procedure ButtonAbbruchClick(Sender: TObject);
procedure ButtonEXITClick(Sender: TObject);
procedure ButtonStartClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ButtonWeiterClick(Sender: TObject);
private
{ Private-Deklarationen }
CriticalSection : TCriticalSection;
UrlList : TStringList;
ErgebnisListe : TStringList;
ActiveThreads : Int64;
IdleJobs : Int64;
JobsFinished : Int64;
procedure UpdateLabelActiveThreads;
procedure UpdateLabelJobs;
procedure UpdateLabelFinished;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
ShouldStop: Boolean = False;
implementation
{$R *.dfm}
type
TURLCheckerThread =
class(TThread)
private
FUrlList : TStrings;
FResultList : TStrings;
FCriticalSection : TCriticalSection;
FOnStatus : TProc<
string>;
FShouldStop : PBoolean;
protected
procedure Execute;
override;
procedure UpdateStatus(
const Msg:
string);
public
constructor Create(UrlList: TStrings; CriticalSection: TCriticalSection; OnStatus: TProc<
string>; ShouldStop: PBoolean; ResultList: TStrings);
end;
{ TWorkerThread }
constructor TURLCheckerThread.Create(UrlList: TStrings; CriticalSection: TCriticalSection; OnStatus: TProc<
string>; ShouldStop: PBoolean; ResultList: TStrings);
begin
inherited Create(False);
FUrlList := UrlList;
FResultList := ResultList;
FCriticalSection := CriticalSection;
FOnStatus := OnStatus;
FShouldStop := ShouldStop;
FreeOnTerminate := True;
end;
procedure TURLCheckerThread.UpdateStatus(
const Msg:
string);
begin
if Assigned(FOnStatus)
then
TThread.Synchronize(
nil,
procedure begin FOnStatus(Msg);
end);
end;
procedure TURLCheckerThread.Execute;
var
Url :
string;
Http : TIdHTTP;
begin
Http := TIdHTTP.Create(
nil);
try
while not Terminated
and not FShouldStop^
do
begin
Url := '
';
FCriticalSection.Acquire;
try
if FUrlList.Count > 0
then
begin
Url := FUrlList[0];
FUrlList.Delete(0);
end;
finally
FCriticalSection.Release;
end;
if Url = '
'
then Break;
try
Sleep(Random(2000));
{Hier kommt später meine Aufgabe}
// Http.Head(Url);
FCriticalSection.Acquire;
{Keine Ahnung ob es richtig ist, habe aber rausgelesen dass man StringList auf jeden Fall mit CriticalSection absichern soll}
try
FResultList.Add('
OK: ' +
Url);
{Ergebnis in StringList eintragen}
FResultList.Add('
Zweite Zeile');
{Ergebnis in StringList eintragen}
FResultList.Add('
Dritte Zeile');
{Ergebnis in StringList eintragen}
finally
FCriticalSection.Release;
end;
// UpdateStatus('OK: ' + Url); {Damit kann ich zB. die Status ON oder OFF ausgeben, oder weglassen und NUR FResult als Ergebnis nutzen}
except
on E:
Exception do UpdateStatus('
FAIL: ' +
Url + '
- ' + E.
Message);
end;
TThread.Synchronize(
nil,
procedure
begin
Dec(Form1.IdleJobs);
Form1.UpdateLabelJobs;
Inc(Form1.JobsFinished);
Form1.UpdateLabelFinished;
end);
end;
finally
Http.Free;
TThread.Synchronize(
nil,
procedure
begin
Dec(Form1.ActiveThreads);
Form1.UpdateLabelActiveThreads;
end);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(CriticalSection);
FreeAndNil(ErgebnisListe);
FreeAndNil(UrlList);
end;
procedure TForm1.ButtonStartClick(Sender: TObject);
var
Threads :
array[0..99]
of TURLCheckerThread;
Index : Integer;
begin
if Assigned(CriticalSection)
then FreeAndNil(CriticalSection);
{Falls ich nach Cancel noch mal Start drücke statt Weiter}
if Assigned(UrlList)
then FreeAndNil(UrlList);
{Falls ich nach Cancel noch mal Start drücke statt Weiter}
UrlList := TStringList.Create;
CriticalSection := TCriticalSection.Create;
ShouldStop := False;
for Index := 1
to 100
do
begin
URLList.Add('
http://google.com/' + IntToStr(
Index));
end;
LabelJobs.Caption := '
100';
LabelIdle.Caption := '
100';
IdleJobs := 100;
JobsFinished := 0;
ErgebnisListe := TStringList.Create;
for Index := 1
to SpinEditThreads.Value
do
begin
Threads[
Index] := TURLCheckerThread.Create(UrlList, CriticalSection,
procedure(Msg:
string)
begin
RichEditLog.Lines.Add(Msg);
{Ergebnis als String}
RichEditLog.Lines.Add(ErgebnisListe.Text);
{Ergebnis als StringList}
ErgebnisListe.Clear;
{Nicht vergessen, sonst wird die StringList immer weiter befüllt}
end, @ShouldStop, ErgebnisListe);
{Zähle aktive Threads}
Inc(ActiveThreads);
LabelActiveThreads.Caption := IntToStr(ActiveThreads);
end;
end;
procedure TForm1.ButtonWeiterClick(Sender: TObject);
var
Threads :
array[0..99]
of TURLCheckerThread;
Index : Integer;
begin
ShouldStop := False;
for Index := 1
to SpinEditThreads.Value
do
begin
Threads[
Index] := TURLCheckerThread.Create(UrlList, CriticalSection,
procedure(Msg:
string)
begin
RichEditLog.Lines.Add(Msg);
{Ergebnis als String}
RichEditLog.Lines.Add(ErgebnisListe.Text);
{Ergebnis als StringList}
ErgebnisListe.Clear;
{Nicht vergessen, sonst wird die StringList immer weiter befüllt}
end, @ShouldStop, ErgebnisListe);
{Zähle aktive Threads}
Inc(ActiveThreads);
LabelActiveThreads.Caption := IntToStr(ActiveThreads);
end;
end;
procedure TForm1.ButtonAbbruchClick(Sender: TObject);
begin
ShouldStop := True;
end;
procedure TForm1.UpdateLabelActiveThreads;
begin
LabelActiveThreads.Caption := IntToStr(ActiveThreads);
{Das war eigentlich nur ein Versehen mit Synchronize. Es war schon spät und viel Stoff für einen Abend :)}
end;
procedure TForm1.UpdateLabelJobs;
begin
LabelIdle.Caption := IntToStr(IdleJobs);
end;
procedure TForm1.UpdateLabelFinished;
begin
LabelFinished.Caption := IntToStr(JobsFinished);
end;
procedure TForm1.ButtonEXITClick(Sender: TObject);
begin
ShouldStop := True;
Close;
end;