Solved

NTFS permissions using API - Very difficult question

Posted on 2004-09-08
6
806 Views
Last Modified: 2007-12-19
Hello experts,
I have an extremely difficult question about settings permission on a NTFS folder/file.
I created a function that gets an array which defines permissions and a folder/file.

The function resets the permissions on the file and set it as specified in the array.
The problem is that when set someones permissions to GENERIC_ALL and I view the permission of the file - everything works fine, but when I do the same to a folder (by right-clicking on the folder and choosing permissions), I see only 'List folder content' even though it shows 'Full-Control' on the advanced view !!!

Can anybody tell me what's wrong with my code?

'Moudle:
Private Const DACL_SECURITY_INFORMATION = &H4
Private Const GROUP_SECURITY_INFORMATION = &H2
Private Const OWNER_SECURITY_INFORMATION = &H1
Private Const SECURITY_DESCRIPTOR_REVISION = 1
Private Const AclSizeInformation = 2
Private Const ACL_REVISION = 2
Private Const MAXDWORD = &HFFFFFFFF
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_WRITE = &H40000000
Public Const DELETE = &H10000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const FILE_ALL_ACCESS = (STANDARD_RIGHTS_ALL Or SYNCHRONIZE Or &H1FF)
Private Const CONTAINER_INHERIT_ACE = &H2
Public Const OBJECT_INHERIT_ACE = &H1
Public Const INHERIT_ONLY_ACE = &H8

Private Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function GetFileSecurityN Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, ByVal pSecurityDescriptor As Long, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Private Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Private Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal dwRevision As Long) As Long
Private Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Byte, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
Private Declare Function GetAclInformation Lib "advapi32.dll" (ByVal pAcl As Long, pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As Long) As Long
Private Declare Function GetLengthSid Lib "advapi32.dll" (pSid As Any) As Long
Private Declare Function GetAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceIndex As Long, pace As Any) As Long
Private Declare Function InitializeAcl Lib "advapi32.dll" (pAcl As Byte, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Byte, ByVal pSid2 As Long) As Long
Private Declare Function AddAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, ByVal pAceList As Long, ByVal nAceListLength As Long) As Long
Private Declare Function AddAccessAllowedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal bDaclPresent As Long, pDacl As Byte, ByVal bDaclDefaulted As Long) As Long
Private Declare Function SetSecurityDescriptorOwner Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, pOwner As Any, ByVal bOwnerDefaulted As Long) As Long
Private Declare Function SetSecurityDescriptorGroup Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, pGroup As Any, ByVal bGroupDefaulted As Long) As Long
Private Declare Function SetFileSecurity Lib "advapi32.dll" Alias "SetFileSecurityA" (ByVal lpFileName As String, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long

Type ACL
   AclRevision As Byte
   Sbz1 As Byte
   AclSize As Integer
   AceCount As Integer
   Sbz2 As Integer
End Type

Type SECURITY_DESCRIPTOR
   Revision As Byte
   Sbz1 As Byte
   Control As Long
   Owner As Long
   Group As Long
   sACL As ACL
   Dacl As ACL
End Type

Type ACL_SIZE_INFORMATION
   AceCount As Long
   AclBytesInUse As Long
   AclBytesFree As Long
End Type

Type ACE_HEADER
   AceType As Byte
   AceFlags As Byte
   AceSize As Integer
End Type

Type ACCESS_ALLOWED_ACE
   Header As ACE_HEADER
   Mask As Long
   SidStart As Long
End Type

Public Function DefinePerms(sarr(), sFileName As String) As Long
    Dim lvsize As Long, lVStart As Long, i As Long
    lvsize = UBound(sarr, 2)
    lVStart = LBound(sarr, 2)
    Dim lret As Long
    Dim bUserSid(255) As Byte
    Dim lSIDType As Long
    Dim sdNewSD As SECURITY_DESCRIPTOR
    Dim sCurrentACE As ACCESS_ALLOWED_ACE    ' Current ACE.
    Dim bNewACL() As Byte          ' Buffer to hold new ACL.
    Dim pCurrentAce As Long
   
    ResetPermissions (sFileName)
    lret = InitializeSecurityDescriptor(sdNewSD, SECURITY_DESCRIPTOR_REVISION)
    lret = LookupAccountName(vbNullString, sarr(2, lVStart), _
           bUserSid(0), 255, sarr(1, lVStart), LenB(sarr(1, lVStart)), _
           lSIDType)
    lNewACLSize = (Len(sCurrentACE) + GetLengthSid(bUserSid(0))) * 2 - 4
    ReDim bNewACL(lNewACLSize)
    lret = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)
    lret = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, sarr(3, lVStart), bUserSid(0))
    lret = GetAce(VarPtr(bNewACL(0)), nRecordNumber, pCurrentAce)
    If GetAttr(sFileName) And vbDirectory Then
        lret = GetAce(VarPtr(bNewACL(0)), lVStart, pCurrentAce)
        CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
        sCurrentACE.Header.AceFlags = OBJECT_INHERIT_ACE + INHERIT_ONLY_ACE
        CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
        lret = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, sarr(3, lVStart), bUserSid(0))
        lret = GetAce(VarPtr(bNewACL(0)), lVStart + 1, pCurrentAce)
        CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
        sCurrentACE.Header.AceFlags = CONTAINER_INHERIT_ACE
        CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
    End If
    lret = SetSecurityDescriptorDacl(sdNewSD, 1, bNewACL(0), 0)
    lret = SetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, sdNewSD)
    For i = lVStart + 1 To lvsize
        Call AddAceEntry(sarr(1, i) & "\" & sarr(2, i), sFileName, sarr(3, i))
    Next
End Function


Public Sub AddAceEntry(sUserName As String, sFileName As String, lMask)
   Dim lResult As Long            ' Result of various API calls.
   Dim i As Integer               ' Used in looping.
   Dim bUserSid(255) As Byte      ' This will contain your SID.
   Dim bTempSid(255) As Byte      ' This will contain the Sid of each ACE in the ACL .
   Dim sSystemName As String      ' Name of this computer system.

   Dim lSystemNameLength As Long  ' Length of string that contains
                                  ' the name of this system.

   Dim lLengthUserName As Long    ' Max length of user name.

   'Dim sUserName As String * 255  ' String to hold the current user
                                  ' name.


   Dim lUserSID As Long           ' Used to hold the SID of the
                                  ' current user.

   Dim lTempSid As Long            ' Used to hold the SID of each ACE in the ACL
   Dim lUserSIDSize As Long          ' Size of the SID.
   Dim sDomainName As String * 255   ' Domain the user belongs to.
   Dim lDomainNameLength As Long     ' Length of domain name needed.

   Dim lSIDType As Long              ' The type of SID info we are
                                     ' getting back.

   Dim sFileSD As SECURITY_DESCRIPTOR   ' SD of the file we want.

   Dim bSDBuf() As Byte           ' Buffer that holds the security
                                  ' descriptor for this file.

   Dim lFileSDSize As Long           ' Size of the File SD.
   Dim lSizeNeeded As Long           ' Size needed for SD for file.


   Dim sNewSD As SECURITY_DESCRIPTOR ' New security descriptor.

   Dim sACL As ACL                   ' Used in grabbing the DACL from
                                     ' the File SD.

   Dim lDaclPresent As Long          ' Used in grabbing the DACL from
                                     ' the File SD.

   Dim lDaclDefaulted As Long        ' Used in grabbing the DACL from
                                     ' the File SD.

   Dim sACLInfo As ACL_SIZE_INFORMATION  ' Used in grabbing the ACL
                                         ' from the File SD.

   Dim lACLSize As Long           ' Size of the ACL structure used
                                  ' to get the ACL from the File SD.

   Dim pAcl As Long               ' Current ACL for this file.
   Dim lNewACLSize As Long        ' Size of new ACL to create.
   Dim bNewACL() As Byte          ' Buffer to hold new ACL.

   Dim sCurrentACE As ACCESS_ALLOWED_ACE    ' Current ACE.
   Dim pCurrentAce As Long                  ' Our current ACE.

   Dim nRecordNumber As Long
   Dim sTemp() As String
    If InStr(1, sUserName, "\") Then
        sTemp = Split(sUserName, "\")
        sDomainName = sTemp(0)
        'lDomainNameLength = LenB(sDomainName)
        sUserName = sTemp(1)
    End If
   ' Get the SID of the user. (Refer to the MSDN for more information on SIDs
   ' and their function/purpose in the operating system.) Get the SID of this
   ' user by using the LookupAccountName API. In order to use the SID
   ' of the current user account, call the LookupAccountName API
   ' twice. The first time is to get the required sizes of the SID
   ' and the DomainName string. The second call is to actually get
   ' the desired information.

   lResult = LookupAccountName(vbNullString, sUserName, _
      bUserSid(0), 255, sDomainName, lDomainNameLength, _
      lSIDType)

   ' Now set the sDomainName string buffer to its proper size before
   ' calling the API again.
   sDomainName = Space(lDomainNameLength)

   ' Call the LookupAccountName again to get the actual SID for user.
   lResult = LookupAccountName(vbNullString, sUserName, _
      bUserSid(0), 255, sDomainName, lDomainNameLength, _
      lSIDType)

   ' Return value of zero means the call to LookupAccountName failed;
   ' test for this before you continue.
     If (lResult = 0) Then
        MsgBox "Error: Unable to Lookup the Current User Account: " _
           & sUserName
        Exit Sub
     End If

   ' You now have the SID for the user who is logged on.
   ' The SID is of interest since it will get the security descriptor
   ' for the file that the user is interested in.
   ' The GetFileSecurity API will retrieve the Security Descriptor
   ' for the file. However, you must call this API twice: once to get
   ' the proper size for the Security Descriptor and once to get the
   ' actual Security Descriptor information.

   lResult = GetFileSecurityN(sFileName, DACL_SECURITY_INFORMATION, _
      0, 0, lSizeNeeded)

   ' Redimension the Security Descriptor buffer to the proper size.
   ReDim bSDBuf(lSizeNeeded)

   ' Now get the actual Security Descriptor for the file.
   lResult = GetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, _
      bSDBuf(0), lSizeNeeded, lSizeNeeded)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      MsgBox "Error: Unable to Get the File Security Descriptor"
      Exit Sub
   End If

   ' Call InitializeSecurityDescriptor to build a new SD for the
   ' file.
   lResult = InitializeSecurityDescriptor(sNewSD, _
      SECURITY_DESCRIPTOR_REVISION)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      MsgBox "Error: Unable to Initialize New Security Descriptor"
      Exit Sub
   End If

   ' You now have the file's SD and a new Security Descriptor
   ' that will replace the current one. Next, pull the DACL from
   ' the SD. To do so, call the GetSecurityDescriptorDacl API
   ' function.

   lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, _
      pAcl, lDaclDefaulted)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      MsgBox "Error: Unable to Get DACL from File Security " _
         & "Descriptor"
      Exit Sub
   End If

   ' You have the file's SD, and want to now pull the ACL from the
   ' SD. To do so, call the GetACLInformation API function.
   ' See if ACL exists for this file before getting the ACL
   ' information.
   If (lDaclPresent = False) Then
      MsgBox "Error: No ACL Information Available for this File"
      Exit Sub
   End If

   ' Attempt to get the ACL from the file's Security Descriptor.
   lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      MsgBox "Error: Unable to Get ACL from File Security Descriptor"
      Exit Sub
   End If

   ' Now that you have the ACL information, compute the new ACL size
   ' requirements.
   lNewACLSize = sACLInfo.AclBytesInUse + (Len(sCurrentACE) + _
      GetLengthSid(bUserSid(0))) * 2 - 4

   ' Resize our new ACL buffer to its proper size.
   ReDim bNewACL(lNewACLSize)

   ' Use the InitializeAcl API function call to initialize the new
   ' ACL.
   lResult = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      MsgBox "Error: Unable to Initialize New ACL"
      Exit Sub
   End If

   ' If a DACL is present, copy it to a new DACL.
   If (lDaclPresent) Then

      ' Copy the ACEs from the file to the new ACL.
      'If (sACLInfo.AceCount > 0) Then

         ' Grab each ACE and stuff them into the new ACL.
         nRecordNumber = 0
         For i = 0 To (sACLInfo.AceCount - 1)

            ' Attempt to grab the next ACE.
            lResult = GetAce(pAcl, i, pCurrentAce)

            ' Make sure you have the current ACE under question.
            If (lResult = 0) Then
               MsgBox "Error: Unable to Obtain ACE (" & i & ")"
               Exit Sub
            End If

            ' You have a pointer to the ACE. Place it
            ' into a structure, so you can get at its size.
            CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)

            'Skip adding the ACE to the ACL if this is same usersid
            lTempSid = pCurrentAce + 8
            If EqualSid(bUserSid(0), lTempSid) = 0 Then

                ' Now that you have the ACE, add it to the new ACL.
                lResult = AddAce(VarPtr(bNewACL(0)), ACL_REVISION, _
                  MAXDWORD, pCurrentAce, _
                  sCurrentACE.Header.AceSize)

                 ' Make sure you have the current ACE under question.
                 If (lResult = 0) Then
                   MsgBox "Error: Unable to Add ACE to New ACL"
                    Exit Sub
                 End If
                 nRecordNumber = nRecordNumber + 1
            End If

         Next i

         ' You have now rebuilt a new ACL and want to add it to
         ' the newly created DACL.
         lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, _
            lMask, bUserSid(0))

         ' Make sure added the ACL to the DACL.
         If (lResult = 0) Then
            MsgBox "Error: Unable to Add ACL to DACL"
            Exit Sub
         End If

         'If it's directory, we need to add inheritance staff.
         If GetAttr(sFileName) And vbDirectory Then

            ' Attempt to grab the next ACE which is what we just added.
            lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber, pCurrentAce)

            ' Make sure you have the current ACE under question.
            If (lResult = 0) Then
               MsgBox "Error: Unable to Obtain ACE (" & i & ")"
               Exit Sub
            End If
            ' You have a pointer to the ACE. Place it
            ' into a structure, so you can get at its size.
            CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
            sCurrentACE.Header.AceFlags = OBJECT_INHERIT_ACE + INHERIT_ONLY_ACE
            CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)

            'add another ACE for files
            lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, _
               lMask, bUserSid(0))

            ' Make sure added the ACL to the DACL.
            If (lResult = 0) Then
               MsgBox "Error: Unable to Add ACL to DACL"
               Exit Sub
            End If

            ' Attempt to grab the next ACE.
            lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber + 1, pCurrentAce)

            ' Make sure you have the current ACE under question.
            If (lResult = 0) Then
               MsgBox "Error: Unable to Obtain ACE (" & i & ")"
               Exit Sub
            End If

            CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
            sCurrentACE.Header.AceFlags = CONTAINER_INHERIT_ACE
            CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
        End If


         ' Set the file's Security Descriptor to the new DACL.
         lResult = SetSecurityDescriptorDacl(sNewSD, 1, _
            bNewACL(0), 0)

         ' Make sure you set the SD to the new DACL.
         If (lResult = 0) Then
            MsgBox "Error: " & _
                "Unable to Set New DACL to Security Descriptor"
            Exit Sub
         End If

         ' The final step is to add the Security Descriptor back to
         ' the file!
         lResult = SetFileSecurity(sFileName, _
            DACL_SECURITY_INFORMATION, sNewSD)

         ' Make sure you added the Security Descriptor to the file!
         If (lResult = 0) Then
            MsgBox "Error: Unable to Set New Security Descriptor " _
               & " to File : " & sFileName
            MsgBox Err.LastDllError
         End If

      End If

   'End If

