Code Snippet
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 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
Public Const DELETE = &H10000
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
' API calls used within this sample. Refer to the MSDN for more
' information on how/what these APIs do.
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
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
Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal dwRevision As Long) As Long
Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Byte, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
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
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
Declare Function GetAclInformation Lib "advapi32.dll" (ByVal pAcl As Long, pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As Long) As Long
Public Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Byte, ByVal pSid2 As Long) As Long
Declare Function GetLengthSid Lib "advapi32.dll" (pSid As Any) As Long
Declare Function InitializeAcl Lib "advapi32.dll" (pAcl As Byte, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Declare Function GetAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceIndex As Long, pace As Any) As Long
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
Declare Function AddAccessAllowedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Public Declare Function AddAccessDeniedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal bDaclPresent As Long, pDacl As Byte, ByVal bDaclDefaulted As Long) As Long
Declare Function SetFileSecurity Lib "advapi32.dll" Alias "SetFileSecurityA" (ByVal lpFileName As String, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function SetAccess(ByVal sUserName As String, ByVal sFileName As String, ByVal lMask As Long) As Boolean
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
Dim lLengthUserName As Long ' Max length of user name.
Dim lUserSID As Long ' Used to hold the SID of the
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
Dim sFileSD As SECURITY_DESCRIPTOR ' SD of the file we want.
Dim bSDBuf() As Byte ' Buffer that holds the security
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
Dim lDaclPresent As Long ' Used in grabbing the DACL from
Dim lDaclDefaulted As Long ' Used in grabbing the DACL from
Dim sACLInfo As ACL_SIZE_INFORMATION ' Used in grabbing the ACL
Dim lACLSize As Long ' Size of the ACL structure used
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
SetAccess = False
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
sDomainName = Space(lDomainNameLength)
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
If (lResult = 0) Then Exit Function
lResult = GetFileSecurityN(sFileName, DACL_SECURITY_INFORMATION, 0, 0, lSizeNeeded)
ReDim bSDBuf(lSizeNeeded)
lResult = GetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, bSDBuf(0), lSizeNeeded, lSizeNeeded)
If (lResult = 0) Then Exit Function
lResult = InitializeSecurityDescriptor(sNewSD, SECURITY_DESCRIPTOR_REVISION)
If (lResult = 0) Then Exit Function
lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, pAcl, lDaclDefaulted)
If (lResult = 0) Then Exit Function
If (lDaclPresent = False) Then Exit Function
lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)
If (lResult = 0) Then Exit Function
lNewACLSize = sACLInfo.AclBytesInUse + (Len(sCurrentACE) + GetLengthSid(bUserSid(0))) * 2 - 4
ReDim bNewACL(lNewACLSize)
lResult = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)
If (lResult = 0) Then Exit Function
If (lDaclPresent) Then
If (sACLInfo.AceCount > 0) Then
nRecordNumber = 0
For i = 0 To (sACLInfo.AceCount - 1)
lResult = GetAce(pAcl, i, pCurrentAce)
If (lResult = 0) Then Exit Function
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
lTempSid = pCurrentAce + 8
If EqualSid(bUserSid(0), lTempSid) = 0 Then
lResult = AddAce(VarPtr(bNewACL(0)), ACL_REVISION, MAXDWORD, pCurrentAce, sCurrentACE.Header.AceSize)
If (lResult = 0) Then Exit Function
nRecordNumber = nRecordNumber + 1
End If
Next i
lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, lMask, bUserSid(0))
If (lResult = 0) Then Exit Function
If GetAttr(sFileName) And vbDirectory Then
lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber, pCurrentAce)
If (lResult = 0) Then Exit Function
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
sCurrentACE.Header.AceFlags = OBJECT_INHERIT_ACE + INHERIT_ONLY_ACE
CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, lMask, bUserSid(0))
If (lResult = 0) Then Exit Function
lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber + 1, pCurrentAce)
If (lResult = 0) Then Exit Function
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
sCurrentACE.Header.AceFlags = CONTAINER_INHERIT_ACE
CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
End If
lResult = SetSecurityDescriptorDacl(sNewSD, 1, bNewACL(0), 0)
If (lResult = 0) Then Exit Function
lResult = SetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, sNewSD)
If (lResult = 0) Then Exit Function
SetAccess = True
End If
End If
End Function
Public Sub RemoveAccess(sUserName As String, sFileName As String)
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
Dim lLengthUserName As Long ' Max length of user name.
Dim lUserSID As Long ' Used to hold the SID of the
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
Dim sFileSD As SECURITY_DESCRIPTOR ' SD of the file we want.
Dim bSDBuf() As Byte ' Buffer that holds the security
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
Dim lDaclPresent As Long ' Used in grabbing the DACL from
Dim lDaclDefaulted As Long ' Used in grabbing the DACL from
Dim sACLInfo As ACL_SIZE_INFORMATION ' Used in grabbing the ACL
Dim lACLSize As Long ' Size of the ACL structure used
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
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
sDomainName = Space(lDomainNameLength)
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
If (lResult = 0) Then
MsgBox "Error: Unable to Lookup the Current User Account: " _
& sUserName
Exit Sub
End If
lResult = GetFileSecurityN(sFileName, DACL_SECURITY_INFORMATION, 0, 0, lSizeNeeded)
ReDim bSDBuf(lSizeNeeded)
lResult = GetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, bSDBuf(0), lSizeNeeded, lSizeNeeded)
If (lResult = 0) Then
MsgBox "Error: Unable to Get the File Security Descriptor"
Exit Sub
End If
lResult = InitializeSecurityDescriptor(sNewSD, SECURITY_DESCRIPTOR_REVISION)
If (lResult = 0) Then
MsgBox "Error: Unable to Initialize New Security Descriptor"
Exit Sub
End If
lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, pAcl, lDaclDefaulted)
If (lResult = 0) Then
MsgBox "Error: Unable to Get DACL from File Security " _
& "Descriptor"
Exit Sub
End If
If (lDaclPresent = False) Then
MsgBox "Error: No ACL Information Available for this File"
Exit Sub
End If
lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)
If (lResult = 0) Then
MsgBox "Error: Unable to Get ACL from File Security Descriptor"
Exit Sub
End If
lNewACLSize = sACLInfo.AclBytesInUse
ReDim bNewACL(lNewACLSize)
lResult = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)
If (lResult = 0) Then
MsgBox "Error: Unable to Initialize New ACL"
Exit Sub
End If
If (lDaclPresent) Then
If (sACLInfo.AceCount > 0) Then
nRecordNumber = 0
For i = 0 To (sACLInfo.AceCount - 1)
lResult = GetAce(pAcl, i, pCurrentAce)
If (lResult = 0) Then
MsgBox "Error: Unable to Obtain ACE (" & i & ")"
Exit Sub
End If
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
lTempSid = pCurrentAce + 8
If EqualSid(bUserSid(0), lTempSid) = 0 Then
lResult = AddAce(VarPtr(bNewACL(0)), ACL_REVISION, MAXDWORD, pCurrentAce, sCurrentACE.Header.AceSize)
If (lResult = 0) Then
MsgBox "Error: Unable to Add ACE to New ACL"
Exit Sub
End If
nRecordNumber = nRecordNumber + 1
End If
Next i
lResult = SetSecurityDescriptorDacl(sNewSD, 1, bNewACL(0), 0)
If (lResult = 0) Then
MsgBox "Error: Unable to Set New DACL to Security Descriptor"
Exit Sub
End If
lResult = SetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, sNewSD)
If (lResult = 0) Then
MsgBox "Error: Unable to Set New Security Descriptor to File : " & sFileName
MsgBox Err.LastDllError
Else
MsgBox "Updated Security Descriptor on File: " & sFileName
End If
End If
End If
End Sub
