La librería Synapse (y 5)

Vamos a terminar de ver las propiedades de esta librería, fijándonos en otras funciones que incorpora que pueden facilitarnos la vida a la hora de crear nuestro software orientado a redes o Internet.

COMPROBAR SI UNA DIRECCIÓN DE CORREO ES VÁLIDA

Debemos añadir la unidad mailchck en el formulario donde vamos a realizar la comprobación y llamamos a esta función:

function mailcheck(email: string): integer;

Y estos son los valores que devuelve:

0 - La dirección existe
1 - La dirección puede existir
2 - Tus direcciones DNS no son válidas
3 - Tus direcciones DNS no están definidas
4 - No puede conectar con los servidores MX
5 - El dominio no tiene registro MX
6 - La dirección no existe
7 - La dirección es incorrecta

ESCANEAR DIRECCIONES IP

Vamos a crear un pequeño programa que recorra un rango de direcciones IP y nos diga si existen o no. Es como si hiciésemos un Ping a cada dirección. Para ello creamos un nuevo proyecto con este formulario:

Para introducir la dirección inicial y final he añadido dos componentes TEdit llamados DirIni y DirFin, de modo que cada vez que encuentre una IP activa lo guarde en un componente TListBox llamado Lista.

Para no reinventar la rueda, vamos a copiar las unidades IPUtils.pas y IPThread.pas de la carpeta:

\CodeGear\RAD Studio\5.0\Componentes\Synapse\source\demo\scan

a la carpeta donde tenemos este proyecto y las vinculamos a nuestro formulario:

uses
  ..., IPUtils, PingThread;

Y este sería el código para recorrer todas las direcciones:

procedure TFEscanear.BEscanearClick(Sender: TObject);
var
  i, j: Cardinal;
  Ping: Array of TPingResult;
  ContadorPing, DirInicial, DirFinal: Cardinal;
  Puffer: String;
  Hilos: Array of TPingThread;
  bHilosCompletados: Boolean;
begin
  // Pasamos las direcciones IP de texto a entero
  DirInicial := IPToCardinal(StrToIP(DirIni.Text));
  DirFinal := IPToCardinal(StrToIP(DirFin.Text));

  // Contamos el nº de direcciones a escanear
  ContadorPing := (DirFinal - DirInicial) + 1;

  // Mostramos el nº de direcciones a escanear
  Lista.Items.Add('Escaneando ' + IntToStr(ContadorPing) + ' direcciones...');
  Application.ProcessMessages;

  // Inicializamos el array dinámico
  SetLength(Ping, ContadorPing);
  SetLength(Hilos, ContadorPing);

  // Recorremos las direcciones y las metemos en el array
  j := 0;
  for i := DirInicial to DirFinal do
  begin
    Ping[j].IPAdress := IPToStr(CardinalToIP(i));
    Ping[j].Exists := False;
    Inc(j);
  end;

  // Creamos un hilo para cada Ping
  for i := 0 to ContadorPing - 1 do
    Hilos[i] := TPingThread.Create(Ping[i]);

  Lista.Items.Add(' ');

  // Esperamos a que los hilos sean ejecutados
  repeat
    bHilosCompletados := True;
    Sleep(1000);
    for i := 0 to ContadorPing - 1 do
    begin
      if not Hilos[i].Ready then
      begin
        bHilosCompletados := False;
        Break;
      end;
    end;
  until bHilosCompletados;

  // Volcamos los resultados a la lista
  for i := 0 to ContadorPing - 1 do
  begin
    if Hilos[i].PingResult.Exists then
    begin
      Puffer := IntToStr(i + 1) + '  ' + Hilos[i].PingResult.IPAdress;
      Lista.Items.Add(Puffer);
    end;
  end;

  // Liberamos los hilos de ejecución
  for i := 0 to ContadorPing - 1 do
    Hilos[i].Free;
end;

Lo que hace es lanzar un hilo de ejecución por cada dirección y cuando terminen todos los muestra por pantalla. Ejecutamos el programa, pulsamos el botón Escanear y esperamos a que termine:

Si en algo destaca esta librería es en su rapidez, ya que se ventila las 250 direcciones en cuestión de segundos.

SINCRONIZAR LA HORA DE VARIOS ORDENADORES

El protocolo NTP (Network Time Procotol) se creó para sincronizar los relojes de cada PC a través de redes, algo ideal para sistemas con bases de datos distribuidas.

Vamos a crear un pequeño programa que lea la hora de un servidor SNTP o NTP:

Contiene un campo TEdit llamado URL donde metemos la dirección del servidor y una etiqueta llamada EMensaje donde volcamos la hora leída o un mensaje de error. Al pulsar el botón Leer hora ejecutamos este código:

procedure TFClienteSNTP.BLeerClick(Sender: TObject);
var
  SNTP: TSntpSend;
begin
  SNTP := TSntpSend.Create;
  try
    SNTP.TargetHost := URL.Text;

    if SNTP.GetSNTP then
      EMensaje.Caption :=
        DatetimeToStr(SNTP.NTPTime) + ' UTC'
    else
      EMensaje.Caption := 'No conectado.';
  finally
    SNTP.Free;
  end;
end;

Para poder utilizar la clase TSntpSend necesitamos añadir la unidad SNTPsend al formulario. Al ejecutar el programa, podemos probarlo con nosotros mismos ya que Windows incorpora un servidor SNTP:

La hora que devuelve es UTC, por lo que debemos incrementar más o menos horas según el país donde estemos. Lo ideal es utilizar un servidor público como este:

De este modo, todos los equipos de nuestra red estarán sincronizados incluso si se encuentran en distintas localizaciones. Aquí podéis encontrar servidores públicos:

http://www.pool.ntp.org/zone/europe


Como funciona sobre UDP, es muy rápido y puede ser de mucha utilidad para que comiencen a la vez las copias de seguridad de distintos centros o para realizar una comunicación directa por TCP a una cierta hora del día.

ENVIAR DATOS POR EL PUERTO SERIE

El ejemplo que trae Synapse sobre las comunicación por el puerto serie no funciona, ya que han cambiado los parámetros de la función Connect y los han desviado a la función Config. Para hacer una prueba hice este formulario:

Contiene los componentes TEdit llamados Puerto, Baudios y Comando que son los parámetros del puerto serie y los mensajes de salida irán a parar a un TMemo llamado Salida. Al pulsar el botón Enviar ejecutamos:

procedure TFPuetoSerie.BEnviarClick(Sender: TObject);
var
  Serie: TBlockSerial;
begin
  Serie := TBlockSerial.Create;
  Serie.RaiseExcept := True;

  try
    Serie.Config(StrToIntDef(Baudios.Text, 9600), 8, 'N', 0, False, False);
    Serie.Connect(Puerto.Text);
    Salida.Lines.Text := Serie.ATCommand(Comando.Text);
  finally
    Serie.Free;
  end;
end;

También debemos añadir la unidad SynaSer al mismo. Por más que lo he intentado siempre me salta esta excepción:

Y mira que he probado a enviarlo por COM1 o COM2, incluso me he instalado el emulador de puertos COM llamado com0com que tiene esta pantalla de configuración:

Este emulador se instala perfectamente en Windows simulando todos los puertos que queramos, pero yo con estos temas ya estoy algo obsoleto, ya que desde que pasamos a la ADSL y el resto de dispositivos van por USB (impresoras de tickets, autómatas, etc.), mi experiencia actualmente con el puerto serie es nula. Si alguien tiene ganas de investigar el asunto y tiene MODEM que pruebe a ver que tal.

CONCLUSIONES

A parte de todo lo que hemos visto, esta librería incorpora otros ejemplos como un servidor de ECHO o rutinas para codificar en MIME, algo utilizado para enviar datos por correo a pelo, pero creo que en ese sentido los componentes Indy le superan.

Por lo demás, solo queda decir que aunque no es una librería demasiado extensa, si funciona muy bien, es rápida y permite aprender como se programan algunos protocolos TCP/IP a bajo nivel, algo que puede gustarle a los programadores de troyanos y virus por su bajo consumo de recursos.

Pruebas realizadas en RAD Studio 2007.

La librería Synapse (3)

Otro de los protocolos que podemos utilizar con esta librería es la descarga de páginas web o archivos así como el envío de los mismos a un servidor. También veremos como crear un pequeño servidor de páginas web utilizando hilos de ejecución.

CREAR UN CLIENTE HTTP

Un cliente de HTTP no es lo mismo que un navegador, ya que ello implica muchísimo más trabajo. Lo que vamos a hacer es leer el código fuente de cualquier página web que nos devolverá el contenido en HTML.

Este sería el formulario donde escribimos la dirección:

Va a constar de un componente TEdit llamado URL para escribir la dirección de la página web que deseamos descargar y volcaremos el resultado en el componente TMemo llamado Pagina.

Cuando pulsemos el botón BDescargar solo hay que introducir esta línea de código:

procedure TFClienteHTTP.BDescargarClick(Sender: TObject);
begin
  HTTPGetText(URL.Text, Pagina.Lines);
end;

Para poder utilizar la función HTTPGetText tenemos que añadir la unidad HTTPSend que se encuentra en la carpeta Lib del directorio donde tengamos descomprimida la librería Synapse.

Con una sola línea de código podemos descargar la página:

También tenemos en la misma unidad las siguientes funciones:

function HttpGetBinary(const URL: string; const Response: TStream): Boolean;

Esta función es igual que la anterior pero permite descargar archivos binarios. Para hacerte tu propio Downloader.

function HttpPostBinary(const URL: string; const Data: TStream): Boolean;

Envía un archivo binario al servidor utilizando el método SEND.

function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;

Sirve para enviar datos de campos por medio de la URL al servidor, como puede ser el rellevar un formulario de solicitud y pulsar el botón POST del HTML.

function HttpPostFile(const URL, FieldName, FileName: string; const Data: TStream; const ResultData: TStrings): Boolean;

Esta función envía un archivo al servidor utilizando el método POST.

Como dije anteriormente, sigo encontrando en los componentes Synapse el problema de monitorizar el progreso de la descarga o subida de archivos con una barra de progreso.

CREAR UN SERVIDOR HTTP

La forma de crear un servidor es muy parecida a la realizada para crear un servidor FTP. Se crea un hilo primario que controla las peticiones de los clientes y en el momento que se encuentre una solicitud entonces abrimos otro hilo para atender el cliente.

Lo primero de todo es crear el formulario que va a monitorizar el servidor:

Solo vamos a tener un componente TMemo llamado Monitor donde volcaremos las páginas web que solicitan los clientes. La demo que trae Synapse del servidor http es bastante cutre y siempre devuelve la misma página diciendo lo que ha pedido el cliente. Yo he realizado una pequeña ampliación para que busque los archivos HTML en nuestro disco duro y si no los encuentra que lo diga.

Vamos primero con el hilo del servidor:

THiloServidor = class(TThread)
private
  Sock: TTCPBlockSocket;
public
  Constructor Create;
  Destructor Destroy; override;
  procedure Execute; override;
end;

El constructor creará el Sock de conexión para esperar peticiones de los clientes:

Constructor THiloServidor.Create;
begin
  inherited Create(False);
  Sock := TTCPBlockSocket.Create;
  FreeOnTerminate := True;
end;

Y el destructor la libera:

Destructor THiloServidor.Destroy;
begin
  Sock.free;
  inherited Destroy;
end;

Al poner en marcha el hilo de ejecución se queda esperando indefinidamente las peticiones de los clientes por el puerto 80:

procedure THiloServidor.Execute;
var
  ClientSock: TSocket;
begin
  with Sock do
  begin
    CreateSocket;
    SetLinger(True, 10000);
    Bind('0.0.0.0','80');
    Listen;
    repeat
      if Terminated then
        Break;
        
      if CanRead(1000) then
      begin
        ClientSock := Accept;

        if LastError = 0 then
          THiloCliente.Create(ClientSock);
      end;
    until False;
  end;
end;

Cuando el cliente realiza una petición lanzamos el hilo cliente (THiloCliente) que se compone de lo siguiente:

  THiloCliente = class(TThread)
  private
    sMensaje: string;
    Sock: TTCPBlockSocket;
  public
    Cabeceras: TStringList;
    InputData, OutputData: TMemoryStream;
    Constructor Create(HSock: TSocket);
    Destructor Destroy; override;
    procedure Execute; override;
    function ProcessHttpRequest(Request, URI: string): integer;
    procedure Monitorizar;
    function Etiqueta(sEtiqueta: string): string;
  end;

Al crear este hilo prepara las conexiones y los streams de entrada y salida:

Constructor THiloCliente.Create(HSock: TSocket);
begin
  Sock := TTCPBlockSocket.Create;
  Cabeceras := TStringList.Create;
  InputData := TMemoryStream.Create;
  OutputData := TMemoryStream.Create;
  Sock.Socket := HSock;
  FreeOnTerminate := True;
  inherited Create(False);
end;

Siendo el destructor el encargado de limpiarlo todo:

Destructor THiloCliente.Destroy;
begin
  Sock.free;
  Cabeceras.Free;
  InputData.Free;
  OutputData.Free;
  inherited Destroy;
end;

Al ejecutar el hilo leerá la petición del cliente y procesará la respuesta:

procedure THiloCliente.Execute;
var
  iLimiteTiempo: integer;
  s: string;
  sMetodo, uri, sProtocolo: string;
  size: integer;
  x, n: integer;
  resultcode: integer;
  bCerrar: boolean; // ¿Hay que cerrar la conexión?
begin
  iLimiteTiempo := 120000; // aguantamos 120 segundos

  repeat
    // Leemos la solicitud del cliente
    s := Sock.RecvString(iLimiteTiempo);

    if Sock.LastError <> 0 then
      Exit;

    if s = '' then
      Exit;

    sMetodo := Fetch(s, ' ');

    if (s = '') or (sMetodo = '') then
      Exit;

    uri := Fetch(s, ' ');

    if uri = '' then
      Exit;

    sProtocolo := Fetch(s, ' ');
    Cabeceras.Clear;
    size := -1;
    bCerrar := False;
    
    // Leemos las cabeceras HTTP
    if sProtocolo <> '' then
    begin
      if pos('HTTP/', sProtocolo) <> 1 then
        Exit;

      if pos('HTTP/1.1', sProtocolo) <> 1 then
        bCerrar := True;

      repeat
        s := Sock.RecvString(iLimiteTiempo);

        if Sock.lasterror <> 0 then
          Exit;

        if s <> '' then
          Cabeceras.add(s);

        if Pos('CONTENT-LENGTH:', UpperCase(s)) = 1 then
          Size := StrToIntDef(SeparateRight(s, ' '), -1);

        if Pos('CONNECTION: CLOSE', Uppercase(s)) = 1 then
          bCerrar := true;
          
      until s = '';
    end;

    // Leemos el contenido del documento
    InputData.Clear;
    if size >= 0 then
    begin
      InputData.SetSize(Size);
      x := Sock.RecvBufferEx(InputData.Memory, Size, iLimiteTiempo);
      InputData.SetSize(x);
      
      if Sock.lasterror <> 0 then
        Exit;
    end;
    
    OutputData.Clear;
    ResultCode := ProcessHttpRequest(sMetodo, uri);
    Sock.SendString(sProtocolo + ' ' + IntTostr(ResultCode) + CRLF);

    if sProtocolo <> '' then
    begin
      Cabeceras.Add('Content-length: ' + IntTostr(OutputData.Size));

      if bCerrar then
        Cabeceras.Add('Connection: close');

      Cabeceras.Add('Date: ' + Rfc822DateTime(now));
      Cabeceras.Add('Server: Servidor HTTP creado con Synapse');
      Cabeceras.Add('');
      
      for n := 0 to Cabeceras.count - 1 do
        Sock.SendString(Cabeceras[n] + CRLF);
    end;

    if Sock.Lasterror <> 0 then
      Exit;
      
    Sock.SendBuffer(OutputData.Memory, OutputData.Size);

    if bCerrar then
      Break;
      
  until Sock.LastError <> 0;
end;

Dicha respuesta viene definida en este método:

function THiloCliente.ProcessHttpRequest(Request, URI: string): integer;
var
  Pagina: TStringlist;
  sRuta: string;
begin
  sMensaje := URI;
  Synchronize(Monitorizar);
  result := 504;
  sRuta := ExtractFilePath(Application.ExeName);

  if request = 'GET' then
  begin
    // Preparamos las cabeceras del HTTP
    Cabeceras.Clear;
    Cabeceras.Add('Content-type: Text/Html');
    Pagina := TStringList.Create;

    // ¿Existe la página web que estamos buscando?
    if FileExists(sRuta + URI) then
    begin
      Pagina.LoadFromFile(sRuta + URI)
    end
    else
    begin
      Pagina.Add(Etiqueta('html'));
      Pagina.Add(Etiqueta('head') + Etiqueta('/head'));
      Pagina.Add(Etiqueta('body'));
      Pagina.Add('No encuentro la página web que ha solicitado:');
      Pagina.Add(Etiqueta('br'));
      Pagina.Add(URI);
      Pagina.Add(Etiqueta('/body'));
      Pagina.Add(Etiqueta('/html'));
    end;

    Pagina.SaveToStream(OutputData);
    Pagina.Free;
    Result := 200;
  end;
end;

Como Blogger no me deja escribir el código fuente con etiquetas he creado esta función que las monta:

function THiloCliente.Etiqueta(sEtiqueta: string): string;
begin
  Result := '<' + sEtiqueta + '>';
end;

Para poder ver los mensajes en el servidor he creado este método:

procedure THiloCliente.Monitorizar;
begin
  FServidorHTTP.Monitor.Lines.Add(sMensaje);
end;

Que será llamado mediante Synchronize para enviar los mensajes al Memo. En el evento OnCreate del formulario ponemos en marcha el hilo del servidor:

procedure TFServidorHTTP.FormCreate(Sender: TObject);
begin
  Monitor.Lines.Add('Arrancando servidor HTTP en puerto 80...');
  HiloServidor := THiloServidor.Create;
end;

Y debemos acordarnos de destruirlo al liberar el formulario:

procedure TFServidorHTTP.FormDestroy(Sender: TObject);
begin
  HiloServidor.Terminate;
end;

Para hacer una prueba he creado un par de páginas web donde la principal sería con el nombre index.html:

Y la página llamada pagina1.html que permite volver a la principal:

Pues bueno, ponemos en marcha el servidor:

Abrimos un navegador y solicitamos la página principal:

Podemos entrar a la página 1 sin problemas:

Pero si volvemos a la principal e intentamos ir a la página 2 nos devolverá esto:

En todo momento podemos ver lo que le van pidiendo al servidor:

El icono favicon.ico lo solicitan los navegadores cada vez que se entra a una web. Es este icono:

Esta sería la base mínima para crear un servidor de páginas web tipo Apache. Pero también hay que preocuparse de otras cuestiones como servir las imágenes que hay dentro de las mismas, controlar las peticiones GET y POST de formularios, etc. Digamos que no es una cosa que se haga en dos tardes. Pero gozamos de la ventaja de tener un servidor muy rápido para tareas específicas: notificaciones para actualizaciones de software (tipo antivirus), descarga de versiones con contraseña o enviar solicitudes de licencia al servidor.

Seguiremos en el próximo artículo con más protocolos de Synapse.

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.

Crea tu propio servidor HTTP (y 4)

Vamos a terminar de ver las características principales del componente TIdHTTPServer viendo como validar a los usuarios del mismo utilizando las cookies del navegador.

Para el que no las conozca, las cookies son archivos temporales que una aplicación web puede crear en el navegador del cliente para guardar estados de sesión. En nuestro caso vamos a guardar el usuario y la contraseña del usuario que ha entrado.

REPROGRAMANDO EL EVENTO ONCOMMANDGET

En el evento OnCommandGet vamos a mostrar en la ventana del servidor las cookies que devuelve el navegador del cliente y también vamos a dar la posibilidad de entrar a la página principal del foro (foro.html) cuando los usuarios sean validados:

procedure TFServidorHTTP.ServidorCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  sDocumento: String;
  i: Integer;
begin
  if ARequestInfo.Cookies.Count > 0 then
  begin
    for i := 0 to ARequestInfo.Cookies.Count-1 do
      Log.Lines.Add( 'cookie: ' + ARequestInfo.Cookies[i].CookieName + ': ' +
        ARequestInfo.Cookies[i].Value );
  end;

  if ARequestInfo.Document = '/registrar' then
    RegistrarUsuario( ARequestInfo, AResponseInfo );

  if ARequestInfo.Document = '/entrar' then
    Entrar( ARequestInfo, AResponseInfo );

  if ARequestInfo.Document = '/enviarmensaje' then
    EnviarMensaje( ARequestInfo, AResponseInfo );

  if ARequestInfo.Document = '/foro.html' then
  begin
    Foro( ARequestInfo, AResponseInfo );
    Exit;
  end;

  // ¿Va a entrar a la página principal?
  if ARequestInfo.Document = '/' then
    AResponseInfo.ServeFile( AContext, ExtractFilePath( Application.ExeName ) + 'index.html' )
  else
  begin
    // Cargamos la página web que vamos a enviar
    sDocumento := ExtractFilePath( Application.ExeName ) +
      Copy( ARequestInfo.Document, 2, Length( ARequestInfo.Document ) );

    // ¿Existe la página que ha solicitado?
    if FileExists( sDocumento ) then
      AResponseInfo.ServeFile( AContext, sDocumento )
    else
      // No hemos encontrado la página
      AResponseInfo.ResponseNo := 404;
  end;

  AResponseInfo.CloseConnection := True;
end;

He añadido como novedades la posibilidad de ver las cookies que tiene el cliente en el navegador:

  if ARequestInfo.Cookies.Count > 0 then
  begin
    for i := 0 to ARequestInfo.Cookies.Count-1 do
      Log.Lines.Add( 'cookie: ' + ARequestInfo.Cookies[i].CookieName + ': ' +
        ARequestInfo.Cookies[i].Value );
  end;

Y suministrar la página del foro donde se van a escribir los mensajes:

  if ARequestInfo.Document = '/foro.html' then
  begin
    Foro( ARequestInfo, AResponseInfo );
    Exit;
  end;

Ahora debemos modificar la página de entrada para crear las cookies.

CREANDO LAS COOKIES EN EL NAVEGADOR DEL USUARIO

Vamos a modificar nuestro procedimiento de entrar para que cuando el usuario sea validado cree en el navegador del cliente dos cookies para almacenar el usuario y su contraseña:

procedure TFServidorHTTP.Entrar( ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo );
var
  sNombre, sPassword, sError, sUsuarios: String;
  Usuarios: TStringList;
begin
  sNombre := ARequestInfo.Params.Values['nombre'];
  sPassword := ARequestInfo.Params.Values['password'];

  // Abrimos la lista de usuarios
  sUsuarios := ExtractFilePath( Application.ExeName ) + 'usuarios.txt';
  Usuarios := TStringList.Create;

  if FileExists( sUsuarios ) then
    Usuarios.LoadFromFile( sUsuarios );

  // Comprobamos si el usuario ya ha sido dado de alta en la lista
  if Usuarios.Values[sNombre] = '' then
    sError := '<h3>El usuario no existe.</h3>'
  else
    if Usuarios.Values[sNombre] <> sPassword then
      sError := '<h3>La contraseña es incorrecta.</h3>';

  if sError <> '' then
  begin
    AResponseInfo.ContentText := sError;
    AResponseInfo.WriteContent;
  end
  else
  begin
    with AResponseInfo.Cookies.Add do
    begin
      CookieName := 'usuario';
      Value := sNombre;
    end;

    with AResponseInfo.Cookies.Add do
    begin
      CookieName := 'password';
      Value := sPassword;
    end;

    AResponseInfo.Redirect( 'foro.html' );
    AResponseInfo.WriteContent;
  end;

  Usuarios.Free;
end;

Cuando el usuario ha sido validado le creamos las dos cookies y redireccionamos al cliente a la página del foro.

CREANDO LA PÁGINA WEB DEL FORO

La página web del foro va a ser la siguiente:


La página principal del foro contiene en su parte superior el nombre el usuario que ha entrado y la lista de mensajes que han enviado los usuarios. En la parte inferior muestro también el número de mensajes que hay en el foro y un pequeño formulario para escribir un nuevo mensaje.

Todo esto lo gestiono con un nuevo procedimiento llamado Foro que genera toda la página web:

procedure TFServidorHTTP.Foro( ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo );
var
  i: Integer;
  Mensajes, Usuarios: TStringList;
  s, sUsuario, sPassword, sMensajes, sUsuarios: String;
begin
  // Antes de entrar en el foro comprobamos si el usuario está registrado.
  // Para ello leemos las cookies del navegador del cliente
  i := ARequestInfo.Cookies.GetCookieIndex(0,'usuario');
  if i > -1 then
    sUsuario := ARequestInfo.Cookies[i].Value;

  i := ARequestInfo.Cookies.GetCookieIndex(0,'password');
  if i > -1 then
    sPassword := ARequestInfo.Cookies[i].Value;

  // Cargamos la lista de usuarios y verificamos su acceso
  sUsuarios := ExtractFilePath( Application.ExeName ) + 'usuarios.txt';
  Usuarios := TStringList.Create;
  if FileExists( sUsuarios ) then
    Usuarios.LoadFromFile( sUsuarios );

  if Usuarios.IndexOf( sUsuario + '=' + sPassword ) = -1 then
  begin
    AResponseInfo.Redirect( 'index.html' );
    AResponseInfo.WriteContent;
    Usuarios.Free;
  end
  else
    Usuarios.Free;

  sMensajes := ExtractFilePath( Application.ExeName ) + 'mensajes.txt';
  Mensajes := TStringList.Create;

  if FileExists( sMensajes ) then
    Mensajes.LoadFromFile( sMensajes );

  s := '<h2>Listado de mensajes</h2><p>';

  // Mostramos el usuario logeado

  i := ARequestInfo.Cookies.GetCookieIndex(0,'usuario');
  if i > -1 then
    s := s + '<h2>Usuario: ' + ARequestInfo.Cookies[i].Value + '</h2>';

  for i := 0 to Mensajes.Count - 1 do
    s := s + Mensajes[i] + '<p>';

  s := s + '<h4>Hay un total de ' + IntToStr( Mensajes.Count ) +
   ' mensajes</h4>';

  s := s + '<p><h4>Escribir un nuevo mensaje</h4>';
  s := s + '<form name="mensaje" action="enviarmensaje" method="post">';
  s := s + '<label for="nombre">Título: </label><br>';
  s := s + '<input name="titulo" size="40" type="text"><br>';
  s := s + '<label for="nombre">Mensaje: </label><br>';
  s := s + '<textarea name="mensaje" rows="3" cols="40"></textarea>
<p><br>';
  s := s + '<input value="Enviar" type="submit"></form>';

  Mensajes.Free;
  AResponseInfo.ContentText := s;
end;

Antes de poder listar los mensajes del foro tenemos que validar al usuario leyendo las cookies y comprobando si esta en la lista de usuarios. Después muestro los mensajes que ha enviado cada usuario.

Aunque con una validación como esta es suficiente para controlar la entrada de usuarios, para crear un foro en condiciones habría que crear más cookies para identificadores de sesión, control del tiempo que lleva el usuario así como un poco de encriptación en las cookies para evitar el robo de las claves mediante sniffers.

También habría que guardar la información del foro en una base de datos fiable como Internase, Firebird, etc. Esto unido a unas buenas hojas de estilo CSS nos permitirá crear unas aplicaciones web pequeñas y potentes.

Y este sería el procedimiento EnviarMensaje:

procedure TFServidorHTTP.EnviarMensaje( ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo );
var
  i: Integer;
  sTitulo, sMensaje, sError, sMensajes, sUsuario: String;
  Mensajes: TStringList;
begin
  sTitulo := ARequestInfo.Params.Values['titulo'];
  sMensaje := ARequestInfo.Params.Values['mensaje'];

  i := ARequestInfo.Cookies.GetCookieIndex(0,'usuario');
  if i > -1 then
    sUsuario := ' ' + ARequestInfo.Cookies[i].Value;

  if sTitulo = '' then
    sError := '<h3>Debe introducir el título del mensaje</h3>';

  if sMensaje = '' then
    sError := '<h3>Debe introducir el mensaje</h3>';

  // Abrimos la lista de mensajes
  sMensajes := ExtractFilePath( Application.ExeName ) + 'mensajes.txt';
  Mensajes := TStringList.Create;

  if FileExists( sMensajes ) then
    Mensajes.LoadFromFile( sMensajes );

  if sError <> '' then
    AResponseInfo.ContentText := sError
  else
  begin
    Mensajes.Add( '<h4>' + DateTimeToStr( Now ) + sUsuario + '</h4><p>' +
      UpperCase( sTitulo ) + ': ' + sMensaje );
    Mensajes.SaveToFile( sMensajes );
    AResponseInfo.Redirect( 'foro.html' );
  end;

  AResponseInfo.WriteContent;
  Mensajes.Free;
end;

Este procedimiento es el utilizado por los usuarios para enviar un mensaje al foro.

Con esto termino estos artículos relacionados con el componente TIdHTTPServer aunque no descarto escribir más sobre el mismo si descubro más utilidades interesantes como puede ser por ejemplo la creación de páginas web seguras con SSL.

Pruebas realizadas en RAD Studio 2007.

Crea tu propio servidor HTTP (3)

Si bien hemos aprendido a que el navegador pida nombre de usuario y clave para entrar en nuestras webs privadas, la forma más natural de entrar a una página web suele ser dándose de alta en un formulario HTML para luego entrar con sus datos.

En esta ocasión no vamos a utilizar por ahora las propiedades de autenticación que vimos en artículos anteriores con AResponseInfo.AuthRealm ni vamos controlar la sesión con la clase TIdHTTPSession.

Vamos a comenzar a ver un ejemplo de cómo crear nuestro propio foro. En este artículo vamos a controlar el registro y la entrada de usuarios.

CREANDO LAS PÁGINAS WEB DEL FORO

Para crear un foro necesitamos una página web de entrada que permita hacer login al usuario así como darse de alta en nuestro foro. Esta va a ser nuestra página web de entrada:

El código fuente de la página se puede hacer con el bloc de notas de Windows (clic para ampliar):


La página contiene un formulario que recoge el usuario y su contraseña para luego pulsar el botón Enviar. Esta página hay que guardarla con el nombre index.html.

Cuando el usuario pulse el enlace Registrar entonces saltará a esta otra página:


Cuyo código fuente es el siguiente:


Ahora es cuando tenemos que entrar en faena y programar nuestro servidor HTTP.

CREANDO LA APLICACIÓN SERVIDOR

La ventana del servidor es prácticamente la misma que vimos en los artículos anteriores:


Lo que vamos a cambiar va a ser el evento OnCommandGet del componente TIdHTTPServer:

procedure TFServidorHTTP.ServidorCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  sDocumento: String;
begin
  Log.Lines.Add( ARequestInfo.RemoteIP + ': ' +
  ARequestInfo.Command + ARequestInfo.Document );

  Log.Lines.Add( 'Parámetros: ' + ARequestInfo.Params.Text );

  if ARequestInfo.Document = '/registrar' then
    RegistrarUsuario( ARequestInfo, AResponseInfo );

  if ARequestInfo.Document = '/entrar' then
    Entrar( ARequestInfo, AResponseInfo );

  // ¿Va a entrar a la página principal?
  if ARequestInfo.Document = '/' then
    AResponseInfo.ServeFile( AContext, ExtractFilePath( Application.ExeName ) + 'index.html' )
  else
  begin
    // Cargamos la página web que vamos a enviar
    sDocumento := ExtractFilePath( Application.ExeName ) +
    Copy( ARequestInfo.Document, 2, Length( ARequestInfo.Document ) );

    // ¿Existe la página que ha solicitado?
    if FileExists( sDocumento ) then
      AResponseInfo.ServeFile( AContext, sDocumento )
    else
      // No hemos encontrado la página
      AResponseInfo.ResponseNo := 404;
  end;

  AResponseInfo.CloseConnection := True;
end;

Este evento se compone de las siguientes partes:

1º Mostramos en la ventana del servidor que página web nos solicita el usuario y los parámetros de la misma:

Log.Lines.Add( ARequestInfo.RemoteIP + ': ' +
ARequestInfo.Command + ARequestInfo.Document );

Log.Lines.Add( 'Parámetros: ' + ARequestInfo.Params.Text );

Los parámetros serán los datos que el usuario ha rellenado en el formulario web antes de pulsar el botón Enviar.

2º Si el usuario pulsa los botones de registrarse en la página o hacer login entonces envío a cada uno a su procedimiento correspondiente para dar más claridad al código:

if ARequestInfo.Document = '/registrar' then
  RegistrarUsuario( ARequestInfo, AResponseInfo );

if ARequestInfo.Document = '/entrar' then
  Entrar( ARequestInfo, AResponseInfo );

3º En caso de que el usuario haya solicitado otra página al servidor se la mandamos normalmente:

// ¿Va a entrar a la página principal?
if ARequestInfo.Document = '/' then
  AResponseInfo.ServeFile( AContext, ExtractFilePath( Application.ExeName ) + 'index.html' )
else
  begin
    // Cargamos la página web que vamos a enviar
    sDocumento := ExtractFilePath( Application.ExeName ) +
    Copy( ARequestInfo.Document, 2, Length( ARequestInfo.Document ) );

    // ¿Existe la página que ha solicitado?
    if FileExists( sDocumento ) then
      AResponseInfo.ServeFile( AContext, sDocumento )
    else
      // No hemos encontrado la página
      AResponseInfo.ResponseNo := 404;
  end;

  AResponseInfo.CloseConnection := True;
end;

CONTROLANDO EL REGISTRO DE USUARIOS

El procedimiento encargado de dar de alta los usuarios tiene que comprobar si el usuario ya rellenado correctamente su nombre, la contraseña y si las contraseñas coinciden:

procedure TFServidorHTTP.RegistrarUsuario( ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo );
var
  sNombre, sPassword, sPassword2, sError, sUsuarios: String;
  Usuarios: TStringList;
begin
  sNombre := ARequestInfo.Params.Values['nombre'];
  sPassword := ARequestInfo.Params.Values['password'];
  sPassword2 := ARequestInfo.Params.Values['password2'];

  if sPassword <> sPassword2 then
    sError := '<h3>Las contraseñas no coinciden.</h3>';

  if sPassword2 = '' then
    sError := '<h3>Debe repetir la contraseña.</h3>';

  if sPassword = '' then
    sError := '<h3>No ha introducido la contraseña.</h3>';

  if sNombre = '' then
    sError := '<h3>No ha introducido el nombre del usuario.</h3>';

  // Abrimos la lista de usuarios
  sUsuarios := ExtractFilePath( Application.ExeName ) + 'usuarios.txt';
  Usuarios := TStringList.Create;

  if FileExists( sUsuarios ) then
    Usuarios.LoadFromFile( sUsuarios );

  // Comprobamos si el usuario ya ha sido dado de alta en la lista
  if sError = '' then
  begin
    if Usuarios.Values[sNombre] <> '' then
      sError := '<h3>El usuario ya existe. Elija otro nombre.</h3>';
  end;

  if sError <> '' then
    AResponseInfo.ContentText := sError
  else
  begin
    Usuarios.Add( sNombre + '=' + sPassword );

    AResponseInfo.ContentText := '<h3>Usuario registrado correctamente:<p>' +
