Форум программистов [Powered by Invision Power Board]

Код


unit DownloadThreadUnit;

interface

uses
 Classes, IdComponent, IdHTTP;

type
 TDownloadThread = class(TThread)
 private
   FUrl: string;
   FFileName: string;
   FPrevTime: TDateTime;
   FProgress: Integer;
   FMaxProgress: Integer;
   FSpeed: Real;
   FTime: Integer;

   procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
   procedure Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
   procedure FSetMaxProgress;
   procedure FSetprogress;
 protected
   procedure Execute; override;
 public
   FDownloadHTTP: TIdHTTP;

   constructor Create(AUrl, AFileName: string);
   procedure StopDownload;
 end;

implementation

uses
 MainUnit, SysUtils, Windows, DateUtils, Math;

{ TDownloadThread }

constructor TDownloadThread.Create(AUrl, AFileName: string);
begin
 FUrl := AUrl;
 FFileName := AFileName;
 FProgress := 0;
 FMaxProgress := 0;
 FPrevTime := Now;
 inherited Create(False);
end;

procedure TDownloadThread.Execute;
var
 Response: TFileStream;
begin
 try
   Response := TFileStream.Create(FFileName, fmCreate);
   FDownloadHTTP := TIdHTTP.Create(nil);
   try
     FDownloadHTTP.Request.Referer := 'AdsCleaner Bundle';
     FDownloadHTTP.OnWorkBegin := WorkBegin;
     FDownloadHTTP.OnWork := Work;
     FDownloadHTTP.Get(FUrl, Response);
   finally
     FDownloadHTTP.Free;
     Response.Free;
   end;
 except
   SysUtils.DeleteFile(FFileName);
   Halt(1);
 end;
end;

procedure TDownloadThread.WorkBegin(Sender: TObject;
 AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
 FMaxProgress := AWorkCountMax;
 Synchronize(FSetMaxProgress);
end;

procedure TDownloadThread.Work(Sender: TObject; AWorkMode: TWorkMode;
 const AWorkCount: Integer);
begin
 FProgress := AWorkCount;
 Synchronize(FSetProgress);
end;

procedure TDownloadThread.FSetMaxProgress;
begin
 MainForm.Gauge.MaxValue := FMaxProgress;
end;

procedure TDownloadThread.FSetProgress;
var
 ResultStr: string;
 ATime: TDateTime;
 ASecond: Real;
begin
 ATime := Now;
 ASecond := MilliSecondsBetween(Now, FPrevTime) / 1000;
 FPrevTime := ATime;
 if ASecond <> 0 then
 begin
   FSpeed := (FDownloadHTTP.RecvBufferSize / ASecond) / 1024;
   FTime := Round(((FMaxProgress - FProgress) / 1024 )/ FSpeed);
   ResultStr := '';
   if FTime div 3600 = 0 then
     ResultStr := '00:'
   else
   begin
     ResultStr := IntToStr(FTime div 3600) + ':';
     FTime := FTime - FTime div 3600 * 3600;
   end;
   if FTime div 60 = 0 then
     ResultStr := ResultStr + '00:'
   else
   begin
     if FTime div 60 < 10 then
       ResultStr := ResultStr + '0' + IntToStr(FTime div 60) + ':'
     else
       ResultStr := ResultStr + IntToStr(FTime div 60) + ':';
     FTime := FTime - FTime div 60 * 60;
   end;
   if FTime = 0 then
     ResultStr := ResultStr + '00'
   else
   begin
     if FTime < 10 then
       ResultStr := ResultStr + '0' + IntToStr(FTime)
     else
     ResultStr := ResultStr + IntToStr(FTime);
   end;
   MainForm.ProgressLabel.Caption := FormatFloat('# ###', Max(1, MainForm.Gauge.Progress div 1024)) + ' from ' +
     FormatFloat('# ###', MainForm.Gauge.MaxValue div 1024) + 'Kb (' + FormatFloat('#.##', FSpeed) + 'Kb/s)' +
     ' - ' + ResultStr + ' remaining';
 end;
 MainForm.Gauge.Progress := FProgress;
 MainForm.Update;
end;

procedure TDownloadThread.StopDownload;
begin
 try
   FDownloadHTTP.Disconnect;
 except
 end;  
end;

Код



procedure TDownloadThread.WorkBegin(Sender: TObject;
 AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
 FMaxProgress := AWorkCountMax;
 Synchronize(FSetMaxProgress);
end;

procedure TDownloadThread.Work(Sender: TObject; AWorkMode: TWorkMode;
 const AWorkCount: Integer);
begin
 FProgress := AWorkCount;
 Synchronize(FSetProgress);
end;

Код



function TFormDownload.GetInetFile(fileURL,FileName: String): boolean;
var co:TThread;
    s:String;
begin
  FormDownload.StatusBar1.Panels.Items[0].Text:='Status: Downloading';
  GetDir(0, s);
  FormDownload.Label3.Caption:='To: '+s+'\Client.exe';
  co:=TDownloadThread.Create(fileURL,FileName);
  co.Priority:=tplowest;
end;

procedure TFormDownload.FormShow(Sender: TObject);
begin
  if(GetInetFile('http://localhost/','index.php')=True)then
    ShowMessage('OK!!!');
end;

Код



...
if AWorkMode = wmRead then ProgressBar1.Max := AWorkCountMax;
..

...
 if AWorkMode = wmRead then ProgressBar1.Position := AWorkCount;
...

Цитата(Snowy @ 7.2.2006, 21:00

)

На форме IdHTTP1 и IdAntiFreeze1.
У IdHTTP RecvBuferSize = 1
У антифриза OnlyWenIdle = false, IdleTimeOut = 64

Код


procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then ProgressBar1.Position := AWorkCount;
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  if AWorkMode = wmRead then ProgressBar1.Max := AWorkCountMax;
end;

procedure TForm1.Button1Click(Sender: TObject);
var s: string;
begin
   s := IdHttp1.Get('http://www.vingrad.ru/');
   ShowMessage(s);
end;

Код


FDownloadHTTP.Request.Referer := 'AdsCleaner Bundle';

Код


procedure TDownloadThread.FSetProgress;

Код


procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then
    progress.Progress := AWorkCount;
  [B]Synchronize(FSetProgress);[/B]
end;

Код


procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then
    progress.Progress := AWorkCount;
  [B]FSetProgress;[/B]
end;

Цитата(Rodman @ 30.8.2006, 17:59

)

а есть ли какая нить возможность еще выводить количество закаченных байт / всего байт (размер файла) и также количество времени до окончания...

Цитата(Rodman @ 30.8.2006, 17:59

)

выдастся значение только после окончания закачки...

Код


procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then  progress.Progress := AWorkCount;
  Application.ProcessMessages;
  FSetProgress;
  Application.ProcessMessages;
end;

Цитата(Rodman @ 30.8.2006, 18:53

)

Ну а возможно это совершить имея только старую и новую версию... без третье проги????