Folder Permissons in VB.NET

I was trying to come up with a way to do the following for my work at GE Healthcare. This is what I came up with. Hope it helps somebody!
1) Read a Folder’s Permissons 2) Add a User to a Folder and have that permission applied to all subFolder/Files 3) Remove a Permission on a folder.
 
Imports System.Runtime.InteropServices
Imports System.Security

Module FileACL
    Public Structure ACE_Entry
        Dim ACE_Type As String
        Dim ACE_Name As String
        Dim ACE_Permission As String
        Dim ACE_Inherited As Boolean
        Dim ACE_Scope As String
    End Structure

    Public Enum SECURITY_INFORMATION As Integer
        OWNER_SECURITY_INFORMATION = 1
        GROUP_SECURITY_INFORMATION = 2
        DACL_SECURITY_INFORMATION = 4
        SACL_SECURITY_INFORMATION = 8
        ‘PROTECTED_SACL_SECURITY_INFORMATION
        ‘PROTECTED_DACL_SECURITY_INFORMATION
        ‘UNPROTECTED_SACL_SECURITY_INFORMATION
        ‘UNPROTECTED_DACL_SECURITY_INFORMATION
    End Enum
    Public Enum FileAccessType As Integer
        DELETE = &H10000
        READ_CONTROL = &H20000
        WRITE_DAC = &H40000
        WRITE_OWNER = &H80000
        SYNCHRONIZE = &H100000
        STANDARD_RIGHTS_REQUIRED = &HF0000
        STANDARD_RIGHTS_READ = READ_CONTROL
        STANDARD_RIGHTS_WRITE = READ_CONTROL
        STANDARD_RIGHTS_EXECUTE = READ_CONTROL
        STANDARD_RIGHTS_ALL = &H1F0000
        SPECIFIC_RIGHTS_ALL = &HFFFF
        ACCESS_SYSTEM_SECURITY = &H1000000
        MAXIMUM_ALLOWED = &H2000000
        GENERIC_READ = &H80000000
        GENERIC_WRITE = &H40000000
        GENERIC_EXECUTE = &H20000000
        GENERIC_ALL = &H10000000
        FILE_READ_DATA = &H1
        FILE_WRITE_DATA = &H2
        FILE_APPEND_DATA = &H4
        FILE_READ_EA = &H8
        FILE_WRITE_EA = &H10
        FILE_EXECUTE = &H20
        FILE_READ_ATTRIBUTES = &H80
        FILE_WRITE_ATTRIBUTES = &H100
        FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &H1FF
        FILE_GENERIC_READ = STANDARD_RIGHTS_READ Or FILE_READ_DATA Or FILE_READ_ATTRIBUTES Or FILE_READ_EA Or SYNCHRONIZE
        FILE_GENERIC_WRITE = STANDARD_RIGHTS_WRITE Or FILE_WRITE_DATA Or FILE_WRITE_ATTRIBUTES Or FILE_WRITE_EA Or FILE_APPEND_DATA Or SYNCHRONIZE
        FILE_GENERIC_EXECUTE = STANDARD_RIGHTS_EXECUTE Or FILE_READ_ATTRIBUTES Or FILE_EXECUTE Or SYNCHRONIZE
    End Enum
    Public Enum DirectoryAccessType As Integer
        DELETE = &H10000
        READ_CONTROL = &H20000
        WRITE_DAC = &H40000
        WRITE_OWNER = &H80000
        SYNCHRONIZE = &H100000
        STANDARD_RIGHTS_REQUIRED = &HF0000
        STANDARD_RIGHTS_READ = READ_CONTROL
        STANDARD_RIGHTS_WRITE = READ_CONTROL
        STANDARD_RIGHTS_EXECUTE = READ_CONTROL
        STANDARD_RIGHTS_ALL = &H1F0000
        SPECIFIC_RIGHTS_ALL = &HFFFF
        ACCESS_SYSTEM_SECURITY = &H1000000
        MAXIMUM_ALLOWED = &H2000000
        GENERIC_READ = &H80000000
        GENERIC_WRITE = &H40000000
        GENERIC_EXECUTE = &H20000000
        GENERIC_ALL = &H10000000
        FILE_LIST_DIRECTORY = &H1
        FILE_ADD_FILE = &H2
        FILE_ADD_SUBDIRECTORY = &H4
        FILE_READ_EA = &H8
        FILE_WRITE_EA = &H10
        FILE_TRAVERSE = &H20
        FILE_DELETE_CHILD = &H40
        FILE_READ_ATTRIBUTES = &H80
        FILE_WRITE_ATTRIBUTES = &H100
        FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &H1FF
        FILE_GENERIC_READ = STANDARD_RIGHTS_READ Or FILE_LIST_DIRECTORY Or FILE_READ_ATTRIBUTES Or FILE_READ_EA Or SYNCHRONIZE
        FILE_GENERIC_WRITE = STANDARD_RIGHTS_WRITE Or FILE_ADD_FILE Or FILE_WRITE_ATTRIBUTES Or FILE_WRITE_EA Or FILE_ADD_SUBDIRECTORY Or SYNCHRONIZE
        FILE_GENERIC_EXECUTE = STANDARD_RIGHTS_EXECUTE Or FILE_READ_ATTRIBUTES Or FILE_TRAVERSE Or SYNCHRONIZE
    End Enum

    Public Enum AceFlags As Byte
        OBJECT_INHERIT_ACE = &H1
        CONTAINER_INHERIT_ACE = &H2
        NO_PROPAGATE_INHERIT_ACE = &H4
        INHERIT_ONLY_ACE = &H8
        INHERITED_ACE = &H10
        VALID_INHERIT_FLAGS = &H1F
        SUCCESSFUL_ACCESS_ACE_FLAG = &H40
        FAILED_ACCESS_ACE_FLAG = &H80
    End Enum

    <StructLayout(LayoutKind.Sequential)> Structure ACEHeader
        Dim AceType As Byte
        Dim AceFlags As Byte
        Dim AceSize As Int16
    End Structure

    <StructLayout(LayoutKind.Sequential)> Structure ACCESS_ACE
        Dim AceHeader As AceHeader
        Dim AccessMask As Integer
        Dim SID As Int32
    End Structure

    ‘ This function obtains specified information about the security of a file or directory.
    <DllImport("AdvAPI32.DLL", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Public Function GetFileSecurity( _
    ByVal lpFileName As String, _
    ByVal RequestedInformation As SECURITY_INFORMATION, _
    ByVal pSecurityDescriptor As IntPtr, _
    ByVal nLength As Int32, _
    ByRef lpnLengthNeeded As Int32) As Boolean
    End Function

    ‘ This function retrieves a pointer to the DACL in a specified security descriptor.
    <DllImport("AdvAPI32.DLL", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Public Function GetSecurityDescriptorDacl( _
    ByVal SecurityDescriptor As IntPtr, _
    ByRef DaclPresent As Boolean, _
    ByRef Dacl As IntPtr, _
    ByRef DaclDefaulted As Boolean) As Boolean
    End Function
    ‘ This function obtains a pointer to an ACE in an ACL.
    <DllImport("AdvAPI32.DLL", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Public Function GetAce( _
    ByVal Dacl As IntPtr, _
    ByVal AceIndex As Integer, _
    ByRef Ace As IntPtr) As Boolean
    End Function
    <DllImport("advapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Function LookupAccountSid( _
    ByVal systemName As String, _
    ByVal psid As IntPtr, _
    ByVal accountName As String, _
    ByRef cbAccount As Integer, _
    ByVal domainName As String, _
    ByRef cbDomainName As Integer, _
    ByRef use As Integer) As Boolean
    End Function
    <DllImport("advapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Function ConvertSidToStringSid( _
    ByVal psid As IntPtr, _
    ByRef ssp As IntPtr) As Boolean
    End Function

    Public Function GetFileACL(ByVal file As String) As ACE_Entry()
        Dim SD As System.IntPtr
        Dim SDSizeNeeded, SDSize As Integer
        Dim LastError As Integer
        Dim Dacl_Present, Dacl_Defaulted As Boolean
        Dim DACL, ACE, SID_ptr, SID_String_ptr As System.IntPtr
        Dim ACE_Header As ACEHeader
        Dim Access_ACE As ACCESS_ACE
        Dim entry As Integer
        Dim isFile As Boolean
        Dim name_len, domain_len, dUse As Integer
        Dim name, domain_name, UserName, MachineName, StringSID As String
        Dim Ans(0) As ACE_Entry

        ‘ Do a quick sanity check?
        isFile = True
        If System.IO.File.Exists(file) = False Then
            If System.IO.Directory.Exists(file) = False Then
                Ans(0).ACE_Name = Left("Error: " & file & " doesn’t exist!", 255)
                Return Ans
            End If
            isFile = False
        End If

        ‘ Do a test run to get the size needed
        SD = New IntPtr(0)
        SDSizeNeeded = 0
        GetFileSecurity(file, SECURITY_INFORMATION.DACL_SECURITY_INFORMATION, SD, 0, SDSizeNeeded)

        ‘ Allocate the memory required for the security descriptor.
        SD = Marshal.AllocHGlobal(SDSizeNeeded)
        SDSize = SDSizeNeeded

        ‘ Get the security descriptor.
        If GetFileSecurity(file, SECURITY_INFORMATION.DACL_SECURITY_INFORMATION, SD, SDSize, SDSizeNeeded) = False Then
            LastError = Marshal.GetLastWin32Error()
            Ans(0).ACE_Name = Left("Error: GetFileSecurity: " & LastError.ToString, 255)
            Return Ans
        End If

        ‘ Get the DACL from the SD
        If GetSecurityDescriptorDacl(SD, Dacl_Present, DACL, Dacl_Defaulted) = False Then
            LastError = Marshal.GetLastWin32Error()
            Ans(0).ACE_Name = Left("Error: GetSecurityDescriptorDacl: " & LastError.ToString, 255)
            Return Ans
        End If

        ‘ loop thru all of the ACE’s in the DACL
        entry = 0
        Do While GetAce(DACL, entry, ACE) = True
            ‘ start by copying just the header
            ACE_Header = Marshal.PtrToStructure(ACE, GetType(ACEHeader))

            ‘ we’re really only interested in type=0 (allow) and type=1 (deny)
            If ACE_Header.AceType = 0 Or ACE_Header.AceType = 1 Then
                ‘ now that we know it’s type… we do the copy over again
                Access_ACE = Marshal.PtrToStructure(ACE, GetType(ACCESS_ACE))

                ‘ translate SID to Account Name
                name_len = 64
                domain_len = 64
                name = Space(name_len)
                domain_name = Space(domain_len)

                ‘ are we doing this remotely? (detected source of mapped drive letters?)
                If file.StartsWith("\\") Then
                    MachineName = file.Split("\")(2)
                Else
                    MachineName = ""
                End If

                ‘ lookup the account for that SID
                SID_ptr = New IntPtr(ACE.ToInt32 + 8)
                If LookupAccountSid(MachineName, SID_ptr, name, name_len, domain_name, domain_len, dUse) = False Then
                    LastError = Marshal.GetLastWin32Error()
                    ‘ if we fail on error 1332, then use the SID in the name
                    If LastError <> 1332 Then
                        domain_len = 0
                        name = "Error: LookupAccountSid: " & LastError.ToString
                        name_len = Len(name)
                    Else
                        If ConvertSidToStringSid(SID_ptr, SID_String_ptr) = False Then
                            LastError = Marshal.GetLastWin32Error()
                            domain_len = 0
                            name = "Error: ConvertSidToStringSid: " & LastError.ToString
                            name_len = Len(name)
                        Else
                            StringSID = Marshal.PtrToStringAuto(SID_String_ptr)
                            Marshal.FreeHGlobal(SID_String_ptr)
                            domain_len = 0
                            name = StringSID
                            name_len = Len(name)
                        End If
                    End If
                End If
                If domain_len > 0 Then
                    UserName = Left(domain_name, domain_len) & "\" & Left(name, name_len)
                Else
                    UserName = Left(name, name_len)
                End If

                ReDim Preserve Ans(entry)

                ‘ Type of ACE
                If ACE_Header.AceType = 0 Then
                    Ans(entry).ACE_Type = "Allow"
                Else
                    Ans(entry).ACE_Type = "Deny"
                End If

                ‘ The security principle
                Ans(entry).ACE_Name = UserName

                ‘ the permissions
                If isFile Then
                    Ans(entry).ACE_Permission = FileMaskToString(Access_ACE.AccessMask)
                Else
                    Ans(entry).ACE_Permission = DirectoryMaskToString(Access_ACE.AccessMask)
                End If

                ‘ Inheritance
                If Access_ACE.AceHeader.AceFlags And AceFlags.INHERITED_ACE Then
                    Ans(entry).ACE_Inherited = True
                Else
                    Ans(entry).ACE_Inherited = False
                End If

                ‘ Scope (directories only)
                If isFile = False Then
                    Ans(entry).ACE_Scope = ACEFlagToString(Access_ACE.AceHeader.AceFlags)
                End If
            End If
            entry = entry + 1
        Loop

        ‘ Free the memory we allocated.
        Marshal.FreeHGlobal(SD)

        ‘ Exit the routine.
        Return Ans
    End Function

    ‘ User friendly version of the access masks
    Function FileMaskToString(ByVal mask As Integer) As String
        Dim buf As String

        Select Case mask
            Case FileAccessType.FILE_ALL_ACCESS
                Return ("Full Control")
            Case FileAccessType.FILE_ALL_ACCESS And Not (FileAccessType.WRITE_DAC Or FileAccessType.WRITE_OWNER Or &H40)
                Return ("Modify")
            Case FileAccessType.FILE_GENERIC_READ Or FileAccessType.FILE_GENERIC_EXECUTE
                Return ("Read & Execute")
            Case FileAccessType.FILE_GENERIC_READ
                Return ("Read")
            Case FileAccessType.FILE_GENERIC_WRITE
                Return ("Write")
            Case FileAccessType.FILE_GENERIC_EXECUTE
                Return ("Execute")
            Case Else
                ‘ ok… do it the hard way
                buf = "Special (0x" & Hex(mask) & "): "
                If mask And FileAccessType.FILE_EXECUTE Then
                    buf = buf & "Execute File,"
                End If
                If mask And FileAccessType.FILE_READ_DATA Then
                    buf = buf & "Read Data,"
                End If
                If mask And FileAccessType.FILE_READ_ATTRIBUTES Then
                    buf = buf & "Read Attributes,"
                End If
                If mask And FileAccessType.FILE_READ_EA Then
                    buf = buf & "Read Extended Attributes,"
                End If
                If mask And FileAccessType.FILE_WRITE_DATA Then
                    buf = buf & "Write Data,"
                End If
                If mask And FileAccessType.FILE_APPEND_DATA Then
                    buf = buf & "Append Data,"
                End If
                If mask And FileAccessType.FILE_WRITE_ATTRIBUTES Then
                    buf = buf & "Write Attributes,"
                End If
                If mask And FileAccessType.FILE_WRITE_EA Then
                    buf = buf & "Write Extended Attributes,"
                End If
                If mask And FileAccessType.DELETE Then
                    buf = buf & "Delete,"
                End If
                If mask And FileAccessType.READ_CONTROL Then
                    buf = buf & "Read Permissions,"
                End If
                If mask And FileAccessType.WRITE_DAC Then
                    buf = buf & "Change Permissions,"
                End If
                If mask And FileAccessType.WRITE_OWNER Then
                    buf = buf & "Take Ownership,"
                End If
                If buf.EndsWith(",") Then
                    buf = buf.TrimEnd(",")
                End If
                Return (buf)
        End Select

    End Function
    Function DirectoryMaskToString(ByVal mask As Integer) As String
        Dim buf As String

        Select Case mask
            Case DirectoryAccessType.FILE_ALL_ACCESS
                Return ("Full Control")
            Case DirectoryAccessType.FILE_ALL_ACCESS And Not (DirectoryAccessType.WRITE_DAC Or DirectoryAccessType.WRITE_OWNER Or DirectoryAccessType.FILE_DELETE_CHILD)
                Return ("Modify")
            Case DirectoryAccessType.FILE_GENERIC_READ Or DirectoryAccessType.FILE_GENERIC_EXECUTE
                Return ("Read & Execute")
            Case DirectoryAccessType.FILE_GENERIC_EXECUTE
                Return ("List Folder Contents")
            Case DirectoryAccessType.FILE_GENERIC_READ
                Return ("Read")
            Case DirectoryAccessType.FILE_GENERIC_WRITE
                Return ("Write")
                ‘ generic permissions
            Case DirectoryAccessType.GENERIC_ALL
                Return ("Generic Full Control")
            Case DirectoryAccessType.GENERIC_READ Or DirectoryAccessType.GENERIC_WRITE Or DirectoryAccessType.GENERIC_EXECUTE Or DirectoryAccessType.DELETE
                Return ("Generic Modify")
            Case DirectoryAccessType.GENERIC_READ Or DirectoryAccessType.GENERIC_EXECUTE
                Return ("Generic Read & Execute")
            Case DirectoryAccessType.GENERIC_EXECUTE
                Return ("Generic List Folder Contents")
            Case DirectoryAccessType.GENERIC_READ
                Return ("Generic Read")
            Case DirectoryAccessType.GENERIC_WRITE
                Return ("Generic Write")
            Case Else
                ‘ ok… do it the hard way
                buf = "Special (0x" & Hex(mask) & "): "
                If mask And DirectoryAccessType.FILE_TRAVERSE Then
                    buf = buf & "Traverse Folder,"
                End If
                If mask And DirectoryAccessType.FILE_LIST_DIRECTORY Then
                    buf = buf & "List Folder,"
                End If
                If mask And DirectoryAccessType.FILE_READ_ATTRIBUTES Then
                    buf = buf & "Read Attributes,"
                End If
                If mask And DirectoryAccessType.FILE_READ_EA Then
                    buf = buf & "Read Extended Attributes,"
                End If
                If mask And DirectoryAccessType.FILE_ADD_FILE Then
                    buf = buf & "Create Files,"
                End If
                If mask And DirectoryAccessType.FILE_ADD_SUBDIRECTORY Then
                    buf = buf & "Create Folders,"
                End If
                If mask And DirectoryAccessType.FILE_WRITE_ATTRIBUTES Then
                    buf = buf & "Write Attributes,"
                End If
                If mask And DirectoryAccessType.FILE_WRITE_EA Then
                    buf = buf & "Write Extended Attributes,"
                End If
                If mask And DirectoryAccessType.DELETE Then
                    buf = buf & "Delete,"
                End If
                If mask And DirectoryAccessType.FILE_DELETE_CHILD Then
                    buf = buf & "Delete Subfolders & Files,"
                End If
                If mask And DirectoryAccessType.READ_CONTROL Then
                    buf = buf & "Read Permissions,"
                End If
                If mask And DirectoryAccessType.WRITE_DAC Then
                    buf = buf & "Change Permissions,"
                End If
                If mask And DirectoryAccessType.WRITE_OWNER Then
                    buf = buf & "Take Ownership,"
                End If
                If buf.EndsWith(",") Then
                    buf = buf.TrimEnd(",")
                End If
                Return (buf)
        End Select

    End Function
    Function ACEFlagToString(ByVal flag As Byte) As String
        Dim buf As String

        Select Case flag
            Case 0, AceFlags.INHERITED_ACE
                Return "This folder only"
            Case AceFlags.OBJECT_INHERIT_ACE Or AceFlags.CONTAINER_INHERIT_ACE, AceFlags.OBJECT_INHERIT_ACE Or AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERITED_ACE
                Return "This folder, subfolders and files"
            Case AceFlags.CONTAINER_INHERIT_ACE, AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERITED_ACE
                Return "This folder and subfolders"
            Case AceFlags.OBJECT_INHERIT_ACE, AceFlags.OBJECT_INHERIT_ACE Or AceFlags.INHERITED_ACE
                Return "This folder and files"
            Case AceFlags.OBJECT_INHERIT_ACE Or AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE, AceFlags.OBJECT_INHERIT_ACE Or AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE Or AceFlags.INHERITED_ACE
                Return "Subfolders and files only"
            Case AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE, AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE Or AceFlags.INHERITED_ACE
                Return "Subfolders only"
            Case AceFlags.OBJECT_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE, AceFlags.OBJECT_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE Or AceFlags.INHERITED_ACE
                Return "Files only"
            Case Else
                ‘ ok… do it the hard way
                buf = "Special (0x" & Hex(flag) & "): "
                If flag And AceFlags.OBJECT_INHERIT_ACE Then
                    buf = buf & "Object,"
                End If
                If flag And AceFlags.CONTAINER_INHERIT_ACE Then
                    buf = buf & "Container,"
                End If
                If flag And AceFlags.NO_PROPAGATE_INHERIT_ACE Then
                    buf = buf & "No Propagate,"
                End If
                If flag And AceFlags.INHERIT_ONLY_ACE Then
                    buf = buf & "Inherit Only,"
                End If
                If flag And AceFlags.INHERITED_ACE Then
                    buf = buf & "Inherited,"
                End If
                If flag And AceFlags.SUCCESSFUL_ACCESS_ACE_FLAG Then
                    buf = buf & "Successful,"
                End If
                If flag And AceFlags.FAILED_ACCESS_ACE_FLAG Then
                    buf = buf & "Failed,"
                End If
                Return buf
        End Select
    End Function
End Module

Advertisements
  1. #1 by Mark on February 12, 2012 - 3:24 pm

    I love you! I have found many examples of checking a single users access, but could never find an enumeration routine. Thanks!

    I work a lot with security permissions using vb.net access control functions and it works well, but with one SERIOUS limitation. I can’t work with paths that are too long. I am converting my code to higher level APIs so I can work with long file paths using (\\?\UNC\Server\Share\path)

  2. #2 by Allan on May 19, 2012 - 10:52 pm

    Can I have a copy of the .sln of this application?

  3. #3 by Greg on October 12, 2013 - 3:16 pm

    Can I have the project file ? for my research project.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: