Running VB executables as different users

Yes there is, you could use CreateProcessAsUser. This will create a process as a user specified in a token. You can get a token by calling LogonAsUser. Or you can use the following code to start the program:

Private Const LOGON_WITH_PROFILE = &H1&
Private Const LOGON_NETCREDENTIALS_ONLY = &H2&
Private Const CREATE_DEFAULT_ERROR_MODE = &H4000000
Private Const CREATE_NEW_CONSOLE = &H10&
Private Const CREATE_NEW_PROCESS_GROUP = &H200&
Private Const CREATE_SEPARATE_WOW_VDM = &H800&
Private Const CREATE_SUSPENDED = &H4&
Private Const CREATE_UNICODE_ENVIRONMENT = &H400&
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000&
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000&
Private Const HIGH_PRIORITY_CLASS = &H80&
Private Const IDLE_PRIORITY_CLASS = &H40&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const REALTIME_PRIORITY_CLASS = &H100&
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Declare Function CreateProcessWithLogon Lib "Advapi32" Alias "CreateProcessWithLogonW" (ByVal lpUsername As Long, ByVal lpDomain As Long, ByVal lpPassword As Long, ByVal dwLogonFlags As Long, ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInfo As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Form_Load()
    Dim lpUsername As String, lpDomain As String, lpPassword As String, lpApplicationName As String
    Dim lpCommandLine As String, lpCurrentDirectory As String
    Dim StartInfo As STARTUPINFO, ProcessInfo As PROCESS_INFORMATION
    lpUsername = "OtherUser"
    lpDomain = ""
    lpPassword = "other_user_password"
    lpApplicationName = "C:\WINNT\NOTEPAD.EXE"
    lpCommandLine = vbNullString 'use the same as lpApplicationName
    lpCurrentDirectory = vbNullString 'use standard directory
    StartInfo.cb = LenB(StartInfo) 'initialize structure
    StartInfo.dwFlags = 0&
    CreateProcessWithLogon StrPtr(lpUsername), StrPtr(lpDomain), StrPtr(lpPassword), LOGON_WITH_PROFILE, StrPtr(lpApplicationName), StrPtr(lpCommandLine), CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP, ByVal 0&, StrPtr(lpCurrentDirectory), StartInfo, ProcessInfo
    CloseHandle ProcessInfo.hThread 'close the handle to the main thread, since we don't use it
    CloseHandle ProcessInfo.hProcess 'close the handle to the process, since we don't use it
    'note that closing the handles of the main thread and the process do not terminate the process
    'unload this application
    Unload Me
End Sub

You will need an account name and password

This is perfect - except that as a service on a remote box, I won't know who is logged in (and therefore won't know the user name and password). Is there any way in which I can parse the logged on user and password into this bit of code ?? If so, this will work like a treat.

Thanks for your help so far.

I don't think that you will be able to find the password of the logged on user.

Maybe you can create the second app as an ActiveX EXE, and then set the dcomcnfg-identity-setting to "the interactive user"?

I am now programming a service myself and I want a VB app to be run in the user session who has the console. I am now trying to get the security token from the desktop and pass that with createprocessasuser. But i am unsuccesfull so far, I'll post it when it works.
Maybe you can first run the program in the SYSTEM context and the adjust the session in the securtity token.

TOKEN_ADJUST_SESSIONID Required to adjust the session ID of an access token. The SE_TCB_NAME privilege is required.

You will probably have the SE_TCB_NAME, so you could try that. For more info: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/access_rights_for_access_token_objects.asp

I think that would work. However, how can I do this ? I've looked up stacks of code on the net but cannot seem to adjust the security tokens without knowing the other userID and password ??

I just found out an other way, wich you can use in a service, the code works like this:
- Scan all running processes for a user with an account name, scan for explorer.exe or something.
- Open the process to get a handle to that process
- Open the processtoken of the process with openprocesstoken and the processid
-call the ImpersonateLoggedOnUser with the token you get from openprocesstoken

You are now running in the security context of the process you selected.
I tested this on my machine and called the GetUserName before and after the impersonateloggedonuser and, the username was changed (In a service). In the taskmanager you'll still see SYSTEM or localservice.

I'll post my code in an hour. I have a meeting now.

Sounds great - if you could post your code, I'll give it a whirl this end. Could be the answer I'm looking for.

Thanks a lot again.

I think that would work. However, how can I do this ? I've looked up stacks of code on the net but cannot seem to adjust the security tokens without knowing the other userID and password ??

I am still working on it, it's a bit harder than I thought it would be. It's almost ready now. It's a lot of code.

No problem - I'm waiting with baited breath !!

Any luck with the code ? Mail me if necessary.

Cheers
R

the code isn't perfect, in a real service you cant use msgboxes and stuff. Also when a token is opened, it will request full access. You can adjust this code to suit your needs.

