delphi मैं कंसोल अनुप्रयोग से SetThreadDesktop API काम कैसे कर सकता हूं?




(2)

दिमित्री द्वारा जवाब सटीक है क्योंकि फ़ंक्शन विफल रहता है क्योंकि कॉलिंग थ्रेड में खिड़कियां या हुक हैं, हालांकि यह कैसे ऐसा नहीं समझाता है।

कारण SetThreadDesktop साथ असफल रहा है, आपके उपयोग सूची में "forms.pas" है। हालांकि यह आपके द्वारा पोस्ट किए गए कोड में गुम है (हालांकि "उपयोग" खंड में अर्धविराम भी अधिक इकाइयों को इशारा करते हुए याद नहीं है), Screen ग्लोबल वैरिएबल का उपयोग यह स्पष्ट करता है कि आपके पास "फ़ॉर्म" उपयोग में हैं "फॉर्म" में "नियंत्रण।" में खींचती है जो कि Application वस्तु को आरंभ करती है इसके निर्माता में, एप्लिकेशन अपने PopupControlWnd लिए एक उपयोगिता विंडो बनाता है। वहाँ अन्य खिड़कियां बनाई जा सकती हैं लेकिन यह फ़ंक्शन विफल होने के लिए पर्याप्त कारण है।

आप इसकी चौड़ाई / ऊंचाई के लिए Screen उपयोग करते हैं "फ़ॉर्म" का उपयोग करें, आप उस जानकारी को पुनः प्राप्त करने के लिए एपीआई का उपयोग कर सकते हैं।

प्रश्न में टिप्पणी में उल्लिखित ग़लत / गलत त्रुटि जांच जैसी कोड में अन्य समस्याएं हैं, लेकिन वे SetThreadDesktop विफल होने के कारण प्रासंगिक नहीं हैं।

नमूना कार्यक्रम के नीचे दर्शाता है कि कंसोल एप्लिकेशन के मुख्य थ्रेड में 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.

मैंने स्टैक अतिप्रवाह प्रश्न देखा है कैसे डिफ़ॉल्ट डेस्कटॉप और Winlogon डेस्कटॉप के बीच एक प्रक्रिया को स्विच करने के लिए?

और मैंने एक कंसोल प्रोजेक्ट एप्लिकेशन बनाने के लिए कम से कम टेस्ट-केस का उत्पादन किया है, लेकिन 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.

SetThreadDesktop() दस्तावेज़ से :

SetThreadDesktop फ़ंक्शन विफल हो जाएगा अगर कॉलिंग थ्रेड में अपने वर्तमान डेस्कटॉप पर कोई विंडो या हुक है (जब तक कि hDesktop पैरामीटर वर्तमान डेस्कटॉप पर हैंडल नहीं है)।