Event Multicast Problem : Howto "Sender.Methodname"?

[XiaN]

Ich glaub der Titel ist nen bissl ungünstig gewählt, aber mir fällt grade kein eindeutigerer ein

Mein Problem in der Kurzfassung

Ich biege mehrere Events von verschiedenen Componenten und verschiedenster Natur ( OnPress, OnClose, TDataset, TQuery usw. ) auf ein Event um und handle es dort. Über RTTI bekommt man ja nun den Klassennamen und viele andere tolle Sachen über Sender heraus, allerdings nicht wie die "Methode" heißt, die das Event ausgelöst hat.

Da ich nun schon 2 Tage am rumsuchen bin, hab ich schon einige Ansätze gefunden, allerdings steh ich grade irgendwie im Wald.

-> Über VMT sollte/könnte/müsste das gehen? Wenn ja wie wo und wann?
-> Callstack. Bei allem was ich so gefunden habe, musste man entweder nen "anderen" Memorymanager nutzen ( was nicht in Frage kommt ) oder irgendwelche MAP/RES/.. Files mitliefern, was ich auch nur SEHR ungern tun würde.
-> Assembler! Und genau das würde ich gern machen

Ein Lösungsansatz, den ich aber nicht verstehe

Gleich vorneweg. Ja, die Unit macht eigentlich genau das was ich machen will, aber sie ist verbuggt und nicht sehr gut implementiert. Deswegen habe ich sie neu geschrieben. Allerdings funktioniert nun der wichtigste Teil nicht mehr ... ein 6 Zeilen ASM Stück, da sich bei mir nat. der Inhalt des Stacks verschoben hat.

Auch habe ich die Unit nicht selbst geschrieben. Credits gehen an Anderson S. Soffa.

Meine Frage bezieht sich eigentlich auf ein Stück ASM

Code:

procedure TMultiDsEvent.FireDsNotifyEvents(Sender:TObject);
  ...
   { Don't change this method, any change here will change the stack content 
     We need the right stack position to get the calling address to identify 
     the calling method } 
   asm
      push eax
      mov eax, [esp+$40]
      mov eax, [eax-6]
      shr eax, 16   // offset of the object property 
      mov EventIndx, eax
      pop eax
   end;

Was macht er da?
Gibt es andere Wege an den Namen oder irgendein eineindeutiges Merkmal der Funktion zu kommen, die mein Event ausgelöst hat?

Das ganze spielt sich unter Delphi 7 und Win2000 ab und sollte wenn möglich auf Delphi 2007 übertragbar sein. Wenn ich erstmal nen Lösungsansatz habe, finde ich schon raus, wie sich das portieren lässt

Mit freundlichen Grüßen
Mario

Delphi-Quellcode:

unit uMultDsEvent;   // Only for DELPHI 7 Win 32

interface

uses Classes, db, variants, dialogs;

{$O+}

{
   Add multicast event handlers feature to applications compiled in Delphi 7
   For the time being only for TDataSet and TField descendants

   Usage:
      MultiEvent = TMultiDsEvent.Create(Form1);
      Delegate.AddEventHandler(Table,DSE_AFTEROPEN,afteropen2);
      Delegate.AddEventHandler(TablePRP_FONERES,FLD_ONCHANGE,onchange2);
      Delegate.AddEventHandler(TablePRP_FONERES,FLD_ONCHANGE,onchange3);
      MultiEvent.Destroy;

   The additional methods must be declared as published.
   If the object already have an event handler assigned to a certain event,
   when you add an extra handler, the original will be fired to.

   ===================================================================================
   Adiciona a capacidade de executar vários manipuladores (multicast event handlers)
   associados a um determinado evento do TDataSet ou TField.

   Exemplo:
      MultiEvent = TMultiDsEvent.Create;
      Delegate.AddEventHandler(Table,DSE_AFTEROPEN,afteropen2);
      Delegate.AddEventHandler(TablePRP_FONERES,FLD_ONCHANGE,onchange2);
      Delegate.AddEventHandler(TablePRP_FONERES,FLD_ONCHANGE,onchange3);
      MultiEvent.Destroy;

   Os métodos adicionais devem ser declarados como published.

   Caso o objeto ja possua um manipulador atribuído ao evento, ao adicionar
   um manipulador o original também será executado.

   ===================================================================================
   Any changes or doubts, please notify me. I will be glad to know any ideas, opnions
   or modifications to the source code. Have fun !!!!

   Anderson S. Soffa
   [email][e-mail][/email]
}
type
  TDSEvent = (DSE_BEFOREOPEN  , DSE_AFTEROPEN   , DSE_BEFORECLOSE , DSE_AFTERCLOSE,
              DSE_BEFOREINSERT, DSE_AFTERINSERT , DSE_BEFOREEDIT  , DSE_AFTEREDIT,
              DSE_BEFOREPOST  , DSE_AFTERPOST   , DSE_BEFORECANCEL, DSE_AFTERCANCEL,
              DSE_BEFOREDELETE, DSE_AFTERDELETE , DSE_BEFORESCROLL, DSE_AFTERSCROLL,
              DSE_ONNEWRECORD , DSE_ONCALCFIELDS, FLD_ONCHANGE    , FLD_ONVALIDATE );

  TMultiEvent = procedure(const Sender : TObject) of object;

  TMultiDsEvent = class(TPersistent)
  private
    fObjects : TStringList;
    fFireNtfEvn : TMethod;
    fOwner : TComponent;
  public
    constructor Create(Owner:TComponent);
    destructor Destroy; override;

    function  AddEventHandler(obj:TComponent; Event:TDSEvent; NewMethod:TNotifyEvent ):integer; overload;
    procedure DelEventHandler(obj:TComponent; Event:TDSEvent; OldMethod:TNotifyEvent);
  published
    procedure FireDsNotifyEvents(Sender:TObject);
  end;

