2022年Delphi内存映射文件例子 .pdf

《2022年Delphi内存映射文件例子 .pdf》由会员分享，可在线阅读，更多相关《2022年Delphi内存映射文件例子 .pdf（6页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、Delphi内存映射文件例子收藏unit 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; /存储

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

3、wWndHandler: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:TObje

4、ct); 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; 名师资料总结 - - -精品资料欢迎下载 - - - - - - - -

5、 - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，共 6 页 - - - - - - - - - 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;

6、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:=TStrin

7、gList.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);

8、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; SetWindowLong(FFormHandle,GWL_WNDPROC,Longint(FPOldWndHandler); if FPNewWndHan

9、dlernil then FreeObjectInstance(FPNewWndHandler); FMapStrings.Free; FMapStrings:=nil; inherited destroy; end; procedure TFileMap.OpenMap; var TempMessage:array0.255 of Char; 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 6 页 - - - - - - - - - begin if (FMapHand

10、le=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 (FMapHandle0) and (GetLastError=ERROR_ALREAD

11、Y_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); FMessageID:=RegisterWindowMessage(TempMessage); if FMessageID=

12、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 FIs

13、MapOpen then begin if FMutexHandle0 then begin CloseHandle(FMutexHandle); FMutexHandle:=0; end; if FMapPointernil then 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 3 页，共 6 页 - - - - - - - - - begin UnMapViewOfFile(FMapPointer); FMapPointer:=nil; end; if FMapHandle0

14、 then begin CloseHandle(FMapHandle); FMapHandle:=0; end; FIsMapOpen:=False; end; end; procedure TFileMap.ReadMap; begin FReading:=True; if(FMapPointernil) then FMapStrings.SetText(FMapPointer); end; procedure TFileMap.WriteMap; var StringsPointer:PChar; HandleCounter:integer; SendToHandle:HWnd; begi

15、n if FMapPointernil 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,FF

16、ormHandle,0); StrDispose(StringsPointer); end; end; 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; 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师

17、精心整理 - - - - - - - 第 4 页，共 6 页 - - - - - - - - - procedure TFileMap.SetMapName(Value:string); begin if (FMapNameValue) and (FMapHandle=0) and (Length(Value)246) then begin FMapName:=Value; FSynchMessage:=FMapName+Synch-Now; end; end; procedure TFileMap.SetMapStrings(Value:TStringList); begin if Valu

18、e.TextFMapStrings.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 (FSizeValue) and (FMapHandle=0) then begin StringsPointer:=FMapStrings.GetText; if (

19、ValueStrLen(StringsPointer)+1) then FSize:=StrLen(StringsPointer)+1 else FSize:=Value; if FSize32 then FSize:=32; StrDispose(StringsPointer); end; end; procedure TFileMap.SetAutoSynch(Value:Boolean); begin if FAutoSynchValue then begin FAutoSynch:=Value; if FAutoSynch and FIsMapOpen then WriteMap; e

20、nd; end; procedure TFileMap.EnterCriticalSection; begin if (FMutexHandle0) and not FLocked then begin 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 5 页，共 6 页 - - - - - - - - - FLocked:=(WaitForSingleObject(FMutexHandle,INFINITE)=WAIT_OBJECT_0); end; end; procedure T

21、FileMap.LeaveCriticalSection; begin if (FMutexHandle0) and FLocked then begin ReleaseMutex(FMutexHandle); FLocked:=False; end; end; / 消息捕获过程procedure TFileMap.NewWndProc(var FMessage:TMessage); begin with FMessage do begin if FIsMapOpen if (Msg=FMessageID) and (WParamFFormHandle) then ReadMap; Result:=CallWindowProc(FPOldWndHandler,FFormHandle,Msg,wParam,lParam); end; end; end. 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 6 页，共 6 页 - - - - - - - - -