Getting the Users Name from the UserName

[alforjj]

I know how to get the UserName using the ENVIRON("USERNAME") command. In WinXP and Win2K, if you press Ctrl-Alt-Del, you can see the users full name as well as his UserName. Is there any way to capture this information?

Thanks.

 

[EBGreen]

I believe that is from Active Directory. You would need to get it from there.

 

[alforjj]

How do I do that in VBA?

 

[EBGreen]

Search the web for information on Active Directory Scripting.

 

[strongm]

You can also use the NetUserGetInfo API call

 

[fumei]

Using the API call is probably better. In fact you could do logic to compare the API name (essentially the name of the username used to login to the session), as opposed to the name of the username of the application.
Maybe you care - maybe you don't, but you
could get both.



Gerry

 

[alforjj]

I found it! It is remarkably simple. I thought it would involved complicated API calls, but it doesn't. You simply need to know the RDN of the Users in your domains' AD. They you make a GetObject call.

Here is the code I used.


Option Explicit

Dim oOU, strContainer, strUser, strFirst, strSur
Dim strUsername

strUsername = ENVIRON("UserName")

strContainer = "LDAP://CN=" & strUsername & ",_
OU=User Accounts,OU=Administration,_
OU=United States,DC=companyname,DC=net"

Set oOU = GetObject(strContainer)

strFirst = oOU.givenname
strSur = oOU.sn

strUser = strFirst & " " & strSur

Yea, I know, doing an API call to get the user name is better. But were locked down here (and our users aren't that computer savy) so it works for me.

Instead of using .givenname (to get first name) or .sn (to get the last name) you can use .displayname and it will return exactly what Windows will show when you hit Ctrl-Alt-Del.

Thanks for everyone's help!

 

[krinid]

1)
Anyone have an example of using the NetUserGetInfo API call?

2)
The above code gave me an error on the Set oOU = GetObject(strContainer) line - could this be a difference in my company's network that doesn't allow this information to be retrieved?

 

[strongm]

1) Sure. Something like:

[COLOR=blue]
Option Explicit

' Utility function declares
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long

Private Declare Function NetUserGetInfo Lib "Netapi32.dll" (lpServer As Any, Username As Byte, ByVal Level As Long, lpBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long

' Declaration up to USER_INFO_3 here,
' but we are only using up to USER_INFO_2
Private Type USER_INFO_2
   ' Level 0 starts here
   Name As Long
   ' Level 1 starts here
   Password As Long
   PasswordAge As Long
   Privilege As Long
   HomeDir As Long
   Comment As Long
   Flags As Long
   ScriptPath As Long
   ' Level 2 starts here
   AuthFlags As Long
   FullName As Long
   UserComment As Long
   Parms As Long
   Workstations As Long
   LastLogon As Long
   LastLogoff As Long
   AcctExpires As Long
   MaxStorage As Long
   UnitsPerWeek As Long
   LogonHours As Long
   BadPwCount As Long
   NumLogons As Long
   LogonServer As Long
   CountryCode As Long
   codepage As Long
   ' Level 3 starts here, but we are not using
'   UserID As Long
'   PrimaryGroupID As Long
'   Profile As Long
'   HomeDirDrive As Long
'   PasswordExpired As Long
End Type


Private Sub Command1_Click()
    MsgBox vbGetFullUserName("Username")
End Sub

Public Function vbGetFullUserName(strName As String) As String
     Dim myInfo As USER_INFO_2
    Dim Username() As Byte
    Dim buff As Long
    
    Username = strName + Chr(0) ' API needs it to be null terminated
    NetUserGetInfo 0&, Username(0), 2, buff
    CopyMemory myInfo, ByVal buff, Len(myInfo) ' Copy from buffer into UDT
    NetApiBufferFree ByVal buff ' be good and free allocated memory
    vbGetFullUserName = GetStrFromPtrW(myInfo.FullName)
End Function


' Returns an ANSI string from a pointer to a Unicode string.
' (highly modified version of function from AllAPI.net)
Public Function GetStrFromPtrW(lpszW As Long) As String
    Dim sRtn As String
    sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0)   ' 2 bytes/char
    CopyMemory ByVal sRtn, ByVal lpszW, Len(sRtn)
    GetStrFromPtrW = StrConv(sRtn, vbFromUnicode)
End Function

[/color]

 

[krinid]

Hm, this causes Excel to crash when it hits the line
CopyMemory myInfo, ByVal buff, Len(myInfo)

Btw, what does dim'ing something as Any do? Is this different than as Variant? Is it used only for API calls?

 

[strongm]

It is an illustration only, without error handling. If buff=0, then the CopyMemory function will fail. Buff will = 0 when the username passed does not exist or if no longname is assigned to the username. What we should really do, however, is check the return value from NetUserGetInfo. 0 means it succeeded, any other value is an error code.

By Any is indeed an API hack, and basically means no type checking is done on the variable being passed or returned. get the wrong data in there and your program will break, but it can be handy for those API calls where a parameter can be one of several types (SendMessage is a good example, where lParam is a different type depending on the message being sent)

 

[alforjj]

krinid,

Your companies AD structure may be different from mine. Use the following code to get your companies basic AD structure. As AD structure shouldn't ever change, you shouldn't need to put this inside a program. So I made this to work in VBS. Just drop it in a text file and rename the extention to .vbs:

Set oRoot = GetObject("LDAP://rootDSE")
Set oDomain = GetObject("LDAP://" & oRoot.Get("defaultNamingContext"))
Call ListObjects("*** defaultNamingContext ***")

Set oRoot = GetObject("LDAP://rootDSE")
Set oDomain = GetObject("LDAP://" & oRoot.Get("schemaNamingContext"))
Call ListObjects("*** schemaNamingContext ***")

Set oRoot = GetObject("LDAP://rootDSE")
Set oDomain = GetObject("LDAP://" & oRoot.Get("configurationNamingContext"))
Call ListObjects("*** configurationNamingContext ***")

Sub ListObjects(strNamingContext)
WScript.Echo strNamingContext
For Each object In oDomain
WScript.Echo object.Name & ": " & object.ADsPath
Next
End Sub


After you get the basic structure, you will probably need to parse down and find where your company keeps its user info. Use the following code to do that:


strContainer = "LDAP://AD Path"
set oDomain = GetObject(strContainer)

For Each object In oDomain
WScript.Echo object.Name & ": " & object.ADsPath
Next

Where AD Path is the branch you want to parse down. I just kept adding on to the strContainer variable until I found what I needed. (P.S. this one is also in VBS)

These sites have good information on scripting AD. It's also where I got the code.

Part 1:

http://www.winnetmag.com/Windows/Article/ArticleID/9168/9168.html

Part 2:

http://www.winnetmag.com/Windows/Article/ArticleID/15734/15734.html

I hope this helps.