当前位置:首页 > 网站技术文档 > 正文内容

Delphi NetHTTPClient1 下载显示进度条

nalyc2个月前 (09-17)网站技术文档212
unit untFrmDownFile;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Net.URLClient,
  System.Net.HttpClient, System.Net.HttpClientComponent, Vcl.ComCtrls,
  Vcl.StdCtrls;

type
  TFrmDown = class(TForm)
    NetHTTPClient1: TNetHTTPClient;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    procedure NetHTTPClient1RequestCompleted(const Sender: TObject;
      const AResponse: IHTTPResponse);
    procedure NetHTTPClient1ReceiveData(const Sender: TObject; AContentLength,
      AReadCount: Int64; var Abort: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    AResponse: TStringStream;
  public
    { Public declarations }
    FileName: string;

    procedure DoDownload(Url: string);
  end;

var
  FrmDown: TFrmDown;

implementation

{$R *.dfm}

//delphi 字节数转换为KB或MB字符串
function BytesToStr(iBytes: Integer): String;
var
  iKb: Integer;
begin
  iKb := Round(iBytes / 1024);
  if iKb > 1000 then
    Result := Format('%.2f MB', [iKb / 1024])
  else
    Result := Format('%d KB', [iKb]);
end;

procedure TFrmDown.DoDownload(Url: string);
begin
  AResponse.Clear;
  NetHTTPClient1.Get(Url,AResponse);
end;

procedure TFrmDown.FormCreate(Sender: TObject);
begin
  AResponse := TStringStream.Create('',TEncoding.UTF8);
end;

procedure TFrmDown.FormDestroy(Sender: TObject);
begin
  FreeAndNil(AResponse);
end;

procedure TFrmDown.FormShow(Sender: TObject);
begin
  ProgressBar1.Position := 0;
end;

procedure TFrmDown.NetHTTPClient1ReceiveData(const Sender: TObject;
  AContentLength, AReadCount: Int64; var Abort: Boolean);
begin
  ProgressBar1.Max := AContentLength;
  ProgressBar1.Position := AReadCount;
  Label1.Caption := BytesToStr(AReadCount) + ' / ' + BytesToStr(AContentLength);
end;

procedure TFrmDown.NetHTTPClient1RequestCompleted(const Sender: TObject;
  const AResponse: IHTTPResponse);
begin
  try
    if AResponse.ContentStream.Size > 0  then
    begin
      if FileExists(FileName) then
        DeleteFile(FileName);
      Self.AResponse.SaveToFile(FileName);
      Application.MessageBox('下载成功', '提示信息', MB_OK + MB_ICONINFORMATION);
      Self.Close;
    end;
  except
    Self.Close;
  end;
end;

end.

扫描二维码推送至手机访问。

版权声明:本文由Qzcc.Com发布,如需转载请注明出处。

本文链接:https://qzcc.com/post/Delphi_NetHTTPClient.html

分享给朋友:

相关文章

DELPHI XE 跨平台 Form ShowModal 官方示例

Calling ShowModal as an Anonymous Method on All Platformsprocedure THeaderFooterForm.btnPickClick(Sender: TObject);var...

mysql的免安装配置

mysql的免安装配置

1、下载(1)下载地址:https://dev.mysql.com/downloads/mysql/(2)选择下载2、配置环境变量(1)解压目录:D:\mysql-8.0.16-winx64(2)配置环境变量3、添加配置文件(1)配置文件目...

RAD Studio 11 Alexandria 补丁 1

RAD Studio 11 Alexandria 补丁 1下载地址:http://altd.embarcadero.com/getit/public/libraries/110Patches/R110.hotfix.1.v2-2021102...

发表评论

访客

看不清,换一张

◎欢迎参与讨论,请在这里发表您的看法和观点。