Использование IVirtualDesktopManager в Delphi

Question

Я пытаюсь использовать IVirtualDesktopManager в Turbo Delphi в Windows 10. Я не получаю никаких ошибок, но IsWindowOnCurrentVirtualDesktop и GetWindowDesktopId не возвращают ничего полезного. Кто-нибудь знает, что я здесь делаю неправильно? Благодарю.

unit VDMUnit; 

interface 

uses ActiveX, Comobj; 

Const 
IID_VDM: TGUID ='{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'; 
CLSID_VDM: TGUID ='{AA509086-5CA9-4C25-8F95-589D3C07B48A}'; 

type 
    {$EXTERNALSYM IVirtualDesktopManager} 
    IVirtualDesktopManager = interface(IUnknown) 
    ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'] 
    function IsWindowOnCurrentVirtualDesktop(Wnd:cardinal; var IsTrue: boolean): HResult; stdcall; 
    function GetWindowDesktopId(Wnd:cardinal; pDesktopID: PGUID): HResult; stdcall; 
    function MoveWindowToDesktop(Wnd:cardinal; DesktopID: PGUID): HResult; stdcall; 
    end; 

function IsOnCurrentDesktop(wnd:cardinal):boolean; 
procedure GetWindowDesktopId(Wnd:cardinal; pDesktopID: PGUID); 
procedure MoveWindowToDesktop(Wnd:cardinal; DesktopID: PGUID); 

implementation 

var 
    vdm:IVirtualDesktopManager; 

function IsOnCurrentDesktop(wnd:cardinal):boolean; 
begin 
    CoInitialize(nil); 
    OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER,IVirtualDesktopManager,vdm)); 
    OleCheck(vdm.IsWindowOnCurrentVirtualDesktop(wnd,result)); 
    CoUninitialize; 
end; 

procedure GetWindowDesktopId(Wnd:cardinal; pDesktopID: PGUID); 
begin 
    CoInitialize(nil); 
    OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER ,IVirtualDesktopManager,vdm)); 
    OleCheck(vdm.GetWindowDesktopId(wnd,pDesktopID)); 
    CoUninitialize; 
end; 

procedure MoveWindowToDesktop(Wnd:cardinal; DesktopID: PGUID); 
begin 
    CoInitialize(nil); 
    OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER,IVirtualDesktopManager,vdm)); 
    OleCheck(vdm.MoveWindowToDesktop(wnd,DesktopID)); 
    CoUninitialize; 
end; 

end. 

Ok вот простой пример: этот проект просто форма с TMemo и TTimer на нем. Показывает, что Form1.handle нельзя использовать, чтобы проверить, находится ли это окно на текущем рабочем столе. Однако, если вы проверите Application.Handle, тогда вернется правильно false, если вы переключитесь на другой рабочий стол и обратно, чтобы проверить, что написано в заметке. Я нахожу это замечательным, так как я предполагаю, что одно приложение может иметь более одного окна, отображаемого на разных рабочих столах?

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ActiveX, Comobj, StdCtrls, ExtCtrls; 

const 
IID_VDM: TGUID = '{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'; 
CLSID_VDM: TGUID ='{AA509086-5CA9-4C25-8F95-589D3C07B48A}'; 

type 
    IVirtualDesktopManager = interface(IUnknown) 
    ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'] 
    function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall; 
    function GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall; 
    function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall; 
    end; 

type 
    TForm1 = class(TForm) 
    Memo1: TMemo; 
    Timer1: TTimer; 
    procedure Timer1Timer(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

function GetVDM: IVirtualDesktopManager; 
begin 
    Result := nil; 
    OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER, IVirtualDesktopManager, Result)); 
end; 

function IsOnCurrentDesktop(wnd: HWND): Boolean; 
var 
    value: BOOL; 
begin 
    OleCheck(GetVDM.IsWindowOnCurrentVirtualDesktop(Wnd, value)); 
    Result := value; 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
    if IsOnCurrentDesktop(Form1.Handle) then 
    Memo1.Lines.Add('Yes') 
    else 
    Memo1.Lines.Add('No'); 
end; 



end. 

Answer 1

