How do I make SetThreadDesktop API work from a console application? - delphi

Question

I saw Stack Overflow question How to switch a process between default desktop and Winlogon desktop?.
And I have produced a minimal test-case creating a console project application, but SetThreadDesktop() does not switch my program to the target desktop.
Why does this happen?
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Winapi.Windows,
System.SysUtils,
Vcl.Graphics,
function RandomPassword(PLen: Integer): string;
var
str: string;
begin
Randomize;
str := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
Result := '';
repeat
Result := Result + str[Random(Length(str)) + 1];
until (Length(Result) = PLen)
end;
procedure Print;
var
DCDesk: HDC;
bmp: TBitmap;
hmod, hmod2 : HMODULE;
BitBltAPI: function(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): BOOL; stdcall;
GetWindowDCAPI: function(hWnd: HWND): HDC; stdcall;
begin
hmod := GetModuleHandle('Gdi32.dll');
hmod2:= GetModuleHandle('User32.dll');
if (hmod <> 0) and (hmod2 <> 0) then begin
bmp := TBitmap.Create;
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
GetWindowDCAPI := GetProcAddress(hmod2, 'GetWindowDC');
if (#GetWindowDCAPI <> nil) then begin
DCDesk := GetWindowDCAPI(GetDesktopWindow);
end;
BitBltAPI := GetProcAddress(hmod, 'BitBlt');
if (#BitBltAPI <> nil) then begin
BitBltAPI(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DCDesk, 0, 0, SRCCOPY);
bmp.SaveToFile('ScreenShot_------_' + RandomPassword(8) + '.bmp');
end;
ReleaseDC(GetDesktopWindow, DCDesk);
bmp.Free;
FreeLibrary(hmod);
FreeLibrary(hmod2);
end;
end;
//===============================================================================================================================
var
hWinsta, hdesktop:thandle;
begin
try
while True do
begin
hWinsta := OpenWindowStation('WinSta0', TRUE, GENERIC_ALL);
If hwinsta <> INVALID_HANDLE_VALUE then
begin
SetProcessWindowStation (hWinsta);
hdesktop := OpenDesktop ('default_set', 0, TRUE, GENERIC_ALL);
if (hdesktop <> INVALID_HANDLE_VALUE) then
if SetThreadDesktop (hdesktop) then
begin
Print; // Captures screen of target desktop.
CloseWindowStation (hwinsta);
CloseDesktop (hdesktop);
end;
end;
Sleep(5000);
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Checking errors, the SetThreadDesktop() call fails with error code 170 (ERROR_BUSY, The requested resource is in use) when the target desktop is open.
var
threahdesk: boolean;
...
threahdesk := SetThreadDesktop (hdesktop);
ShowMessage(IntToStr(GetLastError));
if threahdesk Then
begin
Print;
CloseWindowStation (hwinsta);
CloseDesktop (hdesktop);
end;
After that I saw several suggestion in some forums, my actual code is as follows:
var
hWinsta, hdesktop:thandle;
threahdesk, setprocwst: Boolean;
////////////////////////////////////////////////////////////////////////////////
begin
try
while True do
begin
Application.Free;
hWinsta:= OpenWindowStation('WinSta0', TRUE, GENERIC_ALL);
If hwinsta <> 0 Then
Begin
setprocwst := SetProcessWindowStation(hWinsta);
if setprocwst then
hdesktop:= OpenDesktop('default_set', 0, TRUE, GENERIC_ALL);
If (hdesktop <> 0) Then
threahdesk := SetThreadDesktop(hdesktop);
Application := TApplication.Create(nil);
Application.Initialize;
Application.Run;
If threahdesk Then
Begin
Print;
CloseWindowStation (hwinsta);
CloseDesktop (hdesktop);
End;
End;
Sleep(5000);
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

Answer 1

The answer by Dmitriy is accurate in that the function fails because the calling thread has windows or hooks, although it doesn't explain how so.
The reason SetThreadDesktop is failing with ERROR_BUSY is, you have "forms.pas" in your uses list. Although it's missing in the code you posted (semicolon in "uses" clause is also missing hinting more units), the use of the Screen global variable makes it evident that you have "forms" in uses. "Forms" pulls in "controls.pas" which initializes the Application object. In its constructor, the Application creates a utility window for its PopupControlWnd. There may be other windows created but this one is enough reason for the function to fail.
You use Screen for its width/height. Un-use "forms", you can use API to retrieve that information.
There are other issues in the code like missing/wrong error checking which have been mentioned in the comments to the question, but they are not relevant to why SetThreadDesktop fails.
Below sample program demonstrates there's no problem calling SetThreadDesktop in the main thread of a console application, provided there's a desktop with name 'default_set' in the window station in which the program is running and has access rights to.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
// Vcl.Forms, // uncomment to get an ERROR_BUSY
Winapi.Windows;
var
hSaveDesktop, hDesktop: HDESK;
begin
hSaveDesktop := GetThreadDesktop(GetCurrentThreadId);
Win32Check(hSaveDesktop <> 0);
hDesktop := OpenDesktop('default_set', 0, True, GENERIC_ALL);
Win32Check(hDesktop <> 0);
try
Win32Check(SetThreadDesktop(hDesktop));
try
// --
finally
Win32Check(SetThreadDesktop(hSaveDesktop));
end;
finally
Win32Check(CloseDesktop(hDesktop));
end;
end.

Answer 2

From the SetThreadDesktop() documentation:
The SetThreadDesktop function will fail if the calling thread has any windows or hooks on its current desktop (unless the hDesktop parameter is a handle to the current desktop).