Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

169 lines
5.2 KiB

  1. Attribute VB_Name = "HelpImagePopulater"
  2. Option Explicit
  3. Private Const HHT_ELEMENT_METADATA_C As String = "METADATA"
  4. Private Const HHT_ELEMENT_HELPIMAGE_C As String = "HELPIMAGE"
  5. Private Const HHT_ELEMENT_HELPFILE_C As String = "HELPFILE"
  6. Private Const HHT_FULL_ELEMENT_TAXONOMY_ENTRY_C As String = "METADATA/TAXONOMY_ENTRIES/TAXONOMY_ENTRY"
  7. Private Const HHT_ATTR_ACTION_C As String = "ACTION"
  8. Private Const HHT_ATTR_CHM_C As String = "CHM"
  9. Private Const HHT_ATTR_URI_C As String = "URI"
  10. Private Const HHT_VALUE_ADD_C As String = "ADD"
  11. Private Const CHM_SIG_C As String = ".chm::/"
  12. Private Const CHM_EXT_C As String = ".chm"
  13. Private Const LISTED_FILE_C As Long = 1
  14. Private Const DERIVED_FILE_C As Long = 2
  15. Public Sub PopulateHelpImage( _
  16. ByVal i_strFolder As String _
  17. )
  18. Dim DOMDocPkgDesc As MSXML2.DOMDocument
  19. Dim DOMNodeHHT As MSXML2.DOMDocument
  20. Dim dictHelpFiles As Scripting.Dictionary
  21. Dim intNumHHTs As Long
  22. Dim intIndex As Long
  23. Dim strFile As String
  24. frmMain.Output "Populating HelpImage...", LOGGING_TYPE_NORMAL_E
  25. Set DOMDocPkgDesc = GetPackageDescription(i_strFolder)
  26. intNumHHTs = GetNumberOfHHTsListedInPackageDescription(DOMDocPkgDesc)
  27. For intIndex = 1 To intNumHHTs
  28. strFile = GetNthHHTListedInPackageDescription(DOMDocPkgDesc, intIndex)
  29. frmMain.Output "File: " & strFile, LOGGING_TYPE_NORMAL_E
  30. strFile = i_strFolder & "\" & strFile
  31. Set DOMNodeHHT = GetFileAsDomDocument(strFile)
  32. DOMNodeHHT.setProperty "SelectionLanguage", "XPath"
  33. Set dictHelpFiles = New Scripting.Dictionary
  34. p_GetHelpFiles DOMNodeHHT, dictHelpFiles
  35. p_GetDerivedHelpFiles DOMNodeHHT, dictHelpFiles
  36. p_PutHelpFiles DOMNodeHHT, dictHelpFiles
  37. DOMNodeHHT.save strFile
  38. Next
  39. End Sub
  40. Private Sub p_GetHelpFiles( _
  41. ByVal i_DOMNodeHHT As MSXML2.DOMDocument, _
  42. ByVal u_dict As Scripting.Dictionary _
  43. )
  44. Dim DOMNodeHelpImage As MSXML2.IXMLDOMNode
  45. Dim DOMNode As MSXML2.IXMLDOMNode
  46. Dim strHelpFile As String
  47. u_dict.CompareMode = TextCompare
  48. Set DOMNodeHelpImage = i_DOMNodeHHT.selectSingleNode(HHT_ELEMENT_METADATA_C & "/" & HHT_ELEMENT_HELPIMAGE_C)
  49. If (Not DOMNodeHelpImage Is Nothing) Then
  50. For Each DOMNode In DOMNodeHelpImage.childNodes
  51. strHelpFile = XMLGetAttribute(DOMNode, HHT_ATTR_CHM_C)
  52. If (Not u_dict.Exists(strHelpFile)) Then
  53. u_dict.Add strHelpFile, LISTED_FILE_C
  54. End If
  55. Next
  56. End If
  57. End Sub
  58. Private Sub p_GetDerivedHelpFiles( _
  59. ByVal i_DOMNodeHHT As MSXML2.DOMDocument, _
  60. ByVal u_dict As Scripting.Dictionary _
  61. )
  62. Dim DOMNodeList As MSXML2.IXMLDOMNodeList
  63. Dim DOMNode As MSXML2.IXMLDOMNode
  64. Dim strURI As String
  65. Dim strHelpFile As String
  66. u_dict.CompareMode = TextCompare
  67. Set DOMNodeList = i_DOMNodeHHT.selectNodes(HHT_FULL_ELEMENT_TAXONOMY_ENTRY_C)
  68. If (Not DOMNodeList Is Nothing) Then
  69. For Each DOMNode In DOMNodeList
  70. DoEvents
  71. strURI = XMLGetAttribute(DOMNode, HHT_ATTR_URI_C)
  72. strHelpFile = p_GetHelpFile(strURI)
  73. If (strHelpFile <> "") And (Not u_dict.Exists(strHelpFile)) Then
  74. u_dict.Add strHelpFile, DERIVED_FILE_C
  75. End If
  76. Next
  77. End If
  78. End Sub
  79. Private Function p_GetHelpFile( _
  80. ByVal i_strURI As String _
  81. ) As String
  82. Dim strHelpFile As String
  83. Dim strURI As String
  84. Dim i As Long
  85. Dim j As Long
  86. strURI = LCase$(i_strURI)
  87. i = InStr(strURI, CHM_SIG_C)
  88. If (i = 0) Then
  89. GoTo LEnd
  90. End If
  91. j = InStrRev(strURI, "\", i)
  92. If (j = 0) Then
  93. GoTo LEnd
  94. End If
  95. strHelpFile = Mid$(strURI, j + 1, i - j - 1) & CHM_EXT_C
  96. LEnd:
  97. If ((strHelpFile = "") And (strURI <> "")) Then
  98. frmMain.Output "URI ignored: " & i_strURI, LOGGING_TYPE_WARNING_E
  99. End If
  100. p_GetHelpFile = strHelpFile
  101. End Function
  102. Private Sub p_PutHelpFiles( _
  103. ByVal u_DOMNodeHHT As MSXML2.DOMDocument, _
  104. ByVal i_dict As Scripting.Dictionary _
  105. )
  106. Dim DOMNodeHelpImage As MSXML2.IXMLDOMNode
  107. Dim Element As MSXML2.IXMLDOMElement
  108. Dim vntHelpFile As Variant
  109. Set DOMNodeHelpImage = u_DOMNodeHHT.selectSingleNode(HHT_ELEMENT_METADATA_C & "/" & HHT_ELEMENT_HELPIMAGE_C)
  110. If (DOMNodeHelpImage Is Nothing) Then
  111. Dim DOMNodeMetaData As MSXML2.IXMLDOMNode
  112. If (i_dict.Count = 0) Then
  113. Exit Sub
  114. End If
  115. Set DOMNodeMetaData = u_DOMNodeHHT.selectSingleNode(HHT_ELEMENT_METADATA_C)
  116. Set Element = u_DOMNodeHHT.createElement(HHT_ELEMENT_HELPIMAGE_C)
  117. DOMNodeMetaData.appendChild Element
  118. Set DOMNodeHelpImage = Element
  119. End If
  120. For Each vntHelpFile In i_dict.Keys
  121. If (i_dict(vntHelpFile) = DERIVED_FILE_C) Then
  122. Set Element = u_DOMNodeHHT.createElement(HHT_ELEMENT_HELPFILE_C)
  123. XMLSetAttribute Element, HHT_ATTR_ACTION_C, HHT_VALUE_ADD_C
  124. XMLSetAttribute Element, HHT_ATTR_CHM_C, vntHelpFile
  125. DOMNodeHelpImage.appendChild Element
  126. End If
  127. Next
  128. End Sub