Delphi內(nèi)存映射文件例子

zengbj 2009-09-24

展開全文

Delphi內(nèi)存映射文件例子收藏
unit FileMap;

interface

uses
   Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,StdCtrls,Dialogs;

type
   TFileMap=class(TComponent)
   private
       FMapHandle:THandle;                  //內(nèi)存映射文件句柄
       FMutexHandle:THandle;              //互斥句柄
       FMapName:string;                        //內(nèi)存映射對象
       FSynchMessage:string;              //同步消息
       FMapStrings:TStringList;        //存儲映射文件信息
       FSize:DWord;                                //映射文件大小
       FMessageID:DWord;                      //注冊的消息號
       FMapPointer:PChar;                    //映射文件的數(shù)據(jù)區(qū)指針
       FLocked:Boolean;                        //鎖定
       FIsMapOpen:Boolean;                  //文件是否打開
       FExistsAlready:Boolean;          //是否已經(jīng)建立過映射文件
       FReading:Boolean;                      //是否正在讀取內(nèi)存文件數(shù)據(jù)
       FAutoSynch:Boolean;                  //是否同步
       FOnChange:TNotifyEvent;          //當內(nèi)存數(shù)據(jù)區(qū)內(nèi)容改變時
       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;
   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('創(chuàng)建文件映射對象失敗!')
       else
       begin
           if (FMapHandle<>0) and (GetLastError=ERROR_ALREADY_EXISTS) then
               FExistsAlready:=True; //如果已經(jīng)建立的話，就設它為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=0 then
                   raise Exception.Create('注冊消息失敗')
           end
       end;
       FMutexHandle:=Windows.CreateMutex(nil,False,PChar(FMapName+'.Mtx'));
       if FMutexHandle=0 then
           raise Exception.Create('創(chuàng)建互斥對象失敗');
       FIsMapOpen:=True;
       if FExistsAlready then //判斷內(nèi)存文件映射是否已打開
           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);
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);
       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;
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;
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
         if (Msg=FMessageID) and (WParam<>FFormHandle) then
               ReadMap;
       Result:=CallWindowProc(FPOldWndHandler,FFormHandle,Msg,wParam,lParam);
   end;
end;end.

本文來自CSDN博客，轉載請標明出處：http://blog.csdn.net/whd0310/archive/2007/07/19/1699152.aspx