[[Al González]]

¡Hola a todos!

En los últimos días dediqué algunos ratos libres a escribir esta unidad de código. Es algo que programé hace varios años como parte de una biblioteca que contiene muchas otras cosas, pero decidí aislar y afinar este material para compartirlo con todos los colegas Delphi de manera más directa.

La idea básica es poder crearnos clases derivadas de una como TSuperGlobalObject en lugar de TObject, cuando queramos tener una instancia de objeto que pueda ser compartida entre procesos de manera natural y transparente.

Con esto, un programa Delphi en ejecución puede instanciar un objeto de clase definida por el programador, de la manera usual:

Código Delphi [-]
  O := TMiObjeto.Create;

Y luego otro programa Delphi en ejecución puede hacer lo mismo:

Código Delphi [-]
  O := TMiObjeto.Create;

En ese momento los dos procesos estarán compartiendo el mismo objeto, y podrán acceder a sus campos y métodos como lo harían con cualquier objeto normal. Los cambios que un programa hace sobre el objeto son automáticamente visibles para el otro programa. Esto resulta en una manera muy práctica de compartir información entre dos aplicaciones que se ejecutan en la misma máquina.

Pueden hacérsele muchas mejoras a esta unidad, como adaptarle semáforos de acceso para controlar escrituras simultáneas o modificar algunas secciones de su código para hacerla segura para hilos (thread safe), pero la base ya está.

Al final de este mensaje aparece un enlace para descargarla. He aquí su código (se aceptan críticas constructivas ):

Código Delphi [-]
Unit AGSuperglobals;

{ Unidad de la clase TSuperGlobalObject, base para instancias de objetos
  "superglobales".  Copyleft 2008 Al González.
  
  Web: http://rescatandoadelphi.blogspot.com/

  Esta unidad de código está generosamente comentada para facilitar el
  aprendizaje, pero puede utilizarse libremente en cualquier proyecto. }

Interface

  Type
    {*******************************************************************}
    { Clase TSuperGlobalObject.  Base para clases de objetos cuyas      }
    { instancias pueden ser compartidas entre procesos, a nivel del     }
    { sistema, de forma natural y transparente.  Emplea funciones de    }
    { mapeo de archivos ("file-mapping") de la API de Windows para      }
    { ubicar la instancia del objeto en memoria compartida.  Aprovecha  }
    { la virtualidad del método NewInstance para llevar a cabo tan      }
    { especial asignación de memoria.                                   }
    {                                                                   }
    { NOTA: Debido a que una instancia de objeto de este tipo es en sí  }
    { una vista mapeada ("mapped view") de memoria compartida a nivel   }
    { global del sistema operativo, su uso tiene varias limitaciones:   }
    {   1. Las clases descendientes no deben implementar interfaces.    }
    {   2. Las clases descendientes no deben contener campos que        }
    {      utilicen contadores de referencia, como son las cadenas      }
    {      largas (en lugar de éstas utilice ShortString o              }
    {      "String [n]"), los variantes, las interfaces y los arreglos  }
    {      dinámicos, ni tampoco punteros.                              }
    {   3. Solo podrán emplearse métodos virtuales o referencias        }
    {      (directas o indirectas) a la clase (ClassType) del objeto,   }
    {      cuando todos los procesos que lo compartan sean instancias   }
    {      del mismo módulo ejecutable.                                 }
    {                                                                   }
    { Debe tenerse en cuenta también que los métodos de un objeto de    }
    { memoria compartida, aunque pueden realizar modificaciones en los  }
    { valores de sus campos, su ejecución se lleva a cabo en el         }
    { contexto del proceso que los llama.                               }
    {*******************************************************************}
    TSuperGlobalObject = Class
      Public
        { Redefinimos estos dos métodos virtuales para ubicar a la nueva
          instancia de objeto en la memoria compartida de Windows y
          posteriormente liberar el espacio que ocupa cuando el objeto es
          destruido }
        Class Function NewInstance :TObject; Override;
        Procedure FreeInstance; Override;
    End;

    { Tipo clase de TSuperGlobalObject, auxiliar de la función
      CreateSuperGlobalObject }
    TSuperGlobalObjectClass = Class Of TSuperGlobalObject;

  { Funciones y procedimientos }

  { Función para crear una instancia de objeto superglobal identificándola
    con un nombre específico }
  Function CreateSuperGlobalObject (Const Cls :TSuperGlobalObjectClass;
    Const Name :String) :Pointer;

