...ein Shared Data-Stream zwischen Anwendungen realisieren?

{

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 < 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;

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.

printed from
www.swissdelphicenter.ch
developers knowledge base