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.
\$\endgroup\$
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]));
\$\endgroup\$
  • \$\begingroup\$ Hi thaks, I didn't know Exception.CreateFmt and .Free on nil. \$\endgroup\$ – ar099968 Apr 13 '17 at 6:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.