Implementation

  Uses
    Classes, Windows, SysUtils;

  Var
    { Lista de identificadores ("handles") dados por la API de Windows, uno
      por cada objeto de memoria compartida.  No podemos guardar el
      identificador de cada objeto en la instancia misma, porque Windows
      proporciona diferentes identificadores a cada proceso aunque se
      trate del mismo objeto compartido. }
    HandleList :TList;

    { Lo anterior hace que debamos mantener esta lista de todos los objetos
      superglobales, para determinar cuál es el identificador de cada
      instancia creada. }
    ObjectList :TList;

    { La función CreateSuperGlobalObject guarda en esta variable el nombre
      dado, para después ser usado por el método NewInstance }
    ObjectName :String;

  { TSuperGlobalObject }

  { Redefinición del método NewInstance para evitar que el objeto sea
    constituido con un bloque de memoria convencional, haciendo que su
    memoria sea una vista mapeada del archivo de paginación del sistema
    operativo }
  Class Function TSuperGlobalObject.NewInstance :TObject;
  Var
    AlreadyExists :Boolean;
    Handle :THandle;
    Name :String;
  Begin
    { Si esta instanciación fue a través de la función
      CreateSuperGlobalObject, tomar el nombre dado, de lo contrario tomar
      el nombre de la clase para el objeto de memoria compartida }
    If ObjectName <> '' Then
      Name := ObjectName
    Else
      Name := ClassName;

    { Crear el (u obtener acceso al) objeto Windows de memoria compartida
      con el tamaño de instancia y nombre correspondientes, agregándole a
      éste el sufijo ".mem" para evitar conflictos con otro tipo de objetos
      Windows que podrían tener el mismo nombre.  Es prudente darle a cada
      objeto Windows un sufijo según su tipo (memoria compartida, mutex,
      semáforo, etc.) }
    Handle := CreateFileMapping (Invalid_Handle_Value, Nil, Page_ReadWrite,
      0, InstanceSize, Pointer (Name + '.mem'));

    { Después de llamar a CreateFileMapping, GetLastError devuelve
      error_Already_Exists si el objeto compartido ya había sido creado por
      este u otro proceso.  Eso no es propiamente un error, pero sí un
      indicador muy útil. }
    AlreadyExists := GetLastError () = error_Already_Exists;

    If Handle <> 0 Then
    Begin
      { Crear una vista mapeada sobre la totalidad del objeto Windows de
        memoria compartida.  Esta vista será nuestra "nueva" instancia de
        objeto Delphi superglobal. }
      Result := MapViewOfFile (Handle, file_map_All_Access, 0, 0, 0);

      If Result <> Nil Then
      Begin
        { Si el objeto de memoria compartida no existía previamente,
          llamamos al método InitInstance más que nada para que éste le
          asigne la clase a la cual pertenece.  No lo llamamos
          incondicionalmente porque InitInstance también inicializa en
          ceros los bytes de la instancia dada, cosa que no debemos hacer
          en caso de que el objeto superglobal estuviera ya creado. }
        If Not AlreadyExists Then
          InitInstance (Result);

        { Crear las listas de identificadores y de objetos en caso de que
          aún no lo estén }
        If HandleList = Nil Then
        Begin
          HandleList := TList.Create;
          ObjectList := TList.Create;
        End;

        { Añadir a las listas la relación identificador-objeto }
        HandleList.Add (Pointer (Handle));
        ObjectList.Add (Result);

        Exit;
      End;
    End;

    { Elevar esta excepción en caso de fallar CreateFileMapping o
      MapViewOfFile }
    Raise Exception.CreateFmt (
      'Falló intento de crear objeto superglobal "%s".', [Name]);
  End;

  { Redefinición del método FreeInstance para liberar el objeto de memoria
    compartida }
  Procedure TSuperGlobalObject.FreeInstance;
  Var
    I :Integer;
  Begin
    { Liberar la vista mapeada }
    UnmapViewOfFile (Self);

    { Liberar la memoria compartida y eliminar su identificador de la
      lista HandleList }
    I := ObjectList.IndexOf (Self);
    CloseHandle (THandle (HandleList.Extract (HandleList [i])));

    { Eliminar la instancia de la lista ObjectList }
    ObjectList.Delete (I);

    { Destruir las listas HandleList y ObjectList si han quedado vacías }
    If HandleList.Count = 0 Then
    Begin
      FreeAndNil (HandleList);
      FreeAndNil (ObjectList);
    End;
  End;

  { Funciones y procedimientos }

  { Función auxiliar para crear instancias de objetos superglobales con
    nombres específicos.  El nombre no puede ser dado como parámetro de un
    constructor porque lo necesita el método NewInstance, el cual se
    ejecuta antes que los constructores. }
  Function CreateSuperGlobalObject (Const Cls :TSuperGlobalObjectClass;
    Const Name :String) :Pointer;
  Begin
    { Guardar en la variable ObjectName el nombre que usará
      TSuperGlobalObject.NewInstance en la siguiente instanciación }
    ObjectName := Name;

    Try
      { Crear el objeto superglobal }
      Result := Cls.Create;
    Finally
      { Limpiar la variable ObjectName para no afectar a otras
        instanciaciones que se realicen sin la ayuda de esta función }
      ObjectName := '';
    End;
  End;

End.

Espero que a alguien le sea de utilidad. Ojalá todo mi trabajo consistiese en hacer cosas como esta. Algún día no muy lejano...

Un abrazo superglobal.

Al González.