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;