469,271 Members | 1,270 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,271 developers. It's quick & easy.

Get actual logged on username

374 256MB
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.
Nov 16 '10 #1
5 9842
ADezii
8,800 Expert 8TB
Are you using Active Directory?
Nov 16 '10 #2
munkee
374 256MB
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:

Expand|Select|Wrap|Line Numbers
  1. Sub ADSI_demo()
  2.     Dim domainName As String, userName As String
  3.     Dim ADSuser As ActiveDs.IADsUser
  4.  
  5.  
  6.     'domainName = InputBox("Domain:", "ADSI Demo")
  7.     domainName = Environ("userdomain")
  8.  
  9.     If domainName = "" Then Exit Sub
  10.    ' userName = InputBox("User login:", "ADSI Demo")
  11.    'userName = "mobbe00c"
  12.    userName = Environ("username")
  13.     If userName = "" Then Exit Sub
  14.  
  15.  
  16.     On Error GoTo noData
  17.     Set ADSuser = GetObject("WinNT://" & domainName & "/" & userName)
  18.     Debug.Print ADSuser.FullName
  19.  
  20.  
  21.     Set ADSuser = Nothing
  22.     Exit Sub
  23.  
  24.  
  25. noData:
  26.     MsgBox Err.Number & vbCr & Err.Description
  27. 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.
Nov 17 '10 #3
munkee
374 256MB
After A LOT of searching I have found it! Some code from VB.net that has been converted to VBA.. lovely =]

