Source code of Windows XP (NT5)
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.

5026 lines
132 KiB

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form frmMain
  5. Caption = "HSC Production Tool"
  6. ClientHeight = 8670
  7. ClientLeft = 60
  8. ClientTop = 630
  9. ClientWidth = 11895
  10. Icon = "frmMain.frx":0000
  11. LinkTopic = "Form1"
  12. ScaleHeight = 8670
  13. ScaleWidth = 11895
  14. Begin VB.ComboBox cboNavModel
  15. Height = 315
  16. Left = 8280
  17. Style = 2 'Dropdown List
  18. TabIndex = 5
  19. Top = 0
  20. Width = 1575
  21. End
  22. Begin VB.CommandButton cmdEditEntry
  23. Caption = "Edit"
  24. Height = 255
  25. Left = 11160
  26. TabIndex = 23
  27. Top = 2520
  28. Width = 615
  29. End
  30. Begin VB.TextBox txtEntry
  31. Height = 285
  32. Left = 6960
  33. TabIndex = 22
  34. Top = 2520
  35. Width = 4095
  36. End
  37. Begin VB.CommandButton cmdURI
  38. Caption = "..."
  39. Height = 255
  40. Left = 11400
  41. TabIndex = 16
  42. Top = 1440
  43. Width = 375
  44. End
  45. Begin VB.CheckBox chkSubSite
  46. Caption = "Su&bSite"
  47. Height = 255
  48. Left = 6480
  49. TabIndex = 3
  50. Top = 0
  51. Width = 855
  52. End
  53. Begin VB.TextBox txtIconURI
  54. Height = 285
  55. Left = 6960
  56. TabIndex = 18
  57. Tag = "1"
  58. Top = 1800
  59. Width = 4815
  60. End
  61. Begin VB.Timer tmrRefresh
  62. Interval = 18000
  63. Left = 4320
  64. Top = 0
  65. End
  66. Begin VB.CheckBox chkVisible
  67. Caption = "&Visible"
  68. Height = 255
  69. Left = 5640
  70. TabIndex = 2
  71. Top = 0
  72. Width = 855
  73. End
  74. Begin VB.ComboBox cboLocInclude
  75. Height = 315
  76. Left = 10800
  77. TabIndex = 7
  78. Text = "cboLocInclude"
  79. Top = 0
  80. Width = 975
  81. End
  82. Begin VB.ComboBox cboNavigateLink
  83. Height = 315
  84. Left = 9360
  85. Style = 2 'Dropdown List
  86. TabIndex = 25
  87. Top = 3000
  88. Width = 1935
  89. End
  90. Begin VB.ComboBox cboKeywords
  91. Height = 1935
  92. ItemData = "frmMain.frx":212A
  93. Left = 5640
  94. List = "frmMain.frx":212C
  95. Sorted = -1 'True
  96. Style = 1 'Simple Combo
  97. TabIndex = 39
  98. Tag = "1"
  99. Top = 5520
  100. Width = 6135
  101. End
  102. Begin VB.CommandButton cmdNavigateLink
  103. Caption = "Go"
  104. Height = 375
  105. Left = 11400
  106. TabIndex = 26
  107. Top = 3000
  108. Width = 375
  109. End
  110. Begin VB.Timer tmrScrollDuringDrag
  111. Left = 3960
  112. Top = 0
  113. End
  114. Begin MSComctlLib.StatusBar staInfo
  115. Align = 2 'Align Bottom
  116. Height = 375
  117. Left = 0
  118. TabIndex = 47
  119. Top = 8295
  120. Width = 11895
  121. _ExtentX = 20981
  122. _ExtentY = 661
  123. _Version = 393216
  124. BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
  125. NumPanels = 3
  126. BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
  127. AutoSize = 1
  128. Object.Width = 8440
  129. MinWidth = 1270
  130. EndProperty
  131. BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
  132. AutoSize = 1
  133. Object.Width = 8440
  134. MinWidth = 1270
  135. EndProperty
  136. BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
  137. Object.Width = 3528
  138. MinWidth = 3528
  139. EndProperty
  140. EndProperty
  141. End
  142. Begin VB.CommandButton cmdRefresh
  143. Caption = "Refresh"
  144. Height = 375
  145. Left = 4080
  146. TabIndex = 43
  147. Top = 7800
  148. Width = 1215
  149. End
  150. Begin VB.CommandButton cmdAddRemove
  151. Caption = "&Add/Remove Keywords ..."
  152. Height = 375
  153. Left = 8880
  154. TabIndex = 37
  155. Top = 5040
  156. Width = 2895
  157. End
  158. Begin VB.CommandButton cmdCreateLeaf
  159. Caption = "Create Topic"
  160. Height = 375
  161. Left = 1440
  162. TabIndex = 41
  163. Top = 7800
  164. Width = 1215
  165. End
  166. Begin MSComctlLib.ImageList ilsIcons
  167. Left = 3360
  168. Top = 0
  169. _ExtentX = 1005
  170. _ExtentY = 1005
  171. BackColor = -2147483643
  172. ImageWidth = 16
  173. ImageHeight = 16
  174. MaskColor = 16776960
  175. _Version = 393216
  176. BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
  177. NumListImages = 6
  178. BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
  179. Picture = "frmMain.frx":212E
  180. Key = ""
  181. EndProperty
  182. BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
  183. Picture = "frmMain.frx":2240
  184. Key = ""
  185. EndProperty
  186. BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
  187. Picture = "frmMain.frx":2352
  188. Key = ""
  189. EndProperty
  190. BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
  191. Picture = "frmMain.frx":2464
  192. Key = ""
  193. EndProperty
  194. BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
  195. Picture = "frmMain.frx":2576
  196. Key = ""
  197. EndProperty
  198. BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
  199. Picture = "frmMain.frx":2688
  200. Key = ""
  201. EndProperty
  202. EndProperty
  203. End
  204. Begin VB.CommandButton cmdDelete
  205. Caption = "Delete"
  206. Height = 375
  207. Left = 2760
  208. TabIndex = 42
  209. Top = 7800
  210. Width = 1215
  211. End
  212. Begin VB.CommandButton cmdCreateGroup
  213. Caption = "Create Node"
  214. Height = 375
  215. Left = 120
  216. TabIndex = 40
  217. Top = 7800
  218. Width = 1215
  219. End
  220. Begin MSComDlg.CommonDialog dlgCommon
  221. Left = 2880
  222. Top = 0
  223. _ExtentX = 847
  224. _ExtentY = 847
  225. _Version = 393216
  226. End
  227. Begin VB.CommandButton cmdCancel
  228. Caption = "Cancel"
  229. Height = 375
  230. Left = 10560
  231. TabIndex = 46
  232. Top = 7800
  233. Width = 1215
  234. End
  235. Begin VB.CommandButton cmdSave
  236. Caption = "Save"
  237. Height = 375
  238. Left = 9240
  239. TabIndex = 45
  240. Top = 7800
  241. Width = 1215
  242. End
  243. Begin VB.ComboBox cboType
  244. Height = 315
  245. Left = 6960
  246. Style = 2 'Dropdown List
  247. TabIndex = 13
  248. Top = 1080
  249. Width = 4815
  250. End
  251. Begin VB.TextBox txtURI
  252. Height = 285
  253. Left = 6960
  254. TabIndex = 15
  255. Tag = "1"
  256. Top = 1440
  257. Width = 4335
  258. End
  259. Begin VB.TextBox txtDescription
  260. Height = 285
  261. Left = 6960
  262. TabIndex = 11
  263. Tag = "1"
  264. Top = 720
  265. Width = 4815
  266. End
  267. Begin VB.TextBox txtTitle
  268. Height = 285
  269. Left = 6960
  270. TabIndex = 9
  271. Tag = "1"
  272. Top = 360
  273. Width = 4815
  274. End
  275. Begin MSComctlLib.TreeView treTaxonomy
  276. Height = 7335
  277. Left = 120
  278. TabIndex = 1
  279. Tag = "1"
  280. Top = 360
  281. Width = 5415
  282. _ExtentX = 9551
  283. _ExtentY = 12938
  284. _Version = 393217
  285. Indentation = 529
  286. Style = 7
  287. Appearance = 1
  288. End
  289. Begin VB.Frame fraSKU
  290. Caption = "&SKU"
  291. Height = 1575
  292. Left = 5640
  293. TabIndex = 27
  294. Top = 3360
  295. Width = 6135
  296. Begin VB.CheckBox chkWindowsMillennium
  297. Caption = "Windows Me"
  298. Height = 255
  299. Left = 240
  300. TabIndex = 28
  301. Top = 240
  302. Width = 1695
  303. End
  304. Begin VB.CheckBox chkDataCenterServer64
  305. Caption = "64-bit Datacenter Server"
  306. Height = 255
  307. Left = 3120
  308. TabIndex = 36
  309. Top = 1200
  310. Width = 2055
  311. End
  312. Begin VB.CheckBox chkAdvancedServer64
  313. Caption = "64-bit Advanced Server"
  314. Height = 255
  315. Left = 3120
  316. TabIndex = 34
  317. Top = 720
  318. Width = 2055
  319. End
  320. Begin VB.CheckBox chkProfessional64
  321. Caption = "64-bit Professional"
  322. Height = 255
  323. Left = 240
  324. TabIndex = 31
  325. Top = 960
  326. Width = 1695
  327. End
  328. Begin VB.CheckBox chkDataCenterServer
  329. Caption = "32-bit Datacenter Server"
  330. Height = 255
  331. Left = 3120
  332. TabIndex = 35
  333. Top = 960
  334. Width = 2055
  335. End
  336. Begin VB.CheckBox chkAdvancedServer
  337. Caption = "32-bit Advanced Server"
  338. Height = 255
  339. Left = 3120
  340. TabIndex = 33
  341. Top = 480
  342. Width = 2055
  343. End
  344. Begin VB.CheckBox chkServer
  345. Caption = "32-bit Server"
  346. Height = 255
  347. Left = 3120
  348. TabIndex = 32
  349. Top = 240
  350. Width = 2055
  351. End
  352. Begin VB.CheckBox chkProfessional
  353. Caption = "32-bit Professional"
  354. Height = 255
  355. Left = 240
  356. TabIndex = 30
  357. Top = 720
  358. Width = 1695
  359. End
  360. Begin VB.CheckBox chkStandard
  361. Caption = "32-bit Personal"
  362. Height = 255
  363. Left = 240
  364. TabIndex = 29
  365. Top = 480
  366. Width = 1695
  367. End
  368. End
  369. Begin VB.TextBox txtComments
  370. Height = 285
  371. Left = 6960
  372. TabIndex = 20
  373. Tag = "1"
  374. Top = 2160
  375. Width = 4815
  376. End
  377. Begin VB.Label lblNavModel
  378. Caption = "Nav Model:"
  379. Height = 255
  380. Left = 7440
  381. TabIndex = 4
  382. Top = 0
  383. Width = 855
  384. End
  385. Begin VB.Label lblEntry
  386. Caption = "Entry:"
  387. Height = 255
  388. Left = 5640
  389. TabIndex = 21
  390. Top = 2520
  391. Width = 1215
  392. End
  393. Begin VB.Label lblLastModified
  394. BorderStyle = 1 'Fixed Single
  395. Height = 375
  396. Left = 5400
  397. TabIndex = 44
  398. Top = 7800
  399. Width = 3735
  400. End
  401. Begin VB.Label lblIconURI
  402. Caption = "Ico&n URI:"
  403. Height = 255
  404. Left = 5640
  405. TabIndex = 17
  406. Top = 1800
  407. Width = 1215
  408. End
  409. Begin VB.Label lblLocInclude
  410. Caption = "&Loc. Incl:"
  411. Height = 255
  412. Left = 9960
  413. TabIndex = 6
  414. Top = 0
  415. Width = 735
  416. End
  417. Begin VB.Label lblNavigateLink
  418. Caption = "Vie&w Topic:"
  419. Height = 255
  420. Left = 8400
  421. TabIndex = 24
  422. Top = 3000
  423. Width = 855
  424. End
  425. Begin VB.Label lblComments
  426. Caption = "&Comments:"
  427. Height = 255
  428. Left = 5640
  429. TabIndex = 19
  430. Top = 2160
  431. Width = 1215
  432. End
  433. Begin VB.Label lblKeywords
  434. Caption = "&Keywords associated with selected Node:"
  435. Height = 255
  436. Left = 5640
  437. TabIndex = 38
  438. Top = 5160
  439. Width = 3135
  440. End
  441. Begin VB.Label lblURI
  442. Caption = "&URI of the topic:"
  443. Height = 255
  444. Left = 5640
  445. TabIndex = 14
  446. Top = 1440
  447. Width = 1215
  448. End
  449. Begin VB.Label lblType
  450. Caption = "Ty&pe:"
  451. Height = 255
  452. Left = 5640
  453. TabIndex = 12
  454. Top = 1080
  455. Width = 1215
  456. End
  457. Begin VB.Label lblDescription
  458. Caption = "&Description:"
  459. Height = 255
  460. Left = 5640
  461. TabIndex = 10
  462. Top = 720
  463. Width = 1215
  464. End
  465. Begin VB.Label lblTitle
  466. Caption = "* T&itle:"
  467. Height = 255
  468. Left = 5640
  469. TabIndex = 8
  470. Top = 360
  471. Width = 1215
  472. End
  473. Begin VB.Label lblTaxonomy
  474. Caption = "&Taxonomy tree (including topics):"
  475. Height = 255
  476. Left = 120
  477. TabIndex = 0
  478. Top = 120
  479. Width = 2775
  480. End
  481. Begin VB.Menu mnuFile
  482. Caption = "&File"
  483. Begin VB.Menu mnuFileOpenDatabase
  484. Caption = "Open Database..."
  485. End
  486. Begin VB.Menu mnuFileExportHHT
  487. Caption = "Archive authoring group changes..."
  488. End
  489. Begin VB.Menu mnuFileImportHHT
  490. Caption = "Restore authoring group changes..."
  491. End
  492. Begin VB.Menu mnuSeparator0
  493. Caption = "-"
  494. End
  495. Begin VB.Menu mnuFileExit
  496. Caption = "Exit"
  497. End
  498. End
  499. Begin VB.Menu mnuEdit
  500. Caption = "&Edit"
  501. Begin VB.Menu mnuEditStopSigns
  502. Caption = "Stop Signs..."
  503. End
  504. Begin VB.Menu mnuEditStopWords
  505. Caption = "Stop Words..."
  506. End
  507. Begin VB.Menu mnuEditKeywords
  508. Caption = "Keywords..."
  509. End
  510. Begin VB.Menu mnuEditSynonymSets
  511. Caption = "Synonym Sets..."
  512. End
  513. Begin VB.Menu mnuSeparator1
  514. Caption = "-"
  515. End
  516. Begin VB.Menu mnuEditFind
  517. Caption = "Find..."
  518. Shortcut = ^F
  519. End
  520. Begin VB.Menu mnuEditCopy
  521. Caption = "Copy"
  522. Shortcut = ^Y
  523. End
  524. Begin VB.Menu mnuEditCut
  525. Caption = "Cut"
  526. Shortcut = ^T
  527. End
  528. Begin VB.Menu mnuEditPaste
  529. Caption = "Paste"
  530. Shortcut = ^P
  531. End
  532. Begin VB.Menu mnuSeparator2
  533. Caption = "-"
  534. End
  535. Begin VB.Menu mnuEditCopyKeywords
  536. Caption = "Copy Keywords"
  537. Shortcut = ^K
  538. End
  539. Begin VB.Menu mnuEditPasteKeywords
  540. Caption = "Paste Keywords"
  541. Shortcut = ^L
  542. End
  543. End
  544. Begin VB.Menu mnuTools
  545. Caption = "T&ools"
  546. Begin VB.Menu mnuToolsCreateHHTandCAB
  547. Caption = "Create HHT and CAB..."
  548. End
  549. Begin VB.Menu mnuToolsFilterBySKU
  550. Caption = "Filter by SKU..."
  551. End
  552. Begin VB.Menu mnuToolsImporter
  553. Caption = "Importer..."
  554. End
  555. Begin VB.Menu mnuToolsParameters
  556. Caption = "Parameters..."
  557. End
  558. Begin VB.Menu mnuToolsPropagateKeywords
  559. Caption = "Propagate Keywords"
  560. End
  561. Begin VB.Menu mnuToolsSetFont
  562. Caption = "Set Font..."
  563. End
  564. End
  565. Begin VB.Menu mnuHelp
  566. Caption = "&Help"
  567. Begin VB.Menu mnuHelpContents
  568. Caption = "Contents..."
  569. End
  570. Begin VB.Menu mnuSeparator3
  571. Caption = "-"
  572. End
  573. Begin VB.Menu mnuHelpAbout
  574. Caption = "About..."
  575. End
  576. End
  577. Begin VB.Menu mnuRightClick
  578. Caption = "RightClick"
  579. Visible = 0 'False
  580. Begin VB.Menu mnuRightClickCopy
  581. Caption = "Copy"
  582. End
  583. Begin VB.Menu mnuRightClickCut
  584. Caption = "Cut"
  585. End
  586. Begin VB.Menu mnuRightClickPaste
  587. Caption = "Paste"
  588. End
  589. Begin VB.Menu mnuSeparator4
  590. Caption = "-"
  591. End
  592. Begin VB.Menu mnuRightClickCopyKeywords
  593. Caption = "Copy Keywords"
  594. End
  595. Begin VB.Menu mnuRightClickPasteKeywords
  596. Caption = "Paste Keywords"
  597. End
  598. Begin VB.Menu mnuSeparator5
  599. Caption = "-"
  600. End
  601. Begin VB.Menu mnuRightClickCreateNode
  602. Caption = "Create Node"
  603. End
  604. Begin VB.Menu mnuRightClickCreateTopic
  605. Caption = "Create Topic"
  606. End
  607. Begin VB.Menu mnuRightClickDelete
  608. Caption = "Delete"
  609. End
  610. Begin VB.Menu mnuSeparator6
  611. Caption = "-"
  612. End
  613. Begin VB.Menu mnuRightClickKeywordify
  614. Caption = "Create Keywords from Titles"
  615. End
  616. Begin VB.Menu mnuRightClickExport
  617. Caption = "Archive authoring group changes..."
  618. End
  619. End
  620. Begin VB.Menu mnuMove
  621. Caption = "Move"
  622. Visible = 0 'False
  623. Begin VB.Menu mnuMoveAbove
  624. Caption = "Move Above"
  625. End
  626. Begin VB.Menu mnuMoveBelow
  627. Caption = "Move Below"
  628. End
  629. Begin VB.Menu mnuMoveInside
  630. Caption = "Move Inside"
  631. End
  632. End
  633. End
  634. Attribute VB_Name = "frmMain"
  635. Attribute VB_GlobalNameSpace = False
  636. Attribute VB_Creatable = False
  637. Attribute VB_PredeclaredId = True
  638. Attribute VB_Exposed = False
  639. Option Explicit
  640. Private WithEvents p_clsTaxonomy As AuthDatabase.Taxonomy
  641. Attribute p_clsTaxonomy.VB_VarHelpID = -1
  642. Private WithEvents p_clsHHT As AuthDatabase.HHT
  643. Attribute p_clsHHT.VB_VarHelpID = -1
  644. Private p_clsKeywords As AuthDatabase.Keywords
  645. Private p_clsParameters As AuthDatabase.Parameters
  646. Private p_clsSizer As Sizer
  647. Private p_colKeywords As Collection
  648. Private p_dictKeywordsWithTitle As Scripting.Dictionary
  649. Private p_intAuthoringGroup As Long
  650. Private p_blnDatabaseOpen As Boolean
  651. Private p_nodeMouseDown As Node
  652. Private p_blnCtrlMouseDown As Boolean
  653. Private p_nodeCopied As Node
  654. Private p_nodeCut As Node
  655. Private p_blnScrollUp As Boolean
  656. Private p_DOMNode As MSXML2.IXMLDOMNode
  657. Private p_blnHHKDragDrop As Boolean
  658. Private p_blnAddRemoveKeywordsOpen As Boolean
  659. Private p_strKeywords As String
  660. Private p_blnNoHHTStatus As Boolean
  661. Private p_enumFilterSKUs As SKU_E
  662. Private p_blnCreating As Boolean
  663. Private p_blnUpdating As Boolean
  664. Private p_blnDragging As Boolean
  665. Private p_blnSettingControls As Boolean
  666. Private Const KEY_PREFIX_C As String = "TID"
  667. Private Const CREATE_KEY_C As String = "Node being created"
  668. Private Const MODIFY_KEY_C As String = "Node being modified"
  669. Private Const MDB_FILE_FILTER_C As String = "Microsoft Access 2000 Files (*.mdb)|*.mdb"
  670. Private Const XML_FILE_FILTER_C As String = "XML Files (*.xml)|*.xml"
  671. Private Const HELP_FILE_NAME_C As String = "Hsc.chm"
  672. Private Const HELP_EXE_C As String = "hh.exe"
  673. Private Enum STATUS_BAR_PANEL_E
  674. SBPANEL_DATABASE = 1
  675. SBPANEL_OTHER = 2
  676. SBPANEL_MODE = 3
  677. End Enum
  678. Private Declare Function SendMessage Lib "user32" Alias _
  679. "SendMessageA" ( _
  680. ByVal hwnd As Long, _
  681. ByVal wMsg As Long, _
  682. ByVal wParam As Long, _
  683. lParam As Any _
  684. ) As Long
  685. Private Enum IMAGE_E
  686. IMAGE_LEAF_E = 1
  687. IMAGE_GROUP_E = 2
  688. IMAGE_BAD_LEAF_E = 3
  689. IMAGE_BAD_GROUP_E = 4
  690. IMAGE_FOREIGN_LEAF_E = 5
  691. IMAGE_FOREIGN_GROUP_E = 6
  692. End Enum
  693. ' Usage of a Node's Key and Tag:
  694. ' If a Taxonomy Node's TID is 8, then Key is TID8. Tag is its DOM Node.
  695. ' For a node being modified, Key is MODIFY_KEY_C.
  696. ' For a node under construction, Key is CREATE_KEY_C. Tag is the parent's DOM Node.
  697. ' A gotcha: You need to use CStr in p_colKeywords(CStr(intKID)).
  698. ' Otherwise, you will simply get the intKID'th keyword, not one with intKID as key.
  699. Private Sub Form_Load()
  700. SetLogFile
  701. Set g_AuthDatabase = New AuthDatabase.Main
  702. Set g_ErrorInfo = New CErrorInfo
  703. Set p_clsTaxonomy = g_AuthDatabase.Taxonomy
  704. Set p_clsHHT = g_AuthDatabase.HHT
  705. Set p_clsKeywords = g_AuthDatabase.Keywords
  706. Set p_clsParameters = g_AuthDatabase.Parameters
  707. Set p_clsSizer = New Sizer
  708. Set p_colKeywords = New Collection
  709. Set p_dictKeywordsWithTitle = New Scripting.Dictionary
  710. Set p_nodeMouseDown = Nothing
  711. Set p_nodeCopied = Nothing
  712. Set p_nodeCut = Nothing
  713. Set p_DOMNode = Nothing
  714. p_blnCtrlMouseDown = False
  715. p_blnHHKDragDrop = False
  716. p_blnAddRemoveKeywordsOpen = False
  717. tmrScrollDuringDrag.Enabled = False
  718. tmrScrollDuringDrag.Interval = 20
  719. PopulateCboWithSKUs cboNavigateLink
  720. p_InitializeLocIncludeCombo
  721. p_InitializeNavModelCombo
  722. p_enumFilterSKUs = ALL_SKUS_C
  723. p_StrikeoutUnselectedSKUs
  724. p_blnCreating = False
  725. p_blnUpdating = False
  726. p_blnDragging = False
  727. p_blnSettingControls = False
  728. ' The user needs to open a database first
  729. p_DisableEverything
  730. p_InitializeTaxonomyTree
  731. p_SetToolTips
  732. End Sub
  733. Private Sub Form_Unload(Cancel As Integer)
  734. Set g_AuthDatabase = Nothing
  735. Set g_ErrorInfo = Nothing
  736. Set g_Font = Nothing
  737. Set p_clsTaxonomy = Nothing
  738. Set p_clsHHT = Nothing
  739. Set p_clsKeywords = Nothing
  740. Set p_clsParameters = Nothing
  741. Set p_clsSizer = Nothing
  742. Set p_colKeywords = Nothing
  743. Set p_dictKeywordsWithTitle = Nothing
  744. Set p_nodeMouseDown = Nothing
  745. Set p_nodeCopied = Nothing
  746. Set p_nodeCut = Nothing
  747. Set p_DOMNode = Nothing
  748. AddRemoveKeywordsFormGoingAway
  749. Unload frmAddRemoveKeywords
  750. Unload frmFind
  751. Unload frmImporter
  752. End Sub
  753. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  754. If (p_blnCreating Or p_blnUpdating) Then
  755. MsgBox "You are in the middle of creating or updating an entry. " & _
  756. "Please finish or cancel first.", vbOKOnly
  757. Cancel = True
  758. End If
  759. End Sub
  760. Private Sub Form_Activate()
  761. On Error GoTo LErrorHandler
  762. p_SetSizingInfo
  763. Exit Sub
  764. LErrorHandler:
  765. g_ErrorInfo.SetInfoAndDump "Form_Activate"
  766. End Sub
  767. Private Sub Form_Resize()
  768. On Error GoTo LErrorHandler
  769. p_clsSizer.Resize
  770. Exit Sub
  771. LErrorHandler:
  772. g_ErrorInfo.SetInfoAndDump "Form_Resize"
  773. End Sub
  774. Private Sub mnuFileOpenDatabase_Click()
  775. Dim strDatabase As String
  776. On Error GoTo LErrorHandler
  777. dlgCommon.CancelError = True
  778. dlgCommon.Flags = cdlOFNHideReadOnly
  779. dlgCommon.Filter = MDB_FILE_FILTER_C
  780. dlgCommon.ShowOpen
  781. strDatabase = dlgCommon.FileName
  782. g_AuthDatabase.SetDatabase strDatabase
  783. p_SetTitle strDatabase
  784. cmdRefresh_Click
  785. ' Clear the cached list of all keywords from the old database
  786. AddRemoveKeywordsFormGoingAway
  787. Unload frmAddRemoveKeywords
  788. ' frmImporter may have an HHK with KIDs from the old database
  789. ' associated with Taxonomy entries.
  790. Unload frmImporter
  791. p_blnDatabaseOpen = True
  792. LEnd:
  793. Exit Sub
  794. LErrorHandler:
  795. Select Case Err.Number
  796. Case cdlCancel
  797. ' Nothing. The user cancelled.
  798. Case errDatabaseVersionIncompatible
  799. p_blnDatabaseOpen = False
  800. DisplayDatabaseVersionError
  801. Case errAuthoringGroupNotPresent
  802. p_blnDatabaseOpen = False
  803. DisplayAuthoringGroupError
  804. Case Else
  805. p_blnDatabaseOpen = False
  806. g_ErrorInfo.SetInfoAndDump "mnuFileOpenDatabase_Click"
  807. End Select
  808. GoTo LEnd
  809. End Sub
  810. Private Sub mnuToolsSetFont_Click()
  811. On Error GoTo LErrorHandler
  812. dlgCommon.CancelError = True
  813. dlgCommon.Flags = cdlCFBoth Or cdlCFEffects
  814. dlgCommon.ShowFont
  815. Set g_Font = New StdFont
  816. g_Font.Name = dlgCommon.FontName
  817. g_Font.Size = dlgCommon.FontSize
  818. g_Font.Bold = dlgCommon.FontBold
  819. g_Font.Italic = dlgCommon.FontItalic
  820. g_Font.Underline = dlgCommon.FontUnderline
  821. g_Font.Strikethrough = dlgCommon.FontStrikethru
  822. g_FontColor = dlgCommon.Color
  823. SetFont Me, g_Font, g_FontColor
  824. Exit Sub
  825. LErrorHandler:
  826. ' User pressed Cancel button.
  827. Exit Sub
  828. End Sub
  829. Private Sub mnuFileExportHHT_Click()
  830. Dim DOMNode As MSXML2.IXMLDOMNode
  831. Set DOMNode = treTaxonomy.Nodes(KEY_PREFIX_C & ROOT_TID_C).Tag
  832. p_ExportHHT DOMNode
  833. End Sub
  834. Private Sub mnuFileImportHHT_Click()
  835. On Error GoTo LErrorHandler
  836. Dim strFileName As String
  837. Dim Response As VbMsgBoxResult
  838. Response = MsgBox("Are you sure that you want to do this? " & _
  839. "This operation could create a lot of new Nodes and Topics " & _
  840. "throughout the Taxonomy tree.", _
  841. vbOKCancel + vbDefaultButton2 + vbExclamation)
  842. If (Response <> vbOK) Then
  843. Exit Sub
  844. End If
  845. dlgCommon.CancelError = True
  846. dlgCommon.Flags = cdlOFNHideReadOnly
  847. dlgCommon.Filter = XML_FILE_FILTER_C
  848. dlgCommon.ShowOpen
  849. strFileName = dlgCommon.FileName
  850. Me.Enabled = False
  851. p_clsHHT.ImportHHT strFileName
  852. cmdRefresh_Click
  853. LEnd:
  854. Me.Enabled = True
  855. Exit Sub
  856. LErrorHandler:
  857. Select Case Err.Number
  858. Case cdlCancel
  859. ' Nothing. The user cancelled.
  860. Case errDatabaseVersionIncompatible
  861. DisplayDatabaseVersionError
  862. Case errAuthoringGroupNotPresent
  863. DisplayAuthoringGroupError
  864. Case Else
  865. g_ErrorInfo.SetInfoAndDump "mnuFileImportHHT_Click"
  866. End Select
  867. GoTo LEnd
  868. End Sub
  869. Private Sub mnuFileExit_Click()
  870. Unload Me
  871. End Sub
  872. Private Sub mnuEditFind_Click()
  873. On Error GoTo LErrorHandler
  874. frmFind.Show vbModeless
  875. Exit Sub
  876. LErrorHandler:
  877. g_ErrorInfo.SetInfoAndDump "mnuEditFind_Click"
  878. End Sub
  879. Private Sub mnuEditCopy_Click()
  880. On Error GoTo LErrorHandler
  881. Set p_nodeCopied = treTaxonomy.SelectedItem
  882. Set p_nodeCut = Nothing
  883. Exit Sub
  884. LErrorHandler:
  885. g_ErrorInfo.SetInfoAndDump "mnuEditCopy_Click"
  886. End Sub
  887. Private Sub mnuEditCut_Click()
  888. On Error GoTo LErrorHandler
  889. Set p_nodeCut = treTaxonomy.SelectedItem
  890. Set p_nodeCopied = Nothing
  891. Exit Sub
  892. LErrorHandler:
  893. g_ErrorInfo.SetInfoAndDump "mnuEditCut_Click"
  894. End Sub
  895. Private Sub mnuEditPaste_Click()
  896. On Error GoTo LErrorHandler
  897. If (Not p_nodeCopied Is Nothing) Then
  898. p_CreateTaxonomyEntries p_nodeCopied.Tag, treTaxonomy.SelectedItem, True
  899. ElseIf (Not p_nodeCut Is Nothing) Then
  900. p_ChangeParent p_nodeCut, treTaxonomy.SelectedItem
  901. Set p_nodeCut = Nothing
  902. p_DisableEditPaste
  903. End If
  904. Exit Sub
  905. LErrorHandler:
  906. g_ErrorInfo.SetInfoAndDump "mnuEditPaste_Click"
  907. End Sub
  908. Private Sub mnuEditCopyKeywords_Click()
  909. On Error GoTo LErrorHandler
  910. p_strKeywords = XMLGetAttribute(treTaxonomy.SelectedItem.Tag, HHT_keywords_C)
  911. p_EnableEditPasteKeywords
  912. Exit Sub
  913. LErrorHandler:
  914. g_ErrorInfo.SetInfoAndDump "mnuEditCopyKeywords_Click"
  915. End Sub
  916. Private Sub mnuEditPasteKeywords_Click()
  917. On Error Resume Next
  918. Dim Node As Node
  919. Dim blnDisableEditPasteKeywords As Boolean
  920. Dim intTID As Long
  921. If (p_blnCreating Or p_blnUpdating) Then
  922. MsgBox "You are in the middle of creating or updating an entry. " & _
  923. "Please finish or cancel first.", vbOKOnly
  924. Exit Sub
  925. End If
  926. blnDisableEditPasteKeywords = True
  927. For Each Node In treTaxonomy.Nodes
  928. If Node.Checked Then
  929. Err.Clear
  930. p_SetKeywords Node.Tag
  931. If (Err.Number <> 0) Then
  932. blnDisableEditPasteKeywords = False
  933. Err.Clear
  934. Else
  935. Node.Checked = False
  936. End If
  937. End If
  938. Next
  939. If (blnDisableEditPasteKeywords) Then
  940. p_DisableEditPasteKeywords
  941. p_strKeywords = ""
  942. Else
  943. MsgBox "Not all Nodes/Topics could be updated.", vbOKOnly
  944. End If
  945. intTID = XMLGetAttribute(treTaxonomy.SelectedItem.Tag, HHT_tid_C)
  946. ' The UI must show the new keywords that were associated.
  947. Highlight intTID
  948. End Sub
  949. Private Sub mnuEditStopSigns_Click()
  950. frmStopSigns.Show vbModal
  951. End Sub
  952. Private Sub mnuEditStopWords_Click()
  953. frmStopWords.Show vbModal
  954. End Sub
  955. Private Sub mnuEditKeywords_Click()
  956. frmKeywords.Show vbModal
  957. End Sub
  958. Private Sub mnuEditSynonymSets_Click()
  959. frmSynonymSets.Show vbModal
  960. End Sub
  961. Private Sub mnuToolsCreateHHTandCAB_Click()
  962. p_blnNoHHTStatus = True
  963. frmHHT.Show vbModal
  964. p_blnNoHHTStatus = False
  965. End Sub
  966. Private Sub mnuToolsFilterBySKU_Click()
  967. frmFilterSKU.SetSKUs p_enumFilterSKUs
  968. frmFilterSKU.Show vbModal
  969. End Sub
  970. Private Sub mnuToolsImporter_Click()
  971. frmImporter.Show vbModeless
  972. End Sub
  973. Private Sub mnuToolsParameters_Click()
  974. frmParameters.Show vbModal
  975. End Sub
  976. Private Sub mnuToolsPropagateKeywords_Click()
  977. On Error GoTo LErrorHandler
  978. Dim T0 As Date
  979. Dim T1 As Date
  980. Dim strStatusText As String
  981. strStatusText = p_GetStatusText(SBPANEL_DATABASE)
  982. Me.MousePointer = vbHourglass
  983. Me.Enabled = False
  984. T0 = Now
  985. p_SetStatusText SBPANEL_DATABASE, "Propagating keywords..."
  986. p_clsTaxonomy.PropagateKeywords
  987. p_SetStatusText SBPANEL_DATABASE, strStatusText
  988. T1 = Now
  989. Debug.Print "mnuToolsPropagateKeywords_Click: " & FormatTime(T0, T1)
  990. cmdRefresh_Click
  991. LEnd:
  992. Me.Enabled = True
  993. Me.MousePointer = vbDefault
  994. Exit Sub
  995. LErrorHandler:
  996. p_SetStatusText SBPANEL_DATABASE, strStatusText
  997. Select Case Err.Number
  998. Case E_FAIL
  999. DisplayDatabaseLockedError
  1000. Case errDatabaseVersionIncompatible
  1001. DisplayDatabaseVersionError
  1002. Case Else:
  1003. g_ErrorInfo.SetInfoAndDump "mnuToolsPropagateKeywords_Click"
  1004. End Select
  1005. GoTo LEnd
  1006. End Sub
  1007. Private Sub mnuRightClickCopy_Click()
  1008. mnuEditCopy_Click
  1009. End Sub
  1010. Private Sub mnuRightClickCut_Click()
  1011. mnuEditCut_Click
  1012. End Sub
  1013. Private Sub mnuRightClickPaste_Click()
  1014. mnuEditPaste_Click
  1015. End Sub
  1016. Private Sub mnuRightClickCopyKeywords_Click()
  1017. mnuEditCopyKeywords_Click
  1018. End Sub
  1019. Private Sub mnuRightClickPasteKeywords_Click()
  1020. mnuEditPasteKeywords_Click
  1021. End Sub
  1022. Private Sub mnuRightClickCreateNode_Click()
  1023. cmdCreateGroup_Click
  1024. End Sub
  1025. Private Sub mnuRightClickCreateTopic_Click()
  1026. cmdCreateLeaf_Click
  1027. End Sub
  1028. Private Sub mnuRightClickDelete_Click()
  1029. cmdDelete_Click
  1030. End Sub
  1031. Private Sub mnuRightClickKeywordify_Click()
  1032. On Error GoTo LErrorHandler
  1033. Dim DOMNode As MSXML2.IXMLDOMNode
  1034. Dim intTID As Long
  1035. Dim T0 As Date
  1036. Dim T1 As Date
  1037. Dim strStatusText As String
  1038. Dim Response As VbMsgBoxResult
  1039. strStatusText = p_GetStatusText(SBPANEL_DATABASE)
  1040. Response = MsgBox("Are you sure that you want to create Keywords from Titles of the " & _
  1041. "Node/Topic and its descendents?", _
  1042. vbOKCancel + vbDefaultButton2)
  1043. If (Response <> vbOK) Then
  1044. Exit Sub
  1045. End If
  1046. Me.MousePointer = vbHourglass
  1047. Me.Enabled = False
  1048. Set DOMNode = treTaxonomy.SelectedItem.Tag
  1049. intTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  1050. T0 = Now
  1051. p_clsTaxonomy.KeywordifyTitles intTID
  1052. T1 = Now
  1053. Debug.Print "mnuRightClickKeywordify_Click: " & FormatTime(T0, T1)
  1054. p_SetStatusText SBPANEL_DATABASE, strStatusText
  1055. mnuToolsPropagateKeywords_Click
  1056. LEnd:
  1057. Me.Enabled = True
  1058. Me.MousePointer = vbDefault
  1059. Exit Sub
  1060. LErrorHandler:
  1061. p_SetStatusText SBPANEL_DATABASE, strStatusText
  1062. Select Case Err.Number
  1063. Case E_FAIL
  1064. DisplayDatabaseLockedError
  1065. Case errDatabaseVersionIncompatible
  1066. DisplayDatabaseVersionError
  1067. Case Else:
  1068. g_ErrorInfo.SetInfoAndDump "mnuRightClickKeywordify_Click"
  1069. End Select
  1070. GoTo LEnd
  1071. End Sub
  1072. Private Sub mnuRightClickExport_Click()
  1073. p_ExportHHT p_nodeMouseDown.Tag
  1074. End Sub
  1075. Private Sub mnuHelpContents_Click()
  1076. Dim strCmd As String
  1077. strCmd = HELP_EXE_C & " " & App.Path & "\" & HELP_FILE_NAME_C
  1078. Shell strCmd, vbNormalFocus
  1079. End Sub
  1080. Private Sub mnuHelpAbout_Click()
  1081. frmAbout.Show vbModal
  1082. End Sub
  1083. Private Sub chkVisible_Click()
  1084. If (Not p_blnSettingControls) Then
  1085. p_UserChangedSomethingForCurrentNode
  1086. End If
  1087. End Sub
  1088. Private Sub chkSubSite_Click()
  1089. If (Not p_blnSettingControls) Then
  1090. p_UserChangedSomethingForCurrentNode
  1091. End If
  1092. End Sub
  1093. Private Sub cboLocInclude_Change()
  1094. If (Not p_blnSettingControls) Then
  1095. p_UserChangedSomethingForCurrentNode
  1096. End If
  1097. End Sub
  1098. Private Sub p_clsTaxonomy_ReportStatus(ByVal strStatus As String, blnCancel As Boolean)
  1099. p_SetStatusText SBPANEL_DATABASE, strStatus
  1100. DoEvents
  1101. End Sub
  1102. Private Sub p_clsHHT_ReportStatus(ByVal strStatus As String, blnCancel As Boolean)
  1103. If (Not p_blnNoHHTStatus) Then
  1104. p_SetStatusText SBPANEL_DATABASE, strStatus
  1105. End If
  1106. DoEvents
  1107. End Sub
  1108. Private Sub txtTitle_Change()
  1109. On Error GoTo LErrorHandler
  1110. Dim Node As Node
  1111. If (p_blnSettingControls) Then
  1112. Exit Sub
  1113. End If
  1114. p_UserChangedSomethingForCurrentNode
  1115. If (p_blnCreating) Then
  1116. Set Node = treTaxonomy.Nodes(CREATE_KEY_C)
  1117. Node.Text = txtTitle
  1118. ElseIf (p_blnUpdating) Then
  1119. Set Node = treTaxonomy.Nodes(MODIFY_KEY_C)
  1120. Node.Text = txtTitle
  1121. End If
  1122. Exit Sub
  1123. LErrorHandler:
  1124. g_ErrorInfo.SetInfoAndDump "txtTitle_Change"
  1125. End Sub
  1126. Private Sub txtDescription_Change()
  1127. If (Not p_blnSettingControls) Then
  1128. p_UserChangedSomethingForCurrentNode
  1129. End If
  1130. End Sub
  1131. Private Sub cboNavModel_Click()
  1132. If (Not p_blnSettingControls) Then
  1133. p_UserChangedSomethingForCurrentNode
  1134. End If
  1135. End Sub
  1136. Private Sub cboNavModel_Change()
  1137. If (Not p_blnSettingControls) Then
  1138. p_UserChangedSomethingForCurrentNode
  1139. End If
  1140. End Sub
  1141. Private Sub cboType_Click()
  1142. If (Not p_blnSettingControls) Then
  1143. p_UserChangedSomethingForCurrentNode
  1144. End If
  1145. End Sub
  1146. Private Sub cboType_Change()
  1147. If (Not p_blnSettingControls) Then
  1148. p_UserChangedSomethingForCurrentNode
  1149. End If
  1150. End Sub
  1151. Private Sub txtURI_Change()
  1152. If (Not p_blnSettingControls) Then
  1153. p_UserChangedSomethingForCurrentNode
  1154. End If
  1155. End Sub
  1156. Private Sub txtIconURI_Change()
  1157. If (Not p_blnSettingControls) Then
  1158. p_UserChangedSomethingForCurrentNode
  1159. End If
  1160. End Sub
  1161. Private Sub txtComments_Change()
  1162. If (Not p_blnSettingControls) Then
  1163. p_UserChangedSomethingForCurrentNode
  1164. End If
  1165. End Sub
  1166. Private Sub txtEntry_Change()
  1167. If (Not p_blnSettingControls) Then
  1168. p_UserChangedSomethingForCurrentNode
  1169. End If
  1170. End Sub
  1171. Private Sub chkStandard_Click()
  1172. If (Not p_blnSettingControls) Then
  1173. p_UserChangedSomethingForCurrentNode
  1174. End If
  1175. End Sub
  1176. Private Sub chkProfessional_Click()
  1177. If (Not p_blnSettingControls) Then
  1178. p_UserChangedSomethingForCurrentNode
  1179. End If
  1180. End Sub
  1181. Private Sub chkProfessional64_Click()
  1182. If (Not p_blnSettingControls) Then
  1183. p_UserChangedSomethingForCurrentNode
  1184. End If
  1185. End Sub
  1186. Private Sub chkWindowsMillennium_Click()
  1187. If (Not p_blnSettingControls) Then
  1188. p_UserChangedSomethingForCurrentNode
  1189. End If
  1190. End Sub
  1191. Private Sub chkServer_Click()
  1192. If (Not p_blnSettingControls) Then
  1193. p_UserChangedSomethingForCurrentNode
  1194. End If
  1195. End Sub
  1196. Private Sub chkAdvancedServer_Click()
  1197. If (Not p_blnSettingControls) Then
  1198. p_UserChangedSomethingForCurrentNode
  1199. End If
  1200. End Sub
  1201. Private Sub chkDataCenterServer_Click()
  1202. If (Not p_blnSettingControls) Then
  1203. p_UserChangedSomethingForCurrentNode
  1204. End If
  1205. End Sub
  1206. Private Sub chkAdvancedServer64_Click()
  1207. If (Not p_blnSettingControls) Then
  1208. p_UserChangedSomethingForCurrentNode
  1209. End If
  1210. End Sub
  1211. Private Sub chkDataCenterServer64_Click()
  1212. If (Not p_blnSettingControls) Then
  1213. p_UserChangedSomethingForCurrentNode
  1214. End If
  1215. End Sub
  1216. Private Sub treTaxonomy_Collapse(ByVal Node As MSComctlLib.Node)
  1217. If (Node = treTaxonomy.SelectedItem) Then
  1218. treTaxonomy_NodeClick Node
  1219. End If
  1220. End Sub
  1221. Private Sub treTaxonomy_NodeClick(ByVal Node As MSComctlLib.Node)
  1222. On Error GoTo LErrorHandler
  1223. Dim blnUpdateControls As Boolean
  1224. Dim DOMNode As MSXML2.IXMLDOMNode
  1225. Dim intAG As Long
  1226. If (p_blnCreating Or p_blnUpdating) Then
  1227. ' The user wants to go to a different Group/Leaf.
  1228. ' Assume that he wants to save his changes.
  1229. p_SaveClicked blnUpdateControls
  1230. If (Not blnUpdateControls) Then
  1231. Exit Sub
  1232. End If
  1233. End If
  1234. If (p_NodeDeleted(Node)) Then
  1235. ' If we start creating a node X, and then Create it by right clicking
  1236. ' on it, then we will come here. The info on the RHS is up to date.
  1237. ' So it is OK to simply exit.
  1238. Exit Sub
  1239. End If
  1240. Set DOMNode = Node.Tag
  1241. p_UpdateRHSControls DOMNode
  1242. Set treTaxonomy.SelectedItem = Node
  1243. If (p_IsLeaf(Node)) Then
  1244. p_DisableCreate
  1245. p_DisableEditPaste
  1246. p_DisableSubSite
  1247. p_DisableEditEntry
  1248. p_DisableNavModel
  1249. Else
  1250. p_EnableCreate
  1251. p_EnableSubSite
  1252. p_EnableNavModel
  1253. p_EnableEditEntry
  1254. If (Not p_nodeCut Is Nothing) Then
  1255. p_EnableEditPaste
  1256. ElseIf (Not p_nodeCopied Is Nothing) Then
  1257. p_EnableEditPaste
  1258. End If
  1259. End If
  1260. intAG = XMLGetAttribute(DOMNode, HHT_authoringgroup_C)
  1261. If (intAG = p_intAuthoringGroup) Then
  1262. p_EnableNodeDetailsExceptIndividualSKUs
  1263. Else
  1264. p_DisableNodeDetails
  1265. p_DisableDelete
  1266. p_DisableEditCut
  1267. End If
  1268. If (p_IsRoot(Node)) Then
  1269. p_DisableDelete
  1270. p_DisableEditCopy
  1271. p_DisableEditCut
  1272. p_DisableAddRemoveAndKeywordsCombo
  1273. Else
  1274. p_EnableEditCopy
  1275. If (intAG = p_intAuthoringGroup) Then
  1276. p_EnableDelete
  1277. p_EnableEditCut
  1278. p_EnableAddRemoveAndKeywordsCombo
  1279. End If
  1280. End If
  1281. Exit Sub
  1282. LErrorHandler:
  1283. g_ErrorInfo.SetInfoAndDump "treTaxonomy_NodeClick"
  1284. End Sub
  1285. Private Sub mnuMoveAbove_Click()
  1286. p_Move p_nodeMouseDown, treTaxonomy.DropHighlight, True
  1287. End Sub
  1288. Private Sub mnuMoveBelow_Click()
  1289. p_Move p_nodeMouseDown, treTaxonomy.DropHighlight, False
  1290. End Sub
  1291. Private Sub mnuMoveInside_Click()
  1292. p_ChangeParent p_nodeMouseDown, treTaxonomy.DropHighlight
  1293. End Sub
  1294. Private Sub p_PopupMoveMenu(i_Node As Node)
  1295. mnuMoveInside.Visible = True
  1296. mnuMoveAbove.Visible = True
  1297. mnuMoveBelow.Visible = True
  1298. If (p_IsLeaf(i_Node)) Then
  1299. mnuMoveInside.Visible = False
  1300. ElseIf (p_IsRoot(i_Node)) Then
  1301. mnuMoveAbove.Visible = False
  1302. mnuMoveBelow.Visible = False
  1303. End If
  1304. PopupMenu mnuMove
  1305. End Sub
  1306. Private Sub treTaxonomy_DragDrop(Source As Control, x As Single, y As Single)
  1307. On Error GoTo LErrorHandler
  1308. Dim nodeCurrent As Node
  1309. Dim Response As VbMsgBoxResult
  1310. Dim enumSKUs As SKU_E
  1311. Dim intParentTID As Long
  1312. Set nodeCurrent = treTaxonomy.DropHighlight
  1313. If (Not (nodeCurrent Is Nothing)) Then
  1314. If (Not p_nodeMouseDown Is Nothing) Then
  1315. If (p_nodeMouseDown.Key <> nodeCurrent.Key) Then
  1316. If (p_blnCtrlMouseDown) Then
  1317. If (Not p_IsLeaf(nodeCurrent)) Then
  1318. Response = MsgBox("Are you sure that you want to create " & _
  1319. "a copy of this Node or Topic?", _
  1320. vbOKCancel + vbDefaultButton1)
  1321. If (Response = vbOK) Then
  1322. p_CreateTaxonomyEntries p_nodeMouseDown.Tag, nodeCurrent, _
  1323. True
  1324. End If
  1325. End If
  1326. Else
  1327. p_PopupMoveMenu nodeCurrent
  1328. End If
  1329. End If
  1330. ElseIf (Not (p_DOMNode Is Nothing)) Then
  1331. If (p_blnCreating Or p_blnUpdating) Then
  1332. MsgBox "You are in the middle of creating or updating an entry. " & _
  1333. "Please finish or cancel first.", vbOKOnly
  1334. ElseIf (p_IsLeaf(nodeCurrent)) Then
  1335. MsgBox "Please drop over a Node, not a Topic.", vbOKOnly
  1336. Else
  1337. enumSKUs = frmImporter.GetSelectedSKUs
  1338. intParentTID = XMLGetAttribute(nodeCurrent.Tag, HHT_tid_C)
  1339. p_ReplaceTaxonomySubtree p_DOMNode, intParentTID, enumSKUs, True
  1340. Set p_DOMNode = Nothing
  1341. End If
  1342. End If
  1343. End If
  1344. Set treTaxonomy.DropHighlight = Nothing
  1345. Set p_nodeMouseDown = Nothing
  1346. Set p_DOMNode = Nothing
  1347. p_blnCtrlMouseDown = False
  1348. p_blnDragging = False
  1349. tmrScrollDuringDrag.Enabled = False
  1350. Exit Sub
  1351. LErrorHandler:
  1352. g_ErrorInfo.SetInfoAndDump "treTaxonomy_DragDrop"
  1353. End Sub
  1354. Private Sub treTaxonomy_DragOver(Source As Control, x As Single, y As Single, State As Integer)
  1355. On Error GoTo LErrorHandler
  1356. Dim nodeCurrent As Node
  1357. If (p_blnDragging) Then
  1358. If (y > 0 And y < 800) Then
  1359. 'scroll up
  1360. p_blnScrollUp = True
  1361. tmrScrollDuringDrag.Enabled = True
  1362. ElseIf (y > (treTaxonomy.Height - 800) And y < treTaxonomy.Height) Then
  1363. 'scroll down
  1364. p_blnScrollUp = False
  1365. tmrScrollDuringDrag.Enabled = True
  1366. Else
  1367. tmrScrollDuringDrag.Enabled = False
  1368. End If
  1369. Set nodeCurrent = treTaxonomy.HitTest(x, y)
  1370. If (nodeCurrent Is Nothing) Then
  1371. Exit Sub
  1372. End If
  1373. If (p_blnCtrlMouseDown And p_IsLeaf(nodeCurrent)) Then
  1374. Exit Sub
  1375. End If
  1376. Set treTaxonomy.DropHighlight = nodeCurrent
  1377. 'nodeCurrent.Expanded = True Users hated this.
  1378. End If
  1379. Exit Sub
  1380. LErrorHandler:
  1381. g_ErrorInfo.SetInfoAndDump "treTaxonomy_DragOver"
  1382. End Sub
  1383. Private Sub treTaxonomy_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1384. If (Not p_blnCreating And Not p_blnUpdating) Then
  1385. If (treTaxonomy.Checkboxes) Then
  1386. Exit Sub
  1387. End If
  1388. Set p_nodeMouseDown = treTaxonomy.HitTest(x, y)
  1389. If (p_nodeMouseDown Is Nothing) Then
  1390. Exit Sub
  1391. End If
  1392. treTaxonomy_NodeClick p_nodeMouseDown
  1393. If (p_IsRoot(p_nodeMouseDown)) Then
  1394. Set p_nodeMouseDown = Nothing
  1395. End If
  1396. If (Not (p_nodeMouseDown Is Nothing)) Then
  1397. If (Shift = vbCtrlMask) Then
  1398. p_blnCtrlMouseDown = True
  1399. Else
  1400. p_blnCtrlMouseDown = False
  1401. End If
  1402. End If
  1403. End If
  1404. End Sub
  1405. Private Sub treTaxonomy_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  1406. On Error GoTo LErrorHandler
  1407. If ((Not p_blnCreating And Not p_blnUpdating) And _
  1408. (Button = vbLeftButton) And _
  1409. (Not (p_nodeMouseDown Is Nothing))) Then
  1410. p_blnDragging = True
  1411. treTaxonomy.DragIcon = p_nodeMouseDown.CreateDragImage
  1412. treTaxonomy.Drag vbBeginDrag
  1413. End If
  1414. Exit Sub
  1415. LErrorHandler:
  1416. ' If a node is selected, and then the user clicks on mnuFileOpenDatabase,
  1417. ' and double clicks a database, this event fires. We get the exception "This item's
  1418. ' control has been deleted".
  1419. End Sub
  1420. Public Sub BeginDrag( _
  1421. ByVal i_DOMNode As MSXML2.IXMLDOMNode, _
  1422. ByVal i_blnHHK As Boolean _
  1423. )
  1424. ' Something is being dragged over from the frmImporter form.
  1425. Set p_nodeMouseDown = Nothing
  1426. p_blnCtrlMouseDown = False
  1427. Set p_DOMNode = i_DOMNode
  1428. p_blnHHKDragDrop = i_blnHHK
  1429. If (Not i_DOMNode Is Nothing) Then
  1430. p_blnDragging = True
  1431. Else
  1432. p_blnDragging = False
  1433. End If
  1434. End Sub
  1435. Private Sub treTaxonomy_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  1436. tmrScrollDuringDrag.Enabled = False
  1437. If (Not p_blnCreating And Not p_blnUpdating) Then
  1438. Set p_nodeMouseDown = treTaxonomy.HitTest(x, y)
  1439. If (p_nodeMouseDown Is Nothing) Then
  1440. Exit Sub
  1441. End If
  1442. If (Button = vbRightButton) Then
  1443. Set treTaxonomy.SelectedItem = p_nodeMouseDown
  1444. PopupMenu mnuRightClick
  1445. End If
  1446. End If
  1447. End Sub
  1448. Private Sub Form_DragOver(Source As Control, x As Single, y As Single, State As Integer)
  1449. If Source.Name = "treTaxonomy" Then
  1450. tmrScrollDuringDrag.Enabled = False
  1451. End If
  1452. End Sub
  1453. Private Sub tmrScrollDuringDrag_Timer()
  1454. If (p_blnScrollUp) Then
  1455. ' Send a WM_VSCROLL message 0 is up and 1 is down
  1456. SendMessage treTaxonomy.hwnd, 277&, 0&, vbNull
  1457. Else
  1458. 'Scroll Down
  1459. SendMessage treTaxonomy.hwnd, 277&, 1&, vbNull
  1460. End If
  1461. End Sub
  1462. Private Sub tmrRefresh_Timer()
  1463. ' Auto refresh every 30 min because we cache the database.
  1464. Static intTicks As Long
  1465. intTicks = intTicks + 1
  1466. If (intTicks <> 100) Then
  1467. Exit Sub
  1468. End If
  1469. intTicks = 0
  1470. If (p_blnUpdating Or p_blnCreating) Then
  1471. Exit Sub
  1472. End If
  1473. If (Not p_blnDatabaseOpen) Then
  1474. Exit Sub
  1475. End If
  1476. ' cmdRefresh_Click
  1477. End Sub
  1478. Private Sub cmdCreateGroup_Click()
  1479. On Error GoTo LErrorHandler
  1480. p_CreateNode True
  1481. Exit Sub
  1482. LErrorHandler:
  1483. g_ErrorInfo.SetInfoAndDump "cmdCreateGroup_Click"
  1484. End Sub
  1485. Private Sub cmdCreateLeaf_Click()
  1486. On Error GoTo LErrorHandler
  1487. p_CreateNode False
  1488. Exit Sub
  1489. LErrorHandler:
  1490. g_ErrorInfo.SetInfoAndDump "cmdCreateLeaf_Click"
  1491. End Sub
  1492. Private Sub cmdDelete_Click()
  1493. On Error GoTo LErrorHandler
  1494. Dim nodeCurrent As Node
  1495. Dim strTitle As String
  1496. Dim str1 As String
  1497. Dim str2 As String
  1498. Dim Response As VbMsgBoxResult
  1499. Dim dtmModifiedTime As Date
  1500. Dim intTID As Long
  1501. Dim DOMNodeParent As MSXML2.IXMLDOMNode
  1502. Dim strStatusText As String
  1503. strStatusText = p_GetStatusText(SBPANEL_DATABASE)
  1504. If (p_blnCreating Or p_blnUpdating) Then
  1505. GoTo LEnd
  1506. End If
  1507. Set nodeCurrent = treTaxonomy.SelectedItem
  1508. strTitle = txtTitle
  1509. If (p_IsLeaf(nodeCurrent)) Then
  1510. str1 = "topic """
  1511. str2 = """"
  1512. Else
  1513. str1 = "node """
  1514. str2 = """ and all its children"
  1515. End If
  1516. Response = MsgBox("Are you sure that you want to permanently delete " & _
  1517. str1 & strTitle & str2 & "?", vbOKCancel + vbDefaultButton2)
  1518. If (Response <> vbOK) Then
  1519. GoTo LEnd
  1520. End If
  1521. Me.Enabled = False
  1522. dtmModifiedTime = XMLGetAttribute(nodeCurrent.Tag, HHT_modifiedtime_C)
  1523. intTID = XMLGetAttribute(nodeCurrent.Tag, HHT_tid_C)
  1524. p_clsTaxonomy.Delete intTID, dtmModifiedTime
  1525. Set DOMNodeParent = nodeCurrent.Tag.parentNode
  1526. DOMNodeParent.removeChild nodeCurrent.Tag
  1527. treTaxonomy.Nodes.Remove treTaxonomy.SelectedItem.Key
  1528. treTaxonomy_NodeClick treTaxonomy.SelectedItem
  1529. LEnd:
  1530. Me.Enabled = True
  1531. p_SetStatusText SBPANEL_DATABASE, strStatusText
  1532. Exit Sub
  1533. LErrorHandler:
  1534. Select Case Err.Number
  1535. Case errNodeOrTopicAlreadyModified
  1536. MsgBox "Someone else already modified this entry. " & _
  1537. "You need to Refresh the database and then try again. " & _
  1538. "This prevents you from accidentally overwriting something " & _
  1539. "the other person entered.", _
  1540. vbExclamation + vbOKOnly
  1541. Case E_FAIL
  1542. DisplayDatabaseLockedError
  1543. Case errDatabaseVersionIncompatible
  1544. DisplayDatabaseVersionError
  1545. Case errNotPermittedForAuthoringGroup, errAuthoringGroupDiffers, errAuthoringGroupNotPresent
  1546. DisplayAuthoringGroupError
  1547. Case Else:
  1548. g_ErrorInfo.SetInfoAndDump "cmdDelete_Click"
  1549. End Select
  1550. GoTo LEnd
  1551. End Sub
  1552. Private Sub cmdRefresh_Click()
  1553. On Error GoTo LErrorHandler
  1554. Dim DOMNode As MSXML2.IXMLDOMNode
  1555. Dim intTID As Long
  1556. p_intAuthoringGroup = p_clsParameters.AuthoringGroup
  1557. If (treTaxonomy.SelectedItem Is Nothing) Then
  1558. intTID = ROOT_TID_C
  1559. Else
  1560. intTID = XMLGetAttribute(treTaxonomy.SelectedItem.Tag, HHT_tid_C)
  1561. End If
  1562. Me.MousePointer = vbHourglass
  1563. p_InitializeDataStructures DOMNode
  1564. p_Refresh DOMNode
  1565. p_SetStatusText SBPANEL_DATABASE, "Database last read at: " & Now
  1566. If (p_NodeExists(intTID)) Then
  1567. treTaxonomy_NodeClick treTaxonomy.Nodes(KEY_PREFIX_C & intTID)
  1568. Else
  1569. treTaxonomy_NodeClick treTaxonomy.Nodes(KEY_PREFIX_C & ROOT_TID_C)
  1570. End If
  1571. LEnd:
  1572. Me.MousePointer = vbDefault
  1573. Exit Sub
  1574. LErrorHandler:
  1575. Me.Enabled = True
  1576. Select Case Err.Number
  1577. Case errAuthoringGroupNotPresent
  1578. DisplayAuthoringGroupError
  1579. Case Else
  1580. g_ErrorInfo.SetInfoAndDump "cmdRefresh_Click"
  1581. End Select
  1582. GoTo LEnd
  1583. End Sub
  1584. Private Sub cmdURI_Click()
  1585. frmURI.SetOldURI txtURI
  1586. frmURI.Show vbModal
  1587. End Sub
  1588. Private Sub cmdEditEntry_Click()
  1589. Dim Response As VbMsgBoxResult
  1590. If (Not p_blnCreating) Then
  1591. Response = MsgBox("Are you sure that you want to change this ENTRY? " & _
  1592. "Changing the ENTRY does not change the TITLE, " & _
  1593. "but it does change the identifier that others may be using " & _
  1594. "to reference this topic. If you really want to change this ENTRY, " & _
  1595. "please notify everybody who is linking to this topic so they can " & _
  1596. "update their hyperlink.", _
  1597. vbOKCancel + vbDefaultButton2 + vbExclamation)
  1598. If (Response <> vbOK) Then
  1599. p_DisableEntry
  1600. Exit Sub
  1601. End If
  1602. End If
  1603. p_EnableEntry
  1604. End Sub
  1605. Private Sub cmdNavigateLink_Click()
  1606. On Error GoTo LErrorHandler
  1607. Dim strBrokenLinkDir As String
  1608. Dim strVendor As String
  1609. Dim strURI As String
  1610. Dim Browser As HTMLDocument
  1611. strBrokenLinkDir = p_GetBrokenLinkDir(cboNavigateLink.ItemData(cboNavigateLink.ListIndex))
  1612. strVendor = p_clsParameters.Value(VENDOR_STRING_C) & ""
  1613. LinkValid strBrokenLinkDir, strVendor, txtURI, strURI
  1614. Set Browser = New HTMLDocument
  1615. Browser.url = strURI
  1616. Exit Sub
  1617. LErrorHandler:
  1618. Select Case Err.Number
  1619. Case errNotConfiguredForNavigateLink
  1620. MsgBox "Please verify that you've selected the correct SKU. " & _
  1621. "If the SKU is correct, the database needs to be configured " & _
  1622. "to point to the BrokenLinkWorkingDir.", _
  1623. vbExclamation Or vbOKOnly
  1624. Case Else
  1625. g_ErrorInfo.SetInfoAndDump "cmdNavigateLink_Click"
  1626. End Select
  1627. End Sub
  1628. Public Function GetNavigateLinkURI(i_intListIndex As Long) As String
  1629. On Error GoTo LErrorHandler
  1630. Dim strBrokenLinkDir As String
  1631. Dim strVendor As String
  1632. If (txtURI = "") Then
  1633. Exit Function
  1634. End If
  1635. strBrokenLinkDir = p_GetBrokenLinkDir(cboNavigateLink.ItemData(i_intListIndex))
  1636. strVendor = p_clsParameters.Value(VENDOR_STRING_C) & ""
  1637. LinkValid strBrokenLinkDir, strVendor, txtURI, GetNavigateLinkURI
  1638. Exit Function
  1639. LErrorHandler:
  1640. Select Case Err.Number
  1641. Case errNotConfiguredForNavigateLink
  1642. MsgBox "Please verify that you've selected the correct SKU. " & _
  1643. "If the SKU is correct, the database needs to be configured " & _
  1644. "to point to the BrokenLinkWorkingDir.", _
  1645. vbExclamation Or vbOKOnly
  1646. Case Else
  1647. g_ErrorInfo.SetInfoAndDump "GetNavigateLinkURI"
  1648. End Select
  1649. End Function
  1650. Private Sub cmdAddRemove_Click()
  1651. On Error GoTo LErrorHandler
  1652. Dim Node As Node
  1653. Set Node = treTaxonomy.SelectedItem
  1654. If (Node Is Nothing) Then
  1655. Exit Sub
  1656. End If
  1657. frmAddRemoveKeywords.SetKeywords p_dictKeywordsWithTitle
  1658. frmAddRemoveKeywords.SetTitle txtTitle, p_IsLeaf(Node)
  1659. If (txtURI <> "") Then
  1660. frmAddRemoveKeywords.LinkNavigable True
  1661. Else
  1662. frmAddRemoveKeywords.LinkNavigable False
  1663. End If
  1664. If (Not p_blnAddRemoveKeywordsOpen) Then
  1665. frmAddRemoveKeywords.Show vbModeless
  1666. p_blnAddRemoveKeywordsOpen = True
  1667. End If
  1668. Exit Sub
  1669. LErrorHandler:
  1670. g_ErrorInfo.SetInfoAndDump "cmdAddRemove_Click"
  1671. End Sub
  1672. Private Sub cboKeywords_KeyPress(KeyAscii As Integer)
  1673. On Error GoTo LErrorHandler
  1674. Dim strKeyword As String
  1675. Dim intIndex As Long
  1676. Dim intKID As Long
  1677. Dim Response As VbMsgBoxResult
  1678. If (KeyAscii <> Asc(vbCr)) Then
  1679. Exit Sub
  1680. End If
  1681. strKeyword = RemoveExtraSpaces(cboKeywords.Text)
  1682. cboKeywords.Text = ""
  1683. For intIndex = 0 To cboKeywords.ListCount
  1684. If (LCase$(strKeyword) = LCase$(cboKeywords.List(intIndex))) Then
  1685. Exit Sub
  1686. End If
  1687. Next
  1688. intKID = p_clsKeywords.GetKIDOfKeyword(strKeyword)
  1689. If (intKID = INVALID_ID_C) Then
  1690. Response = MsgBox( _
  1691. "The keyword """ & strKeyword & """ doesn't exist. Do you want to create it?", _
  1692. vbOKCancel + vbDefaultButton1)
  1693. If (Response = vbCancel) Then
  1694. Exit Sub
  1695. End If
  1696. End If
  1697. intKID = p_clsKeywords.Create(strKeyword)
  1698. p_dictKeywordsWithTitle.Add intKID, strKeyword
  1699. If (Not CollectionContainsKey(p_colKeywords, intKID)) Then
  1700. p_colKeywords.Add strKeyword, CStr(intKID)
  1701. End If
  1702. p_SetKeywordsList
  1703. p_UserChangedSomethingForCurrentNode
  1704. Exit Sub
  1705. LErrorHandler:
  1706. Select Case Err.Number
  1707. Case errContainsGarbageChar
  1708. MsgBox "The Keyword " & strKeyword & " contains garbage characters.", _
  1709. vbExclamation + vbOKOnly
  1710. Case errContainsStopSign
  1711. MsgBox "The Keyword " & strKeyword & " contains a Stop Sign.", _
  1712. vbExclamation + vbOKOnly
  1713. Case errContainsStopWord
  1714. MsgBox "The Keyword " & strKeyword & " contains a Stop Word.", _
  1715. vbExclamation + vbOKOnly
  1716. Case errContainsOperatorShortcut
  1717. MsgBox "The Keyword " & strKeyword & " contains an operator shortcut.", _
  1718. vbExclamation + vbOKOnly
  1719. Case errContainsVerbalOperator
  1720. MsgBox "The Keyword " & strKeyword & " contains a verbal operator.", _
  1721. vbExclamation + vbOKOnly
  1722. Case errContainsQuote
  1723. MsgBox "The Keyword " & strKeyword & " contains a quote.", _
  1724. vbExclamation + vbOKOnly
  1725. Case errTooLong
  1726. MsgBox "The Keyword " & strKeyword & " is too long", _
  1727. vbExclamation + vbOKOnly
  1728. Case E_FAIL
  1729. DisplayDatabaseLockedError
  1730. Case errDatabaseVersionIncompatible
  1731. DisplayDatabaseVersionError
  1732. Case Else
  1733. g_ErrorInfo.SetInfoAndDump "cboKeywords_KeyPress"
  1734. End Select
  1735. End Sub
  1736. Private Sub cmdSave_Click()
  1737. On Error GoTo LErrorHandler
  1738. Dim blnUpdateControls As Boolean
  1739. p_SaveClicked blnUpdateControls
  1740. Exit Sub
  1741. LErrorHandler:
  1742. g_ErrorInfo.SetInfoAndDump "cmdSave_Click"
  1743. End Sub
  1744. Private Sub cmdCancel_Click()
  1745. On Error GoTo LErrorHandler
  1746. Dim Node As Node
  1747. If (p_blnCreating) Then
  1748. p_DeleteNodeBeingCreated
  1749. p_SetModeCreating False
  1750. ElseIf (p_blnUpdating) Then
  1751. p_SetModeUpdating False
  1752. End If
  1753. treTaxonomy_NodeClick treTaxonomy.SelectedItem
  1754. Exit Sub
  1755. LErrorHandler:
  1756. g_ErrorInfo.SetInfoAndDump "cmdCancel_Click"
  1757. End Sub
  1758. Private Sub p_SetBrokenLinkAttribute( _
  1759. ByVal i_enumSKU As SKU_E, _
  1760. ByRef i_strBrokenLinkDir As String, _
  1761. ByRef i_strVendor As String, _
  1762. ByRef i_strBrokenLinkAttribute As String, _
  1763. ByRef u_DOMNode As MSXML2.IXMLDOMNode _
  1764. )
  1765. Dim enumSKUs As SKU_E
  1766. Dim strURI As String
  1767. Dim strNewURI As String
  1768. Dim DOMNode As MSXML2.IXMLDOMNode
  1769. Dim strTitle As String
  1770. enumSKUs = XMLGetAttribute(u_DOMNode, HHT_skus_C) And _
  1771. XMLGetAttribute(u_DOMNode, HHT_allowedskus_C)
  1772. strTitle = XMLGetAttribute(u_DOMNode, HHT_TITLE_C)
  1773. strURI = XMLGetAttribute(u_DOMNode, HHT_URI_C)
  1774. p_SetStatusText SBPANEL_DATABASE, "Evaluating " & strTitle
  1775. If ((i_enumSKU And enumSKUs) = 0) Then
  1776. XMLSetAttribute u_DOMNode, i_strBrokenLinkAttribute, "0"
  1777. Exit Sub
  1778. End If
  1779. If (LinkValid(i_strBrokenLinkDir, i_strVendor, strURI, strNewURI)) Then
  1780. XMLSetAttribute u_DOMNode, i_strBrokenLinkAttribute, "0"
  1781. Else
  1782. XMLSetAttribute u_DOMNode, i_strBrokenLinkAttribute, "1"
  1783. End If
  1784. If (Not (u_DOMNode.firstChild Is Nothing)) Then
  1785. For Each DOMNode In u_DOMNode.childNodes
  1786. p_SetBrokenLinkAttribute i_enumSKU, i_strBrokenLinkDir, i_strVendor, _
  1787. i_strBrokenLinkAttribute, DOMNode
  1788. Next
  1789. End If
  1790. End Sub
  1791. Private Sub p_ComputeBrokenLinkAttributes( _
  1792. ByVal i_enumSearchTarget As SEARCH_TARGET_E _
  1793. )
  1794. On Error GoTo LErrorHandler
  1795. Dim DOMNodeRoot As MSXML2.IXMLDOMNode
  1796. Dim strStatusText As String
  1797. Dim enumSKU As SKU_E
  1798. Dim strBrokenLinkDir As String
  1799. Dim strVendor As String
  1800. Dim strBrokenLinkAttribute As String
  1801. strStatusText = p_GetStatusText(SBPANEL_DATABASE)
  1802. Set DOMNodeRoot = treTaxonomy.Nodes(KEY_PREFIX_C & ROOT_TID_C).Tag
  1803. strVendor = p_clsParameters.Value(VENDOR_STRING_C) & ""
  1804. If (i_enumSearchTarget And ST_BROKEN_LINK_WINME_E) Then
  1805. enumSKU = SKU_WINDOWS_MILLENNIUM_E
  1806. strBrokenLinkAttribute = HHT_brokenlinkwinme_C
  1807. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1808. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1809. DOMNodeRoot
  1810. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_STD_E) Then
  1811. enumSKU = SKU_STANDARD_E
  1812. strBrokenLinkAttribute = HHT_brokenlinkstd_C
  1813. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1814. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1815. DOMNodeRoot
  1816. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_PRO_E) Then
  1817. enumSKU = SKU_PROFESSIONAL_E
  1818. strBrokenLinkAttribute = HHT_brokenlinkpro_C
  1819. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1820. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1821. DOMNodeRoot
  1822. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_PRO64_E) Then
  1823. enumSKU = SKU_PROFESSIONAL_64_E
  1824. strBrokenLinkAttribute = HHT_brokenlinkpro64_C
  1825. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1826. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1827. DOMNodeRoot
  1828. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_SRV_E) Then
  1829. enumSKU = SKU_SERVER_E
  1830. strBrokenLinkAttribute = HHT_brokenlinksrv_C
  1831. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1832. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1833. DOMNodeRoot
  1834. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_ADV_E) Then
  1835. enumSKU = SKU_ADVANCED_SERVER_E
  1836. strBrokenLinkAttribute = HHT_brokenlinkadv_C
  1837. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1838. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1839. DOMNodeRoot
  1840. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_ADV64_E) Then
  1841. enumSKU = SKU_ADVANCED_SERVER_64_E
  1842. strBrokenLinkAttribute = HHT_brokenlinkadv64_C
  1843. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1844. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1845. DOMNodeRoot
  1846. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_DAT_E) Then
  1847. enumSKU = SKU_DATA_CENTER_SERVER_E
  1848. strBrokenLinkAttribute = HHT_brokenlinkdat_C
  1849. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1850. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1851. DOMNodeRoot
  1852. ElseIf (i_enumSearchTarget And ST_BROKEN_LINK_DAT64_E) Then
  1853. enumSKU = SKU_DATA_CENTER_SERVER_64_E
  1854. strBrokenLinkAttribute = HHT_brokenlinkdat64_C
  1855. strBrokenLinkDir = p_GetBrokenLinkDir(enumSKU)
  1856. p_SetBrokenLinkAttribute enumSKU, strBrokenLinkDir, strVendor, strBrokenLinkAttribute, _
  1857. DOMNodeRoot
  1858. End If
  1859. LDone:
  1860. p_SetStatusText SBPANEL_DATABASE, strStatusText
  1861. Exit Sub
  1862. LErrorHandler:
  1863. Select Case Err.Number
  1864. Case errNotConfiguredForNavigateLink
  1865. MsgBox "Please verify that you've selected the correct SKU. " & _
  1866. "If the SKU is correct, the database needs to be configured " & _
  1867. "to point to the BrokenLinkWorkingDir.", _
  1868. vbExclamation Or vbOKOnly
  1869. End Select
  1870. GoTo LDone
  1871. End Sub
  1872. Private Function p_GetBrokenLinkXPathQuery( _
  1873. ByVal i_enumSearchTarget As SEARCH_TARGET_E _
  1874. ) As String
  1875. Dim str As String
  1876. Dim strQuery As String
  1877. strQuery = "attribute::" & HHT_tid_C & "!=""" & INVALID_ID_C & """"
  1878. If (i_enumSearchTarget And ST_BROKEN_LINK_WINME_E) Then
  1879. str = "attribute::" & HHT_brokenlinkwinme_C & "=""1"""
  1880. strQuery = strQuery & " and " & str
  1881. End If
  1882. If (i_enumSearchTarget And ST_BROKEN_LINK_STD_E) Then
  1883. str = "attribute::" & HHT_brokenlinkstd_C & "=""1"""
  1884. strQuery = strQuery & " and " & str
  1885. End If
  1886. If (i_enumSearchTarget And ST_BROKEN_LINK_PRO_E) Then
  1887. str = "attribute::" & HHT_brokenlinkpro_C & "=""1"""
  1888. strQuery = strQuery & " and " & str
  1889. End If
  1890. If (i_enumSearchTarget And ST_BROKEN_LINK_PRO64_E) Then
  1891. str = "attribute::" & HHT_brokenlinkpro64_C & "=""1"""
  1892. strQuery = strQuery & " and " & str
  1893. End If
  1894. If (i_enumSearchTarget And ST_BROKEN_LINK_SRV_E) Then
  1895. str = "attribute::" & HHT_brokenlinksrv_C & "=""1"""
  1896. strQuery = strQuery & " and " & str
  1897. End If
  1898. If (i_enumSearchTarget And ST_BROKEN_LINK_ADV_E) Then
  1899. str = "attribute::" & HHT_brokenlinkadv_C & "=""1"""
  1900. strQuery = strQuery & " and " & str
  1901. End If
  1902. If (i_enumSearchTarget And ST_BROKEN_LINK_ADV64_E) Then
  1903. str = "attribute::" & HHT_brokenlinkadv64_C & "=""1"""
  1904. strQuery = strQuery & " and " & str
  1905. End If
  1906. If (i_enumSearchTarget And ST_BROKEN_LINK_DAT_E) Then
  1907. str = "attribute::" & HHT_brokenlinkdat_C & "=""1"""
  1908. strQuery = strQuery & " and " & str
  1909. End If
  1910. If (i_enumSearchTarget And ST_BROKEN_LINK_DAT64_E) Then
  1911. str = "attribute::" & HHT_brokenlinkdat64_C & "=""1"""
  1912. strQuery = strQuery & " and " & str
  1913. End If
  1914. p_GetBrokenLinkXPathQuery = strQuery
  1915. End Function
  1916. Private Function p_GetXPathAttributeString( _
  1917. ByVal i_strAttributeName As String, _
  1918. ByVal i_strStringToFind As String _
  1919. ) As String
  1920. p_GetXPathAttributeString = "attribute::" & i_strAttributeName & _
  1921. "[contains(translate(., 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', 'abcdefghijklmnopqrstuvwxyz')," & _
  1922. """" & i_strStringToFind & """ )]"
  1923. End Function
  1924. Private Function p_GetXPathQuery( _
  1925. ByVal i_strStringToFind As String, _
  1926. ByVal i_enumSearchTarget As SEARCH_TARGET_E _
  1927. ) As String
  1928. Dim strQuery As String
  1929. Dim str As String
  1930. strQuery = "descendant::TAXONOMY_ENTRY["
  1931. str = "attribute::" & HHT_tid_C & "!=""" & INVALID_ID_C & """"
  1932. strQuery = strQuery & str
  1933. If (i_enumSearchTarget And _
  1934. (ST_TITLE_E Or _
  1935. ST_DESCRIPTION_E Or _
  1936. ST_URI_E Or _
  1937. ST_COMMENTS_E Or _
  1938. ST_BASE_FILE_E)) Then
  1939. strQuery = strQuery & " and ("
  1940. strQuery = strQuery & p_GetXPathAttributeString(HHT_basefile_C, "!!!An impossible string!!!")
  1941. If (i_enumSearchTarget And ST_TITLE_E) Then
  1942. str = p_GetXPathAttributeString(HHT_TITLE_C, i_strStringToFind)
  1943. strQuery = strQuery & " or " & str
  1944. End If
  1945. If (i_enumSearchTarget And ST_DESCRIPTION_E) Then
  1946. str = p_GetXPathAttributeString(HHT_DESCRIPTION_C, i_strStringToFind)
  1947. strQuery = strQuery & " or " & str
  1948. End If
  1949. If (i_enumSearchTarget And ST_URI_E) Then
  1950. str = p_GetXPathAttributeString(HHT_URI_C, i_strStringToFind)
  1951. strQuery = strQuery & " or " & str
  1952. End If
  1953. If (i_enumSearchTarget And ST_COMMENTS_E) Then
  1954. str = p_GetXPathAttributeString(HHT_comments_C, i_strStringToFind)
  1955. strQuery = strQuery & " or " & str
  1956. End If
  1957. If (i_enumSearchTarget And ST_BASE_FILE_E) Then
  1958. str = p_GetXPathAttributeString(HHT_basefile_C, i_strStringToFind)
  1959. strQuery = strQuery & " or " & str
  1960. End If
  1961. strQuery = strQuery & ")"
  1962. End If
  1963. If (i_enumSearchTarget And ST_SELF_AUTHORING_GROUP_E) Then
  1964. str = "attribute::" & HHT_authoringgroup_C & "=""" & p_intAuthoringGroup & """"
  1965. strQuery = strQuery & " and " & str
  1966. End If
  1967. If (i_enumSearchTarget And ST_NODES_WITHOUT_KEYWORDS_E) Then
  1968. str = "attribute::" & HHT_keywords_C & "="""" and "
  1969. str = str & "attribute::" & HHT_leaf_C & "=""False"""
  1970. strQuery = strQuery & " and " & str
  1971. End If
  1972. If (i_enumSearchTarget And ST_TOPICS_WITHOUT_KEYWORDS_E) Then
  1973. str = "attribute::" & HHT_keywords_C & "="""" and "
  1974. str = str & "attribute::" & HHT_leaf_C & "=""True"""
  1975. strQuery = strQuery & " and " & str
  1976. End If
  1977. If (i_enumSearchTarget And _
  1978. (ST_BROKEN_LINK_WINME_E Or _
  1979. ST_BROKEN_LINK_STD_E Or _
  1980. ST_BROKEN_LINK_PRO_E Or _
  1981. ST_BROKEN_LINK_PRO64_E Or _
  1982. ST_BROKEN_LINK_SRV_E Or _
  1983. ST_BROKEN_LINK_ADV_E Or _
  1984. ST_BROKEN_LINK_ADV64_E Or _
  1985. ST_BROKEN_LINK_DAT_E Or _
  1986. ST_BROKEN_LINK_DAT64_E)) Then
  1987. p_ComputeBrokenLinkAttributes i_enumSearchTarget
  1988. str = p_GetBrokenLinkXPathQuery(i_enumSearchTarget)
  1989. strQuery = strQuery & " and " & str
  1990. End If
  1991. strQuery = strQuery & "]"
  1992. p_GetXPathQuery = strQuery
  1993. End Function
  1994. Public Function Find( _
  1995. ByVal i_strStringToFind As String, _
  1996. ByVal i_enumSearchTarget As SEARCH_TARGET_E _
  1997. ) As MSXML2.IXMLDOMNodeList
  1998. Dim str As String
  1999. Dim DOMNodeRoot As MSXML2.IXMLDOMNode
  2000. Dim DOMDocument As MSXML2.DOMDocument
  2001. Dim strQuery As String
  2002. str = LCase$(i_strStringToFind)
  2003. strQuery = p_GetXPathQuery(str, i_enumSearchTarget)
  2004. Set DOMNodeRoot = treTaxonomy.Nodes(KEY_PREFIX_C & ROOT_TID_C).Tag
  2005. Set DOMDocument = DOMNodeRoot.ownerDocument
  2006. DOMDocument.setProperty "SelectionLanguage", "XPath"
  2007. Set Find = DOMNodeRoot.selectNodes(strQuery)
  2008. End Function
  2009. Public Sub Highlight( _
  2010. ByVal i_intTID As Long _
  2011. )
  2012. Dim Node As Node
  2013. If (Not p_NodeExists(i_intTID)) Then
  2014. MsgBox "The Node or Topic no longer exists", vbOKOnly
  2015. Exit Sub
  2016. End If
  2017. Set Node = treTaxonomy.Nodes(KEY_PREFIX_C & i_intTID)
  2018. Node.EnsureVisible
  2019. treTaxonomy_NodeClick Node
  2020. Set treTaxonomy.SelectedItem = Node
  2021. End Sub
  2022. Public Sub SetURI(ByVal i_strURI As String)
  2023. txtURI = i_strURI
  2024. End Sub
  2025. Public Sub SetKeywords(ByVal i_dictKeywordsWithTitle As Scripting.Dictionary)
  2026. On Error GoTo LErrorHandler
  2027. Dim intKID As Variant
  2028. p_dictKeywordsWithTitle.RemoveAll
  2029. For Each intKID In i_dictKeywordsWithTitle.Keys
  2030. p_dictKeywordsWithTitle.Add intKID, i_dictKeywordsWithTitle(intKID)
  2031. If (Not CollectionContainsKey(p_colKeywords, intKID)) Then
  2032. p_colKeywords.Add i_dictKeywordsWithTitle(intKID), CStr(intKID)
  2033. End If
  2034. Next
  2035. p_SetKeywordsList
  2036. p_UserChangedSomethingForCurrentNode
  2037. Exit Sub
  2038. LErrorHandler:
  2039. g_ErrorInfo.SetInfoAndRaiseError "SetKeywords"
  2040. End Sub
  2041. Public Sub AddRemoveKeywordsFormGoingAway()
  2042. p_blnAddRemoveKeywordsOpen = False
  2043. End Sub
  2044. Public Sub SetSKUs(i_enumSKUs As SKU_E)
  2045. On Error GoTo LErrorHandler
  2046. Dim T0 As Date
  2047. Dim T1 As Date
  2048. If (p_enumFilterSKUs <> i_enumSKUs) Then
  2049. p_enumFilterSKUs = i_enumSKUs
  2050. p_StrikeoutUnselectedSKUs
  2051. T0 = Now
  2052. p_UpdateSubTree ROOT_TID_C, ALL_SKUS_C
  2053. T1 = Now
  2054. Debug.Print "SetSKUs: " & FormatTime(T0, T1)
  2055. End If
  2056. Exit Sub
  2057. LErrorHandler:
  2058. g_ErrorInfo.SetInfoAndRaiseError "SetSKUs"
  2059. End Sub
  2060. Private Function p_IsLeaf(i_Node As Node) As Boolean
  2061. If ((i_Node.Image = IMAGE_LEAF_E) Or (i_Node.Image = IMAGE_BAD_LEAF_E) Or _
  2062. (i_Node.Image = IMAGE_FOREIGN_LEAF_E)) Then
  2063. p_IsLeaf = True
  2064. Else
  2065. p_IsLeaf = False
  2066. End If
  2067. End Function
  2068. Private Function p_IsRoot(i_Node As Node) As Boolean
  2069. If (i_Node.Parent Is Nothing) Then
  2070. p_IsRoot = True
  2071. Else
  2072. p_IsRoot = False
  2073. End If
  2074. End Function
  2075. Private Function p_NodeDeleted(i_Node As Node) As Boolean
  2076. Dim Node As Node
  2077. On Error GoTo LErrorHandler
  2078. Set Node = i_Node.Parent
  2079. p_NodeDeleted = False
  2080. Exit Function
  2081. LErrorHandler:
  2082. p_NodeDeleted = True
  2083. End Function
  2084. Private Function p_NodeExists(i_intTID As Long) As Boolean
  2085. Dim Node As Node
  2086. If (p_blnUpdating) Then
  2087. Set Node = treTaxonomy.Nodes(MODIFY_KEY_C)
  2088. If (XMLGetAttribute(Node.Tag, HHT_tid_C) = i_intTID) Then
  2089. p_NodeExists = True
  2090. Exit Function
  2091. End If
  2092. End If
  2093. On Error GoTo LErrorHandler
  2094. Set Node = treTaxonomy.Nodes(KEY_PREFIX_C & i_intTID)
  2095. p_NodeExists = True
  2096. Exit Function
  2097. LErrorHandler:
  2098. p_NodeExists = False
  2099. End Function
  2100. Private Sub p_UserChangedSomethingForCurrentNode()
  2101. On Error GoTo LErrorHandler
  2102. If (p_blnCreating Or p_blnUpdating) Then
  2103. Exit Sub
  2104. End If
  2105. p_SetModeUpdating True
  2106. Exit Sub
  2107. LErrorHandler:
  2108. g_ErrorInfo.SetInfoAndDump "p_UserChangedSomethingForCurrentNode"
  2109. End Sub
  2110. Private Sub p_SetLastModified( _
  2111. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  2112. )
  2113. Dim strLastModified As String
  2114. strLastModified = "Modified by " & XMLGetAttribute(i_DOMNode, HHT_username_C) & _
  2115. " on " & XMLGetAttribute(i_DOMNode, HHT_modifiedtime_C)
  2116. lblLastModified.Caption = strLastModified
  2117. End Sub
  2118. Private Sub p_UpdateRHSControls( _
  2119. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  2120. )
  2121. On Error GoTo LErrorHandler
  2122. Dim enumSKUs As SKU_E
  2123. Dim intAllowedSKUs As Long
  2124. Dim enumAllowedSKUs As SKU_E
  2125. Dim intIndex As Long
  2126. Dim arrKIDs() As String
  2127. Dim intKID As Long
  2128. Dim strKeyword As String
  2129. Dim intType As Long
  2130. Dim blnSettingControls As Boolean
  2131. blnSettingControls = p_blnSettingControls
  2132. p_blnSettingControls = True
  2133. txtTitle = XMLGetAttribute(i_DOMNode, HHT_TITLE_C)
  2134. txtDescription = XMLGetAttribute(i_DOMNode, HHT_DESCRIPTION_C)
  2135. txtURI = XMLGetAttribute(i_DOMNode, HHT_URI_C)
  2136. txtIconURI = XMLGetAttribute(i_DOMNode, HHT_ICONURI_C)
  2137. txtComments = XMLGetAttribute(i_DOMNode, HHT_comments_C)
  2138. txtEntry = XMLGetAttribute(i_DOMNode, HHT_ENTRY_C)
  2139. p_DisableEntry
  2140. p_SetLastModified i_DOMNode
  2141. chkVisible.Value = IIf(XMLGetAttribute(i_DOMNode, HHT_VISIBLE_C), 1, 0)
  2142. If (XMLGetAttribute(i_DOMNode, HHT_leaf_C)) Then
  2143. p_DisableSubSite
  2144. p_DisableNavModel
  2145. p_DisableEditEntry
  2146. Else
  2147. p_EnableSubSite
  2148. p_EnableNavModel
  2149. p_EnableEditEntry
  2150. End If
  2151. chkSubSite.Value = IIf(XMLGetAttribute(i_DOMNode, HHT_SUBSITE_C), 1, 0)
  2152. p_SetTypeComboIndex -1
  2153. intType = XMLGetAttribute(i_DOMNode, HHT_TYPE_C)
  2154. For intIndex = 0 To cboType.ListCount - 1
  2155. If (cboType.ItemData(intIndex) = intType) Then
  2156. p_SetTypeComboIndex intIndex
  2157. Exit For
  2158. End If
  2159. Next
  2160. p_SetNavModelCombo XMLGetAttribute(i_DOMNode, HHT_NAVIGATIONMODEL_C)
  2161. p_SetLocIncludeCombo XMLGetAttribute(i_DOMNode, HHT_locinclude_C)
  2162. p_SetSKUs XMLGetAttribute(i_DOMNode, HHT_skus_C), _
  2163. XMLGetAttribute(i_DOMNode, HHT_allowedskus_C)
  2164. If (txtURI <> "") Then
  2165. p_EnableNavigateLink
  2166. Else
  2167. p_DisableNavigateLink
  2168. End If
  2169. arrKIDs = Split(XMLGetAttribute(i_DOMNode, HHT_keywords_C), " ")
  2170. p_dictKeywordsWithTitle.RemoveAll
  2171. ' This loop is time consuming and sometimes causes a couple of seconds delay.
  2172. ' This mostly happens when there are a lot of KIDs of deleted keywords.
  2173. For intIndex = LBound(arrKIDs) To UBound(arrKIDs)
  2174. If (arrKIDs(intIndex) <> "") Then
  2175. intKID = arrKIDs(intIndex)
  2176. If (CollectionContainsKey(p_colKeywords, intKID)) Then
  2177. p_dictKeywordsWithTitle.Add intKID, p_colKeywords(CStr(intKID))
  2178. Else
  2179. ' It is possible that Keyword propagation (for same URI) has gotten
  2180. ' us new KIDs for which we don't have any Keyword.
  2181. p_clsKeywords.GetKeyword intKID, strKeyword
  2182. If (strKeyword <> "") Then
  2183. p_colKeywords.Add strKeyword, CStr(intKID)
  2184. p_dictKeywordsWithTitle.Add intKID, strKeyword
  2185. End If
  2186. End If
  2187. End If
  2188. Next
  2189. p_SetKeywordsList
  2190. ' Reset it to the state it was in when this function was called.
  2191. p_blnSettingControls = blnSettingControls
  2192. If (p_blnAddRemoveKeywordsOpen) Then
  2193. cmdAddRemove_Click
  2194. End If
  2195. Exit Sub
  2196. LErrorHandler:
  2197. p_blnSettingControls = blnSettingControls
  2198. g_ErrorInfo.SetInfoAndRaiseError "p_UpdateRHSControls"
  2199. End Sub
  2200. Private Sub p_SetSKUs(i_enumSelectedSKUs As SKU_E, i_enumAllowedSKUs As SKU_E)
  2201. p_ClearSKUs
  2202. p_DisableSKUs
  2203. If (i_enumAllowedSKUs And SKU_STANDARD_E) Then
  2204. chkStandard.Enabled = True
  2205. If (i_enumSelectedSKUs And SKU_STANDARD_E) Then
  2206. chkStandard.Value = 1
  2207. End If
  2208. End If
  2209. If (i_enumAllowedSKUs And SKU_PROFESSIONAL_E) Then
  2210. chkProfessional.Enabled = True
  2211. If (i_enumSelectedSKUs And SKU_PROFESSIONAL_E) Then
  2212. chkProfessional.Value = 1
  2213. End If
  2214. End If
  2215. If (i_enumAllowedSKUs And SKU_PROFESSIONAL_64_E) Then
  2216. chkProfessional64.Enabled = True
  2217. If (i_enumSelectedSKUs And SKU_PROFESSIONAL_64_E) Then
  2218. chkProfessional64.Value = 1
  2219. End If
  2220. End If
  2221. If (i_enumAllowedSKUs And SKU_WINDOWS_MILLENNIUM_E) Then
  2222. chkWindowsMillennium.Enabled = True
  2223. If (i_enumSelectedSKUs And SKU_WINDOWS_MILLENNIUM_E) Then
  2224. chkWindowsMillennium.Value = 1
  2225. End If
  2226. End If
  2227. If (i_enumAllowedSKUs And SKU_SERVER_E) Then
  2228. chkServer.Enabled = True
  2229. If (i_enumSelectedSKUs And SKU_SERVER_E) Then
  2230. chkServer.Value = 1
  2231. End If
  2232. End If
  2233. If (i_enumAllowedSKUs And SKU_ADVANCED_SERVER_E) Then
  2234. chkAdvancedServer.Enabled = True
  2235. If (i_enumSelectedSKUs And SKU_ADVANCED_SERVER_E) Then
  2236. chkAdvancedServer.Value = 1
  2237. End If
  2238. End If
  2239. If (i_enumAllowedSKUs And SKU_DATA_CENTER_SERVER_E) Then
  2240. chkDataCenterServer.Enabled = True
  2241. If (i_enumSelectedSKUs And SKU_DATA_CENTER_SERVER_E) Then
  2242. chkDataCenterServer.Value = 1
  2243. End If
  2244. End If
  2245. If (i_enumAllowedSKUs And SKU_ADVANCED_SERVER_64_E) Then
  2246. chkAdvancedServer64.Enabled = True
  2247. If (i_enumSelectedSKUs And SKU_ADVANCED_SERVER_64_E) Then
  2248. chkAdvancedServer64.Value = 1
  2249. End If
  2250. End If
  2251. If (i_enumAllowedSKUs And SKU_DATA_CENTER_SERVER_64_E) Then
  2252. chkDataCenterServer64.Enabled = True
  2253. If (i_enumSelectedSKUs And SKU_DATA_CENTER_SERVER_64_E) Then
  2254. chkDataCenterServer64.Value = 1
  2255. End If
  2256. End If
  2257. End Sub
  2258. Private Function p_GetSelectedSKUs() As SKU_E
  2259. Dim enumSelectedSKUs As SKU_E
  2260. If (chkStandard.Value = 1) Then
  2261. enumSelectedSKUs = enumSelectedSKUs Or SKU_STANDARD_E
  2262. End If
  2263. If (chkProfessional.Value = 1) Then
  2264. enumSelectedSKUs = enumSelectedSKUs Or SKU_PROFESSIONAL_E
  2265. End If
  2266. If (chkProfessional64.Value = 1) Then
  2267. enumSelectedSKUs = enumSelectedSKUs Or SKU_PROFESSIONAL_64_E
  2268. End If
  2269. If (chkWindowsMillennium.Value = 1) Then
  2270. enumSelectedSKUs = enumSelectedSKUs Or SKU_WINDOWS_MILLENNIUM_E
  2271. End If
  2272. If (chkServer.Value = 1) Then
  2273. enumSelectedSKUs = enumSelectedSKUs Or SKU_SERVER_E
  2274. End If
  2275. If (chkAdvancedServer.Value = 1) Then
  2276. enumSelectedSKUs = enumSelectedSKUs Or SKU_ADVANCED_SERVER_E
  2277. End If
  2278. If (chkDataCenterServer.Value = 1) Then
  2279. enumSelectedSKUs = enumSelectedSKUs Or SKU_DATA_CENTER_SERVER_E
  2280. End If
  2281. If (chkAdvancedServer64.Value = 1) Then
  2282. enumSelectedSKUs = enumSelectedSKUs Or SKU_ADVANCED_SERVER_64_E
  2283. End If
  2284. If (chkDataCenterServer64.Value = 1) Then
  2285. enumSelectedSKUs = enumSelectedSKUs Or SKU_DATA_CENTER_SERVER_64_E
  2286. End If
  2287. p_GetSelectedSKUs = enumSelectedSKUs
  2288. End Function
  2289. Private Function p_GetSelectedNavModel() As Long
  2290. If (cboNavModel.ListIndex = -1) Then
  2291. p_GetSelectedNavModel = NAVMODEL_DEFAULT_NUM_C
  2292. Else
  2293. p_GetSelectedNavModel = cboNavModel.ItemData(cboNavModel.ListIndex)
  2294. End If
  2295. End Function
  2296. Private Function p_GetSelectedType() As Long
  2297. If (cboType.ListIndex = -1) Then
  2298. p_GetSelectedType = 0
  2299. Else
  2300. p_GetSelectedType = cboType.ItemData(cboType.ListIndex)
  2301. End If
  2302. End Function
  2303. Private Function p_GetSelectedLocInclude() As String
  2304. p_GetSelectedLocInclude = cboLocInclude.Text
  2305. End Function
  2306. Private Sub p_SetNodeColor( _
  2307. ByRef i_Node As Node, _
  2308. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  2309. )
  2310. Dim enumSKUs As SKU_E
  2311. Dim blnVisible As Boolean
  2312. Dim blnSubSite As Boolean
  2313. enumSKUs = XMLGetAttribute(i_DOMNode, HHT_skus_C) And _
  2314. XMLGetAttribute(i_DOMNode, HHT_allowedskus_C)
  2315. blnVisible = XMLGetAttribute(i_DOMNode, HHT_VISIBLE_C)
  2316. blnSubSite = XMLGetAttribute(i_DOMNode, HHT_SUBSITE_C)
  2317. If ((p_enumFilterSKUs And enumSKUs) = 0) Then
  2318. i_Node.ForeColor = vbWhite
  2319. i_Node.BackColor = vbWhite
  2320. Else
  2321. If (blnVisible) Then
  2322. i_Node.ForeColor = vbBlack
  2323. Else
  2324. i_Node.ForeColor = &HB0B0B0
  2325. End If
  2326. End If
  2327. If (blnSubSite) Then
  2328. i_Node.Bold = True
  2329. Else
  2330. i_Node.Bold = False
  2331. End If
  2332. End Sub
  2333. Private Sub p_SetNodeImage( _
  2334. ByRef i_Node As Node, _
  2335. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  2336. )
  2337. Dim blnLeaf As Boolean
  2338. Dim intAG As Long
  2339. blnLeaf = XMLGetAttribute(i_DOMNode, HHT_leaf_C)
  2340. intAG = XMLGetAttribute(i_DOMNode, HHT_authoringgroup_C)
  2341. If (intAG <> p_intAuthoringGroup) Then
  2342. If (blnLeaf) Then
  2343. i_Node.Image = IMAGE_FOREIGN_LEAF_E
  2344. Else
  2345. i_Node.Image = IMAGE_FOREIGN_GROUP_E
  2346. End If
  2347. Exit Sub
  2348. End If
  2349. If (blnLeaf) Then
  2350. i_Node.Image = IMAGE_LEAF_E
  2351. Else
  2352. i_Node.Image = IMAGE_GROUP_E
  2353. End If
  2354. End Sub
  2355. Private Sub p_DeleteNodeBeingCreated()
  2356. On Error GoTo LErrorHandler
  2357. treTaxonomy.Nodes.Remove CREATE_KEY_C
  2358. Exit Sub
  2359. LErrorHandler:
  2360. g_ErrorInfo.SetInfoAndRaiseError "p_DeleteNodeBeingCreated"
  2361. End Sub
  2362. Private Sub p_SetModeCreating(i_bln As Boolean)
  2363. On Error GoTo LErrorHandler
  2364. If (i_bln And Not p_blnCreating) Then
  2365. p_blnCreating = True
  2366. p_DisableCreate
  2367. p_DisableDelete
  2368. p_DisableRefresh
  2369. p_EnableSaveCancel
  2370. p_SetStatusText SBPANEL_MODE, "Creating Node/Topic"
  2371. ElseIf (Not i_bln And p_blnCreating) Then
  2372. p_blnCreating = False
  2373. p_EnableRefresh
  2374. p_DisableSaveCancel
  2375. p_SetStatusText SBPANEL_MODE, ""
  2376. End If
  2377. Exit Sub
  2378. LErrorHandler:
  2379. g_ErrorInfo.SetInfoAndRaiseError "p_SetModeCreating"
  2380. End Sub
  2381. Private Sub p_SetModeUpdating(i_bln As Boolean)
  2382. On Error GoTo LErrorHandler
  2383. Dim Node As Node
  2384. If (i_bln And Not p_blnUpdating) Then
  2385. p_blnUpdating = True
  2386. treTaxonomy.SelectedItem.Key = MODIFY_KEY_C
  2387. p_DisableCreate
  2388. p_DisableDelete
  2389. p_DisableRefresh
  2390. p_EnableSaveCancel
  2391. p_SetStatusText SBPANEL_MODE, "Modifying Node/Topic"
  2392. ElseIf (Not i_bln And p_blnUpdating) Then
  2393. p_blnUpdating = False
  2394. p_EnableRefresh
  2395. Set Node = treTaxonomy.Nodes(MODIFY_KEY_C)
  2396. Node.Key = KEY_PREFIX_C & XMLGetAttribute(Node.Tag, HHT_tid_C)
  2397. Node.Text = XMLGetAttribute(Node.Tag, HHT_TITLE_C)
  2398. p_DisableSaveCancel
  2399. p_SetStatusText SBPANEL_MODE, ""
  2400. End If
  2401. Exit Sub
  2402. LErrorHandler:
  2403. g_ErrorInfo.SetInfoAndRaiseError "p_SetModeUpdating"
  2404. End Sub
  2405. Private Sub p_ExportHHT( _
  2406. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  2407. )
  2408. On Error GoTo LErrorHandler
  2409. Dim strFileName As String
  2410. Dim DOMNode As MSXML2.IXMLDOMNode
  2411. Dim strStatusText As String
  2412. strStatusText = p_GetStatusText(SBPANEL_DATABASE)
  2413. dlgCommon.CancelError = True
  2414. dlgCommon.Flags = cdlOFNHideReadOnly
  2415. dlgCommon.Filter = XML_FILE_FILTER_C
  2416. dlgCommon.ShowSave
  2417. strFileName = Trim$(dlgCommon.FileName)
  2418. If (strFileName = "") Then
  2419. Exit Sub
  2420. End If
  2421. Me.Enabled = False
  2422. p_clsHHT.ExportHHT strFileName
  2423. LEnd:
  2424. Me.Enabled = True
  2425. p_SetStatusText SBPANEL_DATABASE, strStatusText
  2426. Exit Sub
  2427. LErrorHandler:
  2428. Select Case Err.Number
  2429. Case cdlCancel
  2430. ' Nothing. The user cancelled.
  2431. Case Else
  2432. g_ErrorInfo.SetInfoAndDump "p_ExportHHT"
  2433. End Select
  2434. GoTo LEnd
  2435. End Sub
  2436. Private Sub p_CreateNode(i_blnGroupNode As Boolean)
  2437. On Error GoTo LErrorHandler
  2438. Dim DOMNode As MSXML2.IXMLDOMNode
  2439. Dim nodeNew As Node
  2440. Dim strParentKey As String
  2441. Dim intParentTID As Long
  2442. Dim enumSelectedSKUs As SKU_E
  2443. If (p_blnCreating Or p_blnUpdating) Then
  2444. Exit Sub
  2445. End If
  2446. p_SetModeCreating True
  2447. Set DOMNode = treTaxonomy.SelectedItem.Tag
  2448. intParentTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  2449. strParentKey = KEY_PREFIX_C & intParentTID
  2450. Set nodeNew = treTaxonomy.Nodes.Add(strParentKey, tvwChild, CREATE_KEY_C)
  2451. Set nodeNew.Tag = DOMNode
  2452. If (i_blnGroupNode) Then
  2453. nodeNew.Image = IMAGE_GROUP_E
  2454. p_EnableSubSite
  2455. p_EnableNavModel
  2456. p_EnableEditEntry
  2457. Else
  2458. nodeNew.Image = IMAGE_LEAF_E
  2459. p_DisableSubSite
  2460. p_DisableNavModel
  2461. p_DisableEditEntry
  2462. End If
  2463. Set treTaxonomy.SelectedItem = nodeNew
  2464. nodeNew.EnsureVisible
  2465. p_DisableUnselectedSKUs
  2466. p_EnableNodeDetailsExceptIndividualSKUs
  2467. p_EnableNavigateLink
  2468. p_EnableAddRemoveAndKeywordsCombo
  2469. chkSubSite.Value = 0
  2470. p_SetNavModelCombo NAVMODEL_DEFAULT_STR_C
  2471. enumSelectedSKUs = p_GetSelectedSKUs
  2472. p_SetSKUs enumSelectedSKUs, enumSelectedSKUs
  2473. txtTitle = ""
  2474. txtDescription = ""
  2475. txtURI = ""
  2476. txtIconURI = ""
  2477. txtComments = ""
  2478. txtEntry = ""
  2479. lblLastModified = ""
  2480. txtTitle.SetFocus
  2481. p_dictKeywordsWithTitle.RemoveAll
  2482. p_SetKeywordsList
  2483. Exit Sub
  2484. LErrorHandler:
  2485. g_ErrorInfo.SetInfoAndRaiseError "p_CreateNode"
  2486. End Sub
  2487. Private Sub p_ReplaceTaxonomySubtree( _
  2488. ByVal u_DOMNode As MSXML2.IXMLDOMNode, _
  2489. ByVal i_intParentTID As Long, _
  2490. ByVal i_enumSKUs As SKU_E, _
  2491. ByVal i_blnFastImport As Boolean _
  2492. )
  2493. Dim DOMNode As MSXML2.IXMLDOMNode
  2494. Dim T0 As Date
  2495. Dim T1 As Date
  2496. T0 = Now
  2497. If (u_DOMNode.nodeName = HHT_TAXONOMY_ENTRIES_C) Then
  2498. If (Not (u_DOMNode.firstChild Is Nothing)) Then
  2499. For Each DOMNode In u_DOMNode.childNodes
  2500. p_ReplaceTaxonomySubtree2 DOMNode, i_intParentTID, i_enumSKUs, i_blnFastImport
  2501. Next
  2502. End If
  2503. ElseIf (u_DOMNode.nodeName = HHT_TAXONOMY_ENTRY_C) Then
  2504. p_ReplaceTaxonomySubtree2 u_DOMNode, i_intParentTID, i_enumSKUs, i_blnFastImport
  2505. End If
  2506. T1 = Now
  2507. Debug.Print "p_ReplaceTaxonomySubtree: " & FormatTime(T0, T1)
  2508. End Sub
  2509. Private Sub p_SetTypeSKUsLeafLocIncludeVisibleSubSite( _
  2510. ByVal u_DOMNode As MSXML2.IXMLDOMNode, _
  2511. ByVal i_enumSKUs As SKU_E, _
  2512. ByRef i_strLocInclude As String _
  2513. )
  2514. Dim DOMNode As MSXML2.IXMLDOMNode
  2515. Dim blnHasChildren As Boolean
  2516. If (XMLGetAttribute(u_DOMNode, HHT_TYPE_C) = "") Then
  2517. XMLSetAttribute u_DOMNode, HHT_TYPE_C, 0
  2518. End If
  2519. XMLSetAttribute u_DOMNode, HHT_skus_C, i_enumSKUs
  2520. If (Not u_DOMNode.firstChild Is Nothing) Then
  2521. blnHasChildren = True
  2522. End If
  2523. If (XMLGetAttribute(u_DOMNode, HHT_leaf_C) = "") Then
  2524. XMLSetAttribute u_DOMNode, HHT_leaf_C, IIf(blnHasChildren, False, True)
  2525. End If
  2526. XMLSetAttribute u_DOMNode, HHT_locinclude_C, i_strLocInclude
  2527. If (XMLGetAttribute(u_DOMNode, HHT_VISIBLE_C) = "") Then
  2528. XMLSetAttribute u_DOMNode, HHT_VISIBLE_C, CStr(True)
  2529. End If
  2530. If (XMLGetAttribute(u_DOMNode, HHT_SUBSITE_C) = "") Then
  2531. XMLSetAttribute u_DOMNode, HHT_SUBSITE_C, CStr(False)
  2532. End If
  2533. If (blnHasChildren) Then
  2534. For Each DOMNode In u_DOMNode.childNodes
  2535. p_SetTypeSKUsLeafLocIncludeVisibleSubSite DOMNode, i_enumSKUs, i_strLocInclude
  2536. Next
  2537. End If
  2538. End Sub
  2539. Private Sub p_ReplaceTaxonomySubtree2( _
  2540. ByVal u_DOMNode As MSXML2.IXMLDOMNode, _
  2541. ByVal i_intParentTID As Long, _
  2542. ByVal i_enumSKUs As SKU_E, _
  2543. ByVal i_blnFastImport As Boolean _
  2544. )
  2545. On Error GoTo LErrorHandler
  2546. Dim strStatusText As String
  2547. Dim NodeParent As Node
  2548. Dim strLocInclude As String
  2549. Me.MousePointer = vbHourglass
  2550. Me.Enabled = False
  2551. strStatusText = p_GetStatusText(SBPANEL_DATABASE)
  2552. ' For some reason, if nodeParent is passed in to p_ReplaceTaxonomySubtree2
  2553. ' from treTaxonomy_DragDrop, we get the error "The items's control has been
  2554. ' deleted" after about 20 min of processing. So we pass in the TID instead.
  2555. Set NodeParent = treTaxonomy.Nodes(KEY_PREFIX_C & i_intParentTID)
  2556. p_SetStatusText SBPANEL_DATABASE, "Creating new Nodes/Topics..."
  2557. strLocInclude = XMLGetAttribute(NodeParent.Tag, HHT_locinclude_C)
  2558. p_SetTypeSKUsLeafLocIncludeVisibleSubSite u_DOMNode, i_enumSKUs, strLocInclude
  2559. p_CreateTaxonomyEntries u_DOMNode, NodeParent, i_blnFastImport
  2560. LEnd:
  2561. Me.Enabled = True
  2562. Me.MousePointer = vbDefault
  2563. p_SetStatusText SBPANEL_DATABASE, strStatusText
  2564. Exit Sub
  2565. LErrorHandler:
  2566. g_ErrorInfo.SetInfoAndDump "p_ReplaceTaxonomySubtree2"
  2567. GoTo LEnd
  2568. End Sub
  2569. Private Sub p_SaveClicked( _
  2570. ByRef o_blnUpdateControls As Boolean _
  2571. )
  2572. Dim str As String
  2573. Dim intError As Long
  2574. Dim bln As Boolean
  2575. Dim intTID As Long
  2576. If (p_blnUpdating) Then
  2577. intTID = XMLGetAttribute(treTaxonomy.Nodes(MODIFY_KEY_C).Tag, HHT_tid_C)
  2578. If (intTID = ROOT_TID_C) Then
  2579. p_SetModeUpdating False
  2580. o_blnUpdateControls = True
  2581. Exit Sub
  2582. End If
  2583. End If
  2584. o_blnUpdateControls = False
  2585. str = RemoveExtraSpaces(txtTitle)
  2586. If (str = "") Then
  2587. MsgBox "Title cannot be blank", vbExclamation Or vbOKOnly
  2588. txtTitle.SetFocus
  2589. Exit Sub
  2590. End If
  2591. If (p_blnCreating) Then
  2592. bln = p_CreateTaxonomy
  2593. ElseIf (p_blnUpdating) Then
  2594. bln = p_UpdateTaxonomy
  2595. End If
  2596. o_blnUpdateControls = bln
  2597. End Sub
  2598. Private Function p_GetAllowedSKUs( _
  2599. ByRef i_DOMNodeParent As MSXML2.IXMLDOMNode _
  2600. ) As SKU_E
  2601. p_GetAllowedSKUs = XMLGetAttribute(i_DOMNodeParent, HHT_allowedskus_C) And _
  2602. XMLGetAttribute(i_DOMNodeParent, HHT_skus_C)
  2603. End Function
  2604. Private Function p_CreateTaxonomy() As Boolean
  2605. On Error GoTo LErrorHandler
  2606. Dim intSelectedSKUs As Long
  2607. Dim intParentTID As Long
  2608. Dim Node As Node
  2609. Dim blnLeaf As Boolean
  2610. Dim blnVisible As Boolean
  2611. Dim blnSubSite As Boolean
  2612. Dim strTitle As String
  2613. Dim strDescription As String
  2614. Dim strURI As String
  2615. Dim strIconURI As String
  2616. Dim intTID As Long
  2617. Dim intType As Long
  2618. Dim intNavModel As Long
  2619. Dim strLocInclude As String
  2620. Dim strKeywords As String
  2621. Dim DOMNodeParent As MSXML2.IXMLDOMNode
  2622. Dim DOMNode As MSXML2.IXMLDOMNode
  2623. Dim ModifiedDOMNodes As MSXML2.IXMLDOMNode
  2624. Dim NodeParent As Node
  2625. Dim enumAllowedSKUs As SKU_E
  2626. p_CreateTaxonomy = False
  2627. Set Node = treTaxonomy.Nodes(CREATE_KEY_C)
  2628. Set DOMNodeParent = Node.Tag
  2629. intParentTID = XMLGetAttribute(DOMNodeParent, HHT_tid_C)
  2630. intSelectedSKUs = p_GetSelectedSKUs
  2631. If (p_IsLeaf(Node)) Then
  2632. blnLeaf = True
  2633. Else
  2634. blnLeaf = False
  2635. End If
  2636. strTitle = RemoveExtraSpaces(txtTitle)
  2637. strDescription = RemoveExtraSpaces(txtDescription)
  2638. strURI = RemoveExtraSpaces(txtURI)
  2639. strIconURI = RemoveExtraSpaces(txtIconURI)
  2640. blnVisible = IIf((chkVisible.Value = 0), False, True)
  2641. blnSubSite = IIf((chkSubSite.Value = 0), False, True)
  2642. intType = p_GetSelectedType
  2643. strLocInclude = p_GetSelectedLocInclude
  2644. intNavModel = p_GetSelectedNavModel
  2645. strKeywords = p_GetKeywords
  2646. p_clsTaxonomy.Create strTitle, strDescription, intType, intNavModel, strURI, strIconURI, _
  2647. intSelectedSKUs, blnLeaf, intParentTID, strLocInclude, blnVisible, blnSubSite, _
  2648. strKeywords, "", txtComments, txtEntry, DOMNodeParent.ownerDocument, DOMNode, _
  2649. ModifiedDOMNodes
  2650. p_SetModeCreating False
  2651. intTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  2652. DOMNodeParent.appendChild DOMNode
  2653. treTaxonomy.Nodes.Remove CREATE_KEY_C
  2654. enumAllowedSKUs = p_GetAllowedSKUs(DOMNodeParent)
  2655. Set NodeParent = treTaxonomy.Nodes(KEY_PREFIX_C & intParentTID)
  2656. p_CreateTree DOMNode, NodeParent, enumAllowedSKUs
  2657. p_CreateTaxonomy = True
  2658. p_UpdateTIDs ModifiedDOMNodes
  2659. ' The UI must show the new keywords that were associated by p_clsTaxonomy.Create
  2660. Highlight intTID
  2661. LEnd:
  2662. Exit Function
  2663. LErrorHandler:
  2664. Select Case Err.Number
  2665. Case errContainsGarbageChar
  2666. MsgBox "The Title " & strTitle & _
  2667. " or the Description " & strDescription & _
  2668. " contains garbage characters", _
  2669. vbExclamation + vbOKOnly
  2670. Case errTooLong
  2671. MsgBox "The Title " & strTitle & " is too long", _
  2672. vbExclamation + vbOKOnly
  2673. Case E_FAIL
  2674. DisplayDatabaseLockedError
  2675. Case errDatabaseVersionIncompatible
  2676. DisplayDatabaseVersionError
  2677. Err.Raise Err.Number
  2678. Case errAuthoringGroupNotPresent
  2679. DisplayAuthoringGroupError
  2680. Case Else
  2681. g_ErrorInfo.SetInfoAndRaiseError "p_CreateTaxonomy"
  2682. End Select
  2683. GoTo LEnd
  2684. End Function
  2685. Private Sub p_SetKeywords( _
  2686. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  2687. )
  2688. Dim intTID As Long
  2689. Dim strURI As String
  2690. Dim DOMNodeNew As MSXML2.IXMLDOMNode
  2691. Dim ModifiedDOMNodes As MSXML2.IXMLDOMNode
  2692. Dim dtmModifiedTime As Date
  2693. intTID = XMLGetAttribute(i_DOMNode, HHT_tid_C)
  2694. strURI = XMLGetAttribute(i_DOMNode, HHT_URI_C)
  2695. dtmModifiedTime = XMLGetAttribute(i_DOMNode, HHT_modifiedtime_C)
  2696. p_clsTaxonomy.SetKeywords intTID, strURI, p_strKeywords, dtmModifiedTime, _
  2697. i_DOMNode.ownerDocument, DOMNodeNew, ModifiedDOMNodes
  2698. If (Not DOMNodeNew Is Nothing) Then
  2699. ' If nothing changed, then DOMNodeNew will be Nothing.
  2700. XMLCopyAttributes DOMNodeNew, i_DOMNode
  2701. End If
  2702. If (Not ModifiedDOMNodes Is Nothing) Then
  2703. p_UpdateTIDs ModifiedDOMNodes
  2704. End If
  2705. End Sub
  2706. Private Function p_UpdateTaxonomy() As Boolean
  2707. On Error GoTo LErrorHandler
  2708. Dim intSelectedSKUs As Long
  2709. Dim intTID As Long
  2710. Dim Node As Node
  2711. Dim blnVisible As Boolean
  2712. Dim blnSubSite As Boolean
  2713. Dim strTitle As String
  2714. Dim strDescription As String
  2715. Dim strURI As String
  2716. Dim strIconURI As String
  2717. Dim intType As Long
  2718. Dim intNavModel As Long
  2719. Dim strLocInclude As String
  2720. Dim strKeywords As String
  2721. Dim strOriginalKeywords As String
  2722. Dim strDeletedKeywords As String
  2723. Dim DOMNode As MSXML2.IXMLDOMNode
  2724. Dim DOMNodeNew As MSXML2.IXMLDOMNode
  2725. Dim ModifiedDOMNodes As MSXML2.IXMLDOMNode
  2726. Dim dtmModifiedTime As Date
  2727. Dim enumSKUsOld As SKU_E
  2728. p_UpdateTaxonomy = False
  2729. Set Node = treTaxonomy.Nodes(MODIFY_KEY_C)
  2730. Set DOMNode = Node.Tag
  2731. intTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  2732. intSelectedSKUs = p_GetSelectedSKUs
  2733. blnVisible = IIf((chkVisible.Value = 0), False, True)
  2734. blnSubSite = IIf((chkSubSite.Value = 0), False, True)
  2735. strTitle = RemoveExtraSpaces(txtTitle)
  2736. strDescription = RemoveExtraSpaces(txtDescription)
  2737. strURI = RemoveExtraSpaces(txtURI)
  2738. strIconURI = RemoveExtraSpaces(txtIconURI)
  2739. intType = p_GetSelectedType
  2740. intNavModel = p_GetSelectedNavModel
  2741. strLocInclude = p_GetSelectedLocInclude
  2742. strKeywords = p_GetKeywords
  2743. strOriginalKeywords = XMLGetAttribute(DOMNode, HHT_keywords_C)
  2744. strDeletedKeywords = p_GetDeletedKeywords(strOriginalKeywords, strKeywords)
  2745. dtmModifiedTime = XMLGetAttribute(DOMNode, HHT_modifiedtime_C)
  2746. p_clsTaxonomy.Update intTID, strTitle, strDescription, intType, intNavModel, strURI, _
  2747. strIconURI, intSelectedSKUs, strLocInclude, blnVisible, blnSubSite, strKeywords, _
  2748. strDeletedKeywords, txtComments, txtEntry, dtmModifiedTime, _
  2749. DOMNode.ownerDocument, DOMNodeNew, ModifiedDOMNodes
  2750. enumSKUsOld = XMLGetAttribute(DOMNode, HHT_skus_C)
  2751. If (Not DOMNodeNew Is Nothing) Then
  2752. ' If nothing changed, then DOMNodeNew will be Nothing.
  2753. ' p_SetModeUpdating will set the title. Make sure that it is correct.
  2754. XMLCopyAttributes DOMNodeNew, DOMNode
  2755. End If
  2756. p_SetModeUpdating False
  2757. p_UpdateTaxonomy = True
  2758. If (intSelectedSKUs <> enumSKUsOld) Then
  2759. p_UpdateSubTree intTID, XMLGetAttribute(DOMNode, HHT_allowedskus_C)
  2760. End If
  2761. If (Not ModifiedDOMNodes Is Nothing) Then
  2762. p_UpdateTIDs ModifiedDOMNodes
  2763. End If
  2764. p_SetNodeColor Node, DOMNode
  2765. ' The UI must show the new keywords that were associated by p_clsTaxonomy.Update
  2766. Highlight intTID
  2767. LEnd:
  2768. Exit Function
  2769. LErrorHandler:
  2770. Select Case Err.Number
  2771. Case errContainsGarbageChar
  2772. MsgBox "The Title " & strTitle & _
  2773. " or the Description " & strDescription & _
  2774. " contains garbage characters", _
  2775. vbExclamation + vbOKOnly
  2776. Case errTooLong
  2777. MsgBox "The Title " & strTitle & " is too long", _
  2778. vbExclamation + vbOKOnly
  2779. Case errNodeOrTopicAlreadyModified
  2780. MsgBox "Someone else already modified this entry. " & _
  2781. "You need to Cancel your entry, Refresh the database and then " & _
  2782. "re-enter your changes. " & _
  2783. "This prevents you from accidentally overwriting something " & _
  2784. "the other person entered. " & _
  2785. "Tip: Before cancelling your changes, copy them to Notepad.", _
  2786. vbExclamation + vbOKOnly
  2787. Case E_FAIL
  2788. DisplayDatabaseLockedError
  2789. Case errDatabaseVersionIncompatible
  2790. DisplayDatabaseVersionError
  2791. Err.Raise Err.Number
  2792. Case errNotPermittedForAuthoringGroup, errAuthoringGroupDiffers, errAuthoringGroupNotPresent
  2793. DisplayAuthoringGroupError
  2794. Case Else
  2795. g_ErrorInfo.SetInfoAndRaiseError "p_UpdateTaxonomy"
  2796. End Select
  2797. GoTo LEnd
  2798. End Function
  2799. Private Sub p_UpdateTIDs( _
  2800. ByRef i_ModifiedDOMNodes As MSXML2.IXMLDOMNode _
  2801. )
  2802. Dim DOMNodes As MSXML2.IXMLDOMNode
  2803. Dim DOMNode As MSXML2.IXMLDOMNode
  2804. Dim intTID As Long
  2805. Dim intParentTID As Long
  2806. Dim intOrderUnderParent As Long
  2807. Dim enumSKUs As SKU_E
  2808. Dim Node As Node
  2809. Dim DOMNodeOld As MSXML2.IXMLDOMNode
  2810. Dim intParentTIDOld As Long
  2811. Dim intOrderUnderParentOld As Long
  2812. Dim enumSKUsOld As SKU_E
  2813. Dim blnRefresh As Boolean
  2814. Dim strTitle As String
  2815. Set DOMNodes = XMLFindFirstNode(i_ModifiedDOMNodes, HHT_TAXONOMY_ENTRIES_C)
  2816. If (Not DOMNodes.firstChild Is Nothing) Then
  2817. For Each DOMNode In DOMNodes.childNodes
  2818. intTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  2819. If (Not p_NodeExists(intTID)) Then
  2820. GoTo LForEnd
  2821. End If
  2822. intParentTID = XMLGetAttribute(DOMNode, HHT_parenttid_C)
  2823. intOrderUnderParent = XMLGetAttribute(DOMNode, HHT_orderunderparent_C)
  2824. enumSKUs = XMLGetAttribute(DOMNode, HHT_skus_C)
  2825. Set Node = treTaxonomy.Nodes(KEY_PREFIX_C & intTID)
  2826. Set DOMNodeOld = Node.Tag
  2827. intParentTIDOld = XMLGetAttribute(DOMNodeOld, HHT_parenttid_C)
  2828. intOrderUnderParentOld = XMLGetAttribute(DOMNodeOld, HHT_orderunderparent_C)
  2829. enumSKUsOld = XMLGetAttribute(DOMNodeOld, HHT_skus_C)
  2830. If ((intParentTID <> intParentTIDOld) Or _
  2831. (intOrderUnderParent <> intOrderUnderParentOld)) Then
  2832. blnRefresh = True
  2833. Exit For
  2834. End If
  2835. XMLCopyAttributes DOMNode, DOMNodeOld
  2836. strTitle = XMLGetAttribute(DOMNode, HHT_TITLE_C)
  2837. Node.Text = strTitle
  2838. If (enumSKUs <> enumSKUsOld) Then
  2839. p_UpdateSubTree intTID, XMLGetAttribute(DOMNode, HHT_allowedskus_C)
  2840. End If
  2841. LForEnd:
  2842. Next
  2843. End If
  2844. If (blnRefresh) Then
  2845. cmdRefresh_Click
  2846. End If
  2847. End Sub
  2848. Private Sub p_CreateTaxonomyEntries( _
  2849. ByRef i_DOMNode As MSXML2.IXMLDOMNode, _
  2850. ByRef i_nodeParent As Node, _
  2851. ByVal i_blnFast As Boolean _
  2852. )
  2853. On Error GoTo LErrorHandler
  2854. Dim intParentTID As Long
  2855. Dim DOMNodeParent As MSXML2.IXMLDOMNode
  2856. Dim enumAllowedSKUs As SKU_E
  2857. Dim DOMDoc As MSXML2.DOMDocument
  2858. Dim DOMNode As MSXML2.IXMLDOMNode
  2859. If (p_blnCreating Or p_blnUpdating) Then
  2860. Exit Sub
  2861. End If
  2862. Set DOMNodeParent = i_nodeParent.Tag
  2863. intParentTID = XMLGetAttribute(DOMNodeParent, HHT_tid_C)
  2864. Set DOMDoc = New MSXML2.DOMDocument
  2865. Set DOMNode = HhtPreamble(DOMDoc, True)
  2866. XMLCopyDOMTree i_DOMNode, DOMNode
  2867. Set DOMNode = XMLFindFirstNode(DOMNode, HHT_TAXONOMY_ENTRY_C)
  2868. p_clsTaxonomy.CreateTaxonomyEntries DOMNode, intParentTID, i_blnFast
  2869. enumAllowedSKUs = p_GetAllowedSKUs(DOMNodeParent)
  2870. DOMNodeParent.appendChild DOMNode
  2871. p_CreateTree DOMNode, i_nodeParent, enumAllowedSKUs
  2872. LEnd:
  2873. Exit Sub
  2874. LErrorHandler:
  2875. Select Case Err.Number
  2876. Case E_FAIL
  2877. DisplayDatabaseLockedError
  2878. Case errDatabaseVersionIncompatible
  2879. DisplayDatabaseVersionError
  2880. Err.Raise Err.Number
  2881. Case errAuthoringGroupNotPresent
  2882. DisplayAuthoringGroupError
  2883. Case Else
  2884. g_ErrorInfo.SetInfoAndRaiseError "p_CreateTaxonomyEntries"
  2885. End Select
  2886. GoTo LEnd
  2887. End Sub
  2888. Private Sub p_Move(i_Node As Node, i_nodeRef As Node, i_blnAbove As Boolean)
  2889. On Error GoTo LErrorHandler
  2890. Dim DOMNode As MSXML2.IXMLDOMNode
  2891. Dim DOMNodeRef As MSXML2.IXMLDOMNode
  2892. Dim DOMNodeNewParent As MSXML2.IXMLDOMNode
  2893. Dim intTID As Long
  2894. Dim intRefTID As Long
  2895. Dim dtmModifiedTime As Date
  2896. Dim intNewParentTID As Long
  2897. Dim NodeNewParent As Node
  2898. Dim enumAllowedSKUs As SKU_E
  2899. Dim intOrderUnderParent As Long
  2900. If (p_blnCreating Or p_blnUpdating) Then
  2901. Exit Sub
  2902. End If
  2903. Set DOMNode = i_Node.Tag
  2904. Set DOMNodeRef = i_nodeRef.Tag
  2905. intTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  2906. intRefTID = XMLGetAttribute(DOMNodeRef, HHT_tid_C)
  2907. dtmModifiedTime = XMLGetAttribute(DOMNode, HHT_modifiedtime_C)
  2908. p_clsTaxonomy.Move intTID, intRefTID, i_blnAbove, dtmModifiedTime, intOrderUnderParent
  2909. intNewParentTID = XMLGetAttribute(DOMNodeRef, HHT_parenttid_C)
  2910. XMLSetAttribute DOMNode, HHT_modifiedtime_C, Now
  2911. XMLSetAttribute DOMNode, HHT_parenttid_C, intNewParentTID
  2912. XMLSetAttribute DOMNode, HHT_orderunderparent_C, intOrderUnderParent
  2913. Set DOMNodeNewParent = treTaxonomy.Nodes(KEY_PREFIX_C & intNewParentTID).Tag
  2914. DOMNode.parentNode.removeChild DOMNode
  2915. DOMNodeNewParent.insertBefore DOMNode, DOMNodeRef
  2916. treTaxonomy.Nodes.Remove i_Node.Key
  2917. enumAllowedSKUs = p_GetAllowedSKUs(DOMNodeNewParent)
  2918. p_CreateTree DOMNode, i_nodeRef.Parent, enumAllowedSKUs, _
  2919. i_nodeRef, i_blnAbove
  2920. treTaxonomy_NodeClick treTaxonomy.SelectedItem
  2921. LEnd:
  2922. Exit Sub
  2923. LErrorHandler:
  2924. Select Case Err.Number
  2925. Case errRefNodeCannotBeDescendent
  2926. MsgBox "A Node cannot move above or below a descendent Node", _
  2927. vbExclamation + vbOKOnly
  2928. Case errNodeOrTopicAlreadyModified
  2929. MsgBox "Someone else already modified this entry. " & _
  2930. "You need to Refresh the database and then try again. " & _
  2931. "This prevents you from accidentally overwriting something " & _
  2932. "the other person entered.", _
  2933. vbExclamation + vbOKOnly
  2934. Case E_FAIL
  2935. DisplayDatabaseLockedError
  2936. Case errDatabaseVersionIncompatible
  2937. DisplayDatabaseVersionError
  2938. Err.Raise Err.Number
  2939. Case errNotPermittedForAuthoringGroup, errAuthoringGroupDiffers, errAuthoringGroupNotPresent
  2940. DisplayAuthoringGroupError
  2941. Case Else
  2942. g_ErrorInfo.SetInfoAndRaiseError "p_Move"
  2943. End Select
  2944. GoTo LEnd
  2945. End Sub
  2946. Private Sub p_ChangeParent(i_Node As Node, i_nodeParent As Node)
  2947. On Error GoTo LErrorHandler
  2948. Dim DOMNode As MSXML2.IXMLDOMNode
  2949. Dim intTID As Long
  2950. Dim intOldParentTID As Long
  2951. Dim intNewParentTID As Long
  2952. Dim dtmModifiedTime As Date
  2953. Dim DOMNodeNewParent As MSXML2.IXMLDOMNode
  2954. Dim NodeNewParent As Node
  2955. Dim enumAllowedSKUs As SKU_E
  2956. Dim intOrderUnderParent As Long
  2957. If (p_blnCreating Or p_blnUpdating) Then
  2958. Exit Sub
  2959. End If
  2960. Set DOMNode = i_Node.Tag
  2961. Set DOMNodeNewParent = i_nodeParent.Tag
  2962. intTID = XMLGetAttribute(DOMNode, HHT_tid_C)
  2963. intOldParentTID = XMLGetAttribute(i_Node.Parent.Tag, HHT_tid_C)
  2964. intNewParentTID = XMLGetAttribute(DOMNodeNewParent, HHT_tid_C)
  2965. dtmModifiedTime = XMLGetAttribute(DOMNode, HHT_modifiedtime_C)
  2966. Set NodeNewParent = treTaxonomy.Nodes(KEY_PREFIX_C & intNewParentTID)
  2967. If (intOldParentTID = intNewParentTID) Then
  2968. Exit Sub
  2969. End If
  2970. p_clsTaxonomy.MoveInto intTID, intNewParentTID, dtmModifiedTime, intOrderUnderParent
  2971. XMLSetAttribute DOMNode, HHT_modifiedtime_C, Now
  2972. XMLSetAttribute DOMNode, HHT_parenttid_C, intNewParentTID
  2973. XMLSetAttribute DOMNode, HHT_orderunderparent_C, intOrderUnderParent
  2974. DOMNode.parentNode.removeChild DOMNode
  2975. DOMNodeNewParent.appendChild DOMNode
  2976. treTaxonomy.Nodes.Remove i_Node.Key
  2977. enumAllowedSKUs = p_GetAllowedSKUs(DOMNodeNewParent)
  2978. p_CreateTree DOMNode, NodeNewParent, enumAllowedSKUs
  2979. treTaxonomy_NodeClick treTaxonomy.SelectedItem
  2980. LEnd:
  2981. Exit Sub
  2982. LErrorHandler:
  2983. Select Case Err.Number
  2984. Case errRefNodeCannotBeDescendent
  2985. MsgBox "A Node cannot be a child of a descendent Node", _
  2986. vbExclamation + vbOKOnly
  2987. Case errParentCannotBeLeaf
  2988. MsgBox "A Node cannot be a child of a Topic", _
  2989. vbExclamation + vbOKOnly
  2990. Case errNodeOrTopicAlreadyModified
  2991. MsgBox "Someone else already modified this entry. " & _
  2992. "You need to Refresh the database and then try again. " & _
  2993. "This prevents you from accidentally overwriting something " & _
  2994. "the other person entered.", _
  2995. vbExclamation + vbOKOnly
  2996. Case E_FAIL
  2997. DisplayDatabaseLockedError
  2998. Case errDatabaseVersionIncompatible
  2999. DisplayDatabaseVersionError
  3000. Err.Raise Err.Number
  3001. Case errNotPermittedForAuthoringGroup, errAuthoringGroupDiffers, errAuthoringGroupNotPresent
  3002. DisplayAuthoringGroupError
  3003. Case Else
  3004. g_ErrorInfo.SetInfoAndRaiseError "p_ChangeParent"
  3005. End Select
  3006. GoTo LEnd
  3007. End Sub
  3008. Private Function p_GetKeywords() As String
  3009. Dim intKID As Variant
  3010. p_GetKeywords = " "
  3011. For Each intKID In p_dictKeywordsWithTitle.Keys
  3012. p_GetKeywords = p_GetKeywords & intKID & " "
  3013. Next
  3014. If (p_GetKeywords = " ") Then
  3015. p_GetKeywords = ""
  3016. End If
  3017. End Function
  3018. Private Function p_GetDeletedKeywords( _
  3019. ByVal strOldKeywords As String, _
  3020. ByVal strNewKeywords As String _
  3021. ) As String
  3022. Dim arrOldKIDs() As String
  3023. Dim arrNewKIDs() As String
  3024. Dim intIndex1 As Long
  3025. Dim intIndex2 As Long
  3026. Dim blnFound As Boolean
  3027. p_GetDeletedKeywords = " "
  3028. arrOldKIDs = Split(strOldKeywords, " ")
  3029. arrNewKIDs = Split(strNewKeywords, " ")
  3030. For intIndex1 = LBound(arrOldKIDs) To UBound(arrOldKIDs)
  3031. blnFound = False
  3032. intIndex2 = LBound(arrNewKIDs)
  3033. Do While (intIndex2 <= UBound(arrNewKIDs))
  3034. If (arrOldKIDs(intIndex1) = arrNewKIDs(intIndex2)) Then
  3035. blnFound = True
  3036. Exit Do
  3037. End If
  3038. intIndex2 = intIndex2 + 1
  3039. Loop
  3040. If (Not blnFound) Then
  3041. p_GetDeletedKeywords = p_GetDeletedKeywords & arrOldKIDs(intIndex1) & " "
  3042. End If
  3043. Next
  3044. End Function
  3045. Private Sub p_UpdateSubTree( _
  3046. ByVal i_intTID As Long, _
  3047. ByVal i_enumAllowedSKUs As SKU_E _
  3048. )
  3049. Dim Node As Node
  3050. Dim DOMNode As MSXML2.IXMLDOMNode
  3051. Dim ChildDOMNode As MSXML2.IXMLDOMNode
  3052. Dim enumAllowedSKUs As SKU_E
  3053. Dim intTID As Long
  3054. Set Node = treTaxonomy.Nodes(KEY_PREFIX_C & i_intTID)
  3055. Set DOMNode = Node.Tag
  3056. If (i_intTID <> ROOT_TID_C) Then
  3057. XMLSetAttribute DOMNode, HHT_allowedskus_C, i_enumAllowedSKUs
  3058. p_SetNodeImage Node, DOMNode
  3059. p_SetNodeColor Node, DOMNode
  3060. enumAllowedSKUs = i_enumAllowedSKUs And XMLGetAttribute(DOMNode, HHT_skus_C)
  3061. Else
  3062. enumAllowedSKUs = i_enumAllowedSKUs
  3063. End If
  3064. ' Now update the descendents
  3065. If (Not DOMNode.firstChild Is Nothing) Then
  3066. For Each ChildDOMNode In DOMNode.childNodes
  3067. intTID = XMLGetAttribute(ChildDOMNode, HHT_tid_C)
  3068. p_UpdateSubTree intTID, enumAllowedSKUs
  3069. Next
  3070. End If
  3071. End Sub
  3072. Private Sub p_CreateTree( _
  3073. ByRef u_DOMNode As MSXML2.IXMLDOMNode, _
  3074. ByRef i_Node As Node, _
  3075. ByVal i_enumAllowedSKUs As SKU_E, _
  3076. Optional ByRef i_nodeRef As Node = Nothing, _
  3077. Optional ByRef i_blnAbove As Boolean _
  3078. )
  3079. On Error GoTo LErrorHandler
  3080. Dim DOMNode As MSXML2.IXMLDOMNode
  3081. Dim Node As Node
  3082. Dim strTitle As String
  3083. Dim strKey As String
  3084. Dim enumAllowedSKUs As SKU_E
  3085. Dim intRelationship As Long
  3086. If (u_DOMNode.nodeName = HHT_TAXONOMY_ENTRY_C) Then
  3087. strTitle = XMLGetAttribute(u_DOMNode, HHT_TITLE_C)
  3088. strKey = KEY_PREFIX_C & XMLGetAttribute(u_DOMNode, HHT_tid_C)
  3089. XMLSetAttribute u_DOMNode, HHT_allowedskus_C, i_enumAllowedSKUs
  3090. If (i_Node Is Nothing) Then
  3091. Set Node = treTaxonomy.Nodes.Add(Key:=strKey, Text:=strTitle)
  3092. Node.Expanded = True
  3093. Else
  3094. If (i_nodeRef Is Nothing) Then
  3095. Set Node = treTaxonomy.Nodes.Add(i_Node, tvwChild, strKey, strTitle)
  3096. Else
  3097. If (i_blnAbove) Then
  3098. intRelationship = tvwPrevious
  3099. Else
  3100. intRelationship = tvwNext
  3101. End If
  3102. Set Node = treTaxonomy.Nodes.Add(i_nodeRef.Key, intRelationship, strKey, _
  3103. strTitle)
  3104. End If
  3105. End If
  3106. Set Node.Tag = u_DOMNode
  3107. p_SetNodeColor Node, u_DOMNode
  3108. p_SetNodeImage Node, u_DOMNode
  3109. enumAllowedSKUs = i_enumAllowedSKUs And XMLGetAttribute(u_DOMNode, HHT_skus_C)
  3110. Else
  3111. Set Node = i_Node
  3112. enumAllowedSKUs = i_enumAllowedSKUs
  3113. End If
  3114. If (Not (u_DOMNode.firstChild Is Nothing)) Then
  3115. For Each DOMNode In u_DOMNode.childNodes
  3116. p_CreateTree DOMNode, Node, enumAllowedSKUs
  3117. Next
  3118. End If
  3119. LEnd:
  3120. Exit Sub
  3121. LErrorHandler:
  3122. g_ErrorInfo.SetInfoAndRaiseError "p_CreateTree"
  3123. GoTo LEnd
  3124. End Sub
  3125. Private Sub p_InitializeDataStructures( _
  3126. ByRef o_DOMNode As MSXML2.IXMLDOMNode _
  3127. )
  3128. ' Put a Me.Enabled = True in the error handler that will handle errors
  3129. ' that happen here.
  3130. Dim T0 As Date
  3131. Dim T1 As Date
  3132. Dim DOMDoc As MSXML2.DOMDocument
  3133. Me.Enabled = False
  3134. T0 = Now
  3135. Set p_colKeywords = New Collection
  3136. p_SetStatusText SBPANEL_DATABASE, "Reading Keywords from Database..."
  3137. p_clsKeywords.GetAllKeywordsColl p_colKeywords
  3138. p_SetStatusText SBPANEL_DATABASE, "Reading Taxonomy from Database..."
  3139. Set DOMDoc = p_clsTaxonomy.GetTaxonomyInXml
  3140. p_SetStatusText SBPANEL_DATABASE, ""
  3141. Set o_DOMNode = XMLFindFirstNode(DOMDoc, HHT_TAXONOMY_ENTRY_C)
  3142. T1 = Now
  3143. Debug.Print "p_InitializeDataStructures: " & FormatTime(T0, T1)
  3144. Me.Enabled = True
  3145. End Sub
  3146. Private Sub p_Refresh( _
  3147. ByRef i_DOMNode As MSXML2.IXMLDOMNode _
  3148. )
  3149. ' Put a Me.Enabled = True in the error handler that will handle errors
  3150. ' that happen here.
  3151. Dim T0 As Date
  3152. Dim T1 As Date
  3153. Me.Enabled = False
  3154. T0 = Now
  3155. If (p_blnCreating Or p_blnUpdating) Then
  3156. Exit Sub
  3157. End If
  3158. p_ClearTreeView
  3159. p_ClearNodeDetails
  3160. p_DisableEditPaste
  3161. p_DisableEditPasteKeywords
  3162. p_InitializeTypeCombo
  3163. p_EnableTaxonomyAndSomeMenus
  3164. p_EnableRefresh
  3165. p_EnableNodeDetailsExceptIndividualSKUs
  3166. p_SetStatusText SBPANEL_DATABASE, "Creating Taxonomy tree..."
  3167. p_CreateTree i_DOMNode, Nothing, ALL_SKUS_C
  3168. p_SetStatusText SBPANEL_DATABASE, ""
  3169. T1 = Now
  3170. Debug.Print "p_Refresh: " & FormatTime(T0, T1)
  3171. Me.Enabled = True
  3172. End Sub
  3173. Private Sub p_SetKeywordsList()
  3174. On Error GoTo LErrorHandler
  3175. Dim intKID As Variant
  3176. cboKeywords.Clear
  3177. For Each intKID In p_dictKeywordsWithTitle
  3178. cboKeywords.AddItem p_colKeywords(CStr(intKID))
  3179. Next
  3180. Exit Sub
  3181. LErrorHandler:
  3182. g_ErrorInfo.SetInfoAndRaiseError "p_SetKeywordsList"
  3183. End Sub
  3184. Private Function p_GetStatusText(i_enumPanel As STATUS_BAR_PANEL_E) As String
  3185. p_GetStatusText = staInfo.Panels(i_enumPanel).Text
  3186. End Function
  3187. Private Sub p_SetStatusText(i_enumPanel As STATUS_BAR_PANEL_E, i_strText As String)
  3188. staInfo.Panels(i_enumPanel).Text = i_strText
  3189. End Sub
  3190. Private Sub p_SetNavModelCombo(i_strNavModel As String)
  3191. Dim strNavModel As String
  3192. Dim intIndex As Long
  3193. If (i_strNavModel = "") Then
  3194. strNavModel = NAVMODEL_DEFAULT_STR_C
  3195. Else
  3196. strNavModel = i_strNavModel
  3197. End If
  3198. For intIndex = 0 To cboNavModel.ListCount - 1
  3199. If (cboNavModel.List(intIndex) = strNavModel) Then
  3200. cboNavModel.ListIndex = intIndex
  3201. Exit For
  3202. End If
  3203. Next
  3204. End Sub
  3205. Private Sub p_InitializeNavModelCombo()
  3206. cboNavModel.Clear
  3207. cboNavModel.AddItem NAVMODEL_DEFAULT_STR_C
  3208. cboNavModel.ItemData(cboNavModel.NewIndex) = NAVMODEL_DEFAULT_NUM_C
  3209. cboNavModel.AddItem NAVMODEL_SERVER_STR_C
  3210. cboNavModel.ItemData(cboNavModel.NewIndex) = NAVMODEL_SERVER_NUM_C
  3211. cboNavModel.AddItem NAVMODEL_DESKTOP_STR_C
  3212. cboNavModel.ItemData(cboNavModel.NewIndex) = NAVMODEL_DESKTOP_NUM_C
  3213. End Sub
  3214. Private Sub p_SetLocIncludeCombo(i_strLocInclude As String)
  3215. Dim intIndex As Long
  3216. Dim blnExistingLocInclude As Boolean
  3217. p_InitializeLocIncludeCombo
  3218. For intIndex = LBound(LocIncludes) To UBound(LocIncludes)
  3219. If (i_strLocInclude = LocIncludes(intIndex)) Then
  3220. blnExistingLocInclude = True
  3221. End If
  3222. Next
  3223. If (Not blnExistingLocInclude) Then
  3224. cboLocInclude.AddItem i_strLocInclude, UBound(LocIncludes) + 1
  3225. End If
  3226. cboLocInclude.Text = i_strLocInclude
  3227. End Sub
  3228. Private Sub p_InitializeLocIncludeCombo()
  3229. Dim intIndex As Long
  3230. InitializeLocIncludes
  3231. cboLocInclude.Clear
  3232. For intIndex = LBound(LocIncludes) To UBound(LocIncludes)
  3233. cboLocInclude.AddItem LocIncludes(intIndex), intIndex
  3234. Next
  3235. End Sub
  3236. Private Sub p_SetTypeComboIndex(i_intIndex As Long)
  3237. cboType.ListIndex = i_intIndex
  3238. End Sub
  3239. Private Sub p_InitializeTypeCombo()
  3240. On Error GoTo LErrorHandler
  3241. Dim arrTypes() As Variant
  3242. Dim intIndex As Long
  3243. ' Initialize the Types Combo Box
  3244. arrTypes = p_clsTaxonomy.GetTypes
  3245. cboType.Clear
  3246. For intIndex = 0 To UBound(arrTypes)
  3247. cboType.AddItem arrTypes(intIndex)(1), intIndex
  3248. cboType.ItemData(cboType.NewIndex) = arrTypes(intIndex)(0)
  3249. Next
  3250. Exit Sub
  3251. LErrorHandler:
  3252. Select Case Err.Number
  3253. Case errDatabaseVersionIncompatible
  3254. DisplayDatabaseVersionError
  3255. Err.Raise Err.Number
  3256. Case Else
  3257. g_ErrorInfo.SetInfoAndRaiseError "p_InitializeTypeCombo"
  3258. End Select
  3259. End Sub
  3260. Private Function p_GetBrokenLinkDir( _
  3261. ByVal i_enumSKU As SKU_E _
  3262. ) As String
  3263. p_GetBrokenLinkDir = p_clsParameters.Value(BROKEN_LINK_WORKING_DIR_C & Hex(i_enumSKU)) & ""
  3264. If (p_GetBrokenLinkDir = "") Then
  3265. Err.Raise errNotConfiguredForNavigateLink
  3266. End If
  3267. End Function
  3268. Private Sub p_InitializeTaxonomyTree()
  3269. Dim nodeNew As Node
  3270. Set treTaxonomy.ImageList = ilsIcons
  3271. treTaxonomy.HideSelection = False
  3272. treTaxonomy.LabelEdit = tvwManual
  3273. ' The problem with FullRowSelect is that if you click on the far right side of
  3274. ' a row, it will be highlighted, but NodeClick will not be called.
  3275. ' treTaxonomy.FullRowSelect = True
  3276. End Sub
  3277. Private Sub p_ClearTreeView()
  3278. ' Remove the root. Does garbage collection caused the other nodes to be removed?
  3279. If (treTaxonomy.Nodes.Count > 0) Then
  3280. treTaxonomy.Nodes.Remove 1
  3281. End If
  3282. End Sub
  3283. Private Sub p_EnableTaxonomyAndSomeMenus()
  3284. mnuEdit.Enabled = True
  3285. mnuTools.Enabled = True
  3286. mnuFileExportHHT.Enabled = True
  3287. mnuFileImportHHT.Enabled = True
  3288. lblTaxonomy.Enabled = True
  3289. treTaxonomy.Enabled = True
  3290. End Sub
  3291. Private Sub p_DisableTaxonomyAndSomeMenus()
  3292. mnuEdit.Enabled = False
  3293. mnuTools.Enabled = False
  3294. mnuFileExportHHT.Enabled = False
  3295. mnuFileImportHHT.Enabled = False
  3296. lblTaxonomy.Enabled = False
  3297. treTaxonomy.Enabled = False
  3298. End Sub
  3299. Private Sub p_EnableCreate()
  3300. cmdCreateGroup.Enabled = True
  3301. cmdCreateLeaf.Enabled = True
  3302. mnuRightClickCreateNode.Enabled = True
  3303. mnuRightClickCreateTopic.Enabled = True
  3304. End Sub
  3305. Private Sub p_DisableCreate()
  3306. cmdCreateGroup.Enabled = False
  3307. cmdCreateLeaf.Enabled = False
  3308. mnuRightClickCreateNode.Enabled = False
  3309. mnuRightClickCreateTopic.Enabled = False
  3310. End Sub
  3311. Private Sub p_EnableDelete()
  3312. cmdDelete.Enabled = True
  3313. mnuRightClickDelete.Enabled = True
  3314. End Sub
  3315. Private Sub p_DisableDelete()
  3316. cmdDelete.Enabled = False
  3317. mnuRightClickDelete.Enabled = False
  3318. End Sub
  3319. Private Sub p_EnableRefresh()
  3320. cmdRefresh.Enabled = True
  3321. End Sub
  3322. Private Sub p_DisableRefresh()
  3323. cmdRefresh.Enabled = False
  3324. End Sub
  3325. Private Sub p_EnableNavModel()
  3326. lblNavModel.Enabled = True
  3327. cboNavModel.Enabled = True
  3328. End Sub
  3329. Private Sub p_DisableNavModel()
  3330. lblNavModel.Enabled = False
  3331. cboNavModel.Enabled = False
  3332. End Sub
  3333. Private Sub p_EnableSubSite()
  3334. chkSubSite.Enabled = True
  3335. End Sub
  3336. Private Sub p_DisableSubSite()
  3337. chkSubSite.Enabled = False
  3338. End Sub
  3339. Private Sub p_EnableEditEntry()
  3340. cmdEditEntry.Enabled = True
  3341. End Sub
  3342. Private Sub p_DisableEditEntry()
  3343. cmdEditEntry.Enabled = False
  3344. End Sub
  3345. Private Sub p_EnableEntry()
  3346. txtEntry.Locked = False
  3347. End Sub
  3348. Private Sub p_DisableEntry()
  3349. txtEntry.Locked = True
  3350. End Sub
  3351. Private Sub p_EnableNodeDetailsExceptIndividualSKUs()
  3352. chkVisible.Enabled = True
  3353. lblLocInclude.Enabled = True
  3354. cboLocInclude.Enabled = True
  3355. lblTitle.Enabled = True
  3356. lblDescription.Enabled = True
  3357. lblURI.Enabled = True
  3358. cmdURI.Enabled = True
  3359. lblIconURI.Enabled = True
  3360. lblType.Enabled = True
  3361. lblComments.Enabled = True
  3362. lblEntry.Enabled = True
  3363. txtTitle.Locked = False
  3364. txtDescription.Locked = False
  3365. txtURI.Locked = False
  3366. txtIconURI.Locked = False
  3367. cboType.Enabled = True
  3368. txtComments.Locked = False
  3369. fraSKU.Enabled = True
  3370. lblKeywords.Enabled = True
  3371. cboKeywords.Enabled = True
  3372. lblLastModified.Enabled = True
  3373. End Sub
  3374. Private Sub p_DisableNodeDetails()
  3375. chkVisible.Enabled = False
  3376. lblLocInclude.Enabled = False
  3377. cboLocInclude.Enabled = False
  3378. chkSubSite.Enabled = False
  3379. p_DisableNavModel
  3380. lblTitle.Enabled = False
  3381. lblDescription.Enabled = False
  3382. lblURI.Enabled = False
  3383. cmdURI.Enabled = False
  3384. lblIconURI.Enabled = False
  3385. lblType.Enabled = False
  3386. lblComments.Enabled = False
  3387. lblEntry.Enabled = False
  3388. p_DisableEditEntry
  3389. txtTitle.Locked = True
  3390. txtDescription.Locked = True
  3391. txtURI.Locked = True
  3392. txtIconURI.Locked = True
  3393. cboType.Enabled = False
  3394. txtComments.Locked = True
  3395. p_DisableEntry
  3396. chkVisible.Enabled = False
  3397. fraSKU.Enabled = False
  3398. p_DisableSKUs
  3399. lblKeywords.Enabled = False
  3400. cboKeywords.Enabled = False
  3401. lblLastModified.Enabled = False
  3402. p_DisableAddRemoveAndKeywordsCombo
  3403. p_DisableNavigateLink
  3404. End Sub
  3405. Private Sub p_EnableNavigateLink()
  3406. lblNavigateLink.Enabled = True
  3407. cboNavigateLink.Enabled = True
  3408. cmdNavigateLink.Enabled = True
  3409. End Sub
  3410. Private Sub p_DisableNavigateLink()
  3411. lblNavigateLink.Enabled = False
  3412. cboNavigateLink.Enabled = False
  3413. cmdNavigateLink.Enabled = False
  3414. End Sub
  3415. Private Sub p_EnableAddRemoveAndKeywordsCombo()
  3416. cmdAddRemove.Enabled = True
  3417. cboKeywords.Enabled = True
  3418. End Sub
  3419. Private Sub p_DisableAddRemoveAndKeywordsCombo()
  3420. cmdAddRemove.Enabled = False
  3421. cboKeywords.Enabled = False
  3422. End Sub
  3423. Private Sub p_ClearNodeDetails()
  3424. Dim blnSettingControls As Boolean
  3425. blnSettingControls = p_blnSettingControls
  3426. p_blnSettingControls = True
  3427. txtTitle = ""
  3428. txtDescription = ""
  3429. txtURI = ""
  3430. txtIconURI = ""
  3431. txtComments = ""
  3432. txtEntry = ""
  3433. lblLastModified = ""
  3434. p_SetTypeComboIndex -1
  3435. chkVisible.Value = 0
  3436. chkSubSite.Value = 0
  3437. p_SetNavModelCombo NAVMODEL_DEFAULT_NUM_C
  3438. p_ClearSKUs
  3439. cboKeywords.Clear
  3440. ' Reset it to the state it was in when this function was called.
  3441. p_blnSettingControls = blnSettingControls
  3442. End Sub
  3443. Private Sub p_EnableSKUs()
  3444. chkStandard.Enabled = True
  3445. chkProfessional.Enabled = True
  3446. chkProfessional64.Enabled = True
  3447. chkWindowsMillennium.Enabled = True
  3448. chkServer.Enabled = True
  3449. chkAdvancedServer.Enabled = True
  3450. chkDataCenterServer.Enabled = True
  3451. chkAdvancedServer64.Enabled = True
  3452. chkDataCenterServer64.Enabled = True
  3453. End Sub
  3454. Private Sub p_DisableSKUs()
  3455. chkStandard.Enabled = False
  3456. chkProfessional.Enabled = False
  3457. chkProfessional64.Enabled = False
  3458. chkWindowsMillennium.Enabled = False
  3459. chkServer.Enabled = False
  3460. chkAdvancedServer.Enabled = False
  3461. chkDataCenterServer.Enabled = False
  3462. chkAdvancedServer64.Enabled = False
  3463. chkDataCenterServer64.Enabled = False
  3464. End Sub
  3465. Private Sub p_ClearSKUs()
  3466. chkStandard.Value = 0
  3467. chkProfessional.Value = 0
  3468. chkProfessional64.Value = 0
  3469. chkWindowsMillennium.Value = 0
  3470. chkServer.Value = 0
  3471. chkAdvancedServer.Value = 0
  3472. chkDataCenterServer.Value = 0
  3473. chkAdvancedServer64.Value = 0
  3474. chkDataCenterServer64.Value = 0
  3475. End Sub
  3476. Private Sub p_StrikeoutUnselectedSKUs()
  3477. chkStandard.Font.Strikethrough = _
  3478. IIf((p_enumFilterSKUs And SKU_STANDARD_E), False, True)
  3479. chkProfessional.Font.Strikethrough = _
  3480. IIf((p_enumFilterSKUs And SKU_PROFESSIONAL_E), False, True)
  3481. chkProfessional64.Font.Strikethrough = _
  3482. IIf((p_enumFilterSKUs And SKU_PROFESSIONAL_64_E), False, True)
  3483. chkWindowsMillennium.Font.Strikethrough = _
  3484. IIf((p_enumFilterSKUs And SKU_WINDOWS_MILLENNIUM_E), False, True)
  3485. chkServer.Font.Strikethrough = _
  3486. IIf((p_enumFilterSKUs And SKU_SERVER_E), False, True)
  3487. chkAdvancedServer.Font.Strikethrough = _
  3488. IIf((p_enumFilterSKUs And SKU_ADVANCED_SERVER_E), False, True)
  3489. chkDataCenterServer.Font.Strikethrough = _
  3490. IIf((p_enumFilterSKUs And SKU_DATA_CENTER_SERVER_E), False, True)
  3491. chkAdvancedServer64.Font.Strikethrough = _
  3492. IIf((p_enumFilterSKUs And SKU_ADVANCED_SERVER_64_E), False, True)
  3493. chkDataCenterServer64.Font.Strikethrough = _
  3494. IIf((p_enumFilterSKUs And SKU_DATA_CENTER_SERVER_64_E), False, True)
  3495. End Sub
  3496. Private Sub p_DisableUnselectedSKUs()
  3497. If (chkStandard.Value = 0) Then
  3498. chkStandard.Enabled = False
  3499. End If
  3500. If (chkProfessional.Value = 0) Then
  3501. chkProfessional.Enabled = False
  3502. End If
  3503. If (chkProfessional64.Value = 0) Then
  3504. chkProfessional64.Enabled = False
  3505. End If
  3506. If (chkWindowsMillennium.Value = 0) Then
  3507. chkWindowsMillennium.Enabled = False
  3508. End If
  3509. If (chkServer.Value = 0) Then
  3510. chkServer.Enabled = False
  3511. End If
  3512. If (chkAdvancedServer.Value = 0) Then
  3513. chkAdvancedServer.Enabled = False
  3514. End If
  3515. If (chkDataCenterServer.Value = 0) Then
  3516. chkDataCenterServer.Enabled = False
  3517. End If
  3518. If (chkAdvancedServer64.Value = 0) Then
  3519. chkAdvancedServer64.Enabled = False
  3520. End If
  3521. If (chkDataCenterServer64.Value = 0) Then
  3522. chkDataCenterServer64.Enabled = False
  3523. End If
  3524. End Sub
  3525. Private Sub p_EnableSaveCancel()
  3526. cmdSave.Enabled = True
  3527. cmdCancel.Enabled = True
  3528. cmdCancel.Cancel = True
  3529. End Sub
  3530. Private Sub p_DisableSaveCancel()
  3531. cmdSave.Enabled = False
  3532. cmdCancel.Enabled = False
  3533. cmdCancel.Cancel = False
  3534. End Sub
  3535. Private Sub p_EnableEditCopy()
  3536. mnuEditCopy.Enabled = True
  3537. mnuRightClickCopy.Enabled = True
  3538. End Sub
  3539. Private Sub p_DisableEditCopy()
  3540. mnuEditCopy.Enabled = False
  3541. mnuRightClickCopy.Enabled = False
  3542. End Sub
  3543. Private Sub p_EnableEditCut()
  3544. mnuEditCut.Enabled = True
  3545. mnuRightClickCut.Enabled = True
  3546. End Sub
  3547. Private Sub p_DisableEditCut()
  3548. mnuEditCut.Enabled = False
  3549. mnuRightClickCut.Enabled = False
  3550. End Sub
  3551. Private Sub p_EnableEditPaste()
  3552. mnuEditPaste.Enabled = True
  3553. mnuRightClickPaste.Enabled = True
  3554. End Sub
  3555. Private Sub p_DisableEditPaste()
  3556. mnuEditPaste.Enabled = False
  3557. mnuRightClickPaste.Enabled = False
  3558. End Sub
  3559. Private Sub p_EnableEditPasteKeywords()
  3560. mnuEditPasteKeywords.Enabled = True
  3561. mnuRightClickPasteKeywords.Enabled = True
  3562. p_AddCheckboxesToTree
  3563. End Sub
  3564. Private Sub p_DisableEditPasteKeywords()
  3565. mnuEditPasteKeywords.Enabled = False
  3566. mnuRightClickPasteKeywords.Enabled = False
  3567. p_RemoveCheckboxesFromTree
  3568. End Sub
  3569. Private Sub p_DisableEverything()
  3570. p_DisableTaxonomyAndSomeMenus
  3571. p_DisableCreate
  3572. p_DisableDelete
  3573. p_DisableRefresh
  3574. p_DisableNodeDetails
  3575. p_DisableAddRemoveAndKeywordsCombo
  3576. p_DisableNavigateLink
  3577. p_DisableSaveCancel
  3578. End Sub
  3579. Private Sub p_AddCheckboxesToTree()
  3580. treTaxonomy.Checkboxes = True
  3581. End Sub
  3582. Private Sub p_RemoveCheckboxesFromTree()
  3583. treTaxonomy.Checkboxes = False
  3584. End Sub
  3585. Private Sub p_SetTitle( _
  3586. ByVal i_strDatabase As String _
  3587. )
  3588. frmMain.Caption = "Production Tool (" & i_strDatabase & ")"
  3589. End Sub
  3590. Private Sub p_SetSizingInfo()
  3591. Static blnInfoSet As Boolean
  3592. If (blnInfoSet) Then
  3593. Exit Sub
  3594. End If
  3595. p_clsSizer.AddControl treTaxonomy
  3596. Set p_clsSizer.ReferenceControl(DIM_HEIGHT_E) = frmMain
  3597. Set p_clsSizer.ReferenceControl(DIM_WIDTH_E) = frmMain
  3598. p_clsSizer.Operation(DIM_WIDTH_E) = OP_MULTIPLY_E
  3599. p_clsSizer.AddControl cmdCreateGroup
  3600. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = treTaxonomy
  3601. p_clsSizer.ReferenceDimension(DIM_TOP_E) = DIM_BOTTOM_E
  3602. p_clsSizer.AddControl cmdCreateLeaf
  3603. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = cmdCreateGroup
  3604. p_clsSizer.AddControl cmdDelete
  3605. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = cmdCreateGroup
  3606. p_clsSizer.AddControl cmdRefresh
  3607. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = cmdCreateGroup
  3608. p_clsSizer.AddControl lblLocInclude
  3609. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = frmMain
  3610. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_WIDTH_E
  3611. p_clsSizer.AddControl cboLocInclude
  3612. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = lblLocInclude
  3613. p_clsSizer.AddControl lblTitle
  3614. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = treTaxonomy
  3615. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_RIGHT_E
  3616. p_clsSizer.AddControl txtTitle
  3617. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = lblTitle
  3618. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = frmMain
  3619. p_clsSizer.ReferenceDimension(DIM_RIGHT_E) = DIM_WIDTH_E
  3620. p_clsSizer.AddControl chkVisible
  3621. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3622. p_clsSizer.AddControl chkSubSite
  3623. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3624. p_clsSizer.AddControl lblNavModel
  3625. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3626. p_clsSizer.AddControl cboNavModel
  3627. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3628. p_clsSizer.AddControl lblDescription
  3629. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3630. p_clsSizer.AddControl txtDescription
  3631. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3632. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3633. p_clsSizer.AddControl lblType
  3634. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3635. p_clsSizer.AddControl cboType
  3636. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3637. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3638. p_clsSizer.AddControl lblURI
  3639. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3640. p_clsSizer.AddControl txtURI
  3641. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3642. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3643. p_clsSizer.AddControl cmdURI
  3644. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3645. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_RIGHT_E
  3646. p_clsSizer.AddControl lblIconURI
  3647. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3648. p_clsSizer.AddControl txtIconURI
  3649. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3650. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3651. p_clsSizer.AddControl lblComments
  3652. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3653. p_clsSizer.AddControl txtComments
  3654. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3655. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3656. p_clsSizer.AddControl lblEntry
  3657. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3658. p_clsSizer.AddControl txtEntry
  3659. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3660. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3661. p_clsSizer.AddControl cmdEditEntry
  3662. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3663. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_RIGHT_E
  3664. p_clsSizer.AddControl lblNavigateLink
  3665. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3666. p_clsSizer.AddControl cboNavigateLink
  3667. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3668. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = frmMain
  3669. p_clsSizer.ReferenceDimension(DIM_RIGHT_E) = DIM_WIDTH_E
  3670. p_clsSizer.AddControl cmdNavigateLink
  3671. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3672. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_RIGHT_E
  3673. p_clsSizer.AddControl fraSKU
  3674. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3675. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3676. p_clsSizer.AddControl chkServer
  3677. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = fraSKU
  3678. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_WIDTH_E
  3679. p_clsSizer.Operation(DIM_LEFT_E) = OP_MULTIPLY_E
  3680. p_clsSizer.AddControl chkAdvancedServer
  3681. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = chkServer
  3682. p_clsSizer.AddControl chkDataCenterServer
  3683. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = chkServer
  3684. p_clsSizer.AddControl chkAdvancedServer64
  3685. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = chkServer
  3686. p_clsSizer.AddControl chkDataCenterServer64
  3687. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = chkServer
  3688. p_clsSizer.AddControl lblKeywords
  3689. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3690. p_clsSizer.AddControl cmdAddRemove
  3691. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3692. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_RIGHT_E
  3693. p_clsSizer.AddControl cboKeywords
  3694. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = txtTitle
  3695. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = txtTitle
  3696. Set p_clsSizer.ReferenceControl(DIM_HEIGHT_E) = frmMain
  3697. p_clsSizer.AddControl cmdSave
  3698. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = cmdCreateGroup
  3699. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = frmMain
  3700. p_clsSizer.ReferenceDimension(DIM_LEFT_E) = DIM_WIDTH_E
  3701. p_clsSizer.AddControl cmdCancel
  3702. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = cmdCreateGroup
  3703. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = cmdSave
  3704. p_clsSizer.AddControl lblLastModified
  3705. Set p_clsSizer.ReferenceControl(DIM_TOP_E) = cmdCreateGroup
  3706. Set p_clsSizer.ReferenceControl(DIM_LEFT_E) = cmdCreateGroup
  3707. Set p_clsSizer.ReferenceControl(DIM_RIGHT_E) = cmdSave
  3708. blnInfoSet = True
  3709. End Sub
  3710. Private Sub p_SetToolTips()
  3711. chkVisible.ToolTipText = "Controls whether the user can navigate to the Node/Topic using the Taxonomy."
  3712. chkSubSite.ToolTipText = "Indicates whether this node is a subsite, or appears on the flyout menu."
  3713. lblNavModel.ToolTipText = "Determines which navigation model will be used for the node."
  3714. cboNavModel.ToolTipText = lblNavModel.ToolTipText
  3715. lblLocInclude.ToolTipText = "Indicates localization preferences for the topic."
  3716. cboLocInclude.ToolTipText = lblLocInclude.ToolTipText
  3717. lblTitle.ToolTipText = "The title as it will appear in the taxonomy tree."
  3718. txtTitle.ToolTipText = lblTitle.ToolTipText
  3719. lblDescription.ToolTipText = "A description of the node or topic."
  3720. txtDescription.ToolTipText = lblDescription.ToolTipText
  3721. lblType.ToolTipText = "The category of the title, to be used for search categories."
  3722. cboType.ToolTipText = lblType.ToolTipText
  3723. lblURI.ToolTipText = "Uniform Resource Indicator. This is the address of the file."
  3724. txtURI.ToolTipText = lblURI.ToolTipText
  3725. lblIconURI.ToolTipText = "The path to the icon that is displayed in the Desktop navigation model."
  3726. txtIconURI.ToolTipText = lblIconURI.ToolTipText
  3727. lblComments.ToolTipText = "Additional comment about the node or topic."
  3728. txtComments.ToolTipText = lblComments.ToolTipText
  3729. lblEntry.ToolTipText = "Used by other files to link to this topic. It is not recommended that this field be changed after it has been set."
  3730. txtEntry.ToolTipText = lblEntry.ToolTipText
  3731. lblNavigateLink.ToolTipText = "Select a valid SKU to view the content of the selected topic."
  3732. cboNavigateLink.ToolTipText = lblNavigateLink.ToolTipText
  3733. fraSKU.ToolTipText = "Select which platforms this node or topic applies to. " & _
  3734. "Child nodes or topics will inherit only the boxes checked for the parent " & _
  3735. "node or topic."
  3736. cboKeywords.ToolTipText = "These are the keywords associated with selected node."
  3737. End Sub