procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
    procedure FormDestroy(Sender: TObject);

    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonAbbruchClick(Sender: TObject);
    procedure ButtonWeiterClick(Sender: TObject);
    procedure ButtonEXITClick(Sender: TObject);
  private
    { Private-Deklarationen }
    CSection1 : TCriticalSection;
    CSection2 : TCriticalSection;
    UrlList : TStringList;
    ErgebnisListe : TStringList;
    ActiveThreads : Int64;
    IdleJobs : Int64;
    JobsFinished : Int64;
    procedure UpdateLabelActiveThreads(Sender: TObject);
    procedure UpdateLabelJobs(Sender: TObject);
    procedure UpdateLabelFinished(Sender: TObject);

  public
    { Public-Deklarationen }
  end;

var
  Form1 : TForm1;
  ShouldStop : Boolean = False;

implementation

{$R *.dfm}

type
  TURLCheckerThread = class(TThread)
  private
    FUpdateAktiv : TNotifyEvent;
    FUpdateJobs : TNotifyEvent;
    FUpdateFertig : TNotifyEvent;
    FUrlList : TStrings;
    FCSection1 : TCriticalSection;
    FCSection2 : TCriticalSection;
    FOnStatus : TProc<TstringList>;
    FShouldStop : PBoolean;
    FTimeOut : Word;
  protected
    procedure Execute; override;
    procedure UpdateStatus(const Msg: TstringList);
  public
    constructor Create(UrlList: TStrings; CSection1, CSection2: TCriticalSection; OnStatus: TProc<TstringList>; ShouldStop: PBoolean; OnUpdateActive, OnUpdateJobs, OnUpdateFertig: TNotifyEvent; Timeout: Word);
  end;

{ TWorkerThread }
constructor TURLCheckerThread.Create(UrlList: TStrings; CSection1, CSection2: TCriticalSection; OnStatus: TProc<TstringList>; ShouldStop: PBoolean; OnUpdateActive, OnUpdateJobs, OnUpdateFertig: TNotifyEvent; Timeout: Word);
begin
  inherited Create(False);
  FUrlList := UrlList;
  FCSection1 := CSection1;
  FCSection2 := CSection2;
  FOnStatus := OnStatus;
  FShouldStop := ShouldStop;
  FreeOnTerminate := True;
  FTimeOut := Timeout;
  FUpdateAktiv := OnUpdateActive;
  FUpdateJobs := OnUpdateJobs;
  FUpdateFertig := OnUpdateFertig;
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
  FErgebnis : TstringList;
  Url : string;
  Http : TIdHTTP;
begin
  Http := TIdHTTP.Create(nil);
  Http.ConnectTimeout := FTimeOut;
  Http.ReadTimeout := FTimeOut;
    try
      while not Terminated and not FShouldStop^ do
        begin
          Url := '';

          FCSection1.Acquire;
            try
              if FUrlList.Count > 0 then
                begin
                  Url := FUrlList[0];
                  FUrlList.Delete(0);
                end;
            finally
              FCSection1.Release;
            end;

          if Url = '' then Break;

          Sleep(Random(2000)); {Hier kommt später meine Aufgabe}

          FErgebnis := TStringList.Create;
            try
              try
    // Http.Head(Url);

                FCSection2.Acquire; {Ich habe aber gelesen dass man StringList auf jeden Fall mit CriticalSection absichern soll}
                  try
                    FErgebnis.Add('OK: ' + Url); {Ergebnis in StringList eintragen}
                    FErgebnis.Add('Zweite Zeile');
                    FErgebnis.Add('Dritte Zeile');
                  finally
                    FCSection2.Release;
                  end;

                UpdateStatus(FErgebnis);
              except
                on E: Exception do
                  begin
                    FErgebnis.Add('FAIL: ' + Url + ' - ' + E.Message);
                    UpdateStatus(FErgebnis);
                  end;
              end;
            finally
              FreeAndNil(FErgebnis);
            end;

          if Assigned(FUpdateJobs) then
            begin
              TThread.Synchronize(nil, procedure
                begin
                  FUpdateJobs(Self);
                end);
            end;

          if Assigned(FUpdateFertig) then
            begin
              TThread.Synchronize(nil, procedure
                begin
                  FUpdateFertig(Self);
                end);
            end;
        end;
    finally
      FreeAndNil(FErgebnis);
      FreeAndNil(Http);

      if Assigned(FUpdateAktiv) then
        begin
          TThread.Synchronize(nil, procedure
            begin
              FUpdateAktiv(Self);
            end);
        end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Icon : TIcon;
