Detecting when windows is logged off or shut down 1

[AncientTiger]

thread222-1243704

Could someone give me a code example of this? Needing my exe to log when a user logged off / shut windows down at XX date/time, but not sure how to code the event trigger....

Thanks


------------------------------------
Over 35 years of programming, and still learning every day!

 

[strongm]

Unfortunately, due to an error about 18 months ago, the oroginal VB.NET and V5/6 forums were temporarily merged - and, whilst, this forum was then named back to Classic VB it was not possible to unmerge the .NET posts. And the post you are referring to is for .NET, not classic VB.

Fortunately VB6 already pretty much has this capability.

C ehck out a form's QueryUnload event, and the UnloadMode argument - vbAppWindows this represents the session logging offf or system shutting down. Should be pretty much what you are looking for, as far as I can tell.

 

[AncientTiger]

Thanks for the reply Strongm! Sorry, I didn't see this until just now. The unload event was perfect... now one more good one... IS there a way to detect when users lock their session? As opposed to logging off or restarting/shutting down, we have some that just lock their screens, so my program has no way of knowing that they're A.F.K.

Thanks in advance

------------------------------------
Over 35 years of programming, and still learning every day!

 

[AncientTiger]

Ok, I found a snippet of code that works in Windows 7 when the screen is locked..... but it won't work in Windows 10. Any suggestions?

        Option Explicit
         
        Public Const DESKTOP_CREATEMENU = &H4&
        Public Const DESKTOP_CREATEWINDOW = &H2&
        Public Const DESKTOP_ENUMERATE = &H40&
        Public Const DESKTOP_HOOKCONTROL = &H8&
        Public Const DESKTOP_JOURNALPLAYBACK = &H20&
        Public Const DESKTOP_JOURNALRECORD = &H10&
        Public Const DESKTOP_READOBJECTS = &H1&
        Public Const DESKTOP_WRITEOBJECTS = &H80&
        Public Const DESKTOP_SWITCHDESKTOP = &H100&
         
         
        Public Const SPI_SCREENSAVERRUNNING = 114
        Public Declare Function SystemParametersInfoSS _
                Lib "user32" Alias "SystemParametersInfoA" _
                (ByVal uAction As Long, ByVal uParam As Long, _
                ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
                
        Public Declare Function SwitchDesktop _
                Lib "user32" _
                (ByVal hDesktop As Long) As Boolean
                
        Public 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
         
        Public Function SSRunning() As Boolean
            Dim lRetVal         As Long
            Dim lRunning        As Long
            On Error Resume Next
            lRetVal = SystemParametersInfoSS(SPI_SCREENSAVERRUNNING, 0&, lRunning, 0&)
            lRetVal = SystemParametersInfoSS(SPI_SCREENSAVERRUNNING, lRunning, 0&, 0&)
            If lRunning <> 0 Then
                SSRunning = True
            End If
        End Function
         
        Public Function DesktopLocked() As Boolean
            Dim lngHWnd As Long
            Dim lngRtn As Long
            Dim lngErr As Long
            
            DesktopLocked = False
            
            lngHWnd = OpenDesktop("Default", 0, False, DESKTOP_SWITCHDESKTOP)
                
            If lngHWnd = 0 Then
                Debug.Print "Error with OpenDesktop: " & Err.LastDllError
                Else
                lngRtn = SwitchDesktop(hDesktop:=lngHWnd)
                lngErr = Err.LastDllError
                If lngRtn = 0 Then
                    If lngErr = 0 Then
                        Debug.Print "Desktop is locked: "
                        DesktopLocked = True
                    Else
                        Debug.Print "Error with SwitchDesktop: " & Err.LastDllError
                    End If
                End If
            End If
        End Function

------------------------------------
Over 35 years of programming, and still learning every day!

 

[Andrzejek]

some that just lock their screens, so my program has no way of knowing that they're A.F.K.

Could you share why your program cares if your user seats at his/her desk or is away from the keyboard?


---- Andy

There is a great need for a sarcasm font.

 

[AncientTiger]

It's a sign in/out program to help operators know when folks are in their office and out. If they leave their desk, they either log off/restart or lock their screens. My program is good at catching the Unload event and logging the person as OUT, but if they lock their screens, then there IS no unload event, the program still runs.

So, I need some way for it to detect that the users screen has been locked, and show the user as OUT, then when they get back, the program detects that their screen is unlocked and shows them as IN.

Simple enough for me to set a timer to check ever X seconds for a screen lock, but the code that checks for that has thus far eluded me. As I said, the above code works great in Windows 7 (I had to change the err # from 0 to 5 -- If lngErr = 5 Then -- to get it to work, but it worked), but when I tested it in Win10, it was a no-go.

------------------------------------
Over 35 years of programming, and still learning every day!

 

[strongm]

The following, which is very similar to your example, seems to work fine on W10 (not my code for once, BTW, didn't feel like reinventing the wheel ... source here):

[blue]Option Explicit

Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100


Function Check_If_Locked() As String
    Dim p_lngHwnd As Long
    Dim p_lngRtn As Long
    Dim p_lngErr As Long
    Dim system As String
    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
    If p_lngHwnd = 0 Then
        system = "Error"
    Else
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
        p_lngErr = Err.LastDllError

        If p_lngRtn = 0 Then
            If p_lngErr = 0 Then
                system = "Locked"
            Else
                system = "Error"
            End If
        Else
            system = "Unlocked"
        End If
        p_lngHwnd = CloseDesktop(p_lngHwnd)
    End If
    Check_If_Locked = system
End Function[/blue]

 

[Andrzejek]

Simple enough for me to set a timer to check ever X seconds for a screen ..." activity, like a Mouse_Move over the Form. So if the user is still logged in, not locked the computer, but away from his/her computer, "they leave their desk " for, let's say more than X seconds / minutes, - they are OUT (as far as operator is concerned)

Would that work...?



---- Andy

There is a great need for a sarcasm font.

 

[strongm]

Got some code for that actually, written about 16 years ago ... thread222-933476

 

[AncientTiger]

activity, like a Mouse_Move over the Form. So if the user is still logged in, not locked the computer, but away from his/her computer, "they leave their desk " for, let's say more than X seconds / minutes, - they are OUT (as far as operator is concerned)

Would that work...?

Good suggestion, however the program minimizes to the taskbar onLoad and stays out of the users way. I really wanted it to be as unobtrusive as possible. So, it would rarely, if ever, get a mouseover event. Again, good thought tho!

Strongm, your code example worked like a charm in Win10!!! Thank you!

However, even though it's detecting a locked session, when I call the routine to update the Access database on our shared network drive that that program uses, it's not updating the users profile.

I suspect since it's a locked session, it won't send SQL commands to a db file on a network drive? Sorry, still trying to sort through the maze that is Win10......

Got some code for that actually, written about 16 years ago ... thread222-933476: Detect inactivity

COOL!!!! I'm going to keep that example for future usage
------------------------------------
Over 35 years of programming, and still learning every day!

 

[AncientTiger]

Strongm, your code example worked like a charm in Win10!!! Thank you!

Well.... hold on... after experimentation I learn that even though it appears to be working, there's problems...

I set up a test script to monitor the function every 5 seconds to see if the screen was locked or not, write a text file with the function return value in the file name, and to also log the result in a text box.

Here's what I saw:

So, even though the script was performing the checks like it was supposed to, after locking the returned value was still "Unlocked", even though I know the screen was locked.
It returned "Locked" just as I signed back on.

So... close but not quite a cigar

Maybe I'm missing something...

Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100
Function Check_If_Locked() As String
    Dim p_lngHwnd As Long
    Dim p_lngRtn As Long
    Dim p_lngErr As Long
    Dim system As String
    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
    If p_lngHwnd = 0 Then
        system = "Error"
    Else
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
        p_lngErr = Err.LastDllError

        If p_lngRtn = 0 Then
            If p_lngErr = 0 Then
                system = "Locked"
            Else
                system = "Error"
            End If
        Else
            system = "Unlocked"
        End If
        p_lngHwnd = CloseDesktop(p_lngHwnd)
    End If
    Check_If_Locked = system
End Function
Public Sub MONITOR()


While MAIN.COMMDSTART.Enabled = False And MAIN.Visible = True  'a userform with a command button that starts this script/ clicking another re-enables it and breaks the loop

    ET = Timer + 5
    While Timer < ET And MAIN.COMMDSTART.Enabled = False And MAIN.Visible = True
        DoEvents
    Wend
    T = Format(Trim(Str(Time)), "HH.MM.SS")
    FNAME = Check_If_Locked + "@" + T + ".TXT"
    Open "H:\TEST\" + FNAME For Output As 1
    Print #1, "TEST"
    Close 1
    DoEvents
    With MAIN.TB
        .Text = .Text + Check_If_Locked + " -- " + FNAME + Chr(13) + Chr(10)
    End With
    
    
    
Wend


End Sub

(I was using Excel at the time, since I don't have my VB editor on my work PC, just on my laptop)



------------------------------------
Over 35 years of programming, and still learning every day!

 

[strongm]

>(I was using Excel at the time

I also tested in Excel, since I don't have VB6 installed on my W10 PC. And, as I say, it worked fine. BUT!!! it only reports locked whilst the lock screen (rather than rthe screensaver) is showing - i.e the screen with the password input dialog. Knew I should have written my own version ...

Module

[blue]Option Explicit

Public Sub timerloop()
     Debug.Print "Locked: " & IsSessionLocked, Format(Trim(Str(Time)), "HH.MM.SS")
     If UserForm1.chkTimerEnabled Then Application.OnTime Now + TimeValue("00:00:05"), "timerloop"
End Sub

Function IsSessionLocked(Optional strComputer As String = ".")
    With GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        IsSessionLocked = .ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count > 0
    End With
End Function
[/blue]

userform with a checkbox called chkTimerEnabled

[blue]Private Sub chkTimerEnabled_Click()
    timerloop
End Sub[/blue]

 

[AncientTiger]

Thanks Strongm, I will give it a try when I get back to work tomorrow! This evening it's a fine cigar and a smattering of scotch for this old cat.

And you mentioned not having VB6 on your Win10 machine...I recently stumbled upon this article about installing our beloved editor in the new OS,in case you're wanting to:

https://www.codeproject.com/Articles/1191047/Install-Visual-Studio-on-Windows

------------------------------------
Over 35 years of programming, and still learning every day!

 

[strongm]

Thanks . I have to say I am fairly familiar with how to install on W10 - just don't really see the need these days, sadly. I have a VM with VB6 installed that I can spin up whenever I need to.

 

[AncientTiger]

Function IsSessionLocked(Optional strComputer As String = ".")
With GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
IsSessionLocked = .ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count > 0
End With
End Function

THAT DID THE TRICK WONDERFULLY!!!!!!!!!

Working like a charm now, fully tested and good to go

Thanks a ton Strongm!


------------------------------------
Over 35 years of programming, and still learning every day!