Cuelgue enviando ficheros grandes a ftp
 

Hola a tod@s.

Desde hace bastante envio ficheros a servidores ftp con el componente IDFTP sin problemas. El tema es que ahora me surge la necesidad de enviar un fichero con unos 40Mb. y al finalizar se queda colgado, o sea, el fichero lo envía correctamente pero no continúa con la ejecución del programa para desconectarse y enviar un mensaje de "proceso finalizado" o algo así.

He probado con ficheros más pequeños y lo hace sin problemas, también he probado con otros servidores ftp y tampoco va, o sea, que no es problema del servidor ftp. Por otro lado he probado a meterlo en un hilo y le pasa lo mismo. ¿Alguno de vosotros se ha encontrado con ese problema?.

Gracias y un saludo.

newtron,

:rolleyes:

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.

Nelson.

Gracias por tu código de ejemplo.

He descargado el fuente y se comporta exactamente igual que mi código. Pensando que podía ser de mi versión de Delphi/Indy he ejecutado directamente el ejecutable que adjuntas y....:confused:... se comporta exactamente igual, o sea, envía el fichero y se cuelga.

He probado en distintos ordenadores con distintos sistemas operativos y en distintos servidores ftp con el mismo comportamiento así que ya si que estoy un poco perdido.

Seguiré dando cabezazos a ver qué se me ocurre.

Gracias y un saludo

¿Has probado con filezilla, por ejemplo, o algún programa similar?

Afirmativo, y con un programa de ese tipo lo hace correctamente :confused:.

¿Has probado con el programa demo sencillo de ftp que trae delphi?
Bueno, delphi 5 y 7 lo traía, no sé ahora.

No, no he visto ningún otro programa pero los tiros creo que no van por ahí.

Resulta que se me ocurre reproducir la situación en la red de un cliente y.....funciona. Visto esto sigo pensando (que yo pienso de vez en cuando, no sé si bien o mal....:D).

Aquí en la empresa tenemos dos adsl, una con ip fija que es la que usamos normalmente los de software y otra con ip variable que se usa en el servicio técnico para actualizaciones de windows y esas cosas. Cambio de adsl a la otra, abro el programa, envio el fichero y funciona correctamente. Posteriormente, y sin cerrar el programa, cambio de adsl a la mía habitual, pico en el botón de enviar sin cambiar nada y se me cuelga de nuevo al enviar el fichero. :confused:

Resumiendo, por alguna extraña razón con mi adsl habitual se cuelga y con otra no, a ver cómo le ponemos al niño ahora.

¿Y si haces un intercambio de routers?

newtron,

:rolleyes:

Te comento:

1- El problema no es de software ni hardware, es de configuración de parámetros en el ADSL de IP Fija.

2- En la configuración del ADSL de IP Fija, hay un parámetro o restricción que esta afectando la trasmisión de archivos superiores a los 40 MB.

3- Te sugiero revisar la configuración de ambos ADSL y ver cual es la diferencia que esta originado el problema, en general el personal de soporte técnico no tiene ese tipo de restricciones por la naturaleza de su trabajo.

Espero sea útil :)

Nelson.

Bueno... sería una buena prueba a hacer pero tendría que cerrar el "chiringuito" mientras probamos eso porque aquí no paramos de conectarnos a clientes durante todo el día y las configuraciones de los dos routers son distintas básicamente porque uno de ellos tiene ip fija y un "saco" de puertos redireccionados.


Es posible pero lo curioso de esto es que el fichero se envía, el problema es que al finalizar el programa no se entera, se queda ahí "pillado", sin embargo programas como el leechftp si lo suben sin mayor problema, eso es lo que me tiene algo desconcertado.

Yo me estoy temiendo que sea algún tipo de problema de compatibilidad del componente Indy con la configuración del router este en particular. No sé, le echaremos un vistazo al router a ver qué veo.

Gracias a los dos

Bueno, me refería a poner otro router y hacer pruebas de configuración fijándote en el que funciona bien.

Ya ya... lo que me mosquea es que si con un programa como leechftp funciona correctamente con el mío debería de hacerlo igual, así que no tengo muy claro que sea algo exclusivo del router.

Pues entonces prueba el programita que comenté antes, el demo que trae delphi 5, 6, 7... es muy simple y funciona bien. Te servirá de referencia para encontrar cosas diferentes con tu programa.

Ya he probado con el ejemplo de Indy y también se me cuelga. :confused:

Lo que haré será buscar otro componente ftp distinto a ver qué pasa.

¿Y con el ftp de la línea de comandos de windows/linux?

¿mandeloqué?.... no he usado eso nunca.