implementation

uses SysUtils, TypInfo;

type
  TEventRec = record
     oldHandler : TMethod;
     HndList    : TList;
  end;

  TEvntLst = array of TEventRec;
  TEventList = ^TEvntLst;

  TKnownDsEvent = record
     name  : string;
     index : word;
  end;

const NotifyEvents : array[0..19] of TKnownDsEvent =
    ( (name: 'BEFOREOPEN';   index: 00 ),
      (name: 'AFTEROPEN';    index: 01 ),
      (name: 'BEFORECLOSE';  index: 02 ),
      (name: 'AFTERCLOSE';   index: 03 ),
      (name: 'BEFOREINSERT'; index: 04 ),
      (name: 'AFTERINSERT';  index: 05 ),
      (name: 'BEFOREEDIT';   index: 06 ),
      (name: 'AFTEREDIT';    index: 07 ),
      (name: 'BEFOREPOST';   index: 08 ),
      (name: 'AFTERPOST';    index: 00 ),
      (name: 'BEFORECANCEL'; index: 10 ),
      (name: 'AFTERCANCEL';  index: 11 ),
      (name: 'BEFOREDELETE'; index: 12 ),
      (name: 'AFTERDELETE';  index: 13 ),
      (name: 'BEFORESCROLL'; index: 16 ),
      (name: 'AFTERSCROLL';  index: 17 ),
      (name: 'ONNEWRECORD';  index: 18 ),
      (name: 'ONCALCFIELDS'; index: 19 ),
      (name: 'ONCHANGE'    ; index: 00 ),
      (name: 'ONVALIDATE'  ; index: 01 ) );

{ TMultiDsEvent }

function TMultiDsEvent.AddEventHandler(obj: TComponent; Event:TDSEvent;
  NewMethod: TNotifyEvent): integer;
var EventIndx, ObjectIndx : integer;
    ObjectId, EventName : string;
    pEvnList  : TEventList;
    OldMethod : TMethod;
    HandlerList : TList;
    ic : integer;
begin
    EventIndx := NotifyEvents[ord(Event)].index;
    EventName := NotifyEvents[ord(Event)].name;
    ObjectId  := IntToStr( integer( Pointer(obj) ) );
    if (not fObjects.Find(ObjectId,ObjectIndx)) then begin
       new(pEvnList); //  New events arrays
       if (obj is TDataSet) then
          SetLength(pEvnList^,20)
       else
          SetLength(pEvnList^,2);
       ObjectIndx := fObjects.AddObject(ObjectId, pointer(pEvnList) );
       for ic := 0 to high( pEvnList^ ) do begin
          pEvnList^[ic].HndList := nil;
          pEvnList^[ic].oldHandler.Code := nil;
          pEvnList^[ic].oldHandler.Data := nil;
       end;
    end;

    HandlerList := TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx].HndList;
    if not Assigned(HandlerList) then begin
       HandlerList := TList.Create;
       TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx].HndList := HandlerList;
    end;

    try
       if (HandlerList.IndexOf(Addr(NewMethod)) >=0 ) then
          exit;
       OldMethod := GetMethodProp(obj,EventName);
       if (OldMethod.Code <> nil) and (OldMethod.Code <> fFireNtfEvn.Code) then begin
           HandlerList.Add(OldMethod.Code);
           TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx].oldHandler := oldMethod;
       end;

       if (OldMethod.Code <> fFireNtfEvn.Code) then
           SetMethodProp(obj,EventName,fFireNtfEvn);

       result := HandlerList.Add( Addr(NewMethod) );
    except
       result := -1;
    end;
