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;

  {Zähle aktive Threads}
  TThread.Synchronize(nil, procedure
    begin
      Inc(Form1.ActiveThreads);
      Form1.UpdateLabelActiveThreads;
    end);
end;

procedure TURLCheckerThread.UpdateStatus(const Msg: string);
begin
  if Assigned(FOnStatus) then
     TThread.Synchronize(TThread.Current, 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
    Threads[Index] := TURLCheckerThread.Create(UrlList, CriticalSection,
      procedure(Msg: string)
        begin
          RichEditLog.Lines.Add(Msg);
          RichEditLog.Lines.Add(ErgebnisListe.Text);
          ErgebnisListe.Clear; {Nicht vergessen, sonst wird die StringList immer weiter befüllt}
        end, @ShouldStop, ErgebnisListe);
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
    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; {Sehr wichtig, StringList resetten}
        end, @ShouldStop, ErgebnisListe);
end;

procedure TForm1.ButtonAbbruchClick(Sender: TObject);
begin
  ShouldStop := True;
end;

procedure TForm1.UpdateLabelActiveThreads;
begin
  TThread.Synchronize(nil, procedure
    begin
      LabelActiveThreads.Caption := IntToStr(ActiveThreads);
    end);
end;

procedure TForm1.UpdateLabelJobs;
begin
  TThread.Synchronize(nil, procedure
    begin
      LabelIdle.Caption := IntToStr(IdleJobs);
    end);
end;

procedure TForm1.UpdateLabelFinished;
begin
  TThread.Synchronize(nil, procedure
    begin
      LabelFinished.Caption := IntToStr(JobsFinished);
    end);
end;

procedure TForm1.ButtonEXITClick(Sender: TObject);
begin
  ShouldStop := True;
  Close;
end;

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

  {Zähle aktive Threads}
  TThread.Synchronize(nil, procedure
    begin
      Inc(Form1.ActiveThreads);
      Form1.UpdateLabelActiveThreads;
    end);
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
  FUrl : string;
  FHttp : TIdHTTP;
  FResult : TStringList;
begin
  FHttp := TIdHTTP.Create(nil);
  FResult := TStringList.Create;
    try
      while not Terminated and not FShouldStop^ do
        begin
          FUrl := '';
          FCriticalSection.Acquire;
            try
              if FUrlList.Count > 0 then
                begin
                  FUrl := FUrlList[0];
                  FUrlList.Delete(0);
                end;
            finally
              FCriticalSection.Release;
            end;

          if FUrl = '' 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
                FResult.Add('OK: ' + FUrl);
                FResult.Add('Zweite Zeile');
              finally
                FCriticalSection.Release;
              end;
          except
            on E: Exception do
              begin
                FResult.Add('FAIL: ' + FUrl + ' - ' + E.Message);
              end;
          end;

          UpdateStatus(FResult);

          TThread.Synchronize(nil, procedure
            begin
              Dec(Form1.IdleJobs);
              Form1.UpdateLabelJobs;

              Inc(Form1.JobsFinished);
              Form1.UpdateLabelFinished;
            end);
        end;
    finally
      FreeAndNil(FHttp);
      FreeAndNil(FResult);

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(CriticalSection);
  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;

  for Index := 1 to SpinEditThreads.Value do
    Threads[Index] := TURLCheckerThread.Create(UrlList, CriticalSection,
      procedure(Msg: TStringList)
        begin
          RichEditLog.Lines.AddStrings(Msg); {Statusanzeige, z.B. in Memo oder Listbox  Msg = das Ergebnis vom Thread}
        end, @ShouldStop);
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
    Threads[Index] := TURLCheckerThread.Create(UrlList, CriticalSection,
      procedure(Msg: TStringList)
        begin
          RichEditLog.Lines.AddStrings(Msg); {Statusanzeige, z.B. in Memo oder Listbox  Msg = das Ergebnis vom Thread}
        end, @ShouldStop);
end;

procedure TForm1.ButtonAbbruchClick(Sender: TObject);
begin
  ShouldStop := True;
end;

procedure TForm1.UpdateLabelActiveThreads;
begin
  TThread.Synchronize(nil, procedure
    begin
      LabelActiveThreads.Caption := IntToStr(ActiveThreads);
    end);
end;

procedure TForm1.UpdateLabelJobs;
begin
  TThread.Synchronize(nil, procedure
    begin
      LabelIdle.Caption := IntToStr(IdleJobs);
    end);
end;

procedure TForm1.UpdateLabelFinished;
begin
  TThread.Synchronize(nil, procedure
    begin
      LabelFinished.Caption := IntToStr(JobsFinished);
    end);
end;

procedure TForm1.ButtonEXITClick(Sender: TObject);
begin
  ShouldStop := True;
  Close;
end;