共享一个之前封装的多进程共享内存的MemoryStream

具体用处呢,有很多,比如多进程浏览器共享Cookie啦,多个进程传送点数据啦.

{
共享内存封装.
封装成了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;
  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, PByte(Memory)[Position], Count);
    Position := Position + Count;
    Result := Count;
  end;
end;

end.
此条目发表在Delphi分类目录,贴了, , 标签。将固定链接加入收藏夹。

共享一个之前封装的多进程共享内存的MemoryStream》有 5 条评论

  1. keinvo说:

    能否有简单的 两个进程共享通信使用这个的demo?

  2. 宋风寒说:

    非常喜欢老大的万能查询控件WnQuery,一直使用在D7下,现在想学习Delphi Xe5,不知道您的WnQuery有没有Xe5版本可用的啊?若有,给我邮箱发个吧!songfenghanzh@qq.com,不胜感谢!!

    • admin说:

      这个是十年前的作品了,十年没维护过了.这个控件是直连数据库的,不适合多层架构的产品,又是ADO的,借鉴可以.实战的话建议你重新写一个,适用于多层架构的,和数据库引擎无关的.

      • 宋风寒说:

        不支持多层架构吗?我水平有限啊,多层架构的自己写不出来….如果没有新版本,老大能否推荐一个合适多层的查询控件呢?

  3. locet说:

    这里面最重要的一个就是Global

宋风寒进行回复 取消回复

电子邮件地址不会被公开。

您可以使用这些HTML标签和属性: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

你必须启用JavaScript