El componente mxProtector (y 3)

Siguiendo con este fantástico componente destinado a proteger nuestras aplicaciones vamos a ver como activar un programa con una contraseña en concreto para un solo cliente. Ideal para programas a medida.

ACTIVACIÓN DE PROGRAMAS POR CLAVE DE ACCESO

El método es tan simple como no poder utilizar el programa o restringir el uso del mismo hasta que el usuario no introduzca una clave de acceso inventada por el programador y con la posibilidad de instalarlo en cualquier PC.

Para este ejemplo he creado un formulario con estos componentes:

Al arrancar el programa nos pedirá directamente la clave de acceso en el caso de que no esté registrada. Si nos equivocamos al introducirla el programa entrará en modo Demo mostrando el mensaje Programa sin registrar.

Tenemos la oportunidad de pulsar el botón Activar para introducir la clave de nuevo o bien desactivarlo por si queremos restringir de nuevo el uso del mismo a otros usuarios del mismo PC.

Comencemos configurando el componente mxProtector de este modo:

1º En la propiedad Options activamos la opción poPasswordOnce:

2º Activamos la opción stPassword en la tabla en la propiedad ProtectionTypes:

3º En el campo password escribimos nuestra contraseña:

Al pulsar la tecla Intro veremos que la contraseña se encripta en otro formato:

Ya no se si esta será la clave encriptada o su hash. A nosotros nos da lo mismo mientras un hacker no pueda adivinarla por ingeniería inversa.

4º En el evento OnGetPassword debemos preguntarle al usuario por la contraseña:

procedure TFPrincipal.mxProtectorGetPassword(Sender: TObject;
var Password: string);
begin
  Password := InputBox('Introduzca la clave de activación', 'Clave:', '');
end;

5º El evento OnValidPassword se ejecutará si el usuario ha acertado la clave, por lo que deshabilitamos el botón Activar y habilitamos el botón Desactivar:

procedure TFPrincipal.mxProtectorValidPassword(Sender: TObject);
begin
  EMensaje.Caption := 'Programa registrado';
  BActivar.Enabled := False;
  BDesactivar.Enabled := True;
end;

6º Y en el caso de que la clave sea incorrecta hacemos lo contrario dentro del evento OnWrongPassword:

procedure TFPrincipal.mxProtectorWrongPassword(Sender: TObject;
  WrongPassword: string);
begin
  EMensaje.Caption := 'Programa sin registrar';
  BActivar.Enabled := True;
  BDesactivar.Enabled := False;
  Application.MessageBox('Clave de activación incorrecta',
    'Consulte con su proveedor', MB_ICONSTOP);
end;

7º Para finalizar tenemos que pedir la clave al pulsar el botón Activar:

procedure TFPrincipal.BActivarClick(Sender: TObject);
begin
  mxProtector.CheckPassword;
end;

8º Y eliminarla al pulsar el botón Desactivar:

procedure TFPrincipal.BDesactivarClick(Sender: TObject);
begin
  mxProtector.Reset;
  Application.MessageBox('Deberá introducir la clave de activación de nuevo',
    'Programa desactivado', MB_ICONINFORMATION);
  BActivar.Enabled := True;
  BDesactivar.Enabled := False;
end;

Vamos a probarlo. Al ejecutarlo, como no está registrado lo primero que hará es pedirnos la clave:

Si nos equivocamos mostrará el mensaje de error:

Y el programa aparece en modo demo:

Pulsamos de nuevo el botón Activar, introducimos la clave correcta:

Y el programa quedará registrado:

Y aunque cerremos el programa y volvamos a abrirlo, mxProtector comprobará de nuevo si la contraseña se ha activado, por lo que no tenemos que implementar ningún código al inicio de la aplicación.

Luego podemos pulsar el botón Desactivar para eliminar la licencia en ese equipo:

Este sería uno de los métodos más básicos de venta de software a medida. Cuando te paguen le mandas la clave y activas todas las funcionalidades del programa demo.

Si nos fijamos en los proyectos de demostración que lleva este componente en su directorio demo veremos que se pueden hacer muchas más combinaciones entre proteger con contraseña, limitar el programa por número de ejecuciones, limitar por número de días o por número de serie incluyendo una clave única de hardware.

Con esto finalizo la serie de artículos dedicada al componente mxProtector. Mi propósito era contemplar por encima todos los tipos de protección que abarca así su uso a nivel de principiante sin complicaciones.

Por los ejemplos que he visto, se pueden activar varias propiedades a la vez para que el programa sea a la vez una versión demo por tiempo y una vez que el usuario pague entonces se activa según un número de serie y su contraseña, como los programas Shareware profesionales que hay en el mercado.

Lástima que los creadores de este componente vayan a cerrar la página en Diciembre de este año. Espero que dejen por ahí en algún repositorio el código fuente de este maravilloso componente por si alguien se anima a seguirlo.

Pruebas realizadas en RAD Studio 2007.

El componente mxProtector (2)

Vamos a continuar viendo otros modos de protección de este componente como pueden ser la limitación por número de días y por medio de licencias mediante un generador de claves.

PROTECCIÓN POR NÚMERO DE DÍAS TRANSCURRIDOS

Debemos configurar el componente mxProtector de este modo:

1º Dentro de su propiedad Options activamos las opciones poAutoInit, poCheckSystemTime y poPasswordOnce:

2º En su propiedad Protection Types debemos activar stDayTrial:

3º También debemos poner en MaxDayNumber el número de días que damos de plazo, por ejemplo 30.

