Fast User Switching
[SwitchUser.JPG]
If you want to switch users or lock the work station, you'll need these APIs and these functions.
[VB0575.JPG].NET
Const WM_COMMAND As Int32 = 273
Const WTS_CURRENT_SESSION As Int32 = -1
Const WTS_CURRENT_SERVER_HANDLE As Int32 = 0
Private Declare Auto Function apiLockWorkStation Lib _
"user32" Alias "LockWorkStation" () As Int32
Private Declare Auto Function apiWTSDisconnectSession Lib _
"wtsapi32" Alias "WTSDisconnectSession" _
(ByVal hServer As Int32, _
ByVal SessionId As Int32, _
ByVal bWait As Boolean) As Boolean
Private Declare Auto Function apiWTSLogoffSession Lib _
"wtsapi32" Alias "WTSLogoffSession" _
(ByVal hServer As Int32, _
ByVal SessionId As Int32, _
ByVal bWait As Boolean) As Boolean
Private Declare Auto Function apiWTSOpenServer Lib _
"wtsapi32" Alias "WTSOpenServer" _
(ByVal pServerName As String) As Int32
Private Declare Auto Function apiWTSCloseServer Lib _
"wtsapi32" Alias "WTSCloseServer" _
(ByVal hServer As Int32) As Boolean
Private Declare Function apiGetAsyncKeyState Lib _
"user32" Alias "GetAsyncKeyState" _
(ByVal vKey As Int32) As Int32
Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Int32
Private Declare Function apiSendMessage Lib _
"user32" Alias "SendMessageA" _
(ByVal hWnd As Int32, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As String) As Int32
Private Function DissconnectSession _
(ByVal ServerName As String, ByVal SessionID As Integer) _
As Boolean
On Error Resume Next
Dim OpenedServer As Int32
OpenedServer = WTS_CURRENT_SERVER_HANDLE
If ServerName <> "" Then
OpenedServer = apiWTSOpenServer(ServerName)
End If
If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
DissconnectSession = apiWTSDisconnectSession _
(OpenedServer, SessionID, False)
apiWTSCloseServer(OpenedServer)
End Function
Private Function LogoffSession _
(Optional ByVal ServerName As String, _
Optional ByVal SessionID As Int32) As Boolean
On Error Resume Next
Dim OpenedServer As Int32
OpenedServer = WTS_CURRENT_SERVER_HANDLE
If ServerName <> "" Then
OpenedServer = apiWTSOpenServer(ServerName)
End If
If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
LogoffSession = apiWTSLogoffSession _
(OpenedServer, SessionID, False)
apiWTSCloseServer(OpenedServer)
End Function
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Button1.Click
IsFastUserSwitching()
If apiGetAsyncKeyState(Keys.ControlKey) <> 0 AndAlso _
apiGetAsyncKeyState(Keys.ShiftKey) <> 0 Then
LogoffSession()
ElseIf sLock = False OrElse _
apiGetAsyncKeyState(Keys.ShiftKey) <> 0 Then
apiLockWorkStation()
ElseIf apiGetAsyncKeyState(Keys.ControlKey) <> 0 Then
Dim tBar As Int32
tBar = apiFindWindow("Shell_TrayWnd", vbNullString)
apiSendMessage(tBar, WM_COMMAND, 402, vbNullString)
Else
DissconnectSession()
End If
End Sub
[VB675.JPG]VB6
Const WM_COMMAND As Long = 273
Const VK_SHIFT As Long = 16
Const VK_CONTROL As Long = 17
Const WTS_CURRENT_SESSION As Long = -1
Const WTS_CURRENT_SERVER_HANDLE As Long = 0
Private Declare Function apiLockWorkStation Lib _
"user32" Alias "LockWorkStation" () As Long
Private Declare Function apiWTSDisconnectSession Lib _
"wtsapi32" Alias "WTSDisconnectSession" _
(ByVal hServer As Long, ByVal SessionID As Long, _
ByVal bWait As Boolean) As Boolean
Private Declare Function apiWTSLogoffSession Lib _
"wtsapi32" Alias "WTSLogoffSession" _
(ByVal hServer As Long, ByVal SessionID As Long, _
ByVal bWait As Boolean) As Boolean
Private Declare Function apiWTSOpenServer Lib _
"wtsapi32" Alias "WTSOpenServer" _
(ByVal pServerName As String) As Long
Private Declare Function apiWTSCloseServer Lib _
"wtsapi32" Alias "WTSCloseServer" _
(ByVal hServer As Long) As Boolean
Private Declare Function apiGetAsyncKeyState Lib _
"user32" Alias "GetAsyncKeyState" _
(ByVal vKey As Long) As Long
Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function apiSendMessage Lib _
"user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
Private Function DissconnectSession _
(Optional ByVal ServerName As String, _
Optional ByVal SessionID As Long) As Boolean
On Error Resume Next
Dim OpenedServer As Long
OpenedServer = WTS_CURRENT_SERVER_HANDLE
If ServerName <> "" Then
OpenedServer = apiWTSOpenServer(ServerName)
End If
If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
DissconnectSession = apiWTSDisconnectSession _
(OpenedServer, SessionID, False)
apiWTSCloseServer (OpenedServer)
End Function
Private Function LogoffSession _
(Optional ByVal ServerName As String, _
Optional ByVal SessionID As Long) As Boolean
On Error Resume Next
Dim OpenedServer As Long
OpenedServer = WTS_CURRENT_SERVER_HANDLE
If ServerName <> "" Then
OpenedServer = apiWTSOpenServer(ServerName)
End If
If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
LogoffSession = apiWTSLogoffSession _
(OpenedServer, SessionID, False)
apiWTSCloseServer (OpenedServer)
End Function
Private Sub Command1_Click()
Call IsFastUserSwitching
If apiGetAsyncKeyState(VK_CONTROL) <> 0 And _
apiGetAsyncKeyState(VK_SHIFT) <> 0 Then
Call LogoffSession
ElseIf sLock = False Or _
apiGetAsyncKeyState(VK_SHIFT) <> 0 Then
Call apiLockWorkStation
ElseIf apiGetAsyncKeyState(VK_CONTROL) <> 0 Then
Dim tBar As Long
tBar = apiFindWindow("Shell_TrayWnd", vbNullString)
Call apiSendMessage(tBar, WM_COMMAND, 402, vbNullString)
Else
Call DissconnectSession
End If
End Sub
As you can see, I've added some extra options to switching users. If you hold the Shift key down while switching, the workstation will be locked, requiring a password to get back in. If you hold the Control key down while switching, the classic switch dialog will be displayed. If you hold the Control and Shift keys down while switching, the session will be logged off. Otherwise, if no keys are held, it will simply bring you to the switch user's screen.
You should check to see whether Fast User Switching is enabled, and if not, enable it.
[VB0575.JPG].NET
Private Function IsFastUserSwitching() As Boolean
Dim regKey As Microsoft.Win32.RegistryKey
Dim regValue As Int32 : regKey = Nothing
Try
regKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey _
("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", True)
regValue = CInt(regKey.GetValue("AllowMultipleTSSessions"))
If regValue = 0 Then regKey.SetValue("AllowMultipleTSSessions", 1)
regValue = CInt(regKey.GetValue("AllowMultipleTSSessions"))
regKey.Flush()
regKey.Close()
Catch ex As Exception
regKey.Close()
End Try
Return CBool(regValue)
End Function
[VB675.JPG]VB6
These Registry functions, GetRegistryValue & SetRegistryValue, will be used again in this article.
Const ERROR_SUCCESS As Long = 0
Const KEY_QUERY_VALUE As Long = 1
Const KEY_ENUMERATE_SUB_KEYS As Long = 8
Const KEY_NOTIFY As Long = 16
Const KEY_SET_VALUE As Long = 2
Const KEY_CREATE_SUB_KEY As Long = 4
Const READ_CONTROL As Long = 131072
Const STANDARD_RIGHTS_WRITE As Long = _
(READ_CONTROL)
Const SYNCHRONIZE As Long = 1048576
Const KEY_READ As Long = _
((READ_CONTROL Or KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE As Long = _
((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const HKEY_LOCAL_MACHINE As Long = -2147483646
Const HKEY_CURRENT_USER As Long = -2147483647
Const REG_SZ As Long = 1
Const REG_BINARY As Long = 3
Const REG_DWORD As Long = 4
Private Declare Function apiRegOpenKeyEx Lib _
"advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
ByRef phkResult As Long) As Long
Private Declare Function apiRegCloseKey Lib _
"advapi32" Alias "RegCloseKey" _
(ByVal hKey As Long) As Long
Private Declare Function apiRegQueryValueEx Lib _
"advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByRef lpData As Any, _
ByRef lpcbData As Long) As Long
Private Declare Function apiRegSetValueEx Lib _
"advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByRef lpData As Any, _
ByVal cbData As Long) As Long
Private Function IsFastUserSwitching() As Boolean
On Error Resume Next
Dim regKey As String
Dim regValue As Long
regKey = _
"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
regValue = CLng(GetRegistryValue _
(HKEY_LOCAL_MACHINE, regKey, _
"AllowMultipleTSSessions", REG_DWORD))
If regValue = 0 Then
Call SetRegistryValue _
(HKEY_LOCAL_MACHINE, regKey, _
"AllowMultipleTSSessions", REG_DWORD, 1)
End If
regValue = CLng(GetRegistryValue _
(HKEY_LOCAL_MACHINE, regKey, _
"AllowMultipleTSSessions", REG_DWORD))
IsFastUserSwitching = CBool(regValue)
End Function
Public Function GetRegistryValue _
(ByVal hKey As Long, _
ByVal KeyName As String, _
ByVal ValueName As String, _
ByVal KeyType As Integer, _
Optional DefaultValue As Variant = Empty) As Variant
On Error Resume Next
Dim handle As Long
Dim resLong As Long
Dim resString As String
Dim length As Long
Dim resBinary() As Byte
GetRegistryValue = DefaultValue
If apiRegOpenKeyEx _
(hKey, KeyName, 0, KEY_READ, handle) _
<> ERROR_SUCCESS Then Exit Function
If KeyType = REG_DWORD Then
If apiRegQueryValueEx _
(handle, ValueName, 0, REG_DWORD, resLong, 4) _
= 0 Then
GetRegistryValue = resLong
End If
ElseIf KeyType = REG_SZ Then
length = 1024: resString = Space(length)
If apiRegQueryValueEx _
(handle, ValueName, 0, REG_SZ, _
ByVal resString, length) = 0 Then
GetRegistryValue = Left(resString, length - 1)
End If
ElseIf KeyType = REG_BINARY Then
length = 4096
ReDim resBinary(length - 1) As Byte
If apiRegQueryValueEx _
(handle, ValueName, 0, REG_BINARY, resBinary(0), _
length) = 0 Then
ReDim Preserve resBinary(length - 1) As Byte
GetRegistryValue = resBinary()
End If
Else
MsgBox "Reg type not supported"
End If
apiRegCloseKey (handle)
End Function
Public Sub SetRegistryValue _
(ByVal hKey As Long, _
ByVal KeyName As String, _
ByVal ValueName As String, _
ByVal KeyType As Integer, _
ByRef value As Variant)
On Error Resume Next
Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim length As Long
If apiRegOpenKeyEx _
(hKey, KeyName, 0, KEY_WRITE, handle) <> _
ERROR_SUCCESS Then Exit Sub
If KeyType = REG_DWORD Then
lngValue = value
Call apiRegSetValueEx _
(handle, ValueName, 0, KeyType, lngValue, 4)
ElseIf KeyType = REG_SZ Then
strValue = value
Call apiRegSetValueEx _
(handle, ValueName, 0, KeyType, _
ByVal strValue, Len(strValue))
ElseIf KeyType = REG_BINARY Then
binValue = value
length = UBound(binValue) - LBound(binValue) + 1
Call apiRegSetValueEx _
(handle, ValueName, 0, KeyType, _
binValue(LBound(binValue)), length)
Else
MsgBox "Reg type not supported"
End If
apiRegCloseKey (handle)
End Sub
Digg
del.icio.us
Newsvine
Facebook
Google
LinkedIn
MySpace
Reddit
Slashdot
StumbleUpon
Technorati
Twitter
Windows Live
YahooBuzz
FriendFeed
Comments
There are no comments yet. Be the first to comment!