3
\$\begingroup\$

This is a Delphi class, based on System.net.HTTPClient with a function for downloading a file from a URL and saving on a filename destination:

function Download(const ASrcUrl : string; const ADestFileName : string): Boolean;

The main feature is the ability to suspend or resume partial download.

unit AcHTTPClient;
interface
uses
 System.Net.URLClient, System.net.HTTPClient;
type
 TAcHTTPProgress = procedure(const Sender: TObject; AStartPosition : Int64; AEndPosition: Int64; AContentLength: Int64; AReadCount: Int64; ATimeStart : Int64; ATime : Int64; var Abort: Boolean) of object;
 TAcHTTPClient = class
 private
 FOnProgress: TAcHTTPProgress;
 FHTTPClient: THTTPClient;
 FTimeStart: cardinal;
 FCancelDownload: boolean;
 FStartPosition: Int64;
 FEndPosition: Int64;
 FContentLength: Int64;
 private
 procedure SetProxySettings(AProxySettings: TProxySettings);
 function GetProxySettings : TProxySettings;
 procedure OnReceiveDataEvent(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
 public
 constructor Create;
 destructor Destroy; override;
 property ProxySettings : TProxySettings read FProxySettings write SetProxySettings;
 property OnProgress : TAcHTTPProgress read FOnProgress write FOnProgress;
 property CancelDownload : boolean read FCancelDownload write FCancelDownload;
 function Download(const ASrcUrl : string; const ADestFileName : string): Boolean;
 end;
implementation
uses
 System.Classes, System.SysUtils, Winapi.Windows;
constructor TAcHTTPClient.Create;
// -----------------------------------------------------------------------------
// Constructor
begin
 inherited Create;
 // create an THTTPClient
 FHTTPClient := THTTPClient.Create;
 FHTTPClient.OnReceiveData := OnReceiveDataEvent;
 // setting the timeouts
 FHTTPClient.ConnectionTimeout := 5000;
 FHTTPClient.ResponseTimeout := 15000;
 // initialize the class variables
 FCancelDownload := false;
 FOnProgress := nil;
 FEndPosition := -1;
 FStartPosition := -1;
 FContentLength := -1;
end;
destructor TAcHTTPClient.Destroy;
// -----------------------------------------------------------------------------
// Destructor
begin
 FHTTPClient.free;
 inherited Destroy;
end;
procedure TAcHTTPClient.SetProxySettings(AProxySettings: TProxySettings);
// -----------------------------------------------------------------------------
// Set FHTTPClient.ProxySettings with AProxySettings
begin
 FHTTPClient.ProxySettings := AProxySettings;
end;
function TAcHTTPClient.GetProxySettings : TProxySettings;
// -----------------------------------------------------------------------------
// Get FHTTPClient.ProxySettings
begin
 Result := FHTTPClient.ProxySettings;
end;
procedure TAcHTTPClient.OnReceiveDataEvent(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
// -----------------------------------------------------------------------------
// HTTPClient.OnReceiveDataEvent become OnProgress
begin
 Abort := CancelDownload;
 if Assigned(OnProgress) then
 OnProgress(Sender, FStartPosition, FEndPosition, AContentLength, AReadCount, FTimeStart, GetTickCount, Abort);
end;
function TAcHTTPClient.Download(const ASrcUrl : string; const ADestFileName : string): Boolean;
// -----------------------------------------------------------------------------
// Download a file from ASrcUrl and store to ADestFileName
var
 aResponse: IHTTPResponse;
 aFileStream: TFileStream;
 aTempFilename: string;
 aAcceptRanges: boolean;
 aTempFilenameExists: boolean;
begin
 Result := false;
 FEndPosition := -1;
 FStartPosition := -1;
 FContentLength := -1;
 aResponse := nil;
 aFileStream := nil;
 try
 // raise an exception if the file already exists on ADestFileName 
 if FileExists(ADestFileName) then
 raise Exception.Create(Format('the file %s alredy exists', [ADestFileName]));
 // reset the CancelDownload property
 CancelDownload := false;
 // set the time start of the download
 FTimeStart := GetTickCount;
 // until the download is incomplete the ADestFileName has *.parts extension 
 aTempFilename := ADestFileName + '.parts';
 // get the header from the server for aSrcUrl
 aResponse := FHTTPClient.Head(aSrcUrl);
 // checks if the response StatusCode is 2XX (aka OK) 
 if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
 raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));
 // checks if the server accept bytes ranges 
 aAcceptRanges := SameText(aResponse.HeaderValue['Accept-Ranges'], 'bytes');
 // get the content length (aka FileSize)
 FContentLength := aResponse.ContentLength;
 // checks if a "partial" download already exists
 aTempFilenameExists := FileExists(aTempFilename);
 // if a "partial" download already exists
 if aTempFilenameExists then
 begin
 // re-utilize the same file stream, with position on the end of the stream
 aFileStream := TFileStream.Create(aTempFilename, fmOpenWrite or fmShareDenyNone);
 aFileStream.Seek(0, TSeekOrigin.soEnd);
 end else begin
 // create a new file stream, with the position on the beginning of the stream
 aFileStream := TFileStream.Create(aTempFilename, fmCreate);
 aFileStream.Seek(0, TSeekOrigin.soBeginning);
 end;
 // if the server doesn't accept bytes ranges, always start to write at beginning of the stream
 if not(aAcceptRanges) then
 aFileStream.Seek(0, TSeekOrigin.soBeginning);
 // set the range of the request (from the stream position to server content length)
 FStartPosition := aFileStream.Position;
 FEndPosition := FContentLength;
 // if the range is incomplete (the FStartPosition is less than FEndPosition)
 if (FEndPosition > 0) and (FStartPosition < FEndPosition) then
 begin
 // ... and if a starting point is present
 if FStartPosition > 0 then
 begin
 // makes a bytes range request from FStartPosition to FEndPosition
 aResponse := FHTTPClient.GetRange(aSrcUrl, FStartPosition, FEndPosition, aFileStream);
 end else begin
 // makes a canonical GET request
 aResponse := FHTTPClient.Get(aSrcUrl, aFileStream);
 end;
 // check if the response StatusCode is 2XX (aka OK) 
 if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
 raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));
 end;
 // if the FileStream.Size is equal to server ContentLength, the download is completed!
 if (aFileStream.Size > 0) and (aFileStream.Size = FContentLength) then begin
 // free the FileStream otherwise doesn't renames the "partial file" into the DestFileName
 FreeAndNil(aFileStream);
 // renames the aTempFilename file into the ADestFileName 
 Result := RenameFile(aTempFilename, ADestFileName);
 // What?
 if not(Result) then
 raise Exception.Create(Format('RenameFile from %s to %s: %s', [aTempFilename, ADestFileName, SysErrorMessage(GetLastError)]));
 end;
 finally
 if aFileStream <> nil then aFileStream.Free;
 aResponse := nil;
 end;
