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; {<--- HIER}
    FUpdateJobs : TNotifyEvent; {<--- HIER}
    FUpdateFertig : TNotifyEvent; {<--- HIER}
    FUrlList : TStrings;
    FCSection1 : TCriticalSection;
    FCSection2 : TCriticalSection;
    FOnStatus : TProc<TstringList>;
    FShouldStop : PBoolean;
    FTimeOut : Word; {<--- HIER}
  protected
    procedure Execute; override;
    procedure UpdateStatus(const Msg: TstringList);
  public
    constructor Create(UrlList: TStrings; CSection1, CSection2: TCriticalSection; OnStatus: TProc<TstringList>; ShouldStop: PBoolean);

    property OnUpdateActive : TNotifyEvent read FUpdateAktiv write FUpdateAktiv; {<--- HIER}
    property OnUpdateJobs : TNotifyEvent read FUpdateJobs write FUpdateJobs; {<--- HIER}
    property OnUpdateFertig : TNotifyEvent read FUpdateFertig write FUpdateFertig; {<--- HIER}

    property TimeOut : Word read FTimeOut write FTimeOut; {<--- HIER}
  end;

{ TWorkerThread }
constructor TURLCheckerThread.Create(UrlList: TStrings; CSection1, CSection2: TCriticalSection; OnStatus: TProc<TstringList>; ShouldStop: PBoolean);
begin
  inherited Create(False);
  FUrlList := UrlList;
  FCSection1 := CSection1;
  FCSection2 := CSection2;
  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
  FErgebnis : TstringList;
  Url : string;
  Http : TIdHTTP;
begin
  Http := TIdHTTP.Create(nil);
  Http.ConnectTimeout := FTimeOut; // 8000
  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; {Keine Ahnung ob es richtig ist, habe aber rausgelesen 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.FormDestroy(Sender: TObject);
begin
  FreeAndNil(ErgebnisListe);
  FreeAndNil(UrlList);
  FreeAndNil(CSection1);
  FreeAndNil(CSection2);
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
var
  Threads : array[0..100] of TURLCheckerThread;
  Index : Integer;
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;

  LabelJobs.Caption := '100';
  LabelIdle.Caption := '100';
  IdleJobs := 100;
  Gauge1.MaxValue := 100;
  Gauge1.Progress := 0;
  JobsFinished := 0;

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

      Threads[Index].TimeOut := SpinEditTimeout.Value;
      Threads[Index].OnUpdateActive := UpdateLabelActiveThreads;
      Threads[Index].OnUpdateJobs := UpdateLabelJobs;
      Threads[Index].OnUpdateFertig := UpdateLabelFinished;

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

procedure TForm1.ButtonWeiterClick(Sender: TObject);
var
  Threads : array[0..100] of TURLCheckerThread;
  Index : Integer;
begin
  ShouldStop := False;

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

      Threads[Index].TimeOut := SpinEditTimeout.Value;
      Threads[Index].OnUpdateActive := UpdateLabelActiveThreads;
      Threads[Index].OnUpdateJobs := UpdateLabelJobs;
      Threads[Index].OnUpdateFertig := UpdateLabelFinished;

     {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;