Printable View
If you follow this link you will find the code i have to change the permissions of a registry key.
http://www.vbforums.com/showthread.php?t=452607
I would like to know how to put it through a loop for every user. I have a code to get a list of usernames in to a list box. I just need to know how to loop it.
Thanks in advance Chris1990
Code:Dim i As Integer
For i = 0 To List1.ListCount - 1
'run your code here
'the username is List1.List(i) each time through the loop
Next i
I have this codeQuote:
Originally Posted by Al42
run your code here
'the username is List1.List(i) each time through the loop
the code i need is the code to replace this
What ? Haven't you finished this yet ? :lol:. You need to pass the HKEY, subkey and users names to "UpdatePermissionsOfHKLM".
This following is an adaptation from the "SetPerm.bas" module. I've removed the unnecessary stuff to make it clearer, and changed the name of the procedure from "UpdatePermissionsOfHKLM" to "ChangeSubKeyPermissions", and added the necessary parameters so it can be called in a loop.
It's a lot of code, so spans the next few posts. You simply call "ChangeSubKeyPermissions", passing the parameters as required. "strUser" is, obviously, the user name.
EDIT: I've ripped this from an app I made, so one or more declarations (such as "RegCloseKey") or constants may be missing from the code - you will have to add them yourself. Make sure "Break On Unhandled Errors" is selected.
Code:Option Explicit
'Extract from SetPerm.exe, available from:-
'http://support.microsoft.com/kb/316440/
'"How to use low-level access control APIs from Visual Basic"
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub FreeSid Lib "advapi32.dll" _
(ByVal pSid 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 AllocateAndInitializeSid Lib "advapi32.dll" _
(pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As Byte, _
ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, _
ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Function EqualSid Lib "advapi32.dll" _
(ByVal pSid1 As Long, ByVal pSid2 As Long) As Long
Private Declare Function GetAce Lib "advapi32.dll" _
(ByVal pAcl As Long, ByVal dwAceIndex As Long, pACE 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" _
(ByVal pSid As Long) As Long
Private Declare Function GetSecurityDescriptorControl Lib "advapi32.dll" _
(ByVal pSecurityDescriptor As Long, pControl As Long, lpdwRevision As Long) As Long
Private Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" _
(ByVal pSecurityDescriptor As Long, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
Private Declare Function InitializeAcl Lib "advapi32.dll" _
(ByVal pAcl As Long, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Private Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" _
(ByVal pSecurityDescriptor As Long, ByVal dwRevision As Long) As Long
Private Declare Function LocalAlloc Lib "kernel32.dll" _
(ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32.dll" _
(ByVal hMem As Long) As Long
Private Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" _
(ByVal lpSystemName As Long, ByVal lpAccountName As String, ByVal Sid As Long, cbSid As Long, _
ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function SetSecurityDescriptorControl Lib "advapi32.dll" _
(ByVal pSecurityDescriptor As Long, ByVal controlBitsOfInterest As Long, _
ByVal controlBitsToSet As Long) As Long
Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" _
(ByVal pSecurityDescriptor As Long, ByVal bDaclPresent As Long, ByVal pDacl As Long, _
ByVal bDaclDefaulted As Long) As Long
'APIs for modifying DACL of a registry key
Private Declare Function RegGetKeySecurity Lib "advapi32.dll" _
(ByVal hKey As Long, ByVal SecurityInformation As Long, ByVal pSecurityDescriptor As Long, _
lpcbSecurityDescriptor As Long) As Long
Private Declare Function RegSetKeySecurity Lib "advapi32.dll" _
(ByVal hKey As Long, ByVal SecurityInformation As Long, ByVal pSecurityDescriptor As Long) As Long
'Version Checking APIs
Private Declare Function GetVersionExA Lib "kernel32.dll" _
(lpVersionInformation As OSVERSIONINFO) As Integer
' Memory constants used by various memory API calls.
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)
'Generic Access Rights
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_WRITE = &H40000000
'Standard Access Rights
Public Const DELETE = &H10000
Public Const READ_CONTROL = &H20000
Public Const WRITE_DAC = &H40000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const STANDARD_RIGHTS_READ = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Public Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Public Const STANDARD_RIGHTS_ALL = &H1F0000
'Constants to be used in API calls. Refer to the MSDN for more information on how/what these constants are used for.
Private Const DACL_SECURITY_INFORMATION = &H4
Private Const SECURITY_DESCRIPTOR_REVISION = 1
Private Const SECURITY_DESCRIPTOR_MIN_LENGTH = 20
Private Const ACL_REVISION = 2
Private Const MAXDWORD = &HFFFFFFFF
'The following are the inherit flags that go into the AceFlags field of an Ace header.
Private Const CONTAINER_INHERIT_ACE = &H2
Private Const INHERIT_ONLY_ACE = &H8
Private Const INHERITED_ACE = &H10
'The following are the security descriptor flags.
Private Const SE_DACL_AUTO_INHERIT_REQ = &H100
Private Const SE_DACL_AUTO_INHERITED = &H400
Private Const SE_DACL_PROTECTED = &H1000
'Type of ACE being added.
Private Const ACCESS_ALLOWED_ACE_TYPE = 0
Private Const ACCESS_DENIED_ACE_TYPE = 1
'Constants from WINNT.H for the various well-known SIDs, users and groups
Private Const SECURITY_WORLD_SID_AUTHORITY = &H1
Private Const SECURITY_WORLD_RID = &H0
Private Const DOMAIN_USER_RID_GUEST = &H1F5
'Version Information constant
Private Const VER_PLATFORM_WIN32_NT = &H2
'Types needed for ACL manipulation. Refer to MSDN for more info
Private Type ACL
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type
Private Type ACL_SIZE_INFORMATION
AceCount As Long
AclBytesInUse As Long
AclBytesFree As Long
End Type
Private Type ACE_HEADER
AceType As Byte
AceFlags As Byte
AceSize As Integer
End Type
Private Type ACE
Header As ACE_HEADER
Mask As Long
SidStart As Long
End Type
Private Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
' Application Types
Private Type AccountPerm
AccountName As String
AccessMask As Long
AceFlags As Byte
AceType As Byte
pSid As Long
SidPassedByCaller As Boolean
End Type
Private Type SDMemInfo
pSD As Long
pAcl As Long
End Type
Public Sub ChangeSubKeyPermissions(lngHKey As Long, strSubKey As String, strUser As String)
Dim hKey As Long
Dim KeyName As String
Dim Accounts(0 To 2) As AccountPerm
Dim fResult As Long, n As Long
Dim dwNumOfAccounts As Long
Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
KeyName = strSubKey
dwNumOfAccounts = UBound(Accounts)
'Set up the account permissions that need to be created as an array
Accounts(0).AccountName = ""
Accounts(0).AccessMask = GENERIC_READ
Accounts(0).AceFlags = CONTAINER_INHERIT_ACE
Accounts(0).AceType = ACCESS_ALLOWED_ACE_TYPE
'Construct SID for Everyone "Universal well-known SID"
siaNtAuthority.Value(5) = SECURITY_WORLD_SID_AUTHORITY
If AllocateAndInitializeSid(siaNtAuthority, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, Accounts(0).pSid) = 0 Then
MsgBox "AllocateAndInitializeSid failed with error code : " & Err.LastDllError
Exit Sub
End If
'If the caller initializes SID, set SidPassedByCaller member to True
Accounts(0).SidPassedByCaller = True
'The following entry will allow permissions on the specified key
Accounts(1).AccountName = strUser
Accounts(1).AccessMask = GENERIC_READ Or GENERIC_WRITE Or GENERIC_EXECUTE Or DELETE
Accounts(1).AceFlags = 0
Accounts(1).AceType = ACCESS_ALLOWED_ACE_TYPE
Accounts(1).pSid = 0
Accounts(1).SidPassedByCaller = False
'The following entry will deny all permissions on future subkeys
Accounts(2).AccountName = strUser
Accounts(2).AccessMask = GENERIC_ALL
Accounts(2).AceFlags = CONTAINER_INHERIT_ACE Or INHERIT_ONLY_ACE
Accounts(2).AceType = ACCESS_DENIED_ACE_TYPE
Accounts(2).pSid = 0
Accounts(2).SidPassedByCaller = False
fResult = RegOpenKeyEx(lngHKey, KeyName, 0, READ_CONTROL Or WRITE_DAC, hKey)
If fResult <> ERROR_SUCCESS Then
MsgBox "RegOpenKeyEx failed with error code : " & fResult
Else
UpdatePermissionsOfRegistryKey hKey, Accounts
RegCloseKey hKey
End If
'Make sure we clean up
For n = 0 To dwNumOfAccounts
If Accounts(n).pSid <> 0 And Accounts(n).SidPassedByCaller Then
FreeSid (Accounts(n).pSid)
Accounts(n).pSid = 0
End If
Next
End Sub
Code:Private Function UpdatePermissionsOfRegistryKey(ByVal hKey As Long, Accounts() As AccountPerm) As Boolean
Dim fResult As Long
Dim sdInfo As SDMemInfo
Dim oldSD As Long
Dim nLengthNeeded As Long
Dim bStatus As Boolean
bStatus = False
On Error GoTo Cleanup
sdInfo.pAcl = 0
sdInfo.pSD = 0
nLengthNeeded = 0
fResult = RegGetKeySecurity(hKey, DACL_SECURITY_INFORMATION, 0, nLengthNeeded)
'This call will fail. On Return nLengthNeeded will be updated.
'Check for that below
If nLengthNeeded = 0 Then
MsgBox "RegGetKeySecurity failed with error code : " & fResult
Err.Raise 0
End If
oldSD = LocalAlloc(LPTR, nLengthNeeded)
If oldSD = 0 Then
MsgBox "LocalAlloc failed with error code : " & Err.LastDllError
Err.Raise 0
End If
fResult = RegGetKeySecurity(hKey, DACL_SECURITY_INFORMATION, oldSD, nLengthNeeded)
If fResult <> ERROR_SUCCESS Then
MsgBox "RegGetKeySecurity failed with error code : " & fResult
Err.Raise 0
End If
fResult = AddSecurityDescriptor(oldSD, Accounts(), sdInfo)
If fResult = 0 Then
MsgBox "Unable to create Security Descriptor"
Err.Raise 0
End If
fResult = RegSetKeySecurity(hKey, DACL_SECURITY_INFORMATION, sdInfo.pSD)
If fResult <> ERROR_SUCCESS Then
MsgBox "RegSetKeySecurity failed with error code : " & fResult
Err.Raise 0
End If
bStatus = True
Cleanup:
'Free the memory allocated
If (oldSD <> 0) Then LocalFree oldSD
oldSD = 0
If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
sdInfo.pSD = 0
If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
sdInfo.pAcl = 0
UpdatePermissionsOfRegistryKey = bStatus
End Function
Private Function AddSecurityDescriptor(ByVal pOldSD As Long, Accounts() As AccountPerm, sdInfo As SDMemInfo) As Long
Dim pNewACL As Long
Dim dwNewACLSize As Long
Dim dwTotalDACLSize As Long
Dim szDomainName As String
Dim cbDomainName As Long
Dim nSidSize As Long
Dim I As Long, n As Long
Dim eUse As Long
Dim fReturn As Long
Dim fResult As Long
Dim tempACL As ACL
Dim tempAce As ACE
Dim Ptr As Long
Dim dwNumOfAccounts As Long
Dim pSD As Long
Dim AceIndex As Long
Dim lDaclPresent As Long
Dim lDaclDefaulted As Long
Dim sACLInfo As ACL_SIZE_INFORMATION
Dim pAcl As Long
Dim osinfo As OSVERSIONINFO
Dim w2kOrAbove As Boolean
On Error GoTo ExitLabel
'Determine if system is Windows 2000 or above
osinfo.dwOSVersionInfoSize = Len(osinfo)
osinfo.szCSDVersion = Space$(128)
GetVersionExA osinfo
w2kOrAbove = (osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And osinfo.dwMajorVersion >= 5)
'Intialize some of the variables
fReturn = 0
sdInfo.pAcl = 0
sdInfo.pSD = 0
dwNumOfAccounts = UBound(Accounts)
'Allocate memory for a new Security Descriptor
pSD = LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)
If pSD = 0 Then Err.Raise 0
sdInfo.pSD = pSD
'Initialize the new Security Descriptor
fResult = InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION)
If fResult = 0 Then Err.Raise 0
'Get the existing ACL size
lDaclPresent = 0
pAcl = 0
If (pOldSD) Then
fResult = GetSecurityDescriptorDacl(pOldSD, lDaclPresent, pAcl, lDaclDefaulted)
If fResult = 0 Then Err.Raise 0
If (lDaclPresent <> 0 And pAcl <> 0) Then
fResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)
If fResult = 0 Then Err.Raise 0
dwTotalDACLSize = sACLInfo.AclBytesInUse
Else
dwTotalDACLSize = Len(tempACL)
End If
Else
dwTotalDACLSize = Len(tempACL)
End If
'Find the SIDs for each userName supplied in Accounts() array and compute the new ACL size needed.
'Call LookupAccountName only for the entries where the SID is not supplied by the caller.
szDomainName = Space(256)
For n = 0 To dwNumOfAccounts
If (Accounts(n).pSid = 0) Then
nSidSize = 0
cbDomainName = 256
'Lookup the SID for this user
'First call is to find the buffer size required for SID
fResult = LookupAccountName(0, Accounts(n).AccountName, 0, nSidSize, szDomainName, cbDomainName, eUse)
Accounts(n).pSid = LocalAlloc(LPTR, nSidSize)
If Accounts(n).pSid = 0 Then Err.Raise 0
'Get the Actual SID value in this second call
fResult = LookupAccountName(0, Accounts(n).AccountName, Accounts(n).pSid, nSidSize, szDomainName, cbDomainName, eUse)
If fResult = 0 Then Err.Raise 0
End If
'sizeof(DWORD) = 4
dwNewACLSize = Len(tempAce) + GetLengthSid(Accounts(n).pSid) - 4
dwTotalDACLSize = dwTotalDACLSize + dwNewACLSize
Next
'Allocate memory for the new ACL
pNewACL = LocalAlloc(LPTR, dwTotalDACLSize)
If pNewACL = 0 Then Err.Raise 0
sdInfo.pAcl = pNewACL
'Initialize the new ACL
fResult = InitializeAcl(pNewACL, dwTotalDACLSize, ACL_REVISION)
If fResult = 0 Then Err.Raise 0
AceIndex = 0
'Add the new ACCESS DENIED ACEs first to the DACL
For n = 0 To dwNumOfAccounts
If (Accounts(n).AceType = ACCESS_DENIED_ACE_TYPE) Then
fResult = ConstructAndAddAce(pNewACL, Accounts(n).AceType, Accounts(n).AceFlags, Accounts(n).AccessMask, Accounts(n).pSid)
If fResult = 0 Then Err.Raise 0
AceIndex = AceIndex + 1
End If
Next
'Copy all non-inherited ACEs from the existing DACL
If (lDaclPresent <> 0 And pAcl <> 0 And sACLInfo.AceCount > 0) Then
'Get each ACE from the old DACL and add them into the new DACL.
For I = 0 To (sACLInfo.AceCount - 1)
'Attempt to get the next ACE.
fResult = GetAce(pAcl, I, Ptr)
If (fResult = 0) Then Err.Raise 0
CopyMemory tempAce, Ptr, LenB(tempAce)
'Exit this for loop, once the first INHERITED_ACE is found
If ((tempAce.Header.AceFlags And INHERITED_ACE) = INHERITED_ACE) Then
Exit For
End If
'Add the ACE to the new DACL if the SID is not in Accounts()
If Not (IsEqual(Accounts(), Ptr + 8)) Then
'Now that you have the ACE, add it to the new ACL.
fResult = AddAce(pNewACL, ACL_REVISION, MAXDWORD, Ptr, tempAce.Header.AceSize)
If fResult = 0 Then Err.Raise 0
AceIndex = AceIndex + 1
End If
Next I
End If
'Add the new ACCESS ALLOWED ACEs next to the DACL
For n = 0 To dwNumOfAccounts
If (Accounts(n).AceType = ACCESS_ALLOWED_ACE_TYPE) Then
fResult = ConstructAndAddAce(pNewACL, Accounts(n).AceType, Accounts(n).AceFlags, Accounts(n).AccessMask, Accounts(n).pSid)
If fResult = 0 Then Err.Raise 0
AceIndex = AceIndex + 1
End If
Next
'Copy now all inherited ACEs from the existing DACL, so that the new DACL will be in the Windows 2000 preferred order
If (lDaclPresent <> 0 And pAcl <> 0 And sACLInfo.AceCount > 0) Then
'Get each INHERITED_ACE from the old ACL and add them into the new ACL.
For I = I To (sACLInfo.AceCount - 1)
'Attempt to get the next ACE.
fResult = GetAce(pAcl, I, Ptr)
If (fResult = 0) Then Err.Raise 0
CopyMemory tempAce, Ptr, LenB(tempAce)
'Add it to the new ACL.
fResult = AddAce(pNewACL, ACL_REVISION, MAXDWORD, Ptr, tempAce.Header.AceSize)
If fResult = 0 Then Err.Raise 0
AceIndex = AceIndex + 1
Next I
End If
If w2kOrAbove And pOldSD <> 0 Then
Dim controlFlag As Long
Dim dwRevision As Long
Dim controlBitsOfInterest As Long
Dim controlBitsToSet As Long
fResult = GetSecurityDescriptorControl(pOldSD, controlFlag, dwRevision)
If (fResult <> 0) Then
controlBitsOfInterest = 0
controlBitsToSet = 0
If ((controlFlag And SE_DACL_AUTO_INHERITED) = SE_DACL_AUTO_INHERITED) Then
controlBitsOfInterest = SE_DACL_AUTO_INHERIT_REQ Or SE_DACL_AUTO_INHERITED
controlBitsToSet = controlBitsOfInterest
ElseIf ((controlFlag And SE_DACL_PROTECTED) = SE_DACL_PROTECTED) Then
controlBitsOfInterest = SE_DACL_PROTECTED
controlBitsToSet = controlBitsOfInterest
End If
If controlBitsToSet <> 0 Then
fResult = SetSecurityDescriptorControl(pSD, controlBitsOfInterest, controlBitsToSet)
If fResult = 0 Then Err.Raise 0
End If
End If
End If
'Add the new DACL to the new Security Descriptor
fResult = SetSecurityDescriptorDacl(pSD, 1, pNewACL, 0)
If fResult = 0 Then Err.Raise 0
fReturn = 1
ExitLabel:
'Make sure we clean up
For n = 0 To dwNumOfAccounts
'Free only the SIDs that has been allocated in this function
If Accounts(n).pSid <> 0 And Not (Accounts(n).SidPassedByCaller) Then
LocalFree (Accounts(n).pSid)
Accounts(n).pSid = 0
End If
Next
'If any of the functions failed, free new SD, and new ACL
If fReturn = 0 Then
If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
sdInfo.pSD = 0
If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
sdInfo.pAcl = 0
End If
AddSecurityDescriptor = fReturn
End Function
Code:Private Function ConstructAndAddAce(ByVal pNewACL As Long, ByVal AceType As Byte, ByVal AceFlags As Byte, ByVal AccessMask As Long, ByVal pSid As Long) As Long
Dim fResult As Long
Dim dwNewACESize As Long
Dim dwSidLen As Long
Dim tempAce As ACE
Dim pACE As Long
fResult = 0
On Error GoTo Label1
'Find the length of SID and size of new ACE to be added
dwSidLen = GetLengthSid(pSid)
dwNewACESize = Len(tempAce) + dwSidLen - 4
'Allocate memory for the new ACE
pACE = LocalAlloc(LPTR, dwNewACESize)
If pACE = 0 Then Err.Raise 0
'Set up the ACE structure in VB variable
tempAce.Header.AceType = AceType
tempAce.Header.AceFlags = AceFlags
tempAce.Header.AceSize = dwNewACESize
tempAce.Mask = AccessMask
'Copy the VB variable contents and the SID to the the ACE allocated
CopyMemory ByVal pACE, VarPtr(tempAce), LenB(tempAce)
CopyMemory ByVal pACE + 8, pSid, dwSidLen
'Add the new ACE to the new ACL
fResult = AddAce(pNewACL, ACL_REVISION, MAXDWORD, pACE, dwNewACESize)
LocalFree pACE
Label1:
ConstructAndAddAce = fResult
End Function
Private Function IsEqual(Accounts() As AccountPerm, pSid As Long) As Boolean
Dim nEntries As Long
Dim nIndex As Long
'Check if the supplied SID pSid matches with one of the new SIDs specified in Accounts()
nEntries = UBound(Accounts)
For nIndex = 0 To nEntries
If (EqualSid(Accounts(nIndex).pSid, pSid)) Then
IsEqual = True
Exit Function
End If
Next
IsEqual = False
End Function
One last thing you may want to consider: It's handy to flash up a message if someone NOT logged in as admin tries to create a shared key. This code checks for the users status.Code:Option Explicit
'http://www.devx.com/vb2themax/Tip/18672
'---------------------------------------
'"Check whether the current user is an administrator"
'Important assumption for this code.
Option Base 0
'Fixed at this size for comfort. Could be bigger or made dynamic.
Private Const ANYSIZE_ARRAY As Long = 100
'Security APIs
Private Const TokenUser = 1
Private Const TokenGroups = 2
Private Const TokenPrivileges = 3
Private Const TokenOwner = 4
Private Const TokenPrimaryGroup = 5
Private Const TokenDefaultDacl = 6
Private Const TokenSource = 7
Private Const TokenType = 8
Private Const TokenImpersonationLevel = 9
Private Const TokenStatistics = 10
'Token Specific Access Rights
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_IMPERSONATE = &H4
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_ADJUST_GROUPS = &H40
Private Const TOKEN_ADJUST_DEFAULT = &H80
'NT well-known SIDs
Private Const SECURITY_DIALUP_RID = &H1
Private Const SECURITY_NETWORK_RID = &H2
Private Const SECURITY_BATCH_RID = &H3
Private Const SECURITY_INTERACTIVE_RID = &H4
Private Const SECURITY_SERVICE_RID = &H6
Private Const SECURITY_ANONYMOUS_LOGON_RID = &H7
Private Const SECURITY_LOGON_IDS_RID = &H5
Private Const SECURITY_LOCAL_SYSTEM_RID = &H12
Private Const SECURITY_NT_NON_UNIQUE = &H15
Private Const SECURITY_BUILTIN_DOMAIN_RID = &H20
'Well-known domain relative sub-authority values (RIDs)
Private Const DOMAIN_ALIAS_RID_ADMINS = &H220
Private Const DOMAIN_ALIAS_RID_USERS = &H221
Private Const DOMAIN_ALIAS_RID_GUESTS = &H222
Private Const DOMAIN_ALIAS_RID_POWER_USERS = &H223
Private Const DOMAIN_ALIAS_RID_ACCOUNT_OPS = &H224
Private Const DOMAIN_ALIAS_RID_SYSTEM_OPS = &H225
Private Const DOMAIN_ALIAS_RID_PRINT_OPS = &H226
Private Const DOMAIN_ALIAS_RID_BACKUP_OPS = &H227
Private Const DOMAIN_ALIAS_RID_REPLICATOR = &H228
Private Const SECURITY_NT_AUTHORITY = &H5
Private Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Private Type TOKEN_GROUPS
GroupCount As Long
Groups(ANYSIZE_ARRAY) As SID_AND_ATTRIBUTES
End Type
Private Type SID_IDENTIFIER_AUTHORITY
Value(0 To 5) As Byte
End Type
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "Advapi32" (ByVal ProcessHandle _
As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function OpenThreadToken Lib "Advapi32" (ByVal ThreadHandle As _
Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, _
TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "Advapi32" (ByVal TokenHandle _
As Long, TokenInformationClass As Integer, TokenInformation As Any, _
ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function AllocateAndInitializeSid Lib "Advapi32" _
(pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As Byte, _
ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, _
ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Function RtlMoveMemory Lib "kernel32" (Dest As Any, _
Source As Any, ByVal lSize As Long) As Long
Private Declare Function IsValidSid Lib "Advapi32" (ByVal pSid As Long) As Long
Private Declare Function EqualSid Lib "Advapi32" (pSid1 As Any, pSid2 As Any) As Long
Private Declare Sub FreeSid Lib "Advapi32" (pSid As Any)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Function IsAdmin() As Boolean
'Returns True if the thread is running in the user context of the local Administrator account.
'Example: MsgBox "Current user is the Administrator: " & IsAdmin
Dim hProcessToken As Long
Dim BufferSize As Long
Dim psidAdmin As Long
Dim lResult As Long
Dim X As Integer
Dim tpTokens As TOKEN_GROUPS
Dim tpSidAuth As SID_IDENTIFIER_AUTHORITY
Dim llRetVal As Long
Dim InfoBuffer() As Long
Dim sids() As SID_AND_ATTRIBUTES
Dim llCount As Long
Dim llIdx As Long
Dim llMax As Long
IsAdmin = False
tpSidAuth.Value(5) = SECURITY_NT_AUTHORITY
'Obtain current process token
If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
Call OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hProcessToken)
End If
If hProcessToken Then
'Deternine the buffer size required
llRetVal = GetTokenInformation(hProcessToken, ByVal TokenGroups, 0, 0, BufferSize)
If BufferSize Then
ReDim InfoBuffer((BufferSize \ 4) - 1) As Long
ReDim sids(0 To tpTokens.GroupCount) As SID_AND_ATTRIBUTES
'Retrieve your token information
lResult = GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize)
If lResult <> 1 Then Exit Function
'Move it from memory into the token structure
Call RtlMoveMemory(tpTokens, InfoBuffer(0), LenB(tpTokens))
'Retreive the admins sid pointer
lResult = AllocateAndInitializeSid(tpSidAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdmin)
If lResult <> 1 Then Exit Function
If IsValidSid(psidAdmin) Then
For X = 0 To tpTokens.GroupCount
'Run through your token sid pointers
If IsValidSid(tpTokens.Groups(X).Sid) Then
'Test for a match between the admin sid equalling your Sid 's
If EqualSid(ByVal tpTokens.Groups(X).Sid, ByVal psidAdmin) Then
IsAdmin = True
Exit For
End If
End If
Next
End If
If psidAdmin Then Call FreeSid(psidAdmin)
End If
Call CloseHandle(hProcessToken)
End If
End Function
You saidQuote:
Originally Posted by chris1990
That's the code I gave you - to loop through the list of usernames.Quote:
I would like to know how to put it through a loop for every user. I have a code to get a list of usernames in to a list box. I just need to know how to loop it.
Just to re-iterate what Al42 said, and clarify my own posts WRT the above code: (the call to "ChangeSubKeyPermissions" is in post #4)
vb Code:
schoolbusdriver
Please could you edit your posts and use the code tags not the vbcode tags. As when copying and pasting the code i have to go through all the code and press enter in places.
By the way i did use it last time, i just need it automated now though. Thanks
Done! (Except for post #9 ;) )Quote:
Originally Posted by chris1990
thanks this works great :), although there is a problem instead of setting permissions it removes the ticks from the allow and deny checkboxes. Will i still be able to read and write to the key.
Take a look at http://msdn2.microsoft.com/en-us/lib...7t(VS.80).aspx
In particular:
May I suggest you change to a ListView control instead ? :) . The page has some VB6 ListView examples you may find useful such as:-Quote:
Checked ListBox
In Visual Basic 6.0, the Style property of a ListBox control determines whether a check box is displayed next to each text item. Multiple items in the ListBox can be selected by selecting the check box beside them even if the MultiSelect property is set to False. There is no way to programmatically determine the checked state of an item; if you required this capability, you have to use a ListView control instead.
Despite the wording, the VB6 example refers to a ListView.Quote:
Code Changes for Determining Checked Items in a CheckedListBox Control