newtron,
Cita:
Empezado por newtron
...con el componente IDFTP...me surge la necesidad de enviar un fichero con unos 40Mb...el fichero lo envía correctamente...y al finalizar se queda colgado...¿Alguno de vosotros se ha encontrado con ese problema?...
|
Revisa este código:
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, idantifreeze, idftp, IdAntiFreezeBase,
IdTCPClient, IdComponent;
type
TForm1 = class(TForm)
Label1: TLabel;
Label4: TLabel;
txtHost: TEdit;
txtPort: TEdit;
Label5: TLabel;
Label6: TLabel;
txtUsername: TEdit;
txtPassword: TEdit;
Label7: TLabel;
txtFolder: TEdit;
Label8: TLabel;
ListBox1: TListBox;
Memo1: TMemo;
chkMode: TCheckBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
ProgressBar1: TProgressBar;
BitBtn6: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure FTPWork(Sender: TObject; AWorkMode: TWorkMode;const AWorkCount: Integer);
procedure ThreadDone(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
FtpMax : Integer;
ThreadsRunning : Integer;
implementation
{$R *.dfm}
type
TUploaderThread=class(TThread)
private
FFileName : String;
FServer : String;
FPort : Integer;
FPassive : Boolean;
FUser : String;
FPassword : String;
FDestinationDir : String;
FE : Exception;
FSize : Integer;
procedure HandleException;
procedure FinishedUpload;
procedure ProgressFTP;
protected
procedure execute; override;
public
constructor Create(AServer:string; APort:integer; APassive:boolean;
AUser, APassword, ADestinationDir, AFileName:string);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with TIdAntiFreeze.Create(self) do Active:=true;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
openDialog : TOpenDialog;
i : Integer;
begin
openDialog := TOpenDialog.Create(self);
openDialog.InitialDir := GetCurrentDir;
openDialog.Options := [ofFileMustExist, ofAllowMultiSelect];
openDialog.Filter := 'Archivos a FTP Upload|*.*';
openDialog.FilterIndex := 1;
if openDialog.Execute then
begin
for i := 0 to openDialog.Files.Count-1 do
ListBox1.Items.Add(openDialog.Files[i]);
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if ListBox1.ItemIndex = -1 then
Exit
else
ListBox1.DeleteSelected;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
var
i : Integer;
F: File of Byte;
begin
if (txtUsername.Text = '') or (txtPassword.Text = '') or (txtHost.Text = '') then
begin
MessageDlg('Error de Parámetros de Comunicación', mtinformation, [mbok], 0);
Exit;
end;
if ListBox1.Items.count = 0 then
begin
MessageDlg('Lista de FTP Upload Esta Vacía', mtinformation, [mbok], 0);
Exit;
end;
Memo1.Clear;
with TIdFtp.Create(self) do
try
OnWork := FTPWork;
Username := txtUsername.text;
Password := txtPassword.text;
Passive := chkMode.checked;
Host := txtHost.text;
Port := StrToIntDef(txtPort.text, 21);
Connect;
if txtFolder.text <> EmptyStr then
ChangeDir(txtFolder.text);
for i := 0 to ListBox1.Items.count-1 do
begin
try
Application.ProcessMessages;
AssignFile(F, ListBox1.Items[i]);
Reset(F);
ProgressBar1.Max := FileSize(F) div 1024;
CloseFile(F);
Memo1.lines.Add('Iniciando FTP Upload: ' + ListBox1.Items[i]);
Put(ListBox1.Items[i], ExtractFileName(ListBox1.Items[i]),False);
Memo1.lines.Add('Finalizando FTP Upload: ' + ListBox1.Items[i]);
except
on e:exception do
begin
Memo1.lines.Add('Error en FTP Upload: ' + ListBox1.Items[i-1]+': '+e.message);
MessageDlg('Proceso de FTP Upload Finalizo con Error', mtinformation, [mbok], 0);
Exit;
end;
end;
end;
MessageDlg('Proceso de FTP Upload Finalizado', mtinformation, [mbok], 0);
finally
free;
end;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
var
i : integer;
begin
if (txtUsername.text = '') or (txtPassword.text = '') or (txtHost.text = '') then
begin
MessageDlg('Error de Parámetros de Comunicación', mtinformation, [mbok], 0);
Exit;
end;
if ListBox1.Items.count = 0 then
begin
MessageDlg('Lista de FTP Upload Esta Vacía', mtinformation, [mbok], 0);
Exit;
end;
MessageDlg('Envio de Múltiples Archivos Puede Fallar si el Servidor FTP No lo Permite',
mtinformation, [mbok], 0);
Memo1.Clear;
FtpMax := 0;
ThreadsRunning := 0;
for i := 0 to ListBox1.Items.count-1 do
begin
Inc(ThreadsRunning);
Memo1.lines.Add('Iniciando FTP Upload: ' + ListBox1.Items[i]);
TUploaderThread.Create(txtHost.text,
strtointdef(txtPort.text, 21),
chkMode.checked, txtUsername.text,
txtPassword.Text,
txtFolder.Text,
ListBox1.Items[i]);
end;
end;
procedure TForm1.FTPWork(Sender: TObject; AWorkMode: TWorkMode;const AWorkCount: Integer);
begin
ProgressBar1.Position := AWorkCount div 1024;
end;
constructor TUploaderThread.Create(AServer:string; APort:integer; APassive:boolean;
AUser,APassword, ADestinationDir, AFileName: string);
begin
FServer := AServer;
FPort := APort;
FPassive := APassive;
FUser := AUser;
FPassword := APassword;
FDestinationDir := ADestinationDir;
FFileName := AFileName;
OnTerminate := Form1.ThreadDone;
FreeOnTerminate := True;
inherited create(false);
end;
procedure TUploaderThread.ProgressFTP;
begin
form1.ProgressBar1.Max := FtpMax;
end;
procedure TUploaderThread.execute;
var
F: File of byte;
begin
try
with TIdFtp.Create(nil) do
try
OnWork := Form1.FTPWork;
Username := FUser;
Password := FPassword;
Passive := FPassive;
Host := FServer;
Port := FPort;
Connect;
if FDestinationDir <> '' then
ChangeDir(FDestinationDir);
AssignFile(F, FFileName);
Reset(F);
FSize := FileSize(F) div 1024;
FtpMax := FtpMax + FSize;
Synchronize(ProgressFTP);
CloseFile(F);
Put(FFileName, ExtractFileName(FFileName),False);
Synchronize(FinishedUpload);
finally
free;
end;
except
on e:exception do
Synchronize(HandleException);
end;
end;
procedure TUploaderThread.FinishedUpload;
begin
form1.Memo1.lines.Add('Finalizando FTP Upload: ' + FFilename);
form1.ProgressBar1.Position := FTPMax;
end;
procedure TUploaderThread.HandleException;
begin
form1.Memo1.lines.Add('Error en FTP Uploading en ' + FFilename + ': ' + fe.Message);
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
begin
with form1 do
begin
txtUsername.Text := '';
txtPassword.Text := '';
txtFolder.Text := '';
ListBox1.Clear;
Memo1.Clear;
Progressbar1.Position := 0;
end;
end;
procedure TForm1.ThreadDone(Sender: TObject);
begin
Dec(ThreadsRunning);
if ThreadsRunning = 0 then
begin
MessageDlg('Proceso de FTP Upload Finalizado', mtinformation, [mbok], 0);
end;
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
var
FTP: TIdFTP;
Lista: TStringList;
i,j : Integer;
DirDst : String;
begin
if (txtUsername.Text = '') or (txtPassword.Text = '') or (txtHost.Text = '') then
begin
MessageDlg('Error de Parámetros de Comunicación', mtinformation, [mbok], 0);
Exit;
end;
if ListBox1.Items.count = 0 then
begin
MessageDlg('Lista de FTP Upload Esta Vacía', mtinformation, [mbok], 0);
Exit;
end;
if txtFolder.Text <> EmptyStr then
begin
if not DirectoryExists(txtFolder.Text) then
CreateDir(txtFolder.Text);
DirDst := IncludeTrailingBackslash(txtFolder.Text)
end
else
DirDst := 'C:\FTPServerBackup\';
FTP := TIdFTP.Create(nil);
FTP.OnWork := FTPWork;
FTP.Username := txtUsername.Text;
FTP.Password := txtPassword.Text;
FTP.Host := txtHost.Text;
try
FTP.Connect;
except
raise Exception.Create( 'No se ha podido conectar con el servidor ' + FTP.Host );
end;
Memo1.Clear;
FTP.ChangeDir('/');
Lista := TStringList.create;
FTP.List(Lista,'*.*',false);
try
for i := 0 to Lista.Count - 1 do
begin
for j := 0 to ListBox1.Items.Count - 1 do
begin
if Lista.Strings[i] = ExtractFileName(ListBox1.Items.Strings[j]) then
begin
Memo1.lines.Add('Iniciando FTP Download: ' + Lista.Strings[i]);
if FileExists(DirDst + ListBox1.Items.Strings[j]) then
DeleteFile(DirDst + ListBox1.Items.Strings[j]);
FTP.Get(Lista.Strings[i], DirDst + Lista.Strings[i], true);
Memo1.lines.Add('Finalizando FTP Download: ' + Lista.Strings[i]);
end;
end;
end;
MessageDlg('Proceso de FTP Download Finalizado', mtinformation, [mbok], 0);
finally
FTP.Disconnect;
FTP.Free;
Lista.Free;
end;
end;
end.
El código anterior en Delphi 7 e Indy 9 sobre Windows 7 Professional x32,
permite enviar archivos de forma individual o múltiple a un servidor FTP así como descargar archivos del servidor FTP de forma individual, como se muestra en la siguiente imagen:
El código del ejemplo esta disponible en el link :
FTP.rar
Pregunto:
1- ¿Que versión de
Windows utilizas?, ¿
32 o 64 Bits?.
2- ¿Que versión de
Delphi e Indy utilizas?.
3- ¿En que modo realizas el Upload de los archivos al servidor FTP :
En Modo Pasivo o Modo Activo?.
4- ¿Te falla con
cualquier tipo de archivo superior a los 40 MB o es una falla más específica?.
5- ¿Has verificado que no haya
ninguna restricción que pueda afectar tu aplicación en el Servidor FTP?
Te comento:
1- En pruebas realizadas con el código propuesto,
se pudo enviar al servidor FTP archivos de entre 10 KB y 1 GB satisfactoriamente en modo pasivo y modo activo.
2- En una sola oportunidad,
el modo pasivo fue muy lento y dio la impresión de que el proceso se bloqueo, sin embargo termino satisfactoriamente.
3- En modo activo
el envío es mucho más rápido.
4- Si tienes que pasar un Firewall o usas NAT,
es probable que debas usar modo pasivo, en caso contrario puedes probar con el modo activo.
5- Te sugiero probar el código del ejemplo y comparar los resultados,
quizás puedas encontrar alguna diferencia.
Espero sea útil
Nelson.