COM-Object mit Events

[markus.waibel]

Ich habe in der TLB-Unit die mir Delphi beim Importieren der Typenbibliothek erstellt hat ein Interface __API das als

   __API = dispinterface deklariert wurde.

In diesem Interace gibt es dann die Prozedur ItemAdded welche dem Event entspricht.

   procedure ItemAdded(var BasketItem: _BasketItem; var Cancel: WordBool); dispid 7; Analog zu meinem Beispiel aus dem CODEGAR-Tutorial habe ich dann folgendes entwickelt:

Delphi-Quellcode:

....

type
  TTafmoEventSink=Class(TInterfacedObject,IUnknown,IDispatch)
   private
    FController:TForm2;
    function QueryInterface(const IID:TGUID; out Obj):HResult;stdcall;

    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(Controller:TForm2);
   end;
....

Implementation


constructor TTafmoEventSink.create(Controller: TForm2);
begin
 inherited create;
 FController:=Controller;
end;

function TTafmoEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: integer; DispIDs: Pointer): HResult;
begin
 Result:=S_OK;
end;

function TTafmoEventSink.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
 Result:=S_OK;
end;

function TTafmoEventSink.GetTypeInfoCount(out Count: integer): HResult;
begin
 Result:=S_OK;
end;

function TTafmoEventSink.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): Hresult;
var Args: PVariantArgList;
    text:string;

begin
 Result:=S_OK;
 showmessage('Got Event '+inttostr(DispID));
 case DispID of
  7: begin
      Args := TDispParams(Params).rgvarg;
      text:=_BasketItem(Args^[0].dispVal).description;
      FController.OnItemAdded(text);
     end;
 end;
end;

function TTafmoEventSink.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
 if GetInterFace(IID,Obj) then
  Result:=S_OK
 else if isEqualIID(IID,ISimpleEventServerEvents) then
  Result:=QueryInterface(IDispatch,Obj)
 else
  Result:=E_NOINTERFACE;
end;

Die instanzierung bei ONCreate von Form2 sieht dann folgendermaßen aus:

Delphi-Quellcode:

 FTafmoAPI:=coAPI.Create;
 FTafmoEventSink:=TTafmoEventSink.create(Form2);
 InterfaceConnect(FTafmoApi,__API,FTafmoEventSink,FTafmoConnectionToken);

Leider tritt dabei nie ein Event auf. :cry:


Kann jemand damit was anfangen?

[shmia]

Das sieht soweit mal OK aus.
Prüfe mal, ob die Variable FTafmoConnectionToken einen Wert <> 0 erhält.
Ausserdem für jede der leeren Methoden eine Ausgabe mit OutputDebugString einbauen:

Delphi-Quellcode:

function TTafmoEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer; 
  NameCount, LocaleID: integer; DispIDs: Pointer): HResult; 
begin 
  OutputDebugString('TTafmoEventSink.GetIDsOfNames() called');
  Result:=S_OK; 
end;

So lässt sich feststellen, ob der Server eine deiner leere Methoden aufruft, die du ja nicht implementiert hast.

[markus.waibel]

Also der Token hat einen Wert von 0.
Andere Funktionen werden auch keine aufgerufen.

Was heißt das jetzt (Token 0)?


Zwischendurch mal ein GROSSES DANKESCHÖN für Deine Mühen.

[shmia]

Zitat von markus.waibel:

Also der Token hat einen Wert von 0. Was heißt das jetzt (Token 0)?

Das heisst, InterfaceConnect() ist in die Hosen gegangen.

Delphi-Quellcode:

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;

Ich vermute mal, der Parameter IID passt nicht.
Am Anfang der xxxx_TLB.pas steht ja ungefähr das:DIID_IabcedfgEvents: TGUID = '{C70599C4-5BE7-11D5-8F48-0000E237BE23}'; // nur ein Beispiel Das wäre IMHO die richtige GUID.

Führt das nicht zum Ziel, dann die Procedure InterfaceConnect in deine Unit kopieren und zum Debuggen so ändern:

Delphi-Quellcode:

