Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003
Private Const HKEY_CURRENT_CONFIG As Long = &H80000005
Private Const OWNER_SECaURITY_INFORMATION As Long = &H1
Private Const SE_REGISTRY_KEY As Long = 4
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_INSUFFICIENT_BUFFER = 122&
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hkey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function GetSecurityInfo Lib "advapi32.dll" _
(ByVal hkey As Long, _
ByVal ObjectType As Long, _
ByVal SecurityInfo As Long, _
ppsidOwner As Long, _
ppsidGroup As Long, _
ppDacl As Long, _
ppSacl As Long, _
ppSecurityDescriptor As Any) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hkey As Long) As Long
Private 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
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Sub Form_Load()
Label1.Caption = ""
Command1.Caption = "Get RegKey Owner"
End Sub
Private Sub Command1_Click()
Dim hkey As Long
Dim regPath As String
Dim ppsidOwner As Long
Dim sRegKeyOwner As String 'the result!
'A few sample reg key paths
'regPath = "SYSTEM\ControlSet001\Services\lanmanworkstation\NetworkProvider"
'hkey = OpenRegKey(HKEY_LOCAL_MACHINE, regPath)
'regPath = "Printers\Settings\Wizard"
'hkey = OpenRegKey(HKEY_CURRENT_USER, regPath)
'regPath = "Software\Fonts"
'hkey = OpenRegKey(HKEY_CURRENT_CONFIG, regPath)
regPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion" 'HKEY_LOCAL_MACHINE
hkey = OpenRegKey(HKEY_LOCAL_MACHINE, regPath)
If hkey <> 0 Then
'get the SID of the owner of the
'specified registry key
sRegKeyOwner = GetRegKeyOwner(hkey)
Call RegCloseKey(hkey)
End If
Label1.Caption = regPath
Text1.Text = sRegKeyOwner
End Sub
Private Function GetRegKeyOwner(hkey As Long) As String
Dim ppsidOwner As Long
Dim ppsidGroup As Long
Dim ppsidDacl As Long
Dim ppsidSacl As Long
Dim ppSecDescriptor As Long
If hkey <> 0 Then
If GetSecurityInfo(hkey, _
SE_REGISTRY_KEY, _
OWNER_SECURITY_INFORMATION, _
ppsidOwner, ppsidGroup, _
ppsidDacl, ppsidSacl, _
ppSecDescriptor) = ERROR_SUCCESS Then
If ppsidOwner <> 0 Then
'convert the SID to the owner. LookupAccountSid
'needs a server passed; if always called on the
'local machine the first parameter can be deleted,
'and the code in GetRegKeyOwnerBySid modified to always
'pass vbNullString as the server variable.
GetRegKeyOwner = GetRegKeyOwnerBySid("", ppsidOwner)
End If 'ppsidOwner
'we're done with the security descriptor,
'so release its memory
LocalFree ppSecDescriptor
End If 'GetSecurityInfo
End If 'hkey
End Function
Private Function GetRegKeyOwnerBySid(ByVal sServer As String, ByVal ppsidOwner As Long) As String
Dim bSuccess As Long
Dim sName As String
Dim cbName As Long
Dim sReferencedDomain As String
Dim cbReferencedDomain As Long
Dim dwUse As Long
If Len(sServer) > 0 Then
sServer = QualifyServer(sServer)
Else
sServer = vbNullString
End If
If (ppsidOwner <> 0) Then
'call LookupAccountSid twice to
'get the name of the account and the
'first domain on which this SID is found;
'the first call gets the correct buffer size,
'the second gets the data
bSuccess = LookupAccountSid(sServer, _
ppsidOwner, _
sName, _
cbName, _
sReferencedDomain, _
cbReferencedDomain, _
dwUse)
If (bSuccess = 0) And _
(Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
'fill buffers and call again
sName = Space$(cbName)
sReferencedDomain = Space$(cbReferencedDomain)
If LookupAccountSid(sServer, _
ppsidOwner, _
sName, _
cbName, _
sReferencedDomain, _
cbReferencedDomain, _
dwUse) = 1 Then
GetRegKeyOwnerBySid = TrimNull(sName)
End If 'LookupAccountSid
End If 'bSuccess
End If 'ppsidOwner
End Function
Private Function OpenRegKey(ByVal hkey As Long, _
ByVal lpSubKey As String) As Long
Dim hSubKey As Long
If RegOpenKeyEx(hkey, _
lpSubKey, _
0, _
KEY_READ, _
hSubKey) = ERROR_SUCCESS Then
OpenRegKey = hSubKey
End If
End Function
Private Function QualifyServer(ByVal sServer As String) As String
'if nullstring was passed, the
'API does not expect slashes in
'the server name
If Len(sServer) > 0 Then
'are already two slashes
'preceding the server name?
If Left$(sServer, 2) = "\\" Then
'return the passed string
QualifyServer = sServer
Else
'there aren't two, but is there one?
If Left$(sServer, 1) = "\" Then
'yes, so add one more
QualifyServer = "\" & sServer
Else
'the string needs both
QualifyServer = "\\" & sServer
End If 'Left$(sServer, 1) <> "\"
End If 'Left$(sServer, 2) = "\\"
Else
'empty string passed, so return it
QualifyServer = sServer
End If 'Len(sServer)
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function
|
Demo
showing how to retrieve the Owner of a specific registry key. 
