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
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
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
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
published
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;
FicheroM:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,PChar(Archivo_));
if FicheroM=0 then
begin
FicheroM:=CreateFileMapping( $FFFFFFFF,nil,PAGE_READWRITE,0,
SizeOf(TCompartido), PChar(Archivo_));
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;
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;
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;
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);
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.