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.

1137 lines
40 KiB

  1. VERSION 1.0 CLASS
  2. BEGIN
  3. MultiUse = -1 'True
  4. Persistable = 0 'NotPersistable
  5. DataBindingBehavior = 0 'vbNone
  6. DataSourceBehavior = 0 'vbNone
  7. MTSTransactionMode = 0 'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "HHT"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"No"
  16. Option Explicit
  17. Private WithEvents p_clsTaxonomy As Taxonomy
  18. Attribute p_clsTaxonomy.VB_VarHelpID = -1
  19. Private p_clsKeywords As Keywords
  20. Private p_clsStopSigns As StopSigns
  21. Private p_clsStopWords As StopWords
  22. Private Const LCID_ENGLISH As Long = 1033
  23. Private Const PACKAGE_DESCRIPTION As String = "package_description.xml"
  24. Private Const CHQ_C As String = ".chq"
  25. Private Const CHM_C As String = ".chm"
  26. Private Const HHK_C As String = ".hhk"
  27. Private Const TAXONOMY_HHT_C As String = "Taxonomy.hht"
  28. Private Const STOP_SIGNS_HHT_C As String = "StopSigns.hht"
  29. Private Const STOP_WORDS_HHT_C As String = "StopWords.hht"
  30. Private Const SYN_TABLE_HHT_C As String = "SynTable.hht"
  31. Private Const SCOPE_DEFINITION_HHT_C As String = "ScopeDefinition.hht"
  32. Private Const NO_LOC_HHT_C As String = "NoLoc.hht"
  33. Private Const OPERATORS_HHT_C As String = "OperatorEntries.hht"
  34. Private Const START_TAG_C As String = "<A>"
  35. Private Const END_TAG_C As String = "</A>"
  36. Private Const SCOPE_DEFINITION_NODE_C As String = "A/SCOPE_DEFINITION"
  37. Public Event ReportStatus(ByVal strStatus As String, ByRef blnCancel As Boolean)
  38. Private Sub Class_Initialize()
  39. Set p_clsTaxonomy = New Taxonomy
  40. Set p_clsKeywords = New Keywords
  41. Set p_clsStopSigns = New StopSigns
  42. Set p_clsStopWords = New StopWords
  43. End Sub
  44. Private Sub Class_Terminate()
  45. Set p_clsTaxonomy = Nothing
  46. Set p_clsKeywords = Nothing
  47. Set p_clsStopSigns = Nothing
  48. Set p_clsStopWords = Nothing
  49. End Sub
  50. Public Sub GenerateCAB( _
  51. ByVal i_strFileName As String, _
  52. ByVal i_intSKU As Long, _
  53. Optional ByVal i_strLang As String = "ALL" _
  54. )
  55. Dim FSO As Scripting.FileSystemObject
  56. Dim WS As IWshShell
  57. Dim TSPackage As Scripting.TextStream
  58. Dim strTempDir As String
  59. Dim strPackage As String
  60. Dim strCmd As String
  61. Dim enumSKU As SKU_E
  62. Set FSO = New Scripting.FileSystemObject
  63. Set WS = CreateObject("Wscript.Shell")
  64. strTempDir = Environ$("TEMP") & "\__HSCCAB"
  65. If (FSO.FolderExists(strTempDir)) Then
  66. FSO.DeleteFolder strTempDir, Force:=True
  67. End If
  68. FSO.CreateFolder strTempDir
  69. strPackage = strTempDir & "\" & PACKAGE_DESCRIPTION
  70. Set TSPackage = FSO.CreateTextFile(strPackage, Overwrite:=True, Unicode:=True)
  71. enumSKU = i_intSKU
  72. p_GeneratePackageDescription TSPackage, enumSKU, i_strLang
  73. Set TSPackage = Nothing ' Required for cabarc to work
  74. GenerateHHT strTempDir, i_intSKU
  75. p_CopyFiles FSO, g_clsParameters.FilesToInclude(enumSKU), strTempDir & "\"
  76. p_RaiseEventAndLookForCancel "CAB'ing the files."
  77. strCmd = "cabarc -r -s 6144 n """ & i_strFileName & """ " & strTempDir & "\*"
  78. WS.Run strCmd, , True
  79. End Sub
  80. Public Sub GenerateHHT( _
  81. ByVal i_strDirName As String, _
  82. ByVal i_intSKU As Long _
  83. )
  84. Dim FSO As Scripting.FileSystemObject
  85. Dim TS As Scripting.TextStream
  86. Dim colKeywords As Collection
  87. Dim intAG As Long
  88. Dim enumSKU As SKU_E
  89. Dim DOMNode As MSXML2.IXMLDOMNode
  90. Dim DOMNodeEntries As MSXML2.IXMLDOMNode
  91. Dim DOMNodeRoot As MSXML2.IXMLDOMNode
  92. Dim strFileName As String
  93. Dim blnOutputOperators As Boolean
  94. strFileName = i_strDirName & "\" & TAXONOMY_HHT_C
  95. Set FSO = New Scripting.FileSystemObject
  96. Set TS = FSO.CreateTextFile(strFileName, Unicode:=True)
  97. Set colKeywords = New Collection
  98. enumSKU = i_intSKU
  99. p_OutputHHTProlog TS, enumSKU
  100. intAG = g_clsParameters.AuthoringGroup
  101. If (intAG > AG_CORE_MAX_C) Then
  102. Set DOMNode = GenerateHHTForAuthoringGroup(i_intSKU)
  103. Set DOMNode = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRIES_C)
  104. p_RemoveUnnecessaryAttributes DOMNode
  105. TS.WriteLine DOMNode.XML
  106. Else
  107. p_clsKeywords.GetAllKeywordsColl colKeywords
  108. Set DOMNode = p_clsTaxonomy.GetTaxonomyInXml
  109. Set DOMNodeEntries = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRIES_C)
  110. Set DOMNodeRoot = XMLFindFirstNode(DOMNodeEntries, HHT_TAXONOMY_ENTRY_C)
  111. p_clsTaxonomy.TransformHHTTov10 DOMNodeRoot, colKeywords, "", _
  112. ALL_SKUS_C, DOMNodeEntries, i_intSKU, False
  113. p_RemoveUnnecessaryAttributes DOMNodeEntries
  114. TS.WriteLine DOMNodeEntries.XML
  115. End If
  116. If (intAG <= AG_CORE_MAX_C) Then
  117. If (i_intSKU <> SKU_WINDOWS_MILLENNIUM_E) Then
  118. p_OutputStopSigns i_strDirName & "\" & STOP_SIGNS_HHT_C
  119. p_OutputStopWords i_strDirName & "\" & STOP_WORDS_HHT_C
  120. p_OutputSynonyms i_strDirName & "\" & SYN_TABLE_HHT_C
  121. p_OutputOperators i_strDirName & "\" & OPERATORS_HHT_C
  122. End If
  123. blnOutputOperators = True
  124. End If
  125. p_PrintWithIndentation TS, 0, "</METADATA>"
  126. p_OutputScopeAndNoLoc i_strDirName, enumSKU, blnOutputOperators
  127. End Sub
  128. Private Sub p_RemoveUnnecessaryAttributes( _
  129. ByRef u_DOMNode As MSXML2.IXMLDOMNode _
  130. )
  131. Dim Element As MSXML2.IXMLDOMElement
  132. For Each Element In u_DOMNode.childNodes
  133. If (XMLGetAttribute(Element, HHT_URI_C) = "") Then
  134. Element.removeAttribute HHT_URI_C
  135. End If
  136. If (XMLGetAttribute(Element, HHT_ICONURI_C) = "") Then
  137. Element.removeAttribute HHT_ICONURI_C
  138. End If
  139. If (XMLGetAttribute(Element, HHT_DESCRIPTION_C) = "") Then
  140. Element.removeAttribute HHT_DESCRIPTION_C
  141. End If
  142. If (XMLGetAttribute(Element, HHT_VISIBLE_C) = "True") Then
  143. Element.removeAttribute HHT_VISIBLE_C
  144. End If
  145. If (XMLGetAttribute(Element, HHT_SUBSITE_C) = "False") Then
  146. Element.removeAttribute HHT_SUBSITE_C
  147. End If
  148. If (XMLGetAttribute(Element, HHT_NAVIGATIONMODEL_C) = "Default") Then
  149. Element.removeAttribute HHT_NAVIGATIONMODEL_C
  150. End If
  151. Next
  152. End Sub
  153. Private Function p_GetAllowedSKUs( _
  154. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  155. ) As SKU_E
  156. Dim DOMNode As MSXML2.IXMLDOMNode
  157. Dim DOMNodeParent As MSXML2.IXMLDOMNode
  158. Dim intTID As Long
  159. Dim enumParentAllowedSKUs As SKU_E
  160. Dim enumParentSKUs As SKU_E
  161. p_GetAllowedSKUs = ALL_SKUS_C
  162. If (i_DOMNode.nodeName <> HHT_TAXONOMY_ENTRY_C) Then
  163. Exit Function
  164. End If
  165. intTID = XMLGetAttribute(i_DOMNode, HHT_tid_C)
  166. If (intTID = ROOT_TID_C) Then
  167. Exit Function
  168. End If
  169. Set DOMNodeParent = i_DOMNode.parentNode
  170. If (DOMNodeParent Is Nothing) Then
  171. Exit Function
  172. End If
  173. enumParentAllowedSKUs = p_GetAllowedSKUs(DOMNodeParent)
  174. enumParentSKUs = XMLGetAttribute(DOMNodeParent, HHT_skus_C)
  175. p_GetAllowedSKUs = enumParentAllowedSKUs And enumParentSKUs
  176. End Function
  177. Private Sub p_AddDBParameters( _
  178. ByRef i_DOMDoc As MSXML2.DOMDocument, _
  179. ByRef u_DOMNode As MSXML2.IXMLDOMNode _
  180. )
  181. Dim Element As MSXML2.IXMLDOMElement
  182. Dim DOMNodeParameters As MSXML2.IXMLDOMNode
  183. Dim DOMNodeParameter As MSXML2.IXMLDOMNode
  184. Dim arrNames() As String
  185. Dim strName As String
  186. Dim vntValue As Variant
  187. Dim intIndex As Long
  188. Dim i As Long
  189. Set Element = i_DOMDoc.createElement(HHT_dbparameters_C)
  190. Set DOMNodeParameters = u_DOMNode.appendChild(Element)
  191. ReDim arrNames(85)
  192. arrNames(i) = MINIMUM_KEYWORD_VALIDATION_C: i = i + 1
  193. arrNames(i) = VENDOR_STRING_C: i = i + 1
  194. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_STANDARD_E): i = i + 1
  195. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  196. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_SERVER_E): i = i + 1
  197. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  198. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  199. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  200. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  201. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  202. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  203. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  204. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  205. arrNames(i) = BROKEN_LINK_WORKING_DIR_C & Hex(SKU_ALL_E): i = i + 1
  206. arrNames(i) = PRODUCT_ID_C & Hex(SKU_STANDARD_E): i = i + 1
  207. arrNames(i) = PRODUCT_ID_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  208. arrNames(i) = PRODUCT_ID_C & Hex(SKU_SERVER_E): i = i + 1
  209. arrNames(i) = PRODUCT_ID_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  210. arrNames(i) = PRODUCT_ID_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  211. arrNames(i) = PRODUCT_ID_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  212. arrNames(i) = PRODUCT_ID_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  213. arrNames(i) = PRODUCT_ID_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  214. arrNames(i) = PRODUCT_ID_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  215. arrNames(i) = PRODUCT_ID_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  216. arrNames(i) = PRODUCT_ID_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  217. arrNames(i) = PRODUCT_ID_C & Hex(SKU_ALL_E): i = i + 1
  218. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_STANDARD_E): i = i + 1
  219. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  220. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_SERVER_E): i = i + 1
  221. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  222. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  223. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  224. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  225. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  226. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  227. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  228. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  229. arrNames(i) = PRODUCT_VERSION_C & Hex(SKU_ALL_E): i = i + 1
  230. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_STANDARD_E): i = i + 1
  231. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  232. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_SERVER_E): i = i + 1
  233. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  234. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  235. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  236. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  237. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  238. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  239. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  240. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  241. arrNames(i) = DISPLAY_NAME_C & Hex(SKU_ALL_E): i = i + 1
  242. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_STANDARD_E): i = i + 1
  243. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  244. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_SERVER_E): i = i + 1
  245. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  246. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  247. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  248. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  249. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  250. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  251. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  252. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  253. arrNames(i) = DOM_FRAGMENT_PKG_C & Hex(SKU_ALL_E): i = i + 1
  254. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_STANDARD_E): i = i + 1
  255. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  256. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_SERVER_E): i = i + 1
  257. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  258. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  259. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  260. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  261. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  262. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  263. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  264. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  265. arrNames(i) = DOM_FRAGMENT_HHT_C & Hex(SKU_ALL_E): i = i + 1
  266. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_STANDARD_E): i = i + 1
  267. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_PROFESSIONAL_E): i = i + 1
  268. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_SERVER_E): i = i + 1
  269. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_ADVANCED_SERVER_E): i = i + 1
  270. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_DATA_CENTER_SERVER_E): i = i + 1
  271. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_PROFESSIONAL_64_E): i = i + 1
  272. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_ADVANCED_SERVER_64_E): i = i + 1
  273. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_DATA_CENTER_SERVER_64_E): i = i + 1
  274. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_WINDOWS_MILLENNIUM_E): i = i + 1
  275. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_DESKTOP_ALL_E): i = i + 1
  276. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_SERVER_ALL_E): i = i + 1
  277. arrNames(i) = FILES_TO_INCLUDE_C & Hex(SKU_ALL_E): i = i + 1
  278. For intIndex = LBound(arrNames) To UBound(arrNames)
  279. strName = arrNames(intIndex)
  280. vntValue = g_clsParameters.Value(strName)
  281. If (Not IsNull(vntValue)) Then
  282. Set Element = i_DOMDoc.createElement(HHT_dbparameter_C)
  283. Set DOMNodeParameter = DOMNodeParameters.appendChild(Element)
  284. XMLSetAttribute DOMNodeParameter, HHT_name_C, strName
  285. XMLSetAttribute DOMNodeParameter, HHT_value_C, XMLEscape(vntValue)
  286. End If
  287. Next
  288. End Sub
  289. Private Function p_GetHHTForAuthoringGroup( _
  290. ByRef i_DOMNode As MSXML2.IXMLDOMNode, _
  291. ByRef i_colKeywords As Collection, _
  292. ByVal i_intAuthoringGroup As Long, _
  293. ByVal i_intAllowedSKUs As Long _
  294. ) As MSXML2.IXMLDOMNode
  295. Dim DOMDoc As MSXML2.DOMDocument
  296. Dim DOMNode As MSXML2.IXMLDOMNode
  297. Dim DOMNodeParent As MSXML2.IXMLDOMNode
  298. Dim DOMElement As MSXML2.IXMLDOMElement
  299. Dim strCategory As String
  300. Dim intAllowedSKUs As Long
  301. Dim intAuthoringGroup As Long
  302. Set DOMDoc = New MSXML2.DOMDocument
  303. Set DOMNode = HhtPreamble(DOMDoc, True)
  304. XMLCopyDOMTree i_DOMNode, DOMNode
  305. p_RaiseEventAndLookForCancel "Saving database parameters..."
  306. Set DOMNode = DOMNode.parentNode
  307. p_AddDBParameters DOMDoc, DOMNode
  308. Set DOMNode = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRY_C)
  309. Set DOMNodeParent = DOMNode.parentNode
  310. strCategory = p_clsTaxonomy.GetCategory(i_DOMNode)
  311. intAllowedSKUs = p_GetAllowedSKUs(i_DOMNode)
  312. p_RaiseEventAndLookForCancel "Flattening HHT..."
  313. p_clsTaxonomy.TransformHHTTov10 DOMNode, i_colKeywords, strCategory, _
  314. intAllowedSKUs, DOMNodeParent, i_intAllowedSKUs, True
  315. For Each DOMNode In DOMNodeParent.childNodes
  316. p_RaiseEventAndLookForCancel "Processing title: " & _
  317. XMLGetAttribute(DOMNode, HHT_TITLE_C)
  318. intAuthoringGroup = XMLGetAttribute(DOMNode, HHT_authoringgroup_C)
  319. If (intAuthoringGroup <> i_intAuthoringGroup) Then
  320. DOMNodeParent.removeChild DOMNode
  321. Else
  322. Set DOMElement = DOMNode
  323. DOMElement.removeAttribute HHT_authoringgroup_C
  324. If (i_intAllowedSKUs = SKU_WINDOWS_MILLENNIUM_E) Then
  325. DOMElement.removeAttribute HHT_ICONURI_C
  326. DOMElement.removeAttribute HHT_VISIBLE_C
  327. DOMElement.removeAttribute HHT_INSERTMODE_C
  328. DOMElement.removeAttribute HHT_INSERTLOCATION_C
  329. DOMElement.removeAttribute HHT_SUBSITE_C
  330. DOMElement.removeAttribute HHT_NAVIGATIONMODEL_C
  331. End If
  332. End If
  333. Next
  334. Set p_GetHHTForAuthoringGroup = DOMDoc
  335. End Function
  336. Public Sub ExportHHT( _
  337. ByVal i_strFileName As String, _
  338. Optional ByVal i_intAuthoringGroup As Long = INVALID_ID_C _
  339. )
  340. Dim DOMNode As MSXML2.IXMLDOMNode
  341. Dim colKeywords As Collection
  342. Dim intAG As Long
  343. Set DOMNode = p_clsTaxonomy.GetTaxonomyInXml
  344. p_RaiseEventAndLookForCancel "Reading keywords..."
  345. Set colKeywords = New Collection
  346. p_clsKeywords.GetAllKeywordsColl colKeywords
  347. If (i_intAuthoringGroup = INVALID_ID_C) Then
  348. intAG = g_clsParameters.AuthoringGroup
  349. Else
  350. intAG = i_intAuthoringGroup
  351. End If
  352. Set DOMNode = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRY_C)
  353. Set DOMNode = p_GetHHTForAuthoringGroup(DOMNode, colKeywords, intAG, ALL_SKUS_C)
  354. FileWrite i_strFileName, DOMNode.XML, False, True
  355. End Sub
  356. Public Function GenerateHHTForAuthoringGroup( _
  357. ByVal i_intSKU As Long _
  358. ) As MSXML2.IXMLDOMNode
  359. Dim DOMNode As MSXML2.IXMLDOMNode
  360. Dim DOMNodeEntries As MSXML2.IXMLDOMNode
  361. Dim DOMNodeChild As MSXML2.IXMLDOMNode
  362. Dim DOMElement As MSXML2.IXMLDOMElement
  363. Dim colKeywords As Collection
  364. Dim intAG As Long
  365. Set DOMNode = p_clsTaxonomy.GetTaxonomyInXml
  366. Set colKeywords = New Collection
  367. p_clsKeywords.GetAllKeywordsColl colKeywords
  368. intAG = g_clsParameters.AuthoringGroup
  369. Set DOMNode = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRY_C)
  370. Set DOMNode = p_GetHHTForAuthoringGroup(DOMNode, colKeywords, intAG, i_intSKU)
  371. Set DOMNodeEntries = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRIES_C)
  372. For Each DOMNodeChild In DOMNodeEntries.childNodes
  373. Set DOMElement = DOMNodeChild
  374. DOMElement.removeAttribute HHT_skus_C
  375. Next
  376. Set GenerateHHTForAuthoringGroup = DOMNode
  377. End Function
  378. Private Function p_GetOrphanedNodesTopics( _
  379. ByRef u_DOMNodeMain As MSXML2.IXMLDOMNode, _
  380. ByVal i_intAuthoringGroup As Long _
  381. ) As MSXML2.IXMLDOMNode
  382. Dim DOMNode As MSXML2.IXMLDOMNode
  383. Dim DOMDoc As MSXML2.DOMDocument
  384. Dim DOMNodeNew As MSXML2.IXMLDOMNode
  385. Dim strTitle As String
  386. Dim blnLeaf As Boolean
  387. For Each DOMNode In u_DOMNodeMain.childNodes
  388. strTitle = XMLGetAttribute(DOMNode, HHT_TITLE_C)
  389. blnLeaf = XMLGetAttribute(DOMNode, HHT_leaf_C)
  390. If ((strTitle = NODE_FOR_ORPHANS_C) And (Not blnLeaf)) Then
  391. Set p_GetOrphanedNodesTopics = DOMNode
  392. Exit Function
  393. End If
  394. Next
  395. Set DOMDoc = u_DOMNodeMain.ownerDocument
  396. p_clsTaxonomy.CreateFast NODE_FOR_ORPHANS_C, "", 0, NAVMODEL_DEFAULT_NUM_C, _
  397. "", "", ALL_SKUS_C, False, _
  398. ROOT_TID_C, LOC_INCLUDE_ALL_C, False, False, "", "", "", "", _
  399. DOMDoc, DOMNodeNew, i_intAuthoringGroup
  400. u_DOMNodeMain.appendChild DOMNodeNew
  401. Set p_GetOrphanedNodesTopics = DOMNodeNew
  402. End Function
  403. Private Function p_GetCategoryNode( _
  404. ByRef u_DOMNodeMain As MSXML2.IXMLDOMNode, _
  405. ByRef i_strCategory As String, _
  406. ByVal i_enumSKUs As SKU_E, _
  407. ByRef u_DOMNodeOrphans As MSXML2.IXMLDOMNode, _
  408. ByVal i_intAuthoringGroup As Long _
  409. ) As MSXML2.IXMLDOMNode
  410. Dim DOMDoc As MSXML2.DOMDocument
  411. Dim DOMNodeList As MSXML2.IXMLDOMNodeList
  412. Dim DOMNode As MSXML2.IXMLDOMNode
  413. Dim DOMNodeNew As MSXML2.IXMLDOMNode
  414. Dim intIndex As Long
  415. Dim strQuery As String
  416. Dim enumSKUs As SKU_E
  417. Dim intTIDOrphans As Long
  418. strQuery = "descendant::TAXONOMY_ENTRY["
  419. strQuery = strQuery & "attribute::" & HHT_category2_C & "=""" & i_strCategory & """]"
  420. Set DOMDoc = u_DOMNodeMain.ownerDocument
  421. DOMDoc.setProperty "SelectionLanguage", "XPath"
  422. Set DOMNodeList = u_DOMNodeMain.selectNodes(strQuery)
  423. For intIndex = 0 To DOMNodeList.length - 1
  424. Set DOMNode = DOMNodeList(intIndex)
  425. enumSKUs = XMLGetAttribute(DOMNode, HHT_skus_C)
  426. If ((enumSKUs And i_enumSKUs) <> 0) Then
  427. Set p_GetCategoryNode = DOMNode
  428. Exit Function
  429. End If
  430. Next
  431. If (u_DOMNodeOrphans Is Nothing) Then
  432. Set u_DOMNodeOrphans = p_GetOrphanedNodesTopics(u_DOMNodeMain, i_intAuthoringGroup)
  433. End If
  434. intTIDOrphans = XMLGetAttribute(u_DOMNodeOrphans, HHT_tid_C)
  435. p_clsTaxonomy.CreateFast i_strCategory, "", 0, NAVMODEL_DEFAULT_NUM_C, _
  436. "", "", i_enumSKUs, False, _
  437. intTIDOrphans, LOC_INCLUDE_ALL_C, True, False, "", "", "", "", _
  438. DOMDoc, DOMNodeNew, i_intAuthoringGroup
  439. XMLSetAttribute DOMNodeNew, HHT_category2_C, i_strCategory
  440. u_DOMNodeOrphans.appendChild DOMNodeNew
  441. Set p_GetCategoryNode = DOMNodeNew
  442. End Function
  443. Private Sub p_GetBeforeAndAfterNodes( _
  444. ByRef i_DOMNodeCategory As MSXML2.IXMLDOMNode, _
  445. ByRef i_strInsertMode As String, _
  446. ByRef i_strInsertLocation As String, _
  447. ByRef o_DOMNodeBefore As MSXML2.IXMLDOMNode, _
  448. ByRef o_DOMNodeAfter As MSXML2.IXMLDOMNode _
  449. )
  450. Dim DOMNode As MSXML2.IXMLDOMNode
  451. Dim strAttribute As String
  452. Dim str As String
  453. Select Case i_strInsertMode
  454. Case HHTVAL_TOP_C
  455. Set o_DOMNodeBefore = Nothing
  456. Set o_DOMNodeAfter = i_DOMNodeCategory.firstChild
  457. Case HHTVAL_AFTER_NODE_C, HHTVAL_AFTER_TOPIC_C
  458. If (i_strInsertMode = HHTVAL_AFTER_NODE_C) Then
  459. strAttribute = HHT_ENTRY_C
  460. Else
  461. strAttribute = HHT_URI_C
  462. End If
  463. For Each DOMNode In i_DOMNodeCategory.childNodes
  464. str = XMLGetAttribute(DOMNode, strAttribute)
  465. If (str = i_strInsertLocation) Then
  466. Set o_DOMNodeBefore = DOMNode
  467. Set o_DOMNodeAfter = DOMNode.nextSibling
  468. End If
  469. Next
  470. Case Else
  471. Set o_DOMNodeBefore = Nothing
  472. Set o_DOMNodeAfter = Nothing
  473. End Select
  474. End Sub
  475. Private Function p_CreateKeyword( _
  476. ByRef i_strKeyword As String _
  477. ) As Long
  478. On Error GoTo LErrorHandler
  479. p_CreateKeyword = p_clsKeywords.Create(i_strKeyword)
  480. Exit Function
  481. LErrorHandler:
  482. p_CreateKeyword = INVALID_ID_C
  483. End Function
  484. Private Function p_GetKID( _
  485. ByRef i_strKeyword As String, _
  486. ByRef u_dictKeywords As Scripting.Dictionary _
  487. ) As String
  488. Dim intKID As Long
  489. If (u_dictKeywords.Exists(i_strKeyword)) Then
  490. p_GetKID = u_dictKeywords(i_strKeyword)
  491. Else
  492. intKID = p_CreateKeyword(i_strKeyword)
  493. If (intKID <> INVALID_ID_C) Then
  494. u_dictKeywords.Add i_strKeyword, intKID
  495. p_GetKID = intKID
  496. End If
  497. End If
  498. End Function
  499. Private Function p_GetKeywords( _
  500. ByRef i_DOMNodeHHT As MSXML2.IXMLDOMNode, _
  501. ByRef u_dictKeywords As Scripting.Dictionary _
  502. ) As String
  503. Dim DOMNode As MSXML2.IXMLDOMNode
  504. If (Not i_DOMNodeHHT.firstChild Is Nothing) Then
  505. For Each DOMNode In i_DOMNodeHHT.childNodes
  506. p_GetKeywords = p_GetKeywords & p_GetKID(DOMNode.Text, u_dictKeywords) & " "
  507. Next
  508. p_GetKeywords = FormatKeywordsForTaxonomy(p_GetKeywords)
  509. End If
  510. End Function
  511. Private Sub p_CreateTaxonomyEntry( _
  512. ByRef i_DOMNodeHHT As MSXML2.IXMLDOMNode, _
  513. ByRef u_DOMNodeMain As MSXML2.IXMLDOMNode, _
  514. ByRef u_dictKeywords As Scripting.Dictionary, _
  515. ByRef u_DOMNodeOrphans As MSXML2.IXMLDOMNode, _
  516. ByVal i_intAuthoringGroup As Long _
  517. )
  518. Dim strCategory As String
  519. Dim enumSKUs As SKU_E
  520. Dim DOMNodeCategory As MSXML2.IXMLDOMNode
  521. Dim DOMDoc As MSXML2.DOMDocument
  522. Dim DOMNodeNew As MSXML2.IXMLDOMNode
  523. Dim DOMNodeBefore As MSXML2.IXMLDOMNode
  524. Dim DOMNodeAfter As MSXML2.IXMLDOMNode
  525. Dim strTitle As String
  526. Dim strURI As String
  527. Dim strIconURI As String
  528. Dim strDescription As String
  529. Dim intType As Long
  530. Dim intNavModel As Long
  531. Dim blnVisible As Boolean
  532. Dim blnSubSite As Boolean
  533. Dim strEntry As String
  534. Dim blnLeaf As Boolean
  535. Dim intParentTID As Long
  536. Dim strInsertMode As String
  537. Dim strInsertLocation As String
  538. Dim intTID As Long
  539. Dim intRefTID As Long
  540. Dim intOrderUnderParent As Long
  541. Dim strKeywords As String
  542. strCategory = XMLGetAttribute(i_DOMNodeHHT, HHT_CATEGORY_C)
  543. enumSKUs = XMLGetAttribute(i_DOMNodeHHT, HHT_skus_C)
  544. If (Len(strCategory) = 0) Then
  545. Set DOMNodeCategory = u_DOMNodeMain
  546. Else
  547. Set DOMNodeCategory = p_GetCategoryNode(u_DOMNodeMain, strCategory, _
  548. enumSKUs, u_DOMNodeOrphans, i_intAuthoringGroup)
  549. End If
  550. strTitle = XMLGetAttribute(i_DOMNodeHHT, HHT_TITLE_C)
  551. p_RaiseEventAndLookForCancel "Creating " & strTitle
  552. strURI = XMLGetAttribute(i_DOMNodeHHT, HHT_URI_C)
  553. strIconURI = XMLGetAttribute(i_DOMNodeHHT, HHT_ICONURI_C)
  554. strDescription = XMLGetAttribute(i_DOMNodeHHT, HHT_DESCRIPTION_C)
  555. intType = XMLGetAttribute(i_DOMNodeHHT, HHT_TYPE_C)
  556. intNavModel = NavModelNumber(XMLGetAttribute(i_DOMNodeHHT, HHT_NAVIGATIONMODEL_C))
  557. blnVisible = XMLGetAttribute(i_DOMNodeHHT, HHT_VISIBLE_C)
  558. blnSubSite = XMLGetAttribute(i_DOMNodeHHT, HHT_SUBSITE_C)
  559. strEntry = XMLGetAttribute(i_DOMNodeHHT, HHT_ENTRY_C)
  560. If (Len(strEntry) = 0) Then
  561. blnLeaf = True
  562. End If
  563. intParentTID = XMLGetAttribute(DOMNodeCategory, HHT_tid_C)
  564. Set DOMDoc = u_DOMNodeMain.ownerDocument
  565. strKeywords = p_GetKeywords(i_DOMNodeHHT, u_dictKeywords)
  566. p_clsTaxonomy.CreateFast strTitle, strDescription, intType, intNavModel, strURI, strIconURI, _
  567. enumSKUs, blnLeaf, intParentTID, LOC_INCLUDE_ALL_C, blnVisible, blnSubSite, _
  568. strKeywords, "", "", strEntry, DOMDoc, DOMNodeNew, i_intAuthoringGroup
  569. p_clsTaxonomy.SetCategory2AndEntry DOMNodeNew, strCategory
  570. strInsertMode = XMLGetAttribute(i_DOMNodeHHT, HHT_INSERTMODE_C)
  571. strInsertLocation = XMLGetAttribute(i_DOMNodeHHT, HHT_INSERTLOCATION_C)
  572. p_GetBeforeAndAfterNodes DOMNodeCategory, strInsertMode, strInsertLocation, _
  573. DOMNodeBefore, DOMNodeAfter
  574. intTID = XMLGetAttribute(DOMNodeNew, HHT_tid_C)
  575. If (Not DOMNodeBefore Is Nothing) Then
  576. intRefTID = XMLGetAttribute(DOMNodeBefore, HHT_tid_C)
  577. p_clsTaxonomy.Move intTID, intRefTID, False, 0, intOrderUnderParent
  578. If (DOMNodeAfter Is Nothing) Then
  579. DOMNodeCategory.appendChild DOMNodeNew
  580. Else
  581. DOMNodeCategory.insertBefore DOMNodeNew, DOMNodeAfter
  582. End If
  583. ElseIf (Not DOMNodeAfter Is Nothing) Then
  584. intRefTID = XMLGetAttribute(DOMNodeAfter, HHT_tid_C)
  585. p_clsTaxonomy.Move intTID, intRefTID, True, 0, intOrderUnderParent
  586. DOMNodeCategory.insertBefore DOMNodeNew, DOMNodeAfter
  587. Else
  588. DOMNodeCategory.appendChild DOMNodeNew
  589. End If
  590. End Sub
  591. Private Sub p_RestoreDBParameters( _
  592. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  593. )
  594. Dim DOMNode As MSXML2.IXMLDOMNode
  595. Dim strName As String
  596. Dim strValue As String
  597. If (i_DOMNode Is Nothing) Then
  598. Exit Sub
  599. End If
  600. For Each DOMNode In i_DOMNode.childNodes
  601. strName = XMLGetAttribute(DOMNode, HHT_name_C)
  602. strValue = XMLGetAttribute(DOMNode, HHT_value_C)
  603. g_clsParameters.Value(strName) = XMLUnEscape(strValue)
  604. Next
  605. End Sub
  606. Public Sub ImportHHT( _
  607. ByVal i_strFileName As String, _
  608. Optional ByVal i_intAuthoringGroup As Long = INVALID_ID_C _
  609. )
  610. Dim DOMDoc As MSXML2.DOMDocument
  611. Dim DOMNodeHHT As MSXML2.IXMLDOMNode
  612. Dim DOMNodeMain As MSXML2.IXMLDOMNode
  613. Dim DOMNodeEntries As MSXML2.IXMLDOMNode
  614. Dim DOMNode As MSXML2.IXMLDOMNode
  615. Dim dictKeywords As Scripting.Dictionary
  616. Dim DOMNodeOrphans As MSXML2.IXMLDOMNode
  617. Dim DOMNodeParameters As MSXML2.IXMLDOMNode
  618. Set DOMDoc = New MSXML2.DOMDocument
  619. DOMDoc.Load i_strFileName
  620. Set DOMNodeHHT = DOMDoc
  621. Set DOMNodeMain = p_clsTaxonomy.GetTaxonomyInXml
  622. Set DOMNodeMain = XMLFindFirstNode(DOMNodeMain, HHT_TAXONOMY_ENTRY_C)
  623. Set dictKeywords = New Scripting.Dictionary
  624. p_clsKeywords.GetAllKeywordsDict dictKeywords
  625. p_clsTaxonomy.SetCategory2AndEntry DOMNodeMain, ""
  626. Set DOMNodeEntries = XMLFindFirstNode(DOMNodeHHT, HHT_TAXONOMY_ENTRIES_C)
  627. If (DOMNodeEntries Is Nothing) Then
  628. Exit Sub
  629. End If
  630. For Each DOMNode In DOMNodeEntries.childNodes
  631. p_CreateTaxonomyEntry DOMNode, DOMNodeMain, dictKeywords, DOMNodeOrphans, _
  632. i_intAuthoringGroup
  633. Next
  634. p_RaiseEventAndLookForCancel "Restoring database parameters..."
  635. Set DOMNodeParameters = XMLFindFirstNode(DOMNodeHHT, HHT_dbparameters_C)
  636. p_RestoreDBParameters DOMNodeParameters
  637. End Sub
  638. Private Sub p_OutputStopSigns( _
  639. ByVal i_strFileName As String _
  640. )
  641. Dim FSO As Scripting.FileSystemObject
  642. Dim TS As Scripting.TextStream
  643. Dim dictStopSigns As Scripting.Dictionary
  644. Dim intSSID As Variant
  645. Dim strContext As String
  646. Set FSO = New Scripting.FileSystemObject
  647. Set TS = FSO.CreateTextFile(i_strFileName, Unicode:=True)
  648. Set dictStopSigns = New Scripting.Dictionary
  649. p_clsStopSigns.GetAllStopSignsDict dictStopSigns
  650. p_PrintWithIndentation TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  651. p_PrintWithIndentation TS, 0, "<METADATA>"
  652. p_PrintWithIndentation TS, 1, "<STOPSIGN_ENTRIES>"
  653. p_RaiseEventAndLookForCancel "Adding new Stop Signs"
  654. For Each intSSID In dictStopSigns.Keys
  655. If (dictStopSigns(intSSID)(1) = CONTEXT_ANYWHERE_E) Then
  656. strContext = HHTVAL_ANYWHERE_C
  657. Else
  658. strContext = HHTVAL_ENDOFWORD_C
  659. End If
  660. p_PrintWithIndentation TS, 2, _
  661. "<STOPSIGN ACTION=""ADD"" CONTEXT=""" & strContext & _
  662. """ STOPSIGN=""" & XmlText(dictStopSigns(intSSID)(0)) & """ />"
  663. Next
  664. p_PrintWithIndentation TS, 1, "</STOPSIGN_ENTRIES>"
  665. p_PrintWithIndentation TS, 0, "</METADATA>"
  666. End Sub
  667. Private Sub p_OutputStopWords( _
  668. ByVal i_strFileName As String _
  669. )
  670. Dim FSO As Scripting.FileSystemObject
  671. Dim TS As Scripting.TextStream
  672. Dim dictStopWords As Scripting.Dictionary
  673. Dim intSWID As Variant
  674. Set FSO = New Scripting.FileSystemObject
  675. Set TS = FSO.CreateTextFile(i_strFileName, Unicode:=True)
  676. Set dictStopWords = New Scripting.Dictionary
  677. p_clsStopWords.GetAllStopWordsDict dictStopWords
  678. p_PrintWithIndentation TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  679. p_PrintWithIndentation TS, 0, "<METADATA>"
  680. p_PrintWithIndentation TS, 1, "<STOPWORD_ENTRIES>"
  681. p_RaiseEventAndLookForCancel "Adding new Stop Words"
  682. For Each intSWID In dictStopWords.Keys
  683. p_PrintWithIndentation TS, 2, _
  684. "<STOPWORD ACTION=""ADD""" & _
  685. " STOPWORD=""" & XmlText(dictStopWords(intSWID)) & """ />"
  686. Next
  687. p_PrintWithIndentation TS, 1, "</STOPWORD_ENTRIES>"
  688. p_PrintWithIndentation TS, 0, "</METADATA>"
  689. End Sub
  690. Private Sub p_OutputSynonyms( _
  691. ByVal i_strFileName As String _
  692. )
  693. Dim FSO As Scripting.FileSystemObject
  694. Dim TS As Scripting.TextStream
  695. Dim clsSynonymSets As SynonymSets
  696. Dim rs As ADODB.Recordset
  697. Dim intLastEID As Long
  698. Dim intEID As Long
  699. Set FSO = New Scripting.FileSystemObject
  700. Set TS = FSO.CreateTextFile(i_strFileName, Unicode:=True)
  701. Set clsSynonymSets = New SynonymSets
  702. Set rs = New ADODB.Recordset
  703. clsSynonymSets.GetSynonymsRs rs
  704. p_PrintWithIndentation TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  705. p_PrintWithIndentation TS, 0, "<METADATA>"
  706. p_PrintWithIndentation TS, 1, "<SYNTABLE>"
  707. Do While (Not rs.EOF)
  708. intEID = rs("EID")
  709. If (intEID <> intLastEID) Then
  710. If (intLastEID <> 0) Then
  711. p_PrintWithIndentation TS, 2, "</SYNSET>"
  712. End If
  713. intLastEID = intEID
  714. p_PrintWithIndentation TS, 2, "<SYNSET ID=""" & intEID & """>"
  715. p_PrintWithIndentation TS, 2, "<SuperKeyword>" & XMLEscape(rs("Name")) & "</SuperKeyword>" ' For LOC only. HSC ignores this.
  716. End If
  717. p_PrintWithIndentation TS, 3, "<SYNONYM ACTION=""ADD"">" & XMLEscape(rs("Keyword")) & "</SYNONYM>"
  718. rs.MoveNext
  719. Loop
  720. If (rs.RecordCount <> 0) Then
  721. p_PrintWithIndentation TS, 2, "</SYNSET>"
  722. End If
  723. p_PrintWithIndentation TS, 1, "</SYNTABLE>"
  724. p_PrintWithIndentation TS, 0, "</METADATA>"
  725. End Sub
  726. Private Sub p_OutputScopeAndNoLoc( _
  727. ByVal i_strDirName As String, _
  728. ByVal i_enumSKU As SKU_E, _
  729. ByVal i_blnOutputOperators As Boolean _
  730. )
  731. Dim FSO As Scripting.FileSystemObject
  732. Dim TS As Scripting.TextStream
  733. Dim DOMDoc As MSXML2.DOMDocument
  734. Dim DOMNodeScope As MSXML2.IXMLDOMNode
  735. Dim DOMNode As MSXML2.IXMLDOMNode
  736. Set FSO = New Scripting.FileSystemObject
  737. Set DOMDoc = New MSXML2.DOMDocument
  738. DOMDoc.loadXML START_TAG_C & g_clsParameters.DomFragmentHHT(i_enumSKU) & END_TAG_C
  739. Set DOMNodeScope = DOMDoc.selectSingleNode(SCOPE_DEFINITION_NODE_C)
  740. Set TS = FSO.CreateTextFile(i_strDirName & "\" & SCOPE_DEFINITION_HHT_C, Unicode:=True)
  741. p_PrintWithIndentation TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  742. p_PrintWithIndentation TS, 0, "<METADATA>"
  743. If (Not DOMNodeScope Is Nothing) Then
  744. DOMDoc.childNodes(0).removeChild DOMNodeScope
  745. TS.WriteLine DOMNodeScope.XML
  746. End If
  747. p_PrintWithIndentation TS, 0, "</METADATA>"
  748. Set TS = FSO.CreateTextFile(i_strDirName & "\" & NO_LOC_HHT_C, Unicode:=True)
  749. p_PrintWithIndentation TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  750. p_PrintWithIndentation TS, 0, "<METADATA>"
  751. For Each DOMNode In DOMDoc.childNodes(0).childNodes
  752. TS.WriteLine DOMNode.XML
  753. Next
  754. p_PrintWithIndentation TS, 0, "</METADATA>"
  755. End Sub
  756. Private Sub p_OutputOperators( _
  757. ByVal i_strFileName As String _
  758. )
  759. Dim FSO As Scripting.FileSystemObject
  760. Dim TS As Scripting.TextStream
  761. Dim arrOpAnd() As String
  762. Dim arrOpOr() As String
  763. Dim arrOpNot() As String
  764. Dim str As Variant
  765. Set FSO = New Scripting.FileSystemObject
  766. Set TS = FSO.CreateTextFile(i_strFileName, Unicode:=True)
  767. p_PrintWithIndentation TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  768. p_PrintWithIndentation TS, 0, "<METADATA>"
  769. GetVerbalOperators arrOpAnd, arrOpOr, arrOpNot
  770. p_PrintWithIndentation TS, 1, "<OPERATOR_ENTRIES>"
  771. For Each str In arrOpAnd
  772. p_PrintWithIndentation TS, 2, _
  773. "<OPERATOR ACTION=""ADD"" OPERATION=""AND"" OPERATOR=""" & str & """ />"
  774. Next
  775. For Each str In arrOpOr
  776. p_PrintWithIndentation TS, 2, _
  777. "<OPERATOR ACTION=""ADD"" OPERATION=""OR"" OPERATOR=""" & str & """ />"
  778. Next
  779. For Each str In arrOpNot
  780. p_PrintWithIndentation TS, 2, _
  781. "<OPERATOR ACTION=""ADD"" OPERATION=""NOT"" OPERATOR=""" & str & """ />"
  782. Next
  783. p_PrintWithIndentation TS, 1, "</OPERATOR_ENTRIES>"
  784. p_PrintWithIndentation TS, 0, "</METADATA>"
  785. End Sub
  786. Private Sub p_GeneratePackageDescription( _
  787. ByVal i_TS As Scripting.TextStream, _
  788. ByVal i_enumSKU As SKU_E, _
  789. ByVal i_strLang As String _
  790. )
  791. Dim strProductId As String
  792. Dim strVersion As String
  793. strProductId = g_clsParameters.ProductId(i_enumSKU)
  794. strVersion = g_clsParameters.ProductVersion(i_enumSKU)
  795. If ((strProductId = "") Or (strVersion = "")) Then
  796. Err.Raise errProductIdOrVersionMissing
  797. End If
  798. p_RaiseEventAndLookForCancel "Generating " & PACKAGE_DESCRIPTION
  799. p_PrintWithIndentation i_TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  800. p_PrintWithIndentation i_TS, 0, "<HELPCENTERPACKAGE>"
  801. p_PrintWithIndentation i_TS, 1, "<VERSION VALUE=""" & strVersion & """ />"
  802. p_PrintWithIndentation i_TS, 1, "<PRODUCT ID=""" & strProductId & """ />"
  803. If (i_enumSKU <> SKU_WINDOWS_MILLENNIUM_E) Then
  804. p_PrintWithIndentation i_TS, 1, "<SKU VALUE='" & XmlSKU(i_enumSKU) & "' " & _
  805. "DISPLAYNAME='" & g_clsParameters.DisplayName(i_enumSKU) & "'/>"
  806. p_PrintWithIndentation i_TS, 1, "<LANGUAGE VALUE='" & i_strLang & "'/>"
  807. End If
  808. p_PrintWithIndentation i_TS, 1, "<METADATA>"
  809. If (i_enumSKU <> SKU_WINDOWS_MILLENNIUM_E) Then
  810. If (g_clsParameters.AuthoringGroup <= AG_CORE_MAX_C) Then
  811. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & STOP_SIGNS_HHT_C & """ />"
  812. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & STOP_WORDS_HHT_C & """ />"
  813. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & SYN_TABLE_HHT_C & """ />"
  814. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & OPERATORS_HHT_C & """ />"
  815. End If
  816. End If
  817. ' The taxonomy must appear after the syntable
  818. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & TAXONOMY_HHT_C & """ />"
  819. If (i_enumSKU <> SKU_WINDOWS_MILLENNIUM_E) Then
  820. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & SCOPE_DEFINITION_HHT_C & """ />"
  821. p_PrintWithIndentation i_TS, 2, "<HHT FILE=""" & NO_LOC_HHT_C & """ />"
  822. End If
  823. p_PrintWithIndentation i_TS, 1, "</METADATA>"
  824. i_TS.WriteLine g_clsParameters.DomFragmentPackageDesc(i_enumSKU)
  825. p_PrintWithIndentation i_TS, 0, "</HELPCENTERPACKAGE>"
  826. End Sub
  827. Private Sub p_OutputHHTProlog( _
  828. ByVal i_TS As Scripting.TextStream, _
  829. ByVal i_enumSKU As SKU_E _
  830. )
  831. Dim strDateTime As String
  832. strDateTime = FormatDateTime(Now, vbLongDate) & " " & FormatDateTime(Now, vbLongTime)
  833. p_PrintWithIndentation i_TS, 0, "<?xml version=""1.0"" encoding=""UTF-16"" ?>"
  834. p_PrintWithIndentation i_TS, 0, "<!--"
  835. p_PrintWithIndentation i_TS, 0, "This file was automatically created on " & strDateTime
  836. p_PrintWithIndentation i_TS, 0, "Do not modify, as it may be overwritten."
  837. p_PrintWithIndentation i_TS, 0, "SKU: " & DisplayNameForSKU(i_enumSKU)
  838. p_PrintWithIndentation i_TS, 0, "Production Tool version: " & _
  839. App.Major & "." & App.Minor & "." & App.Revision
  840. p_PrintWithIndentation i_TS, 0, "-->"
  841. p_PrintWithIndentation i_TS, 0, "<METADATA>"
  842. End Sub
  843. Private Sub p_CopyFiles( _
  844. ByVal i_FSO As Scripting.FileSystemObject, _
  845. ByVal i_strFiles As String, _
  846. ByVal i_strDirectory As String _
  847. )
  848. Dim strFiles() As String
  849. Dim intIndex As Long
  850. strFiles = Split(i_strFiles, vbCrLf)
  851. For intIndex = LBound(strFiles) To UBound(strFiles)
  852. If (Not i_FSO.FileExists(strFiles(intIndex))) Then
  853. WriteLog "File " & strFiles(intIndex) & " does not exist, and couldn't be copied."
  854. Else
  855. i_FSO.CopyFile strFiles(intIndex), i_strDirectory
  856. End If
  857. Next
  858. End Sub
  859. Private Sub p_PrintWithIndentation( _
  860. ByVal i_TS As Scripting.TextStream, _
  861. ByVal i_intNumIndents As Long, _
  862. ByVal i_strText As String _
  863. )
  864. i_TS.Write Space(i_intNumIndents * 4)
  865. i_TS.WriteLine i_strText
  866. End Sub
  867. Private Sub p_RaiseEventAndLookForCancel( _
  868. ByVal strStatus As String _
  869. )
  870. Dim blnCancel As Boolean
  871. blnCancel = False
  872. RaiseEvent ReportStatus(strStatus, blnCancel)
  873. If (blnCancel) Then
  874. Err.Raise errCancel
  875. End If
  876. End Sub
  877. Private Sub p_clsTaxonomy_ReportStatus(ByVal strStatus As String, blnCancel As Boolean)
  878. p_RaiseEventAndLookForCancel strStatus
  879. End Sub