Search Tools Links Login

XML_Generator


Generate XML from ADO recordsets.

Original Author: Deltaoo

Inputs

'Set a ref to MS ADO and MSXML3.0
strParentName=name of top level node (usually the table name)
oRS = Recordset

Assumptions

Use as follows...
Create a procedure to connect to and retreive a recorset from a datasource.
Dim a strVariable to hold the returned xml and a boolen to check the ceration process...
dim strXML as string
Dim bOK as boolean
'Use as follows...
bOK=bGenerate_XML("tablename", oRS , strXML)

Returns

strXML = The transformed data
bGenerate_XML = Boolean

Side Effects

No error checking.... so there may be some

Code

' Coded by Deltaoo
'  Mail deltaoo@hotmail.com
'-------------------------------
'Use this code to convert a recordset to XML
' Use bGenerate_XML as boolean
Option Explicit
'  -- CONSTANTS --
Const XML_OPEN = ""
Const XML_CLOSE = "" '""

Private Function AddNode(strNodeValue As String, strNodeName As String) As String
Dim strRet     As String
  strRet = "     <" & LCase(ReplaceString(strNodeValue)) & ">"
  strRet = strRet & strNodeName & ""
  AddNode = strRet
'
End Function
Public Function bGenerate_XML(strParentName As String, oRS As ADODB.Recordset, ByRef strXML As String) As Boolean
Dim strRet     As String
Dim n        As Integer
Dim strRootName   As String
On Error Resume Next ' Must handle the error for NULLS///
  strRootName = Trim(LCase(strParentName)) & "s"
  strParentName = LCase(strParentName)
  strRet = XML_OPEN & vbCrLf
  strRet = strRet & "<" & strRootName & ">" & vbCrLf
    With oRS
    Do Until .EOF
      strRet = strRet & "   <" & strParentName & ">" & vbCrLf
      For n = 0 To .Fields.Count - 1
      strRet = strRet & AddNode(.Fields(n).Name, .Fields(n)) & vbCrLf
      Next n
    .MoveNext
      strRet = strRet & "   " & vbCrLf
    Loop
    End With
  strRet = strRet & "" & vbCrLf
  strRet = strRet & XML_CLOSE & vbCrLf
  ' test the XML Before sending it back to the Caller
    bGenerate_XML = b_XML_OK(strRet)
    strXML = strRet
End Function
Private Function ReplaceString(strValue) As String
Dim strRet
  If IsNull(strValue) Then strValue = ""
  strRet = strValue
  strRet = Replace(strRet, "&", "&")
  strRet = Replace(strRet, "<", "<")
  strRet = Replace(strRet, ">", ">")
  strRet = Replace(strRet, """", """)
  strRet = Replace(strRet, "'", "'")
  '  -- Pass the value back --
  ReplaceString = strRet
End Function
Private Function b_XML_OK(strXMLData As String) As Boolean
Dim oDOM      As MSXML2.DOMDocument
Dim bProcOK     As Boolean
  Set oDOM = CreateObject("MSXML2.DOMDocument")
    bProcOK = oDOM.loadXML(bstrXML:=strXMLData)
    If Not bProcOK Then strXMLData = oDOM.parseError.reason
  Set oDOM = Nothing
    b_XML_OK = bProcOK
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 126 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.