Option Explicit
'
' APIs needed to manipulate the RAW SID
'
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

Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid 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 Integer) As Long

Private Declare Function InitializeSid Lib "advapi32.dll" _
(ByVal Sid As Long, ByVal pIndentifierAuthority As Long, _
ByVal nSubAuthorityCount As Byte) As Long

Private Declare Function GetSidSubAuthority Lib "advapi32.dll" _
(ByVal Sid As Long, ByVal nSubAuthority As Long) As Long

Private Declare Function GetSidSubAuthorityCount Lib "advapi32.dll" _
(ByVal Sid As Long) As Long

Private Declare Function GetSidIdentifierAuthority Lib "advapi32.dll" _
(ByVal Sid As Long) As Long

Private Declare Function GetSidLengthRequired Lib "advapi32.dll" _
(ByVal nSubAuthorityCount As Byte) As Long

'
' APIs needed to manipulate pointers in VB
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Declare Sub CopyDWORDFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal hpvDest As Long, ByVal hpvSource As Long, _
ByVal cbCopy As Long)

Private Declare Sub CopyDWORD Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal hpvDest As Long, hpvSource As Long, ByVal cbCopy As Long)

Private Declare Function GetProcessHeap Lib "kernel32" <
font color="#000000">() As Long

Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, ByVal lpMem As Long) As Long

'
' APIs, structures, and constants necessary to obtain the domain SID
'
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long

Private Declare Function NetUserModalsGet Lib "netapi32" _
(ByVal serverName As Long, ByVal level As Long, _
BufPtr As Long) As Long

Type USER_MODALS_INFO_2
usrmod2_domain_name As Long
usrmod2_domain_id As Long
End Type

Public Const NERR_Success = 0

'
' Constants from WINNT.H for the various well-known SIDs, users and groups
'
Public Const SECURITY_WORLD_SID_AUTHORITY = &H1
Public Const SECURITY_NT_AUTHORITY = &H5

Public Const SECURITY_BUILTIN_DOMAIN_RID = &H20&
Public Const DOMAIN_ALIAS_RID_ADMINS = &H220&
Public Const DOMAIN_ALIAS_RID_USERS = &H221&
Public Const SECURITY_LOCAL_SYSTEM_RID = &H12
Public Const SECURITY_WORLD_RID = &H0

Public Const DOMAIN_USER_RID_ADMIN = &H1F4
Public Const DOMAIN_USER_RID_GUEST = &H1F5

Public Const DOMAIN_GROUP_RID_ADMINS = &H200

Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type

'
' Helper function to lookup a SID and display the name as a test
'
Public Sub DisplayNameOfSid(ByVal lSid As Long)

Dim result As Long
Dim userName As String
Dim cbUserName As Long
Dim domainName As String
Dim cbDomainName As Long
Dim peUse As Integer

' Lookup the constructed SID to get the name
userName = Space(255)
domainName = Space(255)
cbUserName = 255
cbDomainName = 255
result = LookupAccountSid(vbNullString, lSid, userName, cbUserName, _
domainName, cbDomainName, peUse)

If result <> 0 Then
MsgBox userName
End If

End Sub

Public Function GetWellKnownUserSIDFromRID(ByVal Rid As Long) As Long

Dim userInfo As USER_MODALS_INFO_2
Dim wszServerName() As Byte
Dim BufPtr As Long
Dim result As Long
Dim pSid As Long
Dim Index, Count As Long
Dim SubAuthorityCount As Byte
Dim domainName As String
Dim cbDomainName As Long
Dim peUse As Integer
Dim srcPtr As Long
Dim dstPtr As Long

GetWellKnownUserSIDFromRID = 0

' Get the SID of the local machine
result = NetUserModalsGet(ByVal 0&, 2 ont>, BufPtr)
If result <> NERR_Success Then
GetWellKnownUserSIDFromRID = 0
Exit Function
End If

' Copy the data in the buffer into USER_MODALS_INFO_2 structure
CopyMemory userInfo, BufPtr, Len(userInfo)

' Allocate storage for the new Sid: account domain Sid + account Rid
CopyMemory SubAuthorityCount, _
GetSidSubAuthorityCount(userInfo.usrmod2_domain_id), 1
Count = SubAuthorityCount
pSid = HeapAlloc(GetProcessHeap(), 0, _
GetSidLengthRequired(SubAuthorityCount + 1))

If pSid <> 0 Then

If InitializeSid(pSid, _
GetSidIdentifierAuthority(userInfo.usrmod2_domain_id), _
SubAuthorityCount + 1) <> 0 Then

' Copy the existing subauthorities from the account domain Sid
' into the new Sid
For Index = 0 To Count - 1
dstPtr = GetSidSubAuthority(pSid, Index)
srcPtr = GetSidSubAuthority(userInfo.usrmod2_domain_id, Index)
CopyDWORDFromPtr dstPtr, srcPtr, 4
Next Index

' append Rid to new Sid
dstPtr = GetSidSubAuthority(pSid, Index)
CopyDWORD dstPtr, Rid, 4

End If

End If

NetApiBufferFree BufPtr

GetWellKnownUserSIDFromRID = pSid

End Function

Public Sub ConstructWellKnownUserSids()

Dim lSid As Long

' Construct SID for Well-known user "Administrator"
lSid = GetWellKnownUserSIDFromRID(DOMAIN_USER_RID_ADMIN)
If lSid <> 0 Then

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the heap memory block allocated in
' GetWellKnownUserSIDFromRID function for the SID
HeapFree GetProcessHeap(), 0, lSid

End If

' Construct SID for Well-known user "Guest"
lSid = GetWellKnownUserSIDFromRID(DOMAIN_USER_RID_GUEST)
If lSid <> 0 Then

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the heap memory block allocated in
' GetWellKnownUserSIDFromRID VB function for the SID
HeapFree GetProcessHeap(), 0, lSid

End If

End Sub

Public Sub ConstructUniversalAndNTWellKnownSids()

Dim result As Long
Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
Dim lSid As Long

' Construct SID for System "NT well-known SID"
siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 1, _
SECURITY_LOCAL_SYSTEM_RID, 0, 0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

' Construct SID for Everyone "Universal well-known SID"
siaNtAuthority.Value(5) = SECURITY_WORLD_SID_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 1, _
SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

' Construct SID for Administrators "Well-known group"
siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 2, _
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, _
0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application

DisplayNameOfSid (lSid)

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

' Construct SID for Users "Well-known group"
siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 2, _
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS, _
0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

End Sub