[Admin]

Автор: brochii
Описание: класс для асинхронного скачивания файлов
Ссылка: Asynchrone avec TIndyHttp & TThread

Код:

unit AsyncDownloader;

interface

uses IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP,
  {$IFDEF MSWINDOWS}
  System.AnsiStrings,
  {$ENDIF}
  Classes, System.SysUtils;

type

  {$IFDEF ANDROID}
    AnsiString = String;
    AnsiChar = Char;
    PAnsiChar = PChar;
  {$ENDIF}

  TDownloadProgess = procedure(sender:TObject;percent:integer) of object;
  TDownloadStringComplete = procedure(sender:TObject; AHtml : string) of object;
  TDownloadDataComplete = procedure(sender:TObject; AStream : TStream) of object;
  TDownloadFileComplete = procedure(sender:TObject; AFileName:string) of object;
  TDownloadProcedure = procedure(AIdHttp:TIdHttp;ATarget:TStream) of object;

  TDownloadState = (Initiate, Downloading, Done);
  TDownloadType = (dltFile, dltData, dltString);

  TAsyncDownloader = class(TThread)
  private
    FTagObject : TObject;
    FTagString : String;
    FTagInt : Integer;
    FOwnStream:boolean;

    FTarget : TStream;
    FUrl, FFileName : String;

    FPercent:byte;
    FState : TDownloadState;

    FDownloader : TIdHTTP;
    FProgress : TDownloadProgess;

    FStringComplete : TDownloadStringComplete;
    FDataComplete : TDownloadDataComplete;
    FFileComplete : TDownloadFileComplete;

    FDownloadProcedure : TDownloadProcedure;

    FType : TDownloadType;

    procedure HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure DoProgress;
    procedure DoCompleteFile;
    procedure DoCompleteString;
    procedure DoCompleteData;
    procedure DoDownload;
  public
    constructor Create;overload;//(AUrl:string;ATarget:TStream);overload;
    //constructor Create(AUrl:string;ATarget:TStream;ADownloadProcedure:TDownloadProcedure);overload;
    constructor Create(ADownloadProcedure:TDownloadProcedure);overload;
    destructor Free;
    procedure Execute;override;

    procedure DownloadData(AUrl:String);overload;
    procedure DownloadData(AUrl:String;ATarget:TStream);overload;
    procedure DownloadFile(AUrl, AFileName:String);overload;
    procedure DownloadString(AUrl:String);overload;

    procedure SetHeader;
    ///<summary>Event that will be triggered at in interval time to provide
    /// the percentage downloaded</summary>
    ///<para> use this event to uptade something like a gauge or a progress component</para>
    property OnProgress : TDownloadProgess read FProgress write FProgress;
    ///<summary>This event is triggered when the download is complete</summary>
    ///<para>Cast the Sender to TAsyncDownloader to retreave the properties needed</para>
    ///<para>like the Url or the Target Stream used to store the download</para>
    property OnDownloadStringComplete : TDownloadStringComplete read FStringComplete write FStringComplete;
    property OnDownloadDataComplete : TDownloadDataComplete read FDataComplete write FDataComplete;
    property OnDownloadFileComplete : TDownloadFileComplete read FFileComplete write FFileComplete;
    ///<summary>This is the IdHttp object used to perform the download</summary>
    property Downloader : TIdHTTP read FDownloader write FDownloader;
    ///<summary>Target where the download will be stored</summary>
    ///<para>This is a decendent of TStream</para>
    property Url : string read FUrl write FUrl;
    property State : TDownloadState read FState;

    property TagObject : TObject read FTagObject write FTagObject;
    property TagInt : Integer read FTagInt write FTagInt;
    property TagString : String read FTagString write FTagString;
  end;

implementation

(*
constructor TAsyncDownloader.Create(AUrl:string;ATarget:TStream;ADownloadProcedure:TDownloadProcedure);
begin
  Create(AUrl,ATarget);
  FDownloadProcedure := ADownloadProcedure;
end;

constructor TAsyncDownloader.Create(AUrl:string;ATarget:TStream);
begin
  FTarget := ATarget;
  FUrl := AUrl;

  FDownloader := TIdHTTP.Create;
  FDownloader.OnWork := HttpWork;
  inherited Create(true);
end;
*)
constructor TAsyncDownloader.Create;
begin
  FDownloader := TIdHTTP.Create;
  FDownloader.OnWork := HttpWork;
  FDownloader.HTTPOptions := [hoNoParseMetaHTTPEquiv];
  FDownloader.HandleRedirects := true;
  FState := TDownloadState.Initiate;
  FOwnStream:=true;
  inherited Create(true);
