software - delphi technologies

¿Cómo hago que la API de SetThreadDesktop funcione desde una aplicación de consola?

Question

Vi la pregunta de Stack Overflow ¿ Cómo cambiar un proceso entre el escritorio predeterminado y el escritorio de Winlogon? .

Y he producido un caso de prueba mínimo para crear una aplicación de proyecto de consola, pero SetThreadDesktop() no cambia mi programa al escritorio de destino.

¿Por qué pasó esto?

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.

Al verificar los errores, la llamada a SetThreadDesktop() falla con el código de error 170 ( ERROR_BUSY , el recurso solicitado está en uso ) cuando el escritorio de destino está abierto.

var
  threahdesk: boolean;

  ...

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

  if threahdesk Then
  begin
    Print;

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

Después de eso vi varias sugerencias en algunos foros, mi código real es el siguiente:

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

De la documentación de SetThreadDesktop() :

La función SetThreadDesktop fallará si el hilo de llamada tiene ventanas o ganchos en su escritorio actual (a menos que el parámetro hDesktop sea un identificador para el escritorio actual).

Answer 2

La respuesta de Dmitriy es precisa porque la función falla porque el hilo que llama tiene ventanas o ganchos, aunque no explica cómo.

La razón por la que SetThreadDesktop está fallando con ERROR_BUSY es que tiene "forms.pas" en su lista de usos. A pesar de que falta en el código que ha publicado (el punto y coma en la cláusula "uses" también falta la sugerencia de más unidades), el uso de la variable global Screen hace evidente que tiene "formas" en los usos. "Formularios" ingresa "controls.pas" que inicializa el objeto Application . En su constructor, la aplicación crea una ventana de utilidad para su PopupControlWnd . Puede haber otras ventanas creadas pero esta es razón suficiente para que la función falle.

Utiliza Screen para su ancho / alto. Sin usar "formularios", puede usar la API para recuperar esa información.

Existen otros problemas en el código, como la falta de verificación de error / errores que se mencionaron en los comentarios a la pregunta, pero no son relevantes para la falla de SetThreadDesktop .

El programa de ejemplo siguiente demuestra que no hay ningún problema para llamar a SetThreadDesktop en el hilo principal de una aplicación de consola, siempre que haya un escritorio con el nombre ''default_set'' en la estación de ventana en la que se ejecuta el programa y tiene derechos de acceso.

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.