AGB  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Callback mit externer C-dll

Ein Thema von oXmoX · begonnen am 23. Jun 2005 · letzter Beitrag vom 24. Jun 2005
Antwort Antwort
oXmoX

Registriert seit: 8. Jun 2005
85 Beiträge
 
#1

Callback mit externer C-dll

  Alt 23. Jun 2005, 17:38
Hallo Forum!

Hab mal eine Frage zu Funktionspointern. Ich verwende eine externe C-Bibliothek. Um ein Callback zu realisieren nimmt eine der verwendeten Funktionen ein Funktionspointer entgegen. Dieser ist vom Typ void* - also Pointer in Delphi.

Jetzt habe ich eine Prozedur "CallbackProc" erstellt, die nun als Pointer übergeben werden soll. Dazu wiederum ist die Funktion "SetupCallback" zuständig. Das Problem ist nur, dass meine Callback-Prozedur vom Typ "TCallbackProc" ist und ich keine Ahnung hab, wie ich daraus einen Pointer für die C-Funktion machen soll.

Code:
unit CallbackTest;

interface
 
type
  TCallbackProc = procedure(ImageIpl: P_IplImage);

function setCallback(callback: Pointer); cdecl;
procedure SetupCallback;
procedure CallbackProc(ImageIpl: P_IplImage);


implementation

var
  CallbackProcVar: TCallbackProc;

function setCallback(callback: Pointer); external 'abc.dll';

procedure CallbackProc(ImageIpl: P_IplImage);
begin
  ; // nix
end;

procedure SetupCallback;
begin
  CallbackProcVar := CallbackProc;
  setCallback(CallbackProcVar);
end;

end.
Bei dem oben abgebildeten Code sagt mir der Compiler jedenfalls "Nicht genügend wirkliche Parameter" in der Zeile "setCallback(CallbackProcVar);" ...kein Wunder: Ich übergebe ja auch einen Pointer, wie gefordert.

Was nun?
  Mit Zitat antworten Zitat
Benutzerbild von c113plpbr
c113plpbr

Registriert seit: 18. Nov 2003
Ort: localhost
674 Beiträge
 
Delphi 2005 Professional
 
#2

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 17:48
Probiers doch mal so:
Delphi-Quellcode:
procedure SetupCallback;
begin
  setCallback(@CallbackProc);
end;
ciao, Philipp
Philipp
There is never enough time to do all the nothing you want.
*HABENWILL*
  Mit Zitat antworten Zitat
NicoDE
(Gast)

n/a Beiträge
 
#3

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 17:57
Zitat von oXmoX:
"setCallback(CallbackProcVar);" ...kein Wunder: Ich übergebe ja auch einen Pointer, wie gefordert.
Delphi ist in diesem Falle etwas übereifrig (bei der automatischen Dereferenzierung von (Funktions-)Zeigern) und versucht CallbackProcVar aufzurufen (es ist kein () nötig wie in C).

Zitat von oXmoX:
Was nun?
Siehe vorherigen Beitrag,
oder Pointer(CallbackProcVar).
  Mit Zitat antworten Zitat
oXmoX

Registriert seit: 8. Jun 2005
85 Beiträge
 
#4

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 18:52
Sowas blöse von mir. Vielen Dank für eure Hilfe. Da war ich eigentlich auch schon selbst drauf gekommen ...hat aber nicht funktioniert ...jetzt schon. Wer weis, das ich da wieder durcheinandergebracht habe.

...So, jetzt kommt der schwierige Teil. Schön wäre jetzt, wenn ich nicht eine Funktion, sondern eine Objekt-Methode als Funktionpointer übergeben kann. Hab mal Gegoogelt und folgenden Code gefunden, der mir angeblich aus einer Methode einen Funktionszeiger machen soll.

Code:
unit MethodPointer;

interface

//type TMyMethod = procedure of object;

function MakeProcInstance(M: TMethod): Pointer;
procedure FreeProcInstance(ProcInstance: Pointer);


implementation

function MakeProcInstance(M: TMethod): Pointer;
begin
  // allocate memory
  GetMem(Result, 15);
  asm
    // MOV ECX,
    MOV BYTE PTR [EAX], $B9
    MOV ECX, M.Data
    MOV DWORD PTR [EAX+$1], ECX
    // POP EDX
    MOV BYTE PTR [EAX+$5], $5A
    // PUSH ECX
    MOV BYTE PTR [EAX+$6], $51
    // PUSH EDX
    MOV BYTE PTR [EAX+$7], $52
    // MOV ECX,
    MOV BYTE PTR [EAX+$8], $B9
    MOV ECX, M.Code
    MOV DWORD PTR [EAX+$9], ECX
    // JMP ECX
    MOV BYTE PTR [EAX+$D], $FF
    MOV BYTE PTR [EAX+$E], $E1
  end;
