Delphi/Lazarus通过扩展Indy组件TIDHttp创建带有下载进度指示的TIdHTTPProgress下载组件

今天，我需要实现一种在系统上下载文件的机制。欢迎加入Delphi开发局QQ群:32422310

因此，研究发现我可以使用TIDHttp进行此操作，TIDHttp是默认情况下随Delphi附带的Indy组件，还可以免费将其安装在Lazarus上。

很酷，基本上是这样的：IDHttp1.Get（“您的链接”，variableStream）。很好，我看到它可以这样工作，但是对于较大的文件，我希望显示下载进度。

我尝试了一些直接使用TIDHttp的方法，但没有成功。因此，我继续研究，并在stackoverflow上找到了一个帖子，其中包含如何解决此问题的示例。

我以这个示例进行了测试，并且可以正常工作。我做了一些小的调整，现在该示例也适用于Lazarus。你感兴趣吗？因此，让我们来看代码！

接下来，让我们开始创建一个名称为util.download的单元。在本单元中，我们将实现一个从TIDHttp继承的颈椎枕类，并添加一些使我们能够检查下载进度的函数。

{          }
{    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;