内存映射

内存映射

{*******************************************************}
{                                                       }
{       Module Name: unitMemoryMap.pas                  }
{       Creation Date 2010-03-10                        }
{       Copyright (C) 2010 Ming.z                       }
{                                                       }
{*******************************************************}
unit unitMemoryMap;

interface

uses
  Windows, Messages, SysUtils, Classes;

type
  PShareMem = ^TShareMem;
  TShareMem = packed record
    FHandle: HWND;
    FMsgBuf: string[50];
    FAction: Byte;
  end;

procedure CreateMemoryMap;
procedure DestoryMemoryMap;
function OpenMap: Boolean;
function CloseMap: Boolean;
procedure ZeroMemoryMap;
procedure WriteMapFile(const PMainHandle:HWND;const PMsg:String;PAction: Byte);

var
  hMap: THandle;
  ShareRecord:TShareMem;
  PShare: PShareMem;
const
  K_MapName = 'MsgReceptor';    

implementation

procedure CreateMemoryMap;
begin
  hMap:=CreateFileMapping($FFFFFFFF,
                           nil,
                           PAGE_READWRITE,
                           0,
                           SizeOf(TShareMem),
                           K_MapName);

  if hMap=0 then
    raise Exception.Create('Error while create file')
  else
    PShare:=PShareMem(MapViewOfFile(hMap,FILE_MAP_ALL_ACCESS,0,0,0));
  if PShare = nil then
  begin
    CloseHandle(hMap);
  end;
end;

procedure DestoryMemoryMap;
begin
  if PShare <> nil then
    UnmapViewOfFile(PShare);
  if hMap<>0 then
    CloseHandle(hMap);
end;

function OpenMap: Boolean;
begin
  Result := False;
  hMap := OpenFileMapping(FILE_MAP_WRITE,False,K_MapName);
  if hMap <> 0 then
    PShare := MapViewOfFile(hMap,FILE_MAP_WRITE,0,0,0);
  if PShare <> nil then
    Result := true;
end;

function CloseMap: Boolean;
begin
  if PShare <> nil then UnmapViewOfFile(PShare);
  if hMap <> 0 then CloseHandle(hMap);
  Result := true;
end;

procedure ZeroMemoryMap;
begin
  FillMemory(PShare,SizeOf(TShareMem),0);
end;

procedure WriteMapFile(const PMainHandle:HWND;const PMsg:String;PAction: Byte);
begin
  ShareRecord.FHandle := PMainHandle;
  ShareRecord.FMsgBuf := PMsg;
  ShareRecord.FAction := PAction;
  CopyMemory(PShare,@ShareRecord,SizeOf(TShareMem));
end;

end.