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;

      TThread.Synchronize(nil, procedure
        begin
          Dec(Form1.ActiveThreads);
          Form1.UpdateLabelActiveThreads;
        end);