htmlprocess.bas

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

  Dim lTmp As Long
  
  strTmp = strSource
  strTag = FindStartTagUnit(strTmp, 1, "center")
  lTmp = InStr(1, strTmp, strTag, vbTextCompare)
  
  Do While lTmp > 0
    strTitle = PeekInfoBetweenTwins(strTmp, lTmp, "center")
    strTitle = DelAllCrLf(strTitle)
    
    If Len(Trim(DelAllTags(strTitle, ""))) < 2 Then
      lTmp = lTmp + 3
      strTag = FindStartTagUnit(strTmp, lTmp, "center")
      If strTag = "" Then Exit Do
      lTmp = InStr(lTmp, strTmp, strTag, vbTextCompare)
    Else
      Exit Do
    End If
    
    DoEvents
  Loop
  
  If InStr(1, LCase(strTitle), "<b>") > 0 Then
    strTitle = PeekInfoBetweenTwins(strTitle, 1, "b")
  End If
  
  If InStr(1, LCase(strTitle), "<h") > 0 Then
    strTag = FindNextTagUnit(strTitle, 1, "<", ">")
    strTmp = GetTagMark(strTag)
    strTitle = PeekInfoBetweenTwins(strTitle, 1, strTmp)
  End If
  
  strTitle = Trim(DelAllTags(strTitle, ""))
  GetCenterTitle = InsertSpecialChar(strTitle, GetstrAllIllegalFileChars, "-")
End Function

Public Function GetPageTitle(ByVal strSource As String) As String
  GetPageTitle = PeekInfoBetweenTwins(strSource, 1, "title")
End Function

Public Function GetTextBody(ByVal strSource As String) As String
  Dim strTmp As String
  Dim strBody As String
  Dim strTag As String
  Dim strInfo As String
  Dim lTmp As Long
  
  strTmp = strSource
  strBody = GetCenterTitle(strTmp)
  If strBody <> "" Then strBody = strBody + vbCrLf
  
  strTag = FindStartTagUnit(strTmp, 1, "p")
  lTmp = InStr(1, strTmp, strTag)
  
  Do While strTag <> ""
    strInfo = PeekInfoBetweenTwins(strTmp, lTmp, "p")
    If strInfo <> "" Then
      strBody = strBody + strInfo + vbCrLf
    End If
    
    strTag = FindStartTagUnit(strTmp, lTmp + 1, "p")
    lTmp = InStr(lTmp + 1, strTmp, strTag)
  Loop
  
  GetTextBody = strBody
End Function

