unit MemMapFile;

interface

uses
  {$IFDEF MSWINDOWS}
  Winapi.Windows,
  {$ENDIF}
  {$IF Defined(NEXTGEN) AND Defined(POSIX)}
  Posix.Unistd,
  {$ENDIF}

  System.Classes, System.SysUtils;

type
  TMMFStream = class(TStream)
  private
    FileHandle : THandle;
    {$IFDEF MSWINDOWS}
    MapHandle : THandle;
    {$ENDIF}
    FMemory : Pointer;
    FSize : Int64;
    FOffset : Integer;
    FFileName : String;
  public
    constructor Create(_FileName : String);
    destructor Destroy; override;
    function Read(var Buffer; Count : Longint) : Longint; override;
    function Write(const Buffer; Count : Longint) : Longint; override;
    function Seek(Offset : Longint; Origin : Word) : Longint; override;
    function Offset(Offset : Longint) : Pointer;
    property Memory : Pointer read FMemory;
    property Size : Int64 read FSize;
    property FileName : String read FFileName;
  end;


implementation

{$IFDEF MSWINDOWS}
procedure RaiseKnownWin32Error(RetVal : Integer);
var
  Error : EOSError;
begin
  if RetVal <> ERROR_SUCCESS then
    Error := EOSError.CreateFmt('Win 32 Error %d:%s', [RetVal,
      SysErrorMessage(RetVal)])
  else
    Error := EOSError.Create('Unknown Win 32 error');
  Error.ErrorCode := RetVal;
  raise Error;
end;

function Win32CheckKnown(Error : Integer) : Integer;
begin
  if Error <> ERROR_SUCCESS then RaiseKnownWin32Error(Error);
  Result := Error;
end;
{$ENDIF}

function FileSizeByName(const AFilename: String): Int64;
begin
  Result := -1;
  if (not FileExists(AFilename)) then
    Exit;
  // the other cases simply return -1 on error, so make sure to do the same here
  try
    with TFileStream.Create(AFilename,fmOpenRead or fmShareDenyNone) do
    try
      Result := Size;
    finally
      Free;
    end;
  except
  end;
end;

constructor TMMFStream.Create(_FileName : String);
begin
  inherited Create;
  FMemory := nil;
  {$IFDEF MSWINDOWS}
  MapHandle := 0;
  {$ENDIF}
  FileHandle := INVALID_HANDLE_VALUE;
  FFileName := _FileName;

  FSize := FileSizeByName(_FileName);
  if FSize <= 0 then Exit;

  {$IFDEF MSWINDOWS}
  // Open the file
  FileHandle := CreateFile(
    PChar(FileName),     // File name
    GENERIC_READ,        // Access (0, GENERIC_READ, GENERIC_WRITE)
    FILE_SHARE_READ,     // Sharing (0, FILE_SHARE_READ, FILE_SHARE_WRITE)
    Nil,                 // Security settings
    OPEN_EXISTING,       // How to create
    FILE_FLAG_RANDOM_ACCESS,  // Flags and attributes
    0);                  // handle of file with attributes to copy
  if FileHandle = INVALID_HANDLE_VALUE then Win32CheckKnown(GetLastError);
  try
    // Create the mapping
    MapHandle := CreateFileMapping(
      FileHandle,
      Nil,
      PAGE_READONLY,
      0, Cardinal(FSize),
      NIL);
    if MapHandle = 0 then Win32CheckKnown(GetLastError);
    try
      // Map it!
      FMemory := MapViewOfFile(  // Ex?
        MapHandle,
        FILE_MAP_READ,
        0, 0,
        Cardinal(FSize));
      if FMemory = Nil then Win32CheckKnown(GetLastError);
      //raise Exception.Create('Could not map a view of the file');
    except
      CloseHandle(MapHandle);
      MapHandle := 0;
      raise;
    end;
  except
    CloseHandle(FileHandle);
    FileHandle := INVALID_HANDLE_VALUE;
    raise;
  end;
  {$ELSEIF DEF POSIX}}
  // Open the file
  FileHandle := Fileopen(_FileName, fmOpenRead or fmShareDenyNone );

  if FileHandle = INVALID_HANDLE_VALUE then RaiseLastOSError;

  // Map it!
  FMemory := mmap(nil,FSize,PROT_READ, MAP_SHARED,FileHandle,0);

  if FMemory = Nil then RaiseLastOSError;
  {$ELSE}
  ShowMessageMultiplatform('MMF not supported on your platform!');
  {$ENDIF}
end;

destructor TMMFStream.Destroy;
begin
  {$IFDEF MSWINDOWS}
  if FMemory <> Nil then
    UnmapViewOfFile(FMemory);
  if MapHandle <> 0 then CloseHandle(MapHandle);
  {$ELSEIF DEF POSIX}}
  if FMemory <> Nil then
    if munmap(FMemory, FSize) <> 0 then
      RaiseLastOSError;
  {$ENDIF}
  if FileHandle <> INVALID_HANDLE_VALUE then FileClose(FileHandle);
  inherited Destroy;
end;

function TMMFStream.Read(var Buffer; Count : Longint) : Longint;
begin
  if FOffset + Count > FSize then
    Count := FSize - FOffset;
  Move(PByte(FMemory)[FOffset], Buffer, Count);
  Inc(FOffset, Count);
  Result := Count;
end;

function TMMFStream.Write(const Buffer; Count : Longint) : Longint;
begin
  Result := 0;
  if FOffset + Count > FSize then
    Exit;
  Move(Buffer, PByte(FMemory)[FOffset], Count);
  Inc(FOffset, Count);
  Result := Count;
end;

function TMMFStream.Seek(Offset : Longint; Origin : Word) : Longint;
begin
  case Origin of
    soFromBeginning: FOffset := Offset;
    soFromCurrent: FOffset := FOffset + Offset;
    soFromEnd: FOffset := FSize - Offset;
  end;
  Result := FOffset;
end;


function TMMFStream.Offset(Offset : Integer) : Pointer;
begin
  if (Offset < 0) or (Offset >= FSize) then
    Result := nil
  else
    Result := @PByte(FMemory)[Offset];
end;

end.