initial commit from lost SVN repo
This commit is contained in:
fatalerrors
518
common/udownloadmanager.pas
Normal file
518
common/udownloadmanager.pas
Normal file
@@ -0,0 +1,518 @@
|
||||
{
|
||||
********************************************************************************
|
||||
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user