BeginThread - Methoden aufruf

[littleDave]

Mit ein paar Tricks kann man auch Methoden mit Parametern, ohne "große" Probleme bekommen.

Delphi-Quellcode:

interface

type
  // Event-Deklaration, die in der Klasse aufgerufen wird
  TThreadExecuteEvent = procedure(const Params: array of const) of object;

procedure RunInThread(Meth: TThreadExecuteEvent; const Params: array of const); register;

implementation

type
  // interne Daten
  TConstArray = array of TVarData;
  PConstArray = ^TConstArray;

  PExecutionInfo = ^TExecutionInfo;
  TExecutionInfo = packed record
    EntryPoint    : TThreadExecuteEvent;
    ArrayLen      : integer;
    Params        : PConstArray;
  end;

// Dass ist die Methode, die man bei "BeginThread" aufruft, als Parameter bei "BeginThread" 
// kommt dann der Pointer auf ein TExecutionInfo - record 
function __internThreadProc(ExecInfo: PExecutionInfo): integer; stdcall;
var pPtr   : Pointer;
    pSelf  : Pointer;    
    pBase  : Pointer;
    len    : integer;
begin
  try
    // Start Address of the method
    pPtr  := TMethod(ExecInfo^.EntryPoint).Code;
    // Self-Pointer
    pSelf := TMethod(ExecInfo^.EntryPoint).Data;
    // Parameter array
    pBase := ExecInfo^.Params;
    // length of Parameter
    len   := ExecInfo^.ArrayLen;
    asm 
      // save base registers
      push ecx
      push ebx
      push eax

      // push self ptr
      mov  eax, pSelf
      // push array of const
      // array of const ->
      //  1st the pointer to the 1st element of the array
      mov  ebx, pBase
      //  2nd (hidden parameter): high value of the array
      mov  ecx, len

      // call
      call pPtr

      // restore registers
      pop eax
      pop ebx
      pop ecx
    end;
  finally
    // ExecInfo freigeben (wurde von "CallMethod" erzeugt)
    Dispose(ExecInfo);
  end;
  result := 0;
end;

procedure RunInThread(Meth: TThreadExecuteEvent; const Params: array of const); 
var p: PExecutionInfo;
begin
  // p wird in der Methode "__internThreadProc" wieder freigegeben
  New(p);
  p^.EntryPoint := Meth;
  p^.ArrayLen   := High(Params);
  p^.Params     := PConstArray(@Params);

  // hier der BeginThread - Aufruf:
  //  BeginThread(nil, 0, @__internThreadProc, p, 0, ThreadID);
  
  // Test-Code: direkter Aufruf
  __internThreadProc(p);
end;

Hier mal ein kleines Beispiel zur Benutzung:

Delphi-Quellcode:

type
  TTest = class
  private
    FValue : string;
  public
    procedure Test(const Params: array of const);
  end;

{ TTest }

procedure TTest.Test(const Params: array of const);
begin
  // Test des Self-Pointers
  ShowMessage(FValue);
  // Test auf Länge des Params-Array
  ShowMessage(IntToStr(length(Params)));
  // Ausgabe des 1. Parameters
  ShowMessage(IntToStr(TVarRec(Params[0]).VInteger));
end;

procedure TForm1.Button1Click(Sender: TObject);
var t: TTest;
begin
  t := TTest.Create;
  try
    t.FValue := 'Hallo';
    RunInThread(t.Test, [12345, 15676]);
  finally
    // wichtig: für das Testen wird kein Thread erstellt
    // daher können wir im finally-Part auch das Objekt wieder freigeben.
    // Falls man nun wirklich die Sache in einem Thread ausführt, darf
    // das Objekt erst freigegeben werden, wenn der Thread beendet ist - also nicht
    // hier.
    t.Free;
  end;
end;

Das ganze ist nur als Denk-Anstoß gedacht.

Gruß

EDIT
Ich seh gerade, dass das ganze per Threading noch nicht so ganz läuft: der Hacken ist in der Methode "RunInThread" in der Zeile: p^.Params := PConstArray(@Params); . Beim direkten Aufruf (also der Testcode), fällt der Fehler noch nicht auf. Jedoch wenn man es per Threading macht: das array-of-const wird freigegeben, sobald die Methode verlassen wird. Jedoch ist der Thread mit 99%er wahrscheinlich noch nicht beendet, d.h. der Pointer auf das "array-of-const"-Array wird ungültig. Man müsste das Array in der Methode neu kopieren - aber darauf habe ich gerade keine Lust mehr . Außerdem ist es wirklich etwas übertrieben. Hier mal eine einfache "RunInThread"-Methode, die ein beliebiges Objekt als Parameter entgegen nimmt (damit sollte es relativ einfach sein, das Grundprinzip zu verstehen):

Delphi-Quellcode:

interface

procedure RunInThread(Meth: TNotifyEvent; const Params: TObject); 

implementation

type
  // interne Daten
  PExecutionInfo = ^TExecutionInfo;
  TExecutionInfo = packed record
    EntryPoint    : TNotifyEvent;
    Data          : TObject;
  end;

// Dass ist die Methode, die man bei "BeginThread" aufruft, als Parameter bei "BeginThread" 
// kommt dann der Pointer auf ein TExecutionInfo - record 
function __internThreadProc(ExecInfo: PExecutionInfo): integer; stdcall;
begin
  try
    ExecInfo^.EntryPoint(ExecInfo^.Data);
  finally
    // ExecInfo freigeben (wurde von "CallMethod" erzeugt)
    Dispose(ExecInfo);
  end;
  result := 0;
end;

procedure RunInThread(Meth: TThreadExecuteEvent; const Data: TObject); 
var p: PExecutionInfo;
begin
  // p wird in der Methode "__internThreadProc" wieder freigegeben
  New(p);
  p^.EntryPoint := Meth;
  p^.Data       := Data;

  // hier der BeginThread - Aufruf:
  //  BeginThread(nil, 0, @__internThreadProc, p, 0, ThreadID);
  
  // Test-Code: direkter Aufruf
  __internThreadProc(p);
end;

Noch ein Beispiel

Delphi-Quellcode:

type
  TTest = class
  private
    FValue : string;
  public
    procedure Test(Sender: TObject);
  end;

{ TTest }

procedure TTest.Test(Sender: TObject);
begin
  // Test des Self-Pointers
  ShowMessage(FValue);
  // Test des Parameters
  ShowMessage(TTest(Sender).FValue);
end;

procedure TForm1.Button1Click(Sender: TObject);
var t: TTest;
begin
  t := TTest.Create;
  try
    t.FValue := 'Hallo';
    RunInThread(t.Test, t);
  finally
    // wichtig: für das Testen wird kein Thread erstellt
    // daher können wir im finally-Part auch das Objekt wieder freigeben.
    // Falls man nun wirklich die Sache in einem Thread ausführt, darf
    // das Objekt erst freigegeben werden, wenn der Thread beendet ist - also nicht
    // hier.
    t.Free;
  end;
end;