Expand|Select|Wrap|Line Numbers
  1. ' ******** Code Start ********
  2. ' -----------------------
  3. ' The code for retrieving remote user name was
  4. ' translated into VBA from source code provided by
  5. ' SysInternals - www.sysinternals.com
  6. ' Copyright (C) 1999-2000 Mark Russinovich
  7. ' as part of the LoggedOn console app
  8. '
  9. ' Translated by: Dev Ashish
  10. ' www.mvps.org/access
  11. '
  12. ' This code was originally written by Dev Ashish.
  13. ' It is not to be altered or distributed,
  14. ' except as part of an application.
  15. ' You are free to use it in any application,
  16. ' provided the copyright notice is left unchanged.
  17. '
  18. ' Modified version 2003-26-03 by Andreas Schubert
  19. '   See description of fGetRemoteLoggedUserID function for details
  20. ' -----------------------
  21.  
  22. Private Declare Function apiNetAPIBufferFree _
  23.         Lib "netapi32.dll" Alias "NetApiBufferFree" _
  24.         (ByVal buffer As Long) _
  25.         As Long
  26.  
  27. Private Declare Function apiFormatMsgLong _
  28.         Lib "kernel32" Alias "FormatMessageA" _
  29.         (ByVal dwFlags As Long, _
  30.          ByVal lpSource As Long, _
  31.          ByVal dwMessageId As Long, _
  32.          ByVal dwLanguageId As Long, _
  33.          ByVal lpBuffer As String, _
  34.          ByVal nSize As Long, _
  35.          Arguments As Long) _
  36.          As Long
  37.  
  38. Private Type FILETIME
  39.     dwLowDateTime As Long
  40.     dwHighDateTime As Long
  41. End Type
  42.  
  43. Private Type SID_IDENTIFIER_AUTHORITY
  44.     Value(5) As Byte
  45. End Type
  46.  
  47. Private Declare Function apiRegConnectRegistry _
  48.         Lib "advapi32.dll" Alias "RegConnectRegistryA" _
  49.         (ByVal lpMachineName As String, _
  50.          ByVal hKey As Long, _
  51.          phkResult As Long) _
  52.          As Long
  53.  
  54. Private Declare Function apiRegEnumKeyEx _
  55.         Lib "advapi32.dll" Alias "RegEnumKeyExA" _
  56.         (ByVal hKey As Long, _
  57.          ByVal dwIndex As Long, _
  58.          ByVal lpName As String, _
  59.          lpcbName As Long, _
  60.          ByVal lpReserved As Long, _
  61.          ByVal lpClass As String, _
  62.          lpcbClass As Long, _
  63.          lpftLastWriteTime As FILETIME) _
  64.          As Long
  65.  
  66. Private Declare Function apiRegCloseKey _
  67.         Lib "advapi32.dll" Alias "RegCloseKey" _
  68.         (ByVal hKey As Long) _
  69.         As Long
  70.  
  71. Private Declare Function apiAllocateAndInitializeSid _
  72.         Lib "advapi32.dll" Alias "AllocateAndInitializeSid" _
  73.         (pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
  74.          ByVal nSubAuthorityCount As Byte, _
  75.          ByVal nSubAuthority0 As Long, _
  76.          ByVal nSubAuthority1 As Long, _
  77.          ByVal nSubAuthority2 As Long, _
  78.          ByVal nSubAuthority3 As Long, _
  79.          ByVal nSubAuthority4 As Long, _
  80.          ByVal nSubAuthority5 As Long, _
  81.          ByVal nSubAuthority6 As Long, _
  82.          ByVal nSubAuthority7 As Long, _
  83.          lpPSid As Any) _
  84.          As Long
  85.  
  86. Private Declare Function apiLookupAccountSid _
  87.         Lib "advapi32.dll" Alias "LookupAccountSidA" _
  88.         (ByVal lpSystemName As String, _
  89.          Sid As Any, _
  90.          ByVal name As String, _
  91.          cbName As Long, _
  92.          ByVal ReferencedDomainName As String, _
  93.          cbReferencedDomainName As Long, _
  94.          peUse As Integer) _
  95.          As Long
  96.  
  97. Private Declare Function apiIsValidSid _
  98.         Lib "advapi32.dll" Alias "IsValidSid" _
  99.         (pSid As Any) _
  100.         As Long
  101.  
  102. Private Declare Sub sapiFreeSid _
  103.         Lib "advapi32.dll" Alias "FreeSid" _
  104.                                         (pSid As Any)
  105.  
  106.  
  107. Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
  108. Private Const ERROR_SUCCESS = 0&
  109. Private Const HKEY_USERS = &H80000003
  110. Private Const MAX_PATH = 260
  111. Private Const ERROR_MORE_DATA = 234
  112. Private Const MAX_NAME_STRING = 1024
  113. Private Const SECURITY_NT_AUTHORITY = 5
  114.  
  115.  
  116. Function fGetRemoteLoggedUserID(strMachineName As String) As String
  117. '
  118. ' Retrieves the id of the user currently logged into the specified
  119. ' local or remote machine in the format DOMAIN\UserName
  120. '
  121. ' Usage:
  122. ' ?fGetRemoteLoggedUserID("springfield")
  123. '
  124. ' Retrieves the id of the user currently logged into the specified
  125. ' local or remote machine in the format DOMAIN\UserName
  126. '
  127. ' Translated into VBA from source code provided by
  128. ' SysInternals - www.sysinternals.com
  129. ' Copyright (C) 1999-2000 Mark Russinovich
  130. ' as part of the LoggedOn console app
  131. '
  132. ' Translated by: Dev Ashish
  133. ' www.mvps.org/access
  134. ' dev@mvps.org
  135. '
  136. '
  137. ' modified 2003-26-03 by: Andreas Schubert
  138. ' usenet@andreas-schubert.net
  139. ' eliminated a view bugs:
  140. ' 1. converting the registry subkey to SubAuthorities sometimes caused an
  141. '       overflow error because of the difference between C's DWORD and VB's Long.
  142. '       so I first convert them to a double and if it exceeds 2147483647,
  143. '       I substract 4294967296 and then convert it to long
  144. '       For j = 3 To lngSubAuthorityCount
  145. '           adblTemp = 0
  146. '           adblTemp = CDbl(astrTmpSubAuthority(j))
  147. '           If adblTemp > 2147483647 Then
  148. '               adblTemp = adblTemp - 4294967296#
  149. '           End If
  150. '           alngSubAuthority(j - 3) = CLng(adblTemp)
  151. '       Next
  152. '
  153. ' 2. sometimes a subkey won't consist of 7 parts. If so, the function
  154. '           crashed with an Index error.
  155. '           Solving this was pretty easy by inserting
  156. '       If UBound(alngSubAuthority) < 7 Then ReDim Preserve alngSubAuthority(7)
  157. '
  158. ' 3. It is possible that the function finds more than 1 active user
  159. '       at the remote workstation. This may for instance be the cause
  160. '       if you are running an Microsoft SMS Server in your network.
  161. '       The SMS client will run under an local account on your machine
  162. '       (like \Computername\SMSCliSvsAcct)
  163. '       So, I modified the function to get all accounts separated by vbcrlf - character(s)
  164. '
  165.  
  166.     Dim hRemoteUser As Long, j As Long
  167.     Dim lngRet As Long, i As Long, lngSubKeyNameSize As Long
  168.     Dim strSubKeyName As String
  169.     Dim alngSubAuthority() As Long, astrTmpSubAuthority() As String
  170.     Dim tFT As FILETIME, tAuthority As SID_IDENTIFIER_AUTHORITY
  171.     Dim pSid As Long, lngUserNameSize As Long, lngDomainNameSize As Long
  172.     Dim lngSubAuthorityCount As Long, intSidType As Integer
  173.     Dim strUserName As String, strDomainName As String
  174.  
  175.     Dim adblTemp As Double
  176.     Const ERR_GENERIC = vbObjectError + 5555
  177.     Const KEY_TO_SKIP_1 = "classes"
  178.     Const KEY_TO_SKIP_2 = ".default"
  179.     On Error GoTo ErrHandler
  180.  
  181.     lngRet = apiRegConnectRegistry(strMachineName, _
  182.                                    HKEY_USERS, hRemoteUser)
  183.     If lngRet <> ERROR_SUCCESS Then Err.Raise ERR_GENERIC
  184.  
  185.  
  186.     For i = 0 To 4
  187.         tAuthority.Value(i) = 0
  188.     Next
  189.     i = 0
  190.  
  191.     lngSubKeyNameSize = MAX_PATH
  192.     strSubKeyName = String$(lngSubKeyNameSize, vbNullChar)
  193.  
  194.     lngRet = apiRegEnumKeyEx(hRemoteUser, _
  195.                              i, strSubKeyName, lngSubKeyNameSize, _
  196.                              0, 0, 0, tFT)
  197.  
  198.     Do While (lngRet = ERROR_SUCCESS Or lngRet = ERROR_MORE_DATA)
  199.         If (InStr(1, strSubKeyName, KEY_TO_SKIP_1, vbTextCompare) = 0 _
  200.             And InStr(1, strSubKeyName, _
  201.             KEY_TO_SKIP_2, vbTextCompare) = 0) Then
  202.             strSubKeyName = Left$(strSubKeyName, lngSubKeyNameSize)
  203.             astrTmpSubAuthority = Split(strSubKeyName, "-")
  204.             lngSubAuthorityCount = UBound(astrTmpSubAuthority)
  205.             ReDim alngSubAuthority(lngSubAuthorityCount)
  206.             For j = 3 To lngSubAuthorityCount
  207.                 adblTemp = 0
  208.                 adblTemp = CDbl(astrTmpSubAuthority(j))
  209.                 If adblTemp > 2147483647 Then
  210.                     adblTemp = adblTemp - 4294967296#
  211.                 End If
  212.                 alngSubAuthority(j - 3) = CLng(adblTemp)
  213.             Next
  214.             lngSubAuthorityCount = UBound(alngSubAuthority) - 2
  215.             If UBound(alngSubAuthority) < 7 Then ReDim Preserve alngSubAuthority(7)
  216.             With tAuthority
  217.                 .Value(5) = SECURITY_NT_AUTHORITY
  218.                 .Value(4) = 0
  219.                 .Value(3) = 0
  220.                 .Value(2) = 0
  221.                 .Value(1) = 0
  222.                 .Value(0) = 0
  223.             End With
  224.  
  225.             If (apiAllocateAndInitializeSid(tAuthority, _
  226.                 lngSubAuthorityCount, _
  227.                 alngSubAuthority(0), _
  228.                 alngSubAuthority(1), _
  229.                 alngSubAuthority(2), _
  230.                 alngSubAuthority(3), _
  231.                 alngSubAuthority(4), _
  232.                 alngSubAuthority(5), _
  233.                 alngSubAuthority(6), _
  234.                 alngSubAuthority(7), _
  235.                 pSid)) Then
  236.  
  237.                 If (apiIsValidSid(ByVal pSid)) Then
  238.                     lngUserNameSize = MAX_NAME_STRING
  239.                     lngDomainNameSize = MAX_NAME_STRING
  240.                     strUserName = String$(lngUserNameSize - 1, vbNullChar)
  241.                     strDomainName = String$( _
  242.                                             lngDomainNameSize - 1, vbNullChar)
  243.                     lngRet = apiLookupAccountSid(strMachineName, _
  244.                                                  ByVal pSid, _
  245.                                                  strUserName, _
  246.                                                  lngUserNameSize, _
  247.                                                  strDomainName, _
  248.                                                  lngDomainNameSize, _
  249.                                                  intSidType)
  250.                     If (lngRet <> 0) Then
  251.                         fGetRemoteLoggedUserID = fGetRemoteLoggedUserID & fTrimNull(strDomainName) _
  252.                                                & "\" & fTrimNull(strUserName) & vbCrLf
  253.                         'Exit Do
  254.                     Else
  255.                         With Err
  256.                             .Raise .LastDllError, _
  257.                                    "fGetRemoteLoggedUserID", _
  258.                                    fAPIErr(.LastDllError)
  259.                         End With
  260.                     End If
  261.                 End If
  262.             End If
  263.             If (pSid) Then Call sapiFreeSid(pSid)
  264.         End If
  265.         i = i + 1
  266.         lngSubKeyNameSize = MAX_PATH
  267.         strSubKeyName = String$(lngSubKeyNameSize, vbNullChar)
  268.         lngRet = apiRegEnumKeyEx(hRemoteUser, _
  269.                                  i, strSubKeyName, lngSubKeyNameSize, _
  270.                                  0, 0, 0, tFT)
  271.     Loop
  272.  
  273.  
  274. ExitHere:
  275.     If (pSid) Then Call sapiFreeSid(pSid)
  276.     Call apiRegCloseKey(hRemoteUser)
  277.     Exit Function
  278. ErrHandler:
  279.     With Err
  280.         If .Number <> ERR_GENERIC Then
  281.             MsgBox "Error: " & .Number & vbCrLf & .Description, _
  282.                    vbCritical Or vbOKOnly, .Source
  283.         End If
  284.     End With
  285.     Resume ExitHere
  286. End Function
  287.  
  288. Private Function fAPIErr(ByVal lngErr As Long) As String
  289. 'Original Idea obtained from
  290. 'Hardcode Visual Basic 5
  291. 'by Bruce McKinney
  292. '
  293.     Dim strMsg As String
  294.     Dim lngRet As Long
  295.     strMsg = String$(1024, 0)
  296.     lngRet = apiFormatMsgLong( _
  297.                               FORMAT_MESSAGE_FROM_SYSTEM, 0&, _
  298.                               lngErr, 0&, strMsg, Len(strMsg), ByVal 0&)
  299.     If lngRet Then
  300.         fAPIErr = Left$(strMsg, lngRet)
  301.     End If
  302. End Function
  303.  
  304. Private Function fTrimNull(strIn As String) As String
  305.     Dim intPos As Integer
  306.     intPos = InStr(1, strIn, vbNullChar)
  307.     If intPos Then
  308.         fTrimNull = Mid$(strIn, 1, intPos - 1)
  309.     Else
  310.         fTrimNull = strIn
  311.     End If
  312. End Function
  313. ' ******** Code End ********
  314.  
  315.  
  316.  
  317.  
  318.  
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 =]
Nov 17 '10 #4
ADezii
8,800 Expert 8TB
Here is some additional info that you can easily retrieve using Active Directory. Many Declarations have been intentionally omitted.:
Expand|Select|Wrap|Line Numbers
  1. Dim sysInfo As Object
  2. Dim oUser As Object
  3. Dim oPath As Object         'Path Class in the ActiveDs Library
  4.  
  5. Set sysInfo = CreateObject("ADSystemInfo")
  6. Set oPath = CreateObject("Path")    'Create a Path Object
  7. Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")
  8.  
  9. "Computer Name: " & sysInfo.ComputerName
  10. "Site Name: " & sysInfo.SiteName
  11. "Domain DNS Name: " & sysInfo.DomainDNSName
  12.  
  13. 'Retrieve Properties of the Path Object
  14. "Path: " & oPath.Path
  15. "Type: " & oPath.Type
  16. "Volume Name: " & oPath.VolumeName
  17.  
  18. '###### Active Directory variables ######
  19. strName = oUser.Get("givenName") '###### Users Christian Name ######
  20. strSurname = oUser.Get("sn") '###### Users Surname ######
  21. strInitials = oUser.Get("initials") '###### Users Initials ######
  22. DisplayName = oUser.Get("displayName") '###### Full Display Name ######
  23. strAddress = oUser.Get("StreetAddress") '###### Address Information ######
  24. strRoom = oUser.Get("PhysicalDeliveryOfficeName") '###### Room/Area Information ######
  25. secretary = oUser.Get("secretary") '###### Secrectary/Assistant ######
  26. strTitle = oUser.Get("title") '###### Job Title ######
  27. strTelephone = oUser.Get("telephoneNumber") '###### Official Intneral Telephone Number ######
  28. strFax = oUser.Get("facsimileTelephoneNumber") '###### Fax Number ######
  29. mobile = oUser.Get("mobile") '###### Mobile Number ######
  30. telephoneAssistant = oUser.Get("telephoneAssistant") '###### Telephone Assistant ######
  31. strDepartment = oUser.Get("department") '###### Department ######
  32. strCC = oUser.Get("ExtensionAttribute1") '###### COST Centre ######
  33. strBuilding = oUser.Get("ExtensionAttribute2") '###### Building ######
  34. strDivision = oUser.Get("ExtensionAttribute3") '###### Division ######
  35. strBranch = oUser.Get("ExtensionAttribute4") '###### Branch ######
  36. ExtensionAttribute5 = oUser.Get("ExtensionAttribute5") '###### PC Item Number ######
  37. ExtensionAttribute6 = oUser.Get("ExtensionAttribute6") '###### External Telephone Number ######
  38. strGroup = oUser.Get("ExtensionAttribute7") '###### Group ######
  39. othertelephone = oUser.Get("othertelephone") '###### GTN Telephone Number ######
  40. samaccountname = oUser.Get("samaccountname") '###### User ID ######
  41. ADsPath = oUser.Get("adspath") '###### Pathway to AD? ######
  42. strFullName = oUser.Get("cn") '###### Full Display Name ######
  43. strMail = oUser.Get("mail") '###### E-Mail Address ######
  44. strManager = oUser.Get("manager")
Nov 17 '10 #5
munkee
374 256MB
Ignore, Got it now
Nov 17 '10 #6

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

4 posts views Thread by 1qa2ws | last post: by
14 posts views Thread by Brent Burkart | last post: by
6 posts views Thread by John Dalberg | last post: by
11 posts views Thread by Alan Silver | last post: by
reply views Thread by Smokey Grindle | last post: by
reply views Thread by suresh191 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.