// Общая память для процессов.
unit FileMapping;

interface
        USES Windows;

type
  tMapRecord=packed record
    Offset:int64;
    Size:dword;
    Access:dword;
    Pointer:pointer;
  end;

  tMappingsArray=array of tMapRecord;

  tFileMapping=class(tObject)
    private
      prFileHandle:tHandle;
      prMappingHandle:tHandle;
      prMappings:tMappingsArray;

      prFileName:string;
      prFileSize:int64;

      prBaseMapping:boolean;

      prName:string;
      prAccess:dword;
      prProtect:dword;


      function prGetMapping(aIndex:cardinal):tMapRecord;
      function prGetMappingsCount:cardinal;
    protected
    public
      constructor Create(const aMappingName:string;  aMappingAccess:dword; aFileSize:int64; aMappingProtect:dword; const aFileName:string='');
      destructor Destroy; override;
      function Map(aOffset:int64; aSize:dword; aAccess:dword):pointer;
      procedure UnMap(aIndex:cardinal); overload;
      procedure UnMap(aPointer:pointer); overload;
      procedure UnMapAll;
      function IndexOf(aPointer:pointer):cardinal;
      property FileName:string read prFileName;
      property Name:string read prName;
      property Access:dword read prAccess;
      property Protect:dword read prProtect;
      property FileSize:int64 read prFileSize;
      property Mappings[i:cardinal]:tMapRecord read prGetMapping;
      property Count:cardinal read prGetMappingsCount;
      property BaseMapping:boolean read prBaseMapping;
    published
  end;

  int64rec=packed record
    case boolean of
     TRUE:(int:int64);
     FALSE:(LoDWORD, HiDWORD:DWORD);
  end;

implementation
  USES SysUtils;

constructor tFileMapping.Create(const aMappingName:string;  aMappingAccess:dword; aFileSize:int64; aMappingProtect:dword; const aFileName:string='');
  var fh,mh:tHandle;
begin
  Inherited Create;
  mh:=OpenFileMapping(aMappingAccess, False, PChar(aMappingName));
  fh:=INVALID_HANDLE_VALUE;
  if mh = 0 then begin
    if aFileName<>'' then begin
      fh:=CreateFile(PChar(aFileName), GENERIC_READ OR GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
      win32check(fh <> 0);
      prFileName:=aFileName;
    end;
    mh:=CreateFileMapping(fh, nil, aMappingProtect, int64rec(aFileSize).HiDWORD, int64rec(aFileSize).LoDWORD, PChar(aMappingName));
    try
      win32check(mh <> 0);
      prProtect:=aMappingProtect;
      prFileSize:=aFileSize;
      prBaseMapping:=TRUE;
    except
      CloseHandle(fh);
      raise;
    end;
  end;
  prFileHandle:=fh;
  prMappingHandle:=mh;

  prName:=aMappingName;
  prAccess:=aMappingAccess;
end;

function tFileMapping.Map(aOffset:int64; aSize:dword; aAccess:dword):pointer;
  var i:cardinal;
begin
  result:=MapViewOfFile(prMappingHandle, aAccess, int64rec(aOffset).HiDWORD, int64rec(aOffset).LoDWORD, aSize);
  win32check(Assigned(result));

  i:=Length(prMappings);
  SetLength(prMappings, i+1);
  with prMappings[i] do begin
    Offset:=aOffset;
    Size:=aSize;
    Access:=aAccess;
    Pointer:=result;
  end;
end;

procedure tFileMapping.UnMap(aIndex:cardinal);
  var  i,j:cardinal; mr:tMapRecord;
begin
  i:=Length(prMappings);
  If aIndex>=i then raise Exception.Create('tFileMapping class: invalid index to unmap: '+IntToStr(aIndex));

  mr:=prMappings[aIndex];

  if aIndex<(i-1) then begin
    for j:=aIndex to i-2 do begin
      prMappings[j]:=prMappings[j+1];
    end;
  end;

  SetLength(prMappings, i-1);

  Win32Check(UnmapViewOfFile(mr.Pointer));
end;

procedure tFileMapping.UnMap(aPointer:pointer);
begin
  UnMap(IndexOf(aPointer));
end;

procedure tFileMapping.UnMapAll;
  var i:cardinal;
begin
  for i:=Length(prMappings) downto 1 do begin
    UnMap(i-1);
  end;
end;

destructor tFileMapping.Destroy;
begin
  UnMapAll;
  Inherited;
end;

function tFileMapping.prGetMapping(aIndex:cardinal):tMapRecord;
  var i:cardinal;
begin
  i:=Length(prMappings);
  If aIndex>=i then raise Exception.Create('tFileMapping class: invalid index to get: '+IntToStr(aIndex));
  result:=prMappings[aIndex];
end;

function tFileMapping.prGetMappingsCount:cardinal;
begin
  result:=Length(prMappings);
end;

function tFileMapping.IndexOf(aPointer:pointer):cardinal;
  var i:cardinal;
begin
  if Length(prMappings)>0 then begin
    for i:=0 to Length(prMappings)-1 do begin
      if prMappings[i].Pointer=aPointer then begin
        result:=i;
        Exit;
      end;
    end;
  end;
  result:=High(result);
end;

end.