whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

17 Visitors Online


 
...implements a Data-sharing Stream Between Applications?
Autor: sanease
Homepage: http://www.sanease.com
[ Print tip ]  

Tip Rating (9):  
     


{

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; overloadoverride;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overloadoverride;

    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 < 0 then asize := 0;
  fresizeable := asize = 0;
  fmaphandle  := createfilemapping(ahandle, nil, protectmode, 0,asize, PChar(aname));
  if fmaphandle = 0 then
  begin
    
i := GetLastError;
    case 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 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;

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.


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners