Solved

Get Logged On User

Posted on 2003-12-05
15
1,015 Views
Last Modified: 2007-12-19
How can i get the logged on user?

GetUserName returns the username of the calling process ( my service runs as a different user) as does environ("USERNAME")


0
Comment
Question by:crazyman
  • 4
  • 3
  • 2
  • +4
15 Comments
 
LVL 24

Expert Comment

by:R_Rajesh
Comment Utility
try this:

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

Sub Get_User_Name()
   
    Dim lpBuff As String * 25
    Dim ret As Long, UserName As String
    ret = GetUserName(lpBuff, 25)
    UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
    MsgBox UserName
   
End Sub
0
 
LVL 6

Expert Comment

by:prasitlee
Comment Utility
Dear crazyman,
    I am not sure if I am understanding your question correctly. Are you mentioning to find out who is the current user which is executing your program or list all of the users who are logging into your server.
                                                                  Meng
0
 
LVL 6

Expert Comment

by:prasitlee
Comment Utility
Dear crazyman,
    Try the sample code at the following link. I hope that I would understand your problem correctly.
     http://www.freevbcode.com/ShowCode.Asp?ID=611
                                                                         Meng
0
 
LVL 13

Author Comment

by:crazyman
Comment Utility
R_Rajesh : No Good, my service is logged in as UserA, i log into windows under administrator, using getusername from within my service returns UserA which is wrong.
0
 
LVL 26

Accepted Solution

by:
EDDYKT earned 500 total points
Comment Utility
0
 
LVL 9

Expert Comment

by:Dang123
Comment Utility
Learning
0
 
LVL 5

Expert Comment

by:mccainz2
Comment Utility
easy ...


Add a reference to the 'windows script host object model' and

Dim objWshN As New WshNetwork
MsgBox objWshN.UserName
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 5

Expert Comment

by:mccainz2
Comment Utility
and for even more information

Dim objWshN As New WshNetwork
MsgBox objWshN.UserDomain & "\" & objWshN.ComputerName & "\" & objWshN.UserName
0
 
LVL 3

Expert Comment

by:TimW1
Comment Utility
Actually I think this is harder than people think.
Here is the code I use when I am running an app as a service.
2 ways.  
1 get the default Windows Station WinSta0  (more complicated so I will leave this out.)
2 get the processid of explorer and impersonate.
--- Here is the code, paste it all into a class.  sorry there is quite a bit.
--- usage: Msgbox class.LoggedUserName

Option Explicit
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
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = 4096

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (lpidProcess As Long, ByVal cb As Long, cbNeeded 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 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 GetProcessMemoryInfo Lib "psapi.dll" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Private Declare Function VirtualQueryEx& Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserNameEx Lib "secur32.dll" Alias "GetUserNameExA" (ByVal NameFormat As EXTENDED_NAME_FORMAT, ByVal lpNameBuffer As String, ByRef nSize As Long) As Long

Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH = 260
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const MEM_private& = &H20000
Private Const MEM_COMMIT& = &H1000
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_QUERY = &H8

Private 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

Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szexeFile As String * MAX_PATH
End Type

Type MEMORY_BASIC_INFORMATION ' 28 bytes
  BaseAddress As Long
  AllocationBase As Long
  AllocationProtect As Long
  RegionSize As Long
  State As Long
  Protect As Long
  lType As Long
End Type

Type SYSTEM_INFO ' 36 Bytes
  dwOemID As Long
  dwPageSize As Long
  lpMinimumApplicationAddress As Long
  lpMaximumApplicationAddress As Long
  dwActiveProcessorMask As Long
  dwNumberOrfProcessors As Long
  dwProcessorType As Long
  dwAllocationGranularity As Long
  wProcessorLevel As Integer
  wProcessorRevision As Integer
End Type

Private Enum EXTENDED_NAME_FORMAT
   NameUnknown = 0
   NameFullyQualifiedDN = 1
   NameSamCompatible = 2
   NameDisplay = 3
   NameUniqueId = 6
   NameCanonical = 7
   NameUserPrincipal = 8
   NameCanonicalEx = 9
   NameServicePrincipal = 10
End Enum
Public Function LoggedUserName() As String
On Error GoTo Error_Handler:
    Dim tok As Long
    Dim Ret As Long
    Dim hProcess As Long
    Dim rr As Long
    Dim explpid As Long
    explpid = explorerpid ' get ProcessID of explorer.exe
    If explpid = -1 Then LoggedUserName = "": Exit Function ' if explorer is not found, nobody is logged on
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, explpid) 'make reference to PID of explorer.exe
    OpenProcessToken hProcess, TOKEN_QUERY Or TOKEN_DUPLICATE, tok 'get token of explorer PID
    Ret = ImpersonateLoggedOnUser(tok) 'impersonate logged user
    'get user name
    Dim s As String * 200
    Dim f As Long
    Dim a As Long
    f = GetUserName(s, Len(s))
    LoggedUserName = Left(s, Len(s))
    For a = 1 To Len(LoggedUserName)
       If Asc(Mid(LoggedUserName, a, 1)) = 0 Then
           LoggedUserName = Left(LoggedUserName, a - 1)
           Exit For
       End If
    Next
    RevertToSelf ' set token to default user (if running as service, that's system)