end;
end.

This is a form for example (don't review; it's just for testing the class):

enter image description here

unit WMain;
interface
uses
 Winapi.Windows,
 Winapi.Messages,
 System.SysUtils,
 System.Variants,
 System.Classes,
 Vcl.Graphics,
 Vcl.Controls,
 Vcl.Forms,
 Vcl.Dialogs,
 Vcl.StdCtrls,
 Vcl.ComCtrls,
 System.Math,
 AcHTTPClient,
 System.Net.URLClient;
type
 TWinMain = class(TForm)
 BtnDownload: TButton;
 EdSrcUrl: TEdit;
 EdDestFilename: TEdit;
 ProgressBar: TProgressBar;
 BtnSospendi: TButton;
 LblInfo: TLabel;
 procedure BtnDownloadClick(Sender: TObject);
 procedure BtnCancelClick(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 private
 { Private declarations }
 FAcHTTPClient: TAcHTTPClient;
 FLastProcess: cardinal;
 procedure AcHTTPProgressEvent(const Sender: TObject; AStartPosition : Int64; AEndPosition: Int64; AContentLength: Int64; AReadCount: Int64; ATimeStart : Int64; ATime : Int64; var Abort: Boolean);
 public
 { Public declarations }
 end;
var
 WinMain: TWinMain;
implementation
{$R *.dfm}
procedure TWinMain.FormCreate(Sender: TObject);
begin
 FLastProcess := GetTickCount;
 FAcHTTPClient := TAcHTTPClient.Create;
 FAcHTTPClient.OnProgress := AcHTTPProgressEvent;
 LblInfo.Caption := '';
 ProgressBar.Max := 0;
 ProgressBar.Position := 0;
end;
procedure TWinMain.FormDestroy(Sender: TObject);
begin
 FAcHTTPClient.Free;
end;
procedure TWinMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 FAcHTTPClient.CancelDownload := true;
end;
procedure TWinMain.BtnCancelClick(Sender: TObject);
begin
 FAcHTTPClient.CancelDownload := true;
end;
procedure TWinMain.AcHTTPProgressEvent(const Sender: TObject; AStartPosition : Int64; AEndPosition: Int64; AContentLength: Int64; AReadCount: Int64; ATimeStart : Int64; ATime : Int64; var Abort: Boolean);
 function ConvertBytes(Bytes: Int64): string;
 const
 Description: Array [0 .. 8] of string = ('Bytes', 'KB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB');
 var
 i: Integer;
 begin
 i := 0;
 while Bytes > Power(1024, i + 1) do
 Inc(i);
 Result := FormatFloat('###0.##', Bytes / Power(1024, i)) + #32 + Description[i];
 end;
var
 aSpeedBytesSec: Int64;
 aBytesToDwn: Int64;
 aSecsDwn: Int64;
 aSecsDwnLeft: Int64;
 aCaption: string;
begin
 aSpeedBytesSec := 0;
 aSecsDwnLeft := 0;
 aCaption := '';
 if (AReadCount > 0) and (ATime > 0) then
 begin
 aBytesToDwn := AContentLength - AReadCount;
 aSecsDwn := (ATime - ATimeStart) div 1000;
 if aSecsDwn > 0 then
 aSpeedBytesSec := AReadCount div aSecsDwn;
 if aSpeedBytesSec > 0 then
 aSecsDwnLeft := aBytesToDwn div aSpeedBytesSec;
 // size to download
 if AReadCount > 1024 then
 aCaption := aCaption + Format('%s/%s ', [ConvertBytes(AReadCount), ConvertBytes(AContentLength)]);
 if AEndPosition > AContentLength then
 aCaption := aCaption + Format('(final size on disk %s) ', [ConvertBytes(AEndPosition)]);
 // download speed
 if aSpeedBytesSec > 0 then
 aCaption := aCaption + Format('(%s/s) ', [ConvertBytes(aSpeedBytesSec)]);
 if aSecsDwn > 0 then
 aCaption := aCaption + Format('time passed %.2d:%.2d ', [aSecsDwn div 60, aSecsDwn mod 60]);
 if aSecsDwnLeft > 0 then
 aCaption := aCaption + Format('time left %.2d:%.2d ', [aSecsDwnLeft div 60, aSecsDwnLeft mod 60]);
 LblInfo.Caption := aCaption;
 ProgressBar.Max := AEndPosition;
 ProgressBar.Position := AStartPosition + AReadCount;
 Application.ProcessMessages;
 end;
end;
procedure TWinMain.BtnDownloadClick(Sender: TObject);
begin
 try
 if FAcHTTPClient.Download(EdSrcUrl.Text, EdDestFilename.Text) then
 ShowMessage('File downloaded!');
 except on E : Exception do
 ShowMessage(E.Message);
 end;
end;
end.
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Apr 12, 2017 at 16:03
\$\endgroup\$

1 Answer 1

3
\$\begingroup\$

Your code looks pretty good to me. Just a few quick notes:


There is an Exception.CreateFmt constuctor you can use. For example:

raise Exception.CreateFmt('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]);

Instead of if aFileStream <> nil, the Delphi idiom is if Assigned(aFileStream):

if Assigned(aFileStream) then aFileStream.Free;

But you don't need to check. You can replace that line with just this:

aFileStream.Free;

Free is a class method. You can call it on a null reference without problems. That's how they designed it to work.


There's need to do this: aResponse := nil. The object will be destroyed when the variable goes out of scope.


function TAcHTTPClient.Download is quite long. It would be good if you could break it up into subfunctions if possible, just for the sake of readability.


The following is repeated code. That violates the Don't Repeat Yourself principle (DRY). You could wrap it in a function.

// checks if the response StatusCode is 2XX (aka OK) 
if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
 raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));
answered Apr 13, 2017 at 4:35
\$\endgroup\$
1
  • \$\begingroup\$ Hi thaks, I didn't know Exception.CreateFmt and .Free on nil. \$\endgroup\$ Commented Apr 13, 2017 at 6:57

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.