end;

constructor TMultiDsEvent.Create(Owner:TComponent);
begin
   fObjects := TStringList.Create;
   fObjects.Sorted := true;
   fFireNtfEvn.Code := Self.MethodAddress('FireDsNotifyEvents');
   fFireNtfEvn.Data := pointer(Self);
   fOwner := Owner;
end;

destructor TMultiDsEvent.Destroy;
var iEvnt: integer;
    HandlerList : TList;
    obj:TObject;
begin
   while fObjects.Count > 0 do begin
      for iEvnt := 0 to high(TEventList( fObjects.Objects[0] )^) do begin
         HandlerList := TEventList( fObjects.Objects[0] )^[iEvnt].HndList;
         if (TEventList( fObjects.Objects[0] )^[iEvnt].oldHandler.Code <> nil) then begin
            // if the event alreay have a handler
            obj := Pointer( strtoint( fObjects.Strings[0] ) );
            if (obj is TDataSet) then
               SetMethodProp(obj,NotifyEvents[iEvnt].name   ,TEventList( fObjects.Objects[0] )^[iEvnt].oldHandler)
            else
               SetMethodProp(obj,NotifyEvents[iEvnt+18].name,TEventList( fObjects.Objects[0] )^[iEvnt].oldHandler);
         end;
         if Assigned(HandlerList) then
            HandlerList.Free;
      end;
      dispose( TEventList( fObjects.Objects[0] ) );
      fObjects.Delete(0);
   end;
   fObjects.Free;
   inherited;
end;

procedure TMultiDsEvent.FireDsNotifyEvents(Sender:TObject);
var ObjectIndx, EventIndx, ii : integer;
    InvokeMethod: TMethod;
    LastInvoked : pointer;
    ObjectId    : string;
begin
   { Don't change this method, any change here will change the stack content
     We need the right stack position to get the calling address to identify
     the calling method }
   asm
      push eax
      mov eax, [esp+$40]
      mov eax, [eax-6]
      shr eax, 16   // offset of the object property 
      mov EventIndx, eax
      pop eax
   end;
   if (Sender Is TDataSet) then
      EventIndx  := (EventIndx div 8)-22
   else
      EventIndx  := (EventIndx div 8)-24;

   ObjectId := IntToStr( integer( Pointer(Sender) ) );
   if ( fObjects.Find(ObjectId, ObjectIndx) ) then begin
       ii          := 0;
       LastInvoked := nil;
       with TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx] do
          while Assigned(HndList) and (ii < HndList.Count) do begin
              if (LastInvoked <> HndList.Items[ii] ) then begin
                 InvokeMethod.Code := HndList.Items[ii];
                 InvokeMethod.Data := Pointer( fowner );
                 TMultiEvent(InvokeMethod)(Sender);
                 LastInvoked := InvokeMethod.Code;
              end;
              inc(ii);
          end;
    end;
end;

procedure TMultiDsEvent.DelEventHandler(obj: TComponent; Event: TDSEvent;
  OldMethod: TNotifyEvent);
var EventIndx, ObjectIndx, ii : integer;
    DelMethod  : Pointer;
    HandlerList: TList;
begin
    if fObjects.Find( IntToStr( integer( Pointer(obj) ) ), ObjectIndx) then begin
       EventIndx   := NotifyEvents[ord(Event)].index;
       HandlerList := TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx].HndList;
       DelMethod   := Addr(OldMethod);
       if (not Assigned(HandlerList) ) or (TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx].HndList.IndexOf(DelMethod) < 0) then
          exit;
       HandlerList.Remove( DelMethod );
       if (HandlerList.Count = 0) then begin
         // There are no more handlers for the event
          HandlerList.Free;
          TEventList( fObjects.Objects[ObjectIndx] )^[EventIndx].HndList := nil;
          for ii := 0 to High( TEventList( fObjects.Objects[ObjectIndx] )^ ) do begin
              if assigned( TEventList( fObjects.Objects[ObjectIndx] )^[ii].HndList ) then
                 break;
          end;
          // There are no more events for the object
          if (ii > High( TEventList( fObjects.Objects[ObjectIndx] )^ ) ) then begin
             dispose( TEventList( fObjects.Objects[ObjectIndx] ) );
             fObjects.Delete(ObjectIndx);
          end;
       end;
    end;
