• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

进程通讯DELPHI的类实现

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
Shared Memory Win32共享内存,几十M都可以
unit SharedMemory;

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.

鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap