mirror of https://github.com/tongzx/nt5src
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.
67 lines
2.1 KiB
67 lines
2.1 KiB
Attribute VB_Name = "HtmFileInfo"
|
|
Option Explicit
|
|
|
|
Private Const TITLE_START_C As String = "<TITLE>"
|
|
Private Const TITLE_END_C As String = "</TITLE>"
|
|
Private Const TITLE_LENGTH_C As Long = 7
|
|
|
|
Private Const LOCCONTENT_START_C As String = "<META NAME=""DESCRIPTION"" LOCCONTENT="""
|
|
Private Const LOCCONTENT_END_C As String = """>"
|
|
Private Const LOCCONTENT_LENGTH_C As Long = 37
|
|
|
|
Public Function GetHtmTitle( _
|
|
ByVal i_strFileName As String _
|
|
) As String
|
|
|
|
Dim FSO As Scripting.FileSystemObject
|
|
Dim TS As Scripting.TextStream
|
|
Dim strContents As String
|
|
Dim strTitle As String
|
|
Dim intTitleStart As Long
|
|
Dim intTitleEnd As Long
|
|
|
|
Set FSO = New Scripting.FileSystemObject
|
|
Set TS = FSO.OpenTextFile(i_strFileName, ForReading)
|
|
strContents = TS.ReadAll
|
|
|
|
intTitleStart = InStr(1, strContents, TITLE_START_C, vbTextCompare)
|
|
intTitleStart = intTitleStart + TITLE_LENGTH_C ' Skip the Title tag
|
|
intTitleEnd = InStr(1, strContents, TITLE_END_C, vbTextCompare)
|
|
|
|
If (intTitleEnd - intTitleStart > 0) Then
|
|
strTitle = Mid$(strContents, intTitleStart, intTitleEnd - intTitleStart)
|
|
GetHtmTitle = RemoveExtraSpaces(RemoveCRLF(strTitle))
|
|
End If
|
|
|
|
End Function
|
|
|
|
Public Function GetHtmDescription( _
|
|
ByVal i_strFileName As String _
|
|
) As String
|
|
|
|
Dim FSO As Scripting.FileSystemObject
|
|
Dim TS As Scripting.TextStream
|
|
Dim strDesc As String
|
|
Dim strContents As String
|
|
Dim intDescStart As Long
|
|
Dim intDescEnd As Long
|
|
|
|
Set FSO = New Scripting.FileSystemObject
|
|
Set TS = FSO.OpenTextFile(i_strFileName, ForReading)
|
|
strContents = TS.ReadAll
|
|
|
|
intDescStart = InStr(1, strContents, LOCCONTENT_START_C, vbTextCompare)
|
|
|
|
If (intDescStart = 0) Then
|
|
Exit Function
|
|
End If
|
|
|
|
intDescStart = intDescStart + LOCCONTENT_LENGTH_C ' Skip the tag
|
|
intDescEnd = InStr(intDescStart, strContents, LOCCONTENT_END_C, vbTextCompare)
|
|
|
|
If (intDescEnd - intDescStart > 0) Then
|
|
strDesc = Mid$(strContents, intDescStart, intDescEnd - intDescStart)
|
|
GetHtmDescription = RemoveExtraSpaces(RemoveCRLF(strDesc))
|
|
End If
|
|
|
|
End Function
|