21.08.2014, 19:24
|
|
Администратор
|
|
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,531
Версия Delphi: Delphi 7
Репутация: выкл
|
|
[ Исходник ] - Асинхронный downloader (TIndyHttp & TThread)
Автор: 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.
|