[[nlsgarcia]]

newtron,

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
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FtpMax : Integer;
  ThreadsRunning : Integer;

implementation

{$R *.dfm}

// Clase Threads para envío múltiple de archivos
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;

// Permite que la aplicación responda a eventos cuando esta haciendo el FTP
procedure TForm1.FormCreate(Sender: TObject);
begin
   with TIdAntiFreeze.Create(self) do Active:=true;
end;

// Selección múltiple de archivos a enviar
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;

// Elimina archivos de lista de envío FTP
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
   if ListBox1.ItemIndex = -1 then
      Exit
   else
      ListBox1.DeleteSelected;
end;

// Envío de Archivos Simple (Uno a uno)
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;

// Envío de Archivos Multiples (Todos Simultaneamente)
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;

// Actualiza posición FtpMax (Cantidad Total de Bytes enviados) en TUploaderThread
  procedure TForm1.FTPWork(Sender: TObject; AWorkMode: TWorkMode;const AWorkCount: Integer);
begin
   ProgressBar1.Position := AWorkCount div 1024;
end;

// Create el Objeto TUploaderThread por cada archivo a enviar
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;

// Actualiza posición FtpMax (Cantidad Total de Bytes a Enviar)
procedure TUploaderThread.ProgressFTP;
begin
   form1.ProgressBar1.Max := FtpMax;
end;

// Envío de Archivos Multiples con TUploaderThread
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;

// Fin de envío con TUploaderThread
procedure TUploaderThread.FinishedUpload;
begin
   form1.Memo1.lines.Add('Finalizando FTP Upload: ' + FFilename);
   form1.ProgressBar1.Position := FTPMax;
end;

// Error de envío con TUploaderThread
procedure TUploaderThread.HandleException;
begin
   form1.Memo1.lines.Add('Error en FTP Uploading en ' + FFilename + ': ' + fe.Message);
end;

// Reset opciones de envío en form1
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;

// Envía un mensaje al finalizar todos los Threads activos
procedure TForm1.ThreadDone(Sender: TObject);
begin
   Dec(ThreadsRunning);
   if ThreadsRunning = 0 then
   begin
      MessageDlg('Proceso de FTP Upload Finalizado', mtinformation, [mbok], 0);
   end;
end;

// Download archivos del Servidor FTP
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.