API: Return the UserID currently logged on a remote machine

  As shown by the LoggedOn console app, written in C and provided by SysInternals, it's possible to connect to a remote machine's Registry, and enumerate the HKey_Users entries to determine which subtree contains the information about the current user account.

  This code is part of the AppUser utility form which uses the machine name from Jet's LDB file to do a remote lookup on the user id.

AppUser.zip (Access 2000, 67,445 bytes) Please note that these are NT/2000 only API functions.

' ******** Code Start ********
' -----------------------
' The code for retrieving remote user name was
'  translated into VBA from source code provided by
'          SysInternals - www.sysinternals.com
'          Copyright (C) 1999-2000 Mark Russinovich
'  as part of the LoggedOn console app
'
'  Translated by: Dev Ashish
'                          www.mvps.org/access
'
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' -----------------------

Private Declare Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long

Private Declare Function apiFormatMsgLong _
    Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, _
    ByVal lpSource As Long, _
    ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, _
    ByVal lpBuffer As String, _
    ByVal nSize As Long, _
    Arguments As Long) _
    As Long
 
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
 
Private Type SID_IDENTIFIER_AUTHORITY
    Value(5) As Byte
End Type
 
Private Declare Function apiRegConnectRegistry _
    Lib "advapi32.dll" Alias "RegConnectRegistryA" _
    (ByVal lpMachineName As String, _
    ByVal hKey As Long, _
    phkResult As Long) _
    As Long
 
Private Declare Function apiRegEnumKeyEx _
    Lib "advapi32.dll" Alias "RegEnumKeyExA" _
    (ByVal hKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    lpcbName As Long, _
    ByVal lpReserved As Long, _
    ByVal lpClass As String, _
    lpcbClass As Long, _
    lpftLastWriteTime As FILETIME) _
    As Long
 
Private Declare Function apiRegCloseKey _
    Lib "advapi32.dll" Alias "RegCloseKey" _
    (ByVal hKey As Long) _
    As Long
 
Private Declare Function apiAllocateAndInitializeSid _
    Lib "advapi32.dll" Alias "AllocateAndInitializeSid" _
    (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 Any) _
    As Long
 
Private Declare Function apiLookupAccountSid _
    Lib "advapi32.dll" Alias "LookupAccountSidA" _
    (ByVal lpSystemName As String, _
    Sid As Any, _
    ByVal name As String, _
    cbName As Long, _
    ByVal ReferencedDomainName As String, _
    cbReferencedDomainName As Long, _
    peUse As Integer) _
    As Long
 
Private Declare Function apiIsValidSid _
    Lib "advapi32.dll" Alias "IsValidSid" _
    (pSid As Any) _
    As Long
 
Private Declare Sub sapiFreeSid _
    Lib "advapi32.dll" Alias "FreeSid" _
    (pSid As Any)
 
 
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const ERROR_SUCCESS = 0&
Private Const HKEY_USERS = &H80000003
Private Const MAX_PATH = 260
Private Const ERROR_MORE_DATA = 234
Private Const MAX_NAME_STRING = 1024
Private Const SECURITY_NT_AUTHORITY = 5


Function fGetRemoteLoggedUserID(strMachineName As String) As String
'
'  Retrieves the id of the user currently logged into the specified
'  local or remote machine in the format DOMAIN\UserName
'
'  Usage:
'        ?fGetRemoteLoggedUserID("springfield")
'
'  Retrieves the id of the user currently logged into the specified
'  local or remote machine in the format DOMAIN\UserName
'
'  Translated into VBA from source code provided by
'          SysInternals - www.sysinternals.com
'          Copyright (C) 1999-2000 Mark Russinovich
'  as part of the LoggedOn console app
'
'  Translated by: Dev Ashish
'                          www.mvps.org/access
'
Dim hRemoteUser As Long, j As Long
Dim lngRet As Long, i As Long, lngSubKeyNameSize As Long
Dim strSubKeyName As String
Dim alngSubAuthority() As Long, astrTmpSubAuthority() As String
Dim tFT As FILETIME, tAuthority As SID_IDENTIFIER_AUTHORITY
Dim pSid As Long, lngUserNameSize As Long, lngDomainNameSize As Long
Dim lngSubAuthorityCount As Long, intSidType As Integer
Dim strUserName As String, strDomainName As String
Const ERR_GENERIC = vbObjectError + 5555
Const KEY_TO_SKIP_1 = "classes"
Const KEY_TO_SKIP_2 = ".default"
On Error GoTo ErrHandler
 
    lngRet = apiRegConnectRegistry(strMachineName, _
                                                    HKEY_USERS, hRemoteUser)
    If lngRet <> ERROR_SUCCESS Then Err.Raise ERR_GENERIC
 
    For i = 0 To 4
        tAuthority.Value(i) = 0
    Next
    i = 0
 
    lngSubKeyNameSize = MAX_PATH
    strSubKeyName = String$(lngSubKeyNameSize, vbNullChar)
 
    lngRet = apiRegEnumKeyEx(hRemoteUser, _
                                i, strSubKeyName, lngSubKeyNameSize, _
                                0, 0, 0, tFT)
 
    Do While (lngRet = ERROR_SUCCESS Or lngRet = ERROR_MORE_DATA)
        If (InStr(1, strSubKeyName, KEY_TO_SKIP_1, vbTextCompare) = 0 _
                        And InStr(1, strSubKeyName, _
                        KEY_TO_SKIP_2, vbTextCompare) = 0) Then
            strSubKeyName = Left$(strSubKeyName, lngSubKeyNameSize)
            astrTmpSubAuthority = Split(strSubKeyName, "-")
            lngSubAuthorityCount = UBound(astrTmpSubAuthority)
            ReDim alngSubAuthority(lngSubAuthorityCount)
            For j = 3 To lngSubAuthorityCount
                alngSubAuthority(j - 3) = CLng(astrTmpSubAuthority(j))
            Next
            lngSubAuthorityCount = UBound(alngSubAuthority) - 2
 
            With tAuthority
                .Value(5) = SECURITY_NT_AUTHORITY
                .Value(4) = 0
                .Value(3) = 0
                .Value(2) = 0
                .Value(1) = 0
                .Value(0) = 0
            End With
 
            If (apiAllocateAndInitializeSid(tAuthority, _
                                    lngSubAuthorityCount, _
                                    alngSubAuthority(0), _
                                    alngSubAuthority(1), _
                                    alngSubAuthority(2), _
                                    alngSubAuthority(3), _
                                    alngSubAuthority(4), _
                                    alngSubAuthority(5), _
                                    alngSubAuthority(6), _
                                    alngSubAuthority(7), _
                                    pSid)) Then
 
                    If (apiIsValidSid(ByVal pSid)) Then
                        lngUserNameSize = MAX_NAME_STRING
                        lngDomainNameSize = MAX_NAME_STRING
                        strUserName = String$(lngUserNameSize - 1, vbNullChar)
                        strDomainName = String$( _
                                                    lngDomainNameSize - 1, vbNullChar)
                        lngRet = apiLookupAccountSid(strMachineName, _
                                            ByVal pSid, _
                                          strUserName, _
                                          lngUserNameSize, _
                                          strDomainName, _
                                          lngDomainNameSize, _
                                          intSidType)
                        If (lngRet <> 0) Then
                            fGetRemoteLoggedUserID = fTrimNull(strDomainName) _
                                                                & "\" & fTrimNull(strUserName)
                            'Exit Do
                        Else
                            With Err
                                .Raise .LastDllError, _
                                    "fGetRemoteLoggedUserID", _
                                    fAPIErr(.LastDllError)
                            End With
                        End If
                    End If
                End If
                If (pSid) Then Call sapiFreeSid(pSid)
        End If
        i = i + 1
        lngSubKeyNameSize = MAX_PATH
        strSubKeyName = String$(lngSubKeyNameSize, vbNullChar)
        lngRet = apiRegEnumKeyEx(hRemoteUser, _
                                i, strSubKeyName, lngSubKeyNameSize, _
                                0, 0, 0, tFT)
    Loop
 
 
ExitHere:
    If (pSid) Then Call sapiFreeSid(pSid)
    Call apiRegCloseKey(hRemoteUser)
    Exit Function
ErrHandler:
    With Err
        If .Number <> ERR_GENERIC Then
            MsgBox "Error: " & .Number & vbCrLf & .Description, _
                vbCritical Or vbOKOnly, .Source
        End If
    End With
    Resume ExitHere
End Function

Private Function fAPIErr(ByVal lngErr As Long) As String
'Original Idea obtained from
'Hardcode Visual Basic 5
'by Bruce McKinney
'
Dim strMsg As String
Dim lngRet As Long
    strMsg = String$(1024, 0)
    lngRet = apiFormatMsgLong( _
                    FORMAT_MESSAGE_FROM_SYSTEM, 0&, _
                    lngErr, 0&, strMsg, Len(strMsg), ByVal 0&)
    If lngRet Then
        fAPIErr = Left$(strMsg, lngRet)
    End If
End Function

Private Function fTrimNull(strIn As String) As String
Dim intPos As Integer
    intPos = InStr(1, strIn, vbNullChar)
    If intPos Then
        fTrimNull = Mid$(strIn, 1, intPos - 1)
    Else
        fTrimNull = strIn
    End If
End Function
' ******** Code End ********