'Anders Wåglund
'Download http://www.vbaccelerator.com/home/VB/Code/Libraries/Subclassing/SSubTimer/VB6_SSubTmr_Binary.asp, register it and add a reference to it
Option Explicit
Private Declare Function WTSRegisterSessionNotification Lib "Wtsapi32" (ByVal hwnd As Long, ByVal THISSESS As Long) As Long
Private Declare Function WTSUnRegisterSessionNotification Lib "Wtsapi32" (ByVal hwnd As Long) As Long
Private Const NOTIFY_FOR_ALL_SESSIONS As Long = 1
Private Const NOTIFY_FOR_THIS_SESSION As Long = 0
Private Const WM_WTSSESSION_CHANGE As Long = &H2B1
Private Const WTS_CONSOLE_CONNECT As Long = 1
Private Const WTS_CONSOLE_DISCONNECT As Long = 2
Private Const WTS_REMOTE_CONNECT As Long = 3
Private Const WTS_REMOTE_DISCONNECT As Long = 4
Private Const WTS_SESSION_LOGON As Long = 5
Private Const WTS_SESSION_LOGOFF As Long = 6
Private Const WTS_SESSION_LOCK As Long = 7
Private Const WTS_SESSION_UNLOCK As Long = 8
Private Const WTS_SESSION_REMOTE_CONTROL As Long = 9
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Private Declare Function GetLastError Lib "kernel32" () 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
Implements ISubclass
Private Sub Command1_Click()
Dim ret As Boolean
ret = WTSRegisterSessionNotification(Me.hwnd, NOTIFY_FOR_ALL_SESSIONS)
If Not ret Then
Debug.Print GetError(Err.LastDllError)
Else
AttachMessage Me, Me.hwnd, WM_WTSSESSION_CHANGE
End If
End Sub
Private Sub Command2_Click()
If Not WTSUnRegisterSessionNotification(Me.hwnd) Then
Debug.Print GetError(Err.LastDllError)
End If
DetachMessage Me, Me.hwnd, WM_WTSSESSION_CHANGE
End Sub
Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer6.EMsgResponse)
'
End Property
Private Property Get ISubclass_MsgResponse() As SSubTimer6.EMsgResponse
'
End Property
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_WTSSESSION_CHANGE
Select Case wParam
Case WTS_CONSOLE_CONNECT
Debug.Print "A session was connected to the console session."
Case WTS_CONSOLE_DISCONNECT
Debug.Print "A session was disconnected from the console session."
Case WTS_REMOTE_CONNECT
Debug.Print "A session was connected to the remote session."
Case WTS_REMOTE_DISCONNECT
Debug.Print "A session was disconnected from the remote session."
Case WTS_SESSION_LOGON
Debug.Print "A user has logged on to the session."
Case WTS_SESSION_LOGOFF
Debug.Print "A user has logged off the session."
Case WTS_SESSION_LOCK
Debug.Print "A session has been locked."
Case WTS_SESSION_UNLOCK
Debug.Print "A session has been unlocked."
Case WTS_SESSION_REMOTE_CONTROL
Debug.Print "A session has changed its remote controlled status. To determine the status, call GetSystemMetrics and check the SM_REMOTECONTROL metric."
End Select
End Select
End Function
Private Function GetError(ByVal lErrorNumber As Long) As String
Dim Buffer As String
Buffer = Space(200)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErrorNumber, LANG_NEUTRAL, Buffer, 200, ByVal 0&
GetError = Buffer
End Function