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.
323 lines
8.2 KiB
323 lines
8.2 KiB
VERSION 5.00
|
|
Begin VB.Form frmMain
|
|
BorderStyle = 1 'Fixed Single
|
|
Caption = "CabStatistics"
|
|
ClientHeight = 3855
|
|
ClientLeft = 45
|
|
ClientTop = 330
|
|
ClientWidth = 4710
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 3855
|
|
ScaleWidth = 4710
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.TextBox txtOutput
|
|
Height = 2775
|
|
Left = 120
|
|
Locked = -1 'True
|
|
MultiLine = -1 'True
|
|
ScrollBars = 2 'Vertical
|
|
TabIndex = 4
|
|
Top = 480
|
|
Width = 4455
|
|
End
|
|
Begin VB.CommandButton cmdClose
|
|
Caption = "Close"
|
|
Height = 375
|
|
Left = 3720
|
|
TabIndex = 3
|
|
Top = 3360
|
|
Width = 855
|
|
End
|
|
Begin VB.TextBox txtCAB
|
|
Height = 285
|
|
Left = 600
|
|
TabIndex = 1
|
|
Top = 120
|
|
Width = 3975
|
|
End
|
|
Begin VB.CommandButton cmdGo
|
|
Caption = "Go"
|
|
Height = 375
|
|
Left = 2760
|
|
TabIndex = 2
|
|
Top = 3360
|
|
Width = 855
|
|
End
|
|
Begin VB.Label lblCAB
|
|
Caption = "CAB:"
|
|
Height = 255
|
|
Index = 0
|
|
Left = 120
|
|
TabIndex = 0
|
|
Top = 120
|
|
Width = 375
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmMain"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Private Const PKG_DESC_FILE_C As String = "package_description.xml"
|
|
Private Const PKG_DESC_HHT_C As String = "HELPCENTERPACKAGE/METADATA/HHT"
|
|
Private Const HHT_KEYWORD_C As String = "METADATA/TAXONOMY_ENTRIES/TAXONOMY_ENTRY/KEYWORD"
|
|
Private Const HHT_NODE_C As String = "METADATA/TAXONOMY_ENTRIES//TAXONOMY_ENTRY[string-length(@ENTRY) > 0]"
|
|
Private Const HHT_TOPIC_C As String = "METADATA/TAXONOMY_ENTRIES//TAXONOMY_ENTRY[string-length(@ENTRY) = 0]"
|
|
|
|
Private FSO As Scripting.FileSystemObject
|
|
Private WS As IWshShell
|
|
|
|
Private Sub Form_Load()
|
|
|
|
Dim strCAB As String
|
|
|
|
Set FSO = New Scripting.FileSystemObject
|
|
Set WS = CreateObject("Wscript.Shell")
|
|
|
|
cmdGo.Default = True
|
|
cmdClose.Cancel = True
|
|
|
|
strCAB = Trim$(Command$)
|
|
txtCAB = strCAB
|
|
|
|
If (Len(strCAB) <> 0) Then
|
|
Me.Show False
|
|
cmdGo_Click
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub cmdGo_Click()
|
|
|
|
On Error GoTo LError
|
|
|
|
Dim strCAB As String
|
|
Dim strFolder As String
|
|
|
|
strCAB = Trim$(txtCAB.Text)
|
|
|
|
If (strCAB = "") Then
|
|
MsgBox "Please specify the CAB", vbOKOnly
|
|
Exit Sub
|
|
End If
|
|
|
|
Me.Enabled = False
|
|
|
|
strFolder = p_Cab2Folder(strCAB)
|
|
FixPerSe strCAB, strFolder
|
|
FSO.DeleteFolder strFolder, True
|
|
|
|
LEnd:
|
|
|
|
Me.Enabled = True
|
|
Exit Sub
|
|
|
|
LError:
|
|
|
|
GoTo LEnd
|
|
|
|
End Sub
|
|
|
|
Private Sub cmdClose_Click()
|
|
|
|
Set FSO = Nothing
|
|
Set WS = Nothing
|
|
Unload Me
|
|
|
|
End Sub
|
|
|
|
Private Sub FixPerSe( _
|
|
ByVal i_strCAB As String, _
|
|
ByVal i_strFolder As String _
|
|
)
|
|
On Error GoTo LError
|
|
|
|
Dim File As Scripting.File
|
|
Dim DOMDocPkgDesc As MSXML2.DOMDocument
|
|
Dim DOMNodeListHHT As MSXML2.IXMLDOMNodeList
|
|
Dim DOMNodeHHTRef As MSXML2.IXMLDOMNode
|
|
Dim DOMNodeHHT As MSXML2.DOMDocument
|
|
Dim DOMNodeList As MSXML2.IXMLDOMNodeList
|
|
Dim strHhtFile As String
|
|
|
|
Dim intTotalKeywordMatches As Long
|
|
Dim intTotalNodes As Long
|
|
Dim intTotalTopics As Long
|
|
|
|
Dim intKeywordMatches As Long
|
|
Dim intNodes As Long
|
|
Dim intTopics As Long
|
|
|
|
Set File = FSO.GetFile(i_strCAB)
|
|
p_Output "CAB file size: " & File.Size
|
|
p_Output ""
|
|
|
|
Set DOMDocPkgDesc = p_GetPackage(i_strFolder)
|
|
|
|
If (DOMDocPkgDesc Is Nothing) Then
|
|
GoTo LEnd
|
|
End If
|
|
|
|
Set DOMNodeListHHT = DOMDocPkgDesc.selectNodes(PKG_DESC_HHT_C)
|
|
|
|
For Each DOMNodeHHTRef In DOMNodeListHHT
|
|
Set DOMNodeHHT = p_GetHht(DOMNodeHHTRef, i_strFolder, strHhtFile)
|
|
DOMNodeHHT.setProperty "SelectionLanguage", "XPath"
|
|
p_Output "File: " & strHhtFile
|
|
|
|
If (Not DOMNodeHHT Is Nothing) Then
|
|
|
|
Set DOMNodeList = DOMNodeHHT.selectNodes(HHT_KEYWORD_C)
|
|
intKeywordMatches = DOMNodeList.length
|
|
p_Output " Keyword matches: " & intKeywordMatches
|
|
intTotalKeywordMatches = intTotalKeywordMatches + intKeywordMatches
|
|
|
|
Set DOMNodeList = DOMNodeHHT.selectNodes(HHT_NODE_C)
|
|
intNodes = DOMNodeList.length
|
|
p_Output " Nodes: " & intNodes
|
|
intTotalNodes = intTotalNodes + intNodes
|
|
|
|
Set DOMNodeList = DOMNodeHHT.selectNodes(HHT_TOPIC_C)
|
|
intTopics = DOMNodeList.length
|
|
p_Output " Topics: " & intTopics
|
|
intTotalTopics = intTotalTopics + intTopics
|
|
|
|
End If
|
|
Next
|
|
|
|
p_Output ""
|
|
p_Output "Total Keyword matches: " & intTotalKeywordMatches
|
|
p_Output "Total Nodes: " & intTotalNodes
|
|
p_Output "Total Topics: " & intTotalTopics
|
|
|
|
LEnd:
|
|
|
|
Exit Sub
|
|
|
|
LError:
|
|
|
|
MsgBox _
|
|
"Error 0x" & Hex(Err.Number) & vbCrLf & _
|
|
Err.Description
|
|
|
|
End Sub
|
|
|
|
Private Sub p_Output( _
|
|
ByVal i_str As String _
|
|
)
|
|
|
|
If (txtOutput <> "") Then
|
|
txtOutput = txtOutput & vbCrLf & i_str
|
|
Else
|
|
txtOutput = i_str
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Function p_GetPackage( _
|
|
ByVal i_strFolder As String _
|
|
) As MSXML2.DOMDocument
|
|
|
|
Dim DOMDocPkg As MSXML2.DOMDocument
|
|
Dim strPkgFile As String
|
|
|
|
Set DOMDocPkg = New MSXML2.DOMDocument
|
|
strPkgFile = i_strFolder & "\" & PKG_DESC_FILE_C
|
|
|
|
DOMDocPkg.async = False
|
|
DOMDocPkg.Load strPkgFile
|
|
|
|
If (DOMDocPkg.parseError <> 0) Then
|
|
p_DisplayParseError DOMDocPkg.parseError
|
|
GoTo LEnd
|
|
End If
|
|
|
|
Set p_GetPackage = DOMDocPkg
|
|
|
|
LEnd:
|
|
|
|
End Function
|
|
|
|
Private Function p_GetHht( _
|
|
ByVal i_DOMNodeHHT As MSXML2.IXMLDOMNode, _
|
|
ByVal i_strFolder As String, _
|
|
ByRef o_strHhtFile As String _
|
|
) As MSXML2.IXMLDOMNode
|
|
|
|
Dim DOMDocHHT As MSXML2.DOMDocument
|
|
|
|
If (i_DOMNodeHHT Is Nothing) Then GoTo LEnd
|
|
|
|
o_strHhtFile = i_DOMNodeHHT.Attributes.getNamedItem("FILE").Text
|
|
|
|
Set DOMDocHHT = New MSXML2.DOMDocument
|
|
DOMDocHHT.async = False
|
|
DOMDocHHT.Load i_strFolder + "\" + o_strHhtFile
|
|
|
|
If (DOMDocHHT.parseError <> 0) Then
|
|
p_DisplayParseError DOMDocHHT.parseError
|
|
GoTo LEnd
|
|
End If
|
|
|
|
Set p_GetHht = DOMDocHHT
|
|
|
|
LEnd:
|
|
|
|
End Function
|
|
|
|
Private Function p_Cab2Folder( _
|
|
ByVal i_strCabFile As String _
|
|
) As String
|
|
|
|
Dim strFolder As String
|
|
Dim strCmd As String
|
|
|
|
p_Cab2Folder = ""
|
|
|
|
' We grab a Temporary Filename and create a folder out of it
|
|
strFolder = FSO.GetSpecialFolder(TemporaryFolder) + "\" + FSO.GetTempName
|
|
FSO.CreateFolder strFolder
|
|
|
|
' We uncab CAB contents into the Source CAB Contents dir.
|
|
strCmd = "cabarc X " + i_strCabFile + " " + strFolder + "\"
|
|
WS.Run strCmd, True, True
|
|
|
|
p_Cab2Folder = strFolder
|
|
|
|
End Function
|
|
|
|
Private Sub p_Folder2Cab( _
|
|
ByVal i_strFolder As String, _
|
|
ByVal i_strCabFile As String _
|
|
)
|
|
Dim strCmd As String
|
|
|
|
If (FSO.FileExists(i_strCabFile)) Then
|
|
FSO.DeleteFile i_strCabFile, True
|
|
End If
|
|
|
|
strCmd = "cabarc -r -s 6144 n """ & i_strCabFile & """ " & i_strFolder & "\*"
|
|
WS.Run strCmd, True, True
|
|
|
|
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
|
|
|
|
MsgBox strError, vbOKOnly, "Error while parsing"
|
|
|
|
End Sub
|