TMemoFileMap, Memo en paginado (memoria virtual)

[elcolo83]

Aca les dejo el código de un componente que hice en estos dias, el "TMemoFileMap", que no es ni mas ni menos que un memo con el cual podemos comunicar dos aplicaciones distintas transfiriendo datos entre ellas pasando el contenido de un memo a otro. A mi me fue bastante util con aplicaciones que usan plugins y necesitan comunicarse entre ellos, creo que alguno mas le puede llegar a servir.
Saludos.

Código Delphi [-]
unit MemoFileMap;

interface

uses
  Windows, SysUtils, Classes, Controls, StdCtrls, Messages, Dialogs, ShellApi;

 CONST
   // Definimos los mensajes
   WM_TRANSFER = WM_USER + 1;
   WM_TRANSFEROK = WM_USER + 2;
   WM_LIBERARARCH = WM_USER + 3;
   WM_DESCONECTADO = WM_USER + 4;

 type
  PCompartido =^TCompartido;
  TCompartido = record
    Manejador1: String[200];
    Manejador2: String[200];
    Activo: Boolean;
    Leido: Boolean;
    Emisor: Integer;
    Continua: Boolean;
    Numero    : Integer;
    Cadena    : String[5];
    EndDoc: Boolean;
  end;

  TEstado = (MtOffLine, MtDesconectado, MtRecibiendo, MtEnviando);

  TEventoEmpezo = procedure(Sender: TObject; State, NewState: TEstado) of Object;
  TEventoTermino = procedure(Sender: TObject; State, NewState: TEstado) of Object;
  TEventoFin = procedure(Sender: TObject) of Object;
  TEventoRecibe = procedure(Sender: TObject; var Cadena: String;
                              Var Escribir:Boolean) of Object;

  TMemoFileMap = class(TMemo)
  private
    { Private declarations }
    Archivo_: string;
    Activo_: Boolean;
    Propietario_: Boolean;
    Creo_: Boolean;
    Estado_: TEstado;
    Compartido: PCompartido;
    FicheroM: THandle;
    Index: Integer;
    X: Integer;
    Cadena_: String;
    BeginDoc: Boolean;

    EOnEmpezo: TEventoEmpezo;
    EOnTermino: TEventoTermino;
    EOnRecibe: TEventoRecibe;
    EOnDesconectado: TEventoFin;

    procedure SetArch(Archivo: string);
    procedure SetActivo(Activo: Boolean);
  protected
    { Protected declarations }
    procedure Reciviendo(var Msg: TMessage); message WM_TRANSFER;
    procedure Listo(var Msg: TMessage); message WM_TRANSFEROK;
    procedure LiberarArch(var Msg: TMessage); message WM_LIBERARARCH;
    procedure Desconectar(var Msg: TMessage); message WM_DESCONECTADO;

    Procedure CerrarArchivo;
    Procedure MapearArchivo;
  public
    { Public declarations }
  published
    { Published declarations }

    constructor create(AOwner : TComponent); override;
    destructor  destroy; override;

    property Archivo: string read Archivo_ write SetArch;
    property Activo: Boolean read Activo_ write SetActivo;
    property Propietario: Boolean read Propietario_;
    property Estado: TEstado read Estado_;

    property OnStartTransfer: TEventoEmpezo
                  read  EOnEmpezo
                  write EOnEmpezo;

    property OnEndTransfer: TEventoTermino
                  read  EOnTermino
                  write EOnTermino;

    property OnRecibe: TEventoRecibe
                  read  EOnRecibe
                  write EOnRecibe;

    property OnDesconectado: TEventoFin
                  read  EOnDesconectado
                  write EOnDesconectado;

    Procedure Enviar;
  end;

procedure Register;

implementation

procedure TMemoFileMap.Desconectar(var Msg: TMessage);
begin
  if Assigned(EOnDesconectado) then
      EOnDesconectado(Self)
end;


Procedure TMemoFileMap.Enviar;
var F: Integer;
begin
if Not Activo_ then
  Exit;

if not Compartido^.Activo then
  begin
    if Assigned(EOnEmpezo) then
      EOnEmpezo(Self, Estado_, MtEnviando);
    Estado_:= MtEnviando;
    Compartido^.Activo:= True;
    if Propietario_ then
      Compartido^.Emisor:= 1;
    Compartido^.Activo:= True;
    Index:= 0;
    X:= 1;
    Compartido^.Continua:= False;
    Compartido^.Leido:= True;
  end;


if  Compartido^.Leido then
  begin
    if Lines.Count>Index then
      begin
        if Compartido^.Leido then
          begin
            Compartido^.Continua:= False;
            F:= Length(Lines[Index])-X+1;
            if F>5 then
               begin
                F:= 5;
                Compartido^.Continua:= True;
               end;
            Compartido^.Cadena:= Copy(Lines[Index], X, F);
            X:= X+F;
            Compartido^.Leido:= False;
            if not Compartido^.Continua then
              begin
                Index:= Index+1;
                X:= 1;
              end;
            if Lines.Count=Index then
              Compartido^.EndDoc:= true
            else Compartido^.EndDoc:= False;
            Estado_:= MtEnviando;
            if Propietario_ then
              PostMessage(StrToInt(Compartido^.Manejador2), WM_TRANSFER,0, 0)
            else PostMessage(StrToInt(Compartido^.Manejador1), WM_TRANSFER,0, 0);
          end;
      end
    else
      begin
        Index:= Index+1;
        Compartido^.Leido:= False;
        Compartido^.Activo:= False;
        Compartido^.Emisor:= 0;
        Compartido^.Cadena:= '';
        Compartido^.Continua:= False;
        if Assigned(EOnTermino) then
            EOnTermino(Self, Estado_, MtDesconectado);
        Estado_:= MtDesconectado;
        if Propietario_ then
          PostMessage(StrToInt(Compartido^.Manejador2), WM_DESCONECTADO,0, 0)
        else PostMessage(StrToInt(Compartido^.Manejador1), WM_DESCONECTADO,0, 0);
      end;
  end;
end;


procedure TMemoFileMap.Listo(var Msg: TMessage);
begin
  Enviar;
end;

procedure TMemoFileMap.Reciviendo(var Msg: TMessage);
var Escribir: Boolean;
begin
  Cadena_:= Cadena_+compartido^.Cadena;
  if not compartido^.Continua then
    begin
      Escribir:= True;

      if not BeginDoc then
        begin
          Cadena_:= Cadena_;
          BeginDoc:= True;
          if Assigned(EOnEmpezo) then
            EOnEmpezo(Self, Estado_, MtRecibiendo);
        end;

      Estado_:= MtRecibiendo;
      if Assigned(EOnRecibe) then
          EOnRecibe(Self, Cadena_, Escribir);

      if Escribir then
          Lines.Add(Cadena_);
      Cadena_:= '';

      if Compartido^.EndDoc then
        begin
          BeginDoc:= False;
          if Assigned(EOnTermino) then
            EOnTermino(Self, Estado_, MtDesconectado);
          Estado_:= MtDesconectado;
        end;

    end;

  Compartido^.Leido:= True;
  if Propietario_ then
    PostMessage(StrToInt(Compartido^.Manejador2), WM_TRANSFEROK,0, 0)
  else PostMessage(StrToInt(Compartido^.Manejador1), WM_TRANSFEROK,0, 0);
end;


Procedure TMemoFileMap.MapearArchivo;
var D: PCHar;
    W: WNDClass;
