delphi内存镜像

/// cxg 2020-12-9
/// 内存映射 支持跨os
/// xe10.2及以上版本适用

unit yn.map;

interface

uses
  SysUtils, SyncObjs
  {$IFDEF posix}
    , Posix.SysMman
  {$ELSE}
    , Windows
  {$ENDIF}
;

type
  PMem = ^TMem;

  TMem = record
    size: Cardinal;
    data: Pointer;
  end;

type
  TWriteRead = reference to procedure(data: pointer);

  TMemMap = class
  private
    FShareMemName: string;
    {$IFDEF mswindows}
    FFileHandle: THandle;
    {$ENDIF}
    p: PMem;
    cs: TCriticalSection;
  public
    constructor Create(const ShareMemName: string; data: Pointer; const dataLen: Cardinal); overload;
    destructor Destroy; override;
  public
    function map: Boolean;
    function unMap: Boolean;
    {$IFDEF mswindows}
    function createFileMap: Boolean;
    function openFileMap: Boolean;
    function closeFileMap: Boolean;
    {$ENDIF}
  public
    procedure write(event: TWriteRead);
    procedure read(event: TWriteRead);
  end;

implementation

{ TMemMap }
{$IFDEF mswindows}
function TMemMap.closeFileMap: Boolean;
begin
  Result := CloseHandle(FFileHandle);
end;
{$ENDIF}

constructor TMemMap.Create(const ShareMemName: string; data: Pointer; const dataLen: Cardinal);
begin
  cs := TCriticalSection.Create;
  FFileHandle := 0;
  FShareMemName := ShareMemName;
  New(p);
  p^.data := data;
  p^.size := dataLen;
end;
{$IFDEF mswindows}

function TMemMap.createFileMap: Boolean;
begin
  FFileHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, p^.size, PChar(FShareMemName));
  Result := FFileHandle <> 0;
end;
{$ENDIF}

destructor TMemMap.Destroy;
begin
  Dispose(p^.data);
  Dispose(p);
  cs.Free;
  inherited;
end;

function TMemMap.map: Boolean;
begin
  {$IFDEF mswindows}
  p^.data := MapViewOfFile(FFileHandle, FILE_MAP_ALL_ACCESS, 0, 0, p^.size);
  Result := p <> nil;
  {$ELSE}
  mmap(p^.data, p^.size, PROT_READ or PROT_WRITE, MAP_SHARED, 0, 0);
  {$ENDIF}
end;

function TMemMap.unMap: Boolean;
begin
  {$IFDEF mswindows}
  Result := UnmapViewOfFile(p^.data);
  {$ELSE}
  munmap(p^.data, p^.size);
  {$ENDIF}
end;
{$IFDEF mswindows}

function TMemMap.openFileMap: Boolean;
begin
  FFileHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, false, PChar(FShareMemName));
  Result := FFileHandle <> 0;
end;
{$ENDIF}

procedure TMemMap.read(event: TWriteRead);
begin
  {$IFDEF mswindows}
  openFileMap;
  {$ENDIF}
  self.map;
  event(p^.data);
  Self.unMap;
end;

procedure TMemMap.write(event: TWriteRead);
begin
  {$IFDEF mswindows}
  if FFileHandle = 0 then
    self.createFileMap;
  {$ENDIF}
  map;
  cs.Enter;
  try
    event(p^.data);
  finally
    cs.Leave;
  end;
  Self.unMap;
end;

end.