La librería Synapse (2)

Continuando con otro protocolo, vamos a ver como implementar un servidor de FTP con esta librería. Basándome en el caos que trae de ejemplo y que esta repartido en dos unidades, lo he fusionado en una unidad pasando a español la mayoría de las variables.

También he tenido que corregir algunas cosas que trae defectuosas, como por ejemplo, subir al directorio padre o listar el contenido de un directorio.

CREAR UN SERVIDOR FTP

Creamos un nuevo proyecto cuyo único formulario va a tener un componente TMemo llamado Mensajes donde monitorizamos los eventos del servidor.

Para gestionar las peticiones de los clientes, lo que se hace es crear primero un hilo de ejecución que espera la conexión de cualquier cliente. Cuando un cliente intenta conectar con el servidor, se abre un nuevo hilo de ejecución exclusivo para ese cliente y deja el hilo principal libre para el resto de usuarios.

Esta sería la implementación del hilo principal:

THiloServidor = class(TThread)
private
  { Private declarations }
protected
  procedure Execute; override;
public
  constructor Create;
end;

Este sería su constructor:

constructor THiloServidor.create;
begin
  inherited create(False);
  FreeOnTerminate := False;
end;

Al ejecutarse este hilo abre un Sock (una conexión) en escucha por el puerto 21 y en canto oiga la conexión de un cliente le abre un hilo para él (THiloFTP):

procedure THiloServidor.Execute;
var
  ClienteSock: TSocket;
  Sock: TTCPBlockSocket;
begin
  // Una vez se ejecuta el hilo del servidor,
  // se queda escuchando indefinidamente las
  // peticiones de los clientes

  Sock := TTCPBlockSocket.Create;
  try
    Sock.Bind('0.0.0.0','21');
    Sock.SetLinger(true, 10000);
    Sock.Listen;

    if Sock.LastError <> 0 then
      Exit;

    while not Terminated do
    begin
      if Sock.CanRead(1000) then
      begin
        ClienteSock := Sock.Accept;
        if Sock.LastError = 0 then
          THiloFtp.create(ClienteSock);
      end;
    end;
  finally
    Sock.Free;
  end;
end;

Este hilo destinado al cliente es el que se quedará activo mientras el cliente esté conectado:

  THiloFTP = class(TThread)
  private
    Clientes: TSocket;
    sIP, sPuerto, sMensaje, sDirectorioActual: string;
  protected
    procedure Execute; override;
    procedure Enviar(const sock: TTcpBlocksocket; sValor: string);
    procedure AnalizarRutaRemota(sValor: string);
    function CrearNombre(sDirectorio, sValor: string): string;
    function CrearNombreReal(sValor: string): string;
    function CrearLista(sValor: string): string;
    procedure Monitorizar;
  public
    constructor Create(sock: TSocket);
  end;

Aquí viene el auténtico ladrillo, el encargado de leer todos los comandos FTP y enviar la respuesta:

procedure THiloFTP.Execute;
var
  Sock, dSock: TTCPBlockSocket;
  s, t: string;
  bAutenticado: boolean;
  sUsuario: string;
  sComando, par: string;
  st: TFileStream;