Все ваши методы интерфейса объявлены неправильно, но IsWindowOnCurrentVirtualDesktop(), в частности, вызывает беспокойство, потому что его второй параметр ожидает указатель на BOOL, а не указатель на Boolean. BOOL и Booleanочень различные типы данных. BOOL - это псевдоним для LongBool, который имеет размер 4 байта, тогда как Boolean имеет размер 1 байт.

Кроме этого, вы должны использовать HWND вместо Cardinal для параметров Wnd. И я также предлагаю использовать out и const для параметров DesktopID вместо необработанных указателей.

Кроме того, вам действительно нужно избавиться от звонков Co(Un)Initialize(), они вообще не принадлежат к вашим функциям. Вызывающий вызывающий абонент отвечает за (un) инициализацию COM, так как он должен решить, какую модель поточной COM-модели он хочет использовать при доступе к COM. Отдельные функции не должны принимать такое решение от имени вызывающего абонента. COM должен быть инициализирован для каждого потока, поэтому перед вашими вызовами ваши индивидуальные потоки приложений отвечают за то, что вы вызываете CoInitialize(), и вызывать CoUninitialize() перед завершением.

Это особенно важно из-за вашей переменной vdm. Эта переменная принадлежит внутри каждой функции, а не в глобальной памяти. Вы рискуете столкнуться, когда компилятор попытается освободить этот интерфейс во время завершения финализации после того, как CoUninitialize() уже вызван.

Со всем, что сказал, попробовать что-то больше, как это вместо:

unit VDMUnit; 

interface 

uses 
    Windows; 

function IsOnCurrentDesktop(wnd: HWND): Boolean; 
function GetWindowDesktopId(Wnd: HWND): TGUID; 
procedure MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID); 

implementation 

uses 
    ActiveX, Comobj; 

const 
IID_VDM: TGUID = '{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'; 
CLSID_VDM: TGUID ='{AA509086-5CA9-4C25-8F95-589D3C07B48A}'; 

type 
    IVirtualDesktopManager = interface(IUnknown) 
    ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'] 
    function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall; 
    function GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall; 
    function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall; 
    end; 

function GetVDM: IVirtualDesktopManager; 
begin 
    Result := nil; 
    OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER, IVirtualDesktopManager, Result)); 
end; 

function IsOnCurrentDesktop(wnd: HWND): Boolean; 
var 
    value: BOOL; 
begin 
    OleCheck(GetVDM.IsWindowOnCurrentVirtualDesktop(Wnd, value)); 
    Result := value; 
end; 

function GetWindowDesktopId(Wnd: HWND): TGUID; 
being 
    OleCheck(GetVDM.GetWindowDesktopId(Wnd, Result)); 
end; 

procedure MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID); 
begin 
    OleCheck(GetVDM.MoveWindowToDesktop(Wnd, DesktopID)); 
end; 

end. 

Наконец, отметим, что IVirtualDesktopManager доступен только на Windows 10 и позже, так что если вы не хотите, чтобы ваш код аварии на более ранние версии Windows, вы должны удалить OleCheck() на CoCreateInstance() так что вы можете обработать ошибку более изящно, например:

uses 
    Classes; 

type 
    TFakeVirtualDesktopManager = class(TInterfacedObject, IVirtualDesktopManager) 
    public 
    function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall; 
    function GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall; 
    function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall; 
    end; 

function TFakeVirtualDesktopManager.IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall; 
begin 
    IsTrue := False; 
    Result := S_OK; 
end; 

function TFakeVirtualDesktopManager.GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall; 
begin 
    DesktopID := GUID_NULL; 
    Result := S_OK; 
end; 

function TFakeVirtualDesktopManager.MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall; 
begin 
    Result := S_OK; 
end; 

function GetVDM: IVirtualDesktopManager; 
var 
    hr: HResult; 
begin 
    Result := nil; 
    hr := CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER, IVirtualDesktopManager, Result); 
    if Failed(hr) then 
    begin 
    if hr = REGDB_E_CLASSNOTREG then 
     Result := TFakeVirtualDesktopManager.Create as IVirtualDesktopManager 
    else 
     OleCheck(hr); 
    end; 
end;