Source Code How to Download Files with Progress? Using TIdHTTPProgress - Extendend TIdHTTP by Giovani da Cruz

[emailx45]

How to Download Files with Progress? Using TIdHTTPProgress - Extendend TIdHTTP
Set/2019 Giovani da Cruz

Спойлер: Content

[SHOWTOGROUPS=4,20]
Hey guys from the Delphi Show, all good?

Today I needed to implement a mechanism to download files on my systems.
So researching I saw that I could do this using TIDHttp, which is an Indy component that already comes with Delphi by default and it is also possible to install it on Lazarus for free.
Cool, basically it is like this: IDHttp1.Get (‘your link’, variableStream). Nice, I saw that it worked like this, but I wanted the download progress to be displayed, for cases of larger files.
I tried some ways using TIDHttp directly, but I was not successful. So I continued researching and found a post on the stackoverflow, a post with an example of how to solve this problem.
I took this example tested and it worked. I made some minor adjustments and now the example works on Lazarus as well. Are you interested? So let's go to the code!
Next, to start, let's create a unit with the name util.download. In this unit we will implement a class that inherits from TIDHttp and add some functions that allow us to check the download progress.

Target: Delphi and Lazarus

Here is the code with comments on the steps:

{                                                                      }
{    TIdHTTPProgress - Extendend TIdHTTP to show progress download     }
{                                                                      }
{    Creted in https://stackoverflow.com/questions/28457925/how-to-download-a-file-with-progress-with-idhttp-via-https   }
{                                                                      }
{ Fixed and adapted to Lazarus and Delphi by Giovani Da Cruz           }
{                                                                      }
{ Please visit: https://showdelphi.com.br                              }
{----------------------------------------------------------------------}
unit util.download;

interface

uses
  Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  IdSSLOpenSSL;

{$M+}

type
  TIdHTTPProgress = class(TIdHTTP)
  private
    FProgress: Integer;
    FBytesToTransfer: Int64;
    FOnChange: TNotifyEvent;
    IOHndl: TIdSSLIOHandlerSocketOpenSSL;
    procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure SetProgress(const Value: Integer);
    procedure SetOnChange(const Value: TNotifyEvent);
  public
    constructor Create(AOwner: TComponent);
    procedure DownloadFile(const aFileUrl: string; const aDestinationFile: String);
  published
    property Progress: Integer read FProgress write SetProgress;
    property BytesToTransfer: Int64 read FBytesToTransfer;
    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  end;

implementation

uses
  Sysutils;

{ TIdHTTPProgress }

constructor TIdHTTPProgress.Create(AOwner: TComponent);
begin
  inherited;
  IOHndl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  Request.BasicAuthentication := True;
  HandleRedirects := True;
  IOHandler := IOHndl;
  ReadTimeout := 30000;

  { Compatibilidade com lazarus }
  {$IFDEF FPC}
  OnWork := @HTTPWork;
  OnWorkBegin := @HTTPWorkBegin;
  OnWorkEnd := @HTTPWorkEnd;
  {$ELSE}
  OnWork := HTTPWork;
  OnWorkBegin := HTTPWorkBegin;
  OnWorkEnd := HTTPWorkEnd;
  {$ENDIF}
end;

procedure TIdHTTPProgress.DownloadFile(const aFileUrl: string; const aDestinationFile: String);
var
  LDestStream: TFileStream;
  aPath: String;
begin
  Progress := 0;
  FBytesToTransfer := 0;
  aPath := ExtractFilePath(aDestinationFile);
  if aPath <> '' then
    ForceDirectories(aPath);

  LDestStream := TFileStream.Create(aDestinationFile, fmCreate);
  try
    Get(aFileUrl, LDestStream);
  finally
    FreeAndNil(LDestStream);
  end;
end;

procedure TIdHTTPProgress.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  { Evento interno responsável por informar o progresso atual }
  if BytesToTransfer = 0 then // No Update File
    Exit;

  Progress := Round((AWorkCount / BytesToTransfer) * 100);
end;

procedure TIdHTTPProgress.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  FBytesToTransfer := AWorkCountMax;
end;

procedure TIdHTTPProgress.HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  FBytesToTransfer := 0;
  Progress := 100;
end;

procedure TIdHTTPProgress.SetOnChange(const Value: TNotifyEvent);
begin
  FOnChange := Value;
end;

procedure TIdHTTPProgress.SetProgress(const Value: Integer);
begin
  FProgress := Value;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

end.

Note that the source code above is already set to be used in both Delphi and Lazarus.
Cool! Now that we have our new class, we will need to use it.
For this we go to the example of a download button on a form.

Let's go to the example of how to download by monitoring progress!

{ Download starting... }
procedure TForm1.bDownloadClick(Sender: TObject);
var
  IdHTTPProgress : TIdHTTPProgress;
begin

  IdHTTPProgress := TIdHTTPProgress.Create(Self);

  try
    {$IFDEF FPC}
    IdHTTPProgress.OnChange := @ProgressOnChange;
    IdHTTPProgress.OnWorkEnd := @WorkEnd;
    {$ELSE}
    IdHTTPProgress.OnChange := ProgressOnChange;
    IdHTTPProgress.OnWorkEnd := WorkEnd;
    {$ENDIF}

    IdHTTPProgress.DownloadFile(edURL.Text, edFile.Text + edArq.Text);
  finally
    FreeAndNil(IdHTTPProgress);
  end;
end;

Note that the source code above is already set to be used in both Delphi and Lazarus.
Cool! Now that we have our new class, we will need to use it.
For this we go to the example of a download button on a form.

Let's go to the example of how to download by monitoring progress!...

ProgressBar1.Position := TIdHTTPProgress(Sender).Progress;
  Application.ProcessMessages;

Now the event that notifies you when the download is complete.

procedure TForm1.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := 100;
  ShowMessage('Download success!');
end;

GitHub repository to IDHttpProgress unit
infussolucoes/IDHttpProgress

[/SHOWTOGROUPS]