Hallo DP!

Ich weiß das Thema wurde nun nicht gerade zum ersten Mal durchgekaut - und ich war so frei und habe so ziemlich alle möglichen Tutorials und Beispiele angeschaut, aber ich schaffe es selbst nicht mein Problem zu lösen. Eins vorweg: Den Thread zu erstellen, laufen zu lassen und ihn dazu zu bekommen für mich ein paar lustige Sachen zu machen ist primär kein Problem, lediglich das beenden des jeweiligen lässt mich hier verzweifeln. Ich poste dazu mal den gesamten Code des besagten TThreads:

Die Deklaration:

zusammenfalten · markieren

Delphi-Quellcode:

TComThread = class(TThread)
  private
    { Private-Deklarationen }
    FStop: Boolean;
    FCurrentTry: Integer;
    FMaxTry: Integer;
    FTimeOut: Integer;
    FHandle: THandle;
    FDebugMode: Boolean;
  public
    procedure ResetTry();
  protected
    constructor Create( CreateSuspended: Boolean;
                        TimeOut: Integer;
                        MaxTry: Integer;
                        MainFormHandle: THandle;
                        DebugMode: Boolean = FALSE );
    procedure Execute(); override;
    procedure Reset();
    procedure Beep( Short: Boolean = FALSE );
  published
    property Stop: Boolean read FStop write FStop;
    property CurrentTry: Integer read FCurrentTry write FCurrentTry;
    property MaxTry: Integer read FMaxTry write FMaxTry;
    property TimeOut: Integer read FTimeOut write FTimeOut;
    property Handle: THandle read FHandle write FHandle;
    property DebugMode: Boolean read FDebugMode write FDebugMode;
  end;

Der eigentliche Quellcode:

zusammenfalten · markieren

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
// TComThread //
////////////////////////////////////////////////////////////////////////////////

constructor TComThread.Create( CreateSuspended: Boolean;
                               TimeOut: Integer;
                               MaxTry: Integer;
                               MainFormHandle: THandle;
                               DebugMode: Boolean = FALSE );
begin
  inherited Create( CreateSuspended );

  self.FreeOnTerminate := TRUE;
  self.FHandle := MainFormHandle;
  self.FMaxTry := MaxTry;
  self.FTimeOut := TimeOut; // seconds

  self.FStop := FALSE;
  self.FCurrentTry := 0;

  self.FDebugMode := DebugMode;
end;


procedure TComThread.ResetTry();
begin
  self.FCurrentTry := 0;
end;

procedure TComThread.Beep( Short: Boolean = FALSE );
begin
  if ( Short ) then
    windows.beep( 1500, 200 )
  else
  begin
    windows.beep( 4000, 30 );
    windows.beep( 3000, 30 );
    windows.beep( 2000, 30 );
    windows.beep( 5000, 30 );
    windows.beep( 4000, 30 );
  end;
end;


procedure TComThread.Execute();
var
  i: Integer;
begin
  if ( self.FDebugMode ) then
    self.Beep( TRUE );

  while ( ( not self.FStop ) AND
          ( self.FMaxTry > self.FCurrentTry ) AND
          ( not Terminated ) ) do
  begin
    for i:=0 to 100 do
      if ( not Terminated ) then
        Sleep( self.FTimeOut * 10 )
      else
        break;

    if ( not Terminated ) then
    begin
      if ( self.FDebugMode ) then
        self.Beep();

      self.FCurrentTry := self.FCurrentTry + 1;

      if ( self.FDebugMode ) then
        SendMessage( Handle, MTM_MESSAGE, 0,
                     Integer( PChar( 'PASS ' + IntToStr( self.FCurrentTry ) +
                     ' OF ' + IntToStr( self.FMaxTry ) ) ) );
    end;
  end;

  self.FStop := TRUE;

  if ( Terminated ) then
    SendMessage( Handle, MTM_ABORTED, 0, Integer( PChar( 'TERMINATED' ) ) )
  else
    SendMessage( Handle, MTM_TIMEOUT, 0, Integer( PChar( 'TIMEOUT' ) ) );

  self.Free();
end;


procedure TComThread.Reset();
begin
  self.FStop := FALSE;
  self.ResetTry();
end;

