Thread & WaitForSingleObject - Access Violation bei SetEvent

[Viktorii]

Hallo zusammen.

Erstmal muss ich sagen, dass Threads usw. mehr oder weniger Neuland für mich sind. Bin deshalb auch für konstruktive Anmerkungen die evtl. etwas off-topic sind, dankbar.
Ich möchte eine USB Kommunikation zwischen PC und einem Gerät aufbauen. Ein Frame besteht jeweils aus Header und den eigentlichen Daten. Dieses Frame wird in zwei Schritten versendet.
Es wird also erst der Header versendet und im zweiten Schritt die Daten. Die Daten dürfen aber erst versendet werden, wenn der Header von Gerät empfangen wurde. Wenn innerhalb eines Timeouts der Header nicht empfangen wurde, soll das Programm in seinen Ursprungszustand zurückkehren. Dies habe ich versucht mit WaitForSingleObject und SetEvent zu erreichen...
Ich habe die den komplette Vorgang für ein Frame einen neuen Thread gepackt:

Delphi-Quellcode:

type
  TBulkTransferThread = class(TThread)
  private
    ...
    ...
  protected
  public
    constructor create( ...
         ... );
  end;


  TBulkWriteThread = class(TBulkTransferThread)
  protected
    procedure CallbackFktWrite(ErrorCode : Longint; 
                 NumberOfBytesTransfered : Longint);
    procedure Execute; override;
  end;

...
...

Bei der Implementierung erzeuge ich mir ein Event. Mit Hilfe von WaitForSingleObject und diesem Event möchte ich das Warten realisieren:

Delphi-Quellcode:

implementation

uses
   SysUtils;

constructor TBulkTransferThread.create( ...
                   ... );
begin
    ...
    ...
    inherited create(False);
end;



procedure TBulkWriteThread.Execute();
var
  bRet            : BOOL;
  Ret             : Integer;

begin

  WriteFinished := TEvent.Create(nil,true,false,'myEvent');

  WriteFinished.ResetEvent;

  // Header versenden
  bRet := USBWriteAsync(...
         ...
                        @TBulkWriteThread.CallbackFktWrite);

  Ret := WaitForSingleObject(Self.WriteFinished.Handle, TIMEOUT_VALUE);

  if Ret = WAIT_OBJECT_0 then
    Ret := USB_OK
  else
    Ret := USB_SEND_COMMAND_ERROR;

  WriteFinished.ResetEvent;

  if (Ret = USB_OK) and (USBcb.nDATA > 0) then
  // Daten versenden
    bRet := USBWriteAsync(...
                ...
                          @TBulkWriteThread.CallbackFktWrite);

  if (Ret = USB_OK) and (USBcb.nDATA > 0) then
    Ret := WaitForSingleObject(Self.WriteFinished.Handle, TIMEOUT_VALUE);

  WriteFinished.Destroy;

  if Ret = WAIT_OBJECT_0 then     
    Integer(Status^) := USB_OK
  else
    Integer(Status^) := USB_SEND_COMMAND_ERROR;
end;

In der Callback-Funktion der Senderoutine, welche ausgeführt wird sobald die Daten versendet wurden, wird das Event gesetzt:

Delphi-Quellcode:

Procedure TBulkWriteThread.CallbackFktWrite(ErrorCode : Longint; NumberOfBytesTransfered : Longint);
begin
  if ErrorCode <> 0 then
  begin
    ErrorCode := GetLastError();
    MessageDlg('Error#: ' + IntToStr(ErrorCode), mtError, [mbOk], 0);
  end;

  SetEvent(Self.WriteFinished.Handle);      // <-- Hier access violation!!


end;

Soweit, so gut. Der Header wird versendet, kommt beim Gerät an und die Callback-Funktion wird aufgerufen.
Allerdings tritt bei SetEvent eine access violation auf:

'In Porjekt ... trat ein Problem mit folgender Meldung auf: 'access violation at 0x0046b567: read of address 0x00000060'. Prozess angehalten'


Ich bekomme nicht heraus, was ich falsch gemacht habe. Wer kann mir da helfen?

Vielen Dank

[Apollonius]

