Delphi 多进程共享内存的简单封装单元

该单元转自武稀松的博客

稍作修改,使其支持Delphi7
{

共享内存封装.

封装成了MemoryStream的形式.

用法如下:

  var

    ms : TShareMemStream;

  ms := TShareMemStream.Create('Global\test', FILE_MAP_ALL_ACCESS, 4096);

  if (ms.Memory <> nil)(*and(ms.AlreadyExists)*) then

  //如果创建失败Memory指针是空指针

  //AlreadyExists表示已经存在了,也就是之前被别人(也许是别的进程)创建过了.

  begin

    //获取锁,多个进程线程访问安全访问

    if ms.GetLock(INFINITE) then

    begin

      ms.read(...);

      ms.write(...);

      //释放锁

      ms.ReleaseLock();

    end;

  end;

  ms.free;

}

unit ShareMemoryStream;

interface

uses

  SysUtils, Classes, Syncobjs, Windows;

type

  TShareMemStream = class(TCustomMemoryStream)

  private

    FFile: THandle;

    FSize: Int64;

    FEvent: TEvent;

    FAlreadyExists: Boolean;

  protected

    property Event: TEvent read FEvent;

  public

    constructor Create(const ShareName: string; ACCESS: DWORD = FILE_MAP_ALL_ACCESS; ASize: Int64 = 16 * 1024 * 1024);

    destructor Destroy; override;

    function Write(const Buffer; Count: Integer): Longint; override;

    function GetLock(ATimeOut: DWORD = INFINITE): Boolean;

    procedure ReleaseLock();

    property AlreadyExists: Boolean read FAlreadyExists;

  end;

implementation

procedure InitSecAttr(var sa: TSecurityAttributes; var sd: TSecurityDescriptor);

begin

  sa.nLength := sizeOf(sa);

  sa.lpSecurityDescriptor := @sd;

  sa.bInheritHandle := false;

  InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);

  SetSecurityDescriptorDacl(@sd, true, nil, false);

end;

{ TShareMem }

constructor TShareMemStream.Create(const ShareName: string; ACCESS: DWORD; ASize: Int64);

var

  sa: TSecurityAttributes;

  sd: TSecurityDescriptor;

  lprotect: DWORD;

  e: Integer;

begin

  FEvent := TEvent.Create(nil, false, true, ShareName + '_TShareMemStream_Event');

  FSize := ASize;

  InitSecAttr(sa, sd);

  ACCESS := ACCESS and (not SECTION_MAP_EXECUTE);

  if (ACCESS and FILE_MAP_WRITE) = FILE_MAP_WRITE then

    lprotect := PAGE_READWRITE

  else if (ACCESS and FILE_MAP_READ) = FILE_MAP_READ then

    lprotect := PAGE_READONLY;

  FFile := CreateFileMapping(INVALID_HANDLE_VALUE, @sa, lprotect, Int64Rec(FSize).Hi, Int64Rec(FSize).Lo, PChar(ShareName));

  e := GetLastError;

  MessageBox(0,PChar(IntToStr(e)),0,0);

  if FFile = 0 then

    Exit;

  FAlreadyExists := e = ERROR_ALREADY_EXISTS;

  SetPointer(MapViewOfFile(FFile, ACCESS, 0, 0, Int64Rec(FSize).Lo), Int64Rec(FSize).Lo);

end;

destructor TShareMemStream.Destroy;

begin

  if Memory <> nil then

  begin

    UnmapViewOfFile(Memory);

    SetPointer(nil, 0);

    Position := 0;

  end;

  if FFile <> 0 then

  begin

    CloseHandle(FFile);

    FFile := 0;

  end;

  FEvent.Free;

  inherited Destroy;

end;

function TShareMemStream.GetLock(ATimeOut: DWORD): Boolean;

var

  wr: TWaitResult;

begin

  wr := FEvent.WaitFor(ATimeOut);

  Result := wr = wrSignaled;

end;

procedure TShareMemStream.ReleaseLock;

begin

  FEvent.SetEvent;

end;

function TShareMemStream.Write(const Buffer; Count: Integer): Longint;

begin

  Result := 0;

  if (Size - Position) >= Count then

  begin

    System.Move(Buffer, Pointer(Longint(Memory) + Position)^, Count);

    Position := Position + Count;

    Result := Count;

  end;

end;

end.
测试Demo下载
巴特西

Delphi 多进程共享内存的简单封装单元

最新文章

热门文章
