config.pas

一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。

unit Config;

{*******************************************
 * brief: 配置类
 * autor: linzhenqun
 * date: 2005-10-26
 * email: [e-mail]
 * blog: http://blog.csdn.net/linzhengqun
 * modi 2006-07-14 by liqj
 * 功能简介：
 *     定义各种配置、配置与文件转换类
 ********************************************}

interface
uses
  Classes, XMLConversion, Graphics, XMLDoc, Contnrs ,
  SysUtils, xmldom, XMLIntf, msxmldom,iniFiles ,Variants;
  
const
  AppSections = 'AppConfig';
    
type
//  TSourceToConfig = class;

  { 配置文件中列表项结构 }
  PItemRec = ^TItemRec;
  TItemRec = record
    Name: string;     //唯一标识
    FilePath: string; //配置文件保存的位置
  end;

  { Shell扩展的结构 }
  TShellRec = record
    AddPop: Boolean;
    RunST: Boolean;
    RunAuto: Boolean;
    AccidenceFile: string;
    DestFileType: string;
  end;

  { 程序配置文件的转换类 
  TSourceToConfigConv = class(TBaseConversion)
  protected
    procedure ObjPropertyToElements(Obj: TObject); override;
    procedure ElementsToObjProperty(Obj: TObject); override;
    procedure GetDefaultXMLStream(XMLStream: TStream); override;
  end;   }

  // 应用程序配置 
  TAppConfig =class
  private
    FFileName :string;
    FChangCount :Integer;
    FIsTerminate:boolean;
  public  
    constructor Create(FileName :string);
    //destructor Destroy; override;
    
    // 得到 小节的值
    procedure GetSections(var Strings:TStrings;
      const AppSection :string=AppSections);virtual;
    procedure GetSection(Section :string; var Strings:TStrings;
      const AppSection :string=AppSections);virtual;
    // 得到配置值 取第三层的值对中的值 (Value="xxx")
    function GetValue(const Section, NameValue:string;const Default: string='';
      const AppSection :string=AppSections;IsCreate:boolean=True):string;virtual;
    // 得到指定属性值 只对XML中的第二层 
    function GetAttrValue(const Section,AttrName:string;const Default: string='';      
      const AppSection :string=AppSections;IsCreate:boolean=True):string;virtual;
    // 设置值 -- 只对名称/值对 (Name="" Value="")
    function SetValue(const Section, NameValue, Value: string;
      IsNotExists :Boolean =True;
      const AppSection :string=AppSections):boolean;virtual;
      
    // 设置属性值  -- 对所有属性 (AttrName="AttrValue")
    // IsCreate 不存在时是否创建, IsErase 是否删除完再重建(Section)
    function SetAttrValues(const Section ,NameValue:string; 
      AttrName, AttrValue: Array of string;
      IsNotExistsCreate :Boolean =True; IsEraseSection :Boolean =False;
      const AppSection :string=AppSections):boolean;virtual;  
      
    function Modified :boolean;virtual;
    procedure Save;virtual;
    procedure SaveAs(const FileName :string);virtual;

    // -- AccidenceFiles --  // 属性使用 #9 分隔
    function GetAccidenceFilesName:string;virtual;
    function GetAccidenceFiles:string;virtual;     
    function SetAccidenceFiles(const Value :array of string):boolean;virtual;
    function GetAccidenceFilePath(const AcciName:string):string;virtual;
    //function AddAccidenceFiles(const Name,FilePath
      
    property FileName: string read FFileName;
    property ChangCount:integer read FChangCount;
    property Terminate:boolean read FIsTerminate write FIsTerminate;
    
  end;

  // XML 文件配置
  TAppXMLConfig =class(TAppConfig)
  private
    FXML :TXMLDocument;
    function FindName(const AppSection,Section,NameValue: string;
      var ParentDom:IDomNode):IDOMNode; 
    function GetLevel2SectonsElement(const AppSection,Section:string): IDOMElement;
      
  public
    constructor Create(FileName :string);
    destructor Destroy; override;

    function AppendChildElement(const TagName,Value: string; 
      ParenElem: IDOMElement): IDOMElement;
    function CreateSection(const AppSection,Section: string): IDOMElement;
    function CreateNodeAndAttr(const AppSection,Section,NameValue,Value :string;
      var ParentEle:IDOMElement):boolean;
    
    // 得到 小节的值
    procedure GetSections(var Strings:TStrings;
      const AppSection :string=AppSections);override;
    procedure GetSection(Section :string; var Strings:TStrings;
      const AppSection :string=AppSections);override;
    // 得到配置值
    function GetValue(const Section, NameValue: string;const Default: string=''; 
      const AppSection :string=AppSections;IsCreate:boolean=True):string;override;
    // 得到指定属性值 只对XML中的第二层 
    function GetAttrValue(const Section,AttrName:string;const Default: string='';      
      const AppSection :string=AppSections;IsCreate:boolean=True):string;override;  
      
    // 设置值  -- 只对名称/值对 (Name="" Value="")
    function SetValue(const Section, NameValue, Value: string;      
      IsNotExistsCreate :Boolean =True ;
      const AppSection :string=AppSections):boolean;override; 
    // 设置属性值  -- 对所有属性 (AttrName="AttrValue")    
    // IsNotExistsCreate 不存在时是否创建
    // IsErase 是否删除完再重建(Section)
    function SetAttrValues(const Section ,NameValue:string; 
      AttrName, AttrValue: Array of string;
      IsNotExistsCreate :Boolean =True; IsEraseSection :Boolean =False;
      const AppSection :string=AppSections):boolean; override;
      
    // -- AccidenceFiles --  
    function GetAccidenceFilesName:string;override;
    // 名称与路径分开二行
    function GetAccidenceFiles:string;override; 
    function SetAccidenceFiles(const Value: array of string):boolean;override;
    function GetAccidenceFilePath(const AcciName:string):string;override;
    
    function Modified :boolean;override;
    procedure Save;override;
    procedure SaveAs(const FileName :string);override;   
  end;
 
  
  { 程序的配置文件 
  TSourceToConfig = class
  private
    FFileName: string;     // 当前配置文件
    FLang: string;         // 界面语言列表
    FAcciList: TOwnerList; // 配置文件列表
    FShell: TShellRec;     // 加壳情况

    procedure InitData;             // 初始化
    procedure SetDefaultData;       // 加入默认数据
    function GetAcciCount: Integer; // 当前配置文件列表数量
    function GetAcciItemRec(Index: Integer): PItemRec;
    procedure SetAcciItemRec(Index: Integer; const Value: PItemRec);
  public
    constructor Create;
    destructor Destroy; override;

    (* 下面是对两个列表的操作 *)
    function AddAcciItem(Item: Pointer): Integer;
    procedure DelAcciItem(Index: Integer);
    function RemoveAcciItem(Item: Pointer): Integer;

    (* 加载词法配置文件 XML -> Obj*)
    procedure LoadFromFile;
    (* 保存词法配置文件 Obj -> XML *)
    procedure SaveToFile;
    (* 根据名字找到一项 *)
    function GetItemByName(AName: string): PItemRec;
    // 得到配置值
    function GetCfgValue(const Section, Name: string; Default: string=''):string;
    
    property FileName: string read FFileName;
    property Lang: string read FLang write FLang;
    property Shell: TShellRec read FShell write FShell;
    property AcciList: TOwnerList read FAcciList;
    property AcciCount: Integer read GetAcciCount;
    property AcciItem[Index: Integer]: PItemRec read GetAcciItemRec
      write SetAcciItemRec;                      // 配置文件列表内容
  end;

 }
//词法配置

  { 词法配置文件的转换类 Obj<->XML }
  TAccidenceConfigConv = class(TBaseConversion)
  protected
    procedure ElementsToObjProperty(Obj: TObject); override;
    procedure ObjPropertyToElements(Obj: TObject); override;
  end;

  { 字体配置 }
  TFontConfig = class
    FontName: string;         // 字体名称
    FontColor: TColor;        // 字体颜色
    FontSize: Integer;        // 字体大小
    FontStyle: TFontStyles;   // 字体样式
    constructor Create;
  end;

  { 常规的设置 }
  TGneralConfig = class
  private
    FIgnoreCase: Boolean;     // 是否忽略大小写
    FShowLine: Boolean;       // 是否显示行号
    FBGround: TColor;         // 代码的背景颜色
    FFontConfig: TFontConfig; // 字体的配置，重要
  public
    constructor Create;
    destructor Destroy; override;

    property IgnoreCase: Boolean read FIgnoreCase write FIgnoreCase;
    property BGround: TColor read FBGround write FBGround;
    property FontConfig: TFontConfig read FFontConfig;
    property ShowLine: Boolean read FShowLine write FShowLine;
  end;

  { 数字的设置 }
  TNumberConfig = class
  private
    FFontConfig: TFontConfig; // 字体的配置
  public
    constructor Create;
    destructor Destroy; override;
    property FontConfig: TFontConfig read FFontConfig;
  end;

  { 关键字设置 }
  TKeyWordConfig = class
  private
    FName: string;            // 关键字名称
    FFontConfig: TFontConfig; // 字体的配置
    FValues: TStrings;        // 关键字列表
  public
    constructor Create;
    destructor Destroy; override;

    property Name: string read FName write FName;
    property FontConfig: TFontConfig read FFontConfig;
    property Values: TStrings read FValues;
  end;

  { 符号的词法设置 如：注释}
  TSymbolConfig = class
  private
    FName: string;            // 符号
    FRange: string;           // 范围 : 只符号、只单词、单行、多行
                              // None, OneWore, SingleLine, MultLine
    FDoubleSymbol: Boolean;   // 是否双符号
    FHightLight: string;      // 高亮部份： 符号Symbol、内容Content、二者Both
    FBeginValue: string;      // 开始值
    FEndValue: string;        // 结束值
    FESC: string;             // 转义符
    FFontConfig: TFontConfig; // 字体的配置
  public
    constructor Create;
    destructor Destroy; override;

    property Name: string read FName write FName;
    property Range: string read FRange write FRange;
    property DoubleSymbol: Boolean read FDoubleSymbol write FDoubleSymbol;
    property HightLight: string read FHightLight write FHightLight;
    property BeginValue: string read FBeginValue write FBeginValue;
    property EndValue: string read FEndValue write FEndValue;
    property ESC: string read FESC write FESC;
    property FontConfig: TFontConfig read FFontConfig;
  end;

  { 词法配置文件 对应XML文件 }
  TAccidenceConfig = class
  private
    FAccidenceName: string;        // 词法名称
    FGeneralConfig: TGneralConfig; // 常规配置  必有 1
    FNumberConfig: TNumberConfig;  // 数字配置  必有 1
    FKeyWords: TObjectList;        // 关键字配置，0..N 种关键字
    FSymbols: TObjectList;         // 符号配置，0..N 种符号
  public
    constructor Create(AcciName :string);
    destructor Destroy; override;
    (* 将词法文件从磁盘中导出 : XML -> Obj *)
    procedure LoadFromFile(FileName: string);
    (* 将词法文件保存到磁盘   : Obj -> XML *)
    procedure SaveToFile(FileName: string);
    (* 清空词法配置文件 *)
    procedure Clear;

    property GeneralConfig: TGneralConfig read FGeneralConfig;
    property NumberConfig: TNumberConfig read FNumberConfig;
    property KeyWords: TObjectList read FKeyWords;
    property Symbols: TObjectList read FSymbols;
    property AccidenceName: string read FAccidenceName;
  end;

