Attribute VB_Name = "MissingToolChecker"
Option Explicit

Private m_NextInternalMacroToolID As Long  ' Next tool id for macros, to use (Use TOOLCHECK_GetFreeMacroId() and TOOLCHECK_FreeMacroId())
Private m_MacroIdFreedList As New Collection  ' Collection used to hold Macro Ids which have been freed

Private Const TOOLCHECK_INTERNALTOOLIDSTART = 1 ' This range is arbitrary - but is a useable range within SA
Private Const TOOLCHECK_INTERNALTOOLIDEND = 998 ' This range is arbitrary - but is a useable range within SA
Private m_NextInternalToolToolID As Long  ' Next tool id for tools, to use (Use TOOLCHECK_GetFreeToolId() and TOOLCHECK_FreeToolId())
Private m_ToolIdFreedList As New Collection  ' Collection used to hold Tool Ids which have been freed

Private m_objXMLDoc As DOMDocument

Private m_blnDirty As Boolean

Public Sub TOOLCHECK_LoadTBF(ByVal v_strToolbarFile As String)
    If Not CmdLineToolCheck Then Exit Sub
    
    Set m_objXMLDoc = New DOMDocument
    Dim objNodes As IXMLDOMNodeList
    Dim objNode As IXMLDOMElement
    Dim lngMacroMin As Long
    Dim lngMacroMax As Long
    Dim lngGeneralMin As Long
    Dim lngGeneralMax As Long
    Dim lngToolID As Long
    Dim arrblnIDs(0 To 100000) As Boolean
    Dim lngIndex As Long
    Dim lngNext As Long
    Dim strCaption As String
    Dim strName As String
    Dim strPath As String
    
    ' Check that ppxml.exe is available;  if not the output will be unformatted and more difficult to diff - so show a warning.
    Dim oFSO As New FileSystemObject
    
    
    strPath = GetExePath()
    If (Not oFSO.FileExists(oFSO.BuildPath(strPath, "ppxml.exe"))) Then  'DEV_STRING
        SAMessageBox "Could not find ppxml.exe in " & strPath & " - the output file will not be formatted." _
          & vbCrLf & vbCrLf & "To improve the quality of the output from ToolCheck, place ppxml.exe in the directory shown above."  'DEV_STRING
    End If
    Set oFSO = Nothing

    m_blnDirty = False
    
    m_objXMLDoc.async = False
    Call m_objXMLDoc.SetProperty("SelectionLanguage", "XPath")    'DEV_STRING Ensure all XPath is available
    
    lngMacroMin = NEXTINTERNALMACROIDEND
    lngMacroMax = NEXTINTERNALMACROIDSTART
    
    lngGeneralMin = TOOLCHECK_INTERNALTOOLIDEND
    lngGeneralMax = TOOLCHECK_INTERNALTOOLIDSTART
    
    m_NextInternalMacroToolID = NEXTINTERNALMACROIDSTART  ' Macro's are renumbered at SA startup
    Set m_MacroIdFreedList = New Collection
    
    m_NextInternalToolToolID = TOOLCHECK_INTERNALTOOLIDSTART
    Set m_ToolIdFreedList = New Collection
    
    ' Prep the macro id generator - THIS IS ONLY USED IN THIS MODULE - DO NOT CONFUSE WITH SA's REAL CODE
    If m_objXMLDoc.Load(v_strToolbarFile) Then
        Set objNodes = m_objXMLDoc.selectNodes("//SATools/SATool") 'DEV_STRING
        
        For lngIndex = objNodes.Length - 1 To 0 Step -1
            Set objNode = objNodes(lngIndex)
            lngToolID = objNode.getAttribute("ToolID") 'DEV_STRING
            strName = objNode.getAttribute("Name") 'DEV_STRING
            strCaption = objNode.getAttribute("Caption") 'DEV_STRING
        
            If Not IsDrawingTool(lngToolID) Then
                If Not IsSpecialTool(lngToolID) And lngToolID >= 0 Then
                    If IsMacroTool(lngToolID) Then
                        If lngToolID > lngMacroMax And lngToolID < NEXTINTERNALMACROIDEND Then
                            lngMacroMax = lngToolID
                        End If
                        If lngToolID < lngMacroMin And lngToolID > NEXTINTERNALMACROIDSTART Then
                            lngMacroMin = lngToolID
                        End If
                    Else
                        If lngToolID > lngGeneralMax And lngToolID < TOOLCHECK_INTERNALTOOLIDEND Then
                            lngGeneralMax = lngToolID
                        End If
                        If lngToolID < lngGeneralMin And lngToolID > TOOLCHECK_INTERNALTOOLIDSTART Then
                            lngGeneralMin = lngToolID
                        End If
                    End If
                    arrblnIDs(lngToolID) = True ' Mark the tool as used
                End If
            End If
        Next

        For lngIndex = NEXTINTERNALMACROIDSTART To lngMacroMax
            If Not arrblnIDs(lngIndex) Then
                TOOLCHECK_FreeMacroId lngIndex    ' This is a hole in the id ranges
            End If
        Next
        m_NextInternalMacroToolID = lngMacroMax + 1
        
        For lngIndex = TOOLCHECK_INTERNALTOOLIDSTART To lngGeneralMax
            If Not arrblnIDs(lngIndex) Then
                TOOLCHECK_FreeToolId lngIndex    ' This is a hole in the id ranges
            End If
        Next
        m_NextInternalToolToolID = lngGeneralMax + 1
    End If
