Adresse eine Funktion / Prozedur ermitteln

[Fussball-Robby]

Danke, werde ich mir morgen heute(so spät schon :cyclops: ) mal genauer angucken :wink:

[Neutral General]

Sag mir unbedingt obs läuft, notfalls schreib ich dir ne kleine Demo :)

Bin ganz stolz auf das Ding :mrgreen: Wobei ich gestehn muss, dass ich das ohne Apollonius nicht geschafft hätte. Der ASM Teil hat mir doch ab und zu zu schaffen gemacht *g*

Gruß
Neutral General

[Fussball-Robby]

Zitat:

Zitat von Neutral General

Sag mir unbedingt obs läuft, notfalls schreib ich dir ne kleine Demo :)

Läuft soweit, hab nur noch eine Prüfung auf proc = nil eingebaut, damit es keine AV gibt, wenn es die Methode nicht gibt :thumb: Was ich aber noch nicht ganz verstanden habe ist die Parameterübergabe mittels TVarRect... Vielleicht wäre eine kleine Demo oder eine Erklärung doch nicht so schlecht :wink:

[Apollonius]

Ich glaube, dass da noch ein paar Fehler drin sind. Teste das mal mit einer Prozedur, die Integer-Parameter entgegennimmt - ich denke, dass das bei @NoExt push edx statt push [edx] heißen muss.
Außerdem wird es unangenehm, wenn einer der ersten beiden nicht-Self-Parameter ein Float ist - dann wird nämlich der vierte Parameter in ecx übergeben, anstatt gepusht zu werden. Das macht es insgesamt äußerst kompliziert - vielleicht wäre es besser, stdcall, cdecl oder pascal als Aufrufkonvention zu verlangen.

[Neutral General]

Zitat:

Zitat von Apollonius

[...]Das macht es insgesamt äußerst kompliziert - vielleicht wäre es besser, stdcall, cdecl oder pascal als Aufrufkonvention zu verlangen.

Mh ja das könnte sein... Nur "damals" wäre stdcall für mich nicht so gut gewesen. Aber wenn man die Methode nur "für sich" braucht, dann wärs natürlich einfacher.

Ich gucke mir grad die Methode nochmal an. Vorallem die Stellen, die du genannt hast.

Gruß
Neutral General

[Fussball-Robby]

Wenn ihr hier über Assembler redet, ist das so als würde ich chinesisch rückwärts lesen :stupid: Ich sollte das vielleicht auch mal lernen, dann müsste ich jetzt nicht warten, bis das hier jemand nen verbesserten Code postet..

[Neutral General]

*hust* Wie bestellt ist hier auch schon der neue Code *g*

Delphi-Quellcode:

class procedure TProceduren.RunMethod(AMethod: String;
  Params: array of Const);
var proc: Pointer;
    hi: Integer;
    i, off: Integer;
    param: Byte;
begin
  proc := MethodAddress(AMethod);
  hi := High(Params);
  asm
    mov param,0
    mov i,0
    @loop:
      mov eax,i
      cmp eax,hi
      jg @loopend    
        imul eax,i,8
        add eax,4
        mov off,eax
         
        mov eax,[Params]
        add eax,off
        movzx ax,byte ptr [eax]
         
        cmp ax,vtExtended
        je @EditParam
          inc param
          cmp param,2
          jle @NextLoop
        @EditParam:
          sub off,4
          cmp ax,vtExtended
          jne @NoExt
            mov eax,[Params]
            add eax,off
            mov eax,[eax]
            movzx edx, word ptr [eax+$08]
            push edx
            push [eax+$04]
            push [eax]
            jmp @NextLoop
          @NoExt:
            mov eax,[Params]
            add eax,off
            push [eax]
        @NextLoop:
          inc i
          jmp @loop
    @loopend:

    mov param,0
    mov i,0
    @loop2:
      mov eax,i
      cmp eax,hi
      jnl @loop2end
        imul eax,i,8
        add eax,4
        mov off,eax
        
        mov eax,[Params]
        add eax,off
        mov eax,[eax]

        cmp eax,vtExtended
        je @NextLoop2
        inc param

        cmp param,1
        je @edx
        cmp param,2
        je @ecx
        jmp @loop2end

        @edx:
          sub off,4
          mov eax,[Params]
          add eax,off
          mov edx,[eax]
          jmp @NextLoop2
        @ecx:
          sub off,4
          mov eax,[Params]
          add eax,off
          mov ecx,[eax]
          jmp @Loop2End
      @NextLoop2:
        inc i
        jmp @loop2
    @loop2end:

    mov eax,self
    call proc
  end;
