Unit 12: Customising Applications

Criteria

The functional specification (12a)
(AO 2, 3)

The design (12b)
(AO 1, 2, 3, 4)

Prototyping & testing (12b, c & d)
(AO 1, 2, 3, 4)

Documentation (12c)
(AO 1, 3)

Evaluation (12e)
(AO 4)

12b

The second prototype (version 1.0)

Graphical User Interface:

This form pulls data from sermons.xml and processes it and outputs a file called latest-sermons.html. It has pretty much the same functionality as the first prototype but it does has more controls.

Code:

' 20070320 D.S Hollands
' Update sermons VBA form to valid XHTML via XML and XSLT - Version 2.0

Option Explicit

' Declaring global vars and constants '
' Begin/ ============================ '
Const PATH As String = "E:\test\"
Const SERMON_ARCHIVE As String = "sermons.xml"
Const LATEST_SERMON As String = "latest-sermon.xml"
Const NO_LOAD As String = "Cannot load: "
Const CONTACT As String = ", contact David as soon as possible."
' ============================== /end '

Public Function EditLatestSermonXML(ByVal NodeNumber As Integer)

 ' Declaring local vars and constants '
 ' Begin/ =========================== '
 Dim LatestSermonXML As New MSXML2.DOMDocument50
 Dim strTime As String
 ' ============================= /end '

 ' Tests the radio buttons and turns result into the appropriate string '
 If frmSMS.radAM = True And frmSMS.radPM = False Then
  strTime = "AM"
 Else
  strTime = "PM"
 End If

 ' Below dumps the text contained within the form's fields into a xml file in memory '
 LatestSermonXML.loadXML _
 "<sermon day='" & frmSMS.txtDay.Text & "' month='" & frmSMS.txtMonth.Text & "' year='" & frmSMS.txtYear.Text & "' time='" & strTime & "'>" + vbNewLine + _
 " <title>" & frmSMS.txtTitle.Text & "</title>" + vbNewLine + _
 " <book>" & frmSMS.txtBook.Text & "</book>" + vbNewLine + _
 " <chapter>" & frmSMS.txtChapter.Text & "</chapter>" + vbNewLine + _
 " <beginning_verse>" & frmSMS.txtBeginningVerse.Text & "</beginning_verse>" + vbNewLine + _
 " <ending_verse>" & frmSMS.txtEndingVerse.Text & "</ending_verse>" + vbNewLine + _
 " <series>" & frmSMS.txtSeries.Text & "</series>" + vbNewLine + _
 " <preacher>" & frmSMS.txtPreacher.Text & "</preacher>" + vbNewLine + _
 " <url_mp3>" & frmSMS.txtMP3URL.Text & "</url_mp3>" + vbNewLine + _
 " <url_ogg>" & frmSMS.txtOGGURL.Text & "</url_ogg>" + vbNewLine + _
 " <summary>" & frmSMS.txtSummary.Text & "</summary>" + vbNewLine + _
 "</sermon>" + vbNewLine

 ' Saves the XML string located in memory to a file

 LatestSermonXML.Save (PATH + LATEST_SERMON) '<-- saves the loaded XML

End Function

' NodeName must be "sermon" '
Public Function AddNewSermonNode(NodeName As String)

 ' Declaring local vars and constants '
 ' ================================== '
 Dim LatestSermonXML As FreeThreadedDOMDocument50
 Dim SermonArchiveXML As DOMDocument50
 Dim Node As IXMLDOMNode
 Dim NodeClone As IXMLDOMNode
 Dim msg As String
 ' ================================== '

 Set LatestSermonXML = New FreeThreadedDOMDocument50
 Set SermonArchiveXML = New DOMDocument50

 SermonArchiveXML.async = False
 If False = SermonArchiveXML.Load(PATH + SERMON_ARCHIVE) Then
  MsgBox NO_LOAD & SERMON_ARCHIVE & CONTACT
  Exit Function
 End If

 LatestSermonXML.async = False
 If False = LatestSermonXML.Load(PATH + LATEST_SERMON) Then
  MsgBox NO_LOAD & LATEST_SERMON & CONTACT
  Exit Function
 End If

 ' Copy the sermon node from LatestSermonXML to SermonArchiveXML: '
 ' Fetch the "/sermon" (node) from LatestSermonXML (LATEST_SERMON) '
 ' Clone node for import to SermonArchiveXML '
 ' Append clone to SermonArchiveXML (SERMON_ARCHIVE) '

 Set Node = LatestSermonXML.SelectSingleNode("/" & NodeName)
 Set NodeClone = SermonArchiveXML.importNode(Node, True)
 SermonArchiveXML.documentElement.appendChild NodeClone
 SermonArchiveXML.documentElement.appendChild SermonArchiveXML.createTextNode(vbNewLine)

 Set Node = Nothing
 Set NodeClone = Nothing

 SermonArchiveXML.Save (PATH + SERMON_ARCHIVE)
 msg = "The sermon archive has been updated."

 MsgBox msg

End Function

