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