end;


procedure FreeProcInstance(ProcInstance: Pointer);
begin
  // free memory
  FreeMem(ProcInstance, 15);
end;

end.
Hier noch der Link.

Wenn ich das jetzt mit folgendem Code aufrufe...

Code:
Self.FCallbackProcVar :=     // ist vom Typ procedure of object;
    Self.MyCallbackProc;
Self.FCallbackProcPtr := // ist vom Typ Pointer
    MakeProcInstance(TMethod(Self.FCallbackProcVar));
setCallback(FCallbackProcPtr);
...dann springt das Programm beim Aufrufen der Calback-Methode mit einer Access Violation raus und der Debugger präsentiert mir das CPU-Fenster. Das macht der bei der vorherigen Version nicht.
  Mit Zitat antworten Zitat
oXmoX

Registriert seit: 8. Jun 2005
85 Beiträge
 
#5

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 18:57
Ok ...habs grad selbst rausgefunden: die Methode muss STDCALL sein ...meine dll benutzt aber CDECL.
(Das kommt davon wenn man den Text nicht ordentlich durchliest)

Tja, ist wohl pech für mich. Oder hat jemand noch eine Idee.
  Mit Zitat antworten Zitat
NicoDE
(Gast)

n/a Beiträge
 
#6

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 19:42
Zitat von oXmoX:
Tja, ist wohl pech für mich. Oder hat jemand noch eine Idee.
Man könnte den Code anpassen...
Allerdings wird's aus Zeitmangel bei mir nichts vor heute Nacht oder morgen; aber es gibt ja genug Freaks in diesem Forum

ps: zudem muss der Code für WinXP SP2 angepasst werden (Code auf dem Heap mag die DEP nicht...)
  Mit Zitat antworten Zitat
oXmoX

Registriert seit: 8. Jun 2005
85 Beiträge
 
#7

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 19:57
Zitat von NicoDE:
Allerdings wird's aus Zeitmangel bei mir nichts vor heute Nacht oder morgen; aber es gibt ja genug Freaks in diesem Forum
Hey, mach dir keinen Stress NicoDE. Zur Not kann ich auch mit der obigen Lösung leben. Ich selbst werde da jedenfalls die Finger von lassen. Ich programmiere erst seit zwei Monaten in Delphi und von Inline-Assembler habe ich schonmal überhaupt keine Ahnung.
  Mit Zitat antworten Zitat
NicoDE
(Gast)

n/a Beiträge
 
#8

Re: Callback mit externer C-dll

  Alt 23. Jun 2005, 20:06
So, weil an-Delphi-rumhacken doch irgendwie Spaß macht...
...hier Dein Thunk für cdecl-Methodenzeiger
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Classes, Controls, Forms, Dialogs, StdCtrls;

type
  TFNCallback = procedure(Text: PChar); cdecl;
  TFNMethodCallback = procedure(Text: PChar) of object; cdecl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure MethodCallback(Text: PChar); cdecl;
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FNCallback: TFNCallback;
    FNMethodCallback: TFNMethodCallback;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

////////////////////////////////////////////////////////////////////////////////
//
// MakeCdeclCallback (build thunk to use cdecl methods as static callback)
//

function MakeCdeclCallback(const Method: TMethod; StackSize: Shortint): Pointer;
{$IFDEF WIN32}
type
  PCallbackPush = ^TCallbackPush;
  TCallbackPush = packed record
    // push dword ptr [esp+x]
    PushParmOps: array [0..2] of Byte;
    PushParmVal: Shortint;
  end;
  PCallbackCall = ^TCallbackCall;
  TCallbackCall = packed record
    // push dword ptr [offset]
    PushDataOps: array [0..1] of Byte;
    PushDataVal: Pointer;
    // call [offset]
    CallCodeOps: array [0..1] of Byte;
    CallCodeVal: Pointer;
    // add esp,x
    AddEspXXOps: array [0..1] of Byte;
    AddEspXXVal: Shortint;
    // ret
    Return : Byte;
  end;
