How to get the logged on user name, NOT GetUserName 1

[darkman0101]

This is not the standard GetUserName question.
As far as I can tell that API will not work for me here.
You see I am running this application from Win 2000 scheduler. In scheduler you specify what user account you want to fire the application as, (much like the startup of a service)

In this case it is not the same user as that who is logged into Windows 2000. As GetUserName returns the user that is running the current thread it is not what I want here.

How can I get the logged on user without having to look in the registry under current user?

Thanks in advance

Jas

 

[chiph]

OK, it's easier to look it up in the registry, but if you don't want to do that, here's the C++ code needed to do what you wanted:
[tt]
//**********************************************************************
//
// FUNCTION: GetCurrentUserAndDomain - This function looks up
// the user name and domain name for the user account
// associated with the calling thread.
//
// PARAMETERS: szUser - a buffer that receives the user name
// pcchUser - the size, in characters, of szUser
// szDomain - a buffer that receives the domain name
// pcchDomain - the size, in characters, of szDomain
//
// RETURN VALUE: TRUE if the function succeeds. Otherwise, FALSE and
// GetLastError() will return the failure reason.
//
// If either of the supplied buffers are too small,
// GetLastError() will return ERROR_INSUFFICIENT_BUFFER
// and pcchUser and pcchDomain will be adjusted to
// reflect the required buffer sizes.
//
//**********************************************************************

BOOL GetCurrentUserAndDomain(PTSTR szUser, PDWORD pcchUser,
PTSTR szDomain, PDWORD pcchDomain) {

BOOL fSuccess = FALSE;
HANDLE hToken = NULL;
PTOKEN_USER ptiUser = NULL;
DWORD cbti = 0;
SID_NAME_USE snu;

__try {

// Get the calling thread's access token.
if (!OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, TRUE,
&hToken)) {

if (GetLastError() != ERROR_NO_TOKEN)
__leave;

// Retry against process token if no thread token exists.
if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY,
&hToken))
__leave;
}

// Obtain the size of the user information in the token.
if (GetTokenInformation(hToken, TokenUser, NULL, 0, &cbti)) {

// Call should have failed due to zero-length buffer.
__leave;

} else {

// Call should have failed due to zero-length buffer.
if (GetLastError() != ERROR_INSUFFICIENT_BUFFER)
__leave;
}

// Allocate buffer for user information in the token.
ptiUser = (PTOKEN_USER) HeapAlloc(GetProcessHeap(), 0, cbti);
if (!ptiUser)
__leave;

// Retrieve the user information from the token.
if (!GetTokenInformation(hToken, TokenUser, ptiUser, cbti, &cbti))
__leave;

// Retrieve user name and domain name based on user's SID.
if (!LookupAccountSid(NULL, ptiUser->User.Sid, szUser, pcchUser,
szDomain, pcchDomain, &snu))
__leave;

fSuccess = TRUE;

} __finally {

// Free resources.
if (hToken)
CloseHandle(hToken);

if (ptiUser)
HeapFree(GetProcessHeap(), 0, ptiUser);
}

return fSuccess;
}
[/tt]

Chip H.

 

[darkman0101]

Thanks,
I can follow this most of the way through... but...
I can not figure out how to increase (or even create) the buffer that will receive the GetTokenInformation data.

If I define the types

Public Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type

Public Type Token_User
user as SID_AND_ATTRIBUTES
End Type

dim mUser as Token_User

The size of the variable which will receive the GetTokenInformation info (mUser) is only 8 bytes.

When I call GetTokenInformation the first time I see I need 36 bytes in the buffer.

How do I do this in vb? Am I missing a type definition somewhere?

Thanks
Jas

 

[chiph]

Oh, OK.

