Easy Downloader

uDownloadThread.pas

(*
 * Easy Downloader
 *
 * Copyright (c) 2015, 2017 HOSOKAWA Jun.
 *
 * CONTACT
 *   Twitter @pik or freeonterminate@gmail.com
 *
 * LAST UPDATE
 *   2017/12/05  Remove iPort parameter
 *   2016/01/05  Add TFile.GetSize Method's help & Bug fix
 *   2015/12/26  First Release
 *
 * PLATFORM
 *   Windows, OS X, iOS, Android
 *   Delphi (XE8 <- maybe) 10 seattle
 *     Maybe, Appmethod and C++Builder
 *
 * ORIGINAL SOURCE
 *   https://gist.github.com/freeonterminate/90c46568010a081805ef
 *
 * DOCUMENT
 *   #1  http://qiita.com/pik/items/998547937c7d05d34977
 *   #2  http://qiita.com/pik/items/1361696efeb4348f2acc
 *   #3  http://qiita.com/pik/items/95dfebdb659b30918196
 *
 * HOW TO USE
 *   0. Download TFile.GetSize Helper Method
 *      Source: https://gist.github.com/freeonterminate/e2316f0f829115851358
 *      Document: http://qiita.com/pik/items/c253d0f55d749dd889ad
 *
 *   1. uses uDownloadThread;
 *
 *   2, Create DownloadThread
 *      TDownloadThread.Create(
 *         TPath.Combine(TPath.GetDocumentPath, 'foo.bin'), // Destination File
 *         'http://foo.bar/baz.bin',                        // Source URL
 *         Flase,                                           // Use Memory ( *1 )
 *         DownloadProgress,                                // Progress Event
 *         DownloadComplete);                               // Complete Event
 *
 *   3. DownloadProgress is Progress Event.
 *      DownloadComplete is Download Complete Event.
 *
 *   *1 if you set UseMemory to True, Download is fast !, But Memory is used.
 *
 * LICENSE:
 *   本ソフトウェアは「現状のまま」で、明示であるか暗黙であるかを問わず、
 *   何らの保証もなく提供されます。
 *   本ソフトウェアの使用によって生じるいかなる損害についても、
 *   作者は一切の責任を負わないものとします。
 *
 *   以下の制限に従う限り、商用アプリケーションを含めて、本ソフトウェアを
 *   任意の目的に使用し、自由に改変して再頒布することをすべての人に許可します。
 *
 *   1. 本ソフトウェアの出自について虚偽の表示をしてはなりません。
 *      あなたがオリジナルのソフトウェアを作成したと主張してはなりません。
 *      あなたが本ソフトウェアを製品内で使用する場合、製品の文書に謝辞を入れて
 *      いただければ幸いですが、必須ではありません。
 *
 *   2. ソースを変更した場合は、そのことを明示しなければなりません。
 *      オリジナルのソフトウェアであるという虚偽の表示をしてはなりません。
 *
 *   3. ソースの頒布物から、この表示を削除したり、表示の内容を変更したりしては
 *      なりません。
 *
 *   This software is provided 'as-is', without any express or implied warranty.
 *   In no event will the authors be held liable for any damages arising from
 *   the use of this software.
 *
 *   Permission is granted to anyone to use this software for any purpose,
 *   including commercial applications, and to alter it and redistribute
 *   it freely, subject to the following restrictions:
 *
 *   1. The origin of this software must not be misrepresented;
 *      you must not claim that you wrote the original software.
 *      If you use this software in a product, an acknowledgment in the product
 *      documentation would be appreciated but is not required.
 *
 *   2. Altered source versions must be plainly marked as such,
 *      and must not be misrepresented as being the original software.
 *
 *   3. This notice may not be removed or altered from any source distribution.
 *)

 unit uDownloadThread;

// If you want log, Following line remove comment and Download FMX.Log.pas
// FMX.Log.pas -> https://github.com/freeonterminate/delphi/tree/master/FMXLog
// {$DEFINE LOG_ON}

interface

uses
  System.Classes
  , System.SysUtils
  ;

type
  TDownloadThread = class(TThread)
  public type
    TProgressEvent =
      procedure (
        Sender: TObject;                 // TDownloadThread Instance
        const iDone, iTotal:Integer;     // iDone: ReadByte; iTotal: TotalBytes
        var ioAbort: Boolean) of object; // ioAbort: If True, Download Cancel
    TCompleteEvent =
      procedure (
        Sender: TObject;                    // TDownloadThread Instance
        const iSuccess: Boolean) of object; // iSuccess: Download succeeded ?
  private const
    MODE_ALL = $1ff;    // rwxrwxrwx
    PROGRESS_TIME = 50; // OnProgress is called every this time [msec].
    DEF_PORT = 80;      // Port no.
  private type
    TProgressThread = class(TThread)
    private
      [Weak] FDownloadThread: TDownloadThread;
      FRunning: Boolean;
      FAbort: Boolean;
      FReadCount: Int64;
      FContentLength: Int64;
      FStart: TDateTime;
      FProgressTime: Integer;
      FSynchronizer: TMultiReadExclusiveWriteSynchronizer;
    protected
      procedure Execute; override;
    public
      constructor Create(
        const iDownloadThread: TDownloadThread;
        const iProgressTime: Integer); reintroduce;
      destructor Destroy; override;
      procedure SetCount(const iReadCount, iContentLength: Int64);
      property Abort: Boolean read FAbort;
    end;
  private
    FFileName: String;
    FURL: String;
    FUseMemory: Boolean;
    FOnProgress: TProgressEvent;
    FOnComplete: TCompleteEvent;
    FProgressThread: TProgressThread;
    procedure HttpReceiveData(
      const Sender: TObject;
      iContentLength, iReadCount: Int64;
      var ioAbort: Boolean);
  protected
    {$IFDEF LOG_ON}
    procedure LogD(const iMsg: String);
    {$ENDIF}
    procedure Execute; override;
  public
    constructor Create(
      const iFilename: String;
      const iURL: String;
      const iOnProgress: TProgressEvent;
      const iOnComplete: TCompleteEvent); reintroduce; overload;
    constructor CreateFast(
      const iFilename: String;
      const iURL: String;
      const iOnProgress: TProgressEvent;
      const iOnComplete: TCompleteEvent); reintroduce; overload;
    constructor Create(
      const iFilename: String;
      const iURL: String;
      const iUseMemory: Boolean;
      const iOnProgress: TProgressEvent;
      const iOnComplete: TCompleteEvent); reintroduce; overload;
    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
    property OnComplete: TCompleteEvent read FOnComplete write FOnComplete;
  end;

implementation

uses
  System.IOUtils.Files
  , System.DateUtils
  , System.Net.HttpClient
  {$IFDEF LOG_ON}
  , FMX.Log
  {$ENDIF}
  ;

type
  TDirectFileStream = class(TFileStream)
  public
    function Write(
      const Buffer: TBytes;
      Offset, Count: Integer): Longint; override;
  end;

{ TDirectFileStream }

function TDirectFileStream.Write(
  const Buffer: TBytes;
  Offset, Count: Integer): Longint;
begin
  Result := FileWrite(Handle, Buffer[Offset], Count);
end;

{ TDownloadThread.TProgressThread }

constructor TDownloadThread.TProgressThread.Create(
  const iDownloadThread: TDownloadThread;
  const iProgressTime: Integer);
begin
  inherited Create(True);

  FreeOnTerminate := True;

  FDownloadThread := iDownloadThread;
  FProgressTime := iProgressTime;
  FSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create;
end;

destructor TDownloadThread.TProgressThread.Destroy;
begin
  FSynchronizer.DisposeOf;

  inherited;
end;

procedure TDownloadThread.TProgressThread.Execute;
var
  ReadCount, ContentLength: Int64;
begin
  while (not Terminated) do
  begin
    if (FRunning) then
    begin
      // Sleep(FProgressTime); // If CPU is Full-Power then use sleep.
      Continue;
    end;

    FSynchronizer.BeginRead;
    try
      ReadCount := FReadCount;
      ContentLength := FContentLength;
    finally
      FSynchronizer.EndRead;
    end;

    if
      (MilliSecondsBetween(Now, FStart) > FProgressTime) or
      (ReadCount >= ContentLength)
    then
    begin
      FRunning := True;
      try
        TThread.Synchronize(
          Self,
          procedure
          begin
            if (Assigned(FDownloadThread.FOnProgress)) then
              FDownloadThread.FOnProgress(
                FDownloadThread,
                ReadCount,
                ContentLength,
                FAbort);
          end
        );
      finally
        FRunning := False;
      end;

      FStart := Now;
    end;
  end;
end;

procedure TDownloadThread.TProgressThread.SetCount(
  const iReadCount, iContentLength: Int64);
begin
  FSynchronizer.BeginWrite;
  try
    FReadCount := iReadCount;
    FContentLength := iContentLength;
  finally
    FSynchronizer.EndWrite;
  end;
end;

{ TDownloadThread }

constructor TDownloadThread.Create(
  const iFilename, iURL: String;
  const iUseMemory: Boolean;
  const iOnProgress: TProgressEvent;
  const iOnComplete: TCompleteEvent);
begin
  inherited Create(False);

  FreeOnTerminate := True;

  FFileName := iFilename;
  FURL := iURL;
  FUseMemory := iUseMemory;
  FOnProgress := iOnProgress;
  FOnComplete := iOnComplete;
end;

constructor TDownloadThread.Create(
  const iFilename, iURL: String;
  const iOnProgress: TProgressEvent;
  const iOnComplete: TCompleteEvent);
begin
  TDownloadThread.Create(
    iFilename,
    iURL,
    DEF_PORT,
    False,
    iOnProgress,
    iOnComplete);
end;

constructor TDownloadThread.CreateFast(
  const iFilename, iURL: String;
  const iOnProgress: TProgressEvent;
  const iOnComplete: TCompleteEvent);
begin
  TDownloadThread.Create(
    iFilename,
    iURL,
    DEF_PORT,
    True,
    iOnProgress,
    iOnComplete);
end;

procedure TDownloadThread.Execute;
var
  Http: THttpClient;
  OK: Boolean;
  FS: TFileStream;
  Size: Int64;
  Res: IHTTPResponse;
begin
  {$IFDEF LOG_ON}
  LogD('URL = ' + FURL);
  {$ENDIF}

  OK := True;
  try
    if (TFile.Exists(FFileName)) then
      TFile.Delete(FFileName);

    FS := TDirectFileStream.Create(FFileName, fmCreate, MODE_ALL);
    try
      Http := nil;
      FProgressThread := nil;
      try
        Http := THttpClient.Create;
        Http.HandleRedirects := True;
        Http.OnReceiveData := HttpReceiveData;

        FProgressThread := TProgressThread.Create(Self, PROGRESS_TIME);
        FProgressThread.Start;

        if (FUseMemory) then
        begin
          Res := Http.Get(FURL);

          if (Res <> nil) and (Res.ContentStream <> nil) then
            FS.CopyFrom(Res.ContentStream, 0)
          else
          begin
            OK := False;

            {$IFDEF LOG_ON}
            LogD('Failed: Response is empty')
            {$ENDIF}
          end;
        end
        else
          Http.Get(FURL, FS);
      finally
        FProgressThread.Terminate;
        FreeAndNil(Http);
        FreeAndNil(FProgressThread);
      end;
    finally
      FreeAndNil(FS);
    end;

    // TFile.GetSize is Helper Method.
    // Source: https://gist.github.com/freeonterminate/e2316f0f829115851358
    // Document: http://qiita.com/pik/items/c253d0f55d749dd889ad
    // or
    // Use TFileEx
    // http://ht-deko.com/delphiforum/?vasthtmlaction=viewtopic&t=1431.0
    Size := TFile.GetSize(FFileName);

    {$IFDEF LOG_ON}
    LogD('FileSize = ' + Size.ToString);
    {$ENDIF}

    if (not TFile.Exists(FFileName)) or (Size < 1) then
    begin
      OK := False;

      {$IFDEF LOG_ON}
      LogD('Failed: File is empty')
      {$ENDIF}
    end;
  except
    on E: Exception do
    begin
      OK := False;

      {$IFDEF LOG_ON}
      LogD('Exception: ' + E.Message);
      {$ENDIF}
    end;
  end;

  if (Assigned(FOnComplete)) then
    Synchronize(
      procedure
      begin
        FOnComplete(Self, OK);
      end
    );
end;

procedure TDownloadThread.HttpReceiveData(
  const Sender: TObject;
  iContentLength, iReadCount: Int64;
  var ioAbort: Boolean);
begin
  if (Assigned(FOnProgress)) then
  begin
    FProgressThread.SetCount(iReadCount, iContentLength);
    ioAbort := FProgressThread.Abort;
  end;
end;

{$IFDEF LOG_ON}
procedure TDownloadThread.LogD(const iMsg: String);
begin
  Log.d('TDownloadThread.' + iMsg);
end;
{$ENDIF}

end.

Hi, thank you for the great blog post and the above codes.
I'm afraid that TDownloadThread.Create() doesn't use the iPort value.

shioyang
Thank you.
I removed 'iPort' !
Because Port property is held by TURI.