Exit Function
Error_Handler:
    Dim sComment As String
    sComment = ApiErrorText(Err.LastDllError)
    gError.LogError Err.Number, Err.Description, " In Sub: LoggedUserName in Module: cStationQueryB " & sComment
End Function
Public Function LoggedUser_With_Pc_Name() As String
    On Error GoTo Error_Handler:
    Dim tok As Long
    Dim Ret As Long
    Dim hProcess As Long
    Dim rr As Long
    Dim explpid As Long
    Dim LoggedUserN As String
    explpid = explorerpid ' get ProcessID of explorer.exe
    If explpid = -1 Then LoggedUserN = "": Exit Function ' if explorer is not found, nobody is logged on
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, explpid) 'make reference to PID of explorer.exe
    OpenProcessToken hProcess, TOKEN_QUERY Or TOKEN_DUPLICATE, tok 'get token of explorer PID
    Ret = ImpersonateLoggedOnUser(tok) 'impersonate logged user
    'get user name
       Dim sBuffer As String
       sBuffer = String(256, 0)
       Ret = Len(sBuffer)
       If GetUserNameEx(2, sBuffer, Ret) <> 0 Then
           LoggedUser_With_Pc_Name = Left$(sBuffer, Ret)
       End If
    RevertToSelf ' set token to default user (if running as service, that's system)
    Exit Function
Error_Handler:
        Dim sComment As String
        sComment = ApiErrorText(Err.LastDllError)
        gError.LogError Err.Number, Err.Description, " In Sub: LoggedUser_With_Pc_Name in Module: cStationQueryB " & sComment
End Function
   
Private Function explorerpid() As Long
    On Error GoTo Error_Handler:
    explorerpid = -1
     If IsWindowNT Then
        explorerpid = explorerPIDNT
     Else
        explorerpid = explorerPID9X
     End If
    Exit Function
Error_Handler:
        Dim sComment As String
        sComment = ApiErrorText(Err.LastDllError)
        gError.LogError Err.Number, Err.Description, " In Sub: explorerpid in Module: cStationQueryB " & sComment