end;

Int64's werden jedoch noch nicht unterstützt. Ich arbeite aber daran ;)

Gruß
Neutral General

[Fussball-Robby]

Ich bin hier gerade am verzweifeln.. :?
Ich bekomm es einfach nicht hin, dass die Prozedur ShowString den Parameter mittes ShowMessage richtig ausgibt..Mal gibts ne AV, mal kommt ne leere MessageBox... Könntest du mir villeicht ein kleines Demo machen, ich kriegs einfach nicht hin :wall:

[Neutral General]

Hab dir mal eine Demo angehängt. Hab auch noch einen Fehler korrigiert und die Methode kann jetzt alles außer Variants.

Hier nochmal der komplette Quelltext:

Delphi-Quellcode:

type
  TProcedures = class
  published // Oder Public, dann muss aber der Compilerschalter {$METHODINFO ON} aktiviert sein
    class procedure ShowString(S: String);
    class procedure MegaTest(a: Integer; b: Boolean; c: Char; d: Extended; e: String; f: Pointer;
                             g: PChar; h: TObject; i: TClass; j: WideChar; k: PWideChar;
                             l: AnsiString; m: Currency; n: IUnknown;
                             o: WideString; p: Int64);
    class procedure RunMethod(AMethod: String; Params: Array of Const);
  end;

implementation

class procedure TProcedures.RunMethod(AMethod: String;
  Params: Array of Const);
var proc: Pointer;
    hi: Integer;
    i, off: Integer;
    param: Byte;
begin
  proc := MethodAddress(AMethod);
  hi := High(Params);
  asm
    mov param,0
    mov i,0
    @loop:
      mov eax,i
      cmp eax,hi
      jg @loopend
        imul eax,i,8
        add eax,4
        mov off,eax

        mov eax,[Params]
        add eax,off
        movzx ax,byte ptr [eax]

        cmp ax,vtExtended
        je @EditParam
          cmp ax,vtInt64
          je @EditParam
          cmp ax,vtCurrency
          je @EditParam
          inc param
          cmp param,2
          jle @NextLoop
        @EditParam:
          sub off,4
          cmp ax,vtExtended
          jne @NoExt
            mov eax,[Params]
            add eax,off
            mov eax,[eax]
            movzx edx, word ptr [eax+$08]
            push edx
            push [eax+$04]
            push [eax]
            jmp @NextLoop
          @NoExt:
            cmp ax,vtInt64
            je @Int64Currency
            cmp ax,vtCurrency
            je @Int64Currency
            cmp ax,vtChar
            je @Char
            @Standard:
              mov eax,[Params]
              add eax,off
              push [eax]
              jmp @NextLoop
            @Char:
              mov eax,[Params]
              add eax,off
              mov eax,[eax]
              xor edx,edx
              mov dl,al
              push edx
              jmp @NextLoop
            @Int64Currency:
              mov eax,[Params]
              add eax,off
              mov eax,[eax]
              push [eax+$04]
              push [eax]
        @NextLoop:
          inc i
          jmp @loop
    @loopend:

    mov param,0
    mov i,0
    @loop2:
      mov eax,i
      cmp eax,hi
      jg @loop2end
        imul eax,i,8
        add eax,4
        mov off,eax

        mov eax,[Params]
        add eax,off
        movzx ax,byte ptr [eax]

        cmp ax,vtExtended
        je @NextLoop2
        cmp ax,vtInt64
        je @NextLoop2
        cmp ax,vtCurrency
        je @NextLoop2
        
        inc param

        cmp param,1
        je @edx
        cmp param,2
        je @ecx
        jmp @loop2end

        @edx:
          sub off,4
          mov eax,[Params]
          add eax,off
          mov edx,[eax]
          jmp @NextLoop2
        @ecx:
          sub off,4
          mov eax,[Params]
          add eax,off
          mov ecx,[eax]
          jmp @Loop2End
      @NextLoop2:
        inc i
        jmp @loop2
    @loop2end:

    mov eax,Self
    call proc
  end;
end;

class procedure TProcedures.ShowString(S: String);
begin
  ShowMessage(S);
end;

