COM-Object mit Events

[markus.waibel]

[delphi]Ich sollte ein COM-Objekt einbinden und auf dessen Events reagieren.
Ich kann zwar auf die Properties und Methoden zugreifen, die Events sind jedoch nicht vorhanden.
In einem VB-Beispiel wird die Klasse mit "Private WithEvents m_objAPI As API" instanziert. Was ich jetzt brauche ist der passende Delphi-Befehl zu der "WithEvents"-Anweisung.

Hat da jemand eine Idee?

[Bernhard Geyer]

Importier dir doch die Typlibrary und lass dir von Delphi ein paasendes VCL-Objekt mit passend verknüpfter Eventschnittstelle erstellen.

Falls aufgrund von "komischer" Eventschnittstelle nicht klappt probier mal EventSinkImp aus.

[markus.waibel]

Hallo Bernhard,

klappt leider beides nicht. Delphi erstellt die Events in einem dispinterface(was auch immer das bedeutet.

Das Programm sventsinkimp meldet "Unable to import type library file:...."

Was nu?????

Danke für deine Antwort

Markus

[Bernhard Geyer]

Zitat:

Zitat von markus.waibel

Das Programm sventsinkimp meldet "Unable to import type library file:...."

Dann beinhaltet die ausgewählte Datei keine TLB bzw. ist für Delphi nicht lesbar.

Um was für ein COM-Objekt geht es denn?

[shmia]

@markus.waibel: kannst du deine Delphi Version in deinen persönlichen Einstellungen hinterlegen ?
Von der Version hängt auch ab, wie gut Delphi mit TLBs und COM-Objekten umgehen kann.
Unterhalb von Delphi 5 ist diese Unterstützung noch relativ unzureichend.

[markus.waibel]

@SHMIA: Da komm ich jetzt nicht ganz mit. Vermute du sprichst das Tool EventSinkGenerator an. bei Optionen kann ich da jedoch nichts einstellen was die Delphi-Version betrifft. Ich verwende Delphi7.
Gruß Markus

[jim_raynor]

Zitat:

Zitat von markus.waibel

@SHMIA: Da komm ich jetzt nicht ganz mit. Vermute du sprichst das Tool EventSinkGenerator an. bei Optionen kann ich da jedoch nichts einstellen was die Delphi-Version betrifft. Ich verwende Delphi7.
Gruß Markus

Er meint dein Delphi-PRAXIS User-Profil ;) Da kann man eintragen, welche Delphi Version man verwendet.

[markus.waibel]

OK Jetzt hab ich's.
Mein Profil habe ich eben aktualisiert.

[markus.waibel]

Ich hab jetzt mal nachgelesen und begonnen meinen eigenen EventSink zu entwickeln.
Im Moment scheitere ich daran den Events die Parameter zu übergeben. Ich habe mich an ein Beispiel von Codegear gealten. Dabei wird ein kleines Testprogramm (Client und Server) erstellt, welches ein Event vom Server im Client abhandelt. Dieses Event hat jedoch keine Übergabeparameter. Mein Event übergibt zwei Parameter. Wie bekomme ich jetzt die Parameter des Events des Servers in der Invoke-Prozedur als Parameter für meine Client-Prozedur?????

(Ich hoffe das war jetzt nicht zu kompliziert...)

[shmia]

Kannst du TLB mal hochladen und dazu angeben, um welches Event-Interface es sich handelt ?
Man kann die TLB wie folgt extrahieren:
Im Delphi Menue: Datei -> Öffnen
Dateityp auf "Typbibliothek" umstellen.
EXE, DLL oder OCX-Datei laden. (kann sehr laaaange dauern)
Datei -> Speichern unter (Dateiendung auf .TLB ändern)

Als Hintergrund:
um ein COM-Event zu empfangen, benötigt man entweder
a.) ein passendes IDispatch-Interface oder
b.) ein Interface, dass von der Server-TLB vorgegeben wird. (frühe Bindung)
Delphi kann nur mit dem Fall a.) umgehen; mit Fall b.) kommt Delphi (aber auch VB-Script, Java-Script) nicht klar.
Beim Fall a.) gibt es noch zwei Varianten:
1.) entweder der Server ruft zuerst die function GetIDsOfNames auf, und danach Invoke
2.) der Server ruft direkt Invoke auf weil ihm die DispIds schon von der TLB bekannst sind.
Wenn der Server nach Fall 1.) agiert (ist aber eher selten), dann hat Delphi ein Problem:

Delphi-Quellcode:

function TEventDispatch.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;  // nicht implementiert, blöd
end;

[markus.waibel]

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

Delphi-Quellcode:

   __API = dispinterface

deklariert wurde.

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

Delphi-Quellcode:

   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:

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:

Delphi-Quellcode:

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. :hi:

[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

Delphi-Quellcode:

InterfaceConnect(FTafmoApi,__API,FTafmoEventSink,FTafmoConnectionToken);

jetzt

Delphi-Quellcode:

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:

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.