troubleshooting Question

Migrating components to VCL.NET

Avatar of steve-west
steve-west asked on
Delphi.NET Programming
7 Comments1 Solution328 ViewsLast Modified:
As part of converting our application suite from Delphi 7 to .NET (VCL Forms), I 'm starting to convert our component library.

One of the components contained within the library is a non-visual COM component. The compiler immediately complains about the IUnknown interface. Can anyone please tell me how I go about implementing this within .NET? Is it possible? I've read about Interop but this seems to be about how to use com components at runtime,  not actually compiling them - or am I missing the point completely?

Any help gratefully received - I've a feeling this (and the whole conversion process) is an invite to a party of pain.

Thanks

Steve

This is the component source in question:

unit PRIAMEventSinkUnit;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ActiveX;

type
 TInvokeEvent = procedure(Sender: TObject; DispID: Integer;
  const IID: TGUID; LocaleID: Integer; Flags: Word;
  Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer) of object;
 
 TAbstractPRIAMEventSink = class(TInterfacedObject,{$IFNDEF DOTNET} IUnknown, {$ENDIF}IDispatch)
 private
  FDispatch: IDispatch;
  FDispIntfIID: TGUID;
  FConnection: Integer;
  FOwner: TComponent;
 protected
  { IUnknown }
  function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
  function _AddRef: Integer; stdcall;
  function _Release: Integer; stdcall;
  { IDispatch }
  function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
  function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
  function GetIDsOfNames(const IID: TGUID; Names: Pointer;
   NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
  function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
 public
  constructor Create(AOwner: TComponent);
  destructor Destroy; override;
  procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
  procedure Disconnect;
 end;

 TPRIAMEventSink = class(TComponent)
 private
  { Private declarations }
  FSink: TAbstractPRIAMEventSink;
  FOnInvoke: TInvokeEvent;
 protected
  { Protected declarations }
  procedure DoInvoke(DispID: Integer; const IID: TGUID;
   LocaleID: Integer; Flags: Word; var Params;
   VarResult, ExcepInfo, ArgErr: Pointer); virtual;
 public
  { Public declarations }
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
 published
  { Published declarations }
  property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
 end;


implementation

uses
 ComObj;


{$IFDEF VER100}
procedure InterfaceConnect(const Source: IUnknown; const IID: TIID;
 const Sink: IUnknown; var Connection: Longint);
var
 CPC: IConnectionPointContainer;
 CP: IConnectionPoint;
begin
 Connection := 0;
 if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then
  if Succeeded(CPC.FindConnectionPoint(IID, CP)) then
   CP.Advise(Sink, Connection);
end;

procedure InterfaceDisconnect(const Source: IUnknown; const IID: TIID;
 var Connection: Longint);
var
 CPC: IConnectionPointContainer;
 CP: IConnectionPoint;
begin
 if Connection <> 0 then
  if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then
   if Succeeded(CPC.FindConnectionPoint(IID, CP)) then
    if Succeeded(CP.Unadvise(Connection)) then Connection := 0;
end;
{$ENDIF}

{ TAbstractPRIAMEventSink }

function TAbstractPRIAMEventSink._AddRef: Integer;
begin
 Result := -1;
end;

function TAbstractPRIAMEventSink._Release: Integer;
begin
 Result := -1;
end;

constructor TAbstractPRIAMEventSink.Create(AOwner: TComponent);
begin
 inherited Create;

 FOwner := AOwner;
end;

destructor TAbstractPRIAMEventSink.Destroy;
begin
 try
  try
    Disconnect;
  except
    on E:Exception do
    begin
    end;
  end;
 finally
   inherited Destroy;
 end;
end;

function TAbstractPRIAMEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
begin
 Result := E_NOTIMPL;
end;

function TAbstractPRIAMEventSink.GetTypeInfo(Index, LocaleID: Integer;
 out TypeInfo): HRESULT;
begin
 Result := E_NOTIMPL;
end;

function TAbstractPRIAMEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
begin
 Count := 0;
 Result := S_OK;
end;

function TAbstractPRIAMEventSink.Invoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer): HRESULT;
begin
 (FOwner as TPRIAMEventSink).DoInvoke(DispID, IID, LocaleID, Flags,
  Params, VarResult, ExcepInfo, ArgErr);
 Result := S_OK;
end;

function TAbstractPRIAMEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
 // We need to return the event interface when it's asked for
 Result := E_NOINTERFACE;
 if GetInterface(IID,Obj) then
  Result := S_OK;
 if IsEqualGUID(IID, FDispIntfIID) and GetInterface(IDispatch,Obj) then
  Result := S_OK;
end;

procedure TAbstractPRIAMEventSink.Connect(AnAppDispatch: IDispatch;
 const AnAppDispIntfIID: TGUID);
begin
 FDispIntfIID := AnAppDispIntfIID;
 FDispatch := AnAppDispatch;
 // Hook the sink up to the automation server
 InterfaceConnect(FDispatch, FDispIntfIID, Self, FConnection);
end;

procedure TAbstractPRIAMEventSink.Disconnect;
begin
 if Assigned(FDispatch) then begin
  // Unhook the sink from the automation server
  InterfaceDisconnect(FDispatch, FDispIntfIID, FConnection);
  FDispatch := nil;
  FConnection := 0;
 end;
end;

{ TPRIAMEventSink }

procedure TPRIAMEventSink.Connect(AnAppDispatch: IDispatch;
 const AnAppDispIntfIID: TGUID);
begin
 FSink.Connect(AnAppDispatch, AnAppDispIntfIID);
end;

constructor TPRIAMEventSink.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 FSink := TAbstractPRIAMEventSink.Create(self);
end;

destructor TPRIAMEventSink.Destroy;
begin
 try
  FSink.Free;
 finally
   inherited Destroy;
 end;
end;

procedure TPRIAMEventSink.DoInvoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer);
begin
 if Assigned(FOnInvoke) then
  FOnInvoke(self, DispID, IID, LocaleID, Flags, TDispParams(Params),
   VarResult, ExcepInfo, ArgErr);
end;

end.
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 7 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 7 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros