Mapping de fichier et tstream

Contenu du snippet

Cette unit contien un simple objet TSream surchargé pour employé le principe du mapping de fichier en mémoire de Windows. Il s'utilise comme un MemoryStream ou un FileSream

Source / Exemple :


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.

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.