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.