delphi进程间通讯例子,自定义消息传递或共享内存区.doc

1、CSDN 社区 Delphi Windows SDK/API 求 delphi 进程间通讯例子，自定义消息传递或共享内存区！楼主 skphoebe（小鲨鱼）2005-09-20 14:00:08 在 Delphi / Windows SDK/API 提问谢谢，摆脱那位大哥供小弟学习下！ 问题点数：50、回复次数：13 Top 1 楼 abc3000（想想就烦）回复于 2005-09-20 14:26:34 得分 0 以下例子是共享内存 实现进程间通讯,没有大的问题 ,就是最后个字符会被吃掉 Top2 楼 abc3000（想想就烦）回复于 2005-09-20 14:27:18 得分 0 uni

2、t FileMap; interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,StdCtrls,Dialogs; type TFileMap=class(TComponent) private FMapHandle:THandle; /内存映射文件句柄 FMutexHandle:THandle; /互斥句柄 FMapName:string; /内存映射对象 FSynchMessage:string; /同步消息 FMapStrings:TStringList; /存储映射文件信息 FSize:DWord;

3、 /映射文件大小 FMessageID:DWord; /注册的消息号 FMapPointer:PChar; /映射文件的数据区指针 FLocked:Boolean; /锁定 FIsMapOpen:Boolean; /文件是否打开 FExistsAlready:Boolean; /是否已经建立过映射文件 FReading:Boolean; /是否正在读取内存文件数据 FAutoSynch:Boolean; /是否同步 FOnChange:TNotifyEvent; /当内存数据区内容改变时 FFormHandle:Hwnd; /存储本窗口的窗口句柄 FPNewWndHandler:Pointer

4、; 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 NewW

5、ndProc(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 p

6、roperty 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 FOnCh

7、ange; 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 FSynchMessage:=FMapName+Synch-Now; if AOwner is TF

8、orm 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(FPNew

9、WndHandler); end else raise Exception.Create(组件的所有者应该是 TForm); end; /析构函数 destructor TFileMap.Destroy; begin CloseMap; /还原 Windows 处理过程地址 SetWindowLong(FFormHandle,GWL_WNDPROC,Longint(FPOldWndHandler); if FPNewWndHandler0) and (GetLastError=ERROR_ALREADY_EXISTS) then FExistsAlready:=True; /如果已经建立的话，

10、就设它为 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 rais

11、e 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; /解除文件视图和内存映射空间的关系，并关闭文件

12、映射 procedure TFileMap.CloseMap; begin if FIsMapOpen then begin /释放互斥对象 if FMutexHandlenil then begin /解除文件视图和内存映射空间的关系 UnMapViewOfFile(FMapPointer); FMapPointer:=nil; end; if FMapHandlenil) then FMapStrings.SetText(FMapPointer); end; /向内存映射文件里写 procedure TFileMap.WriteMap; var StringsPointer:PChar;

13、HandleCounter:integer; SendToHandle:HWnd; begin if FMapPointer0) and not FLocked then begin FLocked:=(WaitForSingleObject(FMutexHandle,INFINITE)=WAIT_OBJECT_0); end; end; /解除互斥关系，可以进入保护的同步代码区 procedure TFileMap.LeaveCriticalSection; begin if (FMutexHandleFFormHandle) then ReadMap; Result:=CallWindow

14、Proc(FPOldWndHandler,FFormHandle,Msg,wParam,lParam); end; end; end. Top4 楼 skphoebe（小鲨鱼）回复于 2005-09-20 14:28:46 得分 0 非常感谢，调试通过，力马揭帖！ Top5 楼 abc3000（想想就烦）回复于 2005-09-20 14:30:05 得分 20晕,我主单元还没给你呢, 呵呵 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

15、Dialogs, StdCtrls,FileMap; type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; procedure FormCreate(Sender: TObject); procedure Button4Click(Sender: TObjec

16、t); procedure Button3Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:

