Hallo,

ich versuche folgendes Problem zu lösen. Es muss eine Datei aus dem Web geladen werden.
Da der Download manchmal schief geht oder zu lange dauert muss eine Möglichkeit zum Abbrechen vorhanden sein. Deswegen habe ich mich für eine Lösung mit Thread entschieden.
Während des Downloads kann man in der Anwendung nichts machen außer auf „Abbrechen“ zu klicken und dem Fortschritt zu beobachten.

Mein Bespiel Quellcode hat zwei Probleme.
Oder die Anwendung friert ein und ich kann nicht auf abbrechen klicken. Oder der Download dauert unnötig lange.
Denn Unterschied macht die Zeile 104 (Application.ProcessMessages

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Net.URLClient,
  System.Net.HttpClient, System.Net.HttpClientComponent, Vcl.ComCtrls,
  Vcl.StdCtrls;

type
  TPBCallBack = procedure(Tiel: String; iReadProzent: Integer);

  TSchnitThread = class(TThread)
  private
    NetHTTPClient1: TNetHTTPClient;
    NetHTTPRequest1: TNetHTTPRequest;
    FPBCallBack: TPBCallBack;
    procedure myReceiveData(const Sender: TObject; AContentLength, AReadCount: Int64; var AAbort: Boolean);
  protected
    procedure Execute; override;
  public
    procedure SetCallBack(aPBCallBack: TPBCallBack);
  end;

  TForm1 = class(TForm)
    btnGET1: TButton;
    ProgressBar1: TProgressBar;
    btnGet2: TButton;
    btnCancel: TButton;
    procedure btnGET1Click(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnGet2Click(Sender: TObject);
  private
    myThread: TSchnitThread;
    isAbbruch: Boolean;
    isTimeOut: Boolean;
    isDone: Boolean;
    procedure OnProcessTerminate(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure PBCallBack(Text: String; Wert: Integer);
begin
  Form1.Caption := Text;
  Form1.ProgressBar1.Position := Wert;
end;

procedure TForm1.OnProcessTerminate(Sender: TObject);
begin
  isDone := true;
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  isAbbruch := true;
end;

procedure TForm1.btnGET1Click(Sender: TObject);
begin
  btnGET1.Enabled := false;
  try
    isAbbruch := false;
    //--
    myThread := TSchnitThread.Create(true);
    myThread.OnTerminate := OnProcessTerminate;
    myThread.SetCallBack(PBCallBack);
    myThread.Start;
    //--
    myThread.WaitFor;
    myThread.Free;
  finally
    btnGET1.Enabled := true;
  end;
end;

procedure TForm1.btnGet2Click(Sender: TObject);
var
  TicksBefore: Cardinal;
  iTimeOut: Integer;
begin
  btnGET2.Enabled := false;
  try
    isAbbruch := false;
    //--
    myThread := TSchnitThread.Create(true);
    myThread.OnTerminate := OnProcessTerminate;
    myThread.SetCallBack(PBCallBack);
    myThread.Start;
    //--
    TicksBefore := GetTickCount;
    iTimeOut := 100000;
    while (NOT isDone) and (NOT isAbbruch) and (NOT isTimeOut) do
    begin
      Application.ProcessMessages; // Geht schneller wenn kommentiert aber zeigt den Fortschritt nicht an

      sleep(300);
      isTimeOut := Trunc(GetTickCount - TicksBefore) >= iTimeOut;
    end;
    //--
    myThread.Free;
  finally
    btnGET2.Enabled := true;
  end;
end;

{ TSchnitThread }

procedure TSchnitThread.Execute;
var
  aStream: TMemoryStream;
begin
  inherited;
  aStream := TMemoryStream.Create;
  NetHTTPClient1 := TNetHTTPClient.Create(nil);
  NetHTTPRequest1 := TNetHTTPRequest.Create(nil);
  try
    NetHTTPRequest1.Client := NetHTTPClient1;
    NetHTTPRequest1.OnReceiveData := myReceiveData;
    //--
    NetHTTPRequest1.Get('https://unsplash.com/photos/wH3YxJwMC5o/download?force=true', aStream); //10 MB Bild
    aStream.Position := 0;
    aStream.SaveToFile('C:\Temp\Test1.jpg');
  finally
    aStream.Free;
    NetHTTPRequest1.Free;
    NetHTTPClient1.Free;
  end;
end;

procedure TSchnitThread.myReceiveData(const Sender: TObject; AContentLength, AReadCount: Int64; var AAbort: Boolean);
var
  ProzentWert: Integer;
begin
  if assigned(FPBCallBack) then
  begin
    ProzentWert := Trunc(AReadCount / AContentLength * 100);
    FPBCallBack('Datei Download..', ProzentWert);
  end;
end;

procedure TSchnitThread.SetCallBack(aPBCallBack: TPBCallBack);
begin
  FPBCallBack := aPBCallBack;
end;

end.

Wenn du sowieso im btnGET1Click auf das Ende des Threads wartest, dann darfst du dich nicht wundern, wenn deine Anwendung einfriert. Da kannst du dir den Thread auch sparen, denn der bringt dann nichts.

Der Thread sollte dort nur vorbereitet und gestartet werden. Mit FreeOnTerminate := True (das ist ein Property und keine Methode!) gibt er sich auch selbst frei wenn er fertig ist.

Im OnProcessTerminate kannst du dann den Button wieder mit Enabled := True aktivieren.

Das PBCallBack wird aus einem Thread aufgerufen und sollte tunlichst den Zugriff auf die VCL synchronisieren.

Für den Abbruch würde ich den Callback erweitern um auch das AAbort in myReceiveData bedienen zu können.

Multithreading ist alles andere als trivial. Ich empfehle das Studium einiger Beispiele um die Problematik und wie man damit umgeht zu erfassen. In meinem Artikel Async Tasks in VCL Projects versuche ich das zumindest anzureißen.

Uwe dein Hilfe ist wie immer Gold wert. Vielen Dank.

Habe es jetzt so gelöst:

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Net.URLClient,
  System.Net.HttpClient, System.Net.HttpClientComponent, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.WinXCtrls;

type
  TPBCallBack = procedure(Text: String; iReadProzent: Integer;var isAbborted: Boolean); stdcall;

  TSchnitThread = class(TThread)
  private
    NetHTTPClient1: TNetHTTPClient;
    NetHTTPRequest1: TNetHTTPRequest;
    FPBCallBack: TPBCallBack;
    myContentLength: Int64;
    myReadCount: Int64;
    myAbort: Boolean;
    procedure myReceiveData(const Sender: TObject; AContentLength, AReadCount: Int64; var AAbort: Boolean);
    procedure doCallCallBack;
  protected
    procedure Execute; override;
  public
    procedure SetCallBack(aPBCallBack: TPBCallBack);
  end;

  TForm1 = class(TForm)
    btnGET1: TButton;
    ProgressBar1: TProgressBar;
    btnCancel: TButton;
    procedure btnGET1Click(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    myThread: TSchnitThread;
    isAbbruch: Boolean;
    isDone: Boolean;
    procedure OnProcessTerminate(Sender: TObject);
    { Private-Deklarationen }
  public
    ProgressProzent: Integer;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure PBCallBack(Text: String; Wert: Integer; var isAbborted: Boolean); stdcall;
begin
  Form1.Caption := Text;
  Form1.ProgressBar1.Position := Wert;
  isAbborted := Form1.isAbbruch;
end;

procedure TForm1.OnProcessTerminate(Sender: TObject);
begin
  isDone := true;
  btnGET1.Enabled := true;
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  isAbbruch := true;
end;

procedure TForm1.btnGET1Click(Sender: TObject);
begin
  btnGET1.Enabled := false;
  isAbbruch := false;
  //--
  myThread := TSchnitThread.Create(true);
  myThread.FreeOnTerminate := true;
  myThread.OnTerminate := OnProcessTerminate;
  myThread.SetCallBack(@PBCallBack);
  myThread.Start;
  //--
  //myThread.WaitFor;
  //myThread.Free;
end;

{ TSchnitThread }

procedure TSchnitThread.Execute;
var
  aStream: TMemoryStream;
begin
  inherited;
  aStream := TMemoryStream.Create;
  NetHTTPClient1 := TNetHTTPClient.Create(nil);
  NetHTTPRequest1 := TNetHTTPRequest.Create(nil);
  try
    NetHTTPRequest1.Client := NetHTTPClient1;
    NetHTTPRequest1.OnReceiveData := myReceiveData;
    //--
    NetHTTPRequest1.Get('https://unsplash.com/photos/wH3YxJwMC5o/download?force=true', aStream); //10 MB Bild
    aStream.Position := 0;
    aStream.SaveToFile('C:\Temp\Test1.jpg');
  finally
    aStream.Free;
    NetHTTPRequest1.Free;
    NetHTTPClient1.Free;
  end;
end;

procedure TSchnitThread.myReceiveData(const Sender: TObject; AContentLength, AReadCount: Int64; var AAbort: Boolean);
begin
  myContentLength := AContentLength;
  myReadCount := AReadCount;
  AAbort := myAbort;
  Synchronize(doCallCallBack);
end;

procedure TSchnitThread.SetCallBack(aPBCallBack: TPBCallBack);
begin
  FPBCallBack := aPBCallBack;
end;

procedure TSchnitThread.doCallCallBack;
var
  ProzentWert: Integer;
begin
  if assigned(FPBCallBack) then
  begin
    ProzentWert := Trunc(myReadCount / myContentLength * 100);
    FPBCallBack('Datei Download..', ProzentWert, myAbort);
  end;
end;

end.