hello,
1 - you must get the size of the file which you want to download before downloading, to have the TotalBytes value.
2 - The downloading procedure need to be in a thread else your Form will freeze while download.
here is an example ( not sure, must be checked) :
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
Dialogs, StdCtrls, ComCtrls, httpsend,blcksock,typinfo, synamisc;
type
{ THTTPDownload }
THTTPDownload = class(TThread)
private
http : THTTPsend;
TotalBytes : integer;
CurrentBytes : integer;
fURL: string;
fFileName: string;
procedure SocketGetCallBack(Sender: TObject; Reason: THookSocketReason;
const Value: string);
public
constructor Create(URL, FileName: string);
procedure Execute; override;
end;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
ELink: TEdit;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ THTTPDownload }
constructor THTTPDownload.Create(URL, FileName: string);
begin
inherited Create(True);
fURL:= URL;
fFileName:= FileName;
end;
procedure THTTPDownload.SocketGetCallBack(Sender: TObject; Reason: THookSocketReason;
const Value: string);
begin
if TotalBytes=0 then
exit;
case Reason of
HR_ReadCount:
begin
Inc(CurrentBytes, StrToIntDef(Value, 0));
Form1.ProgressBar1.Position := Round(100 * (CurrentBytes / TotalBytes));
end;
HR_Connect: CurrentBytes := 0;
end;
end;
procedure THTTPDownload.Execute;
const
MaxRetries=3;
var
HTTPGetResult: boolean;
RetryAttempt: integer;
i:integer;
s:string;
httpresult : boolean;
begin
httpresult:=false;
RetryAttempt:=1;
http :=THTTPSend.Create;
http.Sock.OnStatus := @SocketGetCallBack;
try
try
// try to get the file size
if http.HTTPMethod('HEAD', fURL) then
begin
// search for "Content-Length:" in header
for i:=0 to http.Headers.Count-1 do
begin
s:=UpperCase(http.Headers[i]);
if pos('CONTENT-LENGTH:',s)>0 then
TotalBytes := StrToIntDef(copy(s,pos(':',s)+1,length(s)),0);
end;
http.Headers.Clear;
end;
// Try to get the file
HTTPGetResult:=http.HTTPMethod('GET', fURL);
while (HTTPGetResult=false) and (RetryAttempt<MaxRetries) do
begin
sleep(500*RetryAttempt);
HTTPGetResult:=http.HTTPMethod('GET', fURL);
RetryAttempt:=RetryAttempt+1;
end;
// If we have an answer from the server, check if the file
// was sent to us.
case http.Resultcode of
100..299:
begin
with TFileStream.Create(fFileName,fmCreate or fmOpenWrite) do
try
Seek(0, soFromBeginning);
CopyFrom(http.Document, 0);
finally
Free;
end;
httpresult:=true;
end; //informational, success
300..399: httpresult:=false; //redirection. Not implemented, but could be.
400..499: httpresult:=false; //client error; 404 not found etc
500..599: httpresult:=false; //internal server error
else httpresult:=false; //unknown code
end;
except
// We don't care for the reason for this error; the download failed.
httpresult:=false;
end;
finally
http.Free;
end;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
s:string;
download: THTTPDownload;
begin
Progressbar1.Position := 0;
download:= THTTPDownload.Create(Elink.Text,'file.dwl');
// download.OnTerminate:= @DownloadTerminiated;
download.Resume;
end;
end.
Friendly, J.P
Recent
