Einzelnen Beitrag anzeigen

Edelfix

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

AW: Problem mit Thread und Web

  Alt 7. Sep 2022, 12:06
Uwe dein Hilfe ist wie immer Gold wert. Vielen Dank.

Habe es jetzt so gelöst:

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