17、 Integer); procedure Memo1KeyDown(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 Form1: TFor

18、m1; implementation $R *.dfm /检查 FileMap 的 ExistsAlready 和 IsMapOpen 属性 procedure TForm1.Check; begin CheckBox2.Checked:=FileMap.ExistsAlready; CheckBox3.Checked:=FileMap.IsMapOpen; end; /在窗体创建时，初始化 FileMap 对象 procedure TForm1.FormCreate(Sender: TObject); begin /创建 FileMap FileMap:=TFileMap.Create(se

19、lf); FileMap.OnChange:=FileMapchange; CheckBox1.Checked:=FileMap.AutoSynchronize; /如果内存对象还未创建，初始化 FileMap 里的内容 if not FileMap.ExistsAlready then begin memo1.Lines.LoadFromFile(readme.txt); FileMap.MapStrings.Assign(memo1.Lines); end; end; /写入数据 procedure TForm1.Button4Click(Sender: TObject); begin F

20、ileMap.WriteMap; end; /读出数据 procedure TForm1.Button3Click(Sender: TObject); begin FileMap.ReadMap; end; /清空 procedure TForm1.Button5Click(Sender: TObject); begin memo1.Clear; FileMap.MapStrings.Clear; check; end; /打开 procedure TForm1.Button1Click(Sender: TObject); begin FileMap.MapName:=Delphi 6; Fi

21、leMap.OpenMap; check; end; /关闭 procedure TForm1.Button2Click(Sender: TObject); begin FileMap.CloseMap; check; end; /当内存映射文件的数据改变时，显示最新数据 procedure TForm1.FileMapChange(Sender:TObject); begin memo1.Lines.Assign(FileMap.MapStrings); check; end; /设置是否同步 procedure TForm1.CheckBox1Click(Sender: TObject);

22、 begin FileMap.AutoSynchronize:=CheckBox1.checked; end; /在备注框里写时，同时更新内存文件 procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FileMap.MapStrings.Assign(memo1.Lines); end; procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift:

23、 TShiftState); begin FileMap.MapStrings.Assign(memo1.Lines); end; end. Top6 楼 skphoebe（小鲨鱼）回复于 2005-09-20 14:42:02 得分 0 通过，谢谢！ Top7 楼 abc3000（想想就烦）回复于 2005-09-20 14:45:39 得分 0 3 个 checkbox 框搞清楚了没? Top8 楼 skphoebe（小鲨鱼）回复于 2005-09-20 14:49:24 得分 0 fileMap 的 unit 可以编译通过，我只需简单调用几个过程就可以了！ 不知道你那个源码是什么程序用！

24、 Top9 楼 abc3000（想想就烦）回复于 2005-09-20 14:53:37 得分 0 filemap 单元主要就是实现共享的 unit1 单元是调试用的, 一般编译通过时运行 2 份,可以看到共享的效果 Top10 楼 skphoebe（小鲨鱼）回复于 2005-09-20 14:56:23 得分 0 还是非常感谢，给了个这么好的学习例子！ 还要问下只要两个程序，都包含这个单元文件，就读写内存通讯了吗？ Top11 楼 abc3000（想想就烦） 回复于 2005-09-20 14:59:08 得分 0 是 Top12 楼 skphoebe（小鲨鱼）回复于 2005-09-20

25、15:01:52 得分 0 嘻嘻，谢谢！ Top13 楼 skphoebe（小鲨鱼）回复于 2005-09-20 15:49:16 得分 0 亏了，亏了,我要知道 3 个 checkbox 的意思！ Top宠辱不惊，闲看庭前花开花落；去留无意，漫随天外云卷云舒记录及整理日常学习过程的遇到的觉得需要记录的信息,方便以后忘记时重新翻出来看看. 博客园 首页 新随笔 联系 订阅 管理 随笔 - 144 文章 - 0 评论 - 13 trackbacks - 0 日 一 二 三 四 五 六25 26 27 28 29 30 311 2 3 4 5 6 78 9 10 11 12 13 1415 16

26、17 18 19 20 2122 23 24 25 26 27 281 2 3 4 5 6 7与我联系 发短消息 搜索常用链接 我的随笔 我的空间 我的短信 我的评论 更多链接 留言簿(1) 给我留言 查看留言 我的标签 C/C+(29) Visual Studio(27) DELPHI(21) 批处理(19) 脚本(17) MFC(16) DELPHI 基础常用列表(16) SDK(9) API(9) BOOST(6) 更多 随笔分类(254) BOOST 的使用(4) C/C+(51) DELPHI(36) GHOST 的使用(4) linux 的使用(3) Person Data(7)

