Recent

Author Topic: exists a filemaping in pas?  (Read 1402 times)

ASerge

  • Hero Member
  • *****
  • Posts: 2336
Re: exists a filemaping in pas?
« Reply #15 on: July 19, 2024, 02:41:13 pm »
Stream like memmap (Windows only):
Code: Pascal  [Select][+][-]
  1. {$MODE OBJFPC}
  2. {$LONGSTRINGS ON}
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses Windows, RTLConsts, SysUtils, Classes;
  6.  
  7. type
  8.   TFileMapRead = class(TCustomMemoryStream)
  9.   strict private
  10.     FMapHandle: THandle;
  11.   public
  12.     constructor Create(const FileName: string);
  13.     function Write(const Buffer; Count: LongInt): LongInt; override;
  14.     destructor Destroy; override;
  15.   end;
  16.  
  17. // TFileMapRead
  18.  
  19. function GetFileSizeEx(hFile: THandle; out FileSize: PtrInt): BOOL; external kernel32 name 'GetFileSizeEx';
  20.  
  21. constructor TFileMapRead.Create(const FileName: string);
  22. var
  23.   FileSize: PtrInt;
  24.   HFile: THandle;
  25.   P: Pointer;
  26. begin
  27.   inherited Create;
  28.   HFile := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ, FILE_SHARE_READ,
  29.     nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
  30.   if HFile = INVALID_HANDLE_VALUE then
  31.     RaiseLastOSError;
  32.   if GetFileSizeEx(HFile, FileSize) and (FileSize > 0) then
  33.   begin
  34.     FMapHandle := CreateFileMapping(HFile, nil, PAGE_READONLY, 0, 0, nil);
  35.     CloseHandle(HFile);
  36.     if FMapHandle = 0 then
  37.       RaiseLastOSError;
  38.     P := MapViewOfFile(FMapHandle, FILE_MAP_READ, 0, 0, 0);
  39.     if P = nil then
  40.       RaiseLastOSError;
  41.     SetPointer(P, FileSize);
  42.   end
  43.   else
  44.   begin
  45.     CloseHandle(HFile);
  46.     SetPointer(nil, 0);
  47.   end;
  48. end;
  49.  
  50. destructor TFileMapRead.Destroy;
  51. begin
  52.   if Memory <> nil then
  53.   begin
  54.     UnmapViewOfFile(Memory);
  55.     SetPointer(nil, 0);
  56.   end;
  57.   if FMapHandle <> 0 then
  58.     CloseHandle(FMapHandle);
  59.   inherited;
  60. end;
  61.  
  62. function TFileMapRead.Write(const Buffer; Count: LongInt): LongInt;
  63. begin
  64.   raise EStreamError.Create(SCantWriteResourceStreamError);
  65. end;
  66.  
  67. // Example
  68.  
  69. var
  70.   MFile: TFileMapRead;
  71. begin
  72.   MFile := TFileMapRead.Create(ParamStr(0)); // Self read
  73.   try
  74.     // Direct memory access
  75.     Writeln(PChar(MFile.Memory)); // 'MZP'
  76.   finally
  77.     MFile.Free;
  78.   end;
  79.   Readln;
  80. end.

 

TinyPortal © 2005-2018