Primär dient der Thread eigentlich nur zum Zählen von Durchgängen (evtl. begleitet von lustigen Piepsern aus dem PC Speaker). Er wird von einer Klasse referenziert, die eine serielle Kommunikation veranlasst und benötigt diesen Thread um Timeouts zu zählen, bzw. überhaupt erst von solchen zu erfahren. Im Ablauf wird der Thread mehrfach "suspended" und wieder gestartet und am Ende der Kommunikation per "Terminate" beendet, sofern nötig, d.h. wenn der Thread auf "Suspended" geschaltet wurde. Im Grunde alles kein Problem, leider bekomme ich regelmässig von "FastMM" mitgeteilt, dass das Thread-Objekt(e) sich och im Speicher befindet und nicht freigegeben wird, obwohl ich dies ja eigentlich explizit via "FreeOnTerminate" mitteile.

Ich verstehe die (Thread) Welt nicht mehr...!
Vielen Dank für jede Hilfe.

Christian

EDIT: Ich sollte dazu sagen, dass der besagte Code unter Delphi 5 Enterprise gecoded und compiliert wird / wurde.

Hallo,

wieso ruftst Du Free auf, wenn Du FreeOnTerminate auf True hast ?

Gruß
xaromz

Guter Einwand! Ich hatte es erst ohne das .Free am Ende probiert, habe da aber einige Exceptions zurückgeworfen bekommen, von deren Quelle ich nicht ganz überzeugt war. Zwischenzeitlich habe ich es auch mit einem "self := nil" versucht, aber das hatte zur Folge, dass ich eine Meldung (+ nachträglicher Exception) bekam: "Zuwenig Arbeitsspeicher"...

Ich denke aber der Hauptgrund war, dass meine Thread Objekte nicht freigegeben wurden und ich mir dachte: Bist Du nicht willig, so brauch ich Gewalt. Ohne wirklichen Erfolg.

Wie erzeugst du den Thread?

Ich erzeuge den Thread in einer seperaten Klasse für eine serielle Kommunikation, der Aufruf innerhalb dieser Klasse sieht aus wie folgt:

markieren

Delphi-Quellcode:

  self.Thread := TComThread.Create( TRUE, TimeOut, MaxTry, Handle, DebugMode );
self.Thread.Resume();

Übergeben werden TIMEOUT (Sekunden), MAXTRY (eine maximale Anzahl von Threaddurchläufen, wenn man so will), HANDLE (der Handle des Hauptfensters (evtl. mit Logging) - dieses sorgt auch dafür, dass der Thread sich beendet) und DEBUGMODE (erweitertes Piepen).

Funktion (WNDPROC) des Hauptfensters:
procedure WndProc( var Msg: TMessage ); override;

zusammenfalten · markieren

Delphi-Quellcode:

procedure TFSerial.WndProc( var msg: TMessage );
begin
  inherited;

  case msg.Msg of
    MTM_TIMEOUT:
      begin
        if ( com.DebugMode ) then
          AddLog( 'ERR -- COMMUNICATION TIMEOUT.', log_info, log );

        com.Stop := TRUE;
        AddSerialLog( 'ERR -- COMMUNICATION TIMEOUT.' );
        ShowWarning( _( 'Es konnte keine Verbindung hergestellt ' +
          'werden! (TIMEOUT)' ) );
      end;

    MTM_ABORTED:
      begin
        if ( com.DebugMode ) then
          AddLog( 'MSG -- THREAD TERMINATED.', log_info, log );

        com.Stop := TRUE;
        AddSerialLog( 'MSG -- THREAD TERMINATED.' );
      end;

    MTM_MESSAGE:
      begin
        if ( com.DebugMode ) then
          AddLog( 'MSG -- THREAD SAYS: ' + string( msg.lParam ), log_info, log );

        AddSerialLog( 'MSG -- THREAD SAYS: ' + string( msg.lParam ) );
      end;
  end;
end;

"com" ist hier die Klasse, die den Thread benötigt um einen Timeout festzustellen.

Push... Das Thema ist mir sehr wichtig. Ich würde mich weiterhin sehr über eine Antwort freuen...

Du möchtest die TFSerial Komponente überachen damit sie nach einem Timeout beendet wird, richtig ?
Dann rate ich dir eine andere COM Port Komponente zu benutzen. Denn du versuchst nun umständlich eine Funktionalität mit Tricksereien zu bauen die eigentlich schon im API des COM Port enthalten ist. Dh. es wäre die Aufgabe von TFSerial per asynchronem IO auf die Schnittstelle zuzugreifen und bei diesen APIs den Timeout Wert entsprechend deinen Enstellungen zu benutzen.


Gruß Hagen