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.