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

问题:

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. 

回答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. 

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

文章来源: How do I make SetThreadDesktop API work from a console application?