Einzelnen Beitrag anzeigen

Stewag

Registriert seit: 12. Jun 2008
175 Beiträge
 
Delphi 12 Athens
 
#3

AW: Einbinden eines Thread Downloads

  Alt 17. Jul 2024, 10:32
Himitsu hat natürlich Recht!
Das .Free habe ich erst spontan, nachträglich, im Forum nachgesetzt, weil mir der Befehl zu fehlen schien und ich befürchtete, als Erstes eins deswegen auf den Deckel zu bekommen.

Nun ist es umgekehrt

Hier der korrekte Aufruf:

Code:
procedure TForm1.Button1Click(Sender: TObject);
var
  Downloader: TFileDownloader;
  mstream: TMemoryStream;
begin
  mstream := TMemoryStream.Create;
  Downloader := TFileDownloader.Create('https://www.example/datei.txt', mstream);
  Downloader.OnDownloadComplete := DownloadComplete;
  Downloader.Start;
end;
Meine ursprüngliche Frage ist damit aber nicht beantwortet.

Hier die (lauffähige) Unit:
Code:
unit SynchronousHttpClientStreamDownloader;

interface

uses
  System.Classes, System.SysUtils, System.Net.HttpClient, System.Net.URLClient;

type
  TDownloadCompleteEvent = procedure(const stream: TStream; Success: Boolean) of object;

  TFileDownloader = class(TThread)
  private
    FURL: string;
    FStream: TStream;
    FHttpClient: THTTPClient;
    FOnDownloadComplete: TDownloadCompleteEvent;
    FSuccess: Boolean;
    procedure DownloadFile;
    procedure DoDownloadComplete;
  protected
    procedure Execute; override;
  public
    constructor Create(const URL: String; aStream: TStream);
    destructor Destroy; override;
    property OnDownloadComplete: TDownloadCompleteEvent read FOnDownloadComplete write FOnDownloadComplete;
  end;

implementation

{ TFileDownloader }

constructor TFileDownloader.Create(const URL: String; aStream: TStream);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FURL := URL;
  FStream := aStream;
  FHttpClient := THTTPClient.Create;
end;

destructor TFileDownloader.Destroy;
begin
  FHttpClient.Free;
  inherited;
end;

procedure TFileDownloader.DownloadFile;
var
  vHTTP: THTTPClient;
begin
  try
    FStream := TMemorystream.Create; // FStream muss an dieser Stelle erzeugt werden, im Execute klappt es nicht. Free muss aber im Execute stehen
    Assert(FStream <> nil);

    vHTTP := THTTPClient.Create;
    vHTTP.CustomHeaders['Pragma'] := 'no-cache';

    try
      vHTTP.Get(FURL, FStream);
      FSuccess := True;
    finally
      vHTTP.Free;
    end;
  except
    on E: Exception do
    begin
      FSuccess := False;
    end;
  end;
end;

procedure TFileDownloader.DoDownloadComplete;
begin
  if Assigned(FOnDownloadComplete) then
  begin
    FOnDownloadComplete(FStream, FSuccess);
    FStream.Free
  end
end;

procedure TFileDownloader.Execute;
begin
  DownloadFile;
  Synchronize(DoDownloadComplete);
end;

end.
Gibt es dazu Anmerkungen?
Steffen

Geändert von Stewag (17. Jul 2024 um 10:35 Uhr)
  Mit Zitat antworten Zitat