Code archives/File Utilities/XML (Load\Save)
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
XML.bmx | |||||
Import "bbtype.bmx" Global sdXMLattr_list:TList=New TList Global sdXMLnode_list:TList=New TList Global sdXMLworklist_list:TList=New TList Global sdXMLnodelist_list:TList=New TList ' XML load / parse / save functions ' XML code by Blitztastic Type sdXMLnodelist Extends TBBType Method New() Add(sdXMLnodelist_list) End Method Method After:sdXMLnodelist() Local t:TLink t=_link.NextLink() If t Return sdXMLnodelist(t.Value()) End Method Method Before:sdXMLnodelist() Local t:TLink t=_link.PrevLink() If t Return sdXMLnodelist(t.Value()) End Method Field node:sdXMLnode Field nextnode:sdXMLnodelist Field prevnode:sdXMLnodelist End Type ' for internal use, do not use in code outside of this file Type sdXMLworklist Extends TBBType Method New() Add(sdXMLworklist_list) End Method Method After:sdXMLworklist() Local t:TLink t=_link.NextLink() If t Return sdXMLworklist(t.Value()) End Method Method Before:sdXMLworklist() Local t:TLink t=_link.PrevLink() If t Return sdXMLworklist(t.Value()) End Method Field node:sdXMLnode End Type Type sdXMLnode Extends TBBType Method New() Add(sdXMLnode_list) End Method Method After:sdXMLnode() Local t:TLink t=_link.NextLink() If t Return sdXMLnode(t.Value()) End Method Method Before:sdXMLnode() Local t:TLink t=_link.PrevLink() If t Return sdXMLnode(t.Value()) End Method Field tag$,value$,path$ Field firstattr:sdXMLattr Field lastattr:sdXMLattr Field attrcount,fileid Field endtag$ ' linkage functionality Field firstchild:sdXMLnode Field lastchild:sdXMLnode Field childcount Field nextnode:sdXMLnode Field prevnode:sdXMLnode Field parent:sdXMLnode End Type Type sdXMLattr Extends TBBType Method New() Add(sdXMLattr_list) End Method Method After:sdXMLattr() Local t:TLink t=_link.NextLink() If t Return sdXMLattr(t.Value()) End Method Method Before:sdXMLattr() Local t:TLink t=_link.PrevLink() If t Return sdXMLattr(t.Value()) End Method Field name$,value$ Field sibattr:sdXMLattr Field parent:sdXMLnode End Type Global SDXMLFILEID Function sdReadXML:sdXMLnode(FileName$) infile = ReadFile(FileName$) SDXMLFILEID=MilliSecs() x:sdXMLnode = sdXMLReadNode(infile,Null) CloseFile infile Return x End Function Function sdWriteXML(FileName$,node:sdXMLnode,writeroot=False) outfile = WriteFile(FileName$) WriteLine outfile,"<?xml version="+Chr$(34)+"1.0"+Chr$(34)+" ?>" sdXMLwriteNode(outfile,node) CloseFile outfile End Function Function sdXMLOpenNode:sdXMLnode(parent:sdXMLnode,tag$="") 'DebugLog "Opening new node" x:sdXMLnode = New sdXMLnode x.tag$=tag$ x.fileid = SDXMLFILEID' global indicator to group type entries (allows multiple XML files to be used) sdXMLaddNode(parent,x) Return x End Function Function sdXMLCloseNode:sdXMLnode(node:sdXMLnode) 'DebugLog "Closing node ["+node\tag$+"]" If node.parent <> Null Then 'DebugLog "Returning to parent ["+node\parent\tag$+"]" Else 'DebugLog "No Parent found" End If Return node.parent End Function ' adds node to end of list (need separate function for insert, or mod this on) Function sdXMLAddNode(parent:sdXMLnode,node:sdXMLnode) If parent <> Null 'DebugLog "Parent of node = ["+parent\tag$+"]" If parent.childcount = 0 Then parent.firstchild = node Else parent.lastchild.nextnode = node End If node.prevnode = parent.lastchild parent.lastchild = node parent.childcount = parent.childcount +1 node.path$ = parent.path$+parent.tag$ End If node.parent = parent node.path$=node.path$+"/" 'DebugLog "path to ["+node\tag$+"]={"+node\path$+"}" End Function Function sdXMLDeleteNode(node:sdXMLnode) n:sdXMLnode = node.firstchild ' delete any children recursively While n <> Null nn:sdXMLnode= n.nextnode sdXMLdeletenode(n) n = nn Wend ' delete attributes for this node a:sdXMLattr = node.firstattr While a <> Null na:sdXMLattr = a.sibattr a.Remove() a = na Wend ' dec parents child count If node.parent <> Null node.parent.childcount = node.parent.childcount -1 ' heal linkages If node.prevnode <> Null Then node.prevnode.nextnode = node.nextnode If node.nextnode <> Null Then node.nextnode.prevnode = node.prevnode If node.parent.firstchild = node Then node.parent.firstchild = node.nextnode If node.parent.lastchild = node Then node.parent.lastchild = node.prevnode End If ' delete this node ' ;Debuglog "DELETING:"+node\tag$ node.Remove() End Function ' node functions Function sdXMLfindNode:sdXMLnode(node:sdXMLnode,path$) 'DebugLog "------------- Perfoming Find ("+path$+")------------" ret:sdXMLnode = Null p=Instr(path$,"/") If p > 0 Then tag$=Left$(path$,p-1) ';DebugLog "Looking for ["+tag$+"]" a:sdXMLnode = node While ret=Null And a<>Null ';DebugLog "Checking...["+a\tag$+"]" If Lower(tag$)=Lower(a.tag$) Then If p=Len(path$) Then ';Debuglog "Found..." ret = a Else If a.firstchild <> Null Then ret = sdxmlfindnode(a.firstchild,Mid$(path$,p+1)) End If End If End If a = a.nextnode Wend End If Return ret End Function Function sdXMLDeleteList(nl:sdXMLnodelist) While nl <> Null na:sdXMLnodelist = nl.nextnode nl.Remove() nl = na Wend End Function Function sdXMLSelectNodes:sdXMLnodelist(node:sdXMLnode,path$,recurse=True) root:sdXMLnodelist=Null sdxmlselectnodesi(node,path$,recurse) prev:sdXMLnodelist=Null c = 0 For wl:sdXMLworklist = EachIn sdxmlworklist_list c = c + 1 nl:sdXMLnodelist = New sdXMLnodelist nl.node = wl.node If prev = Null Then root = nl prev = nl Else prev.nextnode = nl nl.prevnode = prev End If prev = nl wl.Remove() Next 'DebugLog "XML: "+c+" nodes selected" Return root End Function ' internal selection function, do not use outside this file Function sdXMLSelectNodesI(node:sdXMLnode,path$,recurse=True) wl:sdXMLworklist=Null 'DebugLog "------------- Perfoming Select ("+path$+")------------" If node = Null Then 'DebugLog "Search node is null!!!" End If ret:sdXMLnode = Null p=Instr(path$,"/") If p > 0 Then tag$=Left$(path$,p-1) a:sdXMLnode = node While a<>Null 'DebugLog "Looking for {"+path$+"} in {"+a\path$+a\tag$+"/} {"+Lower(Right$(a\path$+a\tag$+"/",Len(path$)))+"} @" If Lower(path$)=Lower(Right$(a.path$+a.tag$+"/",Len(path$))) Then wl = New sdXMLworklist wl.node = a 'DebugLog ">>FOUND" End If If a.firstchild <> Null And (recurse) Then sdXMLSelectNodesI(a.firstchild,path$) End If a = a.nextnode Wend End If End Function Function sdXMLNextNode:sdXMLnode(node:sdXMLnode) Return node.nextnode End Function Function sdXMLPrevNode:sdXMLnode(node:sdXMLnode) Return node.prevnode End Function Function sdXMLAddAttr(node:sdXMLnode,name$,value$) 'DebugLog "XML:adding attribute "+name$+"="+value$+" ("+Len(value$)+")" a:sdXMLattr = New sdXMLattr a.name$ = name$ a.value$ = value$ If node.attrcount = 0 Then node.firstattr = a Else node.lastattr.sibattr = a End If node.lastattr=a node.attrcount = node.attrcount + 1 a.parent = node End Function Function sdXMLReadNode:sdXMLnode(infile,parent:sdXMLnode,pushed=False) mode = 0 root:sdXMLnode = Null cnode:sdXMLnode = Null x:sdXMLnode = Null ispushed = False done = False While (Not done) & (Not Eof(infile)) c = ReadByte(infile) If c<32 Then c=32 ch$=Chr$(c) ' ;Debuglog "{"+ch$+"} "+c+" mode="+mode Select mode Case 0 ' looking for the start of a tag, ignore everything else If ch$ = "<" Then mode = 1' start collecting the tag End If Case 1 ' check first byte of tag, ? special tag If ch$ = "?" Or ch$ = "!" Then mode = 0' class special nodes as garbage & consume Else If ch$ = "/" Then mode = 2 ' move to collecting end tag x.endtag$=ch$ 'DebugLog "** found end tag" Else cnode=x x:sdXMLnode = sdXMLOpennode(cnode) If cnode=Null Then root=x x.tag$=ch$ mode = 3 ' move to collecting start tag End If End If Case 2 ' collect the tag name (close tag) If ch$=">" Then mode = 0 ' end of the close tag so jump out of loop 'done = True x = sdXMLclosenode(x) Else x.endtag$ = x.endtag$ + ch$ End If Case 3 ' collect the tag name If ch$=" " Then 'DebugLog "TAG:"+x\tag$ mode = 4 ' tag name collected, move to collecting attributes Else If ch$="/" Then 'DebugLog "TAG:"+x\tag$ x.endtag$=x.tag$ mode = 2' start/end tag combined, move to close Else If ch$=">" Then 'DebugLog "TAG:"+x\tag$ mode = 20' tag closed, move to collecting value Else x.tag$ = x.tag$ + ch$ End If End If End If Case 4 ' start to collect attributes If Lower(ch$)>="a" And Lower(ch$)<="z" Then aname$=ch$' mode = 5' move to collect attribute name Else If ch$=">" Then x.value$="" mode = 20' tag closed, move to collecting value Else If ch$="/" Then mode = 2 ' move to collecting end tag x.endtag$=ch$ 'DebugLog "** found end tag" End If End If End If Case 5 ' collect attribute name If ch$="=" Then 'DebugLog "ATT:"+aname$ aval$="" mode = 6' move to collect attribute value Else aname$=aname$+ch$ End If Case 6 ' collect attribute value If c=34 Then mode = 7' move to collect string value Else If c <= 32 Then 'DebugLog "ATV:"+aname$+"="+aval$ sdXMLAddAttr(x,aname$,aval$) mode = 4' start collecting a new attribute Else aval$=aval$+ch$ End If End If Case 7 ' collect string value If c=34 Then 'DebugLog "ATV:"+aname$+"="+aval$ sdxmlADDattr(x,aname$,aval$) mode = 4' go and collect next attribute Else aval$=aval$+ch$ End If Case 20 ' COLLECT THE VALUE PORTION If ch$="<" Then 'DebugLog "VAL:"+x\tag$+"="+x\value$ mode=1' go to tag checking Else x.value$=x.value$+ch$ End If End Select If Eof(infile) Then done=True Wend Return root End Function ' write out an XML node (and children) Function sdXMLWriteNode(outfile,node:sdXMLnode,tab$="") ' ;Debuglog "Writing...."+node\tag$+".." s$="<"+node.tag$ a:sdXMLattr = node.firstattr While a<>Null ' ;Debuglog "Writing attr ["+a\name$+"]=["+a\value$+"]" s$ = s$+" "+Lower(a.name$)+"="+Chr$(34)+a.value$+Chr$(34) a = a.sibattr Wend If node.value$="" And node.childcount = 0 Then s$=s$+"/>" et$="" Else s$=s$+">"+node.value$ et$="</"+node.tag$+">" End If WriteLine outfile,sdXMLcleanStr$(tab$+s$) n:sdXMLnode = node.firstchild While n <> Null sdXMLwriteNode(outfile,n,tab$+" ") n = n.nextnode Wend If et$<> "" Then WriteLine outfile,sdXMLcleanStr$(tab$+et$) End Function ' remove non-visible chars from the output stream Function sdXMLCleanStr$(s$) a$="" For i = 1 To Len(s$) If Asc(Mid$(s$,i,1))>=32 Then a$ = a$ +Mid$(s$,i,1) Next Return a$ End Function ' attribute functions ' return an attribute of a given name Function sdXMLFindAttr:sdXMLattr(node:sdXMLnode,name$) ret:sdXMLattr = Null If node <> Null Then a:sdXMLattr = node.firstattr done = False While ret=Null And a<>Null If Lower(name$)=Lower(a.name$) Then ret = a End If a = a.sibattr Wend End If Return ret End Function ' return an attribute value as a string Function sdXMLAttrValueStr$(node:sdXMLnode,name$,dflt$="") ret$=dflt$ a:sdXMLattr = sdXMLfindattr(node,name$) If a <> Null Then ret$=a.value$ Return ret$ End Function ' return an attribute value as an integer Function sdXMLAttrValueInt(node:sdXMLnode,name$,dflt=0) ret=dflt a:sdXMLattr = sdXMLfindattr(node,name$) If a <> Null Then ret=Int(a.value) Return ret End Function ' return an attribute value as a float Function sdXMLAttrValueFloat#(node:sdXMLnode,name$,dflt#=0) ret#=dflt# a:sdXMLattr = sdXMLfindattr(node,name$) If a <> Null Then ret#=Float(a.value) Return ret End Function Function XMLValue$(node:sdXMLnode,path$) Local t:sdXMLnode=XMLFindNode2(node,path$) If t<>Null Then Return t.value$ End Function Function XMLValueInt(node:sdXMLnode,path$) Local t:sdXMLnode=XMLFindNode2(node,path$) If t<>Null Then Return Int(t.value$) End Function Function XMLValueFloat(node:sdXMLnode,path$) Local t:sdXMLnode=XMLFindNode2(node,path$) If t<>Null Then Return Float(t.value$) End Function Function XMLParam$(node:sdXMLnode,param$) Return sdXMLAttrValueStr(node,param$) End Function Function XMLParamStr$(node:sdXMLnode,path$,param$) Local t:sdXMLnode=XMLFindNode2(node,path$) If t<>Null Then Return sdXMLAttrValueStr(t,param$) End Function Function XMLParamInt(node:sdXMLnode,path$,param$) Local t:sdXMLnode=XMLFindNode2(node,path$) If t<>Null Then Return sdXMLAttrValueInt(t,param$) End Function Function XMLParamFloat#(node:sdXMLnode,path$,param$) Local t:sdXMLnode=XMLFindNode2(node,path$) If t<>Null Then Return sdXMLAttrValueFloat(t,param$) End Function Function XMLfindNode2:sdXMLnode(node:sdXMLnode,path$) Return sdXMLFindNode(node,node.tag$+"/"+path$) End Function 'x.sdxmlnode = sdReadXML("test.xml") 'sdwritexml("test2.xml",x) 'f.sdxmlnode = sdxmlfindnode(x,"BB3D/NODE/MESH/") 'If f <> Null Then ' ;Debuglog "FOUND!!!" ' sdxmldeletenode(f) 'End If 'sdwritexml("test3.xml",x) 'nl.sdxmlnodelist = sdxmlselectnodes(x,"/VERTEX/POS/") 'While nl <> Null; ' ;Debuglog "Found....."+nl\node\tag$ ' nl=nl\nextnode 'Wend 'sdxmldeleteList(nl); 'sdxmldeletenode(x) |
Comments
| ||
bbtype.bmx' BBType adds legacy Type functionality to BlitzMax Type Type TBBType Field _list:TList Field _link:TLink Method Add(t:TList) _list=t _link=_list.AddLast(Self) End Method Method InsertBefore(t:TBBType) _link.Remove _link=_list.InsertBeforeLink(Self,t._link) End Method Method InsertAfter(t:TBBType) _link.Remove _link=_list.InsertAfterLink(Self,t._link) End Method Method Remove() _list.remove Self End Method End Type Function DeleteLast(t:TBBType) If t TBBType(t._list.Last()).Remove() End Function Function DeleteFirst(t:TBBType) If t TBBType(t._list.First()).Remove() End Function Function DeleteEach(t:TBBType) If t t._list.Clear() End Function Function ReadString$(in:TStream) Local length length=Readint(in) If length>0 And length<1024*1024 Return brl.stream.readstring(in,length) End Function Function HandleToObject:Object(obj:Object) Return obj End Function Function HandleFromObject(obj:Object) Local h=HandleToObject(obj) Return h End Function |
Code Archives Forum