Mocking IDispatch interfaces in Delphi

Sometimes it is needed to write unit tests for code that uses third party ActiveX control. In this case we have to create mock of this ActiveX control. This is easy to do with standard Delphi TObjectDispatch class which creates IDispatch interface from normal class. Here is simple example

{$APPTYPE CONSOLE}

program TestDispatch;

uses System.Win.ObjComAuto;

{$METHODINFO ON}

type
  TTestWriter = class
    procedure Write(const Data: string); 
  end;

procedure TTestWriter.Write(const Data: string); 
begin
  Writeln(Data);
end;

var
  Dispatch: IDispatch;
  OleDispatch: OleVariant;
  TestWriter: TTestWriter;
begin
  TestWriter := TTestWriter.Create;
  Dispatch := TObjectDispatch.Create(TestWriter, True);
  OleDispatch := Dispatch;
  OleDispatch.Write('test');
end.

This works when we use OleVariant and late binding of IDispatch methods, but if we use dispinterface this will not work because TObjectDispatch generates dispid's for methods internally and does not allow to modify them. To overcome this problem we can create following TObjectDispatch extension class that will map real dispid values to auto generated ones.

unit uObjectDispatchWrapper;
interface

uses System.Win.ObjComAuto, System.Generics.Collections, System.Types, System.SysUtils;

type
  TObjectDispatchWrapper = class(TObjectDispatch)
  strict private
    FDispIDsMapping: TDictionary<Integer, Integer>;
  public
    constructor Create(Instance: TObject; const AMethods: TStringDynArray; const AMethodDispIDs: TIntegerDynArray);
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
    destructor Destroy; override;
  end;

implementation

constructor TObjectDispatchWrapper.Create(Instance: TObject; const AMethods: TStringDynArray; const AMethodDispIDs: TIntegerDynArray);
var
  i: Integer;
  MethodName: string;
  DispatchIdentifier: Integer;
begin
  Assert(Length(AMethods) = Length(AMethodDispIDs));
  inherited Create(Instance, True);
  FDispIDsMapping := TDictionary<Integer, Integer>.Create;

  // call GetIDsOfNames for all methods to populate internal TObjectDispatch data
  // this is needed because when used with dispinterfaces GetIDsOfNames method is not called.
  for i := Low(AMethods) to High(AMethods) do
  begin
    MethodName := AMethods[i];
    GetIDsOfNames(GUID_NULL, @MethodName, 1, SysLocale.DefaultLCID, @DispatchIdentifier);
    FDispIDsMapping.Add(AMethodDispIDs[i], DispatchIdentifier);
  end;
end;

destructor TObjectDispatchWrapper.Destroy;
begin
  FDispIDsMapping.Free;
  inherited;
end;

function TObjectDispatchWrapper.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
  ArgErr: Pointer): HRESULT;
begin
  Result := inherited Invoke(FDispIDsMapping[DispID], IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
end;

end.

And here is an example of its usage

{$APPTYPE CONSOLE}

program TestDisp;

uses System.Types, System.Win.ObjComAuto, uObjectDispatchWrapper;

{$METHODINFO ON}

type
  ITestWriter = dispinterface
    ['{4861977E-7E28-4195-BC7A-F45005536FEB}']
    procedure Write(const Data: string); dispid 5;
  end;

  TTestWriter = class
    procedure Write(const Data: string); 
  end;

procedure TTestWriter.Write(const Data: string); 
begin
  Writeln(Data);
end;

var
  Dispatch: IDispatch;
  TestWriter: TTestWriter;
begin
  TestWriter := TTestWriter.Create;
  Dispatch := TObjectDispatchWrapper.Create(TestWriter, 
    // method Write has dispid 5 
    TStringDynArray.Create('Write'), TIntegerDynArray.Create(5)
  );
  ITestWriter(Dispatch).Write('test');
end.

On a side note - dispinterfaces generated from ActiveX controls usually use WideString type for parameters, but there seems to be a bug in TObjectDispatch with WideString parameters so string type have to be used in mock class instead.
On another side note - word 'dispatch' in exe name seems to trigger Windows protection mechanism and it requires admin writes to run, so it is better to call project file TestDisp instead of TestDispatch.