Solved

Detect when windows is logged in

Posted on 2003-12-05
10
821 Views
Last Modified: 2007-12-19
I have a service written in vb using NTSVC.ocx the service is running under its own user id and therefore cannot be interactive, works fine excpet i need to detect if windows is logged in or not, i have tried checking to see if the windows toolbar window exists (FindWindow "Shell_TrayWnd") but it doesnt ever find it, i have also tried checking the UserName (GetUserName) but this always returns the name of the user id the service is running under.

Is there any way to detect the logged on user id or any other way to find if windows is logged in?
0
Comment
Question by:crazyman
10 Comments
 
LVL 26

Accepted Solution

by:
EDDYKT earned 500 total points
ID: 9881924
0
 
LVL 17

Expert Comment

by:inthedark
ID: 9883294
There is a simple way I use when I create a service which can run either in background mode or become interactive when the user logs in....it is very simple.

Windows sends all apps a windows message when a user logs in and a desktop is created.

It is the TASKBARCREATED message.  You cannot register a systray icon until you receive this message as your app will crash if your try to doit before.

Hope this helps:~)

Here is the code:

Step 1 when you app starts you need to get the value of the task bar created message:

' in a module:
Global  WM_TASKBARCREATED As Long
Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long

' in your form_load
WM_TASKBARCREATED = RegisterWindowMessage("TaskbarCreated")

Your form now needs to setup a hook

SubClass Me.Hwnd

Private Sub SubClass(hwnd As Long)

  'assign our own window message
  'procedure (WindowProc)

   YourFormHwnd = hwnd ' a global long
 
   On Error Resume Next
   defWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SystrayProc)
   isSubclassed = True
   
End Sub

In your form unload you need to call this:

Private Sub UnSubClass()

  'restore the default message handling
  'before exiting
   If defWindowProc <> 0 Then
      SetWindowLong mFrm.hwnd, GWL_WNDPROC, defWindowProc
      defWindowProc = 0
      isSubclassed = False
   End If
   
End Sub



In a module:

Public Function SystrayProc(ByVal hwnd As Long, _
                           ByVal uMsg As Long, _
                           ByVal wParam As Long, _
                           ByVal lParam As Long) As Long

  'window message procedure
  '
  'If the handle returned is to our form,
  'call a form-specific message handler to
  'deal with the tray notifications.  If it
  'is a general system message, pass it on to
  'the default window procedure.
  '
  'If its ours, we look at lParam for the
  'message generated, and react appropriately.
   On Error Resume Next
 
   Select Case hwnd
   
     'form-specific handler
      Case YourFormHwnd
         
                 
             Case WM_TASKBARCREATED
           
                   TimerHandle = SetTimer(0, 0, 0, AddressOf RebuildSystray)
                   
             ' place other hooks here      
               
 
           
            Case Else
           
               SystrayProc = CallWindowProc(defWindowProc, _
                                            hwnd, _
                                            uMsg, _
                                            wParam, _
                                            lParam)
               Exit Function
           
         End Select

     
     'this takes care of messages when the
     'handle specified is not that of the form
      Case Else
     
          SystrayProc = CallWindowProc(defWindowProc, _
                                      hwnd, _
                                      uMsg, _
                                      wParam, _
                                      lParam)
   End Select
   
End Function


Sub RebuildSystray()
KillTimer 0, TimerHandle

' now you know that a user has logged on.

End Sub

You also need a few declarations:

Get/SetWindowLong messages
Public Const GWL_WNDPROC As Long = (-4)
Public Const GWL_HWNDPARENT As Long = (-8)
Public Const GWL_ID As Long = (-12)
Public Const GWL_STYLE As Long = (-16)
Public Const GWL_EXSTYLE As Long = (-20)
Public Const GWL_USERDATA As Long = (-21)

'general windows messages
Public Const WM_USER As Long = &H400
Public Const WM_MYHOOK As Long = WM_USER + 1
Public Const WM_NOTIFY As Long = &H4E
Public Const WM_COMMAND As Long = &H111
Public Const WM_CLOSE As Long = &H10

'Event notification constants for callback handle
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK As Long = &H203

Public Const WM_MBUTTONDOWN As Long = &H207
Public Const WM_MBUTTONUP As Long = &H208
Public Const WM_MBUTTONDBLCLK As Long = &H209

Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLCLK As Long = &H206


Public Declare Function SetForegroundWindow Lib "user32" _
   (ByVal hwnd As Long) As Long
   
Public Declare Function PostMessage Lib "user32" _
   Alias "PostMessageA" _
   (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
   
'Public Declare Function SetWindowLong Lib "user32" _
'   Alias "SetWindowLongA" _
'   (ByVal hwnd As Long, _
'    ByVal nIndex As Long, _
'    ByVal dwNewLong As Any) As Long

Public Declare Function CallWindowProc Lib "user32" _
   Alias "CallWindowProcA" _
   (ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
'Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
                           
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Public Const GWL_WNDPROC = (-4)

'Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
'Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
'Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long


Public WM_TASKBARCREATED As Long
Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 9883341
>>I have a service written in vb using NTSVC.ocx the service is running under its own user id

I don't think it work because service doesn't allow to interact with desktop if not run as system user
0
 
LVL 13

Author Comment

by:crazyman
ID: 9902585
EDDYKT: That code seems to work however im getting Logged on user administrator even when the box is not logged in?
0
 
LVL 3

Expert Comment

by:TimW1
ID: 9902989
I have posted code for you in your other question:
http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20817364.html

Also to detect if someone is logged in or not (my service is interactive tho) I try to create a task bar icon using NotifyIcon.  And the app doesn't crash if the call fails.
0
What Security Threats Are You Missing?

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.

 
LVL 26

Expert Comment

by:EDDYKT
ID: 9903904
I 've slight modified the code from the link and works now


Option Explicit


'/////////////////////////////////////////////////
'///        CODE created by MORFEUS            ///
'///             2003. CROATIA                 ///
'/// getting user name when running in service ///
'/////////////////////////////////////////////////

' declaration of functions that we need
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
Dim a
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 = "NO USER": 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
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)
End Function
Public Function loggeduser_with_pc_name() As String
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 loggeduser_with_pc_name = "NO USER": 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)
End Function

Private Function explorerpid() As Long
explorerpid = -1
  If IsWindowNT Then
     explorerpid = explorerPIDNT
  Else
     explorerpid = explorerPID9X
  End If
End Function
Private Function explorerPIDNT() As Long
  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
  explorerPIDNT = -1
  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
End Function

Private Function explorerPID9X() As Long
   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
   explorerPID9X = -1
   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:
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&
   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
End Function

Private Function IsWindowNT() As Boolean
  IsWindowNT = Len(Environ$("OS"))
End Function

Private Function TrimNULL(ByVal str As String) As String
   If InStr(str, Chr$(0)) > 0& Then
       TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
   Else
       TrimNULL = str
   End If
End Function
0
 
LVL 13

Author Comment

by:crazyman
ID: 9903946
GetUserNameEx fails in NT says it cant find the file secur32.dll
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 9913384
Do you get it working now?

I know you close the other question
0
 
LVL 13

Author Comment

by:crazyman
ID: 9913420
yeh, seems wierd.
On my machine it shows administrator even when the machine is just rebooted, not logged in at all and i map to it and read my log file..
However i tried it on one of the servers it will be used on and it seems to work okay.
Cheers for your help mate.
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 9913771
Try my last modified code. It happens to me before I use the new code
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

747 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