Figure 3   Publication.Title


 Option Explicit
 Dim oXML As XML.xmlparser
 Dim rsUpdateTitle As ADODB.Recordset
 Dim rsAllTitles As ADODB.Recordset
 Dim rsTitle As ADODB.Recordset
 Dim cnPubs As ADODB.Connection
 Dim cmdTitle As ADODB.Command
 Dim sSQL As String
 Dim vData As Variant
 Dim dbRecordset As String
 
 Const sDataSource = "conPubs"
 
 'local variable(s) to hold property value(s)
 Private mvarTitleID As Variant 'local copy
 
 Function GetDSN() As String
   GetDSN = "DSN=Pubs;uid=sa;pwd=;"
 End Function
 
 Friend Property Let TitleId(ByVal vData As Variant)
 'used when assigning a value to the property, on the left side of an assignment.
 'Syntax: X.TitleID = 5
     mvarTitleID = vData
 End Property
 
 Friend Property Set TitleId(ByVal vData As Variant)
 'used when assigning an Object to the property, on the left side of a Set statement.
 'Syntax: Set x.TitleID = Form1
     Set mvarTitleID = vData
 End Property
 
 Friend Property Get TitleId() As Variant
 'used when retrieving value of a property, on the right side of an assignment.
 'Syntax: Debug.Print X.TitleID
     If IsObject(mvarTitleID) Then
         Set TitleId = mvarTitleID
     Else
         TitleId = mvarTitleID
     End If
 End Property
 
 Public Sub UpdateTitle(ByVal TitleId As Variant, Title As Variant, Notes As Variant)
 Dim sReturn As String
 
 Set rsTitle = CreateObject("ADODB.Recordset")
     On Error GoTo UpdateTitleErr
 
     If Len(TitleId) = 0 Then
         Exit Sub
     End If
     
     sReturn = ""
 
     sSQL = "UPDATE titles " & _
         "SET  title = '" & Title & "'," & _
         "notes = '" & Notes & "'  " & _
         "WHERE (title_id = " & "'" & TitleId & "')"
            
     rsTitle.Open sSQL, GetDSN, adOpenForwardOnly, adLockOptimistic, adCmdText
     
     Exit Sub
 
 UpdateTitleErr:
     
     Err.Raise Err.Number, "Title:UpdateTitle", Err.Description
 End Sub
 
 Public Function RetrieveAllTitlesOnly()
 
 Set rsAllTitles = CreateObject("ADODB.Recordset")
     sSQL = "select * from titles"
     rsAllTitles.Open sSQL, GetDSN, adOpenForwardOnly, adLockReadOnly, adCmdText
     
     If Not rsAllTitles.EOF And Not rsAllTitles.BOF Then
       vData = rsAllTitles.GetRows
       If IsArray(vData) Then
          dbRecordset = True
       Else
          dbRecordset = False
       End If
     Else
       dbRecordset = False
     End If
     
     rsAllTitles.Close
     Set rsAllTitles = Nothing
     
     RetrieveAllTitlesOnly = vData
 
 End Function
 
 Public Function RetrieveTitle(TitleId As Variant) As Variant
 Dim sReturn As String, sTitle As String, sID As String
 Dim sNotes As String
 
 'SELECT title_id, title, type, pub_id, price, advance, royalty, ytd_sales, notes,
 pubdate FROM titles WHERE (title_id = ?)
 Set rsTitle = CreateObject("ADODB.Recordset")
     
     If Len(TitleId) = 0 Then
         TitleId = ""
         RetrieveTitle = 0
     End If
     sReturn = ""
 
     sSQL = "SELECT title_id, title, type, pub_id, price, advance, royalty, _
     ytd_sales, notes, pubdate FROM titles WHERE (title_id = " & "'" & TitleId & "')"
     rsTitle.Open sSQL, GetDSN, adOpenForwardOnly, adLockReadOnly, adCmdText
         
     If rsTitle.RecordCount <> 0 Then
         sTitle = oXML.Format("Title", rsTitle("title"))
         sID = oXML.Format("Title_ID", rsTitle("title_id"))
         sNotes = oXML.Format("Notes", rsTitle("notes"))
         sReturn = sID & sTitle & sNotes
         RetrieveTitle = sReturn
    End If
 
     rsTitle.Close
     
 End Function
 
 Private Sub Class_Initialize()
     Set oXML = New xmlparser
 End Sub

Figure 4   Publication.Title Methods

Method
Description
GetDSN
Function that returns the DSN for the object. The DSN information is hardcoded.
UpdateTitle
Sub that updates a single title.
RetrieveTitle
Function that retrieves a specific title and returns it in an XML stream.
RetrieveAllTitlesOnly
Function that retrieves all titles and returns them in an array generated by the ADO recordset GetRows method.


Figure 5   XML.xmlparser


 Option Explicit
 Const xs = "<"
 Const xe = ">"
 Const xend = "</"
 
 Public Function XMLDeclaration() As String
   XMLDeclaration = "<?xml version=""1.0""?>"
 
 End Function
 
 Public Function Parse(ByVal XMLSource As String, _
     ByVal XMLName As String, _
     Optional Instance As Integer = 1, _
     Optional Default As Variant = "") As String
 
     Dim x As Integer, y As Integer, XMLStart As Integer, XMLTag As String, _
         c As String
     Dim XMLTagEnd As String
     Dim XMLMatch As Integer, XMLEnd As Integer, XMLLength As Integer
     
     XMLLength = Len(XMLSource)
     XMLTag = xs + XMLName + xe
     XMLTagEnd = xend + XMLName + xe
     
     '*** Find the start of the requested intstance...
     XMLStart = 1
     For x = 1 To Instance
         y = InStr(XMLStart, XMLSource, XMLTag)
         If y >= XMLStart Then
             XMLStart = y + Len(XMLTag)
         Else
             Parse = Default
             Exit Function
         End If
     Next
     
     '*** Find the end of the instance...
     XMLEnd = XMLStart
     XMLMatch = 1
     Do Until XMLMatch = 0
         c = Mid(XMLSource, XMLEnd, Len(XMLTagEnd))
         If c = XMLTagEnd Then
             XMLMatch = XMLMatch - 1
         ElseIf Left(c, 1) = xs Then
             XMLMatch = XMLMatch + 1
         End If
         XMLEnd = XMLEnd + 1
         If XMLEnd = XMLLength Then
             Parse = Default
             Exit Function
         End If
     Loop
     
     Parse = Mid(XMLSource, XMLStart, XMLEnd - XMLStart - 1)
 
 End Function
 
 Public Function Format(XMLName As String, XMLValue As Variant) As String
 
     Select Case VarType(XMLValue)
     Case vbByte, vbInteger, vbSingle, vbDouble, vbDecimal, vbBoolean, vbLong, _
         vbCurrency
         Format = xs + XMLName + xe + Trim(Str(XMLValue)) + xend + XMLName + xe
     Case vbString, vbVariant, vbDate
         Format = xs + XMLName + xe + XMLValue + xend + XMLName + xe
     Case Else
         Format = ""
     End Select
 
 End Function

Figure 6   XML.xmlparser Methods

Method
Description
XMLDeclaration
Function that returns the XML declaration.
Format
Function that takes a value and XML tag name, then formats the data in the proper XML structure.
Parse
Function that looks up an element in a data stream. You can use Parse to look up a single element or multiple elements.