procedure InterfaceConnect(const Source: IUnknown; const IID: TIID;
  const Sink: IUnknown; var Connection: Longint);
var
  CPC: IConnectionPointContainer;
  CP: IConnectionPoint;
  res : HResult;
begin
  Connection := 0;
  res := Source.QueryInterface(IConnectionPointContainer, CPC);
  OleCheck(res);
  res := CPC.FindConnectionPoint(IID, CP);
  OleCheck(res);
  res := CP.Advise(Sink, Connection);
  OleCheck(res);
  // eine der 3 Methoden müsste bei OleCheck auf einen Fehler laufen
end;

Zitat:

Zwischendurch mal ein GROSSES DANKESCHÖN für Deine Mühen.

Das hört man gern.

[markus.waibel]

Die Einträge, die du meinst schauen bei mir so aus:

Delphi-Quellcode:

  IID__API: TGUID = '{52CDEDBE-662A-4D52-8160-71C55A79234F}';
  DIID___API: TGUID = '{460D1860-72C8-41ED-A96A-0407A57648EE}';

Heißt das, dass ich beim Aufruf anstelle von

InterfaceConnect(FTafmoApi,__API,FTafmoEventSink,FTafmoConnectionToken); jetzt
InterfaceConnect(FTafmoApi,DIID___API,FTafmoEventSink,FTafmoConnectionToken); verwenden soll?

Da kommt leider auch 0.

[markus.waibel]

Beim Debuggen der Interface-Connect bekomme ich nach dem Aufruf cp.Advice die Meldung
im Project COMClient.exe ist eine Exception der Klasse EOleSysError aufgetreten. Meldung: 'Schnittstelle nicht unterstützt'. ...

Da bin ich jetzt platt.

[markus.waibel]

Jetzt mal das ganze Interface aus der TLB

Delphi-Quellcode:

// *********************************************************************//
// In dieser Typbibliothek deklarierte GUIDS . Es werden folgende
// Präfixe verwendet:
//   Typbibliotheken     : LIBID_xxxx
//   CoClasses           : CLASS_xxxx
//   DISPInterfaces      : DIID_xxxx
//   Nicht-DISP-Schnittstellen: IID_xxxx
// *********************************************************************//
const
...
  IID__API: TGUID = '{52CDEDBE-662A-4D52-8160-71C55A79234F}';
  DIID___API: TGUID = '{460D1860-72C8-41ED-A96A-0407A57648EE}';
  CLASS_API: TGUID = '{3BFC670F-236D-425D-B387-7B95F4339258}';
...

// *********************************************************************//
// Forward-Deklaration von in der Typbibliothek definierten Typen
// *********************************************************************//
  _API = interface;
  _APIDisp = dispinterface;
  __API = dispinterface;
...
// *********************************************************************//
// Deklaration von in der Typbibliothek definierten CoClasses
// (HINWEIS: Hier wird jede CoClass zu ihrer Standardschnittstelle
// zugewiesen)
// *********************************************************************//
  API = _API;
...