3º En su evento OnDayTrial podemos el código que controla el paso de cada día:

procedure TFPrincipal.mxProtectorDayTrial(Sender: TObject;
  DaysRemained: Integer);
begin
  if DaysRemained = 1 then
    ENumDias.Caption := 'Sólo te queda un día'
  else
    ENumDias.Caption := Format('Te quedan %d días.', [DaysRemained]);

  BReiniciar.Enabled := False;
end;

4º En su evento OnExpiration va el código cuando ya no quedan más días:

procedure TFPrincipal.mxProtectorExpiration(Sender: TObject);
begin
  ENumDias.Caption := 'Le quedan 0 días. Su licencia ha expirado';
  BReiniciar.Enabled := True;
end;

5º Y en su evento OnInvalidSystemTime podemos el mensaje que muestra que el usuario ha intentado mover hacia atrás la fecha de Windows para estirar la licencia:

procedure TFPrincipal.mxProtectorInvalidSystemTime(Sender: TObject);
begin
  Application.MessageBox('La hora de tu sistema no es correcta.',
    'Su licencia ha expirado', MB_ICONSTOP);
end;

6º Al pulsar el botón Reiniciar volvemos a darle otros 30 días:

procedure TFPrincipal.BReiniciarClick(Sender: TObject);
begin
  mxProtector.Reset;
end;

Y al igual que vimos en el ejemplo anterior de control por número de ejecuciones, podemos implementar los métodos OnGetString, OnPutString, OnGetBoolean y OnPutBoolean para que guarde el estado en la clave de registro que queramos o en un archivo INI, binario, etc. Esto es válido para todos los métodos de protección que hemos visto así como los siguientes que voy a comentar.

PROTECCIÓN POR REGISTRO DE NÚMERO DE SERIE

Esta es otra de las protecciones que más se suelen utilizar para distribuir programas con licencia Shareware. Según el nombre del usuario, un ID que haga único al PC y un número de serie podemos proteger cada licencia para que sólo se ejecute en un equipo.

Lo primero que vamos a hacer es el programa que va a registrar el usuario según un número de serie que nos dará un generador de claves que vamos a crear más adelante.

El programa va a tener este formulario:

Veamos como configurar el componente mxProtector igual que hemos visto anteriormente:

1º En la propiedad Options debemos activar las opciones poAutoInit, poCheckSystemTime, poPasswordOnce y poUseHardwareKey:


2º Activar en la propiedad ProtectionTypes el valor stRegister:


3º En el evento OnGetSerialNumber le pasamos al componente el nombre del usuario y el número de serie generado:

procedure TFPrincipal.mxProtectorGetSerialNumber(Sender: TObject;
var UserName, SerialNumber: string);
begin
  UserName := Usuario.Text;
  SerialNumber := NumSerie.Text;
end;

4º En el evento OnInvalidSerialNumber mostramos el mensaje de error en caso de que sea incorrecto:

procedure TFPrincipal.mxProtectorInvalidSerialNumber(Sender: TObject);
begin
  Application.MessageBox('Nº de serie incorrecto',
    'Consulte con el proveedor', MB_ICONSTOP);
end;

5º En el evento OnUnknowHardware debemos mostrar un mensaje en caso de que no podamos obtener la ID del PC:

procedure TFPrincipal.mxProtectorUnknownHardware(Sender: TObject);
begin
  Application.MessageBox('El hardware de este equipo es incompatible con este software.',
    'Consulte con el proveedor', MB_ICONSTOP);
end;

6º Al pulsar el botón Registrar activamos el producto:

procedure TFPrincipal.BRegistrarClick(Sender: TObject);
begin
  mxProtector.Registration;
  ComprobarRegistro;

  if mxProtector.IsRegistered Then
  begin
    Application.MessageBox('Gracias por comprar el producto',
      'Registro realizado', MB_ICONINFORMATION);
  end;
end;

El procedimiento de comprobar el registro es el siguiente:

procedure TFPrincipal.ComprobarRegistro;
begin
  if mxProtector.IsRegistered then
  begin
    Caption := 'Programa registrado';
    BRegistrar.Enabled := False;
    BDesinstalar.Enabled := True;
  end
  else
  begin
    Caption := 'Programa no registrado';
    BRegistrar.Enabled := True;
    BDesinstalar.Enabled := False;
  end;
end;

Activamos o desactivamos los botones de registrar o desinstalar así como el título del formulario según este registrado el programa o no.

7º A pulsar el botón Desinstalar desinstalamos la clave de registro:

procedure TFPrincipal.BDesinstalarClick(Sender: TObject);
begin
  mxProtector.Reset;
  Application.MessageBox('Ya puede desinstalar del producto',
    'Registro cancelado', MB_ICONINFORMATION);
  ComprobarRegistro;
end;

8º Por último, tenemos que comprobar en el evento OnCreate del formulario si hemos registrado el programa y obtener ID del PC:

procedure TFPrincipal.FormCreate(Sender: TObject);
begin
  ID.Text := mxProtector.GetHardwareID;
  ComprobarRegistro;
end;

CREANDO EL GENERADOR DE CLAVES

Ahora vamos a hacer un programa que genere números de serie según el nombre del usuario y un ID único del PC (número de serie del disco duro, de la tarjeta de Windows, etc.).

El programa va a tener este formulario:

Veamos como configurar el componente mxProtector para este programa:

1º En la propiedad Options debemos activar las opciones poAutoInit, poCheckSystemTime, poPasswordOnce y poUseHardwareKey:


2º Activar en la propiedad ProtectionTypes el valor stRegister:

3º En el evento OnGetHardwareID nos encargamos de pasarle al componente el ID del equipo:

procedure TFPrincipal.mxProtectorGetHardwareID(Sender: TObject;
var HardwareID: string);
begin
  HardwareID := ID.Text;
end;

4º El botón Generar le pedimos al componente que nos genere un número de clave según el usuario y el ID del PC:

procedure TFPrincipal.BGenerarClick(Sender: TObject);
begin
  NumSerie.Text := mxProtector.GenerateSerialNumber(Usuario.Text);
end;

Vamos a probar ambos programas. Abrimos primero la aplicación:

Copiamos la clave que nos ha dado el programa, abrimos el generador de claves y escribimos nuestro nombre completo y el ID generado por el programa. Después pulsamos el botón Generar y nos dará la clave de registro:

Ahora copiamos la clave de registro, la llevamos al programa, introducimos nuestro nombre y pulsamos el botón Registrar:

Si cerramos la aplicación y volvemos a abrirla veremos que el programa ya está registrado. Podemos quitar la licencia pulsando el botón Desinstalar que dejará el programa como al principio.

Aunque parezca algo complicado, si tuviésemos que hacer todo esto a mano habría que escribir mucho más código. En el próximo artículo seguiremos viendo otros modos de protección.

Pruebas realizadas en RAD Studio 2007.

El componente mxProtector (1)

Un asunto importante que no debemos descuidar en la distribución de nuestros programas es la protección de los mismos frente a las copias piratas. Para ello hay infinidad de herramientas que permiten proteger el software por número de ejecuciones, por fecha límite, activación por número de serie, etc.

Si no queremos complicarnos mucho la vida hay herramientas que permiten proteger un ejecutable una vez compilado como pueden ser Armadillo, ASProtect, ExeCryptor, Enigma Protector, IntelliProtector, etc. Pero casi todas ellas (sobre todo las más buenas) son comerciales y ninguna es perfecta. Un buen crackeador puede reventar cualquiera de ellas utilizando ingeniería inversa mediante desensambladores y dumpeadores de memoria avanzados.

Si os interesa investigar sobre seguridad informática hay una página web en la que también tiene código fuente de Delphi dedicada a este tema:

http://indetectables.net

Hablan sobre todo de cómo crear troyanos, virus, protectores de archivos EXE o como protegerse contra los mismos. Sobre todo hay que fijarse en el foro.

DESCARGANDO EL COMPONENTE

Lo que si podemos hacer es crear una protección a nuestro programa que sin ser muy compleja por lo menos evite que cualquier principiante pueda copiarlo. Para ello vamos a ver el componente mxProtect que cumple este cometido a la perfección. La versión actual es la 1.32 (a la fecha de escribir este artículo).

Este componente lo podemos encontrar en esta página web:

http://www.maxcomponents.net/

Tiene algunos componentes comerciales y otros con licencia freeware. Es este caso, el componente mxProtect es freeware y lo podemos descargar seleccionando en su página web el apartado Downloads -> Freeware Components:


El archivo que nos bajamos es la instalación comprimida con zip que tiene un tamaño de 355 KB. Es la típica instalación de siempre donde nos pedirá donde instalar el componente (por defecto en Archivos de programa):

Yo tengo por costumbre instalar los componentes en una carpeta debajo de cada versión de Delphi, por ejemplo:

De este modo, si vamos a utilizar el componente en dos versiones distintas de Delphi (en mi caso Delphi 7 y Delphi 2007) lo mejor es que cada una tenga su copia del componente para que se compilen por separado, es decir, instalamos por ejemplo el componente mxProtector dentro de la carpeta:

D:\RadStudio2007\Componentes\mxProtector\

Y luego le sacamos una copia a mano a la carpeta:

D:\Delphi7\Componentes\mxProtector\

De este modo, cada versión del compilador no estropeará el componente de la otra.

INSTALANDO EL COMPONENTE

Una vez que lo tenemos instalado debemos añadirlo a Delphi 2007 abriendo el paquete mxProtector_11.dpk. En caso de que sea Delphi 2009 seria mxProtector_12.dpk. En la ventana del Project Manager pinchamos el archivo mxProtector_11.bpl con el botón derecho del ratón y seleccionamos Compile:


Después seleccionamos Install:


y nos aparecerá el mensaje de que acaba de instalar el componente:

Al abrir o crear un nuevo proyecto veremos ese componente en la paleta:


Para Delphi 7 sería prácticamente lo mismo.

PROTEGER UN PROGRAMA POR EL NÚMERO DE EJECUCIONES

Cada vez que se ejecute el programa restará una vez al contador de número de ejecuciones en ese PC. Vamos a ver un ejemplo de cómo crear un programa que permita ejecutarse 3 veces.

Antes tengo que aclarar una cosa. Este componente tiene dos modos de ejecución: o él se encarga de guardar (dios sabe donde) el número de ejecuciones o nosotros nos encargamos de decirle donde tiene que guardar estos datos (en un archivo INI, en un archivo binario, en el registro del sistema, etc.).

Yo prefiero esta segunda opción, ya que aunque es más pesada de implementar nos da más libertad a la hora de proteger nuestro software. Este será el método que yo voy a utilizar, concretamente lo voy a guardar en el registro del sistema dentro de la clave:

\HKEY_LOCAL_MACHINE\MiEmpresa\MiPrograma\

