Option Explicit
Public Function DecodeHtmlEntity(ByVal htmlEntity As String) As String
Dim decodedString As String
Dim entityStart As Integer
Dim entityEnd As Integer
decodedString = ""
entityStart = 1
Do While entityStart <= Len(htmlEntity)
entityStart = InStr(entityStart, htmlEntity, "&#x")
If entityStart > 0 Then
entityEnd = InStr(entityStart, htmlEntity, ";")
If entityEnd > entityStart + 3 Then
Dim hexCode As String
hexCode = Mid(htmlEntity, entityStart + 3, entityEnd - entityStart - 3)
If IsHex(hexCode) Then
decodedString = decodedString & ChrW("&H" & hexCode)
Else
' 不是有效的十六进制代码，保留原实体编码
decodedString = decodedString & Mid(htmlEntity, entityStart, entityEnd - entityStart + 1)
End If
End If
entityStart = entityEnd + 1
Else
' 没有找到更多实体编码
decodedString = decodedString & Mid(htmlEntity, entityStart)
Exit Do
End If
Loop
DecodeHtmlEntity = decodedString
End Function
Private Function IsHex(ByVal value As String) As Boolean
On Error Resume Next
Dim temp As Long
temp = "&H" & value
IsHex = (Err.Number = 0)
On Error GoTo 0
End Function
Private Sub Command1_Click()
Dim decodedString As String
decodedString = DecodeHtmlEntity(Text1.Text)
Text2.Text = decodedString ' 将显示 "active"
End Sub