精华区 [关闭][返回]
当前位置：网易精华区>>讨论区精华>>编程开发>>● Delphi>>Windows API函数>>（轉）進程閒共享内存

主题：（轉）進程閒共享内存
发信人: red__pig(猪·何处不是家)
整理人: soaringbird(2002-11-08 21:17:52), 站内信件
感覺它考慮的挺全，帖出來給大家看看。不過我不太贊成其中一些的處理方式，
未能對用戶程序員隱藏一些技術細節。不夠SB的說 ；）

unit fisSharedMemory;

interface

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

type

  TfisSharedMemory = class(TComponent)
  private
    { Private declarations }
    FShareName: String;
    FSize: integer;
    FHandle, FMutex: THandle;
    FReadOnly: boolean;
    FTimeout: integer;

  protected
      procedure SetName(const aValue: TComponentName );override;
    { Protected declarations }
  public
      constructor Create(AOwner: TComponent);override;
      destructor Destroy;override;
      function MemoryExist: boolean;
      function MapMemory: pointer;    { Public declarations }
      function UnMapMemory(aMapPtr: pointer):boolean;
      function CreateMemory: boolean;
      function CloseMemory: boolean;
      function OpenMemory: boolean;
      function RequestOwnership: boolean;
      function ReleaseOwnership: boolean;
      property Handle: THandle read FHandle;
      property Mutex: THandle read FMutex;

  published
    { Published declarations }
      property ReadOnly: boolean read FReadOnly write FReadOnly default false;
      property ShareName: String read FShareName write FShareName;
      property Size: integer read FSize write FSize;
      property Timeout: integer read FTimeout write FTimeout default -1;

  end;

  const
    MUTEX_NAME = '_SMMutex';

procedure Register;

implementation

procedure TfisSharedMemory.SetName(const aValue: TComponentName );
var
    lChange: boolean;
begin
    lChange := (csDesigning in ComponentState) and
        ((Name = FShareName) or (Length(FShareName) = 0));
    inherited;
    if lChange then
    begin
        FShareName := Name;
    end;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.MapMemory:pointer;
var
    lMapping: DWord;
begin
    if FHandle = 0 then
    begin
      Result := nil;
      exit;
    end;

    if(FReadOnly)then
    begin
        lMapping := FILE_MAP_READ;
    end
    else
    begin
        lMapping := File_Map_All_Access;
    end;
    Result := MapViewOfFile(FHandle, lMapping, 0, 0, FSize);
    if(Result = nil)then
    begin
        ReleaseMutex(FMutex);
    end;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.UnMapMemory(aMapPtr: pointer): boolean;
begin
    if FHandle <> 0 then
    begin
        UnmapViewOfFile(aMapPtr);
        result := true;
    end
    else
    begin
        result := false;
    end;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.CreateMemory: boolean;
var
    lMutexName: string;
begin
    Result := true;
    if FHandle <> 0 then CreateMemory := false;
    FHandle := CreateFileMapping(THANDLE($FFFFFFFF), nil, PAGE_READWRITE, 0,
        FSize, pchar(FShareName));
    if (FHandle = 0) or ((FHandle <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
    begin
        CloseMemory;
        Result := false;
    end;
    lMutexName := FShareName + MUTEX_NAME;
    FMutex := CreateMutex(nil, false, pchar(lMutexName));
    if(FMutex = 0) then
    begin
        CloseMemory;
        Result := false;
    end;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.CloseMemory: boolean;
begin
    if(FHandle <> 0) then
    begin
        CloseHandle(FHandle);
        FHandle := 0;
    end;
    if(FMutex <> 0) then
    begin
        CloseHandle(FMutex);
        FMutex := 0;
    end;
    Result := true;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.OpenMemory: boolean;
var
    lMutexName: string;
begin
    Result := false;
    if(FHandle = 0) then
    begin
        FHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, true, pchar(FShareName));
        if(FHandle <> 0) then
        begin
            lMutexName := FShareName + MUTEX_NAME;
            FMutex := OpenMutex(MUTEX_ALL_ACCESS, true, pchar(lMutexName));
            if(FMutex <> 0 ) then
            begin
                Result := true;
            end
            else
            begin
                CloseMemory;
            end;
        end;
    end;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.RequestOwnership: boolean;
var
    lTimeout: DWord;
begin
    Result := false;
    if(FHandle <> 0) then
    begin
        if(FTimeout < 0) then
begin
lTimeout := INFINITE;
end
else
begin
lTimeout := FTimeout;
end;
Result := WaitForSingleObject(FMutex, lTimeout) = WAIT_OBJECT_0;
end;
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.ReleaseOwnership: boolean;
begin
Result := false;
if(FHandle <> 0) then
    begin
        Result := ReleaseMutex(FMutex);
    end;
end;
//---------------------------------------------------------------------------
constructor TfisSharedMemory.Create(AOwner: TComponent);
begin
    inherited;
    FShareName := '';
    FTimeout := -1;
    FSize := 0;
    FReadOnly := false;
    FHandle := 0;
    FMutex := 0;
end;
//---------------------------------------------------------------------------
destructor TfisSharedMemory.Destroy;
begin
    CloseMemory;
    inherited;
end;
//---------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('FISH', [TfisSharedMemory]);
end;
//---------------------------------------------------------------------------
function TfisSharedMemory.MemoryExist: boolean;
var PVHandle:THandle;
begin
  Result := false;
  PVHandle := CreateFileMapping(THANDLE($FFFFFFFF), nil, PAGE_READWRITE, 0,
        FSize, pchar(FShareName));
  if (PVHandle <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)
     then Result:=true
     else CloseHandle(PVHandle);
end;

end.


----

Water is not wet, sea is not blue, and i wish i never love this woman... 
[关闭][返回]