Por lo demás le dejamos al componente mxProtector que guarde en esa clave lo que tenga que guardar.

Para probar este ejemplo voy a comenzar un nuevo proyecto que tenga este sencillo formulario:

Al componente de la clase TMXProtector lo he llamado mxProtector y a la etiqueta que va a mostrar el número de ejecuciones que nos quedan la he llamado ENumEje.

Para ello vamos a realizar estas acciones:

1º Ponemos la propiedad MaxStartNumber del componente mxProtector a 3.

2º En el mismo componente activamos sólo el valor stStartTrial de su propiedad ProtectionType. Esto hará que se al arrancar nuestro programa se ejecute el evento OnStartTrial.

2º En el evento OnStartTrial podemos el código que se va a ejecutar por primera vez:

procedure TFPrincipal.mxProtectorStartTrial(Sender: TObject;
  StartsRemained: Integer);
begin
  ENumEje.Caption := Format('Te quedan %d ejecuciones de %d',
    [StartsRemained, mxProtector.MaxStartNumber]);
end;

Este código se ejecutará automáticamente al inicio del programa, ya que está activada la opción poAutoInit dentro de la propiedad Options.

2º Al pulsar el botón Reiniciar ponemos a cero en número de veces que hemos ejecutado el programa:

mxProtector.Reset;

Podemos hacer que el componente se encargue de guardar ese número por si mismo o bien nos encargamos nosotros de todo el proceso (lo mejor). Como vamos a guardar en número de ejecuciones en el registro el sistema entonces haremos que en el evento OnReset elimine la clave del registro:

procedure TFPrincipal.mxProtectorReset(Sender: TObject; var Handled: Boolean);
var
  Reg: TRegistry;
begin
  Handled := True;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  Reg.DeleteKey('\Software\MiEmpresa\MiPrograma');
  Reg.Free;
end;

Si ponemos a True la variable Handled le estamos diciendo al componente mxProtector que nosotros nos encargamos de guardar el contador de ejecuciones. Si la ponemos a false se encarga él. Lo que no sé es donde la guarda. Lo he estado monitorizando con el programa RegMon en el registro del sistema y no he encontrado donde lo mete.

3º En el evento OnExpiration debemos añadir el código de lo que queramos que haga cuando se finalicen el número de ejecuciones (se acabe la versión trial):

procedure TFPrincipal.mxProtectorExpiration(Sender: TObject);
begin
  ENumEje.Caption := 'Ya no te quedan más ejecuciones';
end;

Si por ejemplo estamos haciendo un programa de facturación podíamos cambiar o eliminar la contraseña de acceso al motor de bases de datos para que no pueda volver a funcionar el programa.

Este tipo de protección hace que este componente cargue y grabe una variable tipo booleana y otra de texto. Nosotros nos vamos a encargar de guardar y recoger estas variables. Así que vamos a reprogramar los eventos que necesitamos:

4º En el evento OnGetBoolean leemos la variable booleana que mxProtector nos pida:

procedure TFPrincipal.mxProtectorGetBoolean(Sender: TObject; var APath,
  AKey: string; var AResult, Handled: Boolean);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if Reg.OpenKey('\Software\MiEmpresa\MiPrograma', True) then
      if Reg.ValueExists(AKey) then
        AResult := Reg.ReadBool(AKey);

    Handled := True;
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;

Al igual que antes, le ponemos la variable Handled a True para decirle al componente que nos encargamos del asunto.

5º Lo mismo hacemos para cargar una variable de tipo string en el evento OnGetString:

procedure TFPrincipal.mxProtectorGetString(Sender: TObject; var APath, AKey,
  AResult: string; var Handled: Boolean);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if Reg.OpenKey('\Software\MiEmpresa\MiPrograma', True) then
      if Reg.ValueExists(AKey) then
        AResult := Reg.ReadString(AKey);

    Handled := True;
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;

6º Ahora hacemos lo mismo para guardar una variable booleana en el evento OnPutBoolean:

procedure TFPrincipal.mxProtectorPutBoolean(Sender: TObject; var APath,
  AKey: string; var ASavedData, Handled: Boolean);
var
  Reg: TRegistry;
begin
  Handled := True;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  if Reg.OpenKey('\Software\MiEmpresa\MiPrograma', True) then
  begin
    Reg.WriteBool(AKey, ASavedData);
    Reg.CloseKey;
  end;
  Reg.Free;
end;

7º Y los mismo para una variable string en el evento OnPutString:

procedure TFPrincipal.mxProtectorPutString(Sender: TObject; var APath, AKey,
  ASavedData: string; var Handled: Boolean);
var
  Reg: TRegistry;
begin
  Handled := True;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  if Reg.OpenKey('\Software\MiEmpresa\MiPrograma', True) then
  begin
    Reg.WriteString(AKey, ASavedData);
    Reg.CloseKey;
  end;
  Reg.Free;
end;

8º Por último sólo nos queda reprogramar los eventos OnCodeData y OnDecodeData:

procedure TFPrincipal.mxProtectorCodeData(Sender: TObject; var ACode: string);
begin
  ACode := ACode;
end;

procedure TFPrincipal.mxProtectorDeCodeData(Sender: TObject; var ACode: string);
begin
  ACode := ACode;
end;

Ahora mismo no tienen ningún tipo de codificación. Lo mismo que leen o cargan del registro del sistema es lo que va a parar al componente. Aquí podíamos ampliar la funcionalidad utilizando alguna función de encriptación y desencriptación como suele hacerse comúnmente con las funciones booleanas XOR, aunque esto se sale de los objetivos de este artículo.

Después de todo este rollo que os he metido, vamos a ejecutar el programa para ver que guarda en el registro:

Cuando se ejecuta el programa automáticamente nos resta el número de ejecuciones (eso lo hace sólo el componente) y nos guarda esto en el registro (hacer clic para ampliar):

Cerramos el programa y volvemos a abrirlo y nos queda una ejecución:

Y en el registro vemos que sólo cambia el valor S2:

Ejecutamos por última vez el programa y se acaban el nº de ejecuciones:

Y el estado del valor S2 vuelve a cambiar:


El contenido del registro puede cambiar dependiendo del PC, de la fecha y hora del sistema o de algún patrón interno del componente mxProtector. Nosotros no tenemos que preocuparnos por eso. Lo más que podemos hacer es modificar los eventos OnCodeDate y OnDecodeDate para despistar aun más a los crackers.

También podíamos encriptar el ejecutable con algún compresor de archivos EXE tipo UPX para evitar la ingenieria inversa. Aún así, ningún sistema de protección es perfecto, pero por lo menos da algo más de seguridad frente a los crackeadores novatos.

En el siguiente artículo seguiremos viendo los otros métodos de protección que incorpora este componente.

Pruebas realizadas en RAD Studio 2007.

El componente BackwroundWorker (y 2)

Vamos a ver un ejemplo de cómo utilizar este componente con un hilo de ejecución que recorra todos los números del 1 al 100 y nos calcule los múltiplos de 5, 7 y 9. Este sería el formulario principal de nuestro proyecto:


El formulario se compone de los siguientes componentes:

- 2 botones de la clase TButton llamados BComenzar y BCancelar para iniciar o detener el hilo de ejecución.

- 1 componente TBackgroundWorker llamado BackgroundWorker.

- 1 barra de progreso de la clase TProgressBar llamada Progreso y con su propiedad Smooth a True.

- 3 etiquetas (TLabel) y 3 casillas (TEdit) llamadas Multiplos5, Multiplos7 y Multiplos9 donde se irán alojando los múltiplos encontrados de cada uno.

- 1 barra de estado de la clase TStatusBar llamada Estado con su propiedad SimplePanel a True.

Comencemos a meter código:

1º Al pulsar el botón Comenzar ponemos en marcha el hilo:

procedure TForm1.BComenzarClick(Sender: TObject);
begin
  BackgroundWorker.Execute;
end;

2º Al pulsar el botón Cancelar le pedimos al hilo que se detenga:

procedure TForm1.BDetenerClick(Sender: TObject);
begin
  BackgroundWorker.Cancel;
end;

3º En el evento OnWork del componente BackgroundWorker recorremos los 100 números:

procedure TForm1.BackgroundWorkerWork(Worker: TBackgroundWorker);
var
  i: Integer;
begin
  for i := 1 to 100 do
  begin
    // ¿Hay que cancelar el proceso?
    if Worker.CancellationPending then
    begin
      // Le indicamos al hilo que lo cancelamos
      Worker.AcceptCancellation;
      Exit;
    end;

    // ¿Es múltiplo de 5?
    if i mod 5 = 0 then
      Worker.ReportFeedback(5, i);

    // ¿Es múltiplo de 7?
    if i mod 7 = 0 then
      Worker.ReportFeedback(7, i);

    // ¿Es múltiplo de 9?
    if i mod 9 = 0 then
      Worker.ReportFeedback(9, i);

    // Esperamos 50 milisegundos
    Sleep(50);

    // Incrementamos la barra de progreso
    Worker.ReportProgress(i);
  end;
end;

Al principio del bucle controlamos si nos piden abandonar el hilo de ejecución:

// ¿Hay que cancelar el proceso?
if Worker.CancellationPending then
begin
  // Le indicamos al hilo que lo cancelamos
  Worker.AcceptCancellation;
  Exit;
end;

Después comprobamos los múltiplos de cada número y en el caso de que así sea envío provoco un evento OnWorkFeedBack para notificar el número que he encontrado:

// ¿Es múltiplo de 5?
if i mod 5 = 0 then
  Worker.ReportFeedback(5, i);

// ¿Es múltiplo de 7?
if i mod 7 = 0 then
  Worker.ReportFeedback(7, i);

// ¿Es múltiplo de 9?
if i mod 9 = 0 then
  Worker.ReportFeedback(9, i);

Y por último provoco un pequeño retardo de 50 milisegundos (para ir viendo el progreso) y provoco un evento OnWorkProgress para notificar el incremento en la barra de progreso:

// Esperamos 50 milisegundos
Sleep(50);

// Incrementamos la barra de progreso
Worker.ReportProgress(i);

Sigamos...

4º En el evento OnWorkFeedBack recogemos el mensaje que nos manda el hilo para ir guardando en cada casilla los múltiplos de cada número:

procedure TForm1.BackgroundWorkerWorkFeedback(Worker: TBackgroundWorker;
FeedbackID, FeedbackValue: Integer);
begin
  case FeedbackID of
    5: Multiplos5.Text := Multiplos5.Text + IntToStr(FeedbackValue) + ',';
    7: Multiplos7.Text := Multiplos7.Text + IntToStr(FeedbackValue) + ',';
    9: Multiplos9.Text := Multiplos9.Text + IntToStr(FeedbackValue) + ',';
  end;
end;

