[[nlsgarcia]]

JAI_ME,

Empezado por JAI_ME

Cuando subo un archivo no hay problema, el problema viene cuando intento subir muchos archivos casi que a la ves.

Hey leído y una posible solución seria crear varios hilos de ejecución. pero a que se refieren con hilos, crear en tiempo de ejecución varios TidFTP ???

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;
    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);
  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 <> '' 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
      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
      Inc(ThreadsRunning);
      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;

end.

El código anterior envía múltiples archivos vía FTP usando dos métodos:

1- Enviando múltiples archivos de forma individual (Uno a Uno).

2- Enviando múltiples archivos de forma simultanea por medio de Threads.

Nota:

1- Los archivos se pueden seleccionar por medio de un TOpenDialog que permite selección multiple.

2- La cantidad de Bytes enviados al servidor FTP se controla por medio de un TProgressBar.

Empezado por JAI_ME

como se dan cuenta envío el mismo archivo al servidor y hay veces que envía mas de 1000 archivos sin sacar el error

No es conveniente crear 1000 Threads, prueba primero la forma individual y luego la simultanea a ver cual se puede adaptar mejor a tu proyecto. El método 1 es el más recomendable para FTP masivos.

La aplicación fue realizada en Delphi 7 usando el Componente FTP de Indy 9.

La aplicación esta implementada en el siguiente link: FTPUpload_MultiFiles.rar

Espero sea útil

Nelson.