var
  Size: Shortint;
  Loop: Shortint;
  Buff: Pointer;
{$ENDIF}
begin
{$IFDEF WIN32}
  if (StackSize < 0) or // check for invalid parameter and Shortint overflow
    (StackSize > High(Shortint) + 1 - 2 * SizeOf(Longword)) then
  begin
    Result := nil;
    Exit;
  end;
  Result := VirtualAlloc(nil, $100, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  if Assigned(Result) then
    try
      Buff := Result;
      if StackSize <= 0 then
        Size := 0
      else
      begin
        // Copy parameters (used Longwords)
        Size := ((StackSize - 1) div SizeOf(Longword) + 1) * SizeOf(Longword);
        for Loop := 1 to Size div SizeOf(Longword) do
        begin
          with PCallbackPush(Buff)^ do
          begin
            PushParmOps[0] := $FF;
            PushParmOps[1] := $74;
            PushParmOps[2] := $24;
            PushParmVal := Size;
          end;
          Inc(PCallbackPush(Buff));
        end;
      end;
      with PCallbackCall(Buff)^ do
      begin
        // Push Self
        PushDataOps[0] := $FF;
        PushDataOps[1] := $35;
        PushDataVal := Addr(Method.Data);
        // Call Method
        CallCodeOps[0] := $FF;
        CallCodeOps[1] := $15;
        CallCodeVal := Addr(Method.Code);
        // Fix Stack
        AddEspXXOps[0] := $83;
        AddEspXXOps[1] := $C4;
        AddEspXXVal := Size + SizeOf(Longword);
        // Return
        Return := $C3;
      end;
    except
      VirtualFree(Result, 0, MEM_RELEASE);
      Result := nil;
    end;
{$ELSE}
  Result := nil;
{$ENDIF}
end;

procedure FreeCdeclCallback(Callback: Pointer);
begin
{$IFDEF WIN32}
  if Assigned(Callback) then
    VirtualFree(Callback, 0, MEM_RELEASE);
{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Create callback thunk for FNMethodCallback
  FNCallback := TFNCallback(MakeCdeclCallback(TMethod(FNMethodCallback), 4));
  // afterwards to show that the thunk works even if the value changes!
  FNMethodCallback := MethodCallback;
end;

procedure TForm1.MethodCallback(Text: PChar); cdecl;
begin
  ShowMessage('MethodCallback: ' + string(Text));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FNCallback('foo');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeCdeclCallback(@FNCallback);
end;

end.
  Mit Zitat antworten Zitat
oXmoX

Registriert seit: 8. Jun 2005
85 Beiträge
 
#9

Re: Callback mit externer C-dll

  Alt 24. Jun 2005, 11:34
Genial Meister!

Kann's im Moment nicht ausprobieren.
Sollte es aber bei mir nicht funktionieren, dann weiß ich ja, wo ich meckern kann .

An den Service hier könnte ich mich gewöhnen .

Gruß,
oXmoX
  Mit Zitat antworten Zitat
NicoDE
(Gast)

n/a Beiträge
 
#10

Re: Callback mit externer C-dll

  Alt 24. Jun 2005, 12:11
Apropos Service, hier ist eine Version die mit 'pascal', 'stdcall' und 'safecall' (auch unter WinXP SP2) funktioniert:
(falls es mal jemand brauchen sollte)
Delphi-Quellcode:
////////////////////////////////////////////////////////////////////////////////
//
// MakeStdcallCallback (thunk to use stdcall method as static callback)
// (works too for pascal and safecall, but NOT for cdecl and register!)

function MakeStdcallCallback(const Method: TMethod): Pointer;
{$IFDEF WIN32}
type
  PCallbackCode = ^TCallbackCode;
  TCallbackCode = packed record
    Ops1: array [0..2] of Longword;
    Val1: Pointer;
    Ops2: array [0..1] of Longword;
    Val2: Pointer;
  end;
{$ENDIF}
begin
{$IFDEF WIN32}
  Result := VirtualAlloc(nil, $100, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  if Assigned(Result) then
    try
      with PCallbackCode(Result)^ do
      begin
        // ; do not change registers!
        // push eax ; stack space (Self)
        // push eax ; backup accumulator
        // mov eax, [esp+8] ; get return address
        // mov [esp+4], eax ; save at lower addr
        // mov eax, [x].TMethod.Data ; get x.Self pointer
        // mov [esp+8], eax ; save it into space
        // pop eax ; get eax from stack
        // nop ; think about it *g*
        // jmp dword ptr [x].TMethod.Code ; now jump to method
        // ; no need to cleanup stack
        Ops1[0] := $448B5050;
        Ops1[1] := $44890824;
        Ops1[2] := $058B0424;
        Val1 := Addr(Method.Data);
        Ops2[0] := $08244489;
        Ops2[1] := $25FF9058;
        Val2 := Addr(Method.Code);
      end;
    except
      VirtualFree(Result, 0, MEM_RELEASE);
      Result := nil;
    end;
{$ELSE}
  Result := nil;
{$ENDIF}
end;

procedure FreeCallback(Callback: Pointer);
begin
{$IFDEF WIN32}
  if Assigned(Callback) then
    VirtualFree(Callback, 0, MEM_RELEASE);
{$ENDIF}
end;
Fehlt nur noch 'register', aber dazu bin ich heute zu faul.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:11 Uhr.
Powered by vBulletin® Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2014 by Daniel R. Wolf