不好意思,忘贴出FileMap.pas 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.
findwindow
EnumChildWindowslResult = SendMessage( // returns LRESULT in lResult (HWND) hWndControl, // handle to destination control (UINT) WM_SETTEXT, // message ID (WPARAM) wParam, // = (WPARAM) () wParam; (LPARAM) lParam // = (LPARAM) () lParam; ); 这些函数来解决
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.
注意查收。
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.
1\内存映象文件!
2\在EDIT1的ONCHANGE事件中用SENDMESSAGE,找到句柄也好发送WM_DATA也好....