Delphi System.net.HTTPClient 下载-木庄网络博客

本文整理自网络，侵删。
 

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
  // Enable away mode and prevent the sleep idle time-out
  SetThreadExecutionState(ES_CONTINUOUS or ES_SYSTEM_REQUIRED);
  try
    try
      if FAcHTTPClient.Download(EdSrcUrl.Text, EdDestFilename.Text) then
          ShowMessage('File downloaded!');
    except on E : Exception do
      ShowMessage(E.Message);
    end;
  finally
    // Clear EXECUTION_STATE flags to disable away mode 
    // and allow the system to idle to sleep normally.
    SetThreadExecutionState(ES_CONTINUOUS);
  end;
end;

end.



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.
Delphi System.net.HTTPClient 下载

相关推荐

评论
