Stream like memmap (Windows only):
{$MODE OBJFPC}
{$LONGSTRINGS ON}
{$APPTYPE CONSOLE}
uses Windows, RTLConsts, SysUtils, Classes;
type
TFileMapRead = class(TCustomMemoryStream)
strict private
FMapHandle: THandle;
public
constructor Create(const FileName: string);
function Write(const Buffer; Count: LongInt): LongInt; override;
destructor Destroy; override;
end;
// TFileMapRead
function GetFileSizeEx(hFile: THandle; out FileSize: PtrInt): BOOL; external kernel32 name 'GetFileSizeEx';
constructor TFileMapRead.Create(const FileName: string);
var
FileSize: PtrInt;
HFile: THandle;
P: Pointer;
begin
inherited Create;
HFile := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ, FILE_SHARE_READ,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if HFile = INVALID_HANDLE_VALUE then
RaiseLastOSError;
if GetFileSizeEx(HFile, FileSize) and (FileSize > 0) then
begin
FMapHandle := CreateFileMapping(HFile, nil, PAGE_READONLY, 0, 0, nil);
CloseHandle(HFile);
if FMapHandle = 0 then
RaiseLastOSError;
P := MapViewOfFile(FMapHandle, FILE_MAP_READ, 0, 0, 0);
if P = nil then
RaiseLastOSError;
SetPointer(P, FileSize);
end
else
begin
CloseHandle(HFile);
SetPointer(nil, 0);
end;
end;
destructor TFileMapRead.Destroy;
begin
if Memory <> nil then
begin
UnmapViewOfFile(Memory);
SetPointer(nil, 0);
end;
if FMapHandle <> 0 then
CloseHandle(FMapHandle);
inherited;
end;
function TFileMapRead.Write(const Buffer; Count: LongInt): LongInt;
begin
raise EStreamError.Create(SCantWriteResourceStreamError);
end;
// Example
var
MFile: TFileMapRead;
begin
MFile := TFileMapRead.Create(ParamStr(0)); // Self read
try
// Direct memory access
Writeln(PChar(MFile.Memory)); // 'MZP'
finally
MFile.Free;
end;
Readln;
end.
Recent
