![]() |
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:
Aufruf-Unit (Main-Form):
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.
Delphi-Quellcode:
Ich hab die unwichtigen Dinge rausgeschnitten - der Code sollte hoffentlich trotzdem noch gehen.
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. Und - auch wenns nicht 100% zum Thema passt - würde dieser Download unter XP/Vista auch ohne Adminrechte funktionieren? |
Re: IdHTTP Download im Thread
Ich push hier mal ganz frech ... :wink:
Kann mir hier niemand kurz Feedback geben? |
Re: IdHTTP Download im Thread
Jupp, sieht ganz gut aus.
|
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 17:44 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-2025 by Thomas Breitkreuz