procedure ButtonStartClick(Sender: TObject);
procedure ButtonAbbruchClick(Sender: TObject);
procedure ButtonWeiterClick(Sender: TObject);
procedure ButtonEXITClick(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;
FCriticalSection : TCriticalSection;
FOnStatus : TProc<TstringList>;
FShouldStop : PBoolean;
protected
procedure Execute;
override;
procedure UpdateStatus(
const Msg: TstringList);
public
constructor Create(UrlList: TStrings; CriticalSection: TCriticalSection; OnStatus: TProc<TstringList>; ShouldStop: PBoolean);
end;
{ TWorkerThread }
constructor TURLCheckerThread.Create(UrlList: TStrings; CriticalSection: TCriticalSection; OnStatus: TProc<TstringList>; ShouldStop: PBoolean);
begin
inherited Create(False);
FUrlList := UrlList;
FCriticalSection := CriticalSection;
FOnStatus := OnStatus;
FShouldStop := ShouldStop;
FreeOnTerminate := True;
end;
procedure TURLCheckerThread.UpdateStatus(
const Msg: TstringList);
begin
if Assigned(FOnStatus)
then
TThread.Synchronize(TThread.Current,
procedure begin FOnStatus(Msg);
end);
end;
procedure TURLCheckerThread.Execute;
var
FResultList : TstringList;
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;
Sleep(Random(2000));
{Hier kommt später meine Aufgabe}
FResultList := TStringList.Create;
//--> Hier geändert Pro Job wird eine Liste erstellt und zerstört
try
try
// 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(FResultList);
except
on E:
Exception do
begin
FResultList.Add('
FAIL: ' +
Url + '
- ' + E.
Message);
UpdateStatus(FResultList);
end;
end;
finally
FreeAndNil(FResultList);
//--> Hier geändert Pro Job wird eine Liste erstellt und zerstört
end;
TThread.Synchronize(
nil,
procedure
begin
Dec(Form1.IdleJobs);
Form1.UpdateLabelJobs;
Inc(Form1.JobsFinished);
Form1.UpdateLabelFinished;
end);
end;
finally
FreeAndNil(FResultList);
FreeAndNil(Http);
TThread.Synchronize(
nil,
procedure
begin
Dec(Form1.ActiveThreads);
Form1.UpdateLabelActiveThreads;
end);
end;
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;
for Index := 1
to SpinEditThreads.Value
do
begin
Threads[
Index] := TURLCheckerThread.Create(UrlList, CriticalSection,
procedure(Msg: TstringList)
var
ErgebnisListe : TStringList;
begin
RichEditLog.Lines.Add(Msg.Text);
{Ergebnis als StringList}
end, @ShouldStop);
{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: TstringList)
begin
RichEditLog.Lines.Add(Msg.Text);
{Ergebnis als StringList}
end, @ShouldStop);
{Zähle aktive Threads}
Inc(ActiveThreads);
LabelActiveThreads.Caption := IntToStr(ActiveThreads);
end;
end;
procedure TForm1.ButtonAbbruchClick(Sender: TObject);
begin
ShouldStop := True;
end;
procedure TForm1.ButtonEXITClick(Sender: TObject);
begin
ShouldStop := True;
Close;
end;
procedure TForm1.UpdateLabelActiveThreads;
begin
LabelActiveThreads.Caption := IntToStr(ActiveThreads);
end;
procedure TForm1.UpdateLabelJobs;
begin
LabelIdle.Caption := IntToStr(IdleJobs);
end;
procedure TForm1.UpdateLabelFinished;
begin
LabelFinished.Caption := IntToStr(JobsFinished);
end;