by Viswanath Munnangi (1 Submission)
Category: Registry
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 13th November 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
changing security permissions of the registry folders
API Declarations
' Standard Header:
'Private Const MODULE_NAME As String =
"lilRegistryPermissions"
'Private Const MODULE_FILE_NAME As String =
"basRegistryPermissions"
'Private Const MODULE_DESC As String = "It contains
functions related to Registry"
'Private Const MODULE_MAJOR As Integer = 1
'Private Const MODULE_MINOR As Integer = 0
'Private Const MODULE_REVISION As Integer = 0
'Private Const CREATED_ON As Date = #6/14/2001# '
US date sformat!
'Private Const CREATED_BY As String = "Munnangi
Viswanath"
'Modification History:
'DATE MODIFIED BY CHANGED
Option Explicit
'Module level Variables
Public merkRootKey As eRegistryRootKeys
Public msKeyAdd As String
Public msUName As String
Public mekpAttrib As eKeyPerms
Public mlTotal As Long
Public mvParams As Variant
' Constants used within our API calls. Refer
win32api.txt file and msdn
Public Const GMEM_MOVEABLE = &H2
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)
'collection object to hold all the class objects
Public moAllData As Collection
'declaration of class object
Public moPath As lilRegistryPermissions.cKeyAddresses
Public moLogWriter As lilLogWriter.clsLogWriter
'Constants Registry Key Permissions refer win32api.txt
file for constants
Public Enum eKeyPerms
GENERIC_READ = &H80000000
GENERIC_ALL = &H10000000
GENERIC_EXECUTE = &H20000000
GENERIC_WRITE = &H40000000
End Enum
' The security API call constants. refer to
win32api.txt file
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
'Type of User 1-user and 2-Group refer win32api.txt
file for constants
Public Const SidTypeUser = 2
Public Const AclSizeInformation = 2
'The following are the inherit flags that go into the
AceFlags field of an Ace header. refer win32api.txt
file
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
'Constant to compare Error return value from the API
call
Const ERROR_SUCCESS = 0
Const ERROR_INSUFFICIENT_BUFFER = 122
'This constant is used to format the error message
returned from the api call
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
'enumarated values for the RootKeys in the Registry
Public Enum eRegistryRootKeys
rkHKeyClassesRoot = &H80000000
rkHKeyCurrentUser = &H80000001
rkhkeylocalmachine = &H80000002
rkHKeyUsers = &H80000003
End Enum
'Type declaration for Filetime used in RegQueryInfo
API Call
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
' Structures used by our API calls.
'Type Declarations for ACE's
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
VBcoders
'Method: SetKeyAccess
'Created By: Viswanth
'Created On: 19/06/01
'Description: this procedure will update the
key with new permissons
'Input: erkRootKey-Registry Root Key,
String-lsSubKey-Key
Address,string-lsUserName-UserName,lekpMask-Permissions
'Output: None
'Dependencies: None
'History:
Dim llResult As Long ' Result of
various API calls.
Dim liCnt As Integer ' Used in looping.
Dim lbytUserSid(255) As Byte ' This will
contain SID.
Dim lbytTemSid(255) As Byte ' This will
contain the Sid of each ACE in the ACL .
Dim lsSystemName As String ' Name of this
computer system.
Dim lsSystemNameLength As Long ' Length of string
that contains
Dim llLengthUserName As Long ' Max length of
user name.
Dim llUserSID As Long ' Used to hold the
SID of the
' current
user/group.
Dim llTempSid As Long ' Used to hold the
SID of each ACE in the ACL
Dim llUserSIDSize As Long ' Size of the SID.
Dim lsDomainName As String * 255 ' Domain the user
belongs to.
Dim llDomainNameLength As Long ' Length of domain
name needed.
Dim llSIDType As Long ' The type of SID
info we are
' getting back.
Dim ltypsFileSD As SECURITY_DESCRIPTOR ' SD of the
file we want.
Dim lbytSDBuf() As Byte ' Buffer that
holds the security
' descriptor for
this file.
Dim llFileSDSize As Long ' Size of the File
SD.
Dim llSizeNeeded As Long ' Size needed for
SD for file.
Dim ltypsNewSD As SECURITY_DESCRIPTOR ' New security
descriptor.
Dim ltypsACL As ACL ' Used in grabbing
the DACL from
' the File SD.
Dim llDaclPresent As Long ' Used in grabbing
the DACL from
' the File SD.
Dim llDaclDefaulted As Long ' Used in grabbing
the DACL from
' the File SD.
Dim ltypsACLInfo As ACL_SIZE_INFORMATION ' Used in
grabbing the ACL
' from the
File SD.
Dim llACLSize As Long ' Size of the ACL
structure used
' to get the ACL
from the File SD.
Dim llPAcl As Long ' Current ACL for
this file.
Dim llNewACLSize As Long ' Size of new ACL
to create.
Dim lbytNewACL() As Byte ' Buffer to hold
new ACL.
Dim ltypsCurrentACE As ACCESS_ALLOWED_ACE ' Current
ACE.
Dim llpCurrentAce As Long ' Our
current ACE.
Dim llnRecordNumber As Long 'It counts number
of ACE'S
Dim lllSdSize As Long 'size of security
descriptor
Dim lbytSecurityDescriptor() As Byte 'security
descriptor for getting list
Dim lllngRetVal As Long
Dim lllngHKey As Long
lllSdSize = 0
' Get the SID of the user
llResult = LookupAccountName(vbNullString,
lsUserName, _
lbytUserSid(0), 255, lsDomainName,
llDomainNameLength, _
llSIDType)
' Now set the lsDomainName string buffer to its
proper size before
' calling the API again.
lsDomainName = Space(llDomainNameLength)
' Call the LookupAccountName again to get the
actual SID for user.
llResult = LookupAccountName(vbNullString,
lsUserName, _
lbytUserSid(0), 255, lsDomainName,
llDomainNameLength, _
llSIDType)
' Return value of zero means the call to
LookupAccountName failed;
' test for this before you continue.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult, "LookUpAccountName"
GoTo ExitHere
End If
'open existing key
llResult = RegOpenKeyEx(erkRootKey, lsSubKey, 0,
KEY_ALL_ACCESS, lllngHKey)
If (llResult <> ERROR_SUCCESS) Then
pDisplayError llResult, "RegOpenKeyEx"
GoTo ExitHere
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.
' call the RegGetKeySecurity API to get the
Security Descriptor List
' initializing the buffer with a very low size
ReDim lbytSecurityDescriptor(lllSdSize)
'first call is basically only to find out the
required buffer size
llResult = RegGetKeySecurity(lllngHKey, _
DACL_SECURITY_INFORMATION,
lbytSecurityDescriptor(0), lllSdSize)
If llResult = ERROR_INSUFFICIENT_BUFFER Then
' redimensioning the buffer and calling the
function again
' the lllSdSize returned the required size from
the previous call
ReDim lbytSecurityDescriptor(lllSdSize)
llResult = RegGetKeySecurity(lllngHKey, _
DACL_SECURITY_INFORMATION,
lbytSecurityDescriptor(0), lllSdSize)
End If
' display message error if not successful
If llResult <> ERROR_SUCCESS Then
pDisplayError llResult, "RegGetKeySecurity"
GoTo ExitHere
End If
' Call InitializeSecurityDescriptor to build a new
Security Descriptor
llResult = InitializeSecurityDescriptor(ltypsNewSD,
_
SECURITY_DESCRIPTOR_REVISION)
' A return code of zero means the call failed; test
for this before continuing.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult,
"InitializeSecurityDescriptor"
GoTo ExitHere
End If
' You now have the user/group Security Description
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.
llResult =
GetSecurityDescriptorDacl(lbytSecurityDescriptor(0),
llDaclPresent, _
llPAcl, llDaclDefaulted)
' A return code of zero means the call failed; test
for this
' before continuing.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult,
"GetSecurityDescriptorDacl"
GoTo ExitHere
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 (llDaclPresent = False) Then
pDisplayError llDaclPresent,
"GetSecurityDescriptorDacl"
GoTo ExitHere
End If
' Attempt to get the ACL from the file's Security
Descriptor.
llResult = GetAclInformation(llPAcl, ltypsACLInfo,
Len(ltypsACLInfo), AclSizeInformation)
' A return code of zero means the call failed; test
for this
' before continuing.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult, "GetAclInformation"
GoTo ExitHere
End If
' Now that you have the ACL information, compute
the new ACL size
' requirements.
llNewACLSize = ltypsACLInfo.AclBytesInUse +
(Len(ltypsCurrentACE) + _
GetLengthSid(lbytUserSid(0))) * 2 - 4
' Resize our new ACL buffer to its proper size.
ReDim lbytNewACL(llNewACLSize)
' Use the InitializeAcl API function call to
initialize the new
' ACL.
llResult = InitializeAcl(lbytNewACL(0),
llNewACLSize, ACL_REVISION)
' A return code of zero means the call failed; test
for this
' before continuing.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult, "InitializeAcl"
GoTo ExitHere
End If
' If a DACL is present, copy it to a new DACL.
If (llDaclPresent) Then
' Copy the ACEs from the file to the new ACL.
If (ltypsACLInfo.AceCount > 0) Then
' Grab each ACE and stuff them into the new
ACL.
llnRecordNumber = 0
For liCnt = 0 To (ltypsACLInfo.AceCount - 1)
' Attempt to grab the next ACE.
llResult = GetAce(llPAcl, liCnt,
llpCurrentAce)
' Make sure you have the current ACE under
question.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult, "GetAce"
GoTo ExitHere
End If
' You have a pointer to the ACE. Place it
' into a structure, so you can get at its
size.
CopyMemory ltypsCurrentACE,
llpCurrentAce, LenB(ltypsCurrentACE)
'Skip adding the ACE to the ACL if this is
same usersid
llTempSid = llpCurrentAce + 8
If EqualSid(lbytUserSid(0), llTempSid) = 0
Then
' Now that you have the ACE, add it to
the new ACL.
llResult =
AddAce(VarPtr(lbytNewACL(0)), ACL_REVISION, _
MAXDWORD, llpCurrentAce, _
ltypsCurrentACE.Header.AceSize)
' Make sure you have the current ACE
under question.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult, "AddAce"
GoTo ExitHere
End If
llnRecordNumber = llnRecordNumber + 1
End If
Next liCnt
' You have now rebuilt a new ACL and want to
add it to
' the newly created DACL.
llResult = AddAccessAllowedAce(lbytNewACL(0),
ACL_REVISION, _
lekpMask, lbytUserSid(0))
' Make sure added the ACL to the DACL.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult,
"AddAccessAllowedAce"
GoTo ExitHere
End If
' Set the Current Security Descriptor to the
new DACL.
llResult =
SetSecurityDescriptorDacl(ltypsNewSD, 1, _
lbytNewACL(0), 0)
' Make sure you set the SD to the new DACL.
If (llResult = ERROR_SUCCESS) Then
pDisplayError llResult,
"SetSecurityDescriptorDacl"
GoTo ExitHere
End If
' The final step is to add the Security
Descriptor
'updating new SD to the key
llResult = RegSetKeySecurity(lllngHKey,
DACL_SECURITY_INFORMATION, ltypsNewSD)
If (llResult <> ERROR_SUCCESS) Then
pDisplayError llResult,
"RegSetKeySecurity"
RegCloseKey (lllngHKey)
GoTo ExitHere
End If
'closing the key which is opened
RegCloseKey (lllngHKey)
End If
End If
ExitHere:
Exit Sub
End Sub
Private Sub pDisplayError(ByVal lldwError As Long,
lsRelatedApi As String)
'Method: pDisplayError
'Created By: Viswanth
'Created On: 19/06/01
'Description: this procedure to Display API
Errors
'Input: long-lldwError-Error Return
Value, string-lsRelatedApi-API Name
'Output: None
'Dependencies: None
'History:
Dim lsErrorMsg As String
Dim lsSysMsg As String
Dim llMsgSize As Long
' get the error's description
If lldwError <> 0 Then
llMsgSize = 1000
lsSysMsg = Space(llMsgSize)
llMsgSize =
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _
lldwError, 0, lsSysMsg, llMsgSize, ByVal 0&)
' function returns number of characters in
string; 0=function failed
If llMsgSize = 0 Then
lsSysMsg = "System error code: " &
Str$(lldwError)
Else
' resizing the string for output
lsSysMsg = Left$(lsSysMsg, llMsgSize)
End If
Else
lsSysMsg = ""
End If
' including additional information in the string
lsErrorMsg = "ErrorCode: " & Str$(lldwError) &
"API: " & lsRelatedApi & "System error: " & lsSysMsg
moLogWriter.LogEvent lsErrorMsg, etError
End Sub
Private Sub pRegistrySubKeys(lerkRootKey As
eRegistryRootKeys, lsstrKeyName As String, llPos As
Long)
'Method: pRegistrySubKeys
'Created By: Viswanth
