Enviar archivos a un servidor vía FTP

En este ejemplo vamos a enviar un archivo "listado.txt" que debe estar en la misma carpeta que el programa a un servidor remoto, es decir, necesitamos sí o sí un servidor al cual conectarnos vía FTP, y un usuario con privilegio de lectura y escritura. La conexión la hacemos por el puerto 21. Desde ya el archivo y el puerto se pueden cambiar desde el código fuente.
Necesitamos también el paquete synapse.

Descargar Synapse desde la web del autor: http://www.ararat.cz/synapse/doku.php/download

En la wiki de Free Pascal hay mucha información y ejemplos de Synapse (en inglés): http://wiki.freepascal.org/Synapse

Podemos utilizar este paquete sin necesidad de instalarlo ni reconstruir la IDE Lazarus.

Desde un proyecto nuevo o habiendo ya descargado es de este ejemplo (al final de esta entrada) vamos a Paquete y Abrir archivo de paquete .lpk.

El paquete se encuentra en la carpeta lib dentro de source donde se haya descomprimido synapse.

No tiene que aparecer esto.

Ahora tal cual se ve en la imagen, botón Usar y Agregar al proyecto, nada más, no se compila ni se instala.

Lo primero es incluir las unidades ftpsend y blcksock en la sección uses.

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ftpsend, blcksock;

Al Form1 le vamos a definir dos variables privadas para que puedan ser accedidas desde los procedimientos (eventos/métodos).


private
  TotalBytes : longint;
  CurrentBytes : longint;

En la clase TForm vamos a incluir estos procedimientos:

procedure btnEnviarClick (Sender: TObject);
procedure btnSalirClick (Sender: TObject);
procedure FormCreate (Sender: TObject);
procedure SockCallBack (Sender: TObject; Reason: THookSocketReason; const Value: string);

FormCreate solamente hace los TEdit tipo password por lo tanto no es necesario para "practicar", o puede dejarse como password solo el correspondiente al TEdit de la contraseña.

edContrasena.EchoMode:=emPassword;
edServidor.EchoMode:=emPassword;
edUsuario.EchoMode:=emPassword;

El método SockCallBack solo es necesario para mostrar una barra de progreso.

case Reason of
  HR_WriteCount:

El enumerado HR_WriteCount se utiliza porque se envían archivos, si en cambio se recibieran archivos, el enumerado es otro, lo veremos en otra entrada donde explicare como recibir archivos vía FTP que desde ya, es parecido a esto.

Variables del evento btnEnviarClick:

procedure TForm1.btnEnviarClick(Sender: TObject);
var
  ftp: TFTPSend;
  remotefile: string;
  localfile: String;
  i: Integer;


Lo primero es definir una variable (en este caso llamada ftp) del tipo TFTPSend que se encuentra en la unidad ftpsend.pas. Si bien el nombre de esta unidad puede llevar a pensar que exista otra llamada ftpreciebe.pas, pues no, en ftpsend está todo, ya sea para enviar como para recibir archivos.

Luego de instanciar la variable "ftp" ftp := TFTPSend.Create; debemos "envolver" todo el código de conexión y envío del archivo en un try ... finally, no es obligatorio pero si recomendable.

ftp.DSock.OnStatus := @SockCallBack;

Es para incrementar la progressbar.

ftp.Timeout:=4000;

Esto es muy importante y lamentablemente no se menciona en la mayoría de ejemplos de FTPSend que hay en Internet. Si no definimos un tiempo de espera, el programa puede colgarse o largar un error, de esta forma establecemos en 4 segundo el tiempo de espera de respuesta del servidor.

if ftp.StoreFile(remotefile,False)

La función StoreFile es la que manda el archivo al servidor, el primer parámetros es un string que contiene la carpeta del servidor y el nombre del archivo /prueba/listado.txt y el segundo parámetro, booleano, solo debe ser True si el servidor soporta reanudar subidas, si es así solo se sube la parte que resta y si el tamaño del archivo es el mismo que el del archivo que está en el servidor, entonces no se envía nada. Como tercera opción, en caso de que el archivo del servidor sea más grande que el archivo local, entonces se envía todo el archivo desde el comienzo.

Todo el código:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ftpsend, blcksock;

type

{ TForm1 }

TForm1 = class(TForm)
  btnEnviar: TButton;
  btnSalir: TButton;
  edCarpetaServidor: TEdit;
  edServidor: TEdit;
  edContrasena: TEdit;
  edUsuario: TEdit;
  Label1: TLabel;
  Label2: TLabel;
  Label3: TLabel;
  Label4: TLabel;
  MemoLog: TMemo;
  ProgressBar1: TProgressBar;
  procedure btnEnviarClick(Sender: TObject);
  procedure btnSalirClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure SockCallBack(Sender: TObject; Reason: THookSocketReason; const Value: string);
private
  TotalBytes : longint;
  CurrentBytes : longint;
{ private declarations }
public
{ public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnEnviarClick(Sender: TObject);
var
  ftp : TFTPSend;
  remotefile:string;
  localfile:String;
  i:Integer;
begin
  btnEnviar.Enabled:=False;
  btnSalir.Enabled:=False;
  ftp := TFTPSend.Create;
  localfile:='listado.txt';
  MemoLog.Lines.Add('Conectando con el servidor. Por favor espere.');
  Application.ProcessMessages;
  try
    ftp.DSock.OnStatus := @SockCallBack;
    ftp.Username:=edUsuario.Text;
    ftp.Password:=edContrasena.Text;
    ftp.TargetHost:=edServidor.Text;
    ftp.TargetPort:='21';
    ftp.Timeout:=4000;
    if ftp.Login then
      MemoLog.Lines.Add('Login: ********* correcto')
    else
      begin
        MemoLog.Lines.Add('Login: ********* incorrecto');
        exit;
    end;
    Application.ProcessMessages;
    Sleep(1000);
    remotefile:=edCarpetaServidor.Text+'listado.txt';
    Progressbar1.Position:=0;
    ftp.DirectFileName:=localfile;
    ftp.DirectFile:=true;
    TotalBytes:=FileSize(localfile);
    MemoLog.Lines.Add('Enviando archivo: ' + localfile);
    MemoLog.Lines.Add('Total Bytes: ' + IntToStr(TotalBytes));
    if ftp.StoreFile(remotefile,False) then
      MemoLog.Lines.Add('Transferencia completa')
    else
      MemoLog.lines.add('Transferencia fallida');
    Application.ProcessMessages;
    Sleep(1000);
  finally
    ftp.Logout;
    ftp.free;
  end;
  MemoLog.Lines.Add(#13#10+'Envío de archivos finalizado'+#13#10+'Puede cerrar (salir) esta ventana');
  btnEnviar.Enabled:=True;
  btnSalir.Enabled:=True;
end;

procedure TForm1.btnSalirClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  edContrasena.EchoMode:=emPassword;
  edServidor.EchoMode:=emPassword;
  edUsuario.EchoMode:=emPassword;
end;

procedure TForm1.SockCallBack(Sender: TObject; Reason: THookSocketReason;
const Value: string);
begin
  Application.ProcessMessages;
  case Reason of
    HR_WriteCount:
    begin
      inc(CurrentBytes, StrToIntDef(Value, 0));
      ProgressBar1.Position := Round(100 * (CurrentBytes / TotalBytes));
    end;
  HR_Connect: CurrentBytes := 0;
end;
end;

end.

Descargar proyecto (incluye el archivo listado.txt): EnviaraFTP.7z