unit HTTPDownloader;
interface
uses
SysUtils,
StrUtils,
Dialogs,
Classes,
Forms,
IdBaseComponent,
IdComponent,
IdTCPConnection,
IdTCPClient,
IdAuthentication,
IdHTTP;
type
TUpdateRate = (urFast, urNormal, urSlow);
TDownload =
record
ID : integer;
Count : integer;
URL :
array[0..3]
of string;
Size : int64;
SizeFormated :
string;
Downloaded : int64;
DownloadedFormated :
string;
DownloadedPercent : integer;
end;
TDownloadWork =
procedure(Download : TDownload)
of object;
TDownloadBegin =
procedure(Download : TDownload)
of object;
TDownloadEnd =
procedure(Download : TDownload)
of object;
THTTPDownloader =
class
private
// Variablen
bolAppProcessMsg: boolean;
intDownloads : integer;
urUpdateRate : TUpdateRate;
arrDownloadList :
array of array[0..1]
of string;
objHTTP : TidHTTP;
CurrentDownload : TDownload;
// Ereignisse
DownloadWork : TDownloadWork;
DownloadBegin : TDownloadBegin;
DownloadEnd : TDownloadEnd;
// Funktionen
procedure DownloadOnWork(ASender: TObject;
AWorkMode: TWorkMode;
AWorkCount: Int64);
procedure ClearCurrentDownload;
function GetSizeName(
const Size : int64):
String;
public
// Constructor / Destructor
constructor Create;
destructor Destroy;
override;
// Funktionen / Prozeduren
function GetURLFileSize(aURL :
string) : int64;
function Download(aURL :
string; aDest :
string) : boolean;
procedure ItemsDownload;
procedure ItemsAdd(aURL :
string; aDest :
string);
procedure ItemsClear;
// Eigenschaften
property UpdateRate : TUpdateRate
read urUpdateRate
write urUpdateRate;
property ProcessMessages : boolean
read bolAppProcessMsg
write bolAppProcessMsg;
property Downloads : integer
read intDownloads;
property PercentCurrent : integer
read intDownloads;
property PercentAll : integer
read intDownloads;
// Ereignisse
property OnDownloadWork : TDownloadWork
read DownloadWork
write DownloadWork;
property OnDownloadBegin: TDownloadBegin
read DownloadBegin
write DownloadBegin;
property OnDownloadEnd : TDownloadEnd
read DownloadEnd
write DownloadEnd;
end;
var
Downloader : THTTPDownloader;
implementation
// =============================================================================
// Public
// =============================================================================
constructor THTTPDownloader.Create;
begin
inherited;
// HTTP Objekt (Indy) erzeugen und Eigenschaften setzen
objHTTP := TidHTTP.Create(
nil);
objHTTP.AllowCookies := true;
objHTTP.RedirectMaximum := 10;
// HTTP Objekt Ereigniss zuweißen
objHTTP.OnWork := DownloadOnWork;
// Variablen Initialisieren
intDownloads := 0;
SetLength(arrDownloadList,0);
end;
destructor THTTPDownloader.Destroy;
begin
inherited;
// Aufräumen
objHTTP.Destroy;
end;
procedure THTTPDownloader.ItemsAdd(aURL :
string; aDest :
string);
begin
// DownloadList-Array um eins erhöhen
SetLength(arrDownloadList,Length(arrDownloadList)+1);
// 2te Dimension des Arrays befüllen
arrDownloadList[Length(arrDownloadList)-1,0] := aURL;
arrDownloadList[Length(arrDownloadList)-1,1] := aDest;
// Download Property Var. um 1 erhöhen und Record zuweisen
inc(intDownloads);
CurrentDownload.Count := intDownloads;
end;
procedure THTTPDownloader.ItemsClear;
begin
// DownloadList-Array auf 0 Setzen
SetLength(arrDownloadList, 0);
// Download Property Var. auf 0 setzen und Record zuweißen
intDownloads := 0;
CurrentDownload.Count := 0;
end;
procedure THTTPDownloader.ItemsDownload;
var
i: Integer;
begin
// Jedes Element des DownloadList-Arrays durchlaufen und Datei herunterladen
for i := 0
to Length(arrDownloadList) - 1
do
begin
CurrentDownload.ID := i + 1;
Self.Download(arrDownloadList[i,0],arrDownloadList[i,1]);
end;
end;
function THTTPDownloader.Download(aURL :
string; aDest :
string) : boolean;
var
DownloadStream : TMemoryStream;
begin
// Standartrückgabewert setzen (wird bei Fehlerfall geändert)
result := true;
// Stream erzeugen
DownloadStream := TMemoryStream.Create;
DownloadStream.Clear;
// Versuche Datei herunterzulasen und abzuspeichern
try
// Header Informationen abfragen
objHTTP.Head(aURL);
// ProcessMessages falls Property gesetzt
if bolAppProcessMsg
then
Application.ProcessMessages;
// RECORD befüllen
CurrentDownload.Size := objHTTP.Response.ContentLength;
CurrentDownload.SizeFormated := Self.GetSizeName(objHTTP.Response.ContentLength);
CurrentDownload.URL[0] := aURL;
CurrentDownload.URL[1] := copy(
copy(aURL, 8, length(aURL)),
0,
Pos('
/', copy(
aURL,
8
,
length(aURL)
)
)-1
);
CurrentDownload.URL[2] := copy(
aURL,
length(aURL) - (
Pos(
'
/',
AnsiReverseString(aURL)
)-1
) + 1,
length(aURL)
);
// Ereigniss : DownloadBegin aufrufen - falls definiert
if @DownloadBegin <>
nil then
DownloadBegin(CurrentDownload);
// ProcessMessages falls Property gesetzt
if bolAppProcessMsg
then
Application.ProcessMessages;
// Download in Stream laden
objHTTP.Get(aURL, DownloadStream);
// Ereigniss : DownloadEnd aufrufen - falls definiert
if @DownloadEnd <>
nil then
DownloadEnd(CurrentDownload);
// ProcessMessages falls Property gesetzt
if bolAppProcessMsg
then
Application.ProcessMessages;
// Stream als Datei speichern
DownloadStream.SaveToFile(aDest);
except
// Rückgabewert setzen - Fehler ist aufgetreten
result := false;
end;
// Aufräumen
DownloadStream.Free;
//Self.ClearCurrentDownload;
end;
function THTTPDownloader.GetURLFileSize(aURL :
string) : int64;
begin
// Versuche Header Informationen abzufragen
try
// Ermittle HeadderInformationen
objHTTP.Head(aURL);
// ProcessMessages falls Property gesetzt
if bolAppProcessMsg
then
Application.ProcessMessages;
// Lese HeaderInformationen in Rückgabewert
result := objHTTP.Response.ContentLength;
except
// Falls ein Fehler auftritt, ist der Rückgabewert -1
result := -1;
end;
end;
// =============================================================================
// Private
// =============================================================================
procedure THTTPDownloader.ClearCurrentDownload;
begin
// Record auf Standartwerte zurücksetzen
CurrentDownload.Size := 0;
CurrentDownload.SizeFormated := '
';
CurrentDownload.ID := 0;
CurrentDownload.Count := 0;
CurrentDownload.Downloaded := 0;
CurrentDownload.DownloadedFormated := '
';
CurrentDownload.DownloadedPercent := 0;
CurrentDownload.URL[0] := '
';
CurrentDownload.URL[1] := '
';
CurrentDownload.URL[2] := '
';
end;
procedure THTTPDownloader.DownloadOnWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
intRate : integer;
begin
// Standartwer falls Property nicht gesetzt = 2, urNormal
intRate := 2;
// urUpdateRate auswählen
case urUpdateRate
of
urFast :
begin intRate := 1;
end;
urNormal :
begin intRate := 2;
end;
urSlow :
begin intRate := 3;
end;
end;
// Funktion verlassen falls Rate nicht zutrifft und AWorkCount == CurrentDownload.Size
if (
not(AWorkCount = CurrentDownload.Size))
and
((AWorkCount
mod intRate) <> 0)
then exit;
// Ereigniss : DownloadWork aufrufen - falls definiert
if @DownloadWork <>
nil then
begin
// Record.Downloaded setzen
CurrentDownload.Downloaded := AWorkCount;
CurrentDownload.DownloadedPercent := round((AWorkCount / CurrentDownload.Size) * 100);
CurrentDownload.DownloadedFormated := Self.GetSizeName(AWorkCount);
// Ereigniss DownloadWork
DownloadWork(CurrentDownload);
// ProcessMessages falls Property gesetzt
if bolAppProcessMsg
then
Application.ProcessMessages;
end;
end;
function THTTPDownloader.GetSizeName(
const Size : int64):
String;
begin
Result := '
Error';
if Size = -1
then exit;
if Size < 1024
then
begin
Result := inttostr(Size)+'
Byte';
exit;
end;
if (1024 <= Size)
and (Size < 1048576)
then
begin
Result := floattostr((round((Size/1024)*100))/100)+'
KB';
exit;
end;
if (1048576 <= Size)
and (Size < 1099511627776)
then
begin
Result := floattostr((round((Size/1048576)*100))/100)+'
MB';
exit;
end;
if Size > 1099511627776
then
begin
Result := floattostr((round((Size/1099511627776)*100))/100)+'
GB';
end;
end;
end.