MAPPING DE FICHIER ET TSTREAM

unit MappedFileStream;

interface

uses
  Windows,
  SysUtils,
  Classes;

type
  TMappedFileStream = class(TStream)
  private
    hMapping : THandle;   // Handle de l'objet file-mapping
    FMemory  : pByteArray;// Adresse de base du mapping
    FHandle  : THandle;   // Handle du fichier ouvert pour le mapping
    FPosition,
    FSize    : Integer;
  public
    // Enregistre les pages modifiées dans le fichier sur le disque
    procedure Flush;
    function  Read(var Buffer; Count: Longint): Longint; override;
    function  Write(const Buffer; Count: Longint): Longint; override;
    function  Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    property  Memory: pByteArray read FMemory;
    property  Position: Integer read FPosition;
    property  Size : Integer read FSize;
    property  Handle: THandle read FHandle;
    constructor Create(FileName: string;
                       Mode: Word = fmOpenRead;
                       Rights: Cardinal = fmShareExclusive;
                       Offset: Cardinal = 0;
                       MaxSize: Cardinal = 0);
    destructor Destroy; override;
  published
    { Published declarations }
  end;

implementation

procedure TMappedFileStream.Flush;
begin
  FlushViewOfFile(FMemory, 0);
end;

function TMappedFileStream.Read(var Buffer; Count: Integer): Integer;
begin
  if FPosition + Count > Size then Count := Size - FPosition;
  move(FMemory[FPosition], Buffer, Count);
  Result := Count;
end;

function TMappedFileStream.Write(const Buffer; Count: Longint): Longint;
begin
  if FPosition + Count > Size then Count := Size - FPosition;
  move(Buffer, FMemory[FPosition], Count);
  Result := Count;
end;

function TMappedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Case Origin of
  soBeginning:  // Seek from the beginning of the resource. The seek operation moves to a specified position (offset), which must be greater than or equal to zero.
    if Offset < FSize then FPosition := Offset else raise ERangeError.Create('');
  soCurrent  :  // Seek from the current position in the resource. The seek operation moves to an offset from the current position (position + offset). The offset is positive to move forward, negative to move backward.
    if FPosition + Offset < FSize then FPosition := FPosition + Offset else raise ERangeError.Create('');
  soEnd      :  // Seek from the end of the resource. The seek operation moves to an offset from the end of the resource, where the offset is expressed as a negative value because it is moving toward the beginning of the resource.
    if FSize - Offset >= 0 then FPosition := FSize - Offset else raise ERangeError.Create('');
  end;

  result := FPosition;
end;

constructor TMappedFileStream.Create(FileName: string;
                                     Mode: Word = fmOpenRead;
                                     Rights: Cardinal = fmShareExclusive;
                                     Offset: Cardinal = 0;
                                     MaxSize: Cardinal = 0);
var
    dwDA, dwSM, dwCD, flP, dwVA: DWORD;
    FileInfo: _BY_HANDLE_FILE_INFORMATION;
begin
// Initialise correctement les attributs de construction du mapping
  case Mode of
    fmCreate:
      begin
        dwCD := CREATE_ALWAYS;
        dwDA := GENERIC_WRITE and GENERIC_READ;
        dwVA := FILE_MAP_WRITE;
        flP  := PAGE_READWRITE;
      end;
    fmOpenRead:
      begin
        dwCD := OPEN_EXISTING;
        dwDA := GENERIC_READ;
        dwVA := FILE_MAP_READ;
        flP  := PAGE_READONLY;
      end;
    fmOpenWrite:
      begin
        dwCD := TRUNCATE_EXISTING;
        dwDA := GENERIC_WRITE and GENERIC_READ;
        dwVA := FILE_MAP_WRITE;
        flP  := PAGE_READWRITE;
      end;
    fmOpenReadWrite:
      begin
        dwCD := OPEN_EXISTING;
        dwDA := GENERIC_WRITE and GENERIC_READ;
        dwVA := FILE_MAP_WRITE;
        flP  := PAGE_READWRITE;
      end;
  end;

  case Rights of
    fmShareCompat or fmShareExclusive:
      begin
        dwSM := 0;
      end;
    fmShareDenyWrite:
      begin
        dwSM := FILE_SHARE_READ;
      end;
    fmShareDenyRead:
      begin
        dwSM := FILE_SHARE_WRITE;
      end;
    fmShareDenyNone:
      begin
        dwSM := FILE_SHARE_READ and FILE_SHARE_WRITE;
      end;
  end;

// Ouvre le fichier
  FileName := FileName + #0; // Ajout du zero terminal
  FHandle := CreateFile(@FileName[1], dwDA, dwSM, nil, dwCD, 0, 0);
  inherited create;
  if FHandle = INVALID_HANDLE_VALUE then raise Exception.Create('Erreur Windows N°' + IntToStr(GetLastError));

  if MaxSize = 0 then begin
    if not GetFileInformationByHandle(FHandle, FileInfo) then begin
       CloseHandle(FHandle);
       raise Exception.Create('Erreur Windows N°' + IntToStr(GetLastError));
    end;
    FSize := FileInfo.nFileSizeLow;
  end else FSize := MaxSize;

  hMapping := CreateFileMapping(FHandle, nil, flP, 0, FSize, nil);
  if hMapping = INVALID_HANDLE_VALUE then begin
    FileClose(FHandle);
    raise Exception.Create('Erreur Windows N°' + IntToStr(GetLastError));
  end;

  FMemory := MapViewOfFile(hMapping, dwVA, 0, 0, FSize);
  if FMemory = nil then begin
    FileClose(FHandle);
    CloseHandle(hMapping);
    raise Exception.Create('Erreur Windows N°' + IntToStr(GetLastError));
  end;

end;

destructor TMappedFileStream.Destroy;
begin
  Flush;
  UnMapViewOfFile(FMemory);
  CloseHandle(hMapping);
  CloseHandle(FHandle);
  inherited destroy;
end;

end.