5º En el evento OnWorkProgress actualizamos la barra de progreso y la barra de estado en pantalla:

procedure TForm1.BackgroundWorkerWorkProgress(Worker: TBackgroundWorker;
PercentDone: Integer);
begin
  Progreso.Position := PercentDone;
  Estado.SimpleText := 'Procesando... ' + IntToStr(PercentDone) + '%';
end;

6º En el evento OnWorkComplete le decimos al usuario en la barra de progreso que hemos terminado:

procedure TForm1.BackgroundWorkerWorkComplete(Worker: TBackgroundWorker;
Cancelled: Boolean);
begin
  Estado.SimpleText := 'Proceso finalizado';
end;

7º Por si acaso al usuario le da por cerrar el formulario mientras está el hilo en marcha tenemos que cancelarlo y esperar a que termine (al igual que hacen los programas como Emule o BitTorrent cuando lo cerramos y espera a liberar memoria y cerrar las conexiones):

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // ¿Esta el hilo en marcha?
  if BackgroundWorker.IsWorking then
  begin
    // Le indicamos que se detenga
    BackgroundWorker.Cancel;
    // Esperamos a que se detenga
    BackgroundWorker.WaitFor;
  end;
end;

Al ejecutar el programa irá rellenando las casillas correspondientes:


Hasta finalizar el proceso:


Como podemos apreciar, este componente nos facilita mucho la labor con los hilos de ejecución respecto a la clase TThread. Por las pruebas que he realizado en otros programas más complejos (facturación) es bastante sencillo de manejar y muy estable.

Pruebas realizadas en RAD Studio 2007.

El componente BackgroundWorker (1)

Aunque haya finalizado el tema referente a los hilos de ejecución con la clase TThread no está demás hablar de otros componentes no oficiales de Delphi que también están relacionados con los hijos de ejecución.

En este caso el componente me lo recomendó un lector de este blog (gracias a Jorge Abel) y me puse a echarle un vistazo a ver que tal. Este componente puede descargarse gratuitamente de esta página web (licencia Freeware):

http://www.delphiarea.com/products/

Concretamente en la sección de componentes que viene más abajo:


Al igual que la clase TThread, este componente permite crear un hilo de ejecución paralelo al hilo primario de nuestra aplicación pero de una manera sencilla y sin tener que heredad de clases.

INSTALAR EL COMPONENTE

Como es un componente que va suelto (sin paquete) vamos a proceder a crear un paquete para el sólo. Para ello creamos una carpeta llamada DephiArea donde vamos a descomprimir los archivos del componente:


Ahora nos vamos a Delphi y seleccionamos File -> New -> Package – Delphi for Win32. Aparecerá esto a la derecha en la ventana del proyecto:


Ahora seleccionamos File -> Save all y nos vamos a la carpeta donde hemos descomprimido el componente, por ejemplo:

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

Y guardamos el proyecto con el nombre DelphiArea.dproj. Volvemos a la ventana del proyecto y pinchamos el nombre del mismo con el botón derecho del ratón y seleccionamos Add:


En esta ventana que aparece pulsamos el botón Browse y elegimos el archivo BackgroundWorker.pas:


Ahora ya sólo tenemos que seleccionar Compile:


Y después Install:


Si todo ha ido bien mostrará este mensaje:


Si creamos un nuevo proyecto y nos fijamos en la paleta de componentes veremos el nuevo componente que hemos instalado:


Ya estamos listos para comenzar a trabajar con el mismo.

LAS CARACTERÍSTICAS DEL COMPONENTE BACKGROUNDWORKER

Insertamos el componente en el formulario donde queremos lanzar el hilo de ejecución:


Si nos fijamos en el inspector de objetos veremos que no se han estresado añadiendo propiedades:


Aunque mediante código tenemos acceso a estas variables:

CancellationPending: esta bandera booleana es utilizada para indicarnos que debemos abandonar el bucle principal del hilo (el evento OnWork que veremos más adelante). Por defecto está a False. Se pondrá a True cuando llamemos al método Cancel.

IsCancelled: variable booleana que nos dice si el hilo ha sido cancelado.

IsWorking: indica si el hilo se sigue ejecutando con normalidad.

ThreadID: es un número entero con el identificador que Windows ha asignado a nuestro hilo. Podemos utilizar esta propiedad para llamar a otras funciones de la API de Windows relacionadas con los hilos y procesos.

Y para modificar su comportamiento tenemos estos métodos:

procedure Execute;

Comienza la ejecución del hilo.

procedure Cancel;

Solicita al hilo que detenga la ejecución, es decir, pone la variable CancellationPending a True para que seamos nosotros los que abandonemos el bucle cerrado del evento OnWork.

procedure WaitFor;

Espera a que termine la ejecución del hilo.

procedure ReportProgress(PercentDone: Integer);

A este método sólo podemos llamarlo dentro del evento OnWork. Lo que hace es realizar una llamada al evento OnWorkProgress para que situemos en el mismo lo que vamos a hacer para informar al hilo primario del porcentaje de trabajo que hemos realizado.

procedure ReportProgressWait(PercentDone: Integer);

Igual que el procedimiento anterior pero espera a que termine el código que hemos colocado dentro de OnWorkProgress.

procedure ReportFeedback(FeedbackID, FeedbackValue: Integer);

Al igual que los dos procedimientos anteriores, sólo podemos llamar al mismo dentro del evento OnWork. Realiza una llamada al evento OnWorkFeedBack para que podamos enviar mensajes al hilo primario.

procedure ReportFeedbackWait(FeedbackID, FeedbackValue: Integer);

Lo mismo que el procedimiento anterior pero espera a que termine la ejecución del código que hemos puesto en el evento OnWorkFeedBack.

procedure Synchronice(Method: ThreadMethod);

Sólo podemos llamar a este procedimiento dentro del evento OnWork. Le pasamos como parámetro el método del hilo principal (VCL) para que lo ejecute por nosotros, por ejemplo, para mostrar información en pantalla o incrementar una barra de progreso.

procedure AcceptCancellation;

Sólo podemos llamar a este procedimiento dentro del evento OnWork. Debemos llamar a este procedimiento cuando dentro del evento OnWork hemos visto que la variable CancellationPending es True y entonces abandonamos el bucle principal y llamamos a este procedimiento para informar a hilo que hemos aceptado salir del mismo.

Estos son los eventos que incorpora:


Veamos para que sirve cada evento:

OnWork: Este método equivale al procedimiento Execute de la clase TThread, de hecho, se ejecuta cuando llamamos al procedimiento Execute. Es aquí donde debemos introducir el bucle continuo que va a hacer el trabajo pesado. A cada ciclo del bucle debemos comprobar el valor de la variable CancellationPending para saber si debemos terminarlo. Una vez abandonemos el bucle debemos llamar al método AcceptCancellation que pondrá la variable IsCancelled a True.

OnWorkComplete: este evento se ejecutará cuando termine la ejecución del código que hemos puesto en el evento OnWork ya sea porque ha terminado su ejecución o porque lo hemos cancelado. Aquí podemos poner el código encargado de liberar los objetos creados o cerrar archivos abiertos.

OnWorkProgress: se ejecutará el código que introducimos a este evento cuando desde el evento OnWork hemos hecho una llamada a los procedimientos ReportProgress o ReportProgressWait. Desde aquí podemos informar al hilo primario de sobre cómo vamos.

OnWorkFeedBack: se ejecuta cuando nuestro hilo envía mensajes al hilo primario mediante los procedimientos ReportFeedBack o ReportFeedBackWait.

COMO INSTALARLO EN DELPHI 7

Para instalar este componente en Delphi 7 hay que seguir estos pasos:

1º Seleccionamos en el menú superior Install -> Component.

2º En la ventana que aparece seleccionamos la pestaña Into new Package.

3º Pulsamos el botón Browse del campo Unit file name y seleccionamos el archivo BackgroundWorker.pas.

4º Pulsamos el botón Browse del campo Package file name y escribimos DelphiArea.dpk.

5º En el campo Package Description escribimos Delphi Area.

Suponiendo que el componente lo tengo descomprimido en esta carpeta:

D:\Borland\Delphi7\Componentes\BackgroundWorker\

Quedaría la ventana de este modo:


Pulsamos el botón Ok y aparecerá esta mensaje:


Pulsamos el botón Yes y si todo ha ido bien aparecerá este mensaje:


Con esto ya tiene que aparecer arriba en la paleta de componentes:


En el próximo artículo veremos un ejemplo de cómo crear un hilo de ejecución utilizando este componente.

Pruebas realizadas en RAD Studio 2007.

Los Hilos de Ejecución (y 4)

Hoy voy a terminar de hablar de otras cuestiones relacionadas con los hilos de ejecución como pueden ser las variables de tipo threadvar y las secciones críticas.

ACCESO A LA MISMA VARIABLE POR MULTIPLES HILOS

Antes de ver como utilizar una variable threadvar veamos un problema que se puede plantear cuando varios hilos intentan acceder a una variable global sin utilizar el método synchronize.

Siguiendo con nuestro ejemplo de los tres hilos que incrementan una barra de progreso cada uno, supongamos que quiero que cada barra llegue de 0 a 100 y que cuando termine voy a hacer que termine el hilo.

Después voy a crear una variable global llamada iContador:

var
  iContador: Integer;

Cuando un hilo incremente la barra de progreso entonces incrementará también esta variable global iContador:

procedure THilo.Execute;
begin
  inherited;
  FreeOnTerminate := True;
  while not Terminated do
  begin
    Inc(iContador);
    Synchronize(ActualizarProgreso);
    Sleep(100);
  end;
end;

También he añadido al formulario una etiqueta llamada ETotal que mostrará por pantalla el contenido de la variable iContador:


El procedimiento de ActualizarProgreso incrementará la barra de progreso y mostrará el contador del formulario:

procedure THilo.ActualizarProgreso;
begin
  Progreso.StepIt;
  FTresHilos.ETotal.Caption := IntToStr(iContador);

  if Progreso.Position = 100 then
  Terminate;
end;

Supuestamente, si tres hilos de ejecución incrementan cada barra de 0 a 100 entonces cuando terminen de ejecutarse el contador tendrá el valor 300. Pero no es así:


Me ha salido 277 pero lo mismo puede dar 289 que 291. Como cada hilo accede a la variable global iContador simultáneamente lo mismo la incrementa después de otro hilo que machaca el incremento del hilo anterior.

Ya vimos que esto puede solucionarse incluyendo la sentencia Inc(iContador) dentro del procedimiento ActualizarProgreso, de modo que mediante la sentencia Synchronize sólo el hilo primario podrá incrementar esta variable. Esto tiene un inconveniente y es que se forma un cuello de botella en los hilos de ejecución porque cada hilo tiene que esperar a que el hilo primario incremente la variable.

