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.