End Function
Private Function explorerPIDNT() As Long
On Error GoTo Error_Handler:
 Dim cb As Long, cbNeeded As Long
 Dim ProcessID() As Long
 Dim ModuleID() As Long
 Dim nProcesses As Long, nModules As Long
 Dim ModuleName As String
 Dim hProcess As Long, i As Long
 Dim Pmc As PROCESS_MEMORY_COUNTERS
 cb = 8
 cbNeeded = 96
 Do While cb <= cbNeeded
    cb = cb * 2
    ReDim ProcessID(cb / 4)
    Call EnumProcesses(ProcessID(1), cb, cbNeeded)
 Loop
 nProcesses = cbNeeded / 4
 For i = 1 To nProcesses
     hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcessID(i))
     If hProcess <> 0 Then
        cb = 8
        cbNeeded = 96
        Do While cb <= cbNeeded
           cb = cb * 2
           ReDim ModuleID(cb / 4)
           Call EnumProcessModules(hProcess, ModuleID(1), cb, cbNeeded)
        Loop
        nModules = cbNeeded / 4
        If nModules > 0 Then
           ModuleName = String(MAX_PATH, 0)
           Call GetModuleFileNameExA(hProcess, ModuleID(1), ModuleName, MAX_PATH)
        End If
        If UCase$(ModuleName) = UCase$(App.Path & "\" & App.EXEName & ".exe") Then GoTo NextLoop
        Pmc.cb = LenB(Pmc)
        Call GetProcessMemoryInfo(hProcess, Pmc, Pmc.cb)
        If Right(StrConv(LCase(TrimNULL(ModuleName)), vbLowerCase), 12) = "explorer.exe" Then
        explorerPIDNT = ProcessID(i)
        Exit Function
        End If
     End If
NextLoop:
     Call CloseHandle(hProcess)
  Next
Exit Function
Error_Handler:
    Dim sComment As String
    sComment = ApiErrorText(Err.LastDllError)
    gError.LogError Err.Number, Err.Description, " In Sub: explorerPIDNT in Module: cStationQueryB " & sComment
End Function

Private Function explorerPID9X() As Long
On Error GoTo Error_Handler:
  Static bAlreadyDone As Boolean
  Dim uProcess As PROCESSENTRY32
  Dim rProcessFound As Long
  Dim hSnapshot As Long
  Dim szExename As String
  Dim exitCode As Long
  Dim myProcess As Long
  Dim AppKill As Boolean
  Dim appCount As Integer
  Dim i As Integer
  Dim nMem As Long
  On Local Error GoTo Finish
  appCount = 0
  uProcess.dwSize = Len(uProcess)
  hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
  rProcessFound = ProcessFirst(hSnapshot, uProcess)
  Do While rProcessFound
     szExename = LCase$(TrimNULL(uProcess.szexeFile))
     myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
     nMem = GetProcessMemUsage(myProcess)
     Call CloseHandle(myProcess)
     If Right(StrConv(szExename, vbLowerCase), 12) = "explorer.exe" Then
       explorerPID9X = uProcess.th32ProcessID
       GoTo van:
     End If
     rProcessFound = ProcessNext(hSnapshot, uProcess)
  Loop
van:
  Call CloseHandle(hSnapshot)
Finish:
Exit Function
Error_Handler:
    Dim sComment As String
    sComment = ApiErrorText(Err.LastDllError)
    gError.LogError Err.Number, Err.Description, " In Sub: explorerPID9X in Module: cStationQueryB " & sComment
End Function

Function GetProcessMemUsage(hProcess As Long) As Long
  Dim lpMem As Long
  Dim lPrivateBytes As Long
  Dim Ret&
  Dim si As SYSTEM_INFO
  Dim mbi As MEMORY_BASIC_INFORMATION
  Dim lLenMbi&
  On Error GoTo Err_Handler:
  GetProcessMemUsage = -1
  lLenMbi = Len(mbi)
  Call GetSystemInfo(si)
  lpMem = si.lpMinimumApplicationAddress
  While lpMem < si.lpMaximumApplicationAddress
      mbi.RegionSize = 0
      Ret = VirtualQueryEx(hProcess, lpMem, mbi, lLenMbi)
      If Ret = lLenMbi Then
          If ((mbi.lType = MEM_private) And (mbi.State = MEM_COMMIT)) Then ' this block is In use by this process
              lPrivateBytes = lPrivateBytes + mbi.RegionSize
          End If
          On Error GoTo Finished
          lpMem = mbi.BaseAddress + mbi.RegionSize
          On Error GoTo 0
      Else
          Exit Function
      End If
  Wend
Finished:
  GetProcessMemUsage = lPrivateBytes
  Exit Function
Err_Handler:
    Dim sComment As String
    sComment = ApiErrorText(Err.LastDllError)
    gError.LogError Err.Number, Err.Description, " In Sub: GetProcessMemUsage in Module: cStationQueryB " & sComment
End Function

Private Function IsWindowNT() As Boolean
On Error GoTo Error_Handler:
 IsWindowNT = Len(Environ$("OS"))
Exit Function
Error_Handler:
    Dim sComment As String
    sComment = ApiErrorText(Err.LastDllError)
    gError.LogError Err.Number, Err.Description, " In Sub: IsWindowNT in Module: cStationQueryB " & sComment
End Function

Private Function TrimNULL(ByVal str As String) As String
On Error GoTo Error_Handler:
  If InStr(str, Chr$(0)) > 0& Then
      TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
  Else
      TrimNULL = str
  End If
Exit Function
Error_Handler:
    Dim sComment As String
    sComment = ApiErrorText(Err.LastDllError)
    gError.LogError Err.Number, Err.Description, " In Sub: TrimNULL in Module: cStationQueryB " & sComment
End Function

Private Function ApiErrorText(ByVal ErrNum As Long) As String
    Dim msg As String
    Dim nRet As Long
    msg = Space$(1024)
    nRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
        ByVal 0&, ErrNum, 0&, msg, Len(msg), ByVal 0&)
    If nRet Then
        ApiErrorText = Left$(msg, nRet)
    Else
        ApiErrorText = "Error (" & ErrNum & ") not defined."
    End If
End Function




0
 
LVL 13

Author Comment

by:crazyman
Comment Utility
TimW1 : I am using that code already but even when my workstation is not logged in it is returning administrator as the logged on user??
0
 
LVL 13

Author Comment

by:crazyman
Comment Utility
I log a load of different items to see if anything changes after login, nothing does :o(


Here is my log...


12/9/03 8:28:01 AM  DeskTop Window = 65588
12/9/03 8:28:01 AM  UserName = Administrator
12/9/03 8:28:01 AM  Fore Win = 0
12/9/03 8:28:01 AM  Shell_Traywnd = 0
12/9/03 8:28:01 AM  Process Window Station = 36
12/9/03 8:28:01 AM  Open Clipboard : 1
12/9/03 8:28:02 AM  DeskTop Window = 65588
12/9/03 8:28:02 AM  UserName = Administrator
12/9/03 8:28:02 AM  Fore Win = 0
12/9/03 8:28:02 AM  Shell_Traywnd = 0
12/9/03 8:28:02 AM  Process Window Station = 36
12/9/03 8:28:02 AM  Open Clipboard : 1
12/9/03 8:28:03 AM  DeskTop Window = 65588
12/9/03 8:28:03 AM  UserName = Administrator
12/9/03 8:28:03 AM  Fore Win = 0
12/9/03 8:28:03 AM  Shell_Traywnd = 0
12/9/03 8:28:03 AM  Process Window Station = 36
12/9/03 8:28:03 AM  Open Clipboard : 1


As you can see 12/9/03 8:28:01 AM  DeskTop Window = 65588
12/9/03 8:28:01 AM  UserName = Administrator
12/9/03 8:28:01 AM  Fore Win = 0
12/9/03 8:28:01 AM  Shell_Traywnd = 0
12/9/03 8:28:01 AM  Process Window Station = 36
12/9/03 8:28:01 AM  Open Clipboard : 1
12/9/03 8:28:02 AM  DeskTop Window = 65588
12/9/03 8:28:02 AM  UserName = Administrator
12/9/03 8:28:02 AM  Fore Win = 0
12/9/03 8:28:02 AM  Shell_Traywnd = 0
12/9/03 8:28:02 AM  Process Window Station = 36
12/9/03 8:28:02 AM  Open Clipboard : 1
12/9/03 8:28:03 AM  DeskTop Window = 65588
12/9/03 8:28:03 AM  UserName = Administrator
12/9/03 8:28:03 AM  Fore Win = 0
12/9/03 8:28:03 AM  Shell_Traywnd = 0
12/9/03 8:28:03 AM  Process Window Station = 36
12/9/03 8:28:03 AM  Open Clipboard : 1

This just repeats itself...

As you can see, always administrator returned as looged in user even when not logged in :o(
0
 
LVL 3

Expert Comment

by:TimW1
Comment Utility
Ok, I will give you the code I was using for the Interactive Station.  I did have a problem with it but it may still help you.
Sorry this code is not refined as I switched to the explorer method.
There is also debug code in there.


Option Explicit
Private Declare Function OpenWindowStation Lib "user32" Alias "OpenWindowStationA" (ByVal lpszWinSta As String, ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseWindowStation Lib "user32" (ByVal hWinSta As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function SetProcessWindowStation Lib "user32" (ByVal hWinSta As Long) As Long
Private Declare Function GetProcessWindowStation Lib "user32" () As Long
Private Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long

Private Const MAXIMUM_ALLOWED = &H2000000

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
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = 4096
Private Declare Function SetThreadDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'---
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
'Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Private Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long
'Private Declare Function SetThreadDesktop Lib "user32" (ByVal hDesktop As Long) As Long
'Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'Private Declare Function GetCurrentProcessId Lib "kernel32" () 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'Public Function GetInteractiveStationUser() As String
'orig: was working, no longer. still some work to do on clean up in this function tho
'    Dim lRet As Long
'    Dim vRet As Variant
'    Dim lStation As Long
'    Dim sWinSt As String
'    Dim lOrigStation As Variant
'    Dim sUserName As String
'    Dim lErr As Long
'    Dim lUserProcessID As Long
'    Dim lUserProcess As Long
'    Dim lAccessToken As Long
'    Dim lUserDesktop As Long
'
'    Dim lThreadSave As Long
'    Dim lStationSave As Long
'    Dim lDeskTopSave As Long
'
'
'    'Save our settings
'    lStationSave = GetProcessWindowStation()
'    'lThreadSave = GetCurrentThreadId()
'    'lDeskTopSave = GetThreadDesktop(lThreadSave)
'
'    sWinSt = Space(255)
'    sWinSt = "Winsta0"
'    On Error GoTo Clean_Up:
'    vRet = OpenWindowStation(sWinSt, False, MAXIMUM_ALLOWED)
'    If IsNull(vRet) Then
'        GetInteractiveStationUser = ""
'        Exit Function
'    ElseIf vRet = 0 Then
'        lErr = Err.LastDllError
'        Exit Function
'    Else
'        lStation = vRet
'    End If
'    'Set the users station to current
'    lRet = SetProcessWindowStation(lStation)
'    If lRet = 0 Then
'        lErr = Err.LastDllError
'        'Err.Raise lErr, , ApiErrorText(lErr)
'        GoTo Clean_Up:
'    End If
'    'Get the users desktop
'    lUserDesktop = OpenDesktop("default", 0, False, MAXIMUM_ALLOWED)
'    'get the processid of the desktop
'    lRet = GetWindowThreadProcessId(lUserDesktop, lUserProcessID)
'    'get the process handle of the desktop process
'    lUserProcess = OpenProcess(MAXIMUM_ALLOWED, 0, lUserProcessID)
'    If lUserProcess = 0 Then
'        GoTo Clean_Up:
'    End If
'    'get the access token of the logged on user
'    lRet = OpenProcessToken(lUserProcess, MAXIMUM_ALLOWED, lAccessToken)
'    If lAccessToken = 0 Then
'        lErr = Err.LastDllError
'        GoTo Clean_Up:
'    End If
'    'impersonate the user
'    lRet = ImpersonateLoggedOnUser(lAccessToken)
'    'now finally get the username
'    sUserName = CurrentUser()
'    GetInteractiveStationUser = sUserName
'Clean_Up:
'    If lUserProcess <> 0 Then
'        CloseHandle lUserProcess
'    End If
'    If lUserDesktop <> 0 Then
'        CloseDesktop lUserDesktop
'    End If
'    If lStationSave <> 0 Then
'        SetProcessWindowStation lStationSave
'    End If
'    If lAccessToken <> 0 Then
'        RevertToSelf
'    End If
'    CloseWindowStation lStation
'End Function



Public Function GetInteractiveStationUser() As String
'inprogress mod ver after this function stopped working
    Dim lRet As Long
    Dim vRet As Variant
    Dim lStation As Long
    Dim sWinSt As String
    Dim lOrigStation As Variant
    Dim sUserName As String
    Dim lErr As Long
    Dim lUserProcessID As Long
    Dim lUserProcess As Long
    Dim lAccessToken As Long
    Dim lUserDesktop As Long

    Dim lThreadSave As Long
    Dim lStationSave As Long
    Dim lDeskTopSave As Long

    'Save our settings
    lStationSave = GetProcessWindowStation()
    lThreadSave = GetCurrentThreadId()
    lDeskTopSave = GetThreadDesktop(lThreadSave)

    sWinSt = Space(255)
    sWinSt = "WinSta0"
    On Error GoTo Clean_Up:
    vRet = OpenWindowStation(sWinSt, False, MAXIMUM_ALLOWED)
    If IsNull(vRet) Then
        MsgBox "Could not open windows station Winsta0" 'Debug:LoggedOnUser
        GetInteractiveStationUser = ""
        GoTo Clean_Up:
        Exit Function
    ElseIf vRet = 0 Then
        MsgBox "OpenWindowStation Returned 0" 'Debug:LoggedOnUser
        lErr = Err.LastDllError
        GoTo Clean_Up:
        Exit Function
    Else
        lStation = vRet
    End If
    'Set the users station to current
    lRet = SetProcessWindowStation(lStation)
    If lRet = 0 Then
        MsgBox "SetProcessWindowStation Failed" 'Debug:LoggedOnUser
        lErr = Err.LastDllError
        'Err.Raise lErr, , ApiErrorText(lErr)
        GoTo Clean_Up:
    End If
    'Get the users desktop
    lUserDesktop = OpenDesktop("Default", 0, False, MAXIMUM_ALLOWED)
    MsgBox "Opening default desktop : " & lUserDesktop 'Debug:LoggedOnUser
    'get the processid of the desktop
    'MS example calls reverttoSelf here.
    RevertToSelf
    lRet = SetThreadDesktop(lUserDesktop)
    MsgBox "SetThreadDesktop returns: " & lRet
    'MS example then Calls SetThreadDesktop(hdeskUser);
    'SetThreadDesktop lUserDesktop 'Debug:LoggedOnUser
    'MsgBox "After SetThreadDesktop CurrentUser Returns: " & CurrentUser
    Dim lDeskThreadID As Long 'Debug:
    'lRet = GetWindowThreadProcessId(lUserDesktop, lUserProcessID)
    lRet = GetWindowThreadProcessId(lUserDesktop, lDeskThreadID)
    MsgBox "Desktop Thread is: " & lDeskThreadID
    MsgBox "GetWindowThreadPRocessID Returned: " & lRet
    MsgBox "Win Err: " & ApiErrorText(Err.LastDllError)
    SetThreadDesktop lDeskThreadID 'Debug:LoggedOnUser
    MsgBox "After SetThreadDesktop CurrentUser Returns: " & CurrentUser
    'get the process handle of the desktop process
    'vRet = OpenProcess(MAXIMUM_ALLOWED, False, lUserProcessID)
    vRet = OpenProcess(MAXIMUM_ALLOWED, False, lDeskThreadID)
    If IsNull(vRet) Then
        MsgBox "Failed to open desktop process. Current User: " & CurrentUser 'Debug:LoggedOnUser
        MsgBox "Win Err: " & ApiErrorText(Err.LastDllError)

        GoTo Clean_Up:
    Else
        lUserProcess = CLng(vRet)
    End If
    'get the access token of the logged on user
    lRet = OpenProcessToken(lUserProcess, MAXIMUM_ALLOWED, lAccessToken)
    If lAccessToken = 0 Then
        MsgBox "Failed to open process token" 'Debug:LoggedOnUser
        lErr = Err.LastDllError
        MsgBox "Win Err:" & ApiErrorText(lErr)
        GoTo Clean_Up:
    End If
    'impersonate the user
    lRet = ImpersonateLoggedOnUser(lAccessToken)
    MsgBox "Impersonation returned " & lRet 'Debug:LoggedOnUser
    'now finally get the username
    sUserName = CurrentUser()
    MsgBox "CurrentUser returned : " & sUserName 'Debug:LoggedOnUser
    GetInteractiveStationUser = sUserName
Clean_Up:
    lRet = SetProcessWindowStation(lStationSave)
    If lUserProcess <> 0 Then
        CloseHandle lUserProcess
    End If
    If lUserDesktop <> 0 Then
        CloseDesktop lUserDesktop
    End If
    If lStationSave <> 0 Then
        SetProcessWindowStation lStationSave
    End If
    'If lAccessToken <> 0 Then
        RevertToSelf
   ' End If
    CloseWindowStation lStation
End Function
Private Function ApiErrorText(ByVal ErrNum As Long) As String
    Dim msg As String
    Dim nRet As Long
    msg = Space$(1024)
    nRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
        ByVal 0&, ErrNum, 0&, msg, Len(msg), ByVal 0&)
    If nRet Then
        ApiErrorText = Left$(msg, nRet)
    Else
        ApiErrorText = "Error (" & ErrNum & ") not defined."
    End If
End Function

Private Function CurrentUser() As String
    Dim l As Long
    Dim sUser As String

    sUser = Space(255)
    l = GetUserName(sUser, 255)
    'strip null terminator
    If l <> 0 Then
        CurrentUser = Left(sUser, InStr(sUser, Chr(0)) - 1)
    End If
End Function

Private Sub Form_Load()
    MsgBox GetInteractiveStationUser
End Sub
0
 
LVL 26

Expert Comment

by:EDDYKT
Comment Utility
Can you post you code somewhere? I don't want to create a new project to test.
0
 
LVL 26

Expert Comment

by:EDDYKT
Comment Utility
Have you tried both functions?

loggedusername and loggeduser_with_pc_name

What OS are you using?
0
 
LVL 26

Expert Comment

by:EDDYKT
Comment Utility
Do you get it working now?
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

762 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now