(nobody)
8/30/2010 4:38:00 PM
If one of you has Citrix Presentation Server, which is based on Windows 2003
Server, can you try this software and post the result? I already tried this
on Citrix XenApp, which is based on Windows 2008 Server. XenApp is the new
name for Citrix Presentation Server. I don't have the 2003 version server,
and I need to run the following code to see if it sends WM_WTSSESSION_CHANGE
to my app when a single published application is started. In reality, I have
a service running that sees this message through HandlerEx() function, but I
don't think that I would get the customer cooperation to run one or more
diagnostic versions to see if my software is getting this message.
To try this software, add a TextBox to Form1, set ScrollBars property to
Both, and MultiLine to True, then past the following code. After running the
program, try starting a single published application, not on a full desktop,
but just one application, and post the result which are written to the
TextBox. Here is a sample output when I run it on XP+SP2, and use Fast User
Switching, then logon as another user, then logoff and switch back to the
original console session:
WTSRegisterSessionNotification returned 1
12:29:50 PM: Session ID = -1, Event: Lock
12:29:55 PM: Session ID = -1, Event: Console Disconnect
12:29:55 PM: Session ID = -1, Event: Unlock
12:29:55 PM: Session ID = -1, Event: Console Connect
12:29:56 PM: Session ID = -1, Event: Logon
12:30:15 PM: Session ID = -1, Event: Logoff
12:30:15 PM: Session ID = -1, Event: Console Connect
12:30:21 PM: Session ID = -1, Event: Console Disconnect
12:30:21 PM: Session ID = -1, Event: Console Connect
Here is the source code(Requires XP+):
' Form1 code =======================================
Option Explicit
Private Sub Form_Load()
Text1.Text = ""
SubClass Me.hWnd
Text1.Text = "WTSRegisterSessionNotification returned " & _
WTSRegisterSessionNotification(Me.hWnd, _
NOTIFY_FOR_ALL_SESSIONS) & vbCrLf
End Sub
Private Sub Form_Unload(Cancel As Integer)
Debug.Print WTSUnRegisterSessionNotification(Me.hWnd)
UnSubClass Me.hWnd
End Sub
' Module1 code =======================================
Option Explicit
' Terminal Services API
Public Const WM_WTSSESSION_CHANGE As Long = &H2B1&
' Codes passed in WPARAM for WM_WTSSESSION_CHANGE
Public Const WTS_CONSOLE_CONNECT As Long = &H1
Public Const WTS_CONSOLE_DISCONNECT As Long = &H2
Public Const WTS_REMOTE_CONNECT As Long = &H3
Public Const WTS_REMOTE_DISCONNECT As Long = &H4
Public Const WTS_SESSION_LOGON As Long = &H5
Public Const WTS_SESSION_LOGOFF As Long = &H6
Public Const WTS_SESSION_LOCK As Long = &H7
Public Const WTS_SESSION_UNLOCK As Long = &H8
Public Const WTS_SESSION_REMOTE_CONTROL As Long = &H9
' Flags for WTSRegisterSessionNotification()
Public Const NOTIFY_FOR_THIS_SESSION As Long = 0
Public Const NOTIFY_FOR_ALL_SESSIONS As Long = 1
Public Type WTSSESSION_NOTIFICATION
cbSize As Long
dwSessionId As Long
End Type
Public Declare Function WTSRegisterSessionNotification Lib "Wtsapi32" ( _
ByVal hWnd As Long, ByVal dwFlags As Long) As Long
Public Declare Function WTSUnRegisterSessionNotification Lib "Wtsapi32" ( _
ByVal hWnd As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
' Subclassing API
Public Const GWL_WNDPROC As Long = (-4)
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong 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 oldWindowProc As Long
Public Sub SubClass(ByVal hWnd As Long)
oldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnSubClass(ByVal hWnd As Long)
If oldWindowProc <> 0 Then
SetWindowLong hWnd, GWL_WNDPROC, oldWindowProc
End If
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo WindowProc_Error
Dim s As String
Dim wts As WTSSESSION_NOTIFICATION
Dim dwSessionId As Long
If Msg = WM_WTSSESSION_CHANGE Then
Select Case wParam
Case WTS_CONSOLE_CONNECT: s = "Console Connect"
Case WTS_CONSOLE_DISCONNECT: s = "Console Disconnect"
Case WTS_REMOTE_CONNECT: s = "Remote Connect"
Case WTS_REMOTE_DISCONNECT: s = "Remote Disconnect"
Case WTS_SESSION_LOGON: s = "Logon"
Case WTS_SESSION_LOGOFF: s = "Logoff"
Case WTS_SESSION_LOCK: s = "Lock"
Case WTS_SESSION_UNLOCK: s = "Unlock"
Case WTS_SESSION_REMOTE_CONTROL: s = "Remote Control"
End Select
' Get the Session ID
dwSessionId = -1 ' Assume invlid Session ID
Debug.Print "lParam = " & lParam
If lParam <> 0 Then
CopyMemory wts, lParam, LenB(wts)
Debug.Print wts.cbSize, wts.dwSessionId
If wts.cbSize >= 8 Then
dwSessionId = wts.dwSessionId
End If
End If
AppendLog Time & ": Session ID = " & dwSessionId & ", Event: " & s
End If
WindowProc = CallWindowProc(oldWindowProc, hWnd, Msg, wParam, lParam)
ExitSub:
Exit Function
WindowProc_Error:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Function
Public Sub AppendLog(ByRef s As String)
Form1.Text1.SelStart = Len(Form1.Text1.Text)
Form1.Text1.SelText = s & vbCrLf
End Sub