27、Pocket PC(1) QT(2) Windows 的使用(65) 家庭装修(3) 脚本资料(21) 嵌入式开发(4) 日常生活资料(10) 物理知识资料(6) 相关软件或工具的使用资料(37) 随笔档案(140) 2009 年 3 月 (7) 2009 年 2 月 (3) 2009 年 1 月 (2) 2008 年 12 月 (8) 2008 年 11 月 (10) 2008 年 10 月 (8) 2008 年 9 月 (8) 2008 年 8 月 (94) 文章分类 C/C+ DELPHI 相册 技术类图片 最新评论 1. re: 删除所有.svn 目录 i_ing 写错了好多字啊 发杂

28、-复杂 不行要.svn 文件爱你-不想要.svn 文件 -i_ing 2. re: 删除所有.svn 目录 可以不用这么发杂的如果不行要.svn 文件爱你 svn 有提供 export 命令的这样导出的源代码中就不会带有.svn 文件 还可以用 windows 的搜索.svn 然后 delete 也很简单的. -i_ing 3. re: Borland 官方 Delphi7 vcl 类属继承图 fafaf -gag 阅读排行榜 1. 两个或多个开关控制一盏灯的电器接线图(2371) 2. 访问局域网某台电脑时提示: 无法访问,你可能没有权限使用网络资源. 的解决办法(1662) 3. ATX

29、电源短接哪两个引脚可以开机(1475) 4. VC+中 CTime 类 format 的使用 (1078) 5. WINDOWS 系统服务详解(873) 评论排行榜 1. 访问局域网某台电脑时提示: 无法访问,你可能没有权限使用网络资源. 的解决办法(2) 2. 删除所有 .svn 目录(2) 3. 30 种下载 Youtube 视频的方法 (2) 4. Borland 官方 Delphi7 vcl 类属继承图(1) 5. PDA 触屏的终极解决办法 (1) 60 天内阅读排行 1. Windows 下进程通信方式转 (73) 2. 进程通讯 DELPHI 的类实现(50) 3. Window

30、s 下进程通信方式转 (43) 4. 跨平台 GUI-Qt windows 开发环境安装配置（ Eclipse CDT+ MinGW+QT） (转载)(26) 5. SVN 全局忽略列表(12) 进程通讯 DELPHI 的类实现 Shared Memory Win32 共享内存，几十 M 都可以unit SharedMemory;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;typeTfisSharedMemory = class(TComponent)private

31、Private declarations FShareName: String;FSize: integer;FHandle, FMutex: THandle;FReadOnly: boolean;FTimeout: integer;protectedprocedure SetName(const aValue: TComponentName );override; Protected declarations publicconstructor Create(AOwner: TComponent);override;destructor Destroy;override;function M

32、emoryExist: 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

33、 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

34、 write FTimeout default -1;end;constMUTEX_NAME = _SMMutex;procedure Register;implementationprocedure TfisSharedMemory.SetName(const aValue: TComponentName );varlChange: boolean;beginlChange := (csDesigning in ComponentState) and(Name = FShareName) or (Length(FShareName) = 0);inherited;if lChange the

35、nbeginFShareName := Name;end;end;/-function TfisSharedMemory.MapMemory:pointer;varlMapping: DWord;beginif FHandle = 0 thenbeginResult := nil;exit;end;if(FReadOnly)thenbeginlMapping := FILE_MAP_READ;endelsebeginlMapping := File_Map_All_Access;end;Result := MapViewOfFile(FHandle, lMapping, 0, 0, FSize

36、);if(Result = nil)thenbeginReleaseMutex(FMutex);end;end;/-function TfisSharedMemory.UnMapMemory(aMapPtr: pointer): boolean;beginif FHandle 0 then CreateMemory := false;FHandle := CreateFileMapping(THANDLE($FFFFFFFF), nil, PAGE_READWRITE, 0,FSize, pchar(FShareName);if (FHandle = 0) or (FHandle 0) the

37、nbeginCloseHandle(FHandle);FHandle := 0;end;if(FMutex 0) thenbeginlMutexName := FShareName + MUTEX_NAME;FMutex := OpenMutex(MUTEX_ALL_ACCESS, true, pchar(lMutexName);if(FMutex 0) thenbeginif(FTimeout 0) thenbeginResult := ReleaseMutex(FMutex);end;end;/-constructor TfisSharedMemory.Create(AOwner: TComponent);begininherited;FShareName := ;FTimeout := -1;FSize := 0;FReadOnly := false;FHandle := 0;FMutex := 0;end;