519 lines
15 KiB
ObjectPascal
519 lines
15 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui
|
|
Copyright (C) 2012-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
Copyright (C) <date> <add your name and mail address here>
|
|
|
|
http://www.geoffray-levasseur.org/
|
|
http://0.tuxfamilly.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
full download manager class
|
|
|
|
********************************************************************************
|
|
}
|
|
unit uDownloadManager;
|
|
|
|
{$include defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, uDownload, ExtCtrls;
|
|
|
|
type
|
|
TProxy = record
|
|
Address: string;
|
|
Port: Integer;
|
|
User: string;
|
|
Pass: string;
|
|
end;
|
|
|
|
TDownloadListLoop = class(TThread)
|
|
private
|
|
FOnNextFile: TDownloadProc;
|
|
FOnTerminate: TDownloadProc;
|
|
FOnProgress: TDownloadProc;
|
|
FOnError: TDownloadProc;
|
|
FOnNewDownload: TDownloadProc;
|
|
public
|
|
FTargetDir: string;
|
|
PDownloadIndex: ^Integer;
|
|
PDownloadList: ^TStringList;
|
|
PDownloader: ^TDownloader;
|
|
constructor Create; virtual;
|
|
procedure Execute; override;
|
|
property OnNextFile: TDownloadProc read FOnNextFile write FOnNextFile;
|
|
property OnTerminate: TDownloadProc read FOnTerminate write FOnTerminate;
|
|
property OnProgress: TDownloadProc read FOnProgress write FOnProgress;
|
|
property OnError: TDownloadProc read FOnError write FOnError;
|
|
property OnNewDownload: TDownloadProc read FOnNewDownload
|
|
write FOnNewDownload;
|
|
end;
|
|
|
|
TStateChangeEvent = procedure(Sender: TObject;
|
|
var State: TDownloadResult) of object;
|
|
|
|
TDownloadManager = class(TComponent)
|
|
private
|
|
FOnCreate: TNotifyEvent;
|
|
FOnDestroy: TNotifyEvent;
|
|
FOnNextFile: TNotifyEvent;
|
|
FOnNewDownload: TNotifyEvent;
|
|
FOnProgress: TNotifyEvent;
|
|
FOnError: TNotifyEvent;
|
|
FOnStartDownload: TNotifyEvent;
|
|
FOnEndDownload: TNotifyEvent;
|
|
FOnCalcSpeeds: TNotifyEvent;
|
|
FOnGetSize: TNotifyEvent;
|
|
FOnStateChange: TStateChangeEvent;
|
|
FOnCancelFile: TNotifyEvent;
|
|
FOnCancelAll: TNotifyEvent;
|
|
FDownloadList: TStringList;
|
|
FErrorList: TStringList;
|
|
FDwlLoop: TDownloadListLoop;
|
|
FDestination: string;
|
|
FTotalSize: LongInt;
|
|
FFileSize: LongInt;
|
|
FTotalDownloadedSize: LongInt;
|
|
FDwlSizeSum: LongInt;
|
|
FFileDownloadedSize: LongInt;
|
|
FPause: Boolean;
|
|
FDownloadIndex: Integer;
|
|
FDownloader: TDownloader;
|
|
FState, FOldState: TDownloadResult;
|
|
FCurrentSpeed: LongInt; // calculated every seconds in B/s
|
|
FTotalTime: LongInt; //in seconds
|
|
FFileTime: LongInt;
|
|
FFileMaxSpeed: LongInt;
|
|
FFileMinSpeed: LongInt;
|
|
FFileAverageSpeed: LongInt;
|
|
FTotalMaxSpeed: LongInt;
|
|
FTotalMinSpeed: LongInt;
|
|
FTotalAverageSpeed: LongInt;
|
|
FTimer: TTimer; // used to calculate speeds
|
|
FHttpProxy: TProxy;
|
|
FFtpProxy: TProxy;
|
|
FFtpUser: string;
|
|
FFtpPassword: string;
|
|
FDownloaderStatusText: string;
|
|
procedure ResetFileVars;
|
|
procedure DwlNextFile;
|
|
procedure DwlTerminate;
|
|
procedure DwlProgress;
|
|
procedure DwlError;
|
|
procedure DwlNewFile;
|
|
procedure CheckState;
|
|
procedure SetDwlList(Value: TStringList);
|
|
procedure SetDownloadIndex(Value: Integer);
|
|
procedure TimerExecute(Sender: TObject);
|
|
procedure DownloadFeedback(Txt: string);
|
|
public
|
|
constructor Create(AOwner: TComponent); virtual;
|
|
destructor Destroy; override;
|
|
procedure Cancel(OnlyCurrent: Boolean);
|
|
procedure StartDownload;
|
|
function GetFileSize(Index: integer): LongInt;
|
|
procedure GetTotalSize;
|
|
procedure Pause;
|
|
property DownloadList: TStringList read FDownloadList write SetDwlList;
|
|
property DownloadIndex: Integer read FDownloadIndex write SetDownLoadIndex;
|
|
property ErrorList: TStringList read FErrorList;
|
|
property Destination: string read FDestination write FDestination;
|
|
property Status: TDownloadResult read FState;
|
|
property TotalSize: LongInt read FTotalSize;
|
|
property CurrentSpeed: LongInt read FCurrentSpeed;
|
|
property FileDownloadedSize: LongInt read FFileDownloadedSize;
|
|
property FileMinSpeed: LongInt read FFileMinSpeed;
|
|
property FileMaxSpeed: LongInt read FFileMaxSpeed;
|
|
property FileAverageSpeed: LongInt read FFileAverageSpeed;
|
|
property TotalDownloadedSize: LongInt read FTotalDownloadedSize;
|
|
property TotalMinSpeed: LongInt read FTotalMinSpeed;
|
|
property TotalMaxSpeed: LongInt read FTotalMaxSpeed;
|
|
property TotalAverageSpeed: LongInt read FTotalAverageSpeed;
|
|
property DownloaderStatus: string read FDownloaderStatusText;
|
|
property HttpProxy: TProxy read FHttpProxy write FHttpProxy;
|
|
property FtpProxy: TProxy read FFtpProxy write FFtpProxy;
|
|
property FtpUser: string read FFtpUser write FFtpUser;
|
|
property FtpPassword: string read FFtpPassword write FFtpPassword;
|
|
property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
|
|
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
|
|
property OnNextFile: TNotifyEvent read FOnNextFile write FOnNextFile;
|
|
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
|
property OnNewDownload: TNotifyEvent read FOnNewDownload
|
|
write FOnNewDownload;
|
|
property OnError: TNotifyEvent read FOnError write FOnError;
|
|
property OnCalcSpeeds: TNotifyEvent read FOnCalcSpeeds write FOnCalcSpeeds;
|
|
property OnStartDownload: TNotifyEvent read FOnStartDownload
|
|
write FOnStartDownload;
|
|
property OnEndDownload: TNotifyEvent read FOnEndDownload
|
|
write FOnEndDownload;
|
|
property OnGetSize: TNotifyEvent read FOnGetSize write FOnGetSize;
|
|
property OnStateChange: TStateChangeEvent read FOnStateChange
|
|
write FOnStateChange;
|
|
property OnCancelFile: TNotifyEvent read FOnCancelFile write FOnCancelFile;
|
|
property OnCancelAll: TNotifyEvent read FOnCancelAll write FOnCancelAll;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
uDebug, uStrings;
|
|
|
|
constructor TDownloadListLoop.Create;
|
|
begin
|
|
FreeOnTerminate := True;
|
|
inherited Create(True);
|
|
end;
|
|
|
|
|
|
procedure TDownloadListLoop.Execute;
|
|
var
|
|
I, J: integer;
|
|
begin
|
|
PrintLnDbg(rsDebugDownloadListLoopStarted);
|
|
try
|
|
while PDownloadIndex^ <= PDownloadList^.Count - 1 do
|
|
begin
|
|
if Terminated then
|
|
Break;
|
|
if PDownloadIndex^ < 0 then
|
|
begin
|
|
PrintLnDbg(Format(rsErrorDownloadIndex, [PDownloadIndex^]), vlLow);
|
|
Exit;
|
|
end;
|
|
if Assigned(FOnNewDownload) then
|
|
Synchronize(FOnNewDownload);
|
|
PDownloader^.StartDownload;
|
|
repeat
|
|
if Assigned(FOnProgress) then
|
|
Synchronize(FOnProgress);
|
|
until (PDownloader^.State = drDone) or (PDownloader^.State = drError) or
|
|
(PDownloader^.State = drCanceled);
|
|
if PDownloader^.State = drError then
|
|
if Assigned(FOnError) then
|
|
Synchronize(FOnError); //downloading again needs manual index management
|
|
if PDownloadIndex^ < 0 then //in case of cancellation
|
|
Break;
|
|
if Assigned(FOnNextFile) then
|
|
Synchronize(FOnNextFile) //manual management of download index
|
|
else
|
|
Inc(PDownloadIndex^); //or automatic (forced)
|
|
end;
|
|
if Assigned(FOnTerminate) then
|
|
Synchronize(FOnTerminate);
|
|
except
|
|
on E: Exception do
|
|
heHandleException.ThreadException(E, Self);
|
|
end;
|
|
PrintLnDbg(rsDebugDownloadListLoopStopped);
|
|
end;
|
|
|
|
|
|
constructor TDownloadManager.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDownloader := TDownloader.Create;
|
|
FDownloadList := TStringList.Create;
|
|
FErrorList := TStringList.Create;
|
|
FTimer := TTimer.Create(nil);
|
|
FTimer.Interval := 1000;
|
|
FTimer.Enabled := False;
|
|
FTimer.OnTimer := @TimerExecute;
|
|
FFtpPassword := '';
|
|
FFtpUser := '';
|
|
FHttpProxy.Address := '';
|
|
FHttpProxy.Port := 0;
|
|
FHttpProxy.User := '';
|
|
FHttpProxy.Pass := '';
|
|
FFtpProxy.Address := '';
|
|
FFtpProxy.Port := 0;
|
|
FFtpProxy.User := '';
|
|
FFtpProxy.Pass := '';
|
|
FDownloadIndex := -1;
|
|
FDestination := '';
|
|
ResetFileVars;
|
|
FTotalDownloadedSize := 0;
|
|
FTotalSize := 0;
|
|
FTotalTime := 0;
|
|
FTotalAverageSpeed := 0;
|
|
FTotalMaxSpeed := 0;
|
|
FTotalMinSpeed := 0;
|
|
FCurrentSpeed := 0;
|
|
FState := drNone;
|
|
FDownloader.OnFeedback := @DownloadFeedback;
|
|
FDownloaderStatusText := '';
|
|
if Assigned(FOnCreate) then
|
|
FOnCreate(Self);
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.DownloadFeedback(Txt: string);
|
|
begin
|
|
FDownloaderStatusText := Txt;
|
|
{$IFDEF Debug}
|
|
PrintLnDbg(rsDebugDownloadFeedback + Txt, vlHigh);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
destructor TDownloadManager.Destroy;
|
|
begin
|
|
if Assigned(FOnDestroy) then
|
|
FOnDestroy(Self);
|
|
if (FState = drDownloading) or (FState = drPaused) then
|
|
FDownloader.Cancel;
|
|
FDownloader.Free;
|
|
FDownloadList.Free;
|
|
FTimer.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.CheckState;
|
|
begin
|
|
if FState <> FDownloader.State then
|
|
begin
|
|
FState := FDownloader.State;
|
|
if Assigned(FOnStateChange) then
|
|
FOnStateChange(Self, FState);
|
|
end;
|
|
end;
|
|
|
|
procedure TDownloadManager.ResetFileVars;
|
|
begin
|
|
FFileTime := 0;
|
|
FFileSize := 0;
|
|
FFileAverageSpeed := 0;
|
|
FFileMaxSpeed := 0;
|
|
FFileMinSpeed := 0;
|
|
FFileDownloadedSize := 0;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.DwlNextFile;
|
|
begin
|
|
CheckState;
|
|
if (FState = drDone) or (FState = drError) then
|
|
begin
|
|
FTimer.Enabled := False;
|
|
FDwlSizeSum := FDwlSizeSum + FFileSize;
|
|
if Assigned(FOnNextFile) then
|
|
FOnNextFile(Self)
|
|
else
|
|
Inc(FDownloadIndex);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.DwlTerminate;
|
|
begin
|
|
CheckState;
|
|
ResetFileVars;
|
|
if Assigned(FOnEndDownload) then
|
|
FOnEndDownload(Self);
|
|
FDwlLoop.OnError := nil;
|
|
FDwlLoop.OnNewDownload := nil;
|
|
FDwlLoop.OnNextFile := nil;
|
|
FDwlLoop.OnProgress := nil;
|
|
FDwlLoop.OnTerminate := nil;
|
|
FDownloaderStatusText := '';
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.DwlProgress;
|
|
begin
|
|
CheckState;
|
|
FFileDownloadedSize := FDownloader.DownloadedSize;
|
|
FTotalDownloadedSize := FDwlSizeSum + FFileDownloadedSize;
|
|
if Assigned(FOnProgress) then
|
|
FOnProgress(Self);
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.DwlError;
|
|
begin
|
|
FErrorList.Add(FDownloadList[FDownloadIndex]);
|
|
if Assigned(FOnError) then
|
|
FOnError(Self);
|
|
FDownloaderStatusText := '';
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.DwlNewFile;
|
|
begin
|
|
ResetFileVars;
|
|
if Assigned(FOnNewDownload) then
|
|
FOnNewDownload(Self);
|
|
FDownloader.URL := FDownloadList[FDownloadIndex];
|
|
FFileSize := FDownloader.FileSize;
|
|
FTimer.Enabled := True;
|
|
FDownloader.SaveToFile := FDestination;
|
|
FDownloader.FtpUserName := FFtpUser;
|
|
FDownloader.FtpPassword := FFtpPassword;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.SetDwlList(Value: TStringList);
|
|
begin
|
|
if Value <> FDownloadList then
|
|
if (FState = drDownloading) or (FState = drPaused) then
|
|
begin
|
|
raise
|
|
Exception.Create('Can''t change of StringList while downloading.');
|
|
Exit;
|
|
end else
|
|
FDownloadList := Value;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.SetDownloadIndex(Value: integer);
|
|
begin
|
|
if (FState = drDownloading) or (FState = drPaused) then
|
|
begin
|
|
raise
|
|
Exception.Create('Can''t change index while downloading.');
|
|
Exit;
|
|
end;
|
|
FDownloadIndex := Value;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.Cancel(OnlyCurrent: Boolean);
|
|
begin
|
|
if (FState = drDownloading) or (FState = drPaused) then
|
|
if OnlyCurrent then
|
|
begin
|
|
FDownloader.Cancel;
|
|
if Assigned(FOnCancelFile) then
|
|
FOnCancelFile(Self);
|
|
end else
|
|
begin
|
|
FDownloadIndex := -1;
|
|
FDwlLoop.OnError := nil;
|
|
FDwlLoop.OnNewDownload := nil;
|
|
FDwlLoop.OnNextFile := nil;
|
|
FDwlLoop.OnProgress := nil;
|
|
FDwlLoop.OnTerminate := nil;
|
|
FDownloader.Cancel;
|
|
end;
|
|
FDownloaderStatusText := '';
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.StartDownload;
|
|
begin
|
|
FTotalDownloadedSize := 0;
|
|
FTotalSize := 0;
|
|
FTotalTime := 0;
|
|
FTotalAverageSpeed := 0;
|
|
FTotalMaxSpeed := 0;
|
|
FTotalMinSpeed := 0;
|
|
FCurrentSpeed := 0;
|
|
if DownloadList.Count > 0 then
|
|
begin
|
|
FDownloader.HttpProxy := FHttpProxy.Address;
|
|
FDownloader.HttpProxyPass := FHttpProxy.Pass;
|
|
FDownloader.HttpProxyPort := IntToStr(FHttpProxy.Port);
|
|
FDownloader.HttpProxyUser := FHttpProxy.User;
|
|
FDownloader.FtpFwHost := FFtpProxy.Address;
|
|
FDownloader.FtpFwPort := IntToStr(FFtpProxy.Port);
|
|
FDownloader.FtpFwUserName := FFtpProxy.User;
|
|
FDownloader.FtpFwPassword := FFtpProxy.Pass;
|
|
FErrorList.Clear;
|
|
FDwlLoop := TDownloadListLoop.Create;
|
|
FDwlLoop.OnError := @DwlError;
|
|
FDwlLoop.OnNewDownload := @DwlNewFile;
|
|
FDwlLoop.OnNextFile := @DwlNextFile;
|
|
FDwlLoop.OnProgress := @DwlProgress;
|
|
FDwlLoop.OnTerminate := @DwlTerminate;
|
|
FDwlLoop.PDownloader := @FDownloader;
|
|
FDwlLoop.PDownloadIndex := @FDownloadIndex;
|
|
FDwlLoop.PDownloadList := @FDownloadList;
|
|
if Assigned(FOnStartDownload) then
|
|
FOnStartDownload(Self)
|
|
else
|
|
FDownloadIndex := 0;
|
|
FDwlLoop.PDownloadIndex := @FDownloadIndex;
|
|
FTimer.Enabled := True;
|
|
FDwlLoop.Execute;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDownloadManager.GetFileSize(Index: Integer): LongInt;
|
|
begin
|
|
FDownloader.URL := FDownloadList[Index];
|
|
Result := FDownloader.FileSize;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.GetTotalSize;
|
|
var
|
|
I, Size: Integer;
|
|
begin
|
|
FTotalSize := 0;
|
|
for I := 0 to FDownloadList.Count - 1 do
|
|
try
|
|
Size := GetFileSize(I);
|
|
if (Size < 0) and Assigned(FOnError) then
|
|
FOnError(Self);
|
|
FTotalSize := FTotalSize + Size;
|
|
if Assigned(FOnGetSize) then
|
|
FOnGetSize(Self);
|
|
except
|
|
PrintLnDbg(Format(rsErrorCantGetFileSze, [FDownloadList[I]]), vlLow);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.Pause;
|
|
begin
|
|
CheckState;
|
|
FDownloader.Pause;
|
|
FTimer.Enabled := FDownloader.State <> drDownloading;
|
|
CheckState;
|
|
end;
|
|
|
|
|
|
procedure TDownloadManager.TimerExecute(Sender: TObject);
|
|
begin
|
|
Inc(FTotalTime);
|
|
Inc(FFileTime);
|
|
//do the stuff
|
|
if Assigned(FOnCalcSpeeds) then
|
|
FOnCalcSpeeds(Self);
|
|
end;
|
|
|
|
end.
|
|
|