It's dirty, quickly-made and ... so on ^^
But anyway it is better than declaring structures manually.
* How to use?
1) Save code to a some file
2) Put your XML into a "xml.txt" file around
3) Run code and copy required structures declarations from debug
4) Use ExtractXMLStructure() with those declarations to make XML parsing some easier
Also see the code for something to change, etc.
For now It can't build one structure describing whole XML tree, just produces lot of separated structures.
PS. Also maybe there was some better made already, just didn't found and was simplier to make my own than search a lot
UPDATE: the code below is outdated, here is UI tool instead:
http://geocities.ws/lunasole/data/_4pb/xmlstgen/l
Code: Select all
EnableExplicit
;{ XML and such stuff }
Structure ITEM
Name$
Params$
EndStructure
; Returns type of Data contained in Dat$
; RETURN: detected type, represented as string with PB code
Procedure$ XmlContentType(Dat$, NoDetect = #False)
; if disabled detection
If NoDetect
ProcedureReturn ".s"
EndIf
; analyze data and try to detect it's type
Protected t, L = Len(dat$)
Protected c$
Protected isFloat, isInt, isStr
Protected tVal.q
For T = 1 To L
c$ = Mid(Dat$, T, 1)
Select c$
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9":
isInt + 1
Case ".", ",":
; the float value expected to start from a digit, not from ".", ","
If isInt >= 1
isFloat + 1
Else
isStr + 1
EndIf
Case "-":
; - can be only the first char, if value is numeric
If T = 1
isInt + 1
Else
isStr + 1
EndIf
Default
isStr + 1
EndSelect
Next T
; the value can't be int or float if it is string
If isStr
ProcedureReturn ".s"
; the value can be float if it has numbers (optionally with single "-" sign) and only one separator ("," or ".")
ElseIf isInt And isFloat = 1
;ProcedureReturn ".d"
ProcedureReturn ".f"
; if contains only number, it is int value
ElseIf isInt
;ProcedureReturn ".l"
ProcedureReturn ".q"
; emty value, let it be string
Else
ProcedureReturn ".s"
EndIf
EndProcedure
; Recursively goes through XML tree and collects data types
; Node any node of XML object to start from it
; ChildID used internally
; Types() list to receive results
; NoDetect if True, string type is used for all values (instead of attempt to detect data type)
; RETURN: none, list modified
Procedure XmlScanRecursive (Node, ChildID, List Types.ITEM(), NoDetect = #False)
Static XmlDbgRegExp, Dim RegRes.s(0)
Protected CCount = XMLChildCount (Node), NNode = NextXMLNode (Node), NType = XMLNodeType (Node)
If NType = #PB_XML_Root
; init
ClearList(Types())
XmlDbgRegExp = CreateRegularExpression(#PB_Any, "(?s)([^ \f\n\r\t\v]|.*).*[^ \f\n\r\t\v]") ; probably this still needed ^^
Else
; check if it is list
; Define isList
; If ExamineXMLAttributes(Node)
; While NextXMLAttribute(Node)
; If LCase(XMLAttributeName(Node)) = "list" And LCase(XMLAttributeValue(Node)) = "true"
; Debug GetXMLNodeName (Node) + Str(CCount)
; Break
; EndIf
; Wend
; EndIf
If CCount
; add new type
AddElement(Types())
Types()\Name$ = "XML_" + UCase(GetXMLNodeName (Node))
Else
; add new param
ExtractRegularExpression(XmlDbgRegExp, GetXMLNodeText (Node), RegRes())
Types()\Params$ + #TAB$ + GetXMLNodeName (Node) + XmlContentType(RegRes(0), NoDetect) + #CRLF$
EndIf
EndIf
; counting items on current level
ChildID + 1
If CCount >= ChildID
; go deeper
PushListPosition(Types())
XmlScanRecursive (ChildXMLNode (Node), ChildID, Types(), NoDetect)
PopListPosition(Types())
EndIf
; continue at current deepth
If NNode
XmlScanRecursive(NNode, 0, Types(), NoDetect)
EndIf
; fin
If NType = #PB_XML_Root
FreeRegularExpression(XmlDbgRegExp)
EndIf
EndProcedure
;}
; main
Define NewList Res.ITEM()
Define NewMap Tmp()
; load and analyze xml from file
Define tXML = LoadXML(#PB_Any, "D:\1.txt")
XmlScanRecursive (RootXMLNode (tXML), 0, Res(), #False)
FreeXML(tXML)
; display found structure declarations
; TODO: nested structures, lists/arrays and so on
Define tHash$
SortStructuredList(Res(), #PB_Sort_Ascending, OffsetOf(ITEM\Name$), #PB_String)
ForEach Res()
If Res()\Name$ And Res()\Params$
; also ignore duplicates
tHash$ = Res()\Name$ + Chr(1) + Res()\Params$
If FindMapElement(Tmp(), tHash$) = 0
Debug "Structure " + Res()\Name$
Debug Res()\Params$ + "EndStructure" + #CRLF$
Tmp(tHash$) = #True
EndIf
EndIf
Next Res()