'Nombre: ' + sNombre + '<p>' + 'Contraseña: ' + sPassword + '<p>' +
'<a href="http://www.blogger.com/index.html">Entrar al foro.</a></p></h3>';

    Usuarios.SaveToFile( sUsuarios );
  end;

  AResponseInfo.WriteContent;
  Usuarios.Free;
end;

En caso de error mostraría su mensaje correspondiente:


En el caso de que se hayan escrito bien todos los datos lo que hago es guardar la lista de usuarios y sus contraseñas en un archivo de texto que se llamará usuarios.txt. También compruebo si el usuario ya ha sido dado de alta con anterioridad.

Una vez que ha sido dado de alta lo muestro en pantalla:


A su vez vemos como la ventana del servidor va controlando lo que manda el navegador:


Al pulsar el enlace Entrar al foro volverá a la pantalla principal para hacer login.

CONTROLANDO LA ENTRADA DE USUARIOS

El procedimiento encargado de entrar en nuestro foro es parecido y más sencillo que el de registro:

procedure TFServidorHTTP.Entrar( ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo );
var
  sNombre, sPassword, sError, sUsuarios: String;
  Usuarios: TStringList;
begin
  sNombre := ARequestInfo.Params.Values['nombre'];
  sPassword := ARequestInfo.Params.Values['password'];

  // Abrimos la lista de usuarios
  sUsuarios := ExtractFilePath( Application.ExeName ) + 'usuarios.txt';
  Usuarios := TStringList.Create;

  if FileExists( sUsuarios ) then
    Usuarios.LoadFromFile( sUsuarios );

  // Comprobamos si el usuario ya ha sido dado de alta en la lista
  if Usuarios.Values[sNombre] = '' then
    sError := '<h3>El usuario no existe.</h3>'
  else
    if Usuarios.Values[sNombre] <> sPassword then
      sError := '<h3>La contraseña es incorrecta.</h3>';

  if sError <> '' then
    AResponseInfo.ContentText := sError
 else
   AResponseInfo.ContentText := '<h3>Bienvenido al foro ' + sNombre + '<p>' +
'<a href="http://www.blogger.com/index.html">Salir</a></h3>';

  AResponseInfo.WriteContent;
  Usuarios.Free;
end;

Sólo hay que asegurarse de que el usuario esté dado de alta en nuestra lista y luego lo dejamos pasar:


Todos los usuarios datos de alta quedan almacenados en el archivo usuarios.txt:


En el próximo artículo vamos a implementar el sistema visualización y envío de mensajes al foro por parte de cada usuario.

No he incluido las diferencias respecto a Delphi 7 porque los cambios son los mismos respecto a los anteriores artículos (ServeFile).

Pruebas realizadas en RAD Studio 2007.

Crea tu propio servidor HTTP (2)

Si en el anterior artículo vimos como validar la entrada de usuarios utilizando el usuario y la contraseña que pide el navegador del cliente, ahora vamos a ver como mantener el estado del usuario permanentemente en el servidor.

El estado en el servidor suele utilizarse por ejemplo para comprobar el tiempo que lleva conectado, el número de peticiones que ha realizado o para guardar las últimas consultas que ha realizado en el servidor. Esto es muy utilizado en los juegos RPG online donde suele guardarse la puntuación, energía, objetos, etc.

CREANDO UNA SESION

Los componentes Indy tienen un clase asociada el protocolo HTTP llamada TIdHTTPSession. Para utilizar este objeto hay que crearlo dentro de la lista de sesiones que tiene la clase TIdHTTPServer.

En el ejemplo que he realizado para el evento OnCommandGet voy a guardar en la sesión la fecha y la hora de cuando comenzó la sesión ese usuario:

procedure TFServidorHTTP.ServidorCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  sDocumento, sSesionID: String;
  Sesion: TIdHTTPSession;
begin
  Log.Lines.Add( ARequestInfo.RemoteIP + ': ' +
    ARequestInfo.Command + ARequestInfo.Document );

  // ¿Va a entrar a la página principal?
  if ARequestInfo.Document = '/' then
    AResponseInfo.ServeFile( AContext, ExtractFilePath( Application.ExeName ) + 'index.html' )
  else
  begin
    // Cargamos la página web que vamos a enviar
    sDocumento := ExtractFilePath( Application.ExeName ) +
      Copy( ARequestInfo.Document, 2, Length( ARequestInfo.Document ) );

    // ¿Existe la página que ha solicitado?
    if FileExists( sDocumento ) then
    begin
      // validamos al usuario
      if not ( ( ARequestInfo.AuthUsername = 'admin' ) and
        ( ARequestInfo.AuthPassword = '1234' ) ) then
        AResponseInfo.AuthRealm := 'ServidorHTTP'
      else
      begin
        // Componemos el ID de la sesión con el nombre del usuario y su password
        sSesionID := ARequestInfo.RemoteIP + '_' +  ARequestInfo.AuthUsername +
           '_' + ARequestInfo.AuthPassword;

        // Comprobamos si ese usuario ya tiene una sesión abierta
        Sesion := Servidor.SessionList.GetSession( sSesionID, ARequestInfo.RemoteIP );

        // Si no tiene sesión le pedimos autentificarse
        if Sesion = nil then
          // Creamos una nueva sesión para este usuario
          Sesion := Servidor.SessionList.CreateSession( ARequestInfo.RemoteIP, sSesionID );

        AResponseInfo.ServeFile( AContext, sDocumento );
      end
    end
    else
      // No hemos encontrado la página
      AResponseInfo.ResponseNo := 404;
  end;

  AResponseInfo.CloseConnection := True;