End Sub

Public Sub TOOLCHECK_SaveTBF(ByVal v_strToolbarXMLFile As String)
    If Not CmdLineToolCheck Or m_objXMLDoc Is Nothing Then Exit Sub
    
    Dim objTempXMLDoc As DOMDocument
    Dim objNode As IXMLDOMNode
    Dim objVBUtils As New SAVBUtils.SAUtilities
    Dim strError As String
    Dim objFSO As New FileSystemObject
    
    Set objTempXMLDoc = m_objXMLDoc
    
    If m_blnDirty Then
        objTempXMLDoc.Save GetExePath() & "\temp.xml" 'DEV_STRING
        
        On Error Resume Next
        Kill v_strToolbarXMLFile & ".BAK" 'DEV_STRING
        FileCopy v_strToolbarXMLFile, v_strToolbarXMLFile & ".BAK" 'DEV_STRING
        Kill v_strToolbarXMLFile    ' Ensure the file is not there
        objVBUtils.SA_ShellAndWaitForTermination GetExePath() & "\ppxml -a """ & GetExePath() & "\temp.xml""" & " """ & v_strToolbarXMLFile & """", vbHide, strError, 60000 'DEV_STRING
        
        
        If Not objFSO.FileExists(v_strToolbarXMLFile) Then
            ' If the prettifier failed then just copy the unpretty version across
            FileCopy GetExePath() & "\temp.xml", v_strToolbarXMLFile 'DEV_STRING
        End If
        Kill GetExePath() & "\temp.xml"     'DEV_STRING Delete the temp file
        
        If CmdLineQAReporting Then
            SAMessageBox "Tools have been placed in the menu system which were not in the master toolbar file. If ONLY SA shipped macros were used, then the master TBF may be incomplete. Please forward :" & vbCrLf & v_strToolbarXMLFile & " to development." 'DEV_STRING
        End If
    End If
End Sub

Public Sub TOOLCHECK_ToolChanged(ByRef r_objTool As SAToolbarTool)
    If Not CmdLineToolCheck Or m_objXMLDoc Is Nothing Then Exit Sub
    
    Dim objReNameTools As IXMLDOMNodeList
    Dim objReNameTool As IXMLDOMElement
    Dim strReName As String
    Dim objTool As IXMLDOMElement
    Dim strMaster As String
    Dim strNew As String
    Dim lngPos As Long
    Dim strMacroArgs As String
    
    Set objTool = m_objXMLDoc.selectSingleNode("//SAToolbar/SATools/SATool[@Name='" & r_objTool.Name & "']") 'DEV_STRING
    
    If Not objTool Is Nothing Then
        ' Check the caption
        strMaster = objTool.getAttribute("Caption") 'DEV_STRING
        strMaster = CleanMenuID(strMaster)
        
        strNew = r_objTool.Caption
        strNew = CleanMenuID(strNew)
        
        If strNew <> strMaster Then
            Call objTool.setAttribute("Caption", r_objTool.Caption) 'DEV_STRING
            
            If IsMacroTool(r_objTool.toolID) Then
                ' This is a macro tool
                lngPos = InStr(1, r_objTool.Name, ":") 'DEV_STRING
                If lngPos > 0 Then
                    ' This macro tool has a parameter - so ensure the :caption  part is corrected
                    Set objReNameTools = m_objXMLDoc.selectNodes("//node()[@Name='" & r_objTool.Name & "']") 'DEV_STRING
                    strReName = Left(r_objTool.Name, lngPos - 1) & ":" & UCase(strNew) 'DEV_STRING
                    For Each objReNameTool In objReNameTools
                        objReNameTool.setAttribute "Name", strReName 'DEV_STRING
                    Next
                End If
            End If
            
            m_blnDirty = True
        End If
            
        ' Check the tooltip
        If r_objTool.ToolTipText <> objTool.getAttribute("ToolTipText") Then 'DEV_STRING
            Call objTool.setAttribute("ToolTipText", r_objTool.ToolTipText) 'DEV_STRING
            m_blnDirty = True
        End If
        
        'Check the MacroArgs
        On Error Resume Next
        strMacroArgs = objTool.getAttribute("MacroArgs")    'DEV_STRING
        If r_objTool.MacroArgument <> strMacroArgs Then
            objTool.setAttribute "MacroArgs", r_objTool.MacroArgument
            m_blnDirty = True
        End If
        On Error GoTo 0
    End If
End Sub

Public Sub TOOLCHECK_CreatePopup(ByRef r_objBand As SAToolbarBand)
    If Not CmdLineToolCheck Or m_objXMLDoc Is Nothing Then Exit Sub
    
    Dim objBands As IXMLDOMElement
    Dim objBand As IXMLDOMElement
       
    Set objBand = m_objXMLDoc.selectSingleNode("//SAToolbar/SABands/SABand[@Name='" & r_objBand.BandName & "']") 'DEV_STRING
                
    If objBand Is Nothing Then
        Set objBands = m_objXMLDoc.selectSingleNode("//SAToolbar/SABands") 'DEV_STRING
        Set objBand = m_objXMLDoc.createElement("SABand") 'DEV_STRING
        Set objBand = objBands.insertBefore(objBand, objBands.firstChild)
        
        objBand.setAttribute "Name", r_objBand.BandName 'DEV_STRING
        objBand.setAttribute "Type", "2" 'DEV_STRING
        objBand.setAttribute "Visible", "True" 'DEV_STRING
        objBand.setAttribute "Wrappable", "False" 'DEV_STRING
        
        m_blnDirty = True
    End If
End Sub

Private Function TOOLCHECK_AddToolToMaster(ByRef r_objTool As SAToolbarTool) As Long
    If Not CmdLineToolCheck Or m_objXMLDoc Is Nothing Then Exit Function
    
    Dim lngID As Long
    Dim objTool As IXMLDOMElement
    Dim objTools As IXMLDOMElement
        
    ' Create a new tool
    If IsMacroTool(r_objTool.toolID) Then
        lngID = TOOLCHECK_GetFreeMacroId()
    Else
        lngID = r_objTool.toolID
    End If
    Set objTools = m_objXMLDoc.selectSingleNode("//SAToolbar/SATools") 'DEV_STRING
    Set objTool = m_objXMLDoc.createElement("SATool") 'DEV_STRING
    Set objTool = objTools.appendChild(objTool)

    objTool.setAttribute "Alignment", r_objTool.Alignment 'DEV_STRING
    objTool.setAttribute "Caption", r_objTool.Caption 'DEV_STRING
    objTool.setAttribute "Category", r_objTool.Category 'DEV_STRING
    objTool.setAttribute "Checked", CStr(CBool(r_objTool.Checked)) 'DEV_STRING
    objTool.setAttribute "Description", r_objTool.Description 'DEV_STRING
    objTool.setAttribute "Enabled", CStr(CBool(r_objTool.Enabled)) 'DEV_STRING
    objTool.setAttribute "HelpContextID", r_objTool.HelpContextID 'DEV_STRING
    objTool.setAttribute "IsAccessControlled", "True" 'DEV_STRING
    objTool.setAttribute "MacroArgs", r_objTool.MacroArgument 'DEV_STRING
    objTool.setAttribute "Name", r_objTool.Name 'DEV_STRING
    objTool.setAttribute "ShortcutKey", "" 'DEV_STRING
    objTool.setAttribute "Style", r_objTool.Style 'DEV_STRING
    objTool.setAttribute "SubBand", r_objTool.SubBandName 'DEV_STRING
    objTool.setAttribute "Text", "" 'DEV_STRING
    objTool.setAttribute "ToolID", lngID 'DEV_STRING
    objTool.setAttribute "ToolTipText", r_objTool.ToolTipText 'DEV_STRING
    objTool.setAttribute "Visible", "False" 'DEV_STRING
    
    TOOLCHECK_AddToolToMaster = lngID

    m_blnDirty = True
End Function

Public Sub TOOLCHECK_AddTool(ByRef r_objTools As SAToolbarTools, ByRef r_objTool As SAToolbarTool, Optional ByVal v_strBeforeToolCaption As String = "") 'DEV_STRING
    If Not CmdLineToolCheck Or m_objXMLDoc Is Nothing Then Exit Sub
    
    Dim objBand As IXMLDOMElement
    Dim objBands As IXMLDOMNodeList
    Dim strPopUpID As String
    Dim objMenuTool As IXMLDOMElement
    Dim lngPos As Long
    Dim objTool As IXMLDOMElement
    Dim objToolFind As IXMLDOMElement
    Dim objToolBefore As IXMLDOMElement
    Dim blnFound As Boolean
    Dim strToolName As String
    Dim strBandName As String
    Dim lngPos2 As Long
    Dim lngToolID As Long
           
    Set objBand = m_objXMLDoc.selectSingleNode("//SAToolbar/SABands/SABand[@Name='" & r_objTools.BandName & "']") 'DEV_STRING
                
    If Not objBand Is Nothing Then
        strPopUpID = r_objTools.BandName
    
        Set objTool = m_objXMLDoc.selectSingleNode("//SAToolbar/SATools/SATool[@Name='" & r_objTool.Name & "']") 'DEV_STRING
        
        If objTool Is Nothing Then
            lngToolID = TOOLCHECK_AddToolToMaster(r_objTool)
            Set objTool = m_objXMLDoc.selectSingleNode("//SAToolbar/SATools/SATool[@Name='" & r_objTool.Name & "']") 'DEV_STRING
        Else
            lngToolID = objTool.getAttribute("ToolID") 'DEV_STRING
        End If
        
        Set objToolFind = objBand.selectSingleNode("./SATool[@Name='" & r_objTool.Name & "']") 'DEV_STRING
        
        If (objToolFind Is Nothing) And (Not objTool Is Nothing) Then
            blnFound = False
            If v_strBeforeToolCaption <> SA_VB_EmptyString Then
                For Each objToolBefore In objBand.childNodes
                    If UCase(CleanMenuID(objToolBefore.getAttribute("Caption"))) = UCase(CleanMenuID(v_strBeforeToolCaption)) Then 'DEV_STRING
                        blnFound = True
                        Exit For
                    End If
                Next
            End If
            
            Set objMenuTool = m_objXMLDoc.createElement("SATool") 'DEV_STRING
            
            If Not blnFound Then
                Set objToolBefore = Nothing
                Set objMenuTool = objBand.appendChild(objMenuTool)
            Else
                Set objMenuTool = objToolBefore.parentNode.insertBefore(objMenuTool, objToolBefore)
            End If
            
            objMenuTool.setAttribute "BeginGroup", CStr(r_objTool.BeginGroup) 'DEV_STRING
            objMenuTool.setAttribute "Caption", r_objTool.Caption 'DEV_STRING
            objMenuTool.setAttribute "Name", r_objTool.Name 'DEV_STRING
            objMenuTool.setAttribute "Style", r_objTool.Style 'DEV_STRING
            objMenuTool.setAttribute "SubBand", r_objTool.SubBandName 'DEV_STRING
            objMenuTool.setAttribute "ToolID", lngToolID 'DEV_STRING
        End If
    End If
    
    m_blnDirty = True
End Sub

Private Function TOOLCHECK_GetFreeMacroId() As Long
    If Not CmdLineToolCheck Then Exit Function
  
    If m_MacroIdFreedList.Count > 0 Then
        TOOLCHECK_GetFreeMacroId = m_MacroIdFreedList.Item(1)
        m_MacroIdFreedList.Remove 1 ' No longer available
'    LogMessage "VBA - Re-using macro Tool ID : " + Format(GetFreeMacroId)
    Else
        If m_NextInternalMacroToolID >= NEXTINTERNALMACROIDEND Then
            
            SAMessageBox "TOOLCHECK: Out of macro ids  ABORT", vbOKOnly + vbCritical 'DEV_STRING
            
        Else
            TOOLCHECK_GetFreeMacroId = m_NextInternalMacroToolID
            m_NextInternalMacroToolID = m_NextInternalMacroToolID + 1
    '      LogMessage "VBA - Using New macro Tool ID : " + Format(GetFreeMacroId)
        End If
    End If
    Exit Function
ErrExit:
    ' Not much else we can do
End Function

Private Function TOOLCHECK_FreeMacroId(theID As Long)
    If Not CmdLineToolCheck Then Exit Function

    If theID >= NEXTINTERNALMACROIDSTART And theID <= NEXTINTERNALMACROIDEND Then
        ' Ensure we only remove macro items
        On Error Resume Next
        m_MacroIdFreedList.Add theID, Str(theID)  ' Add the item - don't worry if it already exists
        On Error GoTo 0
        '      LogMessage "VBA - Freeing macro Tool ID : " + Format(theID)
    End If
End Function

Private Function TOOLCHECK_GetFreeToolId() As Long
    If Not CmdLineToolCheck Then Exit Function
  
    If m_ToolIdFreedList.Count > 0 Then
        TOOLCHECK_GetFreeToolId = m_ToolIdFreedList.Item(1)
        m_ToolIdFreedList.Remove (1) ' No longer available
'    LogMessage "VBA - Re-using Tool Tool ID : " + Format(GetFreeToolId)
    Else
        If m_NextInternalToolToolID >= TOOLCHECK_INTERNALTOOLIDEND Then
            
            SAMessageBox "TOOLCHECK: Out of Tool ids - New range required", vbOKOnly + vbCritical 'DEV_STRING
            
        Else
            TOOLCHECK_GetFreeToolId = m_NextInternalToolToolID
            m_NextInternalToolToolID = m_NextInternalToolToolID + 1
    '      LogMessage "VBA - Using New Tool Tool ID : " + Format(GetFreeToolId)
        End If
    End If
    Exit Function
ErrExit:
    ' Not much else we can do
End Function

Private Function TOOLCHECK_FreeToolId(theID As Long)
    If Not CmdLineToolCheck Then Exit Function

    If theID >= TOOLCHECK_INTERNALTOOLIDSTART And theID <= TOOLCHECK_INTERNALTOOLIDEND Then
        ' Ensure we only remove Tool items
        On Error Resume Next
        m_ToolIdFreedList.Add theID, Str(theID)  ' Add the item - don't worry if it already exists
        On Error GoTo 0
        '      LogMessage "VBA - Freeing Tool Tool ID : " + Format(theID)
    End If
End Function


