java 内存映射文件进程间通讯_内存映射实现进程通讯

unit FileMap;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

StdCtrls, Dialogs;

type

//定义TFileMap类

TFileMap = class(TComponent)

private

FMapHandle: THandle; //内存映射文件句柄

FMutexHandle: THandle; //互斥句柄

FMapName: string; //内存映射对象

FSynchMessage: string; //同步信息

FMapStrings: TStringList; //存储映射文件信息

FSize: DWord; //映射文件大小

FMessageID: DWord; //注册的消息号

FMapPointer: PChar; //映射文件的数据区指针

FLocked: Boolean; //锁定

FIsMapOpen: Boolean; //文件是否打开

FExistsAlready: Boolean; //表示是否已经建立文件映射了

FReading: Boolean; //正在读取内存映射文件数据

FAutoSynch: Boolean; //是否自动同步

FOnChange: TNotifyEvent; //当内存数据区内容改变时

FFormHandle: Hwnd; //存储本窗口的窗口句柄

FPNewWndHandler: Pointer; //

FPOldWndHandler: Pointer; //

procedure SetMapName(Value: string);

procedure SetMapStrings(Value: TStringList);

procedure SetSize(Value: DWord);

procedure SetAutoSynch(Value: Boolean);

procedure EnterCriticalSection;

procedure LeaveCriticalSection;

procedure MapStringsChange(Sender: TObject);

procedure NewWndProc(var FMessage: TMessage);

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure OpenMap;

procedure CloseMap;

procedure ReadMap;

procedure WriteMap;

property ExistsAlready: Boolean read FExistsAlready;

property IsMapOpen: Boolean read FIsMapOpen;

published

property MaxSize: DWord read FSize write SetSize;

property AutoSynchronize: Boolean read FAutoSynch write SetAutoSynch;

property MapName: string read FMapName write SetMapName;

property MapStrings: TStringList read FMapStrings write SetMapStrings;

property OnChange: TNotifyEvent read FOnChange write FOnChange;

end;

implementation

//构造函数

constructor TFileMap.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FAutoSynch := True;

FSize := 4096;

FReading := False;

FMapStrings := TStringList.Create;

FMapStrings.OnChange := MapStringsChange;

FMapName := 'Unique & Common name';

FSynchMessage := FMapName + 'Synch-Now';

if AOwner is TForm then

begin

FFormHandle := (AOwner as TForm).Handle;

//得到窗口处理过程的地址

FPOldWndHandler := Ptr(GetWindowLong(FFormHandle, GWL_WNDPROC));

FPNewWndHandler := MakeObjectInstance(NewWndProc);

if FPNewWndHandler = nil then

raise Exception.Create('超出资源');

//设置窗口处理过程新的地址

SetWindowLong(FFormHandle, GWL_WNDPROC, Longint(FPNewWndHandler));

end

else raise Exception.Create('组件的所有者应该是TForm');

end;

//析构函数

destructor TFileMap.Destroy;

begin

CloseMap;

//还原Windows处理过程地址

SetWindowLong(FFormHandle, GWL_WNDPROC, Longint(FPOldWndHandler));

if FPNewWndHandler <> nil then

FreeObjectInstance(FPNewWndHandler);

//释放对象

FMapStrings.Free;

FMapStrings := nil;

inherited destroy;

end;

//打开文件映射，并映射到进程空间

procedure TFileMap.OpenMap;

var

TempMessage: array[0..255] of Char;

begin

if (FMapHandle = 0) and (FMapPointer = nil) then

begin

FExistsAlready := False;

// 创建文件映射对象

FMapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, FSize, PChar(FMapName));

if (FMapHandle = INVALID_HANDLE_VALUE) or (FMapHandle = 0) then

raise Exception.Create('创建文件映射对象失败!')

else

begin

//判断是否已经建立文件映射了

if (FMapHandle <> 0) and (GetLastError = ERROR_ALREADY_EXISTS) then

FExistsAlready := True; //如果已建立的话，就设它为True

//映射文件的视图到进程的地址空间

FMapPointer := MapViewOfFile(FMapHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);

if FMapPointer = nil then

raise Exception.Create('映射文件的视图到进程的地址空间失败')

else

begin

StrPCopy(TempMessage, FSynchMessage);

//在Windows中注册消息常量

FMessageID := RegisterWindowMessage(TempMessage);

if FMessageID = 0 then

raise Exception.Create('注册消息失败')

end

end;

//创建互斥对象，在写文件映射空间时，用到它，以保持数据同步

FMutexHandle := Windows.CreateMutex(nil, False, PChar(FMapName + '.Mtx'));

if FMutexHandle = 0 then

raise Exception.Create('创建互斥对象失败');

FIsMapOpen := True;

if FExistsAlready then //判断内存文件映射是否已打开

ReadMap

else

WriteMap;

end;

end;

//解除文件视图和内存映射空间的关系，并关闭文件映射

procedure TFileMap.CloseMap;

begin

if FIsMapOpen then

begin

//释放互斥对象

if FMutexHandle <> 0 then

begin

CloseHandle(FMutexHandle);

FMutexHandle := 0;

end;

//关闭内存对象

if FMapPointer <> nil then

begin

//解除文件视图和内存映射空间的关系

UnMapViewOfFile(FMapPointer);

FMapPointer := nil;

end;

if FMapHandle <> 0 then

begin

//并关闭文件映射

CloseHandle(FMapHandle);

FMapHandle := 0;

end;

FIsMapOpen := False;

end;

end;

//读取内存文件映射内容

procedure TFileMap.ReadMap;

begin

FReading := True;

if (FMapPointer <> nil) then FMapStrings.SetText(FMapPointer);

FReading := False;

end;

//向内存映射文件里写

procedure TFileMap.WriteMap;

var

StringsPointer: PChar;

HandleCounter: integer;

SendToHandle: HWnd;

begin

if FMapPointer <> nil then

begin

StringsPointer := FMapStrings.GetText;

//进入互斥状态，防止其他线程进入同步区域代码

EnterCriticalSection;

if StrLen(StringsPointer) + 1 <= FSize

then System.Move(StringsPointer^, FMapPointer^, StrLen(StringsPointer) + 1)

else

raise Exception.Create('写字符串失败，字符串太大!');

//离开互斥状态

LeaveCriticalSection;

//广播消息,表示内存映射文件内容已修改

SendMessage(HWND_BROADCAST, FMessageID, FFormHandle, 0);

//释放StringsPointer

StrDispose(StringsPointer);

end;

end;

//当MapStrins值改变时

procedure TFileMap.MapStringsChange(Sender: TObject);

begin

if FReading and Assigned(FOnChange) then

FOnChange(Self)

else if (not FReading) and FIsMapOpen and FAutoSynch then

WriteMap;

end;

//设置MapName属性值

procedure TFileMap.SetMapName(Value: string);

begin

if (FMapName <> Value) and (FMapHandle = 0) and (Length(Value) < 246) then

begin

FMapName := Value;

FSynchMessage := FMapName + 'Synch-Now';

end;

end;

//设置MapStrings属性值

procedure TFileMap.SetMapStrings(Value: TStringList);

begin

if Value.Text <> FMapStrings.Text then

begin

if Length(Value.Text) <= FSize then

FMapStrings.Assign(Value)

else

raise Exception.Create('写入值太大');

end;

end;

//设置内存文件大小

procedure TFileMap.SetSize(Value: DWord);

var

StringsPointer: PChar;

begin

if (FSize <> Value) and (FMapHandle = 0) then

begin

StringsPointer := FMapStrings.GetText;

if (Value < StrLen(StringsPointer) + 1) then

FSize := StrLen(StringsPointer) + 1

else FSize := Value;

if FSize < 32 then FSize := 32;

StrDispose(StringsPointer);

end;

end;

//设置是否同步

procedure TFileMap.SetAutoSynch(Value: Boolean);

begin

if FAutoSynch <> Value then

begin

FAutoSynch := Value;

if FAutoSynch and FIsMapOpen then WriteMap;

end;

end;

//进入互斥，使得被同步的代码不能被别的线程访问

procedure TFileMap.EnterCriticalSection;

begin

if (FMutexHandle <> 0) and not FLocked then

begin

FLocked := (WaitForSingleObject(FMutexHandle, INFINITE) = WAIT_OBJECT_0);

end;

end;

//解除互斥关系，可以进入保护的同步代码区

procedure TFileMap.LeaveCriticalSection;

begin

if (FMutexHandle <> 0) and FLocked then

begin

ReleaseMutex(FMutexHandle);

FLocked := False;

end;

end;

//消息捕获过程

procedure TFileMap.NewWndProc(var FMessage: TMessage);

begin

with FMessage do

begin

if FIsMapOpen then //内存文件打开

{如果消息是FMessageID,且WParam不是FFormHandle，就调用ReadMap，

去读取内存映射文件的内容，表示内存映射文件的内容已变}

if (Msg = FMessageID) and (WParam <> FFormHandle) then

ReadMap;

Result := CallWindowProc(FPOldWndHandler, FFormHandle, Msg, wParam, lParam);

end;

end;

end.

unit MainFrm;

interface

uses

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

StdCtrls, ExtCtrls, FileMap;

type

TfrmMain = class(TForm)

btnWriteMap: TButton;

btnReadMap: TButton;

btnClear: TButton;

chkExistsAlready: TCheckBox;

chkIsMapOpen: TCheckBox;

btnOpenMap: TButton;

btnCloseMap: TButton;

mmoCont: TMemo;

chkAutoSynchronize: TCheckBox;

Label5: TLabel;

lblHelp: TLabel;

procedure btnWriteMapClick(Sender: TObject);

procedure btnReadMapClick(Sender: TObject);

procedure btnClearClick(Sender: TObject);

procedure btnOpenMapClick(Sender: TObject);

procedure btnCloseMapClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure chkAutoSynchronizeClick(Sender: TObject);

procedure mmoContKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

private

//定义TFileMap的对象

FileMap: TFileMap;

//定义FileMapChange用于赋给FileMap的OnChange事件

procedure FileMapChange(Sender: TObject);

procedure Check;

{ Private declarations }

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.DFM}

//检查FileMap的ExistsAlready和IsMapOpen属性

procedure TfrmMain.Check;

begin

chkExistsAlready.Checked := FileMap.ExistsAlready;

chkIsMapOpen.Checked := FileMap.IsMapOpen;

end;

//在窗体创建时，初始化FileMap对象

procedure TfrmMain.FormCreate(Sender: TObject);

begin

//创建对象FileMap

FileMap := TFileMap.Create(self);

FileMap.OnChange := FileMapchange;

chkAutoSynchronize.Checked := FileMap.AutoSynchronize;

//如果内存对象还未创建，初始化FileMap里的内容

if not FileMap.ExistsAlready then

begin

MmoCont.Lines.LoadFromFile('Project1.dpr');

FileMap.MapStrings.Assign(MmoCont.Lines);

end;

lblHelp.Caption := '使用说明：运行两个或多个此应用程序，按下“打开内存映射”按钮，'

+ #13 + '选中“是否同步”复选框，在备注框里改动，在另外的应用程序中将会'

+ #13 + '该动后的信息，同时也可以读写数据按钮来获取共享信息'

end;

//写入内存文件映射的数据

procedure TfrmMain.btnWriteMapClick(Sender: TObject);

begin

FileMap.WriteMap;

end;

//读取内存文件映射的数据

procedure TfrmMain.btnReadMapClick(Sender: TObject);

begin

FileMap.ReadMap;

end;

//清除内存文件数据

procedure TfrmMain.btnClearClick(Sender: TObject);

begin

Mmocont.Clear;

FileMap.MapStrings.Clear;

check;

end;

//打开内存文件映射

procedure TfrmMain.btnOpenMapClick(Sender: TObject);

begin

FileMap.MapName := 'Delphi 6 ';

FileMap.OpenMap;

check;

end;

//关闭内存映射

procedure TfrmMain.btnCloseMapClick(Sender: TObject);

begin

FileMap.CloseMap;

Check;

end;

//当内存映射文件的数据改变时，显示最新数据

procedure TfrmMain.FileMapChange(Sender: TObject);

begin

Mmocont.Lines.Assign(FileMap.MapStrings);

Check;

end;

//设置是否同步显示

procedure TfrmMain.chkAutoSynchronizeClick(Sender: TObject);

begin

FileMap.AutoSynchronize := chkAutoSynchronize.Checked;

end;

//在备注框里写时，同时更新进内存映射文件

procedure TfrmMain.mmoContKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

FileMap.MapStrings.Assign(MmoCont.Lines);

end;

end.

http://blog.csdn.net/zang141588761/article/details/52062603

VC版：

http://blog.csdn.NET/zicheng_lin/article/details/8151448