Validate XML to a DTD (VBScript)

 

When using Internet Explorer to load files, you can check for DTD errors, but to use your DTD to validate an XML file, you need to set the value of validateOnParse to True prior to loading a file into the XML DOM. (Internet Explorer leaves this property set to False as its default for loading XML file types.)

The following VBScript example includes the following:

  • An external DTD file.

  • An XML file, books.xml, that is well-formed but contains a validation error.

  • A Windows batch file written in VBScript. This file loads and validates either an XML file or a folder tree containing XML file types, and returns the validation results.

<!ELEMENT catalog    (book+) >
<!ELEMENT book       (author, title, genre, price, publish_date, description) >
<!ATTLIST book       id ID #REQUIRED >
<!ELEMENT author         (#PCDATA)   >
<!ELEMENT title          (#PCDATA)   >
<!ELEMENT genre          (#PCDATA)   >
<!ELEMENT price          (#PCDATA)   >
<!ELEMENT publish_date   (#PCDATA)   >
<!ELEMENT description    (#PCDATA)   >

<?xml version="1.0"?>
<!DOCTYPE catalog SYSTEM "books.dtd">
<catalog>
   <book id="bk101">
      <author>Gambardella, Matthew</author>
      <title>XML Developer's Guide</title>
      <genre>Computer</genre>
<!-- The following line is not valid according to books.dtd. -->
      <cost>44.95</cost>
      <publish_date>2000-10-01</publish_date>
      <description>An in-depth look at creating applications with
      XML.</description>
   </book>
</catalog>

Option Explicit

' Initialize global objects and variables.
Dim fso, f, file, folder, filepath, dir, coll
Dim fspec, strFileName, shortName, strResult
Dim LineOfEquals, strFile, strFiles, strFileExt
Dim Files, StartingFolder, WshShell, strDesktop
Dim S, SubFolders, SubFolder, procFilesCount
Dim xmlDoc, state
Dim sLogPath

'Set global constants and variables.
Const OpenFileForAppending = 8 
LineOfEquals = "=============================================" & vbCrLf

set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
Set fso = CreateObject("Scripting.FileSystemObject")
sLogPath = strDesktop & "\msval.txt"

Sub ShowHelp
    Wscript.Echo vbCrLf & _
    "About:" & Chr(9) & "Msval.vbs is an XML file validator." & vbCrLf & _
    vbCrLf & _
    "Syntax:" & Chr(9) & "msval [input_file_or_folder]" & vbCrLf & _
    vbCrLf & _
    "Examples:" & vbCrLf & vbCrLf & _
    Chr(9) & "msval my.xml" & vbCrLf & _
    Chr(9) & "msval C:\MyFolderContainingXML" & vbCrLf & _
    Chr(9) & "msval ..\..\MyFolderContainingXML" & vbCrLf & vbCrLf & _
    "Notes:" & Chr(9) & "If XML file is specified, results are " & _
    "returned in a console message." & vbCrLf & vbCrLf & _
    Chr(9) & "If a folder is specified, a report file, Msval.txt," & _
    " is generated" & vbCrLf & _
    Chr(9) & "on your desktop and validation results are recursive" & _
    " for XML" & vbCrLf & _
    Chr(9) & "files found in the specified folder and all of its" & _
    " subfolders." & vbCrLf
    Exit Sub
End Sub

Sub ErrorOut
    Wscript.Echo (vbCrLf & "Status: MSVAL failed." + vbCr)
    Wscript.Quit
End Sub

Sub ValidateAsXmlFile
    Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")
    xmlDoc.setProperty "ProhibitDTD", False
    xmlDoc.setProperty "ResolveExternals", True 

    xmlDoc.validateOnParse = True
    xmlDoc.async = False
    xmlDoc.load(strFileName)
    Select Case xmlDoc.parseError.errorCode
       Case 0 
            strResult = "Valid: " & strFileName & vbCr
       Case Else
           strResult = vbCrLf & "ERROR! Failed to validate " & _
           strFileName & vbCrLf & xmlDoc.parseError.reason & vbCr & _
          "Error code: " & xmlDoc.parseError.errorCode & ", Line: " & _
                           xmlDoc.parseError.line & ", Character: " & _
                           xmlDoc.parseError.linepos & ", Source: " & _
                           Chr(34) & xmlDoc.parseError.srcText & _
                           Chr(34) & " - " & Now & vbCrLf 
    End Select

' Create log file for storing results when validatin multiple files.
    Set f = fso.OpenTextFile(sLogPath, OpenFileForAppending)
    f.WriteLine strResult
    f.Close

    ' Increment processed files count.
    procFilesCount = procFilesCount + 1
    'Release DOM document object
    Set xmlDoc = Nothing
End Sub

Function WalkSubfolders(Folder)
    Dim strFolder, currentFolder, strCurPath
    Set currentFolder = fso.GetFolder(Folder)
    strCurPath = currentFolder.Path
    strFolder = vbCrLf & LineOfEquals & _
                "Folder: " & strCurPath & _
                vbCrLf & LineOfEquals & vbCrLf

    ' Open the log file and append current subfolder.
    Set f = fso.OpenTextFile(sLogPath, OpenFileForAppending)
    f.Write strFolder
    f.Close
    strFolder = ""
    Set Files = currentFolder.Files
    If Files.Count <> 0 Then
      ' Walk the collection. If the file is XML, 
      ' load and validate it.
      For Each File In Files
         strFileName = fso.GetAbsolutePathName(File)
         strFileExt = Right(strFileName,4)
         Select Case strFileExt
           ' Process all known XML file types.
           Case ".xml" ValidateAsXmlFile
           Case ".xsl" ValidateAsXmlFile
           Case ".xsd" ValidateAsXmlFile
           Case Else
         End Select
      Next
    End If

    ' Open the log file and append file list from current subfolder.
    Set f = fso.OpenTextFile(sLogPath, OpenFileForAppending)
    f.Write strFiles
    f.Close
    strFiles  = ""

    Set SubFolders = currentFolder.SubFolders

    If SubFolders.Count <> 0 Then
       For Each SubFolder In SubFolders
          strFolder = strFolder & WalkSubfolders(SubFolder)
       Next
       strFolder = strFolder & vbCr
    End If
End Function

Sub WriteEOFSummary
    Set f = fso.OpenTextFile(sLogPath, OpenFileForAppending)
    strResult = vbCrLf & LineofEquals & _
               "Processing completed at " & Now & vbCrLf & _
               procFilesCount & " files processed" & vbCrLf & _
               LineOfEquals
    f.Write strResult
    f.Close
    strResult = "Results written to " & sLogPath & vbCrLf & _
               "Files processed: " & procFilesCount & vbCrLf & _
               vbCrLf & "Do you want to view the results now?"
    MsgBox strResult, vbYesNo, "MSVAL: Processing completed"
    If vbYes Then
       WshShell.Run ("%windir%\notepad " & sLogPath)
    End If
End Sub

Function ProcessStandAloneFile(sFile)
    Dim basename, str, xdoc
    Set f = fso.GetFile(fspec)
    basename = f.Name
    ' Load XML input file & validate it
    Set xdoc = CreateObject("Msxml2.DOMDocument.6.0")
    xdoc.setProperty "ProhibitDTD", False
    xdoc.setProperty "ResolveExternals", True
    xdoc.validateOnParse = True
    xdoc.async = False
    xdoc.load(fspec)
    If xdoc.parseError.errorCode = 0 Then
       str = basename & " is valid"
    ElseIf xdoc.parseError.errorCode <> 0 Then
       str = basename & " is not valid" & vbCrLf & _
       xdoc.parseError.reason & " URL: " & Chr(9) & _
       xdoc.parseError.url & vbCrLf & "Code: " & Chr(9) & _
       xdoc.parseError.errorCode & vbCrLf & "Line: " & _
       Chr(9) & xdoc.parseError.line & vbCrLf & _
       "Char: "  & Chr(9) & xdoc.parseError.linepos & vbCrLf & _
       "Text: "  & Chr(9) & xdoc.parseError.srcText
    End If
    ProcessStandAloneFile = str
End Function

Sub Main
    'Initialize files count
    procFilesCount = 0

    ' Get the folder to scan for files.
    If Wscript.Arguments.Length > 0 Then
       fSpec = Wscript.Arguments.Item(0)
       fSpec = fSpec & "\"
    Else
       ShowHelp
       WScript.Quit
    End If

    fspec = fso.GetAbsolutePathName(fspec)
    If fso.FileExists(fspec) Then
       strResult = ProcessStandAloneFile(fspec)
       Wscript.Echo strResult
       Wscript.Quit
    ElseIf fso.FolderExists(fspec) Then
       ' Executes a 'DIR' command into a collection.
       Set dir = fso.GetFolder(fspec)
       Set coll = dir.Files
       ' Create the log file on the user's desktop.
       Set f = fso.CreateTextFile(sLogPath, 1)
       strResult = vbCrLf & LineofEquals & sLogPath & _
           " at " & Now & vbCrLf & LineOfEquals & vbCrLf
       f.Write strResult
       f.Close
       WalkSubfolders(fSpec)
    Else
       strResult = vbCrLf & "Input file or folder " & _
                   fspec & " does not exist."
       MsgBox strResult, vbOKOnly, _
             "MSVAL: File or folder doesn't exist"
        ErrorOut
    End If

    WriteEOFSummary

    ' Reset object variables.
    Set fso = Nothing
    Set xmlDoc = Nothing

End Sub

Main

Try It!

  1. Open Notepad.

  2. Copy books.dtd from the code listed above. Paste it into the Notepad window.

  3. From the File menu, click Save As. Save the file as books.dtd to a folder on your computer.

  4. Copy books-well-formed.xml from the code listed above. Paste it into the Notepad window.

  5. From the File menu, click Save As. Save the file as books-well-formed.xml to the same folder in which you saved books.dtd.

  6. Copy msval.vbs from the code listed above. Paste it into the Notepad window.

  7. From the File menu, click Save As. Save the file as msval.vbs to the same folder you used for saving files in steps 3 and 5.

  8. If needed, open Windows Explorer and browse to the folder used in steps 1 through 6.

  9. To validate books-well-formed.xml, drag and drop it on msval.vbs.

A message box should appear with content similar to the following, indicating that books-well-formed.xml is not valid according to its DTD, books.dtd.

books-well-formed.xml is not valid  
Element 'cost' is unexpected  according to content model of parent element 'book'.  
Expecting: price.  
URL:   file:///C:/temp/books-well-formed.xml  
Code:   -1072898028  
Line:   9  
Char:   13  
  
Text:         <cost>44.95</cost>  

The script can also perform validation on multiple XML files with .xml, .xsd, or .xsl extensions. It can be used at the command prompt to perform batch validation as well. For more information, double-click the msval.vbs on your machine to view command help.

Show: