delphi Idhttp 下载文件 Thread

unit UUpdater;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

  xpman, Gauges, ComCtrls, UDownThread, zlib, Grids, BaseGrid, AdvGrid;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Status: TLabel;

    SpeedLabel: TLabel;

    msg: TMemo;

    Progress: TProgressBar;

    Edit1: TEdit;

    Button2: TButton;

    Button3: TButton;

    StringGrid1: TAdvStringGrid;

    Button4: TButton;

    Edit2: TEdit;

    Memo1: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Button2Click(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;

   abbruch :Boolean;

    ndx:integer;

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.Button1Click(Sender: TObject);

begin

  msg.Lines.Append('--------------------------');

  msg.Lines.Append('Starte Download ...');

  download('http://localhost/tools/checkhttp.php?name='+ edit1.text);

  msg.Lines.Append('Download abgeschlossen');

  SpeedLabel.Caption := 'Fertig';

  Button2.Click;

end;

procedure TForm1.download(wwwurl: string);

var

  path: string;

  Down: TDownThread;

begin

  path := ExtractFilePath(paramstr(0)) + 'Update\tmp.txt';

  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.FormCreate(Sender: TObject);

begin

ndx:=1;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

s:string;

begin

abbruch := false;

      while (ndx < StringGrid1.RowCount - 1) and (not abbruch) do // war sonst 0

    begin

    edit1.text:= StringGrid1.Cells[4, ndx]; //name

   abbruch := true;

   inc(ndx);

  end;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

  abbruch := True;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

StringGrid1.LoadFromCSV(ExtractFilePath(Application.ExeName) + 'komma.csv');

end;

end.

$show_page$

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

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.