End Sub



Public Function ResetPermissions(sFileName As String) As Long
    Dim lvsize As Long, lVStart As Long, i As Long
    Dim lret As Long
    Dim bUserSid(255) As Byte
    Dim lSIDType As Long
    Dim sdNewSD As SECURITY_DESCRIPTOR
    Dim sCurrentACE As ACCESS_ALLOWED_ACE    ' Current ACE.
    Dim bNewACL() As Byte          ' Buffer to hold new ACL.
    Dim pCurrentAce As Long
    lret = InitializeSecurityDescriptor(sdNewSD, SECURITY_DESCRIPTOR_REVISION)
    lNewACLSize = (Len(sCurrentACE) + GetLengthSid(bUserSid(0))) * 2 - 4
    ReDim bNewACL(lNewACLSize)
    lret = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)
    lret = SetSecurityDescriptorDacl(sdNewSD, 1, bNewACL(0), 0)
    lret = SetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, sdNewSD)
End Function

Public Sub LockDir(sDir As String)
    Dim sarr(1 To 3, 1)
    sarr(1, 0) = Environ$("computername")
    sarr(2, 0) = "Administrators"
    sarr(3, 0) = GENERIC_ALL
    sarr(1, 1) = Environ$("userdomain")
    sarr(2, 1) = Environ$("username")
    sarr(3, 1) = GENERIC_READ Or GENERIC_EXECUTE
    Call DefinePerms(sarr, sDir)
End Sub

'Form:
'(add a command button and a textbox
Private Sub Command1_Click()
    lockdir(text1.text)
End Sub

Private Sub Form_Load()
    Text1.Text = "enter folder name"
    Command1.Caption = "GO!"
End Sub

Thanx,
Asaf.
0
Comment
Question by:AsafG
  • 2
6 Comments
 
LVL 8

Expert Comment

by:mladenovicz
ID: 12014042
Recently I worked on something similiar. I will recommend you this http://setacl.sourceforge.net/index.html
0
 
LVL 1

Author Comment

by:AsafG
ID: 12270516
I couldn't find anything there...
Still doesn't work...
0
 
LVL 1

Author Comment

by:AsafG
ID: 12271021
I found a way to do it:

Public Const GMEM_MOVEABLE = &H2
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_WRITE = &H40000000
Public Const DELETE = &H10000

' The file/security API call constants.
' Refer to the MSDN for more information on how/what these constants
' are used for.
Public Const DACL_SECURITY_INFORMATION = &H4
Public Const SECURITY_DESCRIPTOR_REVISION = 1
Public Const SECURITY_DESCRIPTOR_MIN_LENGTH = 20
Public Const SD_SIZE = (65536 + SECURITY_DESCRIPTOR_MIN_LENGTH)
Public Const ACL_REVISION2 = 2
Public Const ACL_REVISION = 2
Public Const MAXDWORD = &HFFFFFFFF
Public Const SidTypeUser = 1
Public Const AclSizeInformation = 2