Public Function TransformXML(ByRef XSLStyleSheet As String, ByRef InputXML As String, ByRef OutputXMLDeriv As String)

 ' Declaring local vars and constants '
 ' ================================== '
 Dim xslt As New MSXML2.XSLTemplate30
 Dim xslDoc As New MSXML2.FreeThreadedDOMDocument30
 Dim xmlDoc As New MSXML2.DOMDocument30
 Dim xslProc As IXSLProcessor '<-- only works with MSXML 3.0 or higher
 Dim OutputDoc As New MSXML2.DOMDocument30
 Dim Err '<-- declaring error var
 ' ================================== '

 'MSXML2.30 (MSXML 3.0) or higher is used because lower versions do not have an IXSL Processor

 xslDoc.Load (PATH & XSLStyleSheet) '<-- loads the xsl ready for transformation

 If (xslDoc.parseError.errorCode <> 0) Then '<-- checks the xslt is valid
  Set Err = xslDoc.parseError
  MsgBox ("Error: " & Err.reason) '<-- explains error
 Else
  Set xslt.StyleSheet = xslDoc '<-- assigns xslDoc as the Stylesheet
  xmlDoc.Load (PATH & InputXML) '<-- loads the xml file
 End If

 If (xmlDoc.parseError.errorCode <> 0) Then '<-- checks the xml is valid
  Set Err = xmlDoc.parseError
  MsgBox ("Error: " & Err.reason) '<-- explains error
 Else
  Set xslProc = xslt.createProcessor() '<-- initialises processor
  xslProc.input = xmlDoc '<-- inputs the valid xml file
  xslProc.transform '<-- transforms the xmlDoc using the xslDoc
  OutputDoc.loadXML (xslProc.Output) '<-- Loads the processors output
  OutputDoc.Save (PATH & OutputXMLDeriv) '<-- Saves the output
  MsgBox ("Update complete!") '<-- Informs user of end
 End If

End Function

' ============ Query sermon xml function ============== '

Public Function QuerySermonNode(NodeNum As Integer)

 'Declaring vars and constants
 '================================================
 Dim oXMLDoc As New MSXML2.DOMDocument30 '<-- DOMDocument30 because of functionality
 Dim oNode As IXMLDOMNode
 Dim oNodes As IXMLDOMNodeList '<-- Assigns oNodes as a Node List (collection)
 Dim i As Integer
 Dim detailName As String
 Dim dName As String
 Dim dText As String
 '================================================
 

 ' Assign necessary truths to XMLDocument
 oXMLDoc.async = False
 oXMLDoc.validateOnParse = False
 oXMLDoc.resolveExternals = False
 oXMLDoc.preserveWhiteSpace = True '<-- Keeps the white spaces inside the xml data

 ' Load XML data from latest-sermon.xml file
 If oXMLDoc.Load(PATH + SERMON_ARCHIVE) = False Then
  MsgBox "Failed to load latest sermon xml data from file."
  Exit Function
 End If

 ' Commence querying the sermon node-set ==========================================

 ' Navigate to and load contents of first sermon node as a node list (Xpath)
 ' Integer NodeNum is inserted here...
 Set oNodes = oXMLDoc.SelectNodes("//sermon[" & NodeNum & "]/*")

 For i = 0 To oNodes.Length - 1 '<-- Loop until list ends
 
  ' Jumps the "sermon" node and goes straight to the "title" node
  ' then next time goes to the next node in the list until list ends
  Set oNode = oNodes.NextNode

  ' Check that node name is not empty (error checking - maybe unnecessary??)
  If Not (oNode Is Nothing) Then
 
   'Makes coding less tedious - consider making function though
   dName = oNode.NodeName '<-- dName = detail name = node name
   dText = oNode.Text '<-- dText = detail text = text in node

   'Check what node name is and assign node's text to correct text box
   Select Case dName '<-- (nodeName)
    Case Is = "title"
     frmSMS.txtTitle = dText '<-- Fills text box with node text
    Case Is = "book"
     frmSMS.txtBook = dText
    Case Is = "chapter"
     frmSMS.txtChapter = dText
    Case Is = "beginning_verse"
     frmSMS.txtBeginningVerse = dText
    Case Is = "ending_verse"
     frmSMS.txtEndingVerse = dText
    Case Is = "series"
     frmSMS.txtSeries = dText
    Case Is = "preacher"
     frmSMS.txtPreacher = dText
    Case Is = "url_mp3"
     frmSMS.txtMP3URL = dText
    Case Is = "url_ogg"
     frmSMS.txtOGGURL = dText
    Case Is = "summary"
     frmSMS.txtSummary = dText
   End Select
  End If

 Next '<-- looping...

 ' function.... QuerySermonNode(x)

End Function

Private Sub btnQueryNode_Click()

 QuerySermonNode (0)

End Sub

Private Sub btnUpdate_Click()
 
 Dim a As String

 EditLatestSermonXML (1)
 Call TransformXML("latest-sermon.xsl", "latest-sermon.xml", "latest-sermon.html")

End Sub

Click next to continue...

« BACK | Back to top | NEXT »