Sencillo gestor de descargas en Delphi
Hace poco me dispuse a crear un programa que usara actualizaciones automáticas para evitar el tedioso trabajo de actualizar las nuevas versiones de manera manual y el primer problema que se presento fue el de descargar uno o múltiples archivos desde mi web sin morir en el intento al trabajar directamente con la librería WinInet de Delphi. Para evitar esto he usado la unidad ExtActns que contiene la clase TDownloadURL lo que facilita mucho el trabajo aunque tiene algunos inconvenientes como el de no contar con métodos para pausar o resumir las descargas.
 |
  |
El ejemplo que dejo aquí muestra como trabajar con varias descargas simultáneas empleando Threads (usando la librería BMDThread) o hilos mostrando la velocidad, progreso y avance de la descarga en KB’s; haciendo uso de la clase que he creado llamada DownloadManager contenida en uDownloadManager.pas.
El uso de la clase es sencillo. Primero necesitaremos añadir la clase a nuestro Unit actual con la cláusula “uses”: DownloadManager
Para crear/inicializar/comenzar la clase de descargas basta con ejecutar el siguiente código:
var
Downloads: TDownloadManager;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Not Assigned(Downloads) then
Downloads := TDownloadManager.Create(6); //6 descargas simultaneas maximo
Downloads.addDownload(‘www.pagina.com/archivo.zip’,’C:\’);
Downloads.start;
end;
Downloads: TDownloadManager;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Not Assigned(Downloads) then
Downloads := TDownloadManager.Create(6); //6 descargas simultaneas maximo
Downloads.addDownload(‘www.pagina.com/archivo.zip’,’C:\’);
Downloads.start;
end;
El método Create acepta como parámetro el número de descargas simultáneas máximas (por defecto se asigna 3 si no se especifica). Y finalmente si queremos mostrar la información sobre su estado basta con poner un Timer y acceder a los datos de cada descarga atravez de un ciclo usando el puntero PDownload para recorrerlo.
Aquí el código de la unidad uDownloadManager.pas
(*
*
* Nombre: uDownloadManager.pas
* Fecha: Jueves 16 de Julio del 2009
* Autor: Iván Juárez Núñez
* eMail: radix@redmater.com
* Pagina: www.redmater.com
*
* Unidad de código para administrar multiples descargas haciendo uso de la clase
* TDownloadURL encontrada en la unidad ExtActns
*
* Este codigo se ofrece sin ninguna garantia y puede ser usado/modificado/redistribuido
* con la unica condicion de incluir al autor en sus creditos.
*)
unit uDownloadManager;
interface
uses idURI, SysUtils, BMDThread, ExtActns, Classes, StrUtils, DateUtils;
type
TDownload = record
url: string;
dirDest: string;
fileName: string;
fileSize: Int64;
totalFetched:Int64;
lastFetched: Int64;
running: boolean;
finished: boolean;
failed: boolean;
queue: boolean;
progress: byte;
speed: integer;
lastUpdate: TDateTime; //Para calcular velocidad de descarga
thread: TBMDThread;
worker: TDownloadURL;
end;
PDownload = ^TDownload;
type
TDownloadManager = class
private
MaxDownloads: byte;
ActiveDownloads: byte;
function getFileNameURL(url:string):string;
function checkDuplicateFile(FilePath:string):string;
procedure refreshList;
procedure DownloadThread(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
procedure DownloadThreadFinished(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
procedure DownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal;
StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean) ;
published
DownloadList: TList;
procedure addDownload(url:string; destPath:string);
procedure start;
constructor Create(DownloadLimit: Byte = 3);
end;
implementation
constructor TDownloadManager.Create(DownloadLimit: Byte = 3);
begin
MaxDownloads := DownloadLimit;
ActiveDownloads := 0;
DownloadList := TList.Create;
end;
{Obtiene el nombre del archivo desde una URL de descarga}
function TDownloadManager.getFileNameURL(url:string):string;
var
i:integer;
Begin
result := url;
if Length(url)>0 then
Begin
url := TidURI.URLDecode(url); {Indy Library to Decode URL in idURI}
i := LastDelimiter('/', url);
Result := Copy(url, i + 1, Length(url) - (i));
End;
End;
procedure TDownloadManager.start;
begin
RefreshList;
end;
{Busca por un archivo duplicado en la misma ruta
si el archivo ya existe, devuelve un nombre modificado
para el nombre del archivo agregando un numero al final}
function TDownloadManager.checkDuplicateFile(FilePath:string):string;
var
fileName, ext, path:string;
tmpName: string;
numFile:integer;
Begin
//Separamos el archivo por nombre y extension
path := ExtractFilePath(FilePath);
ext := ExtractFileExt(FilePath);
fileName := AnsiReplaceStr(ExtractFileName(FilePath), ext,'');
tmpName := fileName;
numFile := 2;
Repeat
if FileExists(path+tmpName+ext) then
Begin
tmpName := fileName+' ('+intToStr(numFile)+')';
inc(numFile);
End;
Until Not FileExists(path+tmpName+ext);
result := tmpName+ext;
End;
{Agrega una nueva descarga al gestor de descargas}
procedure TDownloadManager.addDownload(url:string; destPath:string);
var
Download: PDownload;
Begin
new(Download);
Download^.url := url;
Download^.dirDest := destPath;
Download^.fileName := checkDuplicateFile(destPath+getFileNameURL(url));
Download^.fileSize := 0;
Download^.progress := 0;
Download^.totalFetched:= 0;
Download^.lastFetched:= 0;
Download^.running := false;
Download^.finished := false;
Download^.failed := false;
Download^.queue := true;
Download^.speed := 0;
Download^.lastUpdate := now;
Download^.thread := TBMDThread.Create(nil);
Download^.thread.OnExecute := DownloadThread;
Download^.thread.OnTerminate := DownloadThreadFinished;
Download^.worker := TDownloadURL.Create(nil);
Download^.worker.OnDownloadProgress := DownloadProgress;
Download^.worker.Caption := destPath+Download^.fileName;
Download^.worker.Filename := destPath+Download^.fileName;
Download^.worker.URL := url;
DownloadList.Add(Download);
End;
procedure TDownloadManager.RefreshList;
var
i: Integer;
Download: PDownload;
Begin
for i := 0 to DownloadList.Count - 1 do
Begin
Download := DownloadList[i];
if (ActiveDownloads < MaxDownloads) then
Begin
if (Not Download^.running) AND (Not Download^.finished) AND (Download^.queue) then
Begin
Download^.queue := false;
Download^.thread.Start;
inc(ActiveDownloads);
End;
End;
End;
End;
procedure TDownloadManager.DownloadThread(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
var
i: Integer;
Download: PDownload;
Begin
Download := nil;
for i := 0 to DownloadList.Count - 1 do
Begin
Download := DownloadList[i];
if (Not Download^.queue) AND (Not Download^.running) AND (Not Download^.finished) then
Begin
Download^.running := true;
Break;
End else
Begin
Download := nil;
End;
End;
if Download<>nil then
Begin
try
Download^.lastUpdate := now;
try
Download^.worker.ExecuteTarget(nil);
except
On E:Exception do
Begin
Download^.failed := true;
Download^.running := false;
Download^.queue := false;
Download^.finished := true;
End;
end;
finally
Download^.worker.Free;
end;
End;
End;
procedure TDownloadManager.DownloadThreadFinished(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
Begin
RefreshList;
End;
{Evento para actualizar progreso de Archivo}
procedure TDownloadManager.DownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal;
StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean);
var
Download: PDownload;
deltaDownloaded: Int64;
I: Integer;
Begin
Download := nil;
for I := 0 to DownloadList.Count - 1 do
Begin
Download := DownloadList[I];
if (Download^.dirDest+Download^.fileName = Sender.Caption) then
Begin
if (Progress>0) then
Begin
Download^.fileSize:= Round(ProgressMax/1024);
Download^.totalFetched := Round(Progress / 1024);
Download^.progress := Round((Progress/ProgressMax)*100);
DeltaDownloaded:= Progress - Download^.lastFetched;
//Calculamos velocidad en cada 50 KB's bajados
if DeltaDownloaded>51200 then
Begin
if SecondSpan(now,Download^.lastUpdate)>0 then
Begin
Download^.speed := Round(DeltaDownloaded/1024/SecondSpan(now,Download^.lastUpdate));
Download^.lastUpdate := now;
Download^.lastFetched := Progress;
End;
End;
if (Progress = ProgressMax) and (ProgressMax>0) then
Begin
Download^.finished := true;
Download^.running := false;
dec(ActiveDownloads);
End;
End;
End;
End;
End;
end.
*
* Nombre: uDownloadManager.pas
* Fecha: Jueves 16 de Julio del 2009
* Autor: Iván Juárez Núñez
* eMail: radix@redmater.com
* Pagina: www.redmater.com
*
* Unidad de código para administrar multiples descargas haciendo uso de la clase
* TDownloadURL encontrada en la unidad ExtActns
*
* Este codigo se ofrece sin ninguna garantia y puede ser usado/modificado/redistribuido
* con la unica condicion de incluir al autor en sus creditos.
*)
unit uDownloadManager;
interface
uses idURI, SysUtils, BMDThread, ExtActns, Classes, StrUtils, DateUtils;
type
TDownload = record
url: string;
dirDest: string;
fileName: string;
fileSize: Int64;
totalFetched:Int64;
lastFetched: Int64;
running: boolean;
finished: boolean;
failed: boolean;
queue: boolean;
progress: byte;
speed: integer;
lastUpdate: TDateTime; //Para calcular velocidad de descarga
thread: TBMDThread;
worker: TDownloadURL;
end;
PDownload = ^TDownload;
type
TDownloadManager = class
private
MaxDownloads: byte;
ActiveDownloads: byte;
function getFileNameURL(url:string):string;
function checkDuplicateFile(FilePath:string):string;
procedure refreshList;
procedure DownloadThread(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
procedure DownloadThreadFinished(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
procedure DownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal;
StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean) ;
published
DownloadList: TList;
procedure addDownload(url:string; destPath:string);
procedure start;
constructor Create(DownloadLimit: Byte = 3);
end;
implementation
constructor TDownloadManager.Create(DownloadLimit: Byte = 3);
begin
MaxDownloads := DownloadLimit;
ActiveDownloads := 0;
DownloadList := TList.Create;
end;
{Obtiene el nombre del archivo desde una URL de descarga}
function TDownloadManager.getFileNameURL(url:string):string;
var
i:integer;
Begin
result := url;
if Length(url)>0 then
Begin
url := TidURI.URLDecode(url); {Indy Library to Decode URL in idURI}
i := LastDelimiter('/', url);
Result := Copy(url, i + 1, Length(url) - (i));
End;
End;
procedure TDownloadManager.start;
begin
RefreshList;
end;
{Busca por un archivo duplicado en la misma ruta
si el archivo ya existe, devuelve un nombre modificado
para el nombre del archivo agregando un numero al final}
function TDownloadManager.checkDuplicateFile(FilePath:string):string;
var
fileName, ext, path:string;
tmpName: string;
numFile:integer;
Begin
//Separamos el archivo por nombre y extension
path := ExtractFilePath(FilePath);
ext := ExtractFileExt(FilePath);
fileName := AnsiReplaceStr(ExtractFileName(FilePath), ext,'');
tmpName := fileName;
numFile := 2;
Repeat
if FileExists(path+tmpName+ext) then
Begin
tmpName := fileName+' ('+intToStr(numFile)+')';
inc(numFile);
End;
Until Not FileExists(path+tmpName+ext);
result := tmpName+ext;
End;
{Agrega una nueva descarga al gestor de descargas}
procedure TDownloadManager.addDownload(url:string; destPath:string);
var
Download: PDownload;
Begin
new(Download);
Download^.url := url;
Download^.dirDest := destPath;
Download^.fileName := checkDuplicateFile(destPath+getFileNameURL(url));
Download^.fileSize := 0;
Download^.progress := 0;
Download^.totalFetched:= 0;
Download^.lastFetched:= 0;
Download^.running := false;
Download^.finished := false;
Download^.failed := false;
Download^.queue := true;
Download^.speed := 0;
Download^.lastUpdate := now;
Download^.thread := TBMDThread.Create(nil);
Download^.thread.OnExecute := DownloadThread;
Download^.thread.OnTerminate := DownloadThreadFinished;
Download^.worker := TDownloadURL.Create(nil);
Download^.worker.OnDownloadProgress := DownloadProgress;
Download^.worker.Caption := destPath+Download^.fileName;
Download^.worker.Filename := destPath+Download^.fileName;
Download^.worker.URL := url;
DownloadList.Add(Download);
End;
procedure TDownloadManager.RefreshList;
var
i: Integer;
Download: PDownload;
Begin
for i := 0 to DownloadList.Count - 1 do
Begin
Download := DownloadList[i];
if (ActiveDownloads < MaxDownloads) then
Begin
if (Not Download^.running) AND (Not Download^.finished) AND (Download^.queue) then
Begin
Download^.queue := false;
Download^.thread.Start;
inc(ActiveDownloads);
End;
End;
End;
End;
procedure TDownloadManager.DownloadThread(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
var
i: Integer;
Download: PDownload;
Begin
Download := nil;
for i := 0 to DownloadList.Count - 1 do
Begin
Download := DownloadList[i];
if (Not Download^.queue) AND (Not Download^.running) AND (Not Download^.finished) then
Begin
Download^.running := true;
Break;
End else
Begin
Download := nil;
End;
End;
if Download<>nil then
Begin
try
Download^.lastUpdate := now;
try
Download^.worker.ExecuteTarget(nil);
except
On E:Exception do
Begin
Download^.failed := true;
Download^.running := false;
Download^.queue := false;
Download^.finished := true;
End;
end;
finally
Download^.worker.Free;
end;
End;
End;
procedure TDownloadManager.DownloadThreadFinished(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
Begin
RefreshList;
End;
{Evento para actualizar progreso de Archivo}
procedure TDownloadManager.DownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal;
StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean);
var
Download: PDownload;
deltaDownloaded: Int64;
I: Integer;
Begin
Download := nil;
for I := 0 to DownloadList.Count - 1 do
Begin
Download := DownloadList[I];
if (Download^.dirDest+Download^.fileName = Sender.Caption) then
Begin
if (Progress>0) then
Begin
Download^.fileSize:= Round(ProgressMax/1024);
Download^.totalFetched := Round(Progress / 1024);
Download^.progress := Round((Progress/ProgressMax)*100);
DeltaDownloaded:= Progress - Download^.lastFetched;
//Calculamos velocidad en cada 50 KB's bajados
if DeltaDownloaded>51200 then
Begin
if SecondSpan(now,Download^.lastUpdate)>0 then
Begin
Download^.speed := Round(DeltaDownloaded/1024/SecondSpan(now,Download^.lastUpdate));
Download^.lastUpdate := now;
Download^.lastFetched := Progress;
End;
End;
if (Progress = ProgressMax) and (ProgressMax>0) then
Begin
Download^.finished := true;
Download^.running := false;
dec(ActiveDownloads);
End;
End;
End;
End;
End;
end.
Y aquí el modo de empleo desde un form:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, FileCtrl, ExtCtrls, uDownloadManager;
type
TForm1 = class(TForm)
txUrl: TEdit;
lbUrl: TLabel;
Button1: TButton;
Label1: TLabel;
txDirectory: TEdit;
Button2: TButton;
OpenDialog1: TOpenDialog;
Timer1: TTimer;
ListView1: TListView;
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
public
Downloads: TDownloadManager;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if Not Assigned(Downloads) then
Downloads := TDownloadManager.Create();
Downloads.addDownload(txUrl.Text,txDirectory.Text);
Downloads.start;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
directory:string;
begin
if SelectDirectory('Selecciona un directorio para guardar el archivo destino','C:\',directory) then
txDirectory.Text := directory+'\';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Download : PDownload;
i: integer;
begin
ListView1.Clear;
if Assigned(Downloads) then
Begin
for i := 0 to Downloads.DownloadList.Count - 1 do
Begin
Download := Downloads.DownloadList[i];
With ListView1.Items.Add Do
Begin
Caption := Download^.fileName;
SubItems.Add(IntToStr(Download^.totalFetched)+ ' de ' +IntToStr(Download.fileSize)+'KB');
if Download^.running then
Begin
SubItems.Add('Descargando');
end else
Begin
if Download^.finished then
SubItems.Add('Completado')
else
if Download^.failed then
SubItems.Add('Error')
else
SubItems.Add('En cola');
End;
SubItems.Add(InttoStr(Download^.speed)+' kb/seg');
SubItems.Add(InttoStr(Download^.progress)+ '%');
End;
End;
End;
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, FileCtrl, ExtCtrls, uDownloadManager;
type
TForm1 = class(TForm)
txUrl: TEdit;
lbUrl: TLabel;
Button1: TButton;
Label1: TLabel;
txDirectory: TEdit;
Button2: TButton;
OpenDialog1: TOpenDialog;
Timer1: TTimer;
ListView1: TListView;
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
public
Downloads: TDownloadManager;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if Not Assigned(Downloads) then
Downloads := TDownloadManager.Create();
Downloads.addDownload(txUrl.Text,txDirectory.Text);
Downloads.start;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
directory:string;
begin
if SelectDirectory('Selecciona un directorio para guardar el archivo destino','C:\',directory) then
txDirectory.Text := directory+'\';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Download : PDownload;
i: integer;
begin
ListView1.Clear;
if Assigned(Downloads) then
Begin
for i := 0 to Downloads.DownloadList.Count - 1 do
Begin
Download := Downloads.DownloadList[i];
With ListView1.Items.Add Do
Begin
Caption := Download^.fileName;
SubItems.Add(IntToStr(Download^.totalFetched)+ ' de ' +IntToStr(Download.fileSize)+'KB');
if Download^.running then
Begin
SubItems.Add('Descargando');
end else
Begin
if Download^.finished then
SubItems.Add('Completado')
else
if Download^.failed then
SubItems.Add('Error')
else
SubItems.Add('En cola');
End;
SubItems.Add(InttoStr(Download^.speed)+' kb/seg');
SubItems.Add(InttoStr(Download^.progress)+ '%');
End;
End;
End;
end;
end.
Deja un comentario...