AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Problem mit Thread und Web

Ein Thema von Edelfix · begonnen am 7. Sep 2022 · letzter Beitrag vom 7. Sep 2022
 
Edelfix

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

AW: Problem mit Thread und Web

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


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:23 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz