' Yee Hsu
' 9/4/2004
'
' List all files
' Determine if file is XML validated
' Combine XML files into giant XML file

Option Explicit

Main

Sub Main

        Const ForReading        = 1
        Const ForWriting        = 2
        Const ForAppending      = 8
        Const XMLFileName       = "CombineXML.xml"
        Const LOGFileName       = "CombineXML.txt"

        Dim Path, Valid, FileName, WSHShell, TempFile, xmlDoc, xmlLog, xmlTmp, xmlBuf
        
        Set WSHShell = WScript.CreateObject("WScript.Shell")
        Set TempFile = WScript.CreateObject("Scripting.FileSystemObject")       

        Select Case WScript.Arguments.Count
                Case 0: Path = "*.*"            ' list current directory
                Case 1: Path = WScript.Arguments(0)
                Case Else: WScript.Echo "Invalid number of arguments.": Exit Sub
        End Select
        Dim a: a = ListDir(Path)

        If UBound(a) = -1 then
                WScript.Echo "No XML files found."
                Exit Sub
        End If
        
        ' Delete the old XML file
        If TempFile.FileExists(XMLFileName) Then
                TempFile.DeleteFile XMLFileName, True
        End If
        
        ' Delete old log file
        If TempFile.FileExists(LOGFileName) Then
                TempFile.DeleteFile LOGFileName, True
        End If  
        
        TempFile.CreateTextFile(XMLFileName)
        TempFile.CreateTextFile(LOGFileName)
                
        Set xmlDoc = TempFile.OpenTextFile(XMLFileName, ForWriting)
        Set xmlLog = TempFile.OpenTextFile(LOGFileName, ForWriting)
                
        ' Create XML header
        xmlDoc.WriteLine "<OesisXML>"

        For Each FileName In a
                'WScript.Echo FileName
                Valid = ValidateAsXmlFile(FileName)
                
                If Valid = 0 Then
                        xmlLog.WriteLine now & " : " & "XML VALIDATED - " & FileName
                        
                        'XML file is validated, thus append to BIG XML file
                        Set xmlTmp = TempFile.OpenTextFile(FileName, ForReading)
                        
                        xmlBuf = xmlTmp.ReadAll
                        xmlDoc.Write xmlBuf
                        xmlDoc.WriteLine
                        xmlTmp.Close
                        
                Else
                        xmlLog.WriteLine now & " : " & "------> ERROR NOT VALID - " & FileName
                End If
        Next
        
        ' End with XML Footer
        xmlDoc.WriteLine "</OesisXML>"
        xmlDoc.Close
        xmlLog.Close
End Sub

' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply
' as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
Public Function ListDir (ByVal Path)
   Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
   If Path = "" then Path = "*.*"
   Dim Parent, Filter
   if fso.FolderExists(Path) then     ' Path is a directory
      Parent = Path
      Filter = "*"
     Else
      Parent = fso.GetParentFolderName(Path)
      If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else Parent = "."
      Filter = fso.GetFileName(Path)
      If Filter = "" Then Filter = "*"
      End If
   ReDim a(10)
   Dim n: n = 0
   Dim Folder: Set Folder = fso.GetFolder(Parent)
   Dim Files: Set Files = Folder.Files
   Dim File
   For Each File In Files
      If CompareFileName(File.Name,Filter) Then
         If n > UBound(a) Then ReDim Preserve a(n*2)
         a(n) = File.Path
         n = n + 1
         End If
      Next
   ReDim Preserve a(n-1)
   ListDir = a
End Function

' Validates the XML file
Function ValidateAsXmlFile(strFileName)
    DIM xmlDoc, strResult
    Set xmlDoc = CreateObject("Msxml2.DOMDocument.5.0")
    xmlDoc.validateOnParse = True
    xmlDoc.async = False
    xmlDoc.load(strFileName)

    Select Case xmlDoc.parseError.errorCode

       Case 0 
            strResult = 0

            'strResult = "Valid: " & strFileName & vbCr
       Case Else
            strResult = -1


           '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

    Set xmlDoc = Nothing
    ValidateAsXmlFile = strResult
End  Function


Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
   CompareFileName = False
   Dim np, fp: np = 1: fp = 1
   Do
      If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
      If Mid(Filter,fp) = ".*" Then       ' special case: ".*" at end of filter
         If np > Len(Name) Then CompareFileName = True: Exit Function
         End If
      Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
      Select Case fc
         Case "*"
            CompareFileName = CompareFileName2(name,np,filter,fp)
            Exit Function
         Case "?"
            If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
         Case Else
            If np > Len(Name) Then Exit Function
            Dim nc: nc = Mid(Name,np,1): np = np + 1
            If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
         End Select
      Loop
End Function

Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
   Dim fp: fp = fp0
   Dim fc2
   Do
      If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
      If Mid(Filter,fp) = ".*" Then    ' special case: ".*" at end of filter
         CompareFileName2 = True: Exit Function
         End If
      fc2 = Mid(Filter,fp,1): fp = fp + 1
      If fc2 <> "*" And fc2 <> "?" Then Exit Do
      Loop
   Dim np
   For np = np0 To Len(Name)
      Dim nc: nc = Mid(Name,np,1)
      If StrComp(fc2,nc,vbTextCompare)=0 Then
         If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
            CompareFileName2 = True: Exit Function
                End If
                End If
      Next
   CompareFileName2 = False
End Function