Sunday, 6 April 2014

Liting file permissions

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0
'
' NAME: Folder Permission
'
' AUTHOR:  Abdelkader, Amine
' DATE  : 10/03/2006
'
' COMMENT: Create a file with the name of the folder in HTML format
'
'==========================================================================
Const ForReading = 1, ForWriting = 2, ForAppending = 8

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 118009
Const ROAccessMask = 1179817



strComputer = "."
sParentFolder = InputBox("Please Enter folder to gather information on", "Parent Folder")
SParentFoldern=replace(sParentFolder,"\","")
SParentFoldern=replace(sParentFoldern,":","")
Set fso = CreateObject("Scripting.FileSystemObject")
'File name Same As Folder Name without special Caracteres
fullfilename=SParentFoldern&".html"
'WScript.echo fullfilename

Set fsOut = fso.OpenTextFile(fullfilename, ForAppending, True)

On Error Resume Next

fsOut.Writeline ("<html>"&vbCr&"<head>"&vbCr&"<title>File Permission For Folder under &"& SParentFoldern&"</title>"&vbCr&"</head>")

strTableHead = "<table border=2 bordercolor='#000010' width='90%' id='Table1'>"
fsOut.Writeline strTableHead
fsOut.Writeline "<tr><td width='50%'>Folder</td>" & _
                "<td width='50%'>User Name</td>"&_
                "<td width='50%'>Permission</td></tr>"

strTableFoot = "</table>"
               
fsOut.Close



ShowSubFolders FSO.GetFolder(sParentFolder),fullfilename

OutputFolderInfo sParentFolder, fullfilename

Set fsOut = fso.OpenTextFile(fullfilename, ForAppending, True)
fsOut.Writeline strTableFoot
fsOut.Close
MsgBox "Done "
WScript.Quit

Public Sub OutputFolderInfo(FolderName , sOutfile)

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 1180095
Const ROAccessMask = 1179817
Const ForReading = 1, ForWriting = 2, ForAppending = 8

strComputer = "."

'Build the path to the folder because it requites 2 backslashes
folderpath = Replace(FolderName, "\", "\\")

objectpath = "winmgmts:Win32_LogicalFileSecuritySetting.path='" & folderpath & "'"

'Get the security set for the object
Set wmiFileSecSetting = GetObject(objectpath)

'verify that the get was successful
RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
 If Err Then
     MsgBox ("GetSecurityDescriptor failed" & vbCrLf & Err.Number & vbCrLf & Err.Description)
     Err.Clear
 End If


Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\cimv2")
Set colFolders = objWMIService.ExecQuery("SELECT * FROM Win32_Directory WHERE Name ='" & _
    folderpath & "'")
For Each objFolder In colFolders
   
    ' Retrieve the DACL array of Win32_ACE objects.
    DACL = wmiSecurityDescriptor.DACL

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso.OpenTextFile(sOutfile, ForAppending, True)
   

    For Each wmiAce In DACL
    ' Get Win32_Trustee object from ACE
        Set Trustee = wmiAce.Trustee
        fsOut.Writeline "<tr><td width='50%'>"&objFolder.Name&"</td>" & _
                "<td width='50%'>"&Trustee.Domain&"\"&Trustee.Name&"</td>"

        'fsOut.Write objFolder.Name & "," & Trustee.Domain & "\" & Trustee.Name & ","
        FoundAccessMask = False
        CustomAccessMask = Flase
        While Not FoundAccessMask And Not CustomAccessMask
            If wmiAce.AccessMask = FullAccessMask Then
                AccessType = "Full Control"
                FoundAccessMask = True
            End If
            If wmiAce.AccessMask = ModifyAccessMask Then
                AccessType = "Modify"
                FoundAccessMask = True
            End If
            If wmiAce.AccessMask = WriteAccessMask Then
                AccessType = "Read/Write Control"
                FoundAccessMask = True
            End If
            If wmiAce.AccessMask = ROAccessMask Then
                AccessType = "Read Only"
                FoundAccessMask = True
            Else
                CustomAccessMask = True
            End If
        Wend
     
        If FoundAccessMask Then
            'fsOut.Writeline AccessType
            fsOut.Writeline "<td width='50%'>"&AccessType&"</td></tr>"
        Else
             fsOut.Writeline "<td width='50%'>Custom</td></tr>"
            'fsOut.Writeline "Custom"
        End If
     
    Next

    Set fsOut = Nothing
    Set fso = Nothing

Next

Set fsOut = Nothing
Set fso = Nothing

end Sub
Sub ShowSubFolders (Folder,fname)
On Error Resume Next
    For Each Subfolder in Folder.SubFolders
        Call OutputFolderInfo(Subfolder.Path,fname)
        Wscript.Echo Subfolder.Path
        call ShowSubFolders (Subfolder,fname)
    Next
End Sub

No comments:

Post a Comment