This unit implement a Stream class supporting the FileMapping utilities.
The class TFileMappingStream_San inherits TStream, and provide with an
easier way to manipulate the FileMapping objects in comparison of windows APIs.
It's a pity that there is not ,in my opinion , a way to detect the size
of a FileMapping Object with a specific name,which was already created
directly by windows API or others. Anyone knows ,please tell me.
Thanks! sanease@tom.com
c_emsamename = 'The global atom with the name of "%s" already exists';
c_emdiskfull = 'The disk is full , it''s unable to Create the filemapping' +
'with the Size of %d bytes and the Name of "%s"';
c_emunknown = 'Unknown error occured when create file mapping with the name of "%s"';
c_emprotect = 'The protect mode %d of filemapping is invalid with the name of "%s"';
type TFileMappingStream_San = class(TStream) private FMapHandle: DWORD;
FFileHandle: DWORD;
FName: PChar;
FExists: Boolean;
FPointer: Pointer;
FProtectMode: DWORD;
FSize: DWORD;
FResizeable: Boolean;
FPosition: DWORD; ///////// function getname: string; public
function read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(Offset: Longint; Origin: Word): Longint; overload; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
function AlreadyExists: Boolean; function DataPointer: Pointer;
constructor TFileMappingStream_San.Create(AHandle: DWORD; AName: string;
ASize: Cardinal; ProtectMode: DWORD); var i: DWORD; begin
if asize < 0 then asize := 0;
fresizeable := asize = 0;
fmaphandle := createfilemapping(ahandle, nil, protectmode, 0,asize, PChar(aname)); if fmaphandle = 0 then
begin i := GetLastError; case i of ERROR_DISK_FULL: begin
raise Exception.Create(Format(c_emdiskfull, [fname])); end;
ERROR_INVALID_HANDLE: begin
raise Exception.Create(Format(c_emsamename, [fname])); end;
0:; else
begin
raise Exception.Create(Format(c_emprotect, [protectmode, aname])); end; end; end
else
begin fname := nil;
ffilehandle := ahandle;
fprotectmode := protectmode;
fsize := asize;
fexists := GetLastError = ERROR_ALREADY_EXISTS;
i := $FFFFFFFF; if protectmode and PAGE_READONLY = PAGE_READONLY then i := i and FILE_MAP_READ; if protectmode and PAGE_READWRITE = PAGE_READWRITE then i := i and FILE_MAP_ALL_ACCESS; if protectmode and PAGE_WRITECOPY = PAGE_WRITECOPY then i := i and FILE_MAP_COPY;
fpointer := mapviewoffile(fmaphandle, i, 0,0,0); end; end;
constructor TFileMappingStream_San.Create(AHandle: DWORD; ASize: Cardinal;
ProtectMode: DWORD); var i: DWORD; begin
if asize < 0 then asize := 0;
fresizeable := asize = 0;
fmaphandle := createfilemapping(ahandle, nil, protectmode, 0,asize, nil); if fmaphandle = 0 then
begin i := GetLastError; case i of ERROR_DISK_FULL: begin
raise Exception.Create(Format(c_emdiskfull, [asize, ''])); end;
ERROR_INVALID_HANDLE: begin
raise Exception.Create(Format(c_emsamename, [fname])); end;
0:; else
begin
raise Exception.Create(Format(c_emprotect, [protectmode, ''])); end; end; end
else
begin fname := nil;
ffilehandle := ahandle;
fprotectmode := protectmode;
fsize := asize;
fexists := GetLastError = ERROR_ALREADY_EXISTS;
i := $FFFFFFFF; if protectmode and PAGE_READONLY = PAGE_READONLY then i := i and FILE_MAP_READ; if protectmode and PAGE_READWRITE = PAGE_READWRITE then i := i and FILE_MAP_ALL_ACCESS; if protectmode and PAGE_WRITECOPY = PAGE_WRITECOPY then i := i and FILE_MAP_COPY;
fpointer := mapviewoffile(fmaphandle, i, 0,0,0); end; end;
function TFileMappingStream_San.AlreadyExists: Boolean; begin Result := fexists; end;
constructor TFileMappingStream_San.Create(AHandle: DWORD; ASize: Cardinal); begin Create(ahandle, asize, PAGE_READWRITE); end;
destructor TFileMappingStream_San.Destroy; begin unmapviewoffile(fpointer);
closehandle(fmaphandle); inherited; end;
function TFileMappingStream_San.Seek(Offset: Integer;
Origin: Word): Longint; begin
case origin of 0: begin Result := offset; end;
1: begin Result := fposition + offset; end; else
begin Result := fsize + offset; end; end; if Result < 0 then Result := 0 else if Result > fsize then
begin Result := fsize; end;
fposition := Result; end;
function TFileMappingStream_San.Seek(const Offset: Int64;
Origin: TSeekOrigin): Int64; begin Result := seek(Integer(offset), Ord(origin)); end;
function TFileMappingStream_San.read(var Buffer; Count: Integer): Longint; var p: Pointer; begin p := Pointer(Cardinal(fpointer) + fposition); if (not fresizeable) and (Count > Size - fposition) then Count := Size - fposition;
copymemory(@buffer, p, Count);
Result := Count;
Inc(fposition, Count); end;
function TFileMappingStream_San.Write(const Buffer;
Count: Integer): Longint; var p: Pointer; begin p := Pointer(Cardinal(fpointer) + fposition); if (not fresizeable) and (Count > Size - fposition) then Count := Size - fposition;
copymemory(p, @buffer, Count);
Result := Count;
Inc(fposition, Count); if fresizeable then Inc(fsize, Count); end;
constructor TFileMappingStream_San.CreateFromMemory(ASize: Cardinal); begin createfrommemory(asize, PAGE_READWRITE); end;
constructor TFileMappingStream_San.CreateFromMemory(AName: string;
ASize: Cardinal); begin createfrommemory(aname, asize, PAGE_READWRITE); end;
constructor TFileMappingStream_San.CreateFromMemory(ASize: Cardinal;
ProtectMode: Integer); begin Create($FFFFFFFF,aSize, protectmode); end;