中国人自己的XML控件

////控件代码

{
---读取XML配置文件的控件，可以代替DELPHI的TXMLDocument使用。
---咱中国人自己的XML控件
write by liszt.lee
email:[e-mail]
web: www.lhsoft.com.cn
}

unit LHXML;

interface

uses
  SysUtils, Classes,StrUtils;

type Tattribute=record
    list:string;
    name:string;
    value:string;
end;

type Tnode=record
    i:integer;
    j:integer;
    dsca:string;
    value:string;
    name:string;
    text:string;
    attributecnt:integer;
    attribute:array of Tattribute;
    //parent:Tnode;
end;

type
  TLHXML = class(TComponent)
  private
    { Private declarations }
    memo:TStringlist;
    text:string;
    xmlarray:array   of Tnode;
  protected
    { Protected declarations }
    function formatxml(s:string):string;
    function abstractstring(s:string):string;
    procedure strtonode(s:string);
    function findmaxdeep(s:string):integer;

  public
    { Public declarations }
  published
    { Published declarations }
    procedure LoadFromFile(filename:string);
    function  findnode(nodename:string):string;
    function  findseqnode(seq:integer;nodename:string):string;

    function  nodetotree:string;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LINHANGCOMP', [TLHXML]);
end;

{ TLHXML }

function TLHXML.abstractstring(s: string): string;
var i,j:integer;
b:boolean;
begin
   i:=1;
   b:=true;
   while  b  do
   begin
       //showmessage(copy(s,i,1));
       if  ((copy(s,i,1)<>'<') and (copy(s,i,1)<>'>')   and (copy(s,i,1)<>'/') ) then
       delete(s,i,1)
       else
       i:=i+1;

       if i>=length(s) then b:=false;
   end;
   result:=s;

end;

function TLHXML.findmaxdeep(s: string): integer;
      var ss:string;i,j:integer;
      b:boolean;
      begin
         i:=1;
         b:=true;
         //((pos('<',s)>0) or (pos('</',s)>0) or (pos('>',s)>0))
         s:=abstractstring(s);

         j:=1;
         while pos('<></>',s)>0 do
         begin

              for i:=1 to length(s) do
              begin
                  if copy(s,i,5)='<></>' then
                  begin
                      delete(s,i,5);
                      insert('-----',s,i);
                  end;
              end;

              while pos('-',s)>0 do
              begin
                  delete(s,pos('-',s),1);
              end;

              //showmessage(s);

              j:=j+1;

         end;
         //showmessage(s);
         //showmessage(inttostr(j));
         result:=j-1;

end;

function TLHXML.findnode(nodename: string): string;
var i:integer;r:string;
begin
    r:='';
    for i:=0 to   length(xmlarray)-1 do
    begin
        if xmlarray[i].name=nodename then
        begin
            r:=xmlarray[i].value;
            break;
        end;
    end;

    result:=r;
end;

function TLHXML.findseqnode(seq: integer; nodename: string): string;
var i,j:integer;r:string;
begin
    r:='';
    j:=1;
    for i:=0 to   length(xmlarray)-1 do
    begin
        if xmlarray[i].name=nodename then
        begin
            r:=xmlarray[i].value;

            if j=seq then
            break;

            j:=j+1;
        end;
    end;

    result:=r;

end;

function TLHXML.formatxml(s: string): string;
var name:string;i:integer;
begin
    while pos('/>',s)>0 do
    begin
        name:=copy(s,1,pos('/>',s)-1);
        name:=ReverseString(name);
        name:=trim(copy(name,1,pos('<',name)-1));
        name:=ReverseString(name);
        i:=pos('<'+name+'/>',s);
        delete(s,i,length('<'+name+'/>'));
        insert('<'+name+'></'+name+'>',s,i);
    end;
    result:=s;
end;

procedure TLHXML.LoadFromFile(filename: string);
var s:string;i,j:integer;
begin

memo:=Tstringlist.Create;
memo.LoadFromFile(filename);
text:=memo.Text;

text:=trim(copy(text,pos('?>',text)+2,length(text)));
text:=formatxml(text);

//计算有几条记录
j:=0;
s:=abstractstring(text);
for i:=1 to length(s) do
begin
    if copy(s,i,1)='/' then
    j:=j+1;
end;
//recordcnt:=j;
//deep:=findmaxdeep(mainmemo);
//动态数组变量初始化
setlength(xmlarray,j);

//将文本内容转化为节点数组
strtonode(text);

end;

function TLHXML.nodetotree: string;
var i,j:integer;
s,ss:string;
begin

s:='';
ss:='';
for i:=0 to length(xmlarray)-1 do
begin
    s:=xmlarray[i].name+':'+xmlarray[i].value;
    for j:=0 to xmlarray[i].attributecnt-1 do
    begin
        s:=s+' '+xmlarray[i].attribute[j].list+' ';
    end;
   ss:=ss+s;
end;

result:=ss;
//showmessage(findnode('ReasonName'));
//showmessage(findseqnode(2,'ReasonName'));

end;

procedure TLHXML.strtonode(s: string);
var i,j,k:integer;
b:boolean;
dsca:string;
value:string;
cnt:integer;
attributelist:string;
begin

         b:=true;
         j:=0;
         while b do
         begin
            //节点结束，对记录数没有影响
            while ((copy(s,1,2)='</') and (pos('>',s)>0))  do
            delete(s,pos('</',s), pos('>',s)-pos('</',s)+1 );

            if ((pos('>',s)>0) and  (pos('<',s)>0)) then
            begin
             // <dsca>value</dsca>
             dsca:=copy(s,pos('<',s)+1,pos('>',s)-pos('<',s)-1);

             s:=copy(s,pos('>',s)+1,length(s));
             value:=copy(s,1,pos('<',s)-1);
             s:=copy(s,pos('<',s),length(s));

             if pos(' ',dsca)>0 then
              begin
                  xmlarray[j].dsca:=dsca;
                  xmlarray[j].name:=trim(copy(dsca,1,pos(' ',dsca)-1)) ;

                  //属性
                  attributelist:=trim(copy(dsca,pos(' ',dsca),length(s)));

                  //计数
                  cnt:=0;
                  while pos(' ',attributelist)>0 do
                  begin
                     delete(attributelist,1,pos(' ',attributelist));
                     attributelist:=trim(attributelist);
                     cnt:=cnt+1;
                  end;
                  if attributelist>'' then
                  cnt:=cnt+1;
                  setlength(xmlarray[j].attribute,cnt);
                  xmlarray[j].attributecnt:=cnt;

                  //属性列表赋值
                  attributelist:=trim(copy(dsca,pos(' ',dsca),length(s)));
                  k:=0;
                  while pos(' ',attributelist)>0 do
                  begin
                      xmlarray[j].attribute[k].list:=trim(copy(attributelist,1,pos(' ',attributelist)));
                      xmlarray[j].attribute[k].name:=copy(xmlarray[j].attribute[k].list,1,pos('=',xmlarray[j].attribute[k].list)-1);
                      xmlarray[j].attribute[k].value:=copy(xmlarray[j].attribute[k].list,pos('=',xmlarray[j].attribute[k].list)+1,length(xmlarray[j].attribute[k].list));
                      attributelist:=trim(copy(attributelist,pos(' ',attributelist)+1,length(attributelist)));
                      k:=k+1;
                  end;

                  if pos(' ',attributelist)>0  then
                  begin
                      xmlarray[j].attribute[k].list:=trim(attributelist);
                      xmlarray[j].attribute[k].name:=copy(xmlarray[j].attribute[k].list,1,pos('=',xmlarray[j].attribute[k].list)-1);
                      xmlarray[j].attribute[k].value:=copy(xmlarray[j].attribute[k].list,pos('=',xmlarray[j].attribute[k].list)+1,length(xmlarray[j].attribute[k].list));
                      k:=k+1;
                  end;
                  xmlarray[j].attributecnt:=k;
              end
             else
             begin
                 if j<=length(xmlarray)-1 then
                 begin
                    xmlarray[j].attributecnt:=0;
                    xmlarray[j].name:=dsca;
                 end;
             end;

             if j<=length(xmlarray)-1 then
             xmlarray[j].value:=value;

             j:=j+1;

             //showmessage(s);
            end;

             if s='' then b:=false;

         end;
         //result:=xmlarray;
end;

end.

 

/////如何使用

//例子，从XML配置文件中读取表格的字体大小

procedure TFrm_BaseData.FormShow(Sender: TObject);
var LHXML1:TLHXML;
fs:integer;
begin
  inherited;

try
    LHXML1:=TLHXML.Create(nil);
    if fileexists(GetCurrentDir+'/LHGRIDSET1.XML') then
    begin
        LHXML1.LoadFromFile(GetCurrentDir+'/LHGRIDSET1.XML');
        fs:=strtoint(LHXML1.findnode('size'));
        dbgrid1.Font.Size:=fs ;
        dbgrid1.titleFont.Size:=fs ;
    end;
    LHXML1.Free;
except

end;

end;