// *********************************************************************//
// Schnittstelle: _API
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {52CDEDBE-662A-4D52-8160-71C55A79234F}
// *********************************************************************//
  _API = interface(IDispatch)
    ['{52CDEDBE-662A-4D52-8160-71C55A79234F}']
    function Get_IsReady: WordBool; safecall;
    function Get_IsBusy: WordBool; safecall;
    procedure Set_POSDeviceID(const Param1: WideString); safecall;
    function Get_POSDeviceID: WideString; safecall;
    procedure Set_POSOperatorID(const Param1: WideString); safecall;
    function Get_POSOperatorID: WideString; safecall;
    procedure Set_POSReferenceID(const Param1: WideString); safecall;
    function Get_POSReferenceID: WideString; safecall;
    function SimpleProduct(const ProductID: WideString): WordBool; safecall;
    procedure Set_SovereignName(const Param1: WideString); safecall;
    function Get_SovereignName: WideString; safecall;
    procedure Set_SovereignVersion(const Param1: WideString); safecall;
    function Get_SovereignVersion: WideString; safecall;
    procedure Set_TrainingMode(Param1: WordBool); safecall;
    function Get_TrainingMode: WordBool; safecall;
    function Get_Version: WideString; safecall;
    procedure Set_WellBehaved(Param1: WordBool); safecall;
    function Get_WellBehaved: WordBool; safecall;
    function UserInterface: _UserInterface; safecall;
    function Basket: _Basket; safecall;
    function Journal: _Journal; safecall;
    function Settings: _Settings; safecall;
    procedure InjectData(Data: OleVariant; Device: Integer); safecall;
    procedure InjectCancel(Cancel: WordBool); safecall;
    function Get_IsAssigned: WordBool; safecall;
    procedure Set_POSInfo(const Name: WideString; const Param2: WideString); safecall;
    function Get_POSInfo(const Name: WideString): WideString; safecall;
    function Eftpos: _Eftpos; safecall;
    function Assign1(var HardwareID: WideString; var AssignCode1: WideString;
                     var AssignCode2: WideString; var Force: WordBool): WideString; safecall;
    function Assign2(var Args: PSafeArray): WideString; safecall;
    function Assign3: WideString; safecall;
    property IsReady: WordBool read Get_IsReady;
    property IsBusy: WordBool read Get_IsBusy;
    property POSDeviceID: WideString read Get_POSDeviceID write Set_POSDeviceID;
    property POSOperatorID: WideString read Get_POSOperatorID write Set_POSOperatorID;
    property POSReferenceID: WideString read Get_POSReferenceID write Set_POSReferenceID;
    property SovereignName: WideString read Get_SovereignName write Set_SovereignName;
    property SovereignVersion: WideString read Get_SovereignVersion write Set_SovereignVersion;
    property TrainingMode: WordBool read Get_TrainingMode write Set_TrainingMode;
    property Version: WideString read Get_Version;
    property WellBehaved: WordBool read Get_WellBehaved write Set_WellBehaved;
    property IsAssigned: WordBool read Get_IsAssigned;
    property POSInfo[const Name: WideString]: WideString read Get_POSInfo write Set_POSInfo;
  end;
...
// *********************************************************************//
// DispIntf:  _APIDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {52CDEDBE-662A-4D52-8160-71C55A79234F}
// *********************************************************************//
  _APIDisp = dispinterface
    ['{52CDEDBE-662A-4D52-8160-71C55A79234F}']
    property IsReady: WordBool readonly dispid 1745027081;
    property IsBusy: WordBool readonly dispid 1745027080;
    property POSDeviceID: WideString dispid 1745027079;
    property POSOperatorID: WideString dispid 1745027078;
    property POSReferenceID: WideString dispid 1745027077;
    function SimpleProduct(const ProductID: WideString): WordBool; dispid 1610809356;
    property SovereignName: WideString dispid 1745027076;
    property SovereignVersion: WideString dispid 1745027075;
    property TrainingMode: WordBool dispid 1745027074;
    property Version: WideString readonly dispid 1745027073;
    property WellBehaved: WordBool dispid 1745027072;
    function UserInterface: _UserInterface; dispid 1610809357;
    function Basket: _Basket; dispid 1610809358;
    function Journal: _Journal; dispid 1610809359;
    function Settings: _Settings; dispid 1610809360;
    procedure InjectData(Data: OleVariant; Device: Integer); dispid 1610809361;
    procedure InjectCancel(Cancel: WordBool); dispid 1610809362;
    property IsAssigned: WordBool readonly dispid 1745027092;
    property POSInfo[const Name: WideString]: WideString dispid 1745027091;
    function Eftpos: _Eftpos; dispid 1610809367;
    function Assign1(var HardwareID: WideString; var AssignCode1: WideString;
                     var AssignCode2: WideString; var Force: WordBool): WideString; dispid 1610809368;
    function Assign2(var Args: {??PSafeArray}OleVariant): WideString; dispid 1610809369;
    function Assign3: WideString; dispid 1610809372;
  end;
