Get actual logged on username

[munkee]

Hi all,

Basically I understand the usage of Enviro("username") etc to return the username of someone logged in to my databased, or infact the computer.

However I did have some code I picked up which I have now lost which returned the real name of the person associated with the username.

For example I have a username of mobbe003 on my network however my full name was obtainable, which for reference is shown on the start menu of my xp machine at the very top.

Does anyone have code to return the actual name? As I said, I know this is possible as I did have it at one point.

[ADezii]

Are you using Active Directory?

[munkee]

Thanks for the reply! I did some searching based on the activedirectory comment you made and came up with some code which I have messed around with to return what I need:

Sub ADSI_demo()
    Dim domainName As String, userName As String
    Dim ADSuser As ActiveDs.IADsUser
 
 
    'domainName = InputBox("Domain:", "ADSI Demo")
    domainName = Environ("userdomain")
 
    If domainName = "" Then Exit Sub
   ' userName = InputBox("User login:", "ADSI Demo")
   'userName = "mobbe00c"
   userName = Environ("username")
    If userName = "" Then Exit Sub
 
 
    On Error GoTo noData
    Set ADSuser = GetObject("WinNT://" & domainName & "/" & userName)
    Debug.Print ADSuser.FullName
 
 
    Set ADSuser = Nothing
    Exit Sub
 
 
noData:
    MsgBox Err.Number & vbCr & Err.Description
End Sub

This seems quite useful as I am now able to query anything from the directory as long as I can capture the domain and username.

Do you know if there is a method to lookup who is logged in to a computer based on their computername? I am trying to get some real functionality in to my ldb viewer whilst I am not using the built in access security (every username shows as Admin).

I can capture computernames/logged in names etc using my custom security but I want to basically synchronize my ldb viewer with built in security. If there is not a matching computer name to match the two together (e.g. someone has opened the back end directly without logging in) I want to do a reverse lookup of computer names to find out the user.

[munkee]

After A LOT of searching I have found it! Some code from VB.net that has been converted to VBA.. lovely =]

' ******** 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.
'
' Modified version 2003-26-03 by Andreas Schubert
'   See description of fGetRemoteLoggedUserID function for details
' -----------------------
 
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
' [e-mail]
'
'
' modified 2003-26-03 by: Andreas Schubert
' [e-mail]
' eliminated a view bugs:
' 1. converting the registry subkey to SubAuthorities sometimes caused an
'       overflow error because of the difference between C's DWORD and VB's Long.
'       so I first convert them to a double and if it exceeds 2147483647,
'       I substract 4294967296 and then convert it to long
'       For j = 3 To lngSubAuthorityCount
'           adblTemp = 0
'           adblTemp = CDbl(astrTmpSubAuthority(j))
'           If adblTemp > 2147483647 Then
'               adblTemp = adblTemp - 4294967296#
'           End If
'           alngSubAuthority(j - 3) = CLng(adblTemp)
'       Next
'
' 2. sometimes a subkey won't consist of 7 parts. If so, the function
'           crashed with an Index error.
'           Solving this was pretty easy by inserting
'       If UBound(alngSubAuthority) < 7 Then ReDim Preserve alngSubAuthority(7)
'
' 3. It is possible that the function finds more than 1 active user
'       at the remote workstation. This may for instance be the cause
'       if you are running an Microsoft SMS Server in your network.
'       The SMS client will run under an local account on your machine
'       (like \Computername\SMSCliSvsAcct)
'       So, I modified the function to get all accounts separated by vbcrlf - character(s)
'
 
    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
 
    Dim adblTemp As Double
    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
                adblTemp = 0
                adblTemp = CDbl(astrTmpSubAuthority(j))
                If adblTemp > 2147483647 Then
                    adblTemp = adblTemp - 4294967296#
                End If
                alngSubAuthority(j - 3) = CLng(adblTemp)
            Next
            lngSubAuthorityCount = UBound(alngSubAuthority) - 2
            If UBound(alngSubAuthority) < 7 Then ReDim Preserve alngSubAuthority(7)
            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 = fGetRemoteLoggedUserID & fTrimNull(strDomainName) _
                                               & "\" & fTrimNull(strUserName) & vbCrLf
                        '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 ********
 
 
 
 
 

For anyone else that has been searching to retrieve the username of the person logged in via their computer name you can use the above code.

I will be using this within my database to find out usernames from computernames within my .ldb (based on the fact I am not using inbuilt access security and I also have some users connecting from the internet)

Once I have the user name I will use the code I posted above this set to lookup the username within the ActiveDirectory to get the real name of the person.

Perfect LDB monitoring in my books =]

[ADezii]

Here is some additional info that you can easily retrieve using Active Directory. Many Declarations have been intentionally omitted.:

Dim sysInfo As Object
Dim oUser As Object
Dim oPath As Object         'Path Class in the ActiveDs Library
 
Set sysInfo = CreateObject("ADSystemInfo")
Set oPath = CreateObject("Path")    'Create a Path Object
Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")
 
"Computer Name: " & sysInfo.ComputerName
"Site Name: " & sysInfo.SiteName
"Domain DNS Name: " & sysInfo.DomainDNSName
 
'Retrieve Properties of the Path Object
"Path: " & oPath.Path
"Type: " & oPath.Type
"Volume Name: " & oPath.VolumeName
 
'###### Active Directory variables ######
strName = oUser.Get("givenName") '###### Users Christian Name ######
strSurname = oUser.Get("sn") '###### Users Surname ######
strInitials = oUser.Get("initials") '###### Users Initials ######
DisplayName = oUser.Get("displayName") '###### Full Display Name ######
strAddress = oUser.Get("StreetAddress") '###### Address Information ######
strRoom = oUser.Get("PhysicalDeliveryOfficeName") '###### Room/Area Information ######
secretary = oUser.Get("secretary") '###### Secrectary/Assistant ######
strTitle = oUser.Get("title") '###### Job Title ######
strTelephone = oUser.Get("telephoneNumber") '###### Official Intneral Telephone Number ######
strFax = oUser.Get("facsimileTelephoneNumber") '###### Fax Number ######
mobile = oUser.Get("mobile") '###### Mobile Number ######
telephoneAssistant = oUser.Get("telephoneAssistant") '###### Telephone Assistant ######
strDepartment = oUser.Get("department") '###### Department ######
strCC = oUser.Get("ExtensionAttribute1") '###### COST Centre ######
strBuilding = oUser.Get("ExtensionAttribute2") '###### Building ######
strDivision = oUser.Get("ExtensionAttribute3") '###### Division ######
strBranch = oUser.Get("ExtensionAttribute4") '###### Branch ######
ExtensionAttribute5 = oUser.Get("ExtensionAttribute5") '###### PC Item Number ######
ExtensionAttribute6 = oUser.Get("ExtensionAttribute6") '###### External Telephone Number ######
strGroup = oUser.Get("ExtensionAttribute7") '###### Group ######
othertelephone = oUser.Get("othertelephone") '###### GTN Telephone Number ######
samaccountname = oUser.Get("samaccountname") '###### User ID ######
ADsPath = oUser.Get("adspath") '###### Pathway to AD? ######
strFullName = oUser.Get("cn") '###### Full Display Name ######
strMail = oUser.Get("mail") '###### E-Mail Address ######
strManager = oUser.Get("manager")

[munkee]

Ignore, Got it now