Using IVirtualDesktopManager in Delphi

Question

I'm trying to use IVirtualDesktopManager in Turbo Delphi on Windows 10. I don't get any errors but the IsWindowOnCurrentVirtualDesktop and GetWindowDesktopId do not return anything useful. Does anyone know what I'm doing wrong here? Thanks.

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 here is a simple example: this project is just a form with a TMemo and a Ttimer on it. It is showing that Form1.handle can not be used to check if the window is on the current desktop. However, if you check Application.Handle then is will return correctly false if you switch to another desktop and back again so check what is written in the memo. I find this remarkable since I presume one application can have more then one window showing on different desktops?

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

All of your interface methods are declared incorrectly, but IsWindowOnCurrentVirtualDesktop() in particular is troublesome because its second parameter expects a pointer to a BOOL, not a pointer to a Boolean. BOOL and Boolean are very different data types. BOOL is an alias for LongBool, which is 4 bytes in size, whereas Boolean is 1 byte in size.

Other than that, you should be using HWND instead of Cardinal for the Wnd parameters. And I also suggest using out and const for the DesktopID parameters instead of raw pointers.

Also, you really need to get rid of the Co(Un)Initialize() calls, they don't belong in your functions at all. The caller is responsible for (un)initializing COM, as it has to decide which COM threading model it wants to use when accessing COM. Individual functions should not make that decision on the caller's behalf. COM must be initialized on a per-thread basis, so it is the responsibility of your individual app threads to call CoInitialize() before calling your functions, and to call CoUninitialize() before terminating.

This is especially important because of your vdm variable. That variable belongs inside of each function, not in global memory. You are risking a crash when the compiler tries to release that interface during unit finalization after CoUninitialize() has already been called.

With all of that said, try something more like this instead:

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.

Lastly, note that IVirtualDesktopManager is only available on Windows 10 and later, so if you don't want your code to crash on earlier Windows versions, you should remove the OleCheck() on CoCreateInstance() so you can handle the error more gracefully, eg:

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;