ACCESS内部存款和储蓄器映射达成进度通信

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: TNotify伊芙nt; //当内存数据区内容改变时
    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 :=
‘使用表达:运营两个或五个此应用程序,按下“展开内部存款和储蓄器映射”按键,’
    + #1三 +
‘选中“是还是不是同步”复选框,在备注框里改造,在别的的应用程序少将会’
    + #一3 + ‘该动后的新闻,同时也得以读写多少开关来获得共享音讯’
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.

 

ACCESS 1

 

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

 

VC版:
http://blog.csdn.NET/zicheng\_lin/article/details/8151448

相关文章