begin
  Icon := TIcon.Create;
  Icon.Handle := LoadIcon(hInstance, 'ICON_1');
  Form1.Icon := Icon;
  Icon.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  R : TRect;
begin
  Statusbar1.Perform($040A, 1, Integer(@R));
  Gauge1.Parent := Statusbar1;
  Gauge1.Top := r.Top + 2;
  Gauge1.Left := r.Left + 2;
  Gauge1.Width := r.Right - r.Left - 4;
  Gauge1.Height := r.Bottom - r.Top - 4;
end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
begin
  FormShow(Sender); {Wiederverwenden der Logik, weil es genauso wie in TForm1.FormShow ist}
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(ErgebnisListe);
  FreeAndNil(UrlList);
  FreeAndNil(CSection1);
  FreeAndNil(CSection2);
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
var
  Threads : TURLCheckerThread;
  Index : Integer;
  Timeout : Word;
begin
  if Assigned(CSection1) then FreeAndNil(CSection1); {Falls ich nach Cancel noch mal Start drücke statt Weiter}
  if Assigned(CSection2) then FreeAndNil(CSection2);
  if Assigned(UrlList) then FreeAndNil(UrlList);

  UrlList := TStringList.Create;
  CSection1 := TCriticalSection.Create;
  CSection2 := TCriticalSection.Create;
  ShouldStop := False;

  for Index := 0 to 200 do
    begin
      URLList.Add('http://google.com/' + IntToStr(Index));
    end;

  LabelActiveThreads.Caption := '0';
  LabelJobs.Caption := '201';
  LabelIdle.Caption := '201';
  IdleJobs := 201;
  Gauge1.MaxValue := 201;
  Gauge1.Progress := 0;
  JobsFinished := 0;
  Timeout := SpinEditTimeout.Value * 1000;

  for Index := 1 to SpinEditThreads.Value do
    begin
      Threads := TURLCheckerThread.Create(UrlList, CSection1, CSection2,
        procedure(Msg: TstringList)
          var
            ErgebnisListe : TStringList;
          begin
            RichEditLog.Lines.Add(Msg.Text); {Ergebnis vom Thread als StringList}
          end, @ShouldStop, UpdateLabelActiveThreads, UpdateLabelJobs, UpdateLabelFinished, Timeout);

     {Zähle aktive Threads}
      Inc(ActiveThreads);
      LabelActiveThreads.Caption := IntToStr(ActiveThreads);
    end;
end;

procedure TForm1.ButtonWeiterClick(Sender: TObject);
var
  Threads : TURLCheckerThread;
  Index : Integer;
  Timeout : Word;
begin
  ShouldStop := False;
  Timeout := SpinEditTimeout.Value * 1000;

  for Index := 1 to SpinEditThreads.Value do
    begin
      Threads := TURLCheckerThread.Create(UrlList, CSection1, CSection2,
        procedure(Msg: TstringList)
          begin
            RichEditLog.Lines.Add(Msg.Text); {Ergebnis vom Thread als StringList}
          end, @ShouldStop, UpdateLabelActiveThreads, UpdateLabelJobs, UpdateLabelFinished, Timeout);

     {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
  Dec(ActiveThreads);
  LabelActiveThreads.Caption := IntToStr(ActiveThreads);
end;

procedure TForm1.UpdateLabelJobs(Sender: TObject);
begin
  Dec(Form1.IdleJobs);
  LabelIdle.Caption := IntToStr(IdleJobs);
end;

procedure TForm1.UpdateLabelFinished;
begin
  Inc(Form1.JobsFinished);
  LabelFinished.Caption := IntToStr(JobsFinished);
  Gauge1.Progress := Gauge1.Progress + 1;
end;