usharemem.~pas

此程序演示了利用xml控件（当然也可以不通过xml控件）

unit uShareMem;
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

基于 SimDesign NativeXml.v2.20 控件，实现多个DELPHI程序间的变量共享

作者：韦梁邦

日期：2006-04-06

QQ: 86804

MSN: [e-mail]

使用方法：
  1. 将变量写到内存（支持写多个变量，按名存取）
     uShareMem.ShareMem_SetValue( 'memo', self.Memo1.Text );

  2. 从内存中读出变量值
     showMessage( uShareMem.ShareMem_GetValue( 'memo', '缺省值' ) );

更新历史：
  2006-04-06  因为程序需要，编写此程序初版

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
interface

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

  //初始化共享内存指针
  function _ShareMem_Init(): Boolean;
  //把文本写入共享内存
  function ShareMem_SaveToMemory( _text: String ): Boolean;
  //从内存读出文本
  function ShareMem_LoadFromMemory(): String;
  //写入变量到内存
  function ShareMem_SetValue( _Key, _Value: String ): boolean;
  //从内存读出变量
  function ShareMem_GetValue( _Key: String; _DefVal:String='' ): String;

var
  ShareMem_hMapFile: THandle;
  ShareMem_MapFilePointer: Pointer;

implementation

  uses NativeXml; //使用XML包

//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
//初始化共享内存指针
//在共享内存操作前必须执行
function _ShareMem_Init(): Boolean;
begin

  Result := False;
  try
    ShareMem_hMapFile := CreateFileMapping (
      $FFFFFFFF, // 特殊内存映射句柄
      nil,
      page_ReadWrite,
      0,
      10000,
      'ShareMem_MappedFile'); // 文件名

    if ShareMem_hMapFile <> 0 then begin
      ShareMem_MapFilePointer := MapViewOfFile (
        ShareMem_hMapFile, // 上面映象文件的句柄
        File_Map_All_Access,
        0,
        0,
        0); // 访问整个映象文件
    end;

    if ShareMem_MapFilePointer <> nil then Result := True;
  Except
    on e: Exception do begin
      showMessage( 'ShareMem->ShareMem_Init' + #13#10 + e.Message );
    end;

  end;
  
end;


//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
//把文本写入共享内存
function ShareMem_SaveToMemory( _text: String ): Boolean;
begin
  result := False;
  if ShareMem_MapFilePointer = Nil Then
    if Not _ShareMem_Init() then Exit;
    
  StrCopy (PChar (ShareMem_MapFilePointer), PChar (_text));
  Result := True;
end;


//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
//从内存读出文本
function ShareMem_LoadFromMemory(): String;
begin
  result := '';
  if ShareMem_MapFilePointer = Nil Then
    if Not _ShareMem_Init() then Exit;
    
  Result := PChar (ShareMem_MapFilePointer);
end;


//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
//写入变量到内存
//参数：变量名，值
function ShareMem_SetValue( _Key, _Value: String ): boolean;
var _text: String;
    ADoc: TNativeXml;
begin
  result := False;
  
  try
    _text := ShareMem_LoadFromMemory(); //读内存

    ADoc := TNativeXml.Create;
    try
      if _text <> '' then ADoc.ReadFromString( _text );
      ADoc.EncodingString := 'GB2312';
      ADoc.Root.Name := 'Root';

      //如果节点存在则更新，不存在则新增
      if adoc.Root.FindNode( _Key ) = nil then
        ADoc.Root.NodeNew( _Key ).ValueAsString := _Value
      else
        ADoc.Root.NodeByName( _Key ).ValueAsString := _Value;

      //showMessage( ADoc.WriteToString );
      ShareMem_SaveToMemory( ADoc.WriteToString ); //保存xml到内存
    finally
      ADoc.Free;
    end;

    Result := True;

  Except
    on e: Exception do begin
      showMessage( 'ShareMem->ShareMem_SetValue' + #13#10 + e.Message );
    end;

  end;
  
end;


//从内存读出变量
//参数：变量名，如果该变量不存在返回的缺省值
//不区分大小写
function ShareMem_GetValue( _Key: String; _DefVal:String='' ): String;
var _text: String;
    ADoc: TNativeXml;
    Node: TXmlNode;
begin

  result := _DefVal;
  
  try
    _text := ShareMem_LoadFromMemory(); //读内存

    ADoc := TNativeXml.Create;
    try
      if _text <> '' then ADoc.ReadFromString( _text );
      ADoc.EncodingString := 'GB2312';
      ADoc.Root.Name := 'Root';

      //showMessage( ADoc.WriteToString );
      
      //如果节点存在则更新，不存在则新增
      Node := adoc.Root.FindNode( _Key );
      if Node <> nil then
        Result := Node.ValueAsString;

    finally
      ADoc.Free;
    end;

  Except
    on e: Exception do begin
      showMessage( 'ShareMem->ShareMem_GetValue' + #13#10 + e.Message );
    end;

  end;

end;


end.