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.
184 lines
4.7 KiB
184 lines
4.7 KiB
Attribute VB_Name = "HHTs"
|
|
Option Explicit
|
|
|
|
Private Const HHT_TAXONOMY_C As String = "METADATA/TAXONOMY_ENTRIES/TAXONOMY_ENTRY"
|
|
Private Const HHT_STOPSIGN_C As String = "METADATA/STOPSIGN_ENTRIES/STOPSIGN"
|
|
Private Const HHT_STOPWORD_C As String = "METADATA/STOPWORD_ENTRIES/STOPWORD"
|
|
Private Const HHT_SYNSET_C As String = "METADATA/SYNTABLE/SYNSET"
|
|
Private Const HHT_OPERATOR_C As String = "METADATA/OPERATOR_ENTRIES/OPERATOR"
|
|
Private Const HHT_FTS_C As String = "METADATA/FTS"
|
|
Private Const HHT_SCOPE_DEFINITION_C As String = "METADATA/SCOPE_DEFINITION"
|
|
Private Const HHT_INDEX_C As String = "METADATA/INDEX"
|
|
Private Const HHT_HELPIMAGE_C As String = "METADATA/HELPIMAGE"
|
|
Private Const HHT_EXTENSION_C As String = ".HHT"
|
|
|
|
Public Sub ImportHHTs2MDB( _
|
|
ByVal i_strFolder As String, _
|
|
ByVal i_strDatabase As String, _
|
|
ByVal i_intSKU As Long, _
|
|
ByVal i_blnIgnoreTaxonomy As Boolean _
|
|
)
|
|
On Error GoTo LError
|
|
|
|
OpenDatabaseAndSetSKU i_strDatabase, i_intSKU
|
|
p_ProcessFolder i_strFolder, i_blnIgnoreTaxonomy
|
|
FinalizeDatabase
|
|
|
|
LEnd:
|
|
|
|
Exit Sub
|
|
|
|
LError:
|
|
|
|
frmMain.Output Err.Description, LOGGING_TYPE_ERROR_E
|
|
Err.Raise Err.Number
|
|
|
|
End Sub
|
|
|
|
Private Sub p_ProcessFolder( _
|
|
ByVal i_strFolder As String, _
|
|
ByVal i_blnIgnoreTaxonomy As Boolean _
|
|
)
|
|
On Error GoTo LError
|
|
|
|
Dim FSO As Scripting.FileSystemObject
|
|
Dim Folder As Scripting.Folder
|
|
Dim File As Scripting.File
|
|
Dim DOMNodeHHT As MSXML2.DOMDocument
|
|
|
|
Set FSO = New Scripting.FileSystemObject
|
|
Set Folder = FSO.GetFolder(i_strFolder)
|
|
|
|
For Each File In Folder.Files
|
|
If (InStr(1, File.Name, HHT_EXTENSION_C, vbTextCompare) <> 0) Then
|
|
Set DOMNodeHHT = p_LoadHht(File.Path)
|
|
frmMain.Output "Importing file " & File.Name, LOGGING_TYPE_NORMAL_E
|
|
p_ImportHHT DOMNodeHHT, i_blnIgnoreTaxonomy
|
|
End If
|
|
Next
|
|
|
|
LEnd:
|
|
|
|
Exit Sub
|
|
|
|
LError:
|
|
|
|
Err.Raise E_FAIL, , Err.Description
|
|
|
|
End Sub
|
|
|
|
Private Function p_LoadHht( _
|
|
ByVal i_strHhtFile As String _
|
|
) As MSXML2.IXMLDOMNode
|
|
|
|
On Error GoTo LError
|
|
|
|
Dim DOMDocHHT As MSXML2.DOMDocument
|
|
|
|
Set DOMDocHHT = New MSXML2.DOMDocument
|
|
DOMDocHHT.async = False
|
|
DOMDocHHT.Load i_strHhtFile
|
|
|
|
If (DOMDocHHT.parseError <> 0) Then
|
|
p_DisplayParseError DOMDocHHT.parseError
|
|
GoTo LError
|
|
End If
|
|
|
|
Set p_LoadHht = DOMDocHHT
|
|
|
|
LEnd:
|
|
|
|
Exit Function
|
|
|
|
LError:
|
|
|
|
Err.Raise E_FAIL, , "Unable to read HHT file " & i_strHhtFile & ": " & Err.Description
|
|
|
|
End Function
|
|
|
|
Private Sub p_ImportHHT( _
|
|
ByVal i_DOMNodeHHT As MSXML2.IXMLDOMNode, _
|
|
ByVal i_blnIgnoreTaxonomy As Boolean _
|
|
)
|
|
On Error GoTo LError
|
|
|
|
Dim DOMNodeList As MSXML2.IXMLDOMNodeList
|
|
Dim DOMNode As MSXML2.IXMLDOMNode
|
|
Dim strXML As String
|
|
Dim arrNode() As String
|
|
Dim intIndex As Long
|
|
|
|
If (Not i_blnIgnoreTaxonomy) Then
|
|
Set DOMNodeList = i_DOMNodeHHT.selectNodes(HHT_TAXONOMY_C)
|
|
|
|
For Each DOMNode In DOMNodeList
|
|
DoEvents
|
|
ImportTaxonomyEntry DOMNode
|
|
Next
|
|
End If
|
|
|
|
Set DOMNodeList = i_DOMNodeHHT.selectNodes(HHT_OPERATOR_C)
|
|
ImportOperators DOMNodeList
|
|
|
|
Set DOMNodeList = i_DOMNodeHHT.selectNodes(HHT_STOPSIGN_C)
|
|
|
|
For Each DOMNode In DOMNodeList
|
|
DoEvents
|
|
ImportStopSign DOMNode
|
|
Next
|
|
|
|
Set DOMNodeList = i_DOMNodeHHT.selectNodes(HHT_STOPWORD_C)
|
|
|
|
For Each DOMNode In DOMNodeList
|
|
DoEvents
|
|
ImportStopWord DOMNode
|
|
Next
|
|
|
|
Set DOMNodeList = i_DOMNodeHHT.selectNodes(HHT_SYNSET_C)
|
|
|
|
For Each DOMNode In DOMNodeList
|
|
DoEvents
|
|
ImportSynset DOMNode
|
|
Next
|
|
|
|
ReDim arrNode(3)
|
|
arrNode(0) = HHT_FTS_C
|
|
arrNode(1) = HHT_SCOPE_DEFINITION_C
|
|
arrNode(2) = HHT_INDEX_C
|
|
arrNode(3) = HHT_HELPIMAGE_C
|
|
|
|
For intIndex = LBound(arrNode) To UBound(arrNode)
|
|
Set DOMNode = i_DOMNodeHHT.selectSingleNode(arrNode(intIndex))
|
|
If (Not DOMNode Is Nothing) Then
|
|
strXML = strXML & vbCrLf & DOMNode.XML
|
|
End If
|
|
Next
|
|
|
|
SetDomFragment strXML
|
|
|
|
LEnd:
|
|
|
|
Exit Sub
|
|
|
|
LError:
|
|
|
|
Err.Raise E_FAIL, , "ImportHHT failed: " & Err.Description
|
|
|
|
End Sub
|
|
|
|
Private Sub p_DisplayParseError( _
|
|
ByRef i_ParseError As MSXML2.IXMLDOMParseError _
|
|
)
|
|
|
|
Dim strError As String
|
|
|
|
With i_ParseError
|
|
strError = "Error: " & .reason & _
|
|
"Line: " & .Line & vbCrLf & _
|
|
"Linepos: " & .linepos & vbCrLf & _
|
|
"srcText: " & .srcText
|
|
End With
|
|
|
|
frmMain.Output strError, LOGGING_TYPE_ERROR_E
|
|
|
|
End Sub
|