config.pas

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

    begin
      Dom2 := Dom.childNodes.item[j];
      if CompareText(Dom2.nodeName,Section)<>0 then
         Continue ;
      for k :=0 to Dom2.childNodes.length -1 do   
      begin
        Dom3 := Dom2.childNodes.item[k];
        // 返回的属性串中要 用双引号括起值并要以逗号(,) 分隔、结尾
        s := Dom3.nodeName + '=';
        for n :=0 to Dom3.attributes.length -1 do
        begin
          s := s + Dom3.attributes.item[n].nodeName  + '="' +
                   Dom3.attributes.item[n].nodeValue + '",';
        end;
        //Delete(s,Length(s),1);
        Strings.Add(s);           
      end;  // Level 3 for/end
      Exit; // 找到，返回   
    end;    // Level 2 for/end 
  end;      // Level 1 for/end  
end;


function TAppXMLConfig.GetAttrValue(const Section, AttrName, Default,
  AppSection: string;IsCreate:boolean): string;
var
  i,j,k :integer;
  Dom,Dom2,Dom3 :IDOMNode;  
begin
  Result := Default;
  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
    begin
      Dom2 := Dom.childNodes.item[j];
      if CompareText(Dom2.nodeName,Section)<>0 then
         Continue ;
      if AttrName <>'' then
      begin   
        Dom3 :=Dom2.attributes.getNamedItem(AttrName);
        if Dom3<>nil then
          Result := Dom3.nodeValue
        else  
          if IsCreate then
          begin          
            (DOM2 as IDOMElement).setAttribute(AttrName,Default);
            Inc(FChangCount);
          end;     
      end    
      else
      begin
        // 返回的属性串中要 用双引号括起值并要以逗号(,) 分隔、结尾
        Result := Section + '=';
        for k:=0 to Dom2.attributes.length -1 do
          Result := Result + Dom2.attributes.item[k].nodeName + '="' +
                             Dom2.attributes.item[k].nodeValue +'",';
      end;
      Exit;// 找到，返回    
    end;   // Level 2 for/end 
  end;     // Level 1 for/end  
end;
 
function TAppXMLConfig.GetValue(const Section, NameValue,Default,
  AppSection :string;IsCreate:boolean): string;
var
  IDom ,INode :IDomNode;
  Ele :IDOMElement; 
begin
  Result := Default;
  if Not Assigned(FXML.DOMDocument) then Exit;
  IDom := FindName(AppSection,Section,NameValue,INode);
  if IDom <>nil then
  begin
    INode := IDom.attributes.getNamedItem('Value');
    if INode <> nil then
      Result := INode.nodeValue
    else
      if IsCreate then
      begin
        (IDOM as IDOMElement).setAttribute('Value',Default);
        Inc(FChangCount);
      end;
  end
  else
    if IsCreate then
    begin
      if INode =nil then 
        Ele := CreateSection(AppSection,Section)
      else
        Ele := INode as IDOMElement;   
      CreateNodeAndAttr(AppSection,Section,NameValue,Default,Ele);     
    end;
end;

function TAppXMLConfig.SetValue(const Section, NameValue, Value: string;
  IsNotExistsCreate: Boolean; const AppSection: string): boolean;
var
  ValueNode,ParentNode:IDomNode; 
  Ele ,SectionEle :IDOMElement; 
begin
  Result := False;
  if Not Assigned(FXML.DOMDocument) then Exit;
  SectionEle := FindName(AppSection,Section,NameValue,ParentNode) as IDOMElement;
  if SectionEle <>nil then            // 存在元素，已有 Name 属性
  begin
    ValueNode := SectionEle.attributes.getNamedItem('Value');
    if ValueNode <> nil then          // 有Value属性 -> 值更新
    begin
      ValueNode.nodeValue := Value;
      Inc(FChangCount);
    end  
    else if IsNotExistsCreate then    // 无Value属性 -> 新增 Value 属性
    begin           
      SectionEle.setAttribute('Value',Value);
      Inc(FChangCount);           
    end;  
  end
  else if IsNotExistsCreate then      // 无元素 -> 建立
  begin  
    if ParentNode =nil then 
      Ele := CreateSection(AppSection,Section)
    else
      Ele := ParentNode as IDOMElement;   
    CreateNodeAndAttr(AppSection,Section,NameValue,Value,Ele);  
  end
  else
    Raise Exception.Create(pubGet('Err_Params_Invalide'));
  Result := True;  
end;

function TAppXMLConfig.SetAttrValues(const Section,NameValue: string; AttrName,
  AttrValue: array of string; IsNotExistsCreate, IsEraseSection: Boolean;
  const AppSection: string): boolean;
var
  i,n,m :integer;
  Ele :IDOMElement;
  Node,ParentNode :IDOMNode;

  procedure AddElementNode;         // 直接建立第三层元素，并设置属性
  var
    ii,jj :integer;
    SectionName :string;
    Str :TStrings;
    Ele2:IDOMElement;
  begin    
    Str := TStringList.Create;
    try
      SectionName := Copy(Section,1,Length(Section)-1);
      for ii := Low(AttrValue) to High(AttrValue) do
      begin
        Str.Clear;
        Str.Text := AttrValue[ii];
        Ele2 := FXML.DOMDocument.createElement(SectionName);  
        Ele.appendChild(Ele2);
        Inc(FChangCount);       
        for jj :=0 to Str.Count -1 do
        begin
          if Trim(Str.Names[jj]) = '' then Continue;
          Ele2.setAttribute(Trim(Str.Names[jj]),Str.ValueFromIndex[jj]);           
        end;
        Inc(FChangCount,Str.Count);
      end;
    finally
      Str.Free;
    end;
  end;
begin
  {注：
   (1)只清除节点： a.属性为空  
     (存在才处理)  b.不存在时创建   IsNotExistsCreate = *
                   c.可以设置清除节点  IsEraseSection = True
   (2)只创建节点： a.属性为空
     (不存在才处理)b.不存在时创建   IsNotExistsCreate = True
                   c.可以设置清除节点  IsEraseSection = *
     两个都设置为True，则存在时清除起作用，不存在时创建起作用。
   (3)NameValue 为空时，AttrName也要为空，
      AttrValue 要为 Name=Value #13#10 Name2=Value2 的形式参数
  } 
  
  Result := False;
  n := High(AttrName) - Low(AttrName) +1;
  m := High(AttrValue) - Low(AttrValue) +1;
  if n>0 then Assert(n=m,pubGet('Err_Params_Invalide'));
    
  if NameValue='' then  // 只处理第2层元素时
    Ele := GetLevel2SectonsElement(AppSection,Section)
  else
  begin                 // 定位第三层元素位置，按 Name=NameValue
    Ele :=FindName(AppSection,Section,NameValue,ParentNode) as IDOMElement;
    if Ele =nil then
    begin
      if Not IsNotExistsCreate then
      begin
        if n=0 then 
        begin
          Result := True;// 也算成功
          Exit;          // 只清除节点，(未找到)，不处理 
        end;  
        raise Exception.Create(pubGet('Err_Params_Invalide'));
      end  
      else
      begin
        if ParentNode=nil then
          Ele := CreateSection(AppSection,Section)
        else
          Ele := ParentNode As IDOMElement;
        CreateNodeAndAttr(AppSection,Section,NameValue,'',Ele);
        IsEraseSection := False;     // 已重建，已不用清除 
      end;   
    end;
  end;  
      
  if Ele = nil then
  begin
    if Not IsNotExistsCreate then
    begin
      if n=0 then 
      begin
        Result := True;// 也算成功
        Exit;          // 只清除节点，未找到，不处理 
      end;  
      raise Exception.Create(pubGet('Err_Params_Invalide'));
    end  
    else
      Ele :=CreateSection(AppSection,Section);
    IsEraseSection := False;     // 已重建，已不用清除  
  end; 
     
  if IsEraseSection then 
  begin
    ParentNode := Ele.parentNode;
    ParentNode.removeChild(Ele as IDOMNode);
    Ele := ParentNode as IDOMElement;
    Inc(FChangCount);
    if NameValue<>'' then  
      CreateNodeAndAttr(AppSection,Section,NameValue,'',Ele)
    else   
      if (n>0) or ((NameValue='') and (m>0)) then   // 有参数时才重建
        Ele :=CreateSection(AppSection,Section);
        
    if n>0 then
    begin     
      for i := Low(AttrName) to High(AttrName) do
        Ele.setAttribute(AttrName[i],AttrValue[i]);
      Inc(FChangCount,n);  
    end    
    else
    begin
      if m>0 then AddElementNode;
    end;        
  end
  else
    if n>0 then
    begin
      for i := Low(AttrName) to High(AttrName) do
      begin
        Node :=Ele.attributes.getNamedItem(AttrName[i]); 
        if Node=nil then
          Ele.setAttribute(AttrName[i],AttrValue[i])
        else
          Node.nodeValue := AttrValue[i];
      end;
      Inc(FChangCount,n);
    end  
    else
      if m>0 then AddElementNode;
  Result := True;  
end;

procedure TAppXMLConfig.Save;
var
  s : string;
begin
  if Modified then
  begin
    FXML.SaveToXML(s); 
    FXML.LoadFromXML(FormatXMLData(s));
    FXML.SaveToFile(FFileName); 
    FChangCount := 0;
  end;  
end;

procedure TAppXMLConfig.SaveAs(const FileName: string);
var
  s :string;
begin
  inherited;
  FXML.SaveToXML(s); 
  FXML.LoadFromXML(FormatXMLData(s)); 
  FXML.SaveToFile(FileName);
end;


function TAppXMLConfig.GetAccidenceFilesName: string;
var
  i ,j: integer;
  s : string;
  SL: TStrings;
begin
  Result := '';
  SL := TStringList.Create;
  try
    GetSection('AccidenceFiles',SL); 
    // 一行格式 AccidenceFile=Name="NameValue",FilePath="PathValue",
    // 取 NameValue 列表
    // 当前词法名称列表，使用 #13#10间隔，并结尾
    for i:=0 to SL.Count -1 do
    begin
      s := Trim(SL.ValueFromIndex[i]);
      if s<>'' then
      begin
        j := Pos('"',s);
        Delete(s,1,j);
        j := Pos('",',s);
        Result := Result + Copy(s,1,j-1) + #13#10;
      end;
    end;
  finally
    SL.Free;
  end;  
end;

function TAppXMLConfig.GetAccidenceFiles: string;
var
  i ,j: integer;
  s ,s2: string;
  SL: TStrings;
begin
  Result := '';
  SL := TStringList.Create;
  try
    GetSection('AccidenceFiles',SL); 
    // 一行格式 AccidenceFile=Name="NameValue",FilePath="PathValue",
    // 取 NameValue 与 PathValue 的组合列表
    // 名称与路径分开二行
    for i:=0 to SL.Count -1 do
    begin
      s := Trim(SL.ValueFromIndex[i]);
      if s<>'' then
      begin
        j := Pos('"',s);              // NameValue
        Delete(s,1,j);
        j := Pos('",',s);
        s2 := Copy(s,1,j-1);
        Delete(s,1,j+1);
        j := Pos('"',s);              // PathValue
        Delete(s,1,j);
        j := Pos('",',s);
        s2 := s2 +#13#10+ Copy(s,1,j-1);
        Result := Result + s2 + #13#10;
      end;
    end;
  finally
    SL.Free;
  end; 
end; 

function TAppXMLConfig.SetAccidenceFiles(const Value: array of string): boolean;
begin
  Result := False;
  if High(Value)=-1 then Exit;   // 空
  Result :=SetAttrValues('AccidenceFiles','',[],Value,True,True); // 重建
end;

function TAppXMLConfig.GetAccidenceFilePath(const AcciName: string): string;
var
  i ,j:integer;
  s :string;
begin
  Result := '';
  s :=GetAccidenceFiles;
  i := Pos(LowerCase(AcciName) +#13#10,LowerCase(s));
  if i>0 then
  begin
    Inc(i,Length(AcciName) +2);
    s := Copy(s,i,MaxInt);
    j := Pos(#13#10,s);
    if j>0 then Result:= Copy(s,1,j-1);
  end;
end;

initialization
finalization

end.