留着其他版本用``
'过滤HTML字符替换为文字
Public Function ReplaceToText(ByVal Html As String)
On Error GoTo ErrLabel '打开错误陷阱
'------------------------------------------------
Dim i As Integer
Dim CurPosBefore As Long
Dim CurPosEnd As Long
Dim ReplaceTextTMP As String
Dim ReplaceText As String '替换为该字符
Html = Replace$(Html, "<br />", vbCrLf)
Do
ReplaceText = ""
CurPosBefore = InStr(1, Html, "<")
If CurPosBefore <> 0 Then
'found < text
CurPosEnd = InStr(CurPosBefore, Html, ">")
If CurPosEnd <> 0 Then
'found > text
ReplaceTextTMP = Mid$(Html, CurPosBefore, CurPosEnd - CurPosBefore + 1)
If Len(ReplaceTextTMP) > 3 Then
If Left$(ReplaceTextTMP, 4) = "<img" Then
ReplaceText = "[图象]"
End If
End If
Html = Replace$(Html, ReplaceTextTMP, ReplaceText)
End If
End If
If InStr(1, Html, "<") = 0 Or InStr(1, Html, ">") = 0 Then Exit Do
Loop While True
Html = Replace$(Html, " ", " ")
ReplaceToText = Html
'------------------------------------------------
Exit Function
'----------------
ErrLabel:
'跳出错误对话框,并保存错误信息
Call SaveErrLog("modGeneric", "ReplaceToText")
Resume Next
End Function
a
|