//function gSourceToConfig: TSourceToConfig;     // 全局程序配置类 变量 uSourceToConfig
                                               // 管理本程序可配置内容
                                               // 对应 Config.xml 文件
                                               
implementation

uses CommonUtils;
{
resourcestring
  List_OutOfBounds = 'List index out of bounds.';
}
// 单元变量
//var
//  uSourceToConfig: TSourceToConfig = nil;
//  uAppConfig :TAppConfig =nil;
{  
function gSourceToConfig: TSourceToConfig;
begin
  if uSourceToConfig = nil then
    uSourceToConfig := TSourceToConfig.Create;
  Result := uSourceToConfig;
end; 

function gAppConfig :TAppConfig;  -- > 转到 CommonUtils 单元
begin
  if uAppConfig = nil then
    uAppConfig := TAppXMLConfig.Create(GetAbsolutePath('Config_2.xml'));
  Result := uAppConfig;
end;   }

{ TSourceToConfig 程序配置文件

constructor TSourceToConfig.Create;
begin
  FAcciList := TOwnerList.Create;
  FFileName := ExtractFilePath(ParamStr(0)) + 'Config.xml'; // modi
  //初始化数据
  InitData;
end;

destructor TSourceToConfig.Destroy;
begin
  FAcciList.Free;
  inherited;
end;

procedure TSourceToConfig.InitData;
begin
  if FileExists(FFileName) then
    LoadFromFile
  else
    SetDefaultData;
end;

procedure TSourceToConfig.SetDefaultData;
var
  LStream: TMemoryStream;
  Conversion: TSourceToConfigConv;
begin
  LStream := TMemoryStream.Create;
  Conversion := TSourceToConfigConv.Create;
  try
    Conversion.GetDefaultXMLStream(LStream); // 默认值
    LStream.SaveToFile(FFileName);
  finally
    LStream.Free;
    Conversion.Free;
  end;
end;

procedure TSourceToConfig.LoadFromFile;
var
  LStream: TMemoryStream;
  Conversion: TSourceToConfigConv;
begin
  LStream := TMemoryStream.Create;
  Conversion := TSourceToConfigConv.Create;
  try
    LStream.LoadFromFile(FFileName);
    Conversion.XMLToObjProperty(LStream, Self);
  finally
    LStream.Free;
    Conversion.Free;
  end;
end;

procedure TSourceToConfig.SaveToFile;
var