Veamos si se puede solucionar mediante variables threadvar.

LAS VARIABLES THREADVAR

Las variables de tipo threadvar son declaradas globalmente en nuestro programa para que puedan ser leídas por uno o más hilos simultáneamente pero no pueden ser modificadas por los mismos. Me explico.

Cuando un hilo lee de una variable global threadvar, si intenta modificarla sólo modificará una copia de la misma, no la original, ya que solo puede ser modificada por el hilo primario. Delphi creará automáticamente una copia de la variable threadvar para cada hilo (como si fuera una variable privada dentro del objeto que hereda de Thread).

Una variable threadvar se declara igual que una variable global:

implementation

threadvar
  iContador: Integer;

Si volvemos a ejecutar el programa veremos que iContador nunca de mueve:


Entonces, ¿de que nos sirve la variable threadvar? Su cometido es crear una variable donde sólo el hilo primario la pueda incrementar pero que a la hora de ser leía por un hilo secundario siempre tenga el mismo valor.

Para solucionar este problema lo mejor es que cada clase tenga su propio contador y que luego en el formulario principal creemos un temporizador que muestre la suma de los contadores de cada hilo y de este modo no se crean cuellos de botella ni es necesario utilizar synchronize.

Una utilidad que se le puede dar a este tipo de variables es cuando el hilo primario debe suministrar información crítica en tiempo real a los hijos secundarios y sobre todo cuando queremos que ningún hilo lea un valor distinto de otro por el simple hecho que lo ha ejecutado después.

SECCIONES CRÍTICAS

Anteriormente vimos como los objetos mutex podían controlar que cuando se ejecute cierto código dentro de un hilo de ejecución, los demás hilos tienen que esperarse a que termine.

Esto también puede crearse mediante secciones críticas (CrititalSection). Una sección crítica puede ser útil para evitar que varios hilos intenten enviar o recibir simultáneamente información de un dispositivo (monotarea). Naturalmente esto solo tiene sentido si hay dos o más instancias del mismo hilo, sino es absurdo.

Aprovechando el caso anterior de los tres hilos incrementando la barra de progreso, imaginemos que cada vez que un hilo intenta incrementa su barra de progreso, tiene que enviar su progreso por un puerto serie a un dispositivo. Aquí vamos a suponer que ese puerto serie a un objeto TStringList (que bien podía ser por ejemplo un TFileStream).

Primero creamos una variable global llamada Lista:

var
  Lista: TStringList;

Después la creo cuando pulso el botón Comenzar:

procedure TFTresHilos.BComenzarClick(Sender: TObject);
begin
  Lista := TStringList.Create;
  Progreso1.Position := 0;
  Progreso2.Position := 0;
  Progreso3.Position := 0;
  ... 

Y en el procedimiento Execute envío la posición de su barra de progreso al StringList:

procedure THilo.Execute;
begin
  inherited;
  FreeOnTerminate := True;
  while not Terminated do
  begin
    Synchronize(ActualizarProgreso);
    Lista.Add(IntToStr(Progreso.Position));
    Sleep(100);
  end;
end;

Pero al ejecutar el programa puede ocurrir esto:


Eso ocurre porque los tres hilos intentan acceder a la vez al mismo objeto StringList. Si bien podíamos solucionar esto utilizando Synchronize volvemos al problema de que cada hilo pierde su independencia respecto al hilo principal.

Lo que vamos a hacer es que si un hilo está enviando algo al objeto StringList los otros hilos no pueden enviarlo, pero si seguir su normal ejecución. Esto se soluciona creando lo que se llama una sección crítica que aísla el momento en que un hilo hace esto:

Lista.Add(IntToStr(Progreso.Position));

Para crear una sección crítica primero tenemos que declarar esta variable global:

var
  Lista: TStringList;
  SeccionCritica: TRTLCriticalSection;

Al pulsar el botón Comenzar inicializamos la sección crítica:

procedure TFTresHilos.BComenzarClick(Sender: TObject);
begin
  Lista := TStringList.Create;
  InitializeCriticalSection(SeccionCritica);
  Progreso1.Position := 0;
  Progreso2.Position := 0;
  Progreso3.Position := 0;
  ...

Acordándonos que hay que liberarla al pulsar el botón Detener:

procedure TFTresHilos.BDetenerClick(Sender: TObject);
begin
  Hilo1.Terminate;
  Hilo2.Terminate;
  Hilo3.Terminate;
  DeleteCriticalSection(SeccionCritica);
end;

Después hay que modificar el procedimiento Execute para introducir nuestra instrucción peligrosa dentro de la sección crítica:

procedure THilo.Execute;
begin
  inherited;
  FreeOnTerminate := True;
  while not Terminated do
  begin
    Synchronize(ActualizarProgreso);
    EnterCriticalSection(SeccionCritica);
    Lista.Add(IntToStr(Progreso.Position));
    LeaveCriticalSection(SeccionCritica);
    Sleep(100);
  end;
end;

Todo lo que se ejecute dentro de EnterCritialSection y LeaveCriticalSection solo será ejecutado a la vez por hilo, evitando así la concurrencia. Con esto solucionamos el problema sin tener que recurrir al hilo primario.

Aunque he abarcando bastantes temas respecto a los hilos de ejecución todavía quedan muchas cosas que entran en la zona de la API de Windows y que se salen de los objetivos de este artículo. Si encuentro algo más interesante lo publicaré en artículos independientes.

Pruebas realizadas en RAD Studio 2007.