delphi内存镜像

左半脑思维 發表於 2022-4-10 16:41:00

<div class="cnblogs_code">
<pre>/// <author>cxg 2020-12-9</author>
/// 内存映射支持跨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.</pre>
</div>
 

</div>
<div id="MySignature" role="contentinfo">
本文来自博客园，作者：{咏南中间件}，转载请注明原文链接：https://www.cnblogs.com/hnxxcxg/p/16126461.html 
来源：https://www.cnblogs.com/hnxxcxg/p/16126461.html

頁: [1]

琼殿技术论坛's Archiver

delphi内存镜像