I hope this helps, it works for me

Excellent - this does work !! I'm stripped out the stuff that isn't needed and put the ImpersonateUser into my code framework. Now it writes to the database as the logged on user even though Task Manager says SYSTEM. Super stuff ! Thanks very much again for all your help on this - top work.

Cheers
R

Ah - Ok, a slight problem. This works great on XP systems - but not on NT4 ! I'm presuming that this is because it's using WTSAPI32.DLL and this won't work on NT4. I'm thinking that maybe I can get round this by using the NT equivilants (i.e. EnumProcesses, etc). Any ideas jantenhove ??? It works great on an XP system !

hi,

This code works only on XP and Win2000, this is because of the use of WTSAPI32.DLL. Maybe you can copy the dll in to your app.path, but I think that will not work. The problem you have with enumprocesses that you can't see wich user is running a process. If only one user is logged on you could use enumprocesses.

I tried to copy that DLL but you can't register it in NT. Disaster - especially since the service was going to go on 500 NT boxes and only 25 XP ! I'm still working on it with a subset of your code ...

Ok, maybe you can explain why the code below doesn't work. I've taken out all the references to WTS (which I believe was only used to get the PID of explorer.exe), and this does work on an XP box but not NT - any explanations ??

Form code:


Private Sub Form_Load()
   MsgBox usr
   MsgBox ImpersonateActiveUser
   MsgBox usr
End Sub





Class module: clsProcessInfo

Private m_lProcess() As Long
Private m_lNumProcesses As Long
Private m_lCurrentPID As Long
Private m_strAppName As String
Private m_strPath As String
Private m_strClassName As String
Private m_strWindowTitle As String
Private m_lhwnd As Long

Public Property Get GetProcessesList() As Long

    Dim cb As Long
    Dim cbNeeded As Long

    cb = 1024
    Do
        cb = cb * 2
        ReDim m_lProcess(cb / 4 - 1) As Long
        EnumProcesses m_lProcess(0), cb, cbNeeded
        If cbNeeded < cb Then Exit Do
    Loop

    If cbNeeded = 0 Then
        m_lNumProcesses = 0
    Else
        m_lNumProcesses = cbNeeded / 4
        ReDim Preserve m_lProcess(m_lNumProcesses - 1)
    End If

    GetProcessesList = m_lNumProcesses
    GetProcessInfo

End Property
 
Public Property Get NumProcesses() As Long
   
    NumProcesses = m_lNumProcesses

End Property
 
Public Property Get ListProcessID(ByVal index As Long) As Long
   
    ListProcessID = m_lProcess(index)
 
End Property
 
Public Property Let ProcessID(ByVal pid As Long)
         
    m_lCurrentPID = pid
    GetProcessInfo
 
End Property
 
 Public Property Get ProcessID() As Long
     ProcessID = m_lCurrentPID
 End Property
 
 Public Property Get ProcessName() As String
     ProcessName = m_strAppName
 End Property
 
 Public Property Get ProcessPath() As String
     ProcessPath = m_strPath
 End Property

Public Property Get ProcessHwnd() As Long
    ProcessHwnd = m_lhwnd
End Property

Public Property Get ClassName() As String
    ClassName = m_strClassName
End Property

Public Property Get WindowTitle() As String
    WindowTitle = m_strWindowTitle
End Property

Public Property Get Visible() As Boolean
    Visible = m_bolVisible
End Property

Public Property Get IsAWindow() As Boolean
    IsAWindow = m_bolIsWindow
End Property

Public Property Get Enabled() As Boolean
    Enabled = m_bolEnabled
End Property

Public Sub GetProcessInfo()

     On Error GoTo exitsub

     Dim hProcess As Long
     Dim lProp As Long

     m_strPath = ""
     m_strAppName = ""

     lProp = PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ
     hProcess = OpenProcess(lProp, 0, m_lCurrentPID)
     If hProcess = 0 Then GoTo exitsub

     Dim lRet As Long
     Dim cbNeeded As Long
     Dim Modules()  As Long

     'Retrieve the number of bytes that the array of module handles requires
     ReDim Modules(1023)

     lRet = EnumProcessModules(hProcess, Modules(0), 1024, cbNeeded)
     If lRet = 0 Then GoTo exitsub
     ReDim Modules(cbNeeded / 4 - 1)
     'Get an array of the module handles for the specified process
     lRet = EnumProcessModules(hProcess, Modules(0), cbNeeded, cbNeeded)
     If lRet = 0 Then GoTo exitsub

     Dim nSize As Long

     m_strAppName = Space(MAX_PATH)
     nSize = 500
     lRet = GetModuleFileNameExA(hProcess, Modules(0), m_strAppName, nSize)
     m_strAppName = Left$(m_strAppName, lRet)

     m_strPath = m_strAppName
     lRet = InStrRev(m_strAppName, "\")
     If lRet > 0 Then
         m_strAppName = Right(m_strPath, Len(m_strPath) - lRet)
         m_strPath = Left(m_strPath, lRet)
     End If
         
     
exitsub:
     CloseHandle hProcess
 End Sub




Module: modWhatever



Private Declare Function GetProcessMemoryInfo Lib "psapi.dll" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "Advapi32" (ByVal htoken As Long) As Boolean
Private Declare Function DuplicateTokenEx Lib "Advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAcces As Long, lpTokenAttribute As SECURITY_ATTRIBUTES, ImpersonatonLevel As Integer, ByVal tokenType As Integer, Phandle As Long)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "Advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function CreateProcessAsUserW Lib "Advapi32" (ByVal htoken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long


'some constants
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_IMPERSONATE = &H4
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_ADJUST_SESSIONID = &H100
Private Const TOKEN_ADJUST_DEFAULT = &H80
Private Const TOKEN_ADJUST_GROUPS = &H40
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_SESSIONID Or TOKEN_ADJUST_DEFAULT)
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const TH32CS_SNAPPROCESS = &H2&
Private Const hNull = 0
Private Const WIN95_System_Found = 1
Private Const WINNT_System_Found = 2
Private Const Default_Log_Size = 10000000
Private Const Default_Log_Days = 0
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const INFINITE = &HFFFF
Private Const STARTF_USESHOWWINDOW = &H1
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Private Const SUBLANG_DEFAULT = &H1

'some types
Type MEMORYSTATUS
   dwLength As Long
   dwMemoryLoad As Long
   dwTotalPhys As Long
   dwAvailPhys As Long
   dwTotalPageFile As Long
   dwAvailPageFile As Long
   dwTotalVirtual As Long
   dwAvailVirtual As Long
End Type


Type PROCESS_MEMORY_COUNTERS
   cb As Long
   PageFaultCount As Long
   PeakWorkingSetSize As Long
   WorkingSetSize As Long
   QuotaPeakPagedPoolUsage As Long
   QuotaPagedPoolUsage As Long
   QuotaPeakNonPagedPoolUsage As Long
   QuotaNonPagedPoolUsage As Long
   PagefileUsage As Long
   PeakPagefileUsage As Long
End Type


Public Type PROCESSENTRY32
   dwSize As Long
   cntUsage As Long
   th32ProcessID As Long ' This process
   th32DefaultHeapID As Long
   th32ModuleID As Long ' Associated exe
   cntThreads As Long
   th32ParentProcessID As Long ' This process's parent process
   pcPriClassBase As Long ' Base priority of process threads
   dwFlags As Long
   szExeFile As String * 260 ' MAX_PATH
End Type

'enums, and again, not all used but hey
Private Enum enSW
   SW_HIDE = 0
   SW_NORMAL = 1
   SW_MAXIMIZE = 3
   SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadId As Long
End Type
Private Type STARTUPINFO
   cb As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Byte
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type
Private Enum enPriority_Class
   NORMAL_PRIORITY_CLASS = &H20
   IDLE_PRIORITY_CLASS = &H40
   HIGH_PRIORITY_CLASS = &H80
End Enum

Public Function ImpersonateActiveUser() As Boolean

  Dim htoken As Long, lngHwndProcess As Long
  lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, GetExplorerProcessID)
   OpenProcessToken lngHwndProcess, TOKEN_ALL_ACCESS, htoken
   ImpersonateActiveUser = ImpersonateLoggedOnUser(htoken)
End Function

Public Function usr() As String
   Dim strUserName As String
   'Create a buffer
   strUserName = String(100, Chr$(0))
   'Get the username
   GetUserName strUserName, 100
   'strip the rest of the buffer
   strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
   
   usr = strUserName
End Function

Public Function GetExplorerProcessID() As Long

    Dim plist As New cProcessInfo
    Dim j As Integer
    Dim num As Long

    num = plist.GetProcessesList
   
    For j = 0 To num - 1
        plist.ProcessID = plist.ListProcessID(j)
        If plist.ProcessName = "Explorer.EXE" Then
            GetExplorerProcessID = plist.ProcessID
        End If
    Next j
   
End Function

All the dll's that you use can be used from NT4 and later. Maybe the token has to many rights. Now when you open a token it will have all the rights. Try it with only query and information token.

I'll give that a try - though I'm sure I tried that earlier from XP and then it wouldn't even give me the impersonated user on that OS.

I'll let you know what happens - I have tried to enable privileges on the explorer process to my program - will see if that makes a difference

Nope - it can't see to impersonate the user on NT4. Does anyone know how to use that API in NT4 ? Will it ever work ??