shmem.pas

啊看见电脑哦啊师父破案对方；啊老大你发；dfadsdsfadfd发

unit ShMem;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TSharedMem = class(TComponent)
  private
    { Private declarations }
    FMapName: string;
    FSize: Integer;
    FActive: Boolean;
    FBuffer: Pointer;
    FHandle: THandle;
    procedure CreateShareMem;
    procedure FreeShareMem;
  protected
    { Protected declarations }
    procedure SetMapName(Value : string);
    procedure SetSize(Value : integer);
    procedure SetActive(Value : Boolean);
    function  GetBuffer : pchar;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    property Buffer :  pchar read GetBuffer;
    property Memory : Pointer read FBuffer;
  published
    { Published declarations }
    property MapName : string read FMapName write SetMapName;
    property Size : integer read FSize write SetSize;
    property Active : Boolean read FActive write SetActive;
  end;


implementation


constructor TSharedMem.Create(AOwner : TComponent);
begin
 inherited Create(AOwner);
 FMapName:='ShareMem';
 FSize:=10;
 FActive:=False;
 FBuffer:=nil;
 FHandle:=0;
end;

destructor TSharedMem.Destroy;
begin
 FreeShareMem;
 inherited Destroy;
end;

procedure TSharedMem.CreateShareMem;
begin
 FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,FSize, PChar(FMapName));
 if FHandle = 0 then
   raise Exception.Create(Format('Error creating FileMapping memory %s (%d)', [FMapName, GetLastError]));
 FBuffer := MapViewOfFile(FHandle, FILE_MAP_WRITE, 0, 0, FSize);
 if FBuffer = nil then
   raise Exception.Create(Format('Error creating MapViewOfFile memory %s (%d)', [FMapName, GetLastError]));
 FActive:=True;
end;

function TSharedMem.GetBuffer : pchar;
begin
 Result:=pchar(FBuffer);
end;

procedure TSharedMem.FreeShareMem;
begin
 if FBuffer <> nil then UnmapViewOfFile(FBuffer);
 FBuffer:=nil;
 if FHandle <> 0 then CloseHandle(FHandle);
 FHandle:=0;
 FActive:=False;
end;

procedure TSharedMem.SetMapName(Value : string);
begin
 if FActive=True then ShowMessage('Can''t Change MapName in Active')
 else FMapName:=Value;
end;

procedure TSharedMem.SetSize(Value : integer);
begin
 if FActive=True then ShowMessage('Can''t Change Size in Active')
 else FSize:=Value;
end;

procedure TSharedMem.SetActive(Value : Boolean);
begin
 if FActive<>Value then begin
   if FActive=True then FreeShareMem;
   if Value=True then CreateShareMem
   else FreeShareMem;
 end;
end;

end.