end;

constructor TAsyncDownloader.Create(ADownloadProcedure:TDownloadProcedure);
begin
  Create;
  FDownloadProcedure := ADownloadProcedure;
end;

destructor TAsyncDownloader.Free;
begin
  FDownloader.Free;
  inherited free;
end;

procedure TAsyncDownloader.DownloadData(AUrl:String);
begin
  FUrl := AUrl;
  FType := dltData;
  FTarget := TMemoryStream.Create;
  resume;
end;

procedure TAsyncDownloader.DownloadData(AUrl:String;ATarget:TStream);
begin
  FUrl := AUrl;
  FType := dltData;

  if(assigned(ATarget)) then begin
    FOwnStream := false;
    FTarget := ATarget;
  end;

  resume;
end;

procedure TAsyncDownloader.SetHeader;
begin
  with FDownloader.Request do begin
    UserAgent := 'Mozilla/5.0 (Windows NT 5.1; rv:19.0) Gecko/20100101 Firefox/19.0';
    AcceptCharset := 'Utf-8;q=0.7,*;q=0.7';
    AcceptLanguage := 'fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3';
    Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
    ContentType := 'application/x-www-form-urlencoded';
  end;
end;

procedure TAsyncDownloader.DownloadFile(AUrl, AFileName:String);
begin
  FType := dltFile;
  FUrl := AUrl;
  FFileName := AFileName;

  FTarget := TFileStream.Create(AFileName,fmCreate);
  resume;
end;

procedure TAsyncDownloader.DownloadString(AUrl:String);
begin
  FType := dltString;
  FUrl := AUrl;
  resume;
end;

procedure TAsyncDownloader.DoDownload;
begin
  if(Assigned(FDownloader)) then
    FDownloadProcedure(FDownloader,FTarget);
end;

procedure TAsyncDownloader.DoProgress;
begin
  if(assigned(FProgress)) then FProgress(self,FPercent);
end;

procedure TAsyncDownloader.DoCompleteString;
var
  AHtml:String;
begin
  AHtml := FFileName;
  FFileName:='';
  if(assigned(FStringComplete)) then FStringComplete(self,AHtml);
end;

procedure TAsyncDownloader.DoCompleteData;
begin
  if(assigned(FStringComplete)) then FDataComplete(self,FTarget);
  if FOwnStream then FTarget.Free;
end;

procedure TAsyncDownloader.DoCompleteFile;
begin
  if(assigned(FFileComplete)) then FFileComplete(self,FFileName);
  if FOwnStream then FTarget.Free;

end;

procedure TAsyncDownloader.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  Http: TIdHTTP;
  ContentLength: Int64;
begin
  Http := TIdHTTP(ASender);
  ContentLength := Http.Response.ContentLength;

  if (Pos('chunked', LowerCase(Http.Response.TransferEncoding)) = 0) and
     (ContentLength > 0) then
  begin
    FPercent := 100*AWorkCount div ContentLength;
    Synchronize(DoProgress);
  end;
end;

procedure TAsyncDownloader.Execute;
begin
  FPercent :=0;
  FState := TDownloadState.Downloading;
  Synchronize(DoProgress);

  if(Assigned(FDownloadProcedure)) then
    Synchronize(DoDownload)
  else begin

    if FType = dltString then
      FFileName := FDownloader.Get(FUrl)
    else
      FDownloader.Get(FUrl, FTarget);

  end;
  //This allow us to update the progress to 100%
  if(FPercent <100) then begin
    FPercent := 100;
    Synchronize(DoProgress);
  end;

  FState := TDownloadState.Done;
    if FType = dltString then
      Synchronize(DoCompleteString)
    else if FType = dltData then
      Synchronize(DoCompleteData)
    else if FType = dltFile then
      Synchronize(DoCompleteFile);
end;

end.