begin
  Sock := TTCPBlockSocket.Create;
  dSock := TTCPBlockSocket.Create;
  try
    Sock.Socket := Clientes;
    Enviar(Sock, '220 Bienvenido ' + Sock.GetRemoteSinIP);
    bAutenticado := False;
    sUsuario := '';

    // Esperamos cíclicamente hasta que el usuario se autentifique
    repeat
      s := Sock.RecvString(LimiteTiempo);
      sComando := UpperCase(SeparateLeft(s, ' '));
      par := SeparateRight(s, ' ');
      sMensaje := s;
      Synchronize(Monitorizar);

      if Sock.LastError <> 0 then
        Exit;

      if Terminated then
        Exit;

      // ¿Nos han enviado el nombre del usuario?
      if sComando = 'USER' then
      begin
        sUsuario := par;
        Enviar(Sock, '331 Introduzca la contraseña.');
        Continue;
      end;

      // ¿Nos han enviado la contraseña?
      if sComando = 'PASS' then
      begin
        //user verification...
        if ((sUsuario = 'admin') and (par = '1234')) then
        begin
          Enviar(Sock, '230 Conectado correctamente.');
          bAutenticado := True;
          Continue;
        end;
      end;

      Enviar(Sock, '500 Usuario o contraseña incorrecta.');
    until bAutenticado;

    sDirectorioActual := '/';

    // Una vez que el usuario se ha identificado
    // esperamos los comandos del mismo
    
    repeat
      s := Sock.RecvString(LimiteTiempo);
      sComando := UpperCase(SeparateLeft(s, ' '));
      par := SeparateRight(s, ' ');
      sMensaje := s;
      Synchronize(Monitorizar);

      if par = s then
        par := '';

      if Sock.LastError <> 0 then
        Exit;

      if Terminated then
        Exit;

      // ¿El usuario quiere desconectarse?  
      if sComando = 'QUIT' then
      begin
        Enviar(Sock, '221 Cerrando conexión.');
        Break;
      end;

      // ¿No hace nada? (comando para evitar la desconexión por tiempo)
      if sComando = 'NOOP' then
      begin
        Enviar(Sock, '200 tururu');
        Continue;
      end;

      // Nos piden el directorio actual
      if (sComando = 'PWD') or (sComando = 'XPWD') then
      begin
        Enviar(Sock, '257 ' + Quotestr(sDirectorioActual, '"'));
        Continue;
      end;

      // Cambiar de directorio
      if sComando = 'CWD' then
      begin
        t := UnquoteStr(par, '"');
        t := CrearNombre(sDirectorioActual, t);
        
        if DirectoryExists(CrearNombreReal(t)) then
        begin
          sDirectorioActual := t;
          Enviar(Sock, '250 OK ' + t);
        end
        else
          Enviar(Sock, '550 La acción requerida no pudo realizarse.');

        Continue;
      end;

      // Crear un directorio
      if (sComando = 'MKD') or (sComando = 'XMKD') then
      begin
        t := UnquoteStr(par, '"');
        t := CrearNombre(sDirectorioActual, t);

        if CreateDir(CrearNombreReal(t)) then
        begin
          //sDirectorioActual := t;
          Enviar(Sock, '257 "' + t + '" directorio creado');
        end
        else
          Enviar(Sock, '521 "' + t + '" La acción requerida no pudo realizarse.');
          
        Continue;
      end;

      // Volver al directorio padre
      if sComando = 'CDUP' then
      begin
        sDirectorioActual := '/';
        Enviar(Sock, '250 OK');
        Continue;
      end;

      // Estos comandos quedan sin implementar
      if (sComando = 'TYPE') or (sComando = 'ALLO')
        or (sComando = 'STRU') or (sComando = 'MODE') or
        (sComando = 'PASV') then
      begin
        Enviar(Sock, '200 OK');
        Continue;
      end;

      // Cambiar puerto de datos
      if sComando = 'PORT' then
      begin
        AnalizarIPRemota(par);
        Enviar(Sock, '200 OK');
        Continue;
      end;

      // Listar el contenido del directorio actual
      if sComando = 'LIST' then
      begin
        t := UnquoteStr(par, '"');
        t := CrearNombre(sDirectorioActual, t);
        dSock.CloseSocket;
        dSock.Connect(sIP, sPuerto);

        if dSock.LastError <> 0 then
          Enviar(Sock, '425 No se puede abrir la conexión de datos.')
        else
        begin
          Enviar(Sock, '150 OK ' + t);
          dSock.SendString(CrearLista(CrearNombreReal(t)));
          Enviar(Sock, '226 OK ' + t);
        end;
        
        dSock.CloseSocket;
        Continue;
      end;

      // Leee un archivo del servidor
      if sComando = 'RETR' then
      begin
        t := UnquoteStr(par, '"');
        t := CrearNombre(sDirectorioActual, t);
        
        if FileExists(CrearNombreReal(t)) then
        begin
          dSock.CloseSocket;
          dSock.Connect(sIP, sPuerto);
          dSock.SetLinger(true, 10000);
          
          if dSock.LastError <> 0 then
            Enviar(Sock, '425 No puedo abrir la conexión.')
          else
          begin
            Enviar(Sock, '150 OK ' + t);
            try
              st := TFileStream.Create(CrearNombreReal(t),
                fmOpenRead or fmShareDenyWrite);
              try
                dSock.SendStreamRaw(st);
              finally
                st.free;
              end;
              Enviar(Sock, '226 OK ' + t);
            except
              on exception do
                Enviar(Sock, '451 La acción requerida ha sido abortada: error al procesarlo.');
            end;
          end;
          
          dSock.CloseSocket;
        end
        else
          Enviar(Sock, '550 Archivo no disponible. ' + t);
          
        Continue;
      end;

      // Enviar un fichero al servidor
      if sComando = 'STOR' then
      begin
        t := UnquoteStr(par, '"');
        t := CrearNombre(sDirectorioActual, t);

        if DirectoryExists(ExtractFileDir(CrearNombreReal(t))) then
        begin
          dSock.CloseSocket;
          dSock.Connect(sIP, sPuerto);
          dSock.SetLinger(True, 10000);
          
          if dSock.LastError <> 0 then
            Enviar(Sock, '425 No se puede abrir la conexión para datos.')
          else
          begin
            Enviar(Sock, '150 OK ' + t);
            try
              st := TFileStream.Create(CrearNombreReal(t), fmCreate or fmShareDenyWrite);
              try
                dSock.RecvStreamRaw(st, LimiteTiempo);
              finally
                st.free;
              end;
              Enviar(Sock, '226 OK ' + t);
            except
              on Exception do
                Enviar(Sock, '451 La acción requerida ha sido abortada: error al procesarlo.');
            end;
          end;
          dSock.CloseSocket;
        end
        else
          Enviar(Sock, '553 El directorio no existe. ' + t);

        Continue;
      end;
      Enviar(Sock, '500 Error de sintaxis, comando no reconocido.');
    until false;

  finally
    dSock.free;
    Sock.free;
  end;
