Einzelnen Beitrag anzeigen

Edelfix

Registriert seit: 6. Feb 2015
Ort: Stadtoldendorf
213 Beiträge
 
Delphi 10.4 Sydney
 
#1

Problem mit Thread und Web

  Alt 7. Sep 2022, 10:50
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

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.
  Mit Zitat antworten Zitat