Creating New Desktops and Running Applications
Get an entire desktop to yourself and disable Ctrl+Alt+Del
All varieties of Windows NT since 3.51 include the ability to create and run multiple desktops. Normally, this feature isn't used, and all applications run within the "Default" desktop. However, if you want to create a kiosk-style application which has a full-screen interface, and prevents Ctrl+Alt+Del or any of the other standard Windows options from being accessed, then this technique is the way to do it.
Windows NT is divided at the top level into Window Stations and Desktops. More than one of each of these objects can be present at the same time, but only one Desktop within one Window Station can be interactive at any time. The definitions of Window Stations and Desktops can be looked up in more detail at MSDN; here's a quick overview:
Under Windows XP, you will find that a logged on Windows Station typically contains three desktops:
Creating New Desktops and Running Applications
Creating a new desktop for your application gives you a lot of control, but of course that also means more responsibility. By default, your new desktop has nothing on it: no start menu and no task bar. Ctrl + Alt + Del brings up the task manager, but it doesn't bring it up on your new desktop, it brings it up on the Default desktop. If you create an application which cannot be ended in the new desktop (which is easy to do in a full-screen application and is frequently what you want to achieve), then there is literally no way out other than shutting down the computer with the power-down button!
In theory, it is possible to write an application which starts in one desktop, creates a new desktop and then switches to it and shows its forms there. However, to do this you need a multi-threaded message loop, which isn't supported by VB. Even if you could create a multi-threaded message loop, trying to use an IDE to debug the thing would become extremely painful, since IDE errors and breakpoints will be triggered on the IDE desktop rather than the one you're running in.
A somewhat easier approach is to use a bootstrap application. The bootstrap application is responsible for creating the new desktop and launching your application into it, then waiting for your application to end, at which point it returns you to the original desktop. The greatest advantage of this method is you can develop your application as if it were a normal application in VB, and only when you genuinely want it to run in kiosk mode do you need to start it from the bootstrapper. The disadvantage is that you have two executables, and if the user has suitable access to the machine could in theory run the version on your local desktop. You can prevent this from occurring by adding a check to your release build of the main application to confirm it is running in the correct desktop.
A Bootstrap Application
The sample provided with the downloads includes a bootstrap application which starts a new desktop and runs the sample Kiosk application on it. It does this using the cDesktop class, which has just two methods:
Typically, then, a bootstrap application will contain something like the following in the Main method:
Public Sub Main() Dim cNewDesktop As New cDesktop cNewDesktop.Create "MyDesktop" cNewDesktop.StartProcess App.Path & "\" & APP_EXE_NAME End Sub
If you want your application to have an icon, then you can do this by creating a .res file, as described in the article Icons without forms.
The cDesktop class is straightforward code. The three main things it has to do are:
Creating a new desktop and switching are performed using the sensibly named CreateDesktop and SwitchDesktop functions. Here is the code (error handling omitted for clarity):
Private Declare Function CreateDesktop Lib "user32" Alias "CreateDesktopW" ( _ ByVal lpszDesktop As Long, _ ByVal lpszDevice As Long, _ pDevmode As Any, _ ByVal dwFlags As Long, _ ByVal dwDesiredAccess As Long, _ lpsa As Any _ ) As Long Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long Private Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private Declare Function OpenInputDesktop Lib "user32" ( _ ByVal dwFlags As Long, _ ByVal fInherit As Boolean, _ ByVal dwDesiredAccess As Long _ ) As Long Private Const DESKTOP_SWITCHDESKTOP = &H100& Private Const GENERIC_ALL = &H10000000 Public Sub Create(ByVal sDesktopName As String) m_hDesktopThreadOld = GetThreadDesktop(GetCurrentThreadId()) m_hDesktopInputOld = OpenInputDesktop(0, False, DESKTOP_SWITCHDESKTOP) m_hDesktop = CreateDesktop( _ StrPtr(sDesktopName), ByVal 0&, ByVal 0&, 0, GENERIC_ALL, ByVal 0&) SetThreadDesktop m_hDesktop SwitchDesktop m_hDesktop
To create a process and run it on the new desktop, you must use the lower-level CreateProcess API rather than Shell or ShellExecute, as this is the only one which allows you to specify a desktop to run the application on. CreateProcess takes a lot of parameters, but typically you don't need to fill many of them in. Here's the code:
Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Private Type STARTUPINFOW cbSize As Long lpReserved As Long lpDesktop As Long lpTitle As Long dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessW" ( _ ByVal lpApplicationName As Long, _ ByVal lpCommandLine As Long, _ lpProcessAttributes As Any, _ lpThreadAttributes As Any, _ ByVal bInheritHandles As Long, _ ByVal dwCreationFlags As Long, _ lpEnvironment As Any, _ ByVal lpCurrentDirectory As Long, _ lpStartupInfo As STARTUPINFOW, _ lpProcessInformation As PROCESS_INFORMATION _ ) As Long Public Sub StartProcess(ByVal sPath As String) Dim tSi As STARTUPINFOW Dim tPi As PROCESS_INFORMATION Dim lR As Long Dim lErr As Long ' Must set the desktop to run on in the ' STARTUPINFO structure: tSi.cbSize = Len(tSi) tSi.lpTitle = StrPtr(m_sDesktop) tSi.lpDesktop = StrPtr(m_sDesktop) lR = CreateProcess( _ StrPtr(sPath), ByVal 0&, ByVal 0&, ByVal 0&, _ 1, 0, ByVal 0&, ByVal 0&, tSi, tPi) If (lR = 0) Then lErr = Err.LastDllError ' Make sure we get back into the desktop ' that contains the application that is ' using this class: ClearUp ' Now show the error ApiErrorHandler lErr, True Else ' Wait until the process has completed: WaitForSingleObject tPi.hProcess, INFINITE ' Done. Not sure if we need to close these ' handles, but it doesn't cause a problem CloseHandle tPi.hProcess CloseHandle tPi.hThread ' Once no more processes are running on ' the desktop it will automatically ' close. End If End Sub
To get back to the original desktop we simply switch back to the original desktop and close the new desktop handle. Note that Windows automatically closes desktops which no longer have any applications running on them, so this is not usually necessary:
Public Sub ClearUp() SwitchDesktop m_hDesktopInputOld SetThreadDesktop m_hDesktopThreadOld CloseDesktop m_hDesktop End Sub
The sample kiosk application demonstrates checking the desktop name to ensure it is running in the correct desktop. This is done using the GetUserObjectInformation API call:
Private Declare Function OpenInputDesktop Lib "user32" ( _ ByVal dwFlags As Long, _ ByVal fInherit As Boolean, _ ByVal dwDesiredAccess As Long _ ) As Long Private Declare Function CloseHandle Lib "kernel32" ( _ ByVal hObject As Long _ ) As Long Private Declare Function GetUserObjectInformation Lib "user32" _ Alias "GetUserObjectInformationW" ( _ ByVal hObj As Long, _ ByVal nIndex As Long, _ pvInfo As Any, _ ByVal nLength As Long, _ lpnLengthNeeded As Long _ ) As Long Private Const UOI_FLAGS = 1 Private Const UOI_NAME = 2 Private Const UOI_TYPE = 3 Private Const UOI_USER_SID = 4 Private Const DESKTOP_READOBJECTS = &H1& Public Function GetDesktopName() As String Dim hDesktop As Long Dim lR As Long Dim lSize As Long Dim sBuff As String Dim iPos As Long hDesktop = OpenInputDesktop(0, False, DESKTOP_READOBJECTS) If Not (hDesktop = 0) Then lSize = (Len(DESKTOP_NAME) + 1) * 2 ReDim bBuff(0 To lSize - 1) As Byte lR = GetUserObjectInformation(hDesktop, UOI_NAME, bBuff(0), lSize, lSize) sBuff = bBuff iPos = InStr(sBuff, vbNullChar) If (iPos > 1) Then sBuff = Left(sBuff, iPos - 1) End If GetDesktopName = sBuff CloseHandle hDesktop End If End Function
This article demonstrates a simple way to get the an entire desktop, free of any Shell or Explorer bits like the TaskBar or the Alt-Tab list, and also prevents the user from escaping from your application using Ctrl+Alt+Del. The code will run on any NT or above system.