Attribute VB_Name = "TestXmlsq"
Option Explicit
Option Base 0
' Some tests using the VBA/VB6 interface to xmlsq
' $Id: TestXmlsq.bas $
' Last updated:
' $Date: 2021-07-18 09:19 $
' $Version: 1.0.0 $
'
' ------------------------------ LICENSE -------------------------------------
' Copyright (C) 2020-21 David Ireland, DI Management Services Pty Limited.
' All rights reserved. <https://di-mgt.com.au> <https://cryptosys.net>
' The code in this module is licensed under the terms of the MIT license.
' For a copy, see <http://opensource.org/licenses/MIT>
' ----------------------------------------------------------------------------
'
' Requires `diXmlsq.dll` to be installed on your system: available from <https://cryptosys.net/xmlsq/>.
' Include the module `basXmlsq.bas` in your project.
'
' Test files are provided in `xmlsq-testfiles.zip`. These must be in the current working directory.
'
Private Const MIN_VERSION As Long = 900
Sub Main()
Debug.Print "Current Dir=" & CurDir
Call DoAllTests
End Sub
Public Sub DoAllTests()
Call Test_General
Call Test_Bookstore
Call Test_Empty
Call Test_Arithmetic
Call Test_Whitespace
End Sub
Public Sub Test_General()
Dim n As Long
Dim ch As String
Debug.Print ("INTERROGATE THE CORE DLL:")
n = xmlsqGenVersion()
Debug.Print "Version=" & n
If n < MIN_VERSION Then
MsgBox "Require xmlsq v" & MIN_VERSION & " or higher", vbCritical
Exit Sub
End If
Debug.Print "ModuleName=" & xmlsqGenModuleName()
Debug.Print "CompileTime=" & xmlsqGenCompileTime()
Debug.Print "Platform=" & xmlsqGenPlatform()
End Sub
Public Sub Test_Bookstore()
Dim strXmlFile As String
Dim strQuery As String
Dim s As String
Dim n As Long
Dim i As Long
Debug.Print vbCrLf & "VALID QUERIES COMPARE GETTEXT WITH FULL QUERY..."
strXmlFile = "bookstore.xml"
Debug.Print "FILE: " & strXmlFile
strQuery = "/"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
' Gets text for first element named 'title'
strQuery = "//title"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
Debug.Print "Same but using FullQuery"
s = xmlsqFullQuery(strXmlFile, strQuery, 0)
Debug.Print s
Debug.Print "using XMLSQ_RAW"
s = xmlsqFullQuery(strXmlFile, strQuery, XMLSQ_RAW)
Debug.Print s
' Get third element named 'book'
strQuery = "//book[3]"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
' Again using asciify
Debug.Print "using XMLSQ_ASCIIFY"
s = xmlsqGetText(strXmlFile, strQuery, XMLSQ_ASCIIFY)
Debug.Print s
Debug.Print "Same but using FullQuery"
s = xmlsqFullQuery(strXmlFile, strQuery, XMLSQ_ASCIIFY)
Debug.Print s
Debug.Print "Same but using FullQuery and XMLSQ_RAW"
s = xmlsqFullQuery(strXmlFile, strQuery, XMLSQ_ASCIIFY Or XMLSQ_RAW)
Debug.Print s
strQuery = "//title/@lang"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
Debug.Print "Same but using FullQuery"
s = xmlsqFullQuery(strXmlFile, strQuery, XMLSQ_ASCIIFY)
Debug.Print s
Debug.Print "Use the count to query each matching element"
strQuery = "//title"
Debug.Print "Query: " & strQuery
n = xmlsqCount(strXmlFile, strQuery, 0)
Debug.Print "Count = " & n
For i = 1 To n
' Note parentheses around query
strQuery = "(//title)[" & i & "]"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, XMLSQ_ASCIIFY)
Debug.Print s
Next
End Sub
Public Sub Test_Empty()
Dim strXmlFile As String
Dim strQuery As String
Dim s As String
Dim n As Long
Debug.Print vbCrLf & "EMPTY ATTRIBUTES AND ELEMENTS..."
' Specify XML directly in a string
strXmlFile = "<a><b foo=''></b><e /></a>"
Debug.Print "FILE: " & strXmlFile
strQuery = "/"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
Debug.Print "NOTE: a missing attribute (or element) returns the same result as an empty one"
Debug.Print "Use xmlsqCount to tell the difference..."
' Get value of attribute foo
strQuery = "a/b/@foo"
Debug.Print "Query: " & strQuery & " (exists but empty)"
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print "'" & s & "'" ' use quotes for clarity
' Get value of attribute missing attribute baz
strQuery = "a/b/@baz"
Debug.Print "Query: " & strQuery & " (missing)"
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print "'" & s & "'" ' use quotes for clarity
' To tell the difference, use count
strQuery = "a/b/@foo"
Debug.Print "Query: " & strQuery
n = xmlsqCount(strXmlFile, strQuery, 0)
Debug.Print "Count = " & n & " (expecting 1)"
Debug.Assert 1 = n
strQuery = "a/b/@baz"
Debug.Print "Query: " & strQuery
n = xmlsqCount(strXmlFile, strQuery, 0)
Debug.Print "Count = " & n & " (expecting 0)"
Debug.Assert 0 = n
Debug.Print "Similarly for the empty element e"
strQuery = "//e"
Debug.Print "Query: " & strQuery & " (exists but empty)"
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print "'" & s & "'" ' use quotes for clarity
n = xmlsqCount(strXmlFile, strQuery, 0)
Debug.Print "Count = " & n & " (expecting 1)"
Debug.Assert 1 = n
End Sub
Public Sub Test_Whitespace()
Dim strXmlFile As String
Dim strQuery As String
Dim s As String
Dim n As Long
Debug.Print vbCrLf & "EMPTY ATTRIBUTES AND ELEMENTS..."
' Specify XML directly in a string
strXmlFile = "<a foo = ' val de ri '> hello world </a>"
Debug.Print "FILE: " & strXmlFile
strQuery = "/a"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print "'" & s & "'" ' use quotes for clarity
Debug.Print "-- with Trim option (note internal whitespace of element content is unchanged)"
s = xmlsqGetText(strXmlFile, strQuery, XMLSQ_TRIM)
Debug.Print "'" & s & "'" ' use quotes for clarity
strQuery = "/a/@foo"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print "'" & s & "'" ' use quotes for clarity
Debug.Print "-- with Trim option (note internal whitespace of attribute value is collapsed)"
s = xmlsqGetText(strXmlFile, strQuery, XMLSQ_TRIM)
Debug.Print "'" & s & "'" ' use quotes for clarity
End Sub
Public Sub Test_Arithmetic()
Dim strXmlFile As String
Dim strQuery As String
Dim s As String
Debug.Print vbCrLf & "EVALUATE XPATH ARITHMETIC EXPRESSIONS..."
' To evaluate an XPath 1.0 arithmetic expression,
' pass dummy XML data in strXmlFile, e.g. "<a/>"
strQuery = "3 + 5 div 2"
Debug.Print "Query: " & strQuery
s = xmlsqFullQuery("<a/>", strQuery, 0)
Debug.Print s
strQuery = "14 mod 3"
Debug.Print "Query: " & strQuery
s = xmlsqFullQuery("<a/>", strQuery, 0)
Debug.Print s
End Sub
Public Sub Test_Errors()
Dim strXmlFile As String
Dim strQuery As String
Dim s As String
Debug.Print vbCrLf & "TEST FOR ERRORS..."
strXmlFile = "bookstore.xml"
Debug.Print "FILE: " & strXmlFile
' Errors
Debug.Print "EXPECTING ERRORS..."
strQuery = "///badquery"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
strQuery = "3 + 5/2"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
strXmlFile = "notxml.txt"
Debug.Print "FILE: " & strXmlFile
strQuery = "/"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
strXmlFile = "missing.file"
Debug.Print "FILE: " & strXmlFile
strQuery = "/"
Debug.Print "Query: " & strQuery
s = xmlsqGetText(strXmlFile, strQuery, 0)
Debug.Print s
End Sub