Generando un informe de Microsoft Word

Aunque hay muchos generadores de informes para Delphi como pueden ser QuickReport, Rave Reports, Report Manager, etc., no hay procesador de textos más completo que Microsoft Word.

Es este artículo vamos a ver como generar un nuevo documento de Word y poder introducir textos, tablas, figuras, notas al pie, etc. Esto lo vamos a conseguir utilizando el componente TWordApplication que encuentra en el apartado Servers dentro de la paleta de componentes.

Aunque no he conseguido averiguar la inmensidad de funciones que incorpora este objeto sí que podemos generar un informe más o menos decente.

EL COMPONENTE TWORDAPPLICATION

Insertamos el componente en nuestro formulario y lo llamamos Word para abreviar:


Este es el documento que vamos a generar:


Creamos un par de variables del tipo OleVariant para poder enviar parámetros a funciones:

var
  Documento, Texto: OleVariant;

Conectamos con Microsoft Word y le decimos que cree un nuevo documento que va a llamarse Informe.doc y que va a guardarse en el mismo directorio donde nos encontramos:

// Conectamos con Word y creamos un nuevo documento
Documento := ExtractFilePath( Application.ExeName ) + 'Informe.doc';
Word.Connect;
Word.Documents.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam);

Entramos al encabezado del documento y escribimos el título centrado:

with Word do
begin
  with Selection do
  begin
    // Insertamos un título en el encabezado del documento
    with Sections.Item(1).Headers.Item(1).Range do
    begin
      Font.Name := 'Courier New';
      Font.Bold := 1;
      Text := 'TITULO DEL DOCUMENTO';
      Paragraphs.Item(1).Alignment := 1; // centramos párrafo
    end;

La propiedad Selection contempla el punto donde se encuentra el cursor al principio de la página.

Dentro del documento escribimos tres frases de un color distinto:

    // Establecemos la fuente Tahoma, negrita, azul y tamaño 10
    Font.Name := 'Tahoma';
    Font.Size := 10;
    Font.Color := clNavy;
    Font.Bold := 1;
    TypeText( 'Frase 1' + #13 );
    Font.Color := clRed;
    TypeText( 'Frase 2' + #13 );
    Font.Color := clGreen;
    TypeText( 'Frase 3' + #13 + #13 + #13 );

También vamos a insertar una nota al pie de página y otra al final del documento:

    // Insertamos una nota al pie y una nota al final
    Texto := 'Nota al pie de página';
    FootNotes.Add( Range, EmptyParam, Texto );
    Texto := 'Nota al final';
    EndNotes.Add( Range, EmptyParam, Texto );

Además insertamos una tabla configurando todas las celdas:

    // Insertamos una tabla con fuente de color negro
    Font.Color := clBlack;
    with Tables.Add( Range, 3, 4, EmptyParam, EmptyParam ) do
    begin
      // Títulos de la tabla
      Cell(1,1).Range.Text := 'Unidades';
      Cell(1,2).Range.Text := 'Artículo';
      Cell(1,3).Range.Text := 'Precio';
      Cell(1,4).Range.Text := 'Total';
      Rows.Item(1).Shading.BackgroundPatternColor := clGreen; // fonfo verde
      Rows.Item(1).Range.Font.Color := clYellow; // fuente amarilla

      // Contenido
      Cell(2,1).Range.Text := '1';
      Cell(2,2).Range.Text := 'PORTATIL ACER';
      Cell(2,3).Range.Text := '540';
      Cell(2,4).Range.Text := '540';
      Cell(3,1).Range.Text := '2';
      Cell(3,2).Range.Text := 'RATON OPTICO';
      Cell(3,3).Range.Text := '2,50';
      Cell(3,4).Range.Text := '5';
      Columns.Item(4).Shading.BackgroundPatternColor := clBlue; // fondo azul
    end;
  end;
end;

Para crear una nueva tabla hemos llamado a:

Tables.Add( Range, 3, 4, EmptyParam, EmptyParam )

El segundo parámetro determina el número de filas y el tercero el número de columnas.

Aparte de añadir el contenido a cada celda hemos establecido para toda la primera fila el fondo de color verde y la fuente de color amarillo:

      Rows.Item(1).Shading.BackgroundPatternColor := clGreen; // fonfo verde
      Rows.Item(1).Range.Font.Color := clYellow; // fuente amarilla

Igualmente le hemos dicho a la cuarta columna que el color de fondo es azul:

Columns.Item(4).Shading.BackgroundPatternColor := clBlue; // fondo azul

Aun así, si queremos ser más específicos podemos hacerlo para cada celda (Cells).

Por último he añadido una línea recta cuyas coordenadas van por pixels:

Word.ActiveDocument.Shapes.AddLine( 200, 200, 250, 250, EmptyParam );

Una vez hemos finalizado el documento lo guardamos y desconectamos de Word:

Word.ActiveDocument.SaveAs( Documento,
  EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
  EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
  EmptyParam, EmptyParam, EmptyParam );
Word.Quit;
Word.Disconnect;

Aunque me hubiera gustado poder añadir muchos más elementos a este informe, debido a la pésima documentación de Delphi 2007 y que en la web tampoco abundan muchos ejemplos (lo único decente que he visto es de unas páginas rusas y japonesas). Si averiguo más cosas lo ampliaré en un futuro.

Pruebas realizadas en RAD Studio 2007.

Creando una hoja de cálculo desde Delphi

Al igual que en el artículo anterior vimos como leer datos de una hoja de cálculo de Microsoft Excel hoy vamos a ver como crearla, rellenarla con datos y fórmulas para luego guardarla en disco.

Para ello utilizaremos el mismo componente: TExcelApplication. Le pondremos igualmente en su propiedad Name el nombre Excel. Mi objetivo es crear esta hoja de cálculo:


Esta hoja contiene 4 columnas con las unidades, el nombre del artículo, el precio y total línea. La columna del total debe contener una fórmula que multiplique las unidades por el precio.

Vamos a ver paso a paso como crear esta hoja de cálculo:

1º Declaramos la variable Hoja de tipo _WorkSheet para que apunte a la hoja de cálculo con la que estamos trabajando:

var
  Hoja: _WorkSheet;

2º Ejecutamos una instancia de Excel y creamos un nuevo libro (Workbook):

// Abrimos excel
Excel.Connect;

// Creamos un nuevo libro con tres hojas (predeterminado)
Excel.Workbooks.Add( NULL, 0 );

3º A la primera hoja del libro la llamamos Presupuesto:

// Apuntamos a la primera hoja y le cambiamos el nombre
Hoja := Excel.Worksheets.Item[1] as _WorkSheet;
Hoja.Name := 'Presupuesto';

4º Creamos los títulos de las columnas:

// Títulos de los datos
Hoja.Range['A1','A1'].Value2 := 'UNIDADES';
Hoja.Range['B1','B1'].Value2 := 'ARTICULO';
Hoja.Range['B1','B1'].ColumnWidth := 30;
Hoja.Range['C1','C1'].Value2 := 'PRECIO';
Hoja.Range['D1','D1'].Value2 := 'TOTAL';
Hoja.Range['A1','D1'].Font.Bold := True;

Aparte de introducir los títulos he utilizado las propiedades ColumnWidth y Font.Bold para ensanchar la columna del artículo y para poner todos los títulos en negrita.

5º Introducimos los datos dentro de las columnas:

// Datos
Hoja.Range['A2','A2'].Value2 := 3;
Hoja.Range['B2','B2'].Value2 := 'BOLIGRAFOS';
Hoja.Range['C2','C2'].Value2 := 1.25;
Hoja.Range['A3','A3'].Value2 := 2;
Hoja.Range['B3','B3'].Value2 := 'LIBRETAS';
Hoja.Range['C3','C3'].Value2 := 2.4;
Hoja.Range['A4','A4'].Value2 := 5;
Hoja.Range['B4','B4'].Value2 := 'LAPICES';
Hoja.Range['C4','C4'].Value2 := 0.45;

Al ser la propiedad Value2 de tipo Variant podemos introducir datos de todo tipo sin necesidad de realizar conversiones.

6º En la última columna vamos a introducir una fórmula para multiplicar unidades por precio:

// Fórmulas
Hoja.Range['D2','D2'].Formula := '=A2*C2';
Hoja.Range['D3','D3'].Formula := '=A3*C3';
Hoja.Range['D4','D4'].Formula := '=A4*C4';

7º Damos formato decimal a las columnas del precio y los totales y para ésta última columna le cambiamos los colores:

 // Formato decimal
 Hoja.Range['C2','D4'].NumberFormat := '0,00';

 // Damos formato a los totales
 Hoja.Range['D2','D4'].Font.Bold := True;          // fuente negrita
 Hoja.Range['D2','D4'].Font.Color := clBlue;       // fuente azul
 Hoja.Range['D2','D4'].Borders.Color := clRed;     // borde rojo
 Hoja.Range['D2','D4'].Interior.Color := clYellow; // fondo amarrillo

8º Por último guardamos la hoja de cálculo y desconectamos de Excel:

 // Lo primero que hacemos es guardarlo
 Excel.ActiveWorkbook.SaveAs( ExtractFilePath( Application.ExeName ) + 'Nueva.xls',
   EmptyParam, EmptyParam, EmptyParam,
   EmptyParam, EmptyParam, xlNoChange,
   EmptyParam, EmptyParam, EmptyParam,
   EmptyParam, EmptyParam, 0);

 Excel.Quit;
 Excel.Disconnect;

La hoja de cálculo la hemos guardado con el nombre Nueva.xls dentro de mismo directorio donde se ejecuta nuestra aplicación.

Y es que no hay nada mejor que sacarle partido a Microsoft Office para que nos haga el trabajo sucio.

Pruebas realizadas en RAD Studio 2007.

Leyendo datos de hojas de cálculo de Microsoft Excel

Si hay algo que nos piden frecuentemente a los programadores de gestión es poder recoger o enviar datos a los programas ofimáticos más populares: Microsoft Word, Microsoft Excel y Microsoft Access.

Lo más común suele ser leer datos de una hoja de cálculo y guardarlos en nuestra base de datos, aunque también tenemos la posibilidad de enviarle la información para que Excel nos haga una gráfica espectacular.

Una hoja de cálculo es realmente un libro que puede contener una o más hojas de cálculo:


A su vez, Microsoft Excel puede abrir varios libros a la vez.

EL COMPONENTE TEXCELAPPLICATION

En la paleta de componentes tenemos el componente de la clase TExcelApplication que se encuentra en la sección Servers:


Lo insertamos en el formulario donde vamos a hacer la importación y lo llamamos Excel para simplificar:


Supongamos que queremos leer esta hoja de cálculo:


Primero abrimos la hora de cálculo:

Excel.Workbooks.Open( ExtractFilePath( Application.ExeName ) + 'Hoja.xls',
  EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
  EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
  EmptyParam, EmptyParam, EmptyParam, EmptyParam, 0 );

Hay que reconocer que la cantidad de parámetros que tiene el método Open es impresionante:


Aunque no hay que asustarse porque lo que necesitamos realmente es el primer parámetro (el nombre del archivo excel a abrir). Los demás son para elegir si queremos abrirlo en modo sólo lectura, introducir una contraseña, etc.

Una vez que hemos abierto la hora de cálculo tenemos que situarnos en la Hoja1. Para ello creamos las siguientes variables:

var
  i: Integer;
  si: String;
  Hoja: _WorkSheet;

Las variables i y si son para recorrer las celdas de la hoja de cálculo y la variable Hoja va a apuntar a una hoja en concreto. En nuestro caso la primera:

Hoja := Excel.Worksheets.Item[1] as _WorkSheet;

Para leer información de las celdas de la hoja de cálculo tenemos que conocer las coordenadas horizontales (A,B,C,…) y las verticales (1,2,3,…). Cuando lea la información la voy a volcar a un componente ListView configurado con estas columnas:


Ahora sólo queda ir recorriendo cada fila hasta que encontremos una fila vacía:

i := 2;
si := IntToStr( i );
repeat
  with ListView.Items.Add do
  begin
    SubItems.Add( Hoja.Range['A'+si,'A'+si].Value2 ); // Código
    SubItems.Add( Hoja.Range['B'+si,'B'+si].Value2 ); // Nombre
    SubItems.Add( Hoja.Range['C'+si,'C'+si].Value2 ); // CIF
    SubItems.Add( Hoja.Range['D'+si,'D'+si].Value2 ); // Saldo
  end;

  Inc( i );
  si := IntToStr( i );
until ( VarType( Excel.Range['A'+si,'A'+si].Value2 ) = VarEmpty );

La propiedad Value2 de cada celda devuelve un tipo Variant, por ello utilizo la función VarType para comprobar si lo que hay en la celda esta vacío (VarEmpty). De ese modo sabemos cuando hemos terminado de leer datos.

Por último cerramos la hoja de cálculo con:

Excel.Workbooks.Close( 0 );

Con esto ya hemos conseguido traernos la información de la hoja de cálculo:


Igualmente podemos escribir datos en cualquier celda de la hoja de cálculo con total naturalidad:

Hoja.Range['B2','B2'].Value2 := ‘TRANSPORTES GARCIA, S.L.’;

De esta manera podemos crear nuestras plantillas de hojas de cálculo con gráficas incluidas y desde Delphi le enviamos la información.

Pruebas realizadas en RAD Studio 2007.

El componente ZipMaster

Si en el anterior artículo vimos como comprimir y descomprimir archivos con el componente ZipForge cuyo único inconveniente es que es comercial, hoy vamos a ver como hacer lo mismo con el componente ZipMaster, el cual es gratuito (con licencia LGPL).

El único inconveniente que tiene este componente es que necesita tener una librería dinámica al lado de nuestro ejecutable: DelZip179.dll. Según sus autores, podemos definir una directiva para añadir la librería de manera estática, aunque yo no he podido conseguirlo como comentaré más adelante.

DESCARGANDO EL COMPONENTE DE SU PAGINA WEB

La página oficial del componente ZipMaster es esta:

http://www.delphizip.org/


La última versión a fecha de este artículo es la 1.79. Soporta desde Delphi 5 hasta Delphi 2007.

Nos bajamos el archivo zm179setup1004.exe que tiene un tamaño de 3,07 MB y lo instalamos:


Después de instalarlo debemos instalar el paquete DPK en nuestra versión de Delphi habitual con los siguientes pasos:

1. Seleccionamos File -> Open y en el cuadro de búsqueda que aparece seleccionamos en el campo Tipo los archivos de tipo DPK:


2. En mi caso voy a instalar la versión ZipMaster11.dpk que corresponde a la versión 2007 de Delphi.

3. Seleccionamos el paquete abierto con el botón derecho del ratón y seleccionamos Install:


4. Si todo ha ido bien aparecerá este mensaje:


Una vez instalado debe aparecer en la paleta de componentes:


AÑADIENDO EL COMPONENTE A NUESTRO PROYECTO

Insertamos el componente ZipMaster en un formulario y lo llamamos Zip para abreviar:


También debemos vincular el directorio de búsqueda del proyecto al directorio donde se encuentra la unidad ZipMaster. Esto se hace seleccionando Proyect -> Options y en la sección Directories/Conditionals pulsamos el botón […] a la derecha del campo Search Path y añadimos:

D:\CodeGear\RAD Studio\5.0\Componentes\ZipMaster\

Suponiendo que sea ese el directorio donde he instalado el componente ZipMaster. También sería una buena costumbre copiar la librería DelZip179.dll del directorio:

D:\CodeGear\RAD Studio\5.0\Componentes\ZipMaster\DLL\

a donde tengamos nuestro proyecto, aunque no es necesario ya que se encuentra en C:\Windows\System32\. Es bueno llevarlo al lado del ejecutable cuando tenemos que instalar el programa en otros ordenadores.

COMO COMPRIMIR ARCHIVOS CON ZIPMASTER

Ahora supongamos que quiero comprimir un par de hojas de cálculo que se encuentran en la carpeta D:\prueba\:


Este sería el proceso para comprimir todos los archivos de esa carpeta:

Zip.DLLDirectory := ExtractFilePath( Application.ExeName );
Zip.ZipFileName := 'D:\prueba\calculos.zip';
Zip.TempDir := 'D:\prueba\';
Zip.FSpecArgs.Clear;
Zip.FSpecArgs.Add( 'D:\prueba\*.*' );
try
  Zip.Add;
except
  raise exception.Create( 'Error al comprimir los archivos.' );
end;

He realizado los siguientes pasos:

1º Le he especificado el directorio donde se encuentra la librería dinámica DelZip129.dll con la propiedad DLLDirectory.

2º Con la propiedad ZipFileName le indico como se va a llamar el archivo zip que voy a crear.

3º Aunque no es obligatorio, si es recomendable decirle el directorio temporal donde procesar los archivos temporales (TempDir). Lo normal es que sea el mismo directorio donde se están comprimiendo los archivos, por si se detiene el proceso y deja archivos temporales.

4º Por último vamos añadiendo los archivos que queremos comprimir:

Zip.FSpecArgs.Clear;
Zip.FSpecArgs.Add( 'D:\prueba\*.*' );

También podemos añadir una contraseña al archivo comprimido de este modo:

Zip.Password := '1234';

CREANDO ARCHIVOS AUTOEXTRAIBLES

Para crear un archivo comprimido y autoextraible hay que introducir en nuestro formulario el componente ZipSFX:


Suponiendo que el componente se llame ZipSFX escribimos el siguiente código que convierte un archivo zip ya comprimido en uno ejecutable:

ZipSFX.SFXPath := 'D:\CodeGear\RAD Studio\5.0\Componentes\ZipMaster\Res\';
ZipSFX.SourceFile := 'D:\prueba\calculos.zip';
ZipSFX.TargetFile := 'D:\prueba\calculos.exe';
ZipSFX.Convert;

El archivo que hace de autoextraible procede del directorio:

..\ZipMaster\Res\

El cual contiene dentro el archivo sfx_std.zip que hay que descomprimir en el mismo directorio.

Al ejecutar el archivo autoextraible aparece esta ventana:


Supuestamente también nos permite crear el archivo autoextraible en varios idiomas, incluido el español. Esto es lo que habría que añadir:

ZipSFX.SFXLanguage := ‘es’;

Lo que ocurre es que al ejecutarlo da este error:


Y ya he comprobado de que se encuentran estos archivos en ese directorio:

Dzsfxes.res
Dzsfxes.bin

Pero no hay manera de que me haga caso.

COMO DESCOMPRIMIR ARCHIVOS CON ZIPMASTER

Para descomprimir uno o más archivos con ZipMaster hacemos esto:

Zip.DLLDirectory := ExtractFilePath( Application.ExeName );
Zip.ZipFileName := 'D:\prueba\calculos.zip';
Zip.TempDir := 'D:\prueba\';
Zip.ExtrBaseDir := 'D:\prueba\';
Zip.FSpecArgs.Clear;
Zip.FSpecArgs.Add( '*.*' );
try
  Zip.Extract;
except
  raise exception.Create( 'Error al descomprimir los archivos.' );
end;

INTENTANDO AÑADIR LA LIBRERÍA DELZIP179.DLL

En la documentación de este componente nos indica que si añadimos la directiva:

{$DEFINE STATIC_LOAD_DELZIP_DLL}

en nuestro proyecto ya no necesitamos la librería DelZip179.dll al lado de nuestro ejecutable. Aunque he probado a quitar esta DLL y al ejecutarlo me da el error:


Que me lo expliquen.

CONCLUSIONES

Pese a las dos cosas que he intentado hacer y que no me han funcionado he de reconocer que el rendimiento de este componente es excelente y tiene una cantidad de opciones impresionante.

Pruebas realizadas en RAD Studio 2007.

Comprimir y descomprimir archivos con ZipForge

Aunque hay muchos componentes de terceros para Delphi que comprimen y descomprimen archivos zip con total naturalidad hay que reconocer que muchos de ellos necesitan librerías DLL externas. Sin embargo el componente ZipForge permite manipular archivos zip sin ninguna librería adicional. Todo va dentro de nuestro ejecutable.

Este componente es comercial y se vende al precio de 49 € (sin el código fuente). Para probarlo podemos bajar una versión personal para uso no comercial desde su página web:

http://componentace.com/zip_component_zip_delphi_zipforge.htm


Lo bueno de este componente es que está disponible para todas las versiones de Delphi:

En mi caso me he bajado la versión para RAD Studio 2007, cuya instalación va comprimida en un archivo zip de 2,81 MB.

INSTALANDO EL COMPONENTE

Para instalarlo sólo hay que descomprimir el archivo y ejecutar Install.exe, para luego ir pulsando el botón Next hasta que finalice la instalación:


Lo bueno de esta instalación es que no hay que instalar paquetes DPK ya que lo hace automáticamente. Sólo hay que cerrar Delphi, volver a abrirlo y veremos este mensaje al arrancar:


Cuando compremos el producto y lo registremos desaparecerá este mensaje. Al crear o abrir un nuevo proyecto ya tenemos visible el componente ZipForge en la paleta de componentes:


COMPRIMIR ARCHIVOS CON ZIPFORGE

Insertamos el componente en el formulario y le ponemos en su propiedad name el nombre Zip para simplificar:


Supongamos que tengo en la carpeta D:\prueba estos tres archivos:


Para comprimir estos archivos en un solo archivo zip hacemos lo siguiente:

With Zip do
begin
  FileName := 'd:\prueba\documentos.zip';
  OpenArchive( fmCreate );
  BaseDir := 'd:\prueba\';
  TempDir := 'd:\prueba\';
  AddFiles( '*.pdf' );
  CloseArchive;
end;

Con FileName le hemos dicho como va a llamarse el archivo zip que vamos a crear. Después creamos el archivo con OpenArchive y le decimos con la propiedad BaseDir desde donde vamos a comprimir los archivos.

No es necesario decirle también la propiedad TempDir (directorio temporal de compresión/decompresión) aunque recomiendo utilizar el mismo directorio para que no deje archivos temporales en Windows en caso de que se interrumpa el proceso de compresión/descompresión.

Por último sólo hay que decirle mediante AddFiles los archivos que vamos a comprimir (admitiendo incluso *.*) y cerramos el archivo creado.

Esta sería una compresión de archivos normal pero tenemos muchas más opciones. Por ejemplo, le podemos poner una contraseña al archivo zip escribiendo esto antes del comando AddFiles:

Password := '1234';

Si queremos asegurarnos de que los archivos se han comprimido correctamente podemos ejecutar esto:

AddFiles( '*.*' );

try
  TestFiles('*.*');
except
  Application.MessageBox( 'Error al comprimir los archivos.',
    'Atención', MB_ICONSTOP );
end;

CloseArchive;

Otra opción que podemos elegir es el nivel de compresión:

CompresionLevel := clMax;

Permite todos estos valores:

clMax     -> es la que más comprime pero la más lenta
clNormal  -> compresión normal
clFastest -> es la compresión más rápida pero la que menos comprime
clNone    -> no comprime nada, sólo empaqueta los archivos.

Si queremos controlar el proceso de compresión con una barra de progreso tenemos que añadir este código en el evento OnFileProgress:

procedure TForm1.ZipFileProgress(Sender: TObject; FileName: WideString;
Progress: Double; Operation: TZFProcessOperation;
ProgressPhase: TZFProgressPhase; var Cancel: Boolean);
begin
  if ProgressPhase = ppProcess then
    ProgressBar1.Position := Round(Progress);
end;

Lo que contiene el valor Progress no es el incremento total de la compresión sino el porcentaje de cada archivo que está comprimiendo. Por lo tanto sería conveniente hacer esto antes de empezar:

  ProgressBar1.Max := 100;

Por último y no menos importante, también nos permite comprimir archivos desde un stream, desde un buffer de memoria o una cadena de texto:

procedure AddFromStream(FileName: WideString; Stream: TStream;
CopyToBuffer: Boolean = True; Position: Integer = 0;
Count: Integer = 0; Attr: Integer = faArchive; DateTime: TDateTime = 0);

procedure AddFromBuffer(FileName: WideString; const Buffer; Count: Integer;
Attr: Integer = faArchive; DateTime: TDateTime = 0);

procedure AddFromString(FileName: WideString; Text: String;
Attr: Integer = faArchive; DateTime: TDateTime = 0);

Algo sin duda muy interesante para no tener que crear archivos intermedios.

CREANDO ARCHIVOS AUTOEJECUTABLES

Para comprimir un archivo y hacerlo autoejecutable debemos utilizar un ejecutable que trae predeterminado el componente ZipForge y que viene en el directorio:

\ComponentAce\ZipForge\SFXStub\SFXStub.exe

Esa ruta hay que indicársela antes de crearlo:

With Zip do
begin
  FileName := 'd:\prueba\documentos.zip';
  OpenArchive( fmCreate );
  BaseDir := 'd:\prueba\';
  TempDir := 'd:\prueba\';
  AddFiles( '*.*' );
  CloseArchive;
  SFXStub := 'D:\CodeGear\RAD Studio\5.0\Componentes\ZipForge\SFXStub\SFXStub.exe';
  MakeSFX( 'd:\prueba\documentos.exe' );
end;

Al hacer doble clic sobre el ejecutable nos pedirá la ruta de descompresión:


DESCOMPRIMIR ARCHIVOS CON ZIPFORGE

Descomprimir archivos es todavía más fácil que comprimirlos:

With Zip do
begin
  FileName := 'd:\prueba\documentos.zip';
  OpenArchive( fmOpenRead );
  BaseDir := 'd:\prueba\';
  TempDir := 'd:\prueba\';
  ExtractFiles( '*.*' );
  CloseArchive;
end;

Si nos fijamos en las propiedades que tiene el componente ZipForge en el inspector de objetos podemos configurar si queremos que cree carpetas al descomprimir (si las hay) o elegir por ejemplo si queremos sobrescribir archivos:


Un componente como este se hace casi imprescindible para dar a nuestros programas funcionalidades tales como crear copias de seguridad de bases de datos, descomprimir archivos de configuración en directorios remotos o incluso proteger nuestros gráficos y recursos dentro de un zip con contraseña para que no puedan ser utilizados por otro programador.

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.

Crea tu propio servidor HTTP (1)

Si bien hoy en día hay servidores de páginas web gratuitos y de calidad como pueden ser Apache, LightHTTP, IIS, etc. no está de más crear nuestro propio servidor de páginas web para tener nuestra propia intranet en nuestro hogar o incluso en nuestra oficina. Si a eso le sumamos los conocimientos que ya tenemos de Delphi respecto al acceso a bases de datos podemos crear pequeñas aplicaciones web muy interesantes.

Como viene siendo habitual en esta serie de artículos vamos a utilizar los componentes Indy. Lo que vamos a hacer es que el usuario que se conecte al servidor entre a una página principal y luego para entrar a nuestra zona privada tenga que identificarse con usuario y contraseña.

CREANDO LA VENTANA DEL SERVIDOR

Al igual que hicimos con el servidor de Telnet, sería interesante monitorizar las conexiones de los usuarios que se van a conectar a nuestro servidor. Por ello vamos a crear un nuevo proyecto cuya ventana principal es la siguiente:

En este formulario hemos introducido dos botones para conectar y desconectar el servidor y un componente de la clase TMemo llamado Log donde iremos mostrando los eventos que ocurren. Y por último añadimos el componente más importante: IdHTTPServer situado en la pestaña Indy Servers.

El código asociado a los botones Activar y Desactivar no puede ser más sencillo:

procedure TFServidorHTTP.BActivarClick(Sender: TObject);
begin
  Servidor.Active := True;
  Log.Lines.Add( 'Servidor activado.' );
  BActivar.Enabled := False;
  BDesactivar.Enabled := True;
end;

procedure TFServidorHTTP.BDesactivarClick(Sender: TObject);
begin
  Servidor.Active := False;
  Log.Lines.Add( 'Servidor desactivado.' );
  BActivar.Enabled := True;
  BDesactivar.Enabled := False;
end;

Al ejecutar el programa y pulsar el botón Activar veremos que salta el cortafuegos de Windows (o el que tengamos configurado por defecto) donde debemos pulsar el botón Desbloquear para tener nuestro servidor operativo:


Después sólo tenemos que abrir nuestro navegador de Internet preferido y teclear localhost o bien http://127.0.0.1 y debe aparecer una página web en blanco.

Pues bien, cada vez que un usuario entra a nuestro servidor de páginas web con cualquier navegador, lo que realmente hace es enviarnos este comando por el puerto 80:

GET /

Esto significa que debemos darle la página principal de entrada, que en nuestro caso va a ser un archivo HTML que vamos a crear con el Bloc de Notas de Windows y que va a contener lo siguiente:


El archivo lo guardamos con el nombre index.html en el mismo directorio donde se encuentra el ejecutable del servidor.

Otra página que vamos a crear es la zona privada:


Este archivo lo guardamos con el nombre zonaprivada.html. Ahora viene el punto fuerte, donde hay que responder a los comandos del cliente utilizando el evento OnCommandGet del componente IdHTTPServer:

procedure TFServidorHTTP.ServidorCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  sDocumento: String;
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
        AResponseInfo.ServeFile( AContext, sDocumento );
    end
    else
      // No hemos encontrado la página
      AResponseInfo.ResponseNo := 404;
  end;

  AResponseInfo.CloseConnection := True;
end;

Para poder compilar este ejemplo hay que añadir arriba la unidad IdContext. Este evento se divide en las siguientes partes:

1º Escribimos en la ventana de nuestro servidor quien se está conectando y el documento (pagina web, archivo, etc.) solicita:

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

2º Si lo que el usuario solicita es la página principal pues entonces se la damos sin rechistar:

// ¿Va a entrar a la página principal?
if ARequestInfo.Document = '/' then
  AResponseInfo.ServeFile( AContext, ExtractFilePath( Application.ExeName ) + 'index.html' )
else
...

El método ServeFile envía cualquier archivo al navegador del cliente.

3º Traducimos el documento que nos solicitan en una ruta donde estamos ejecutando el servidor:

// Cargamos la página web que vamos a enviar
sDocumento := ExtractFilePath( Application.ExeName ) +
Copy( ARequestInfo.Document, 2, Length( ARequestInfo.Document ) );

4º Si el documento que nos solicitan no existe le mandamos un error 404. En el caso de que exista, significa que va a entrar en nuestra zona privada, con lo cual compruebo primero su usuario y password antes de dejarle pasar:

// ¿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
    AResponseInfo.ServeFile( AContext, sDocumento );
end
else
  // No hemos encontrado la página
  AResponseInfo.ResponseNo := 404;

Una vez autentificado el usuario le enviamos la página web solicitada.

5º Por último cerramos la conexión con el cliente:

AResponseInfo.CloseConnection := True;

Ahora ejecutamos el programa y pulsamos el botón Conectar:


Ejecutamos por ejemplo Internet Explorer y escribimos locahost:

Al pulsar el enlace Ir a la zona privada hará que el navegador nos pida usuario y contraseña:


Escribimos admin Y 1234 y saltará a la zona privada:


Si volvemos a ir a la página principal y e intentamos entrar en la zona privada ya no será necesario introducir usuario y contraseña, ya que lo memoriza automáticamente el navegador.

Si intentamos solicitar a nuestro servidor una página que no existe nos devolverá un error 404:


Mientras ha sucedido todo esto, nuestro servidor ha monitorizado todo el proceso:


En esto hay que ver tres cosas importantes:

1º Si el usuario vuelve a la página principal index.html el servidor no se entera, ya que el navegador web la ha cogido de su caché de páginas, evitando el tráfico innecesario.

2º Cuando nos conectamos por primera vez a una página web, el navegador solicita el archivo favicon.ico. Este icono es el que aparece al lado de la URL de la página web donde hemos entrado:


Si os interesa más información sobre el icono favicon podéis verlo en esta página:

http://www.favicon.net/

De todas formas no hay que tomarle mucha importancia a esto porque por ejemplo Firefox no lo pide.

3º El control de entrada de usuarios que hemos realizado sólo es eso, control de usuarios, pero no es una sesión. Una sesión es la encargada de guardar el estado del usuario en nuestra página. Eso lo veremos más adelante.

CONCLUSIÓN

Como puede apreciarse en el código, con algo tan sencillo como esto ya tenemos un pequeño servidor web que permite servir páginas web a los clientes y tener una zona privada que podíamos validar con una pequeña base de datos de Internase o bien un pequeño archivo de texto encriptado.

Pero no hay que hacerse muchas ilusiones ya que un servidor web incluye muchas más cosas. Una cosa es dejar que un usuario entre a una zona privada y otra guardar el estado del usuario con una sesión mediante cookies. Eso lo veremos en el siguiente artículo. También sería interesante poder recoger información de usuarios y controlar eventos al estilo web 2.0, como puede ser la implementación de un blog, un foro, un chat online, etc.

MODIFICACIONES QUE HAY QUE REALIZAR PARA DELPHI 7

El único inconveniente que tiene este código en Delphi 7 (cuya versión de los componentes Indy es más antigua) es que el objeto AResponseInfo no tiene el método ServeFile por lo que tenemos que dárle la página web a mano. Lo que he realizado en este ejemplo es cargar la página web en un StringList y se la doy al cliente:

procedure TFServidorHTTP.ServidorCommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  sDocumento: String;
  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
        S.LoadFromFile( sDocumento );
        AResponseInfo.ContentText := S.Text;
      end
    end
    else
      AResponseInfo.ResponseNo := 404;
  end;

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

Igualmente se podía haber cargado el archivo con AssignFile y Reset o bien con un objeto TStreamFile. Eso lo dejo al gusto del usuario.

En el próximo artículo veremos como sacarle más partido a este componente.

Pruebas realizadas en RAD Studio 2007 y Delphi 7.