end;

Después de identificar al usuario comprobamos si existe una sesión asociada al mismo. Cuando se crea una nueva sesión tenemos que darle un identificador que sea único en nuestro servidor. En nuestro caso he creado un ID juntando la IP del usuario, el nombre y su contraseña:

sSesionID := ARequestInfo.RemoteIP + '_' +  ARequestInfo.AuthUsername +
       '_' + ARequestInfo.AuthPassword;

Después compruebo si ya está abierta una sesión para este usuario y si no es así entonces le creamos una sesión:

// Comprobamos si ese usuario ya tiene una sesión abierta
Sesion := Servidor.SessionList.GetSession( sSesionID, ARequestInfo.RemoteIP );

// Si no tiene sesión le pedimos autentificarse
if Sesion = nil then
  // Creamos una nueva sesión para este usuario
  Sesion := Servidor.SessionList.CreateSession( ARequestInfo.RemoteIP, sSesionID );

Primero llama al método GetSession que necesita el identificador de la sesión y la IP del usuario remoto. Si no la encuentra creamos una nueva sesión que se añadirá automáticamente a la lista de sesiones del servidor.

Ahora introducimos en el evento OnSessionStart el código que guarda la fecha y la hora de cuando el usuario comenzó su conexión:

procedure TFServidorHTTP.ServidorSessionStart(Sender: TIdHTTPSession);
begin
  Sender.Content.Text := DateTimeToStr( Now );
  Log.Lines.Add( 'Iniciada sesion de ' + Sender.SessionID + ' en ' +
  Sender.Content.Text );
end;

La clase TIdHTTPSession permite guardar en su variable Content (que es de la clase TStrings) cualquier texto que nos venga en gana. En mi caso sólo he guardado la fecha y hora de cuando entró el usuario.

En el evento OnSessionEnd mostramos en la ventana del servidor cuando finalizó el usuario:

procedure TFServidorHTTP.ServidorSessionEnd(Sender: TIdHTTPSession);
begin
  Log.Lines.Add( 'Finalizada sesion de ' + Sender.SessionID + ' en ' +
    DateTimeToStr( Now ) + ' (' + FormatFloat( '###0', MinuteSpan(
    Now, StrToDateTime( Sender.Content.Text ) ) ) + ' minutos)' );
end;

La función MinuteSpan calcula la diferencia en minutos entre dos variables TDateTime. Para poder utilizar esta función hay que añadir arriba la unidad DateUtils.

Este sería el resultado al entrar a nuestro servidor:


Entramos en la zona privada:


Una vez dentro podemos esperar un par de minutos:


Al desactivar el servidor se cerrarán automáticamente todas las sesiones (lo hace sólo el componente TIdHTTPServer) mostrando en pantalla los minutos que ha permanecido nuestro usuario con la sesión abierta:


Mediante este sistema podemos guardar todas las acciones del usuario en el servidor sin necesidad de utilizar los cookies del navegador del cliente. Si queremos que los datos de cada usuario sean permanentes sólo hay que guardar el contenido de la variable Content a disco en un fichero cuyo nombre sea por ejemplo el ID del usuario. De ese modo, cuando el usuario se conecte otro día puede recuperar sus datos.

VARIACIONES PARA DELPHI 7

Como vimos en el artículo anterior, para Delphi 7 hay que hacer una pequeña variación ya que el objeto TIdHTTPResponseInfo no tiene el método ServeFile:

procedure TFServidorHTTP.ServidorCommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  sDocumento, sSesionID: String;
  Sesion: TIdHTTPSession;
  S: TStringList;
begin
  S := TStringList.Create;
  Log.Lines.Add( ARequestInfo.RemoteIP + ': ' +
    ARequestInfo.Command + ARequestInfo.Document );

  // ¿Va a entrar a la página principal?
  if ARequestInfo.Document = '/' then
  begin
    S.LoadFromFile( ExtractFilePath( Application.ExeName ) + 'index.html' );
    AResponseInfo.ContentText := S.Text;
  end
  else
  begin
    // Cargamos la página web que vamos a enviar
    sDocumento := ExtractFilePath( Application.ExeName ) +
      Copy( ARequestInfo.Document, 2, Length( ARequestInfo.Document ) );

    // ¿Existe la página que ha solicitado?
    if FileExists( sDocumento ) then
    begin
      // validamos al usuario
      if not ( ( ARequestInfo.AuthUsername = 'admin' ) and
        ( ARequestInfo.AuthPassword = '1234' ) ) then
        AResponseInfo.AuthRealm := 'ServidorHTTP'
      else
      begin
        // Componemos el ID de la sesión con el nombre del usuario y su password
        sSesionID := ARequestInfo.RemoteIP + '_' +  ARequestInfo.AuthUsername +
           '_' + ARequestInfo.AuthPassword;

        // Comprobamos si ese usuario ya tiene una sesión abierta
        Sesion := Servidor.SessionList.GetSession( sSesionID, ARequestInfo.RemoteIP );

        // Si no tiene sesión le pedimos autentificarse
        if Sesion = nil then
          // Creamos una nueva sesión para este usuario
          Sesion := Servidor.SessionList.CreateSession( ARequestInfo.RemoteIP, sSesionID );

        S.LoadFromFile( sDocumento );
        AResponseInfo.ContentText := S.Text;
      end
    end
    else
      // No hemos encontrado la página
      AResponseInfo.ResponseNo := 404;
  end;

  AResponseInfo.CloseConnection := True;
  S.Free;
end;

Los demás métodos funcionan exactamente igual.

En el siguiente artículo vamos a seguir exprimiendo nuestro servidor con nuevas funcionalidades.

Pruebas realizadas en RAD Studio 2007 y Delphi 7.