How do extract the username or logon in VB6 after elevation

Posted on 2010-04-07
Medium Priority
Last Modified: 2012-06-27
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?
Question by:gismofo
LVL 66

Expert Comment

ID: 30080282
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.....

Expert Comment

ID: 30090616
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

Author Comment

ID: 30135914
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\user.style", 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.

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.


Expert Comment

ID: 30156860
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.

Assisted Solution

Karen earned 800 total points
ID: 30170286
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

Expert Comment

ID: 30171160
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.
LVL 29

Accepted Solution

nffvrxqgrcfqvvc earned 1200 total points
ID: 30212984
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


Author Closing Comment

ID: 31760924
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.

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Q&A with Course Creator, Mark Lassoff, on the importance of HTML5 in the career of a modern-day developer.
AngularJS web development a very simple procedure. So, to put it, in short, AngularJS’ stand out features are – Two-way data binding, MVC structure, directives, templates, dependency injections and testing.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Introduction to Processes

627 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question