Public Const OBJECT_INHERIT_ACE = &H1
Public Const CONTAINER_INHERIT_ACE = &H2
Public Const NO_PROPAGATE_INHERIT_ACE = &H4
Public Const INHERIT_ONLY_ACE = &H8
Public Const INHERITED_ACE = &H10
Public Const VALID_INHERIT_FLAGS = &H1F

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31

Type ACE_HEADER
   AceType As Byte
   AceFlags As Byte
   AceSize As Integer
End Type


Public Type ACCESS_DENIED_ACE
  Header As ACE_HEADER
  Mask As Long
  SidStart As Long
End Type

Type ACCESS_ALLOWED_ACE
   Header As ACE_HEADER
   Mask As Long
   SidStart As Long
End Type

Type ACL
   AclRevision As Byte
   Sbz1 As Byte
   AclSize As Integer
   AceCount As Integer
   Sbz2 As Integer
End Type

Type ACL_SIZE_INFORMATION
   AceCount As Long
   AclBytesInUse As Long
   AclBytesFree As Long
End Type

Type SECURITY_DESCRIPTOR
   Revision As Byte
   Sbz1 As Byte
   Control As Long
   Owner As Long
   Group As Long
   sACL As ACL
   Dacl As ACL
End Type

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal dwRevision As Long) As Long
Private Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Byte, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
Private Declare Function GetFileSecurityN Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, ByVal pSecurityDescriptor As Long, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Private Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Private Declare Function GetAclInformation Lib "advapi32.dll" (ByVal pAcl As Long, pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As Long) As Long
Private Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Byte, ByVal pSid2 As Long) As Long
Private Declare Function GetLengthSid Lib "advapi32.dll" (pSid As Any) As Long
Private Declare Function InitializeAcl Lib "advapi32.dll" (pAcl As Byte, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Private Declare Function GetAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceIndex As Long, pace As Any) As Long
Private Declare Function AddAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, ByVal pAceList As Long, ByVal nAceListLength As Long) As Long
Private Declare Function AddAccessAllowedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Private Declare Function AddAccessDeniedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal bDaclPresent As Long, pDacl As Byte, ByVal bDaclDefaulted As Long) As Long
Private Declare Function SetFileSecurity Lib "advapi32.dll" Alias "SetFileSecurityA" (ByVal lpFileName As String, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Public Function ResetPermissions(sFileName As String) As Long
    Dim lvsize As Long, lVStart As Long, i As Long
    Dim lret As Long
    Dim bUserSid(255) As Byte
    Dim lSIDType As Long
    Dim sdNewSD As SECURITY_DESCRIPTOR
    Dim sCurrentACE As ACCESS_ALLOWED_ACE    ' Current ACE.
    Dim bNewACL() As Byte          ' Buffer to hold new ACL.
    Dim pCurrentAce As Long
    lret = InitializeSecurityDescriptor(sdNewSD, SECURITY_DESCRIPTOR_REVISION)
    lNewACLSize = (Len(sCurrentACE) + GetLengthSid(bUserSid(0))) * 2 - 4
    ReDim bNewACL(lNewACLSize)
    lret = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)
    lret = SetSecurityDescriptorDacl(sdNewSD, 1, bNewACL(0), 0)
    lret = SetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, sdNewSD)