class procedure TProcedures.MegaTest(a: Integer; b: Boolean; c: Char; d: Extended;
  e: String; f: Pointer; g: PChar; h: TObject; i: TClass; j: WideChar;
  k: PWideChar; l: AnsiString; m: Currency; n: IInterface;
  o: WideString; p: Int64);
begin
  ShowMessage(Format('a: %d'#13#10 // Integer
                   + 'b: %d'#13#10 // Boolean (auf Integer gecastet)
                   + 'c: %s'#13#10 // Char
                   + 'd: %f'#13#10 // Extended (Single,Double)
                   + 'e: %s'#13#10 // String
                   + 'f: %p'#13#10 // Pointer
                   + 'g: %s'#13#10 // PChar
                   + 'h: %s'#13#10 // TObject (Classname)
                   + 'i: %s'#13#10 // TClass (Classname)
                   + 'j: %d'#13#10 // WideChar
                   + 'k: %s'#13#10 // PWideChar
                   + 'l: %s'#13#10 // AnsiString
                   + 'm: %f'#13#10 // Currency
                   + 'n: %d'#13#10 // Interface
                   + 'o: %s'#13#10 // WideString
                   + 'p: %d'#13#10,// Int64
                   [a,Integer(b),c,d,e,f,g,h.ClassName,i.ClassName,Word(j),k,l,m,Integer(n),o,p]));
end;

Aufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  TProcedures.RunMethod('ShowString',['Test']);
end;

// Der utlimative Test/Beweis für das funktionieren meiner Methode :P
// Gibt man konkrete Werte an, muss z.T. gecastet werden, da der Compiler
// z.B. 123456789 ohne den Cast auf Int64 als normalen Integer behandelt
// ==> Exception!
// Man muss halt entweder casten oder int64 variablen etc übergeben.
// Das gleiche gilt auch noch für ein paar andere Typen, aber das kann man unten
// ja ablesen
//
// PS: Das bei dem Interface '0' angezeigt wird, ist schon richtig so ;)
procedure TForm1.Button2Click(Sender: TObject);
var x: IUnknown;
    curr: Currency;
    pwc : PWideCHar;
begin
  curr := 999;
  pwc := 'WideChar Welt';
  TProcedures.RunMethod('MegaTest',[22,true,'c',123.456,'Hallo Welt',Pointer($ABCDEF),
                        'Hallo Welt 2',Form1,TButton,WideChar('w'),pwc,
                        'En Ansistring',curr,x,WideString('B r e i t e r  S t r i n g *g*'),
                         Int64(123456789)]);
end;

Gruß
Neutral General

[BlueWonder]

Ich hätte da noch eine etwas einfachere Lösung. :-D Also ohne Assembler. :zwinker: Dabei stellt "TDynMethod" die Signatur der aufzurufenden Methoden dar und die Adresse der gesuchten Methode kommt in eine Variable vom Typ "TMethod" und wird anschließend in den Typ "TDynMethod" gecastet und hier auch gleich ausgeführt. Hab allerdings nicht explizit alle Datentypen durchprobiert. Da der Auffruf aber nicht aus der Applikation raus geht, sollten eigentlich alle Parameter-Typen funktionieren.

Delphi-Quellcode:

unit Unit3;

{$METHODINFO ON}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type

  TDynMethod = function(s: String):String of object;

  TForm3 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure execMyMethod(name: String);
    function m1(value: String): String;
    function m2(value: String): String;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}


procedure TForm3.execMyMethod(name: string);
var
  dMethode: TMethod;
begin
  dMethode.Data := Self;                      // Objekt zu dem die Methode gehört
  dMethode.Code := Self.MethodAddress(name);  // Adresse der gesuchten Methode
  if (dMethode.Code <> nil) then
    ShowMessage(TDynMethod(dMethode)('Teststring'))  // Type-Cast und sofortiger Aufruf mit einem sinnlosen String :)
  else
    ShowMessage('Die angegebene Methode wurde nicht gefunden!');
end;


function TForm3.m1(value: string): String;
begin
  Result := 'Ich bin Methode 1 und übergeben wurde: ' + value;
end;


function TForm3.m2(value: string): String;
begin
  Result := 'Ich bin Methode 2 und übergeben wurde: ' + value;
end;


procedure TForm3.Button1Click(Sender: TObject);
begin
  execMyMethod(Edit1.Text);
end;

end.