Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi IdHTTP Download im Thread (https://www.delphipraxis.net/93727-idhttp-download-im-thread.html)

Master-of-Magic 10. Jun 2007 14:59


IdHTTP Download im Thread
 
Ich bin dabei, ein AutoUpdate für mein Programm zu schreiben und möchte dabei den Indy-Download in einem Thread realisieren, damit die MainForm nicht einfriert(es wird trotzdem gewartet, bis der Download fertig ist). Ich hab ein Beispiel dafür gefunden und versucht, das Ganze mit Synchronize umzusetzen.
Da ich aber erst Anfänger in Sachen Threads bin, würde ich euch bitten, mir etwas Feedback zum Code zu geben. Kann ich etwas vereinfachen, wo könnten Probleme entstehen oder wo ist mein Stil schlecht ... ich hab das Gefühl, das ich die Synchronizes im Thread etwas umständlich implementiert habe :gruebel:
In der Praxis geht der Code soweit, aber ich würde gerne wissen, ob ich auch die Theorie verstanden habe :wink:

Thread-Unit:
Delphi-Quellcode:
unit UDownThread;

interface

uses
  Windows, SysUtils, Classes, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent;

type
  //external prototypes
  TOnWorkBeginEvent = procedure(Sender: TThread; AWorkCountMax: Integer) of object;
  TOnWorkEvent = procedure(Sender: TThread; AWorkCount: Integer) of object;
  TOnFinish = procedure(Sender: TObject; ResponseCode: Integer) of object;

  TDownThread = class(TThread)
  private
    { Private declarations }
    HTTP: TIdHTTP;
    //external
    FOnWorkBeginEvent: TOnWorkBeginEvent;
    FOnWorkEvent: TOnWorkEvent;
    FOnFinish: TOnFinish;

    FResponseCode: Integer;
    FURL: string;
    FFileName: String;
    FWorkCountMax: Integer;
    FWorkCount: Integer;
    procedure InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
    procedure InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
    procedure DoNotifyFinish;
    procedure DoNotifyWorkBegin;
    procedure DoNotifyWork;
  protected
    procedure Execute; override;
  public
    { Public declarations }
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    property URL: String read FURL write FURL;
    property FileName: String read FFileName write FFileName;
    property WorkCountMax: Integer read FWorkCountMax;
    property OnWork: TOnWorkEvent read FOnWorkEvent write FOnWorkEvent;
    property OnWorkBegin: TOnWorkBeginEvent read FOnWorkBeginEvent write FOnWorkBeginEvent;
    property OnFinish: TOnFinish read FOnFinish write FOnFinish;
  end;

implementation

uses UUpdater;

constructor TDownThread.Create;
begin
  inherited Create(True);
  HTTP := TIdHTTP.Create(nil);  // HTTP-Kompo wird dynamisch erstellt
  with HTTP do
  begin
    OnWorkBegin := InternalOnWorkBegin;
    OnWork := InternalOnWork;
//    HTTP.IOHandler.RecvBufferSize:=4096; //löst AccessViolation aus !?!
  end;
end;

destructor TDownThread.Destroy;
begin
  HTTP.Free;
  inherited Destroy;
end;

procedure TDownThread.Execute;
var
  lStream: TFileStream;
begin
  lStream:=TFileStream.Create(FileName, fmCreate or fmShareDenyNone);
  try
    HTTP.Get(FURL, lStream);
    FResponseCode := HTTP.ResponseCode;
  finally
    if Assigned(lStream) then lStream.Free;
  end;
  Synchronize(DoNotifyFinish);
end;

procedure TDownThread.DoNotifyFinish;
begin
  if Assigned(OnFinish) then OnFinish(Self, FResponseCode);
end;
//##############################################################################
procedure TDownThread.InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
  FWorkCountMax := AWorkCountMax;
  Synchronize(DoNotifyWorkBegin);
end;

procedure TDownThread.DoNotifyWorkBegin;
begin
  if Assigned(OnWorkBegin) then OnWorkBegin(Self, FWorkCountMax);
end;
//##############################################################################
procedure TDownThread.InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
  FWorkCount := AWorkCount;
  Synchronize(DoNotifyWork);
end;

procedure TDownThread.DoNotifyWork;
begin
  if Assigned(OnWork) then OnWork(Self, FWorkCount);
end;

end.
Aufruf-Unit (Main-Form):
Delphi-Quellcode:
unit UUpdater;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  xpman, Gauges, ComCtrls, UDownThread, zlib;

type
  TForm1 = class(TForm)
    msg: TMemo;
    startdownload: TButton;
    exit: TButton;
    Progress: TProgressBar;
    SpeedLabel: TLabel;
    Status: TLabel;
    procedure startdownloadClick(Sender: TObject);
  private
    { Private declarations }
    StartTime: Cardinal;
    procedure download(wwwurl: string);
    procedure OnThreadWork(Sender: TThread; AWorkCount: Integer);
    procedure OnThreadWorkBegin(Sender: TThread; AWorkCountMax: Integer);
    procedure DownResultHandle(Sender: TObject; ResponseCode: Integer);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnThreadWork(Sender: TThread; AWorkCount: Integer);
var
  speed: single;
begin
  Progress.Position := AWorkCount;
  speed := AWorkCount/(GetTickCount - StartTime + 1); //+1 um DivbyZero zu verhindern
  Status.caption := Format('%f s|%.2f KB/s', [(((Sender as TDownThread).WorkCountMax-AWorkCount)/1000)/speed, speed]);
end;

procedure TForm1.OnThreadWorkBegin(Sender: TThread; AWorkCountMax: Integer);
begin
  Progress.Max := AWorkCountMax;
  msg.Lines.Append(FormatFloat('Dateigröße: 0, Bytes', AWorkCountMax));
  StartTime := GetTickCount;
end;

procedure TForm1.download(wwwurl: string);
var
  path: string;
  Down: TDownThread;
begin
  path := ExtractFilePath(paramstr(0)) + 'Update\file.zip';
  Status.Caption := '';
  Progress.Position := 0;

  msg.Lines.Append('Downloade Datei ' + path);

  Down := TDownThread.Create(true);
  with Down do
  begin
    FreeOnTerminate := true;
    OnWork := OnThreadWork;
    OnWorkBegin := OnThreadWorkBegin;
    OnFinish := DownResultHandle;
    URL := wwwurl;
    FileName := path;
    Resume;
  end;
end;

procedure TForm1.startdownloadClick(Sender: TObject);
begin
  msg.Lines.Append('--------------------------');
  msg.Lines.Append('Starte Download ...');
  download(link);
end;

procedure TForm1.DownResultHandle(Sender: TObject; ResponseCode: Integer);
begin
  msg.Lines.Append('Download abgeschlossen');
  SpeedLabel.Caption := 'Fertig';
  showmessage(IntToStr(ResponseCode));
end;

end.
Ich hab die unwichtigen Dinge rausgeschnitten - der Code sollte hoffentlich trotzdem noch gehen.

Und - auch wenns nicht 100% zum Thema passt - würde dieser Download unter XP/Vista auch ohne Adminrechte funktionieren?

Master-of-Magic 14. Jun 2007 07:20

Re: IdHTTP Download im Thread
 
Ich push hier mal ganz frech ... :wink:

Kann mir hier niemand kurz Feedback geben?

Luckie 23. Jun 2007 09:21

Re: IdHTTP Download im Thread
 
Jupp, sieht ganz gut aus.

moshhc 23. Mai 2008 23:02

Re: IdHTTP Download im Thread
 
Hm... echt cool soweit.. aber wie stop man das ganz wenn es einmal läuft...

:roll:


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:02 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz