Main reason was I kinda liked the XMLNodeFromPath() and wanted to experiment with it.
@freak: Any chance of some more functions that use NodeFromPath ?
In particular a Set and a Delete, so that one could simply do quick xml preference files using node paths.
These procedures gives you a easy way to do a XML based preference or config file.
Although there is a Main document node, a group node, and the entry nodes in this example, the code should support many many sub groups, so your not just limited to 3 levels like here.
Anyway, have fun with this one folks, experiment, improve upon, whatever
Test XML:
Code: Select all
<?xml version="1.0" encoding="UTF-8"?>
<Main>
<Group>
<Entry>This is a simple test!</Entry>
<Entry2>1</Entry2>
<Entry3>This will be deleted!</Entry3>
</Group>
</Main>Code: Select all
;Public Domain.
EnableExplicit
Procedure.i XMLPrefsLoad(xml.i,filepath$)
Protected result.i=#Null,bak$,len.i
;If prefs not found, restore backup if available.
If len
len+1
bak$=Left(filepath$,Len(filepath$)-len)
EndIf
bak$+".bak"
If FileSize(filepath$)<1
RenameFile(bak$,filepath$)
EndIf
result=LoadXML(xml,filepath$)
ProcedureReturn result
EndProcedure
Procedure.i XMLPrefsSave(xml.i,filepath$)
Protected result.i=#False,bak$,len.i
If IsXML(xml)
len=Len(GetExtensionPart(filepath$))
If len
len+1
bak$=Left(filepath$,Len(filepath$)-len)
EndIf
bak$+".bak"
;Delete any old backup.
If FileSize(bak$)>-1
DeleteFile(bak$)
EndIf
;And make a new backup.
RenameFile(filepath$,bak$)
;Save current prefs.
FormatXML(xml,#PB_XML_ReFormat|#PB_XML_ReduceNewline,1)
If Not SaveXML(xml,filepath$) ;If save failed then,
If FileSize(filepath$)=0 ;If file exist and empty,
DeleteFile(filepath$) ;delete it,
EndIf
RenameFile(bak$,filepath$) ;restore the backup.
Else
result=#True
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure.s XMLPrefsGetValue(xml.i,nodepath$)
Protected text$,*rootnode,*node,pos.i,len.i
If IsXML(xml)
*rootnode=RootXMLNode(xml)
If *rootnode
*node=XMLNodeFromPath(*rootnode,nodepath$)
If *node
text$=Trim(GetXMLNodeText(*node))
pos=1
If (Left(text$,2)=#CRLF$)
pos+2
ElseIf (Left(text$,1)=#LF$) Or (Left(text$,1)=#CR$)
pos+1
EndIf
len=Len(text$)
If (Right(text$,2)=#CRLF$)
len-4
ElseIf (Right(text$,1)=#LF$) Or (Right(text$,1)=#CR$)
len-3
EndIf
text$=Trim(Mid(GetXMLNodeText(*node),pos,len))
EndIf
EndIf
EndIf
ProcedureReturn text$
EndProcedure
Procedure.i XMLPrefsSetValue(xml.i,nodepath$,value$)
Protected result=#False,text$,*rootnode,*node,*parentnode,n.i,i.i,path$,pos.i,name$
If IsXML(xml)
*rootnode=RootXMLNode(xml)
If *rootnode
*node=XMLNodeFromPath(*rootnode,nodepath$)
If *node
SetXMLNodeText(*node,value$)
result=#True
Else
*parentnode=*rootnode
pos=1
n=CountString(nodepath$,"/")+1
For i=2 To n
pos=FindString(nodepath$,"/",pos+1)
If pos=0
pos=Len(nodepath$)
EndIf
path$=Left(nodepath$,pos)
*node=XMLNodeFromPath(*parentnode,path$)
If Not *node
name$=StringField(nodepath$,i,"/")
*node=CreateXMLNode(*parentnode,-1)
If *node
SetXMLNodeName(*node,name$)
*parentnode=*node
EndIf
Else
*parentnode=*node
EndIf
*node=XMLNodeFromPath(*rootnode,nodepath$)
If *node
SetXMLNodeText(*node,value$)
result=#True
EndIf
Next
EndIf
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure.i XMLPrefsDeleteValue(xml.i,nodepath$)
Protected result=#False,*rootnode,*node
If IsXML(xml)
*rootnode=RootXMLNode(xml)
If *rootnode
*node=XMLNodeFromPath(*rootnode,nodepath$)
If *node
DeleteXMLNode(*node)
result=#True
EndIf
EndIf
EndIf
ProcedureReturn result
EndProcedure
;You can use the rest of the XML functions normally, like:;
;XMLStatus() to check status, CreateXML() to create a new XML, FreeXML() to free the XML memory, and so on.
#XML_Prefs=1
Define prefs$,num.i,prefs_bak$,status.i
prefs$="test.xml"
If XMLPrefsLoad(#XML_Prefs,prefs$)
status=XMLStatus(#XML_Prefs)
If (status=#PB_XML_Success) Or (status=#PB_XML_NoElements)
Debug XMLPrefsGetValue(#XML_Prefs,"/Main/Group/Entry") ;/main/node/value, IMPORTANT! Remember that XML is case sensitive.
num=Val(XMLPrefsGetValue(#XML_Prefs,"/Main/Group/Entry2"))
num+1
XMLPrefsSetValue(#XML_Prefs,"/Main/Group/Entry2",Str(num))
XMLPrefsDeleteValue(#XML_Prefs,"/Main/Group/Entry3")
XMLPrefsSave(#XML_Prefs,prefs$)
Else
;Show some XML error info here maybe?
EndIf
;Free resources.
FreeXML(#XML_Prefs)
EndIf