end;

Lo que tiene dentro son dos bucles:

1º Espera que el usuario se identifique.

2º Una vez identificado espera comandos hasta que el usuario manda un QUIT (un bye en el cliente).

Este procedimiento utiliza otros como el de enviar mensajes:

procedure THiloFTP.Enviar(const Sock: TTcpBlockSocket; sValor: string);
begin
  // Envia los mensajes a los clientes incluyendo el fin de línea
  Sock.SendString(sValor + CRLF);
  sMensaje := sValor;
  Synchronize(Monitorizar);
end;

También tienen otro chorizo para analizar las direcciones remotas:

procedure THiloFTP.AnalizarIPRemota(sValor: string);
var
  n: integer;
  nb, ne: integer;
  s: string;
  x: integer;
begin
  sValor := trim(sValor);
  nb := Pos('(',sValor);
  ne := Pos(')',sValor);

  if (nb = 0) or (ne = 0) then
  begin
    nb := RPos(' ',sValor);
    s := Copy(sValor, nb + 1, Length(sValor) - nb);
  end
  else
    s:=Copy(sValor,nb+1,ne-nb-1);

  for n := 1 to 4 do
    if n = 1 then
      sIP := Fetch(s, ',')
    else
      sIP := sIP + '.' + Fetch(s, ',');

  x := StrToIntDef(Fetch(s, ','), 0) * 256;
  x := x + StrToIntDef(Fetch(s, ','), 0);
  sPuerto := IntToStr(x);
end;

Tenemos otra rutina que junta las rutas con los nombres de los archivos:

function THiloFTP.CrearNombre(sDirectorio, sValor: string): string;
begin
  // Crea una composición con el nombre del directorio y del archivo

  if sValor = '' then
  begin
    Result := sDirectorio;
    Exit;
  end;

  if sValor[1] = '/' then
    Result := sValor
  else
    if (sDirectorio <> '') and (sDirectorio[Length(sDirectorio)] = '/') then
      Result := sDirectorio + sValor
    else
      Result := sDirectorio + '/' + sValor;
end;

A esta otra le he tenido que dar un buen meneo para que se vaya al directorio padre, porque lo que traía implementado era una chapuza:

function THiloFTP.CrearNombreReal(sValor: string): string;
var i: Integer;
begin
  // ¿Hay que subir al directorio padre?
  if Copy(sValor, Length(sValor)-1, 2) = '..' then
  begin
    // Nos saltamos la primera barra
    i := Length(sValor);
    while (i > 1) and (sValor[i] <> '/') do
      Dec(i);

    // Y saltamos hasta la segunda barra
    Dec(i);
    while (i > 1) and (sValor[i] <> '/') do
      Dec(i);

    sValor := Copy(sValor, 1, i);
    sDirectorioActual := sValor;

    if sDirectorioActual = '' then
      sDirectorioActual := '/';
  end;

  sValor := ReplaceString(sValor, '/', '\');
  sValor := '.\datos' + sValor;
  Result := sValor;
end;

Luego esta la rutina que devuelve el formato de fecha y hora para listar los directorios. También la he modificado para adaptarla a lo estándar en Windows:

function FormatoFechaHora(iValor: Integer): string;
var
  FechaHora: TDateTime;
  wAnio, wMes, wDia, wHora, wMinutos, wSegundos, wMilisegundos: word;
begin
  FechaHora := FileDateToDateTime(iValor);
  DecodeDate(FechaHora, wAnio, wMes, wDia);
  DecodeTime(FechaHora, wHora, wMinutos, wSegundos, wMilisegundos);
  Result := Meses[wMes] + ' ' + FormatCurr('00', wDia) + ' ' +
  FormatCurr('00', wHora) + ':' + FormatCurr('00', wMinutos);
end;

Esta es otra de las más importantes. Se encarga de listar el contenido de un directorio al estilo unix:

function THiloFTP.CrearLista(sValor: string): string;
var
  Busqueda: TSearchRec;
  rResultadoBusqueda: integer;
  s: string;
begin
  // Devuelve el contenido del directorio que le pasamos como parámetro
  Result := '';

  if sValor = '' then
    Exit;

  // Si el directorio no termina en contrabarra, se la ponemos
  if sValor[Length(sValor)] <> '\' then
    sValor := sValor + '\';

  rResultadoBusqueda := FindFirst(sValor + '*.*', faAnyFile, Busqueda);
  while rResultadoBusqueda = 0 do
  begin
    if ((Busqueda.Attr and faHidden) = 0) and
       ((Busqueda.Attr and faSysFile) = 0) and
       ((Busqueda.Attr and faVolumeID) = 0) then
    begin
      s := '';
      if (Busqueda.Attr and faDirectory) > 0 then
      begin
        s := s + 'drwxrwxrwx   1 root     root           1 ';
        s := s + FormatoFechaHora(Busqueda.Time) + ' ';
        s := s + Busqueda.Name;
      end
      else
      begin
        s := s + '-rwxrwxrwx   1 root     other      ';
        s := s + CompletarEI(FormatCurr('###,###,#0', Busqueda.Size), 5) + ' ';
        s := s + FormatoFechaHora(Busqueda.Time) + ' ';
        s := s + Busqueda.Name;
      end;
      
      if s <> '' then
        Result := Result + s + CRLF;
    end;
    
    rResultadoBusqueda := FindNext(Busqueda);
  end;
  
  FindClose(Busqueda);
end;

A toda esta parafernalia he tenido que añadir otra función para monitorizar por pantalla el servidor (con synchronize):

procedure THiloFTP.Monitorizar;
begin
  FServidorFTP.Mensajes.Lines.Add(sMensaje);
end;

Y otra para que complete con espacios por la izquierda los números que le pasemos. El listado original se torcía según si listaba archivos con tamaño distinto o directorios:

function CompletarEI(sCadena: string; iLongitud: Integer): string;
begin
  // Completa espacios por la izquierda
  Result := StringOfChar(' ', iLongitud - Length(sCadena)) + sCadena;
end;

Y por último y lo más importante, ponemos en marcha el hilo principal del servidor en el evento OnCreate de este formulario:

procedure TFServidorFTP.FormCreate(Sender: TObject);
begin
  THiloServidor.Create;
end;

EJECUTANDO EL SERVIDOR

Al ejecutar el servidor tiene que quedar a la espera:

Abrimos una ventana de comandos y conectamos con nosotros mismos:

El usuario es admin y la contraseña 1234:

Como podemos apreciar en la imagen, las eñes y las tildes se estropean en modo texto. Nuestro servidor habrá confirmado que estamos dentro:

Dentro de la carpeta de nuestro proyecto tenemos que crear la carpeta datos que será la carpeta raíz de nuestro servidor FTP. He creado tres archivos y una carpeta dentro de datos para probarlo:

Podemos subir o bajar cualquier archivo del servidor:

También podemos entrar y salir de cualquier carpeta:

O crear una nueva carpeta dentro del servidor:

La ventana del servidor nos dirá siempre lo que va ocurriendo:

A este servidor todavía le quedan muchas cosas por implementar, como pueden ser la gestión de usuarios, los permisos de usuarios y carpetas, programar el modo pasivo, los comandos binary, hash, etc.

CONCLUSIONES

A menos que queramos aprender como funciona un servidor FTP, esta librería no sirve de mucho si queremos crear un servidor rápidamente de manera profesional. Ya hemos visto que todo hay que hacerlo a mano, lo cual no es muy práctico si tenemos prisa.

Para mí, un auténtico componente o librería que haga de servidor sería donde solo tenemos que dar de alta usuarios, habilitar permisos en directorios y poco más. Y desde luego, la librería Synapse no sería la candidata. Eso sí, si queréis aprender como funciona desde sus tripas un servidor FTP, esta es la mejor opción. Tenéis el control absoluto sobre todo lo que sucede en el servidor. Eso si no os explota la cabeza antes.

Estos son algunos de los comandos de un servidor FTP según el RFC 959:

USER, PASS, ACCT, CWD, CDUP, SMNT, REIN, QUIT, PORT, PASV, TYPE, STRU, MODE, RETR, STOR, STOU, APPE, ALLO, REST, RNFR, RNTO, ABOR, DELE, etc.

Próximamente seguiré analizando más protocolos con esta librería. Todavía le quedan cosas muy interesantes.

Pruebas realizadas en RAD Studio 2007.

La librería Synapse (1)

Buscando componentes de comunicaciones alternativos a los indocumentados Indy, me encontré con esta librería que soporta diversos protocolos TCP/IP sin tener que instalar ningún componente en Delphi. Además es gratuita y viene con todo el código fuente abierto.

La última versión es la release nº 39 con fecha 9/10/2009 y se encuentra en esta página web:

http://www.synapse.ararat.cz/doku.php

Nos vamos al apartado Download y nos bajamos la última versión estable:

Donde tengamos el directorio de los otros componentes, creamos la carpeta Synapse y descomprimimos dentro este zip:

Luego solo tenemos que preocuparnos de enlazar la carpeta \Synapse\source\lib dentro del Search Path de nuestro proyecto.

Vamos a ver todo lo que se puede hacer con esta librería. Para hacer las pruebas he utilizado Delphi 2007.

CREAR UN CLIENTE TFTP

El protocolo TFTP (Trivial File Transfer Protocol – Protocolo de Transferencia de Archivos Trivial) es una versión descafeinada del protocolo FTP que solo permite subir o bajar archivos directamente del servidor sin tener en cuenta usuarios, carpetas, permisos, etc.

Para realizar el transporte de datos utiliza el protocolo UDP usando el puerto 69 (en vez del 21 como el FTP). Como necesitaba un servidor TFTP para hacer las pruebas, me bajé el servidor gratuito tftpd32:

Se puede descargar de esta página web:

http://tftpd32.jounin.net/

Solo hay que ejecutarlo y listo. Por defecto, comparte los archivos que están en su misma carpeta, pero podemos pulsar el botón Browse para cambiarla. Comencemos a crear el servidor con un nuevo proyecto te tenga este formulario:

Debemos añadir la unidad FTPTSend en la sección uses de la unidad actual. Y como dije antes, enlazamos la carpeta \Synapse\source\lib dentro del Search Path de nuestro proyecto.

El formulario se divide en tres partes principales:

1º La dirección del servidor y el puerto que va a utilizar el usuario:

Los componentes TEdit que he utilizado se llaman Servidor y Puerto.

2º El apartado para descargar un archivo del servidor:

El componente TEdit donde metemos el nombre del archivo se llama Descargar. Al pulsar el botón BDescargar hacemos lo siguiente:

procedure TFClienteTFTP.BDescargarClick(Sender: TObject);
var
  Cliente: TTFTPSend;
begin
  // Creamos el cliente
  Cliente := TTFTPSend.Create;

  // Establecemos los parámetros de conexión
  Cliente.TargetHost := Servidor.Text;
  Cliente.TargetPort := Puerto.Text;

  // ¿Podemos descargar el archivo?
  if Cliente.RecvFile(Descargar.Text) then
  begin
    // Lo guardamos a disco
    Cliente.Data.SaveToFile(ExtractFilePath(Application.ExeName) + Descargar.Text);
    EMensajeDescarga.Caption := 'OK';
    EMensajeDescarga.Font.Color := clGreen;
  end
  else
  begin
    EMensajeDescarga.Caption := 'ERROR: ' + Cliente.ErrorString;
    EMensajeDescarga.Font.Color := clMaroon;
  end;

  EMensajeDescarga.Visible := True;

  // Liberamos el cliente
  Cliente.Free;
end;

He utilizado la etiqueta EMensajeDescarga que por defecto está invisible para mostrar OK o Error en caso de que falle. No hace falta introducir la ruta del archivo en el servidor, sólo el nombre del mismo:

3º Y otro apartado para subir un archivo al servidor:

El usuario debe pulsar el botón Examinar para volcar el nombre con la ruta al campo TEdit llamado Subir:

procedure TFClienteTFTP.BExaminarClick(Sender: TObject);
begin
  if AbrirArchivo.Execute then
    Subir.Text := AbrirArchivo.FileName;
end;

AbrirArchivo es un componente TOpenDialog. Al pulsar el botón BSubir comprobamos antes si el archivo es válido:

procedure TFClienteTFTP.BSubirClick(Sender: TObject);
var
  Cliente: TTFTPSend;
begin
  // Comprobamos si el usuario ha seleccionado el archivo
  if Subir.Text = '' then
  begin
    Application.MessageBox('Seleccione el archivo que desea subir al servidor.',
      'Atención', MB_ICONEXCLAMATION);
    ActiveControl := Subir;
    Exit;
  end;

  // Comprobamos si el archivo a subir existe
  if not FileExists(Subir.Text) then
  begin
    Application.MessageBox('El archivo que intenta subir al servidor no existe.',
      'Atención', MB_ICONEXCLAMATION);
    ActiveControl := Subir;
    Exit;
  end;

  // Creamos el cliente TFTP
  Cliente := TTFTPSend.Create;

  // Establecemos los parámetros de conexión
  Cliente.TargetHost := Servidor.Text;
  Cliente.TargetPort := Puerto.Text;

  // Intentamos subir el archivo
  Cliente.Data.LoadFromFile(Subir.Text);

  if Cliente.SendFile(ExtractFileName(Subir.Text)) then
  begin
    EMensajeSubida.Caption := 'OK';
    EMensajeSubida.Font.Color := clGreen;
  end
  else
  begin
    EMensajeSubida.Caption := 'ERROR: ' + Cliente.ErrorString;
    EMensajeSubida.Font.Color := clMaroon;
  end;

  EMensajeSubida.Visible := True;

  // Liberamos el cliente
  Cliente.Free;
end;

Como puede verse en ambos casos, el código a escribir para la transferencia de archivos por TFTP entre el cliente y el servidor es extremadamente sencilla. Solo le he encontrado un inconveniente y es que no tiene ningún evento especial para monitorizar la transferencia en tiempo real, algo imprescindible para poner una barra de progreso.

CREAR UN SERVIDOR TFTP

Ahora le damos la vuelta a la tortilla y vamos a implementar el servidor para sustituir tftp32. Aquí la cosa no va tan fácil ya que hay que crear todo el servidor a mano leyendo y procesando los mensajes del mismo. Como es natural, me he basado en las demos que lleva esta librería para crearlo, pasando a español todo lo que he podido de la clase que controla el servidor.

Para empezar creamos un nuevo proyecto con este formulario:


Volvemos a vincular la carpeta \Synapse\source\lib dentro del Search Path de nuestro proyecto y añadimos la unidad FTPTSend.

Le he metido el campo Directorio de la clase TEdit para guardar el directorio por defecto que comparte los archivos. También tiene un componente TMemo llamado Mensajes para monitorizar el estado del servidor.

Por si queremos cambiar el directorio que comparte con los clientes, podemos pulsar el botón BExaminar para elegir otro directorio:

procedure TFServidorTFTP.BExaminarClick(Sender: TObject);
var
  sDirectorio: string;
begin
  if SelectDirectory('Seleccione un directorio', '', sDirectorio) then
    Directorio.Text := sDirectorio;
end;

Ahora vamos a crear el servidor. Para que la aplicación no se quede bloqueada hay que meter el servidor dentro de un hilo de ejecución que procese las peticiones de los clientes. Lo primero es crear la clase que controla al servidor:

type
  // Hilo encargado de recibir mensajes de los clientes
  THiloServidor = class(TThread)
  private
    { Private declarations }
    FServidor: TTFTPSend;
    FIP: string;
    FPuerto: string;
    FMensaje: string;
    procedure ActualizarMensajes;
  protected
    procedure Execute; override;
  public
    constructor Create(sIP, sPuerto: string);
  end;

El constructor solo recoge la IP y el puerto:

constructor THiloServidor.Create(sIP, sPuerto: string);
begin
  FIP := sIP;
  FPuerto := sPuerto;
  inherited Create(False);
end;

También va a tener un procedimiento sincronizado para enviar al formulario los mensajes, ya que un hilo no puede manejar componentes VCL directamente:

procedure THiloServidor.ActualizarMensajes;
begin
  FServidorTFTP.Mensajes.Lines.Add(FMensaje);
end;

Y ahora viene la parte gorda, la encargada de recibir mensajes de los clientes y enviar o recibir archivos a los mismos:

procedure THiloServidor.Execute;
var
  RequestType: Word;
  FileName: String;
begin
  // Creamos el servidor encargado de escuchar a los clientes
  FServidor := TTFTPSend.Create;
  FMensaje := 'Servidor arrancado con el puerto ' + FPuerto + '.';
  Synchronize(Actualizarmensajes);
  FServidor.TargetHost := FIP;
  FServidor.TargetPort := FPuerto;

  try
    // Mientras no termine el hilo de ejecución escuchamos los
    // mensajes de los clientes
    while not Terminated do
    begin
      // ¿Ha llegado algún mensaje?
      if FServidor.WaitForRequest(RequestType,FileName) then
      begin
        // Mostramos quién realiza las solicitudes
        case RequestType of
          1:FMensaje := 'Solicitan lectura de ' +
              FServidor.RequestIP + ':' + FServidor.RequestPort;

          2:FMensaje := 'Solicitan escritura de ' +
              FServidor.RequestIP + ':' + FServidor.RequestPort;
        end;

        Synchronize(ActualizarMensajes);
        FMensaje := 'Archivo: ' + Filename;
        Synchronize(ActualizarMensajes);

        // Procesa la solicitud
        case RequestType of
          1:begin  // Solucitud de lectura (RRQ)
              if FileExists(FServidorTFTP.Directorio.Text + FileName) then
              begin
                FServidor.Data.LoadFromFile(FServidorTFTP.Directorio.Text +
                  FileName);

                if FServidor.ReplySend then
                begin
                  FMensaje := '"' + FServidorTFTP.Directorio.Text +
                    FileName + '" correctamente enviado.';
                  Synchronize(ActualizarMensajes);
                end;
              end
              else
                FServidor.ReplyError(1, 'Archivo no encontrado');
            end;

          2:begin  // Solicitud de escritura (WRQ)
              if not FileExists(FServidorTFTP.Directorio.Text + FileName) then
              begin
                if FServidor.ReplyRecv then
                begin
                  FServidor.Data.SaveToFile(FServidorTFTP.Directorio.Text +
                    FileName);
                  FMensaje := 'Archivo guardardo en ' +
                    FServidorTFTP.Directorio.Text + FileName;
                  Synchronize(ActualizarMensajes);
                end;
              end
              else
                FServidor.ReplyError(6, 'El archivo ya existe.');
            end;
        end;
      end;
    end;
  finally
    FServidor.Free;
  end;
end;

Por último, al crear el formulario establecemos como ruta de compartición de archivos el mismo directorio del programa y arrancamos el servidor:

procedure TFServidorTFTP.FormCreate(Sender: TObject);
begin
  Directorio.Text := ExtractFilePath(Application.ExeName);
  HiloServidor := THiloServidor.Create('0.0.0.0', '69');
end;

Ahora ejecutamos el servidor y el cliente, y probamos a enviar y recibir archivos:

Utilizando en nuestro software los clientes y servidores de TFTP podemos hacer una transferencia de información entre programas en una red local, independientemente de la conexión al servidor de bases de datos. La velocidad es muy rápida y fiable, pero como he dicho antes, hecho de menos controlar el progreso de la descarga cuando los archivos son grandes.

Quizás la librería Synapse no sea tan sofisticada como los componentes Indy, pero por lo menos dan ejemplos y documentación bastante asequible. En el próximo artículo seguiré investigando sobre otros protocolos.

Pruebas realizadas en RAD Studio 2007.

El experto GExperts (y 3)

Finalizamos en esta serie de tres entradas dedicadas a GExperts viendo otras opciones como los buscadores de archivos, las dependencias o la sustitución automática de componentes.

GREP RESULTS

Esta opción muestra la ventana de resultados de una búsqueda de Grep, un excelente buscador de archivos que destaca por permitir buscar trozos de texto dentro los archivos de código fuente:


Supongamos que estoy buscando donde está definida la clase TIdSocketHandle dentro de los componentes KelvinIndy que me he instalado. Entonces pulso el botón de la lupa y escribo esto:

Abajo en el campo Directories elegimos la carpeta por donde queremos que se inicie la búsqueda y pulsamos el botón Ok. Volverá a la ventana de resultados de Grep con todas las unidades donde ha encontrado dicha cadena:

Si hacemos clic sobre cualquier unidad de la lista se desplegarán todas las líneas que ha encontrado de dicha unidad, incluyendo el número de línea y las coincidencias:

Si además pulsamos sobre una de las líneas nos mostrará la zona donde está en la parte inferior de la ventana:

En esta misma ventana tenemos también las opciones de reemplazar el texto buscado o imprimirlo. Lo que más sorprende de Grep es la velocidad a la que busca, es sorprendente. Aunque si lo que estáis buscando son solo archivos (sin mirar el contenido) el buscador más rápido es Everything (gratuito).

GREP SEARCH

Es la misma ventana de búsqueda que hemos visto antes:

Es para ir directamente a buscar sin pasar por la ventana de resultados.

HIDE/SHOW NON-VISUAL

Si tenemos que organizar un formulario donde hay una pasada de componentes no visuales encima del mismo:

Podemos seleccionar esta opción para hacer invisibles los componentes no visuales hasta que recoloquemos los componentes visuales:


IDE MENU SHORTCUTS

Esta es otra gran idea añadida a este experto que permite asignar una combinación de teclas a cualquier opción del menú de Delphi en esta ventana:

Por ejemplo, la opción File -> Open no tiene ninguna combinación de teclas asignada, así que la selecciono en esta ventana:

Para asignarle una combinación antes hay que activar la opción Apply a custom shortcut to this menu item y asigno por ejemplo la combinación CTRL + O. Podemos comprobar si ha ido bien la asignación en el mismo Delphi:

De este modo, podemos acelerar nuestro trabajo sin coger el ratón.

MACRO LIBRARY

La librería de macros nos permite guardar una serie de acciones que efectuemos regularmente en Delphi para que se ejecuten de una sola vez:

No se si será mi versión de Delphi, pero cada vez que intento grabar una macro se queda completamente colgado incluso a veces se cierra todo el IDE de golpe. ¿Se supone que funciona esto o es mi versión de Delphi 2007?

MESSAGE DIALOG

Esta opción nos permite escribir rápidamente el código de un mensaje de error, pregunta, advertencia, etc. Por ejemplo:

Nos generará este código al pulsar el botón Ok:

MessageDlg('¿Desea eliminar este cliente?', mtConfirmation, [mbYes, mbNo], 0);

También permite crear mensajes utilizando Application.MessageBox:


OPEN FILE

Este es un buscador que permite encontrar cualquier tipo de archivo dentro del proyecto con solo ir escribiendo su nombre:

Según la pestaña que seleccionemos, permite buscar los archivos del proyecto, las librerías según la ruta de búsqueda, etc. También es muy rápido aunque no permite hacer búsquedas según el contenido (para eso tenemos Grep).

PE INFORMATION

Esta utilizad permite conocer la cabecera de cualquier archivo ejecutable. Si seleccionamos el Bloc de notas de Windows (NOTEPAD.EXE) nos dará esta información:

La pestaña Imports nos dice que librerías DLL utiliza al ejecutarse:

Al pulsar sobre cualquier DLL nos dice las funciones que tiene. Esta utilidad puede ser interesante por si queremos hacer nuestra aplicación portable y averiguar que archivos DLL deberían acompañar al ejecutable.

PROCEDURE LIST

Esta es la ventana de procedimientos que permite buscar todos los métodos de la unidad actual:

El filtro de búsqueda se activa nada más comenzar a escribir.

PROJECT DEPENDENCIES

La ventana de dependencias del proyecto nos muestra todas las unidades de nuestro proyecto:

Y seleccionando cualquiera de ellas podemos ver a su derecha las unidades que usa:

Incluso las dependencias externas (Indirect Dependencies):


PROJECT OPTIONS SET

En esta ventana podemos activar o desactivar todas las directivas del proyecto de una sola tajada:

También se puede declarar en la pestaña Sets la variables de entorno para que luego compilemos con condicionantes.

RENAME COMPONENTS

Con esta ventana podemos renombrar o mejor dicho, asignar un prefijo a los componentes de un formulario según su clase. Por ejemplo, si quiero que todas las etiquetas tengan el prefijo E, hago lo siguiente:

Después de pulsar Ok, cada vez que insertemos una etiqueta en un formulario se llamará E1, E2, etc., en vez de Label1, Label2, …


REPLACE COMPONENTS

Esta potente opción nos permite cambiar los componentes de una clase por otra. Supongamos que tengo un formulario con tres botones de la clase TButton:

Ahora vamos reemplazar los botones TButton por los de la clase TBitBtn:

Lo hará automáticamente y respetando los nombres anteriores:


Esto nos permitirá sustituir unos componentes por otros sin tener que hacerlo manualmente.

SET TAB ORDER

Todos sabemos la pereza que da el tener que ordenar la tabulación de los componentes de un formulario, pero con esta ventana lo podemos organizar todo:

Podemos cambiar el orden manteniendo pinchando el botón izquierdo del ratón para hacer subir o bajar posiciones. También tiene a la derecha el campo Order by Position para que lo ordene según su posición vertical.

SOURCE EXPORT

Con esta opción podemos exportar todo el código fuente de la unidad actual o el que tengamos seleccionado, exportando a los formatos HTML o RTF:

Lo mejor de todo es que conserva casi todo el formato original de nuestro editor de código:


Si queremos retocar el formato de salida podemos pulsar el botón Configure para personalizarlo:

De modo para solucionar el problema que he tenido con el color de fondo, pulso el botón HTML Background y le pongo color negro:

Lo bueno que tiene es que además lo exporta incluyendo en el mismo HTML la hoja de estilo CSS para que ocupe menos.

TO DO LIST

Esta es una lista de tareas pendientes en la que podemos apuntar todo lo que nos queda por hacer en nuestro proyecto. Para añadir un elemento a la lista debemos escribir unos comentarios especiales en el código como estos:

{#ToDo1 Revisar la validación de los campos del cliente}

//#ToDo2 No olvides adjuntar la librería Unzip.dll

Entonces abrimos la ventana TO DO LIST y pulsamos el botón de refrescar para que actualice la lista de tareas:

Aunque vemos que las tildes se las come con patatas. La idea está bien pero creo que es un poco incómodo.

MORE…

La opción More nos lleva a otras dos opciones:

Configuration: permite configurar las distintas partes de este experto como las opciones del menú, las teclas de acceso rápido, los directorios, etc.:

About: con esto podemos averiguar que versión de GExperts tenemos instalada:


CONCLUSIONES

Después de todo lo visto, debo recomendar encarecidamente este experto no solo por la calidad de sus herramientas sino también por el poco consumo de recursos que necesita y lo bien que se integra con Delphi. Con esto doy por finalizado el tema de los expertos hasta que encuentre algún otro interesante.

Pruebas realizadas en RAD Studio 2007.