Zitat von SyntaxXx:

Wie kann ich nun warten, bis der Thread beendet wurde um dann die Meldung auszugeben?

Na eben mit TThread.WaitFor ... allerdings ist es doof, wenn du den Thread automatisch beim Beenden ins Nirwana schickst. Von wem willst du dann noch was holen?

Und wenn du auf den Thread wartest, dann ist deine UI blockiert ... warum dann einen Thread?

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var Thread1: TThread1;
begin
    Thread1 := TThread1.Create(True);
    try
      // Thread1.FreeOnTerminate := True;
      Thread1.response := 'Foo';
      Thread1.page := 'http://google.de';
      Thread1.Start;
      Thread1.WaitFor;
    
      showmessage(Thread1.response);
    finally
      Thread1.Free;
    end;
end;

Ahhhh ok, das war einfach.
Ok, du hast recht, macht natürlich jetzt keinen Sinn, mit nem Thread zu arbeiten.

Du kannst natürlich OnTerminate etwas zuweisen. Das Ereignis wird ausgelöst, wenn der Thread fertig ist

Und das tolle daran: OnTerminate wird sogar schon im Hauptthread ausgeführt.

Zitat von Der schöne Günther:

Und das tolle daran: OnTerminate wird sogar schon im Hauptthread ausgeführt.

Und das Allerbeste,

Man kann darin sogar auf Exceptions prüfen. Also die, welche im Thread auftrat und wodurch der Thread abgeschossen wurde.
Denn, im Gegensatz um Hauptthread, werden diese Exception zwar ebenfalls abgefangen, aber nicht dem Benutzer "angezeigt".

Der Grund, warum die RTL/VCL das macht: Windows beendet Prozesse, womit sich das ganze Programm verabschieden würde, wenn in irgendeinem Thread eine Exceptions bis zur Wurzel (ins Windows) durch rauscht.

TThread.FatalException

Wieder was gelernt, hätte ich das mal früher gewusst

Generell sollte man das Thread-Thema etwas anders anfassen:

Man stelle sich das als einen zusätzlichen Mitarbeiter vor, dem man eine Aufgabe gibt und wenn die Aufgabe abgeschlossen ist, dann gibt es wieder eine Rückmeldung.

Und wie im wahren Leben hat dieser Mitarbeiter einen Postkorb, wo alle Arbeiten hineinkommen und diese arbeitet der dann der Reihe nach ab.

Der Thread

zusammenfalten · markieren

Delphi-Quellcode:

unit HttpRequestThread;

interface

uses
  System.Generics.Collections,
  System.SyncObjs,
  System.Classes;

type
  TResponseNotify = procedure( const Request, Response : string ) of object;

  THttpRequestThread = class( TThread )
  private
    FCS : TCriticalSection;
    FEvent : TEvent;
    FQueue : TQueue<string>;
    FOnResponse : TResponseNotify;
    procedure SetOnResponse( const Value : TResponseNotify );
    function GetOnResponse : TResponseNotify;
    function GetQueueItem : string;
    procedure ProcessQueueItem;
    procedure DoResponseNotify( const ARequest, AResponse : string );
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add( const ARequest : string );

    property OnResponse : TResponseNotify read GetOnResponse write SetOnResponse;
  end;

implementation

uses
  System.SysUtils,
  IdException,
  IdHTTP;

{ THttpRequestThread }

procedure THttpRequestThread.Add( const ARequest : string );
begin
  FCS.Enter;
  try
    FQueue.Enqueue( ARequest );
    FEvent.SetEvent;
  finally
    FCS.Leave;
  end;
end;

constructor THttpRequestThread.Create;
begin
  FCS := TCriticalSection.Create;
  FEvent := TEvent.Create( nil, False, False, '' );
  FQueue := TQueue<string>.Create;
  inherited Create( False );

end;

destructor THttpRequestThread.Destroy;
begin

  inherited;
  FreeAndNil( FQueue );
  FreeAndNil( FEvent );
  FreeAndNil( FCS );
end;

procedure THttpRequestThread.DoResponseNotify( const ARequest, AResponse : string );
begin
  if MainThreadID = CurrentThread.ThreadID
  then
    begin
      if Assigned( OnResponse )
      then
        OnResponse( ARequest, AResponse );
    end
  else
    Queue(
        procedure
      begin
        DoResponseNotify( ARequest, AResponse );
      end );
end;

procedure THttpRequestThread.Execute;
begin
  inherited;
  while not Terminated do
    begin
      FEvent.WaitFor;
      if not Terminated
      then
        ProcessQueueItem;
    end;
end;

function THttpRequestThread.GetOnResponse : TResponseNotify;
begin
  FCS.Enter;
  try
    Result := FOnResponse;
  finally
    FCS.Leave;
  end;
end;

function THttpRequestThread.GetQueueItem : string;
begin
  FCS.Enter;
  try
    Result := FQueue.Dequeue;
    if FQueue.Count > 0
    then
      FEvent.SetEvent;
  finally
    FCS.Leave;
  end;
end;

procedure THttpRequestThread.ProcessQueueItem;
var
  LRequest : string;
  LResponse : string;
  LHttp : TIdHTTP;
begin
  LHttp := TIdHTTP.Create( nil );
  LHttp.HandleRedirects := True;
  try
    LRequest := GetQueueItem;
    try
      LResponse := LHttp.Get( LRequest );
    except
      on E : EIdException do
        begin
          LResponse := E.ClassName + ': ' + E.Message;
        end;
    end;
    DoResponseNotify( LRequest, LResponse );
  finally
    LHttp.Free;
  end;
end;

procedure THttpRequestThread.SetOnResponse( const Value : TResponseNotify );
begin
  FCS.Enter;
  try
    FOnResponse := Value;
  finally
    FCS.Leave;
  end;
end;

procedure THttpRequestThread.TerminatedSet;
begin
  inherited;
  FEvent.SetEvent;
end;

end.

und ein kleine Anwendung

zusammenfalten · markieren

Delphi-Quellcode:

unit FormMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  HttpRequestThread;

type
  TForm1 = class( TForm )
    Button1 : TButton;
    ListBox1 : TListBox;
    procedure Button1Click( Sender : TObject );
  private
    FHttpRequest : THttpRequestThread;
    procedure HttpRequestResponse( const Request, Response : string );
    procedure LogMsg( const AMsgStr : string );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.AfterConstruction;
begin
  inherited;
  FHttpRequest := THttpRequestThread.Create;
  FHttpRequest.OnResponse := HttpRequestResponse;
end;

procedure TForm1.BeforeDestruction;
begin
  inherited;
  FreeAndNil( FHttpRequest );
end;

procedure TForm1.Button1Click( Sender : TObject );
var
  LUrl : string;
  LIdx : Integer;
begin
  LUrl := 'http://google.de';
  for LIdx := 1 to 10 do
    begin
      LogMsg( 'Request ' + LUrl );
      FHttpRequest.Add( LUrl );
    end;
end;

procedure TForm1.HttpRequestResponse( const Request, Response : string );
begin
  LogMsg( Request + ' => ' + Response );
end;

procedure TForm1.LogMsg( const AMsgStr : string );
begin
  ListBox1.Items.Add( DateTimeToStr( Now ) + ': ' + AMsgStr );
end;

end.