Examples Delphi

Title: implements a Data-sharing Stream Between Applications?
{
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
}
unit FileMapping_San;
interface
uses
windows, messages, sysutils, classes;
const
c_msgstr = 'msgstr_san_{9BB1155F-1A06-4664-AB21-AB0A0C05A658}';
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 Create; overload;
constructor Create(AHandle: DWORD; AName: string; ASize: Cardinal); overload;
constructor Create(AHandle: DWORD; ASize: Cardinal); overload;
constructor CreateFromMemory(AName: string; ASize: Cardinal); overload;
constructor CreateFromMemory(ASize: Cardinal); overload;
constructor Create(AHandle: DWORD; AName: string; ASize: Cardinal;
ProtectMode: DWORD);
overload;
constructor Create(AHandle: DWORD; ASize: Cardinal; ProtectMode: DWORD); overload;
constructor CreateFromMemory(AName: string; ASize: Cardinal; ProtectMode: DWORD);
overload;
constructor CreateFromMemory(ASize: Cardinal; ProtectMode: Integer); overload;
destructor Destroy; override;
published
property MapHandle: DWORD read fmaphandle;
property FileHandle: DWORD read ffilehandle;
property Name: string read getname;
property ProtectMode: DWORD read fprotectmode;
end;
implementation
{ TFileMapping_San }
constructor TFileMappingStream_San.Create(AHandle: DWORD; AName: string;
ASize: Cardinal);
begin
Create(ahandle, aname, asize, PAGE_READWRITE);
end;
constructor TFileMappingStream_San.Create(AHandle: DWORD; AName: string;
ASize: Cardinal; ProtectMode: DWORD);
var
i: DWORD;
begin
if asize 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 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 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;
constructor TFileMappingStream_San.CreateFromMemory(AName: string;
ASize: Cardinal; ProtectMode: DWORD);
begin
Create($FFFFFFFF,aName, asize, protectmode);
end;
function TFileMappingStream_San.DataPointer: Pointer;
begin
Result := fpointer;
end;
function TFileMappingStream_San.getname: string;
begin
Result := fname;
end;
constructor TFileMappingStream_San.Create;
begin
Create(INVALID_HANDLE_VALUE, 0);
end;
end.