...
// *********************************************************************//
// DispIntf:  __API
// Flags:     (4240) Hidden NonExtensible Dispatchable
// GUID:      {460D1860-72C8-41ED-A96A-0407A57648EE}
// *********************************************************************//
  __API = dispinterface
    ['{460D1860-72C8-41ED-A96A-0407A57648EE}']
    procedure Surrender(Reason: Integer; const Message: WideString); dispid 1;
    procedure RefuseInterrupt; dispid 2;
    procedure StartDevice(Device: Integer); dispid 3;
    procedure StopDevice(Device: Integer); dispid 4;
    procedure GetData(const Name: WideString; const DataType: WideString; Device: Integer;
                      const ErrorMessage: WideString; var Data: OleVariant; var Cancel: WordBool); dispid 5;
    procedure DataMismatch(Index: Smallint; Data: OleVariant; const Message: WideString); dispid 6;
    procedure ItemAdded(var BasketItem: _BasketItem; var Cancel: WordBool); dispid 7;
    procedure ItemRemoved(var BasketItem: _BasketItem); dispid 8;
    procedure AddItemFailed(const ProductID: WideString; const Message: WideString); dispid 9;
    procedure VoucherAvailable(var Voucher: _Voucher); dispid 10;
    procedure BasketCommitted(NumberOfItems: Smallint); dispid 27;
    procedure BasketSuspended(const handle: WideString); dispid 11;
    procedure SuspendFailed(const Message: WideString); dispid 12;
    procedure ResumeComplete(NumberOfItems: Smallint); dispid 13;
    procedure ResumeFailed(const handle: WideString; const Message: WideString); dispid 14;
    procedure PrintBegin(NumberOfDocuments: Smallint); dispid 15;
    procedure PrintVoucher(const Alignment: WideString); dispid 16;
    procedure PrintText(const Font: WideString; const Emphasis: WideString; CharWidth: Smallint; 
                        CharHeight: Smallint; const Alignment: WideString; Indent: Smallint; 
                        const Data: WideString); dispid 17;
    procedure PrintLine(Width: Smallint); dispid 18;
    procedure PrintBarcode(const BarcodeType: WideString; Width: Smallint; Height: Smallint; 
                           const Alignment: WideString; const Data: WideString); dispid 19;
    procedure PrintGraphicsBegin(const VerticalAlignment: WideString); dispid 20;
    procedure PrintImage(const Alignment: WideString; const FileName: WideString); dispid 21;
    procedure PrintGraphicsEnd; dispid 22;
    procedure PrintCut(HalfCut: WordBool); dispid 23;
    procedure PrintVoucherEnd; dispid 24;
    procedure PrintEnd; dispid 25;
    procedure Closing(const Message: WideString); dispid 26;
  end;
...

Kann mann da irgendwo rauslesen, dass das ganze nicht geht???

[shmia]

cp.Advice ruft jetzt in diese Methode hinein:

Delphi-Quellcode:

function TTafmoEventSink.QueryInterface(const IID: TGUID; 
  out Obj): HResult;
var
   s : string; 
begin
   s := GuidToString(IID);
 
if GetInterFace(IID,Obj) then 
  Result:=S_OK 
else if isEqualIID(IID,ISimpleEventServerEvents) then 
  Result:=QueryInterface(IDispatch,Obj) 
else 
  Result:=E_NOINTERFACE; 

  if result <> S_OK then
    OutputDebugString(s);  // zu debugzwecken hinzu - hier unbedingt Breakpoint setzen
end;

Irgendwas ist da faul. Eigentlich dürfte ja nur das IDispatch Interface vom Server abgerufen werden.
Vielleicht will er ja ein weiteres/anderes Interface abrufen wie z.B. ISupportsErrorInfo...

[markus.waibel]

Läuft da überall sauber durch.

Keine Meldung. Lediglich die Gleiche Meldung nach dem CP.Advise

[shmia]

Zitat von markus.waibel:

Läuft da überall sauber durch.
Keine Meldung. Lediglich die Gleiche Meldung nach dem CP.Advise

Rätzelhaft. Aber warum sind die Interfaces als Hidden gekennzeichnet???
Hidden bedeutet IMHO dass ein Interface nur im eigenen Prozess verwendet werden kann.