Article ID: 202179
Article Last Modified on 7/15/2004
MySample
Option Explicit
' structures
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
' constants
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_INSUFFICIENT_BUFFER = 122 ' dderror
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const DACL_SECURITY_INFORMATION = &H4&
Public Const AclSizeInformation = 2 ' from the ACL_INFORMATION_CLASS enum
' API function declarations
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpDest As Any, lpSrc As Any, ByVal Length As Long)
Declare Function RegGetKeySecurity Lib "advapi32.dll" _
(ByVal hKey As Long, ByVal SecurityInformation As Long, _
pSecurityDescriptor As Any, lpcbSecurityDescriptor As Long) As Long
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
ByVal nSize As Long, Arguments As Long) As Long
Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" _
(pSecurityDescriptor As Any, lpbDaclPresent As Long, pDacl As Long, _
lpbDaclDefaulted As Long) As Long
Declare Function GetAclInformation Lib "advapi32.dll" (pDacl As Any, _
pAclInformation As Any, ByVal nAclInformationLength As Long, _
ByVal dwAclInformationClass As Integer) As Long
Declare Function GetAce Lib "advapi32.dll" (pDacl As Any, _
ByVal dwAceIndex As Long, pAce As Any) As Long
Sub MySample()
Dim lErrorCode As Long
Dim lSdSize As Long
Dim bDaclExist As Long, bDaclPresent As Long ' booleans returned in API's
Dim pDacl As Long ' to store the address of a DACL
Dim pAce As Long ' to store the address of a ACE
Dim i As Long
Dim SecurityDescriptor() As Byte
Dim aclSizeInfo As ACL_SIZE_INFORMATION
Dim AceHeader As ACE_HEADER
'
' CASE 1
'
' initializing the buffer with a very low size
lSdSize = 0
ReDim SecurityDescriptor(lSdSize)
' first call is basically only to find out the required buffer size
lErrorCode = RegGetKeySecurity(HKEY_CLASSES_ROOT, _
DACL_SECURITY_INFORMATION, SecurityDescriptor(0), lSdSize)
If lErrorCode = ERROR_INSUFFICIENT_BUFFER Then
' redimensioning the buffer and calling the function again
' the lSdSize returned the required size from the previous call
ReDim SecurityDescriptor(lSdSize)
lErrorCode = RegGetKeySecurity(HKEY_CLASSES_ROOT, _
DACL_SECURITY_INFORMATION, SecurityDescriptor(0), lSdSize)
End If
' display message error if not successful
If lErrorCode <> ERROR_SUCCESS Then
DisplayError lErrorCode, "RegGetKeySecurity"
Exit Sub
End If
'
' CASE 2
'
' get a pointer (pDacl) to the discretionary access-control list (ACL)
' pDacl was declared as a variable of type Long and will store the
' address of the DACL list
lErrorCode = GetSecurityDescriptorDacl(SecurityDescriptor(0), _
bDaclPresent, pDacl, bDaclExist)
If lErrorCode = 0 Then
lErrorCode = Err.LastDllError
DisplayError lErrorCode, "GetSecurityDescriptorDacl"
Exit Sub
End If
If pDacl = 0 Then
MsgBox "Key has a NULL DACL"
Exit Sub
End If
' retrieving DACL's information; information is returned in the
' aclSizeInfo structure
lErrorCode = GetAclInformation(ByVal pDacl, aclSizeInfo, _
Len(aclSizeInfo), AclSizeInformation)
If lErrorCode = 0 Then
lErrorCode = Err.LastDllError
DisplayError lErrorCode, "GetAclInformation"
Exit Sub
End If
'
' if Dacl is present, get ACE's information
' for each ACE in the DACL list we are going to display the ACE's size
'
If bDaclPresent Then
MsgBox "DACL contains " & aclSizeInfo.AceCount & " ACEs"
If aclSizeInfo.AceCount > 0 Then
For i = 0 To aclSizeInfo.AceCount - 1
' The GetAce function obtains a pointer to an ACE in an ACL
' GetAce expects a reference to DACL in the first
' parameter, thus we pass it ByVal
' GetAce returns the address of an ACE in the second
' parameter, thus we pass pAce ByRef
' pAce was declared as a variable of type Long and will
' store the address of an ACE
lErrorCode = GetAce(ByVal pDacl, i, pAce)
If lErrorCode = 0 Then
lErrorCode = Err.LastDllError
DisplayError lErrorCode, "GetAce"
Else
' copying the memory block pointed by pAce to the
' ACE_HEADER structure
' pAce stores the address of an ACE; we want this
' address to be passed
' to the CopyMemory function, thus we pass this
' parameter ByVal.
CopyMemory AceHeader, ByVal pAce, Len(AceHeader)
' use the AceHeader variable to access structure members
MsgBox "Size of ACE(" & i + 1 & ") is: " _
& AceHeader.AceSize
End If
Next i
End If
End If
End Sub
Sub DisplayError(ByVal dwError As Long, RelatedApi As String)
Dim ErrorMsg As String, SysMsg As String
Dim MsgSize As Long
' get the error's description
If dwError <> 0 Then
MsgSize = 1000
SysMsg = Space(MsgSize)
MsgSize = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _
dwError, 0, SysMsg, MsgSize, ByVal 0&)
' function returns number of characters in string; 0=function failed
If MsgSize = 0 Then
SysMsg = "System error code: " & Str$(dwError)
Else
' resizing the string for output
SysMsg = Left$(SysMsg, MsgSize)
End If
Else
SysMsg = ""
End If
' including additional information in the string
ErrorMsg = "ErrorCode: " & Str$(dwError) & vbCrLf & "API: " _
& RelatedApi & vbCrLf & "System error: " & SysMsg
MsgBox ErrorMsg
End Sub
Declare Function RegGetKeySecurity Lib "advapi32.dll" _ (ByVal hKey As Long, ByVal SecurityInformation As Long, _ pSecurityDescriptor As Any, lpcbSecurityDescriptor As Long) As LongNote that the third parameter is declared as pSecurityDescriptor As Any instead of being declared as a structure. This occurs because you should pass a reference to a memory buffer instead of a reference to the structure itself. In this case, the memory buffer is the SecurityDescriptor array that is an array of Bytes. You need to pass the memory buffer to the function by passing the first element of the array (SecurityDescriptor(0)) by reference.
Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" _ (pSecurityDescriptor As Any, lpbDaclPresent As Long, pDacl As Long, _ lpbDaclDefaulted As Long) As Long
Keywords: kbhowto kbapi KB202179