How do extract the username or logon in VB6 after elevation

In a VB6 script, I am trying to extract a username or windows logon name in Vista after elevation.  Currently, I have a VB6 program that extracts user name and profile location in XP.  

But under Vista, the program requires elevated privileges.  Once a admin user name/password are entered to execute the program, the only user name or profile name that is extracted from the program is the admin user name/profile.  

Is there a way around this?
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

I may totally be off here, but it should still be the same username, just with teh administrative tokens added to the ID....

I dont see anything wrong with your returns.....
KarenAnalyst programmerCommented:
What method are you using to find this information? I'm pretty sure you should not have to elevate to get it.


Dim WshShell
Dim objNet
Dim objEnv
Dim strProfile

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objEnv = WshShell.Environment("Volatile")
Set objNet = CreateObject("WScript.NetWork")
strProfile=objEnv("HomeDrive") & objEnv("HomePath")

MsgBox "User Name is: " & objNet.UserName & vbcrlf & "Profile: " & strProfile

Set objNet = Nothing
Set objEnv = Nothing
Set WshShell = Nothing
gismofoAuthor Commented:
I've tried two methods for extracting username and profile with no success.  I'm using the user name extraction to copy directories/files into a user's profile

Complete Original Code:

Option Explicit
Dim WshShell
Dim WScript
Dim strUser
Dim strName

Public Sub Main()
  Set WshShell = CreateObject("WScript.Shell")
  strUser = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
  strName = WshShell.ExpandEnvironmentStrings("%USERNAME%")
  Set FSO = CreateObject("Scripting.FileSystemObject")
  If FSO.FolderExists(strUser & "\AppData\Roaming\ESRI") Then
    FSO.DeleteFolder strUser & "\AppData\Roaming\ESRI"
  End If
  FSO.CopyFolder "\\server1-gis\Desktop\ESRI", strUser & "\AppData\Roaming\ESRI", True
  FSO.CopyFile "\\server1-gis\Desktop\", strUser & "\AppData\Roaming\ESRI\ArcMap\" & strName & ".style", True
  Set FSO = Nothing
End Sub

The second method I used the parameters from Snowberry, but the same reults.

Results:  For example, if i'm logged in as JohnDoe and run the program in Vista, it will require elevation.  Once I type my admin credentials to run the progran, the user name/profile that is extracted is admin,not JohnDoe.

Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

KarenAnalyst programmerCommented:
Like I said, why does it have to be elevated? For something else you need to do? I can run the code I gave earlier on Vista without elevating.
KarenAnalyst programmerCommented:
Try the following to get the username, if you have to run elevated:

Option Explicit

dim objWMIService
dim colComputers
dim objComputer
dim colAccounts
dim objAccount
dim colProfiles
dim objProfile
dim strComputer
dim arrName
dim SID
dim LocalPath
dim j

' Find the logged-in user.
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  
Set colComputers = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")

j = 0
For Each objComputer in colComputers
    arrName = Split(objComputer.UserName, "\")
    j = j + 1

If j = 1 Then
    ' Find account information for the logged-in user.
    Set colAccounts = objWMIService.ExecQuery("Select * from Win32_UserAccount where Domain = '" & arrName(0) & _
            "' and Name = '" & arrName(1) & "' and AccountType = 512")
    j = 0
    For Each objAccount in colAccounts
        SID = objAccount.SID
        j = j + 1

    If j = 1 Then
      ' Use the SID to find the local profile path.
        Set colProfiles = objWMIService.ExecQuery("Select * from Win32_UserProfile where SID = '" & SID & "'")
        j = 0
        For each objProfile in colProfiles
            LocalPath = objProfile.LocalPath
            j = j + 1

        If j = 1 Then
            Wscript.Echo "Local profile path: " & LocalPath
        End If
    End If
End If

Set objProfile = Nothing
Set colProfiles = Nothing
Set objAccount = Nothing
Set colAccounts = Nothing
Set objComputer = Nothing
Set colComputers = Nothing
Set objWMIService = Nothing
KarenAnalyst programmerCommented:
This code will only work on Windows Vista with SP1 or later. You will also need to add an On Error Resume Next at the start.
If you have VB6 and you experience this problem it's because these functions use the token of the current process. This means when you run as administrator it uses the administrative token and returns the username of the context the process is running under.
Because of this you could get the token of the explorer process. This always runs with the standard user token of the logged on user.
You can use the methods like this for example:
  Dim userProfile As String
  userProfile = GetUserProfilePath
  MsgBox userProfile
  MsgBox GetUserName(userProfile)

Option Explicit

Private Const BUFF_SIZE = (260 * 2)
Private Const TOKEN_QUERY = &H8&

Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetUserProfileDirectoryW Lib "userenv" (ByVal hToken As Long, ByVal lpProfileDir As Long, ByRef lpcchSize As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetShellWindow Lib "user32" () As Long

Private Function GetUserProfileFromToken(ByVal dwTokenHandle As Long) As String
  ' Helper to get profile string from token.
  Dim Buffer(BUFF_SIZE) As Byte
  Dim dwSize As Long
  dwSize = BUFF_SIZE
  If GetUserProfileDirectoryW(dwTokenHandle, VarPtr(Buffer(0)), dwSize) Then
    GetUserProfileFromToken = Left$(Buffer, dwSize - 1)
  End If
  Erase Buffer
End Function

Public Function GetUserProfilePath() As String
  ' Get the standard user profile.
  Dim lpPid       As Long
  Dim hProcess    As Long
  Dim hTokenUser  As Long
  If GetWindowThreadProcessId(GetShellWindow, lpPid) Then
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lpPid)
    If hProcess Then
      If OpenProcessToken(hProcess, TOKEN_QUERY, hTokenUser) Then
        GetUserProfilePath = GetUserProfileFromToken(hTokenUser)
        CloseHandle hTokenUser
      End If
      CloseHandle hProcess
    End If
  End If
End Function

Public Function GetUserName(ByVal szProfile As String)
  ' Get the standard username from profile string.
  Dim args() As String
  args() = Split(szProfile, "\")
  GetUserName = args(UBound(args))
  Erase args
End Function

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
gismofoAuthor Commented:
Thank you experts for getting me over this hump!  I don't know why, both all the code suggested requires elevated privileges in Vista. Probably do to the fact that my company has set security at the highest level in Vista.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.