1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254
| Option Compare Database
Public Const DACL_SECURITY_INFORMATION = &H4
Type Droit
Nom As String
Flag As Long
End Type
Public tabRights(21) As Droit
' Structures used by our API calls.
' Refer to the MSDN for more information on how/what these
' structures are used for.
Type ACE_HEADER
AceType As Byte '1
AceFlags As Byte '1
AceSize As Integer '2
End Type
Public Type ACCESS_DENIED_ACE
Header As ACE_HEADER
Mask As Long '4
SidStart As Long
End Type
Type ACCESS_ALLOWED_ACE
Header As ACE_HEADER
Mask As Long
SidStart As Long
End Type
Type ACL_SIZE_INFORMATION
AceCount As Long
AclBytesInUse As Long
AclBytesFree As Long
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)
'Declare Function GetSecurityDescriptorOwner Lib "advapi32.dll" (pSecurityDescriptor As Any, pOwner As Long, lpbOwnerDefaulted As Long) As Long
Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
'Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Sub GetFolderInfo(sFolderName As String)
Dim lResult As Long ' Result of various API calls.
Dim I As Integer ' Used in looping.
Dim bSDBuf() As Byte ' Buffer that holds the security
Dim lSizeNeeded As Long ' Size needed for SD for file.
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 sCurrentACE As ACCESS_ALLOWED_ACE ' Current ACE.
Dim pCurrentAce As Long ' Our current ACE.
Dim lMask As Long
Dim pSID As Long
Dim bSuccess As Variant ' Status variable
Dim sAccName As String ' Name of the file owner
Dim lAccName As Long
Dim sDomName As String ' Name of the first domain for the owner
Dim lDomName As Long
Dim peUse As Long
Dim peLbl As String
Dim droits As String
Dim lNbCar As Long
Dim R
tabRights(0).Nom = "ACCESS_READ"
tabRights(0).Flag = &H1
tabRights(1).Nom = "ACCESS_WRITE"
tabRights(1).Flag = &H2
tabRights(2).Nom = "ACCESS_CREATE"
tabRights(2).Flag = &H4
tabRights(3).Nom = "ACCESS_EXEC"
tabRights(3).Flag = &H8
tabRights(4).Nom = "ACCESS_DELETE"
tabRights(4).Flag = &H10
tabRights(5).Nom = "ACCESS_ATTRIB"
tabRights(5).Flag = &H20
tabRights(6).Nom = "ACCESS_PERM"
tabRights(6).Flag = &H40
tabRights(7).Nom = "ACCESS_GROUP"
tabRights(7).Flag = 32768 ' &H8000
tabRights(8).Nom = "DELETE"
tabRights(8).Flag = &H10000
tabRights(9).Nom = "READ_CONTROL"
tabRights(9).Flag = &H20000
tabRights(10).Nom = "WRITE_DAC"
tabRights(10).Flag = &H40000
tabRights(11).Nom = "WRITE_OWNER"
tabRights(11).Flag = &H80000
tabRights(12).Nom = "SYNCHRONIZE"
tabRights(12).Flag = &H100000
tabRights(13).Nom = "ACCESS_SYSTEM_SECURITY"
tabRights(13).Flag = &H1000000
tabRights(14).Nom = "MAXIMUM_ALLOWED"
tabRights(14).Flag = &H2000000
tabRights(15).Nom = "GENERIC_ALL"
tabRights(15).Flag = &H10000000
tabRights(16).Nom = "GENERIC_EXECUTE"
tabRights(16).Flag = &H20000000
tabRights(17).Nom = "GENERIC_WRITE"
tabRights(17).Flag = &H40000000
tabRights(18).Nom = "SPECIFIC_RIGHTS_ALL"
tabRights(18).Flag = 65535 ' &HFFFF
tabRights(19).Nom = "STANDARD_RIGHTS_REQUIRED"
tabRights(19).Flag = &HF0000
tabRights(19).Nom = "STANDARD_RIGHTS_ALL"
tabRights(19).Flag = &H1F0000
lResult = GetFileSecurityN(sFolderName, 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(sFolderName, 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 for " & sFileName
Exit Sub
Else
MsgBox "Success: Ok Getting the File Security Descriptor"
' 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
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
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
lNbCar = 128
sAccName = Space(lNbCar)
sDomName = Space(lNbCar)
lAccName = lNbCar
lDomName = lNbCar
pSID = pCurrentAce + 8 ' sCurrentACE.SidStart
lMask = sCurrentACE.Mask
' MsgBox "ACE" _
' & Chr(13) & Chr(10) & "(Header) AceFlags: " & sCurrentACE.Header.AceFlags _
' & Chr(13) & Chr(10) & "(Header) ACE size: " & sCurrentACE.Header.AceSize _
' & Chr(13) & Chr(10) & "(Header) ACE type: " & sCurrentACE.Header.AceType _
' & Chr(13) & Chr(10) & "MASK : " & lMask _
' & Chr(13) & Chr(10) & "SIDSTART : " & pSID
bSuccess = LookupAccountSid(vbNullString, pSID, sAccName, lAccName, sDomName, lDomName, peUse)
Select Case peUse
Case 1: peLbl = "User"
Case 2: peLbl = "Group"
Case 3: peLbl = "Domain"
Case 4: peLbl = "Alias"
Case 5: peLbl = "WellKnownGroup"
Case 6: peLbl = "DeletedAccount"
Case 7: peLbl = "Invalid"
Case Else: peLbl = "Unknown"
End Select
droits = ""
For R = 0 To 19
Dim hMaskComp
hMaskComp = &H0
hMaskComp = (lMask And tabRights(R).Flag)
If (hMaskComp = tabRights(R).Flag) Then droits = droits & "-" & tabRights(R).Nom & Chr(10) & Chr(13)
Next R
If (bSuccess = 0) Then
MsgBox ("ERROR : unable to LookupAccountSid " & Chr(13) & Chr(10) & "SID " & pSID)
Else
MsgBox ("(Header) AceFlags: " & sCurrentACE.Header.AceFlags _
& Chr(13) & Chr(10) & "(Header) ACE size: " & sCurrentACE.Header.AceSize _
& Chr(13) & Chr(10) & "(Header) ACE type: " & sCurrentACE.Header.AceType _
& Chr(13) & Chr(10) & "MASK : " & lMask _
& Chr(13) & Chr(10) & "SIDSTART : " & pSID _
& Chr(13) & Chr(10) & "---------------" & Chr(13) & Chr(10) & _
"DOMAIN :" & Left(sDomName, lDomName) & Chr(13) & Chr(10) & _
"USER :" & Left(sAccName, lAccName) & Chr(13) & Chr(10) & _
"TYPE :" & peLbl & Chr(13) & Chr(10) & _
"RIGHTS :" & droits)
End If
Next I
End If
End Sub |
Partager