config.pas

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

  try
    Conversion.ObjPropertyToXML(LStream, Self);
    LStream.SaveToFile(FileName);
  finally
    LStream.Free;
    Conversion.Free;
  end;
end;

{ TKeyWordConfig }

constructor TKeyWordConfig.Create;
begin
  FValues := TStringList.Create;
  FFontConfig := TFontConfig.Create;
end;

destructor TKeyWordConfig.Destroy;
begin
  FValues.Free;
  FFontConfig.Free;
  inherited;
end;

{ TGneralConfig }

constructor TGneralConfig.Create;
begin
  FFontConfig := TFontConfig.Create;
  FBGround := clWhite;
end;

destructor TGneralConfig.Destroy;
begin
  FFontConfig.Free;
  inherited;
end;

{ TFontConfig }

constructor TFontConfig.Create;
begin
  FontName := Def_FontName;
  FontSize := Def_FontSize;
  FontColor := clBlack;
end;

{ TNumberConfig }

constructor TNumberConfig.Create;
begin
  FFontConfig := TFontConfig.Create;
end;

destructor TNumberConfig.Destroy;
begin
  FFontConfig.Free;
  inherited;
end;

{ TSymbolConfig }

constructor TSymbolConfig.Create;
begin
  FFontConfig := TFontConfig.Create;
end;

destructor TSymbolConfig.Destroy;
begin
  FFontConfig.Free;
  inherited;
end;

{ TAppConfig }

constructor TAppConfig.Create(FileName: string);
begin
  FFileName := FileName;
  FChangCount :=0;
  FIsTerminate :=False;
end;

procedure TAppConfig.GetSection(Section: string; var Strings: TStrings;
  const AppSection: string);
begin
  if Not Assigned(Strings) then 
    Raise Exception.Create(pubGet('Err_Params_Invalide'));
  Strings.Clear;
end;

procedure TAppConfig.GetSections(var Strings:TStrings;
  const AppSection :string);
begin
  if Not Assigned(Strings) then 
    Raise Exception.Create(pubGet('Err_Params_Invalide'));
  Strings.Clear;   
end;

function TAppConfig.GetValue(const Section, NameValue,Default,
  AppSection :string;IsCreate:boolean): string;
begin
end;
function TAppConfig.GetAttrValue(const Section,AttrName,Default,
  AppSection :string;IsCreate:boolean):string;
begin 
end;  
function TAppConfig.Modified: boolean;
begin 
end;
procedure TAppConfig.Save;
begin
end;
procedure TAppConfig.SaveAs(const FileName: string);
begin
end;


function TAppConfig.GetAccidenceFilesName: string;
begin

end;

function TAppConfig.GetAccidenceFiles: string;
begin

end;

function TAppConfig.SetAttrValues(const Section,NameValue: string; AttrName,
  AttrValue: array of string; IsNotExistsCreate, IsEraseSection: Boolean;
  const AppSection: string): boolean;
begin

end;

function TAppConfig.SetValue(const Section, NameValue, Value: string;
  IsNotExists: Boolean; const AppSection: string): boolean;
begin

end;

function TAppConfig.SetAccidenceFiles(const Value: array of string): boolean;
begin

end;

function TAppConfig.GetAccidenceFilePath(const AcciName: string): string;
begin

end;

{ TAppXMLConfig }

function TAppXMLConfig.Modified: boolean;
begin
  Result := FChangCount <>0 ;
end;

constructor TAppXMLConfig.Create(FileName: string);
var
  Str :TStringStream;
//  XMLNode : IXMLNode;
begin
  inherited Create(FileName);
  FXML := TXMLDocument.Create(nil);
  FXML.XML.LoadFromFile(FFileName);
  Str := TStringStream.Create(FXML.XML.Text) ;
  try
    FXML.LoadFromStream(Str); 
  finally  
    Str.Free;
  end;
//  XMLNode := FXML.DocumentElement;
//  ShowDlg(XMLNode.NodeName +#13#10+ XMLNode.NamespaceURI);
//  FXML.loadFromXML(FXML.XML.Text); 
  FXML.Active := True;              // 分析 
end;

function TAppXMLConfig.AppendChildElement(const TagName,
  Value: string;ParenElem: IDOMElement): IDOMElement;
var
  Text: IDOMText;
  NodeList :IDOmNodeList;
  EleRoot : IDOMElement;
begin
  Result := FXML.DOMDocument.createElement(TagName);  
  if Value <> '' then
  begin
    Text := FXML.DOMDocument.createTextNode(Value);
    Result.appendChild(Text);
    Inc(FChangCount);
  end;
  if ParenElem = nil then 
  begin
    NodeList:= FXml.DOMDocument.getElementsByTagName(AppSections);
    EleRoot := NodeList.item[0] as IDOMElement; 
    EleRoot.appendChild(Result); 
  end  
  else
    ParenElem.appendChild(Result);
  Inc(FChangCount);  
end;

function TAppXMLConfig.CreateNodeAndAttr(const AppSection,Section,NameValue,
  Value: string;var ParentEle:IDOMElement): boolean;
var
  Ele,EleRoot,Ele2 : IDOMElement;
  NodeList :IDOMNodeList;  
begin
  if ParentEle =nil then
  begin
    NodeList:= FXml.DOMDocument.getElementsByTagName(AppSection);
    EleRoot := NodeList.item[0] as IDOMElement; 
    Ele := nil;
    NodeList:= EleRoot.getElementsByTagName(Section);
    if NodeList<> nil then 
      Ele := NodeList.item[0] as IDOMElement;
     
    if Ele = nil then
    begin
      Ele := FXML.DOMDocument.createElement(Section);
      EleRoot.appendChild(Ele);
      Inc(FChangCount); 
    end;
  end  
  else
    Ele := ParentEle;
    
  // 建节点 与 一对属性 (Name ="NameValue" Value="Value")
  Ele2 := FXML.DOMDocument.createElement(Copy(Section,1,Length(Section)-1));
  Ele.appendChild(Ele2);
  Inc(FChangCount);  
  Ele2.setAttribute('Name',NameValue);
  Inc(FChangCount);
  if Value<>'' then 
  begin
    Ele2.setAttribute('Value',Value);
    Inc(FChangCount); 
  end;
  ParentEle := Ele2;  
end;

function TAppXMLConfig.CreateSection(const AppSection,Section: string): IDOMElement;
var
  i ,count:integer;
  NodeList :IDOMNodeList;
  Ele ,Ele2 :IDOMElement;
begin
  Result := nil;
  count := FXML.DOMDocument.childNodes.length ;
  if count =0 then  
    Raise Exception.Create('Err_InVaile_XMLFile');
  Ele := nil;
  NodeList := FXML.DOMDocument.getElementsByTagName(AppSection);
  if NodeList<> nil then 
    Ele := NodeList.item[0] as IDOMElement;
      
  if Ele =nil then
  begin
    Ele := FXML.DOMDocument.createElement(AppSection);
    FXML.DOMDocument.appendChild(Ele);
    Inc(FChangCount); 
  end;
  
  Ele2 :=nil;
  NodeList :=Ele.getElementsByTagName(Section);
  if NodeList<> nil then 
    Ele2 := NodeList.item[0] as IDOMElement;
    
  if Ele2 =nil then
  begin
    Ele2 := FXML.DOMDocument.createElement(Section); 
    Ele.appendChild(Ele2);
    Inc(FChangCount); 
  end;
  Result := Ele2;
end;

destructor TAppXMLConfig.Destroy;
begin
  FXML.Free;
  inherited;
end;

{  注：xml 文件格式为
   <?xml ...
   <AppConfig>
     <Sections>
       <Section Name="NameValue" Value="Values"/>
       <Section Name="NameValue2" Value="Values2"/>
     </Sections>
     <Sections2>
       <Section Name="NameValue" Value="Values"/>
       <Section Name="NameValue2" Value="Values2"/>
     </Sections2>     
   </AppConfig>
   其中 Level 1 = <?xml... 与 <AppConfig>
        Level 2 = <Sections> 与 <Sections2>
        Level 3 = Level2 里面的 <Section> 此层(元素)有属性 Name 与 Value
}
function TAppXMLConfig.FindName(const AppSection,Section, NameValue: string;
  var ParentDom:IDomNode): IDOMNode;
var
  i,j,k :integer;
  Dom,Dom2,Dom3,Node :IDomNode; // 局部变量的接口，释放由编译器处理
begin
  Result := nil; 
  for i:=1 to FXML.DOMDocument.childNodes.length -1 do // Level 1
  begin                                                // i:=1 <?xml 不处理
    Dom := FXML.DOMDocument.childNodes.item[i];
    if CompareText(Dom.nodeName,AppSection)<>0 then
       Continue ; 
    for j:=0 to Dom.childNodes.length -1 do            // Level 2
    begin
      Dom2 := Dom.childNodes.item[j];
      if CompareText(Dom2.nodeName,Section)<>0 then
        Continue ;
      for k:=0 to Dom2.childNodes.length-1 do          // Level 3
      begin
        Dom3 := Dom2.childNodes.item[k];
        if Dom3.attributes.length =0 then Continue;
        Node := Dom3.attributes.getNamedItem('Name');       
        if (Node<>nil) and 
           (CompareText(Node.nodeValue,NameValue)=0) then
        begin        
          Result := Dom3;
          ParentDom := Dom2;
          Exit;
        end;  
      end;   // for 3/end
    end;     // for 2/end
  end;       // for 1/end 
end;

function TAppXMLConfig.GetLevel2SectonsElement(const AppSection,
  Section: string): IDOMElement;
var
  i ,j :integer;
  Dom :IDomNode;
  Ele :IDOMElement;  
begin
  Result := nil;
  for i:=1 to FXML.DOMDocument.childNodes.length -1 do // Level 1
  begin                                                // i:=1 <?xml 不处理
    Dom := FXML.DOMDocument.childNodes.item[i];
    if CompareText(Dom.nodeName,AppSection)<>0 then
       Continue ; 
    for j:=0 to Dom.childNodes.length -1 do            // Level 2
    begin
      Ele := Dom.childNodes.item[j] as IDOMElement;
      if CompareText(Ele.nodeName,Section)=0 then
      begin
        Result := Ele ;
        Exit;
      end;
    end;     // for 2/end
  end;       // for 1/end 
end;

procedure TAppXMLConfig.GetSections(var Strings:TStrings;
  const AppSection :string);
var
  i ,j : Integer;
  IDom : IDOMNode;  
begin  
  inherited;
  if Not Assigned(FXml.DOMDocument) then Exit;
  for i:=0 to FXml.DOMDocument.childNodes.length -1 do
  begin
    IDom := FXml.DOMDocument.childNodes.item[i];
    if CompareText(IDom.nodeName,AppSection)<>0 then
       Continue ;
    for j:=0 to IDom.childNodes.length -1 do
    begin
      Strings.Add(IDom.childNodes.item[j].nodeName);    
    end;  
  end; // Level 1 for/end
end;

procedure TAppXMLConfig.GetSection(Section: string; var Strings: TStrings;
  const AppSection :string);
var
  i,j,k,n :integer;
  s :string;
  Dom,Dom2,Dom3 :IDOMNode;
begin
  inherited;
  if Not Assigned(FXml.DOMDocument) then Exit;
  for i:=0 to FXml.DOMDocument.childNodes.length -1 do
  begin
    Dom := FXml.DOMDocument.childNodes.item[i];
    if CompareText(Dom.nodeName,AppSection)<>0 then
       Continue ;
    for j:=0 to Dom.childNodes.length -1 do