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.
