delphi - 在Delphi中使用IVirtualDesktopManager

Question

我正在尝试在 Windows 10 上的 Turbo Delphi 中使用 IVirtualDesktopManager。 我没有收到任何错误，但 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.

好吧，这是一个简单的例子:这个项目只是一个带有 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

所有接口(interface)方法的声明都不正确，但 IsWindowOnCurrentVirtualDesktop() 特别麻烦，因为它的第二个参数需要一个指向 BOOL 的指针，而不是指向 bool 值。 BOOL 和 Boolean 是非常不同的数据类型。 BOOL 是 LongBool 的别名，其大小为 4 个字节，而 Boolean 的大小为 1 个字节。

除此之外，您应该使用 HWND 而不是 Cardinal 作为 Wnd 参数。我还建议使用 out 和 const 作为 DesktopID 参数，而不是原始指针。

此外，您确实需要删除 Co(Un)Initialize() 调用，它们根本不属于您的函数。 调用者负责初始化(取消)COM，因为它必须决定在访问 COM 时要使用哪个 COM 线程模型。各个函数不应代表调用者做出该决定。 COM 必须在每个线程的基础上进行初始化，因此您的各个应用线程有责任在调用您的函数之前调用 CoInitialize()，并调用 CoUninitialize() > 终止之前。

由于您的 vdm 变量，这一点尤其重要。该变量属于每个函数内部，而不是全局内存中。当编译器在调用 CoUninitialize() 后尝试在单元终结期间释放该接口(interface)时，您将面临崩溃的风险。

综上所述，请尝试类似这样的方法:

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() on 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;