Public Function GetParagraph(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim strTag As String
  Dim strInfo As String
  Dim lStart As Long
  
  strTmp = strSource
  If lLocation < 1 Then
    lStart = 1
  Else
    lStart = lLocation
  End If
  
  strTag = FindStartTagUnit(strTmp, lStart, "p")
  If strTag = "" Then
    GetParagraph = ""
  Else
    GetParagraph = Trim(PeekInfoBetweenTwins(strTmp, lStart, "p"))
  End If
End Function

Public Function GetNoOfParagraghs(ByVal strSource As String) As Integer
  Dim strTmp As String
  Dim strTag As String
  Dim I As Integer
  Dim nLocOfTag As Integer
  
  strTmp = strSource
  strTag = FindStartTagUnit(strTmp, 1, "p")
  
  Do While strTag <> ""
    I = I + 1
    nLocOfTag = InStr(1, strTmp, strTag, vbTextCompare)
    strTmp = Mid(strTmp, nLocOfTag + Len(strTag))
    strTag = FindStartTagUnit(strTmp, 1, "p")
    DoEvents
  Loop
  
  GetNoOfParagraghs = I
End Function

Public Function GetLocOfParagragh(ByVal strSource As String, nNo As Integer) As Long
  Dim lStart As Long
  Dim nStartTags As Integer
  Dim strTag As String
  Dim strTmp As String
  
  strTmp = strSource
  lStart = 1
  
  strTag = FindStartTagUnit(strTmp, lStart, "p")
  Do While strTag <> ""
    nStartTags = nStartTags + 1
    
    If nStartTags = nNo Then
      GetLocOfParagragh = InStr(lStart, LCase(strTmp), LCase(strTag))
      Exit Function
    End If
    
    lStart = InStr(lStart, LCase(strTmp), LCase(strTag)) + 3
    strTag = FindStartTagUnit(strTmp, lStart, "p")
    DoEvents
  Loop
  
  GetLocOfParagragh = 0
End Function

Public Function GetNoParagragh(ByVal strSource As String, nNo As Integer) As String
  Dim strTmp As String
  Dim lTmp As Long
  
  strTmp = strSource
  lTmp = GetLocOfParagragh(strTmp, nNo)
  
  If lTmp > 0 Then
    GetNoParagragh = GetParagraph(strTmp, lTmp)
  Else
    GetNoParagragh = ""
  End If
End Function

Public Function PeekSerialChars(ByVal strSource As String, lLocation As Long, sCharSet As String) As String
  Dim lStart As Long
  Dim strChar As String
  Dim strTmp As String
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  
  Do While lStart <= Len(strSource)
    strChar = Mid(strSource, lStart, 1)
    If InStr(1, sCharSet, strChar) > 0 Then
      lStart = InStr(lStart, strSource, strChar)
      Exit Do
    End If
    lStart = lStart + 1
  Loop
  
  If lStart > Len(strSource) Then
    PeekSerialChars = ""
    Exit Function
  End If
  
  Do While InStr(1, sCharSet, strChar) > 0
    PeekSerialChars = PeekSerialChars + strChar
    lStart = lStart + 1
    strChar = Mid(strSource, lStart, 1)
    If strChar = "" Then Exit Do
  Loop
End Function

Public Function GetTextYear(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim lStart As Long
  Dim lTmp As Long
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  
  lTmp = InStr(lStart, strSource, "年")
  strTmp = Mid(strSource, lTmp - 4, 5)
  GetTextYear = PeekSerialChars(strTmp, 1, cStrNumSet)
End Function

Public Function GetTextMonth(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim lStart As Long
  Dim lTmp As Long
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  
  lTmp = InStr(lStart, strSource, "月")
  strTmp = Mid(strSource, lTmp - 2, 3)
  GetTextMonth = PeekSerialChars(strTmp, 1, cStrNumSet)
End Function

Public Function GetTextDay(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim lStart As Long
  Dim lTmp As Long
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  
  lTmp = InStr(lStart, strSource, "日")
  strTmp = Mid(strSource, lTmp - 2, 3)
  GetTextDay = PeekSerialChars(strTmp, 1, cStrNumSet)
End Function

Public Function GetTextYMD(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim lStart As Long
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  strTmp = GetTextYear(strSource, lStart)
  If strTmp = "" Then
    GetTextYMD = ""
  Else
    GetTextYMD = strTmp + "年"
    lStart = InStr(lStart, strSource, GetTextYMD)
    strTmp = Mid(strSource, lStart, 15)
    If GetTextMonth(strTmp, 1) <> "" Then
      GetTextYMD = GetTextYMD + GetTextMonth(strTmp, 1) + "月"
      If GetTextDay(strTmp, 1) <> "" Then
        GetTextYMD = GetTextYMD + GetTextDay(strTmp, 1) + "日"
      Else
        GetTextYMD = ""
      End If
    Else
      GetTextYMD = ""
    End If
  End If
End Function

Public Function GetTextMD(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim lStart As Long
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  strTmp = GetTextMonth(strSource, lStart)
  If strTmp = "" Then
    GetTextMD = ""
  Else
    GetTextMD = strTmp + "月"
    lStart = InStr(lStart, strSource, GetTextMD)
    strTmp = Mid(strSource, lStart, 7)
    If GetTextDay(strTmp, 1) <> "" Then
      GetTextMD = GetTextMD + GetTextDay(strTmp, 1) + "日"
    Else
      GetTextMD = ""
    End If
  End If
End Function

Public Function GetTextTime(ByVal strSource As String, lLocation As Long) As String
  Dim strTmp As String
  Dim lStart As Long
  
  If lLocation < 1 Then lLocation = 1
  lStart = lLocation
  
  Do While lStart <= Len(strSource)
    lStart = InStr(lStart, strSource, ":")
    If InStr(1, cStrNumSet, Mid(strSource, lStart - 1, 1)) > 0 And _
       InStr(1, cStrNumSet, Mid(strSource, lStart + 1, 1)) > 0 Then
      Exit Do
    Else
      lStart = lStart + 1
    End If
  Loop
  
  If lStart > Len(strSource) Then
    GetTextTime = ""
    Exit Function
  End If
  
  lStart = InStr(lStart, strSource, ":")
  strTmp = Mid(strSource, lStart - 3, 6)
  GetTextTime = PeekSerialChars(strTmp, 1, cStrNumSet)
  If GetTextTime <> "" Then
    lStart = InStr(1, strTmp, ":")
    GetTextTime = GetTextTime + ":" + PeekSerialChars(strTmp, lStart, cStrNumSet)
  Else
    GetTextTime = ""
  End If
End Function

Public Function GetCnNum(strSource As String) As Integer
  Select Case strSource
    Case "○", "0"
      GetCnNum = 0
    Case "一"
      GetCnNum = 1
    Case "二"
      GetCnNum = 2
    Case "三"
      GetCnNum = 3
    Case "四"
      GetCnNum = 4
    Case "五"
      GetCnNum = 5
    Case "六"
      GetCnNum = 6
    Case "七"
      GetCnNum = 7
    Case "八"
      GetCnNum = 8
    Case "九"
      GetCnNum = 9
    Case "十"
      GetCnNum = 10
    Case "百"
      GetCnNum = 100
    Case "千"
      GetCnNum = 1000
  End Select
End Function

Public Function GetCnNumSet1(ByVal strSource As String, lLocation As Long) As Integer
  'only to 9999
  Dim strResult As String
  Dim strTmp As String
  Dim I As Integer
  Dim nTmp As Integer
  Dim nResult As Integer
  Dim strUnit(2) As String
  
  strUnit(0) = "十"
  strUnit(1) = "百"
  strUnit(2) = "千"
  strResult = PeekSerialChars(strSource, lLocation, cCnNumSet1)
  If strResult = "" Then Exit Function
  
  For I = 2 To 0 Step -1
    strTmp = GetLeftString(strResult, strUnit(I))
    If Len(strTmp) > 1 Then strTmp = Mid(strTmp, 2)
    If strTmp <> "" Then
      nTmp = GetCnNum(strTmp)
      nResult = nResult + nTmp * (10 ^ (I + 1))
      strResult = NextString(strResult, strUnit(I))
    End If
  Next I
  
  nResult = nResult + GetCnNum(strResult)
  GetCnNumSet1 = nResult
End Function

Public Function GetHREF(ByVal strSource As String) As String
  Dim strTmp As String
  
  strTmp = Trim(NextString(LCase(strSource), "href="))
  If InStr(1, strTmp, Chr(&H22)) = 0 Then
    GetHREF = GetNoString(strTmp, ">", 0)
  Else
    GetHREF = GetNoString(strTmp, Chr(&H22), 1)
  End If
End Function

Public Function GetCurrentSentence(ByVal strSource As String, nLocation As Integer) As String
  Dim nTmp As Integer
  Dim nBegin As Integer
  Dim nEnd As Integer
  Dim strChar As String
  
  nBegin = 1
  nEnd = Len(strSource)
  If nEnd = 0 Then Exit Function
  
  nTmp = nLocation
  Do While nTmp > 1
    nTmp = nTmp - 1
    If nTmp <= 1 Then
      Exit Do
    End If
    
    strChar = Mid(strSource, nTmp, 1)
    If InStr(1, cCnMarkSeg + vbCrLf, strChar) <> 0 Then
      nBegin = nTmp + 1
      Exit Do
    End If
  Loop
  
  nTmp = nLocation
  Do While nTmp < Len(strSource)
    nTmp = nTmp + 1
    If nTmp >= Len(strSource) Then
      Exit Do
    End If
    
    strChar = Mid(strSource, nTmp, 1)
    If InStr(1, cCnMarkSeg + vbCrLf, strChar) <> 0 Then
      nEnd = nTmp - 1
      Exit Do
    End If
  Loop
  
  GetCurrentSentence = Mid(strSource, nBegin, nEnd - nBegin + 1)
End Function