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

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

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).

Answer 2

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.