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. <www.di-mgt.com.au> <www.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://www.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