Thread Safe Programming

[aps]

Hallo,
wie kann man eine Klasse Thread-Safe programmieren? Ich stehe da völlig auf dem Schlauch, immer wieder gibt es bei mir threadbedingte Fehlermeldungen :-(

[stoxx]

Code ?

[aps]

Hm, eine allgemeine Lösung scheint es nicht zu geben. Vielleicht kann mir jemand auf diesen speziellen Code helfen:

Delphi-Quellcode:

unit online;

interface

uses
  Classes, data, TBXStatusBars, VirtualTrees;

type
  POnlineThread = ^TOnlineThread;
  TOnlineThread = class(TThread)
  private
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    URL: PURL;
    Tree: TVirtualDrawTree;
    selbst: POnlineThread;
    next: POnlineThread;
    prev: POnlineThread;
    constructor Create(CreateSuspended:boolean);
  end;

  TControlThread = class(TThread)
  private
    { Private-Deklarationen }
    ThreadCount   : integer;
    OnlineThreads : POnlineThread;
    aktuell       : PURL;
    procedure SetStatusbar;
    procedure OnlineThreadStopped(Sender: TObject);
  protected
    procedure Execute; override;
  public
    FirstURL: PURL;
    Tree: TVirtualDrawTree;
    StatusBar: TTBXStatusBar;
    constructor Create(CreateSuspended:boolean);
  end;

implementation

uses
  constants, SysUtils;

constructor TOnlineThread.Create(CreateSuspended:Boolean);
begin
  inherited Create(CreateSuspended);
  next := nil;
  prev := nil;
  selbst := nil;
  Tree := nil;
  URL := nil;
end;

procedure TOnlineThread.Execute;
begin
  URL^.getStatus;                // Status der URL abfragen
  Synchronize(Tree.Repaint);     // Übersichtsbaum aktualisieren
end;


constructor TControlThread.Create(CreateSuspended:boolean);
begin
  inherited Create(CreateSuspended);
  FirstURL := nil;
  Tree := nil;
  StatusBar := nil;
  OnlineThreads := nil;
  ThreadCount := 0;
end;

procedure TControlThread.SetStatusbar;
begin
  StatusBar.Panels[0].Caption := Format(TXT_ACTIVETHREADS,[ThreadCount])
end;

procedure TControlThread.OnlineThreadStopped(Sender: TObject);
// Thread aus Kette löschen, anschließend Speicher freigeben
// und Anzeige in der Statuszeile aktualisieren
var
  th: POnlineThread;
begin
  th := (Sender as TOnlineThread).selbst;
  if OnlineThreads=th then
    begin
      OnlineThreads := th^.next;
      if th^.next<>nil then th^.next^.prev := nil;
    end
  else
    begin
      if th^.next<>nil then th^.next^.prev := th^.prev;
      if th^.prev<>nil then th^.prev^.next := th^.next;
    end;
  {end if};
  th^.Free;
  Dispose(th);
  Dec(ThreadCount);
//  Synchronize(SetStatusbar);              // Funktioniert nicht. Warum ???
  if (aktuell=nil) and (ThreadCount<=0) then
    Terminate    // ControlThread beenden, wenn keine weitere Adresse mehr vorliegt
  {end if};
end;

procedure TControlThread.Execute;
var
  newthread,th : POnlineThread;
begin
  aktuell := FirstURL;
  while (not Terminated) do
    begin
      while (aktuell<>nil) and (not Terminated) do
        begin
          if ThreadCount>=MAXIMUM_THREADS then
            Sleep100     // 100 ms warten, wenn die max. Anzahl an Online-Threads erreicht
          else
            begin
              new(newthread);
              newthread^ := TOnlineThread.Create(true);
              newthread^.selbst := newthread;  //Zeiger auf sich selbst speichern
              newthread^.OnTerminate := OnlineThreadStopped;

              if OnlineThreads=nil then
                OnlineThreads := newthread
              else
                begin                   // Thread hinten an die Liste hängen
                  th := OnlineThreads;
                  while th^.next<>nil do
                    th := th^.next
                  {end while};
                  th^.next := newthread;
                  newthread^.prev := th; // und bisherigen letzten als Vorgänger markieren
                end
              {end if};

              newthread^.Tree := Tree;
              newthread^.URL := aktuell;
              Inc(ThreadCount);
//              Synchronize(SetStatusbar);  // Funktioniert nicht. Warum ????
              aktuell := aktuell^.next;
              newthread^.Resume;
            end
          {end if};
        end
      {end while};
      if aktuell=nil then
        Sleep(100)   // 100 ms warten bis zum nächsten nachschauen, ob Thread beendet werden darf
      {end if};
    end
  {end while};
end;

end.

PURL ist dabei ein Zeiger auf eine Klasse TURL. Vielleicht sehe ich ja auch nur den Wald vor Bäumen nicht, und das Ganze kann vereinfacht werden?!

Zusammenfassung, was das Programm macht:
Nach Aufruf eines Menüpunktes wird der "ControlThread" gestartet, der nichts anderes zu tun hat, als die OnlineThreads zu überwachen, welche wiederum eine in TURL vorhandene Routine (PURL^.GetStatus) aufrufen. Diese stellt eine Online-Verbindung zu einem Zielrechner her, und fragt dort Daten ab.

[stoxx]

ohr nee ! .. jetzt hab ich ne etwas längere Antwort verfasst, und nun ist mein geschriebenes weg, weil ich bei der Vorschau den zurück Button des Browsers benutzt habe. Sch ...

Hab jetzt aber keine Lust, das nochmal zu schreiben.

ich machs jetzt kurz.

Das hier ist erstmal Mißt, da TOnlineThread schon ein Zeiger ist !!
new() ist doppelt gemoppelt. new(); weglassen.

Code:

type 
  POnlineThread = ^TOnlineThread; 
  TOnlineThread = class(TThread)

und dann

Code:

th.next := newthread;

ändern auf

Code:

TOnlineThread = class(TThread) 
  private 
    { Private-Deklarationen } 
  protected 
    procedure Execute; override; 
  public 
    URL: PURL; 
    Tree: TVirtualDrawTree; 
    selbst: TOnlineThread; 
    next: TOnlineThread; 
    prev: TOnlineThread; 
    constructor Create(CreateSuspended:boolean); 
  end;

die Variable Statusbar ändern auf FSTatusbar. der Syncrhonize Gedanke war richtig.

Aber noch viel besser wäre, ein Event schicken !!, anstatt die Statusbar selber zu ändern im Thread ! Was ist, wenn Du die Komnponente nochmal brauchst, und es dort keine Statusbar gibt ?
Der Thread schickt ein Event an ein Form, und das Form aktualisiert sich selber !

Wenn Du es aber dennoch so haben willst, dann hier besserer Code

Code:

procedure TControlThread.SetStatusbar; 
begin 
  StatusBar.Panels[0].Caption := Format(TXT_ACTIVETHREADS,[ThreadCount]) 
end;

nach

Code:

procedure TControlThread.RefreschStatusbar; 
begin 
  if assigned(FStatusbar) 
    then FStatusBar.Panels[0].Caption := Format(TXT_ACTIVETHREADS,[ThreadCount]) 
end;

und dann

Code:

 private
    proceudre SetStatusbar(value : TStatusbar);
 public
    property Statusbar : TStatusbar write SetStatusbar;

....

procedre TControlThread.SetStatusbar(value : Tstatusbar);
begin
  FStatusbar := Value;
end;