End Function

Public Function SetAccess(sUserName As String, sFileName As String, lMask As Long) As Long
   Dim lResult As Long            ' Result of various API calls.
   Dim i As Integer               ' Used in looping.
   Dim bUserSid(255) As Byte      ' This will contain your SID.
   Dim bTempSid(255) As Byte      ' This will contain the Sid of each ACE in the ACL .
   Dim sSystemName As String      ' Name of this computer system.

   Dim lSystemNameLength As Long  ' Length of string that contains
                                  ' the name of this system.

   Dim lLengthUserName As Long    ' Max length of user name.

   'Dim sUserName As String * 255  ' String to hold the current user
                                  ' name.


   Dim lUserSID As Long           ' Used to hold the SID of the
                                  ' current user.

   Dim lTempSid As Long            ' Used to hold the SID of each ACE in the ACL
   Dim lUserSIDSize As Long          ' Size of the SID.
   Dim sDomainName As String '* 255   ' Domain the user belongs to.
   Dim lDomainNameLength As Long     ' Length of domain name needed.

   Dim lSIDType As Long              ' The type of SID info we are
                                     ' getting back.

   Dim sFileSD As SECURITY_DESCRIPTOR   ' SD of the file we want.

   Dim bSDBuf() As Byte           ' Buffer that holds the security
                                  ' descriptor for this file.

   Dim lFileSDSize As Long           ' Size of the File SD.
   Dim lSizeNeeded As Long           ' Size needed for SD for file.


   Dim sNewSD As SECURITY_DESCRIPTOR ' New security descriptor.

   Dim sACL As ACL                   ' Used in grabbing the DACL from
                                     ' the File SD.

   Dim lDaclPresent As Long          ' Used in grabbing the DACL from
                                     ' the File SD.

   Dim lDaclDefaulted As Long        ' Used in grabbing the DACL from
                                     ' the File SD.

   Dim sACLInfo As ACL_SIZE_INFORMATION  ' Used in grabbing the ACL
                                         ' from the File SD.

   Dim lACLSize As Long           ' Size of the ACL structure used
                                  ' to get the ACL from the File SD.

   Dim pAcl As Long               ' Current ACL for this file.
   Dim lNewACLSize As Long        ' Size of new ACL to create.
   Dim bNewACL() As Byte          ' Buffer to hold new ACL.

   Dim sCurrentACE As ACCESS_ALLOWED_ACE    ' Current ACE.
   Dim pCurrentAce As Long                  ' Our current ACE.

   Dim nRecordNumber As Long
   
    Dim sTempArr() As String
    sTempArr = Split(sUserName, "\")
    If UBound(sTempArr) = 0 Then
        ret = GetCompName(sDomainName)
        If ret <> 0 Then
            SetAccess = 10 'Unable to retrieve computer name
            Exit Function
        End If
    Else
        sDomainName = sTempArr(0)
        sUserName = sTempArr(1)
    End If
    lDomainNameLength = LenB(sDomainName)

   ' Get the SID of the user. (Refer to the MSDN for more information on SIDs
   ' and their function/purpose in the operating system.) Get the SID of this
   ' user by using the LookupAccountName API. In order to use the SID
   ' of the current user account, call the LookupAccountName API
   ' twice. The first time is to get the required sizes of the SID
   ' and the DomainName string. The second call is to actually get
   ' the desired information.

'''   lResult = LookupAccountName(vbNullString, sUserName, _
'''      bUserSid(0), 255, sDomainName, lDomainNameLength, _
'''      lSIDType)
'''
'''   ' Now set the sDomainName string buffer to its proper size before
'''   ' calling the API again.
'''   sDomainName = Space(lDomainNameLength)

   ' Call the LookupAccountName again to get the actual SID for user.
   lResult = LookupAccountName(vbNullString, sUserName, _
      bUserSid(0), 255, sDomainName, lDomainNameLength, _
      lSIDType)

   ' Return value of zero means the call to LookupAccountName failed;
   ' test for this before you continue.
     If (lResult = 0) Then
        SetAccess = 11 'Unable to retrieve user's SID
        Exit Function
     End If

   ' You now have the SID for the user who is logged on.
   ' The SID is of interest since it will get the security descriptor
   ' for the file that the user is interested in.
   ' The GetFileSecurity API will retrieve the Security Descriptor
   ' for the file. However, you must call this API twice: once to get
   ' the proper size for the Security Descriptor and once to get the
   ' actual Security Descriptor information.

   lResult = GetFileSecurityN(sFileName, DACL_SECURITY_INFORMATION, _
      0, 0, lSizeNeeded)

   ' Redimension the Security Descriptor buffer to the proper size.
   ReDim bSDBuf(lSizeNeeded)

   ' Now get the actual Security Descriptor for the file.
   lResult = GetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, _
      bSDBuf(0), lSizeNeeded, lSizeNeeded)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      SetAccess = 12 'Unable to Get the File Security Descriptor
      Exit Function
   End If

   ' Call InitializeSecurityDescriptor to build a new SD for the
   ' file.
   lResult = InitializeSecurityDescriptor(sNewSD, _
      SECURITY_DESCRIPTOR_REVISION)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      SetAccess = 13 'Unable to Initialize New Security Descriptor
      Exit Function
   End If

   ' You now have the file's SD and a new Security Descriptor
   ' that will replace the current one. Next, pull the DACL from
   ' the SD. To do so, call the GetSecurityDescriptorDacl API
   ' function.

   lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, _
      pAcl, lDaclDefaulted)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      SetAccess = 14 'Unable to Get DACL from File Security Descriptor
      Exit Function
   End If

   ' You have the file's SD, and want to now pull the ACL from the
   ' SD. To do so, call the GetACLInformation API function.
   ' See if ACL exists for this file before getting the ACL
   ' information.
   If (lDaclPresent = False) Then
      SetAccess = 15 ' No ACL Information Available for this File
      Exit Function
   End If

   ' Attempt to get the ACL from the file's Security Descriptor.
   lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      MsgBox "Error: Unable to Get ACL from File Security Descriptor"
      Exit Function
   End If

   ' Now that you have the ACL information, compute the new ACL size
   ' requirements.
   lNewACLSize = sACLInfo.AclBytesInUse + (Len(sCurrentACE) + _
      GetLengthSid(bUserSid(0))) * 2 - 4

   ' Resize our new ACL buffer to its proper size.
   ReDim bNewACL(lNewACLSize)

   ' Use the InitializeAcl API function call to initialize the new
   ' ACL.
   lResult = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)

   ' A return code of zero means the call failed; test for this
   ' before continuing.
   If (lResult = 0) Then
      SetAccess = 15 ' Unable to Initialize New ACL
      Exit Function
   End If

   ' If a DACL is present, copy it to a new DACL.
   If (lDaclPresent) Then

      ' Copy the ACEs from the file to the new ACL.
'      If (sACLInfo.AceCount > 0) Then

         ' Grab each ACE and stuff them into the new ACL.
         nRecordNumber = 0
         For i = 0 To (sACLInfo.AceCount - 1)

            ' Attempt to grab the next ACE.
            lResult = GetAce(pAcl, i, pCurrentAce)

            ' Make sure you have the current ACE under question.
            If (lResult = 0) Then
               SetAccess = 17 ' MsgBox "Error: Unable to Obtain ACE i
               Exit Function
            End If

            ' You have a pointer to the ACE. Place it
            ' into a structure, so you can get at its size.
            CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)

            'Skip adding the ACE to the ACL if this is same usersid
            lTempSid = pCurrentAce + 8
            If EqualSid(bUserSid(0), lTempSid) = 0 Then

                ' Now that you have the ACE, add it to the new ACL.
                lResult = AddAce(VarPtr(bNewACL(0)), ACL_REVISION, _
                  MAXDWORD, pCurrentAce, _
                  sCurrentACE.Header.AceSize)

                 ' Make sure you have the current ACE under question.
                 If (lResult = 0) Then
                    SetAccess = 18 'Unable to Add ACE to New ACL
                    Exit Function
                 End If
                 nRecordNumber = nRecordNumber + 1
            End If

         Next i

         ' You have now rebuilt a new ACL and want to add it to
         ' the newly created DACL.
         lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, _
            lMask, bUserSid(0))

         ' Make sure added the ACL to the DACL.
         If (lResult = 0) Then
            SetAccess = 19 ' Unable to Add ACL to DACL
            Exit Function
         End If

         'If it's directory, we need to add inheritance staff.
         If GetAttr(sFileName) And vbDirectory Then

            ' Attempt to grab the next ACE which is what we just added.
            lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber, pCurrentAce)

            ' Make sure you have the current ACE under question.
            If (lResult = 0) Then
               SetAccess = 20 'Unable to Obtain ACE i
               Exit Function
            End If
            ' You have a pointer to the ACE. Place it
            ' into a structure, so you can get at its size.
            CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
            sCurrentACE.Header.AceFlags = OBJECT_INHERIT_ACE + INHERIT_ONLY_ACE
            CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)

            'add another ACE for files
            lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, _
               lMask, bUserSid(0))

            ' Make sure added the ACL to the DACL.
            If (lResult = 0) Then
               SetAccess = 21 'Unable to Add ACL to DACL
               Exit Function
            End If

            ' Attempt to grab the next ACE.
            lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber + 1, pCurrentAce)

            ' Make sure you have the current ACE under question.
            If (lResult = 0) Then
               SetAccess = 22 'Unable to Obtain ACE i
               Exit Function
            End If

            CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
            sCurrentACE.Header.AceFlags = CONTAINER_INHERIT_ACE
            CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
        End If


         ' Set the file's Security Descriptor to the new DACL.
         lResult = SetSecurityDescriptorDacl(sNewSD, 1, _
            bNewACL(0), 0)

         ' Make sure you set the SD to the new DACL.
         If (lResult = 0) Then
            MsgBox "Error: " & _
                SetAccess = 22 'Unable to Set New DACL to Security Descriptor
            Exit Function
         End If

         ' The final step is to add the Security Descriptor back to
         ' the file!
         lResult = SetFileSecurity(sFileName, _
            DACL_SECURITY_INFORMATION, sNewSD)

         ' Make sure you added the Security Descriptor to the file!
         If (lResult = 0) Then
            SetAccess = 30
            'MsgBox Err.LastDllError
         End If

      End If

   'End If

End Function


Private Function GetCompName(sCompName As String) As Long 'Returns computer name
    Dim ltemp As Long
    Dim ret As Long
    ltemp = MAX_COMPUTERNAME_LENGTH
    sCompName = String(ltemp, "X")
    ret = GetComputerName(sCompName, ltemp)
    If ret <> 1 Then
        GetCompName = 1
        Exit Function
    End If
    sCompName = Left(sCompName, ltemp)
End Function

sub main()
    Call ResetPermissions("c:\temp")
    ret = SetAccess("administrators", "c:\temp", GENERIC_ALL)
end sub
0
 

Accepted Solution

by:
ee_ai_construct earned 0 total points
ID: 12305162
Question answered by asker or dialog valuable.
Closed, 500 points refunded.
ee_ai_construct (replacement part #xm34)
Community Support Admin
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now