When you call GetTokenInformation, there is more info in there than just the User record (it's just the first one of potentially quite a few token structures).

What you do is call GetTokenInformation with a NULL (0-byte) like they do to find out how long a buffer you need. You then Dim a string, and assign that many hex 0's to it:
[tt]
Dim sBuffer As String
sBuffer = string(lBufferSize, Chr$(0))
[/tt]

This will reserve memory in the string. VB doesn't allocate any memory to a string until you actually store something in it. If you set the string to empty ("&quot, it frees the memory.

You then call GetTokenInformation again, this time passing the string (ByVal, like you always do to a C DLL). Afterwards, the string will have the info you need.

To get it into your Token_User structure, you do a CopyMemory from the string to your allocated structure:
[tt]
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Dim MyUserStruct as Token_User

call CopyMemory(MyUserStruct, ByVal sBuffer, lBufferSize)
[/tt]
And that should do it.

Let me know how it works.

Chip H.

 

[Guest_imported]

Hi,

I had a hard time finding this information on the web. Though I didn't test it much, it works fine for me.

Hope this helps:

Use UserNTDomain function to retrieve the Domain Name and the UserNT to retrieve the User name of the currently opened session.

Works with VB 6.0 SP4 for me.

Have fun!

-- STARTS HERE ---

Private Type WKSTA_USER_INFO_1

wkui1_username As Long
wkui1_logon_domain As Long
wkui1_oth_domains As Long
wkui1_logon_server As Long

End Type

Private Declare Function apiWkStationUser Lib "Netapi32" _
Alias "NetWkstaUserGetInfo" _
(ByVal reserved As Long, _
ByVal Level As Long, _
bufptr As Long) _
As Long

Private Declare Function apiStrLenFromPtr Lib "kernel32" _
Alias "lstrlenW" _
(ByVal lpString As Long) _
As Long

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

Private Function fStringFromPtr(lngPtr As Long) As String

Dim lngLen As Long
Dim abytStr() As Byte

lngLen = apiStrLenFromPtr(lngPtr) * 2

If lngLen > 0 Then

ReDim abytStr(0 To lngLen - 1)

Call sapiCopyMemory(abytStr(0), ByVal lngPtr, lngLen)

fStringFromPtr = abytStr()

End If

End Function

Public Function UserNTDomain() As String
On Error GoTo UserNTDomain_ErrHandler

Dim lngRet As Long
Dim lngPtr As Long
Dim tNTInfo As WKSTA_USER_INFO_1

lngRet = apiWkStationUser(0&, 1&, lngPtr)

If lngRet = 0 Then

Call sapiCopyMemory(tNTInfo, ByVal lngPtr, LenB(tNTInfo))

If Not lngPtr = 0 Then

With tNTInfo

UserNTDomain = fStringFromPtr(.wkui1_logon_domain)

End With

End If

End If

UserNTDomain_ExitHere:
Exit Function

UserNTDomain_ErrHandler:
UserNTDomain = vbNullString
Resume UserNTDomain_ExitHere

End Function

Public Function UserNT() As String
On Error GoTo UserNT_ErrHandler

Dim lngRet As Long
Dim lngPtr As Long
Dim tNTInfo As WKSTA_USER_INFO_1

lngRet = apiWkStationUser(0&, 1&, lngPtr)

If lngRet = 0 Then

Call sapiCopyMemory(tNTInfo, ByVal lngPtr, LenB(tNTInfo))

If Not lngPtr = 0 Then

With tNTInfo

UserNT = fStringFromPtr(.wkui1_username)

End With

End If

End If

UserNT_ExitHere:
Exit Function

UserNT_ErrHandler:
UserNT = vbNullString
Resume UserNT_ExitHere

End Function

 

[darkman0101]

Thanks Hybrid,
but the above code gives the same result as GetUserName.
That is if you create a module with the above code and create a sub main procedure defined as this

public sub Main()
dim filenum as int
open "c:\test.txt" for output as filenum
print #filenum, userNT
close filenum
end sub

and make this the startup procedure for the project (no forms). Compile the project.
Set this executable to run as a scheduled task in task scheduler and set the user to anoone other the the currently logged on user.
Once it has run look at c:\test.txt and you will find the user as that specified in the scheduled task, (not the user logged on at the time).

To chiph
I have managed to get the code you gave me to compile in c++ and it works great, but for some reason I can't get the desired result in vb. If you feel so inclined can you give it a shot in vb and post the code?

Cheers
Jason

 

[ratman]

maybe this ?

Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function NTDomainUserName() As String
Dim strBuffer As String * 255
Dim lngBufferLength As Long
Dim lngRet As Long
Dim strTemp As String

lngBufferLength = 255
strBuffer = String(255, 0)
lngRet = GetUserName(strBuffer, lngBufferLength)
strTemp = UCase(Left(strBuffer, lngBufferLength - 1))
NTDomainUserName = strTemp
End Function

 

[darkman0101]

Nope same result

 

[ratman]

Here's some code to find the registered owner, registered organisation, product id, and product name of your PC's installation of Windows! This works on both 95/98 and NT/2000, by looking in the CurrentVersion section of HKEY_LOCAL_MACHINE\Software\Microsoft\Windows. You can get lots of information from there, and in this case, it looks at "RegisteredOwner", "RegisteredOrganization", "ProductName" and "ProductId", but you could use the code to look up any other value too.

Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long


Private Const ERROR_MORE_DATA = 234
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const KEY_QUERY_VALUE = &H1

Private Sub Form_Load()
Dim sKey As String
sKey = "Software\Microsoft\Windows\CurrentVersion"
If GetStringValue("Software\Microsoft\Windows\CurrentVersion", "SystemRoot&quot = "" Then
sKey = "Software\Microsoft\Windows NT\CurrentVersion"
End If

txtRegOwner = GetStringValue(sKey, "RegisteredOwner&quot
txtRegOrg = GetStringValue(sKey, "RegisteredOrganization&quot
txtProductName = GetStringValue(sKey, "ProductName&quot
txtProductID = GetStringValue(sKey, "ProductId&quot
End Sub
Private Function GetStringValue(sSectionKey As String, sValueKey As String) As String
Dim hKey As Long
Dim lResult As Long
Dim ordType As Long
Dim cData As Long
Dim sData As String
Dim e As Long

lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sSectionKey, 0, KEY_QUERY_VALUE, hKey)


lResult = RegQueryValueExLong(hKey, sValueKey, 0&, ordType, 0&, cData)
If lResult And lResult <> ERROR_MORE_DATA Then
DoEvents
Exit Function
End If
If ordType = 1 Then 'REG_SZ
sData = String$(cData - 1, 0)
lResult = RegQueryValueExStr(hKey, sValueKey, 0&, _
ordType, sData, cData)
GetStringValue = sData
Else
'MsgBox "Invalid String Value"
End If
End Function

 

[strongm]

Darkman,
Here is the GetUsernameAndDomain function rewritten in VB.
Parameters:

strUser - string that on successful return will contain username
strDomain - string that on successful return will contain domain name

Function returns a boolean indicating success or failure of the function




Option Explicit

Public Type SID_AND_ATTRIBUTES
SID As Long
Attributes As Long
End Type

Public Const TokenUser = 1
Public Const TOKEN_QUERY = 8
Private Const ERROR_INSUFFICIENT_BUFFER = 122&

Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetCurrentThread Lib "kernel32" () As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function OpenThreadToken Lib "advapi32.dll" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Public 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 Long) As Long

' Note two different declares for GetTokenInformation
Public Declare Function GetTokenInformationLen Lib "advapi32.dll" Alias "GetTokenInformation" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Long, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Public Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, ByVal TokenInformation As String, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


' Translation of Q111544
Public Function GetCurrentUserAndDomain(strUser As String, strDomain As String) As Boolean
Dim hToken As Long
Dim hProcess As Long
Dim lAccess As Long
Dim result As Long
Dim buflen As Long
Dim buffer As String

Dim ptiUser As SID_AND_ATTRIBUTES
Dim SID As Long
'Dim strUser As String
Dim lUser As Long
'Dim strDomain As String
Dim lDomain As Long

GetCurrentUserAndDomain = False ' default return value, indicating failure

result = OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, 0&, hToken)

' If we cannot get thread token then try getting process token instead
If result = 0 Then
result = OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hToken)
End If

' If we successfully got a token
If result <> 0 Then
' First call to get required buffer length
result = GetTokenInformationLen(hToken, TokenUser, vbNull, 0, buflen)
If buflen <> 0 Then

buffer = Space(buflen - 1) 'String(buflen, Chr$(0))
' Now get the info
result = GetTokenInformation(hToken, TokenUser, buffer, buflen, buflen)
If result <> 0 Then
Call CopyMemory(ptiUser, ByVal buffer, 8) ' Dump the first 8 bytes into structure
strUser = &quot;&quot;
strDomain = &quot;&quot;
' Make first call to determine buffer lengths
result = LookupAccountSid(vbNullString, ptiUser.SID, strUser, lUser, strDomain, lDomain, SID)

' Do we get the expected buffer error?
If result = 0 And Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
strUser = Space(lUser - 1)
strDomain = Space(lDomain - 1)
result = LookupAccountSid(vbNullString, ptiUser.SID, strUser, lUser, strDomain, lDomain, SID)
If result <> 0 Then GetCurrentUserAndDomain = True ' It worked!
End If

End If
End If
End If

' Clean up
If hToken <> 0 Then CloseHandle (hToken)

End Function