end;

initialization
  RegisterClass(TMultiDsEvent);


end.

[Apollonius]

Ich würde das einfach so erledigen, indem ich für jedes Ereignis eine eigene Objektinstanz anlege, die einen Eventhandler hat und beliebige Zusatzdaten speichern kann. Diese einzelnen Instanzen werden von einer Elternklasse kontrolliert, an die alle Ereignisse mitsamt den Zusatzdaten weitergeleitet werden. Wenn du dann die Ereignisse "umbiegst", erstellst du eben eine neue Objektinstanz und trägst deine Zusatzdaten (z.B. Ereignisname) ein.

[XiaN]

Danke für den Stubs in die richtige Richtung Apollonius.

Da es zu Multicast Events in Delphi Win32 so gut wie nichts im Web gibt, poste ich hier mal meine Lösung.

Delphi-Quellcode:

  //
  //  TEventHandler Class
  //
  //  Note : Class MUST be inherited from TPersistent
  //  Note : The procedure "Fire" MUST be published
  //

  TEventHandler = class(TPersistent)
  private

    LEvent: TMethod;
    LOwner: pointer;
    LEventName: string;

    OriginalMethod: TMethod;
    ScriptMethod: TMethod;

  public

    procedure Init(LDataSet: TComponent; Event: string; PMethod: pointer);

    constructor Create;
    destructor Destroy; override;

  published

    procedure Fire(Sender: TObject);

  end;

//
// Eventhandler
//

constructor TEventHandler.Create;
begin

  LEvent.Code := Self.MethodAddress('Fire');
  LEvent.Data := Pointer(Self);

end;

destructor TEventHandler.Destroy;
begin

  SetMethodProp(TObject(LOwner), LEventName, OriginalMethod);

  inherited;

end;

procedure TEventHandler.Init(LDataSet: TComponent; Event: string; PMethod: Pointer);
begin

  LOwner := Pointer(LDataSet);
  LEventName := Event;

  OriginalMethod := GetMethodProp(LDataset, Event);

  ScriptMethod.Code := PMethod;
  ScriptMethod.Data := self;

  SetMethodProp(LDataset, Event, LEvent);

end;

procedure TEventHandler.Fire(Sender: TObject);
begin
  TNotifyEvent(OriginalMethod)(Sender);
  TNotifyEvent(ScriptMethod)(Sender);
end;

Dieses Beispiel funktioniert natürlich nur mit einem Event. Wenn man beliebig viele Events auslösen will, ersetzt man

-> PMethod mit einem "array of pointer"
-> ScriptMethod mit "array of TMethod"
-> Den letzten Teil von "Init" mit einer Schleife die für length(PMethod) das "ScriptMethod" array füllt

Aufruf erfolgt dann wie folgt

Delphi-Quellcode:

var
  DataSetEventHandler: array of TEventHandler;

...

  SetLength(DataSetEventHandler, Length(DataSetEventHandler) + 1);
  DataSetEventHandler[Length(DataSetEventHandler) - 1] := TEventHandler.Create;
  DataSetEventHandler[Length(DataSetEventHandler) - 1].Init(LObject, 'OnChange', LPointer);

-> LObject ist das Objekt, von dem man ein Event hooken möchte
-> Danach folgt der Name des zu hookenden Events
-> LPointer ist hier der Pointer zu einer Methode/Funktion/Procedure die man nach dem org. Event auslösen möchte

Wird nun das gehookte Event ausgelöst, werden automatisch und ohne weiteres zutun das originale und dann das "gehookte" Event nacheinander ausgelöst.

Und nat. brav irgendwo wieder freigeben

Delphi-Quellcode:

  for i := 0 to Length(DataSetEventHandler) - 1 do
  begin
    FreeAndNil(DataSetEventHandler[i]);
  end;

Ich hoffe das hilft so manchem sich die 3-4 Tage suchen in der zu ersparen. Zumal google da ja wirklich nich viel hergibt.