begin
   Propietario_:= False;
   Creo_:= False;
   Cadena_:= '';
   Estado_:= MtOffLine;
   BeginDoc:= False;
   {Miramos si existe el fichero}
   FicheroM:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,PChar(Archivo_));

   {Si no existe, Veo si lo puedo crear}
   if FicheroM=0 then
    begin
     {Creamos el fichero de memoria}
     FicheroM:=CreateFileMapping( $FFFFFFFF,nil,PAGE_READWRITE,0,
                                 SizeOf(TCompartido), PChar(Archivo_));
      {Si no se creó el fichero, lo llenamos de ceros}
      if FicheroM=0 then
        raise Exception.Create( 'Error al crear el fichero'+
                                '/Error while create file')
      else
        begin
          Propietario_:= True;
          Creo_:= True;
        end;
    end
   else Creo_:= True;

    if Creo_ then
      Estado_:= MtDesconectado;

    {Direccionamos nuestra estructura al fichero de memoria}
    Compartido:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);
    
    if (Compartido^.Manejador1 = IntToStr(Handle)) or
        (Compartido^.Manejador1 = '0') then
      begin
        Propietario_:= True;
        Creo_:= True;
        Estado_:= MtDesconectado;
      end;
    {Escribimos datos en el fichero de memoria}
    if Propietario_ then
      begin
        Compartido^.Manejador1:= IntToStr(Handle);
        Compartido^.Manejador2:= '0';
      end
    else
      begin
        if Compartido^.Manejador2 = '0' then
          Compartido^.Manejador2:= IntToStr(Handle)
        else Activo_:= False;
      end;
    Compartido^.Numero:=0;
    Compartido^.Cadena:='';
    Compartido^.Activo:= False;
    Compartido^.Leido:= False;
    Compartido^.Emisor:= 0;
    Compartido^.EndDoc:= True;
end;

procedure TMemoFileMap.SetActivo(Activo: Boolean);
begin
  Activo_:= Activo;
  if Activo then
    MapearArchivo
  else
    CerrarArchivo;
  Enabled:= Activo_;
end;


procedure TMemoFileMap.LiberarArch(var Msg: TMessage);
var M1: Integer;
begin
if Not Propietario_  then
  begin
    M1:= StrToInt(Compartido^.Manejador1);
    Compartido^.Manejador1:= '0';
    if Creo_ then
        SetActivo(False);
    PostMessage(M1, WM_LIBERARARCH,0, 0);
  end
else
  CerrarArchivo;
end;


Procedure TMemoFileMap.CerrarArchivo;
begin
if not Creo_ then
  exit;
{Cerramos la vista del fichero}
if Not Propietario then
  begin
    Compartido^.Manejador2:= '0';
    UnmapViewOfFile(Compartido);
    Propietario_:= False;
    Estado_:= MtOffLine;
  end
else
  begin
    if Compartido^.Manejador2<>'0' then
      PostMessage(StrToInt(Compartido^.Manejador2), WM_LIBERARARCH,0, 0)
    else
      begin
        Compartido^.Manejador1:= '0';
        UnmapViewOfFile(Compartido);
        CloseHandle(FicheroM); {Cerramos el fichero si es mio}
        Propietario_:= False;
        Estado_:= MtOffLine;
      end;
  end;
end;

procedure TMemoFileMap.SetArch(Archivo: string);
begin
  Archivo_:= Archivo;
end;


constructor TMemoFileMap.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Parent:= TWinControl(AOwner);
  SetArch('MemoMapfile');
  Propietario_:= False;
  Activo_:= False;
  Enabled:= False;
  Estado_:= MtOffLine;
end;


destructor TMemoFileMap.Destroy;
begin
  if Activo_ then
    SetActivo(False);
  inherited Destroy;
end;



procedure Register;
begin
  RegisterComponents('DXel', [TMemoFileMap]);
end;

end.

[roman]

Pues oye, muchas gracias. Si gustas, también puedes subirlo al FTP del club, así estará a la mano para cualquiera que lo necesite.

// Saludos

[elcolo83]

Hola Roman, no sabia eso... ahora subo el .pas asi queda a disposicion del que lo necesite.
Saludos

[elcolo83]

Ya subi los archivos al ftp del club este es el link
http://www.terawiki.clubdelphi.com/D...emoFileMap.rar
Saludos