Zeige mal die Deklaration von USBWriteAsync. Ich vermute stark, dass hier ein Funktions- und kein Methodenzeiger erwartet wird (wobei du mit @TBulkWriteThread.CallbackFktWrite auch keinen "echten", gebundenen, Methodenzeiger übergibst). Außerdem solltest du die Aufrufkonvention prüfen.

[Viktorii]

Zitat:

Zitat von Apollonius

Zeige mal die Deklaration von USBWriteAsync. Ich vermute stark, dass hier ein Funktions- und kein Methodenzeiger erwartet wird

Die bekomme ich von einer dll....

Delphi-Quellcode:

// callback function used as parameter with UsbTransferAsync 
TTRANSFER_COMPLETION_ROUTINE = procedure (ErrorCode : Longint;
                                          NumberOfBytesTransfered : Longint); stdcall;


function UsbWriteAsync(hPipe                    : USB_PIPE_HANDLE;
                       const Buffer             : LPVOID;
                       nNumberOfBytesToTransfer : DWORD;
                       CompletionRoutine        : TTRANSFER_COMPLETION_ROUTINE) : BOOL; stdcall;

Macht es einen Unterschied ob die Funktion zur Klasse gehört (das ist doch mit Methode gemeint, oder?) oder ob es eine normale Funktion ist? Die 'Event Variable' habe ich auch in der Klasse als Privates Feld... Ist das in Ordung?

Zitat:

Zitat von Apollonius

(wobei du mit @TBulkWriteThread.CallbackFktWrite auch keinen "echten", gebundenen, Methodenzeiger übergibst). Außerdem solltest du die Aufrufkonvention prüfen.

Kannst du das evtl. etwas genauer Erläutern? Was heißt "echter", gebundener, Methodenzeiger und was bedeutet ich soll die Aufrufkonvention prüfen?
Vielen Dank

[Apollonius]

Zitat:

Macht es einen Unterschied ob die Funktion zur Klasse gehört (das ist doch mit Methode gemeint, oder?) oder ob es eine normale Funktion ist?

Ja, das ändert alles! Du darfst Funktions- und Methodenzeiger nicht so einfach vermischen. Es gibt aber Konvertierungsfunktionen, z.B. hat Luckie einen Thread aus der DP und einen Tipp aus swissdelphicenter in einen Artikel gegossen.
Mit Aufrufkonvention ist stdcall gemeint, das musst du auch hinter deine Methode schreiben! Sonst geht auch die Umwandlung nicht.

[Viktorii]

Vielen Dank für den Link. Das war schon mal sehr aufschlussreich.
Okay, wo das Problem liegt habe ich nun verstanden. Auch den Lösungsansatz habe ich größtenteils verstanden, denke ich. Hab es zwar (noch) nicht komplett im Detail nachvollziehen können, aber ich dachte mir ich probiert es einmal. Und da hat sich gezeigt, dass ich es wohl doch nicht so ganz verstanden habe...

Also, es sieht jetzt folgendermaßen aus:

Delphi-Quellcode:

type
  TBulkTransferThread = class(TThread)
  private
    ...
    ...
    WriteFinishedEvent      : TEvent;
    FEnumProcInst           : Pointer;
    function MakeProcInstance(M: TMethod): Pointer;
    procedure CallbackFktWrite(ErrorCode : Longint; NumberOfBytesTransfered : Longint); stdcall;
  protected

  public
    constructor create(...
                       ...);
  end;


  TBulkWriteThread = class(TBulkTransferThread)
  protected
    procedure Execute; override;
  end;
  
  ...
  ...

Die Funktion MakeProcInstance habe ich einfach mal so übernommen:

Delphi-Quellcode:

function TBulkTransferThread.MakeProcInstance(M: TMethod): Pointer;
begin
  // Ausführbaren Speicher alloziieren fü 15 Byte an Code
  Result := VirtualAlloc(nil, 15, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  asm
    // MOV ECX,
    MOV BYTE PTR [EAX], $B9
    MOV ECX, M.Data
    MOV DWORD PTR [EAX+$1], ECX
    // POP EDX (bisherige Rücksprungadresse nach edx)
    MOV BYTE PTR [EAX+$5], $5A
    // PUSH ECX (self als Parameter 0 anfügen)
    MOV BYTE PTR [EAX+$6], $51
    // PUSH EDX (Rücksprungadresse zurück auf den Stack)
    MOV BYTE PTR [EAX+$7], $52
    // MOV ECX, (Adresse nach ecx laden)
    MOV BYTE PTR [EAX+$8], $B9
    MOV ECX, M.Code
    MOV DWORD PTR [EAX+$9], ECX
    // JMP ECX (Sprung an den ersten abgelegten Befehl und Methode aufrufen)
    MOV BYTE PTR [EAX+$D], $FF
    MOV BYTE PTR [EAX+$E], $E1
    // hier kein Call, ansonsten würde noch eine Rücksprungadresse auf den Stack gelegt
  end;
end;

Hier 'füge' ich nun den Self Parameter 'an':

Delphi-Quellcode:

procedure TBulkWriteThread.Execute();
var
  bRet                    : BOOL;
  Ret                     : Integer;
  Method                  : TMethod;

begin
  WriteFinishedEvent := TEvent.Create(nil,true,false,'WriteEvent');

  WriteFinishedEvent.ResetEvent;

  Method.Code := @TBulkTransferThread.CallbackFktWrite;
  Method.Data := Self;
  FEnumProcInst := MakeProcInstance(Method);


  bRet := USBWriteAsync(PipeHandle,
                        @USBcb,
                        HEADERSIZE,
                        FEnumProcInst);
//                        @CallbackFktWrite);

  Ret := WaitForSingleObject(WriteFinishedEvent.Handle, TIMEOUT_VALUE);

  ...
  ...

Wenn ich den Self Parameter nun hier zur Verfügung habe, wie komme ich dann an ihn ran?

Delphi-Quellcode:

Procedure CallbackFktWrite(ErrorCode : Longint; NumberOfBytesTransfered : Longint); stdcall;
begin
  if ErrorCode <> 0 then
  begin
    ErrorCode := GetLastError();
    MessageDlg('Error#: ' + IntToStr(ErrorCode), mtError, [mbOk], 0);
  end;

  SetEvent({??????}WriteFinishedEvent.Handle{??????});
end;

Vielleicht bringt der nächste Hinweis ja Licht in mein Dunkel.

Vielen Dank nochmals.

[Apollonius]

In der Implementation steht doch hoffentlich

Delphi-Quellcode:

procedure TBulkTransferThread.CallbackFktWrite(ErrorCode : Longint; NumberOfBytesTransfered : Longint); stdcall;

? Wenn ja, kannst du implizit auf Self zugreifen (also ohne irgendetwas vor dem Namen des Feldes) oder eben mit Self.Feldname.

[sirius]

Warum benutzt den du beim setzen des Events plötzlich die WinAPI direkt und nicht wie bisher die Methoden des Objektes?
==>TEvent.setEvent ==> WriteFinishedEvent.SetEvent

[Viktorii]

Okay, funktioniert mittlerweile sehr gut. Nur eine Sache wäre da noch: Wenn ich die Funktion VirtualAlloc aufgerufen habe, muss ich den Speicher ja auch wieder freigeben. Dazu habe ich mir eine CleanUp-Procedure welche ich bei OnTerminate meines Threads ausführe:

Delphi-Quellcode:

procedure TBulkCommandThread.CleanUp(Sender: TObject);
var
  bRet        : Boolean;
begin
  bRet := VirtualFree(FEnumProcInst, 15, MEM_DECOMMIT);
  ...
end;

Nur leider erhalte ich eine access violation:

Delphi-Quellcode:

---------------------------
Benachrichtigung über Debugger-Problem
---------------------------
In Projekt ... trat ein Problem mit folgender Meldung auf: 'access violation at 0x01750000: read of address 0x01750000'. Prozess angehalten. Mit Einzelne Anweisung oder Start fortsetzen.
---------------------------
OK   
---------------------------

An welcher Stelle kann ich den Speicher am besten wieder freigeben, ohne dass ich eine access violation erhalte?
Vielen Dank

[Viktorii]

Hat jemand vielleicht eine Idee?
Vielen Dank

[Viktorii]

Kann mir da keiner was zu sagen?