DFM文件与XML文件互转

dfm文件是Delphi中存储窗体控件信息的，有时为了对大批量的dfm文件操作（如：批量替换控件、作检查等），往往不是太方便。
XML对结构化的数据读写则很强，将文本类型的dfm转为xml后进行操作，再转回dfm存储大大方便了操作。

 

//DFM to XML
procedure Dfm2Xml(ADfmStrings: TStrings; AXml: IDsXmlDocument);
Var
  i: integer;
  mStr : string;
  mParentNode, mNode : IDsXMLNode;
  mObjName, mClass, mObjType: string;
  mPropName, mPropValue: string;
  mInItem: Boolean;   //有Item的也会有End相对，所以要和Object end分开
begin
  mInItem := False;
  mParentNode := AXML;
  for i:=0 to ADfmStrings.Count - 1 do
  begin
    mStr := trim(ADfmStrings.Strings[i]);
    //对象开始
    if (copy(mStr, 1, 6) = 'object') or (copy(mStr, 1, 9) = 'inherited') then
    begin
      //先写入属性 - 如果还有属性没有写
      if mPropName <> '' then
      begin
        mNode := AXml.createElement(mPropName);
        mNode.text := mPropValue;
        mParentNode.appendChild(mNode);
        mPropName := '';
      end;
      mObjType := CutToken(mStr, ' ');          //Type: object or inherited
      mObjName := CutToken(mStr, ': ');         //ObjName: Ex. frmCmsI03
      mClass := mStr;                           //ClassName: Ex. TButton
      mNode := AXml.createElement(mObjName);
      (mNode as IDsXmlElement).setAttribute('ObjType', mObjType);
      (mNode as IDsXmlElement).setAttribute('Class', mClass);
      mParentNode.appendChild(mNode);
      mParentNode := mNode;
    end
    //对象结束
    else if (mStr = 'end') and (not mInItem) then
    begin
      //先写入属性
      if mPropName <> '' then
      begin
        mNode := AXml.createElement(mPropName);
        mNode.text := mPropValue;
        mParentNode.appendChild(mNode);
        mPropName := '';
      end;
      mParentNode := mParentNode.parentNode;
    end
    //属性处理
    else
    begin
      //有 = 说明是一个属性的新的开始
      if (Pos(' = ', mStr) > 0) and (not mInItem) then
      begin
        //先写入属性
        if mPropName <> '' then
        begin
          mNode := AXml.createElement(mPropName);
          mNode.text := mPropValue;
          mParentNode.appendChild(mNode);
        end;
        mPropName := CutToken(mStr, ' = ');
        mPropValue := CutToken(mStr, ' = ');
      end
      else   //说明这个属性可能有多行
        mPropValue := mPropValue + '#13#10' + mStr;
        if mStr = 'item' then mInItem := True;
        if mStr = 'end' then mInItem := False;
    end;
  end;
end;
//XML to DFM
procedure Xml2Dfm(AXml: IDsXmlDocument; ADfmStrings: TStrings);
  procedure Node2Dfm(ANode: IDsXMLNode; oString: TStrings; IdentSpace: string);
  Var
    mObjName, mClass, mObjType: string;
    mPropName, mPropValue: string;
    mNode : IDsXMLNode;
    i: integer;
    mVar : Variant;
  begin
    mObjName := (ANode as IDsXmlElement).NodeName;
    mClass   := (ANode as IDsXmlElement).getAttribute('Class');
    mObjType := (ANode as IDsXmlElement).getAttribute('ObjType');
    //写入Object begin
    oString.Add(Format('%s%s %s: %s', [IdentSpace, mObjType, mObjName, mClass]));
    //写入属性
    for i:= 0 to ANode.childNodes.length - 1 do
    begin
      mNode := ANode.childNodes.item[i];
      //Has Child 说明是一个新的对象
      mVar := (mNode as IDsXmlElement).getAttribute('ObjType');
      if not varIsNull(mVar)  then
        Node2Dfm(mNode, oString, IdentSpace + '  ')
      //是属性，写进去就好了．
      else
      begin
        mPropName := mNode.nodeName;
        mPropValue := mNode.text;
        mPropValue := StringReplace(mPropValue, '#13#10', #13#10, [rfReplaceAll]);
        //写入：缩进
        oString.Add(Format('%s%s = %s', [IdentSpace+'  ', mPropName, mPropValue]));
      end;
    end;
    //写入End
    oString.Add(Format('%send', [IdentSpace]));
  end;
  
begin
  Node2Dfm(AXml.Get_documentElement, ADfmStrings, '');
end;

用到的类型：

uses
   MSXML2_TLB;
//类型自己重新定义过
type
  IDsXmlDocument = IXMLDOMDocument2;
  IDsXmlNode     = IXMLDOMNode;
  IDsXmlElement  = IXMLDOMElement;
  IDsXmlNodeList = IXMLDOMNodeList;