如何使 SetThreadDesktop API 从控制台应用程序工作？

Question

我看到了 Stack Overflow 问题How to switch a process between default desktop and Winlogon desktop?。

我已经制作了一个创建控制台项目应用程序的最小测试用例，但SetThreadDesktop() 不会将我的程序切换到目标桌面。

为什么会这样？

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.

检查错误，当目标桌面打开时，SetThreadDesktop() 调用失败，错误代码为 170（ERROR_BUSY，请求的资源正在使用中）。

var
  threahdesk: boolean;

  ...

  threahdesk := SetThreadDesktop (hdesktop);
  ShowMessage(IntToStr(GetLastError));

  if threahdesk Then
  begin
    Print;

    CloseWindowStation (hwinsta);
    CloseDesktop (hdesktop);
  end;

后来在一些论坛看到了一些建议，我的实际代码如下：

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

来自SetThreadDesktop() documentation：

如果调用线程在其当前桌面上有任何窗口或挂钩，则 SetThreadDesktop 函数将失败（除非 hDesktop 参数是当前桌面的句柄）。

Answer 2

The answer by Dmitriy 是准确的，因为调用线程有窗口或钩子，所以函数失败，尽管它没有解释为什么会这样。

SetThreadDesktop 与ERROR_BUSY 失败的原因是，您的使用列表中有“forms.pas”。尽管您发布的代码中缺少它（“uses”子句中的分号也缺少暗示更多单位），但Screen 全局变量的使用表明您在使用中具有“表单”。 “Forms”引入初始化Application 对象的“controls.pas”。在其构造函数中，应用程序为其PopupControlWnd 创建一个实用程序窗口。可能还创建了其他窗口，但这一个足以导致该功能失败。

您使用Screen 作为其宽度/高度。不使用“表单”，您可以使用 API 来检索该信息。

代码中还有其他问题，例如问题的 cmets 中提到的缺失/错误错误检查，但它们与 SetThreadDesktop 失败的原因无关。

---

下面的示例程序演示了在控制台应用程序的主线程中调用SetThreadDesktop 没有问题，前提是在程序正在运行并有权访问的窗口站中有一个名为“default_set”的桌面。

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.