2015-11-01 201 views
0

我需要解码以下文本(仅部分),它由中文繁体字符组成。我尝试了一些解码代码,但它不起作用。解码后,结果是?VB6如何使用HTML代码解码中文字符

部分编码的文字:

%3Ctable%20width%3D%22100%25%22%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cp%20style%3D%22color%3A%23000000%3Bfont-size%3A20pt%3Btext-align%3Acenter%3Bfont-weight%3Abold%22%3E%0D%0A%09Genie%E7%93%B6%E4%B8%AD%E7%B2%BE%E9%9D%88%2010%25%E6%9D%8F%E4%BB%81%E9%85%B8%E4%BA%AE%E9%87%87%E7%85%A5%E8%86%9A%E7%B2%BE%E8%8F%AF%E6%B6%B2%20%E8%B2%B7%E4%B8%80%E9%80%81%E4%B8%80%0D%0A%3C%2Fp%3E%0D%0A%3C%2Ftd%3E%3C%2Ftr%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cp%20style%3D%22color%3A%23000000%3Bfont-size%3A12pt%3Btext-align%3Acenter%22%3E%0D%0A%09%20%0D%0A%3C%2Fp%3E%0D%0A%3C%2Ftd%3E%3C%2Ftr%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cdiv%20align%3D%22center%22%3E%3Cimg%20src%3D%22https%3A%2F%2Fs.yimg.com%2Fwb%2Fimages%2F3C8EF489980779600D2E2A95C5BB2E0C15859F8B%22%20%2F%3E%3C%2Fdiv%3E%3C%2Ftd%3E%3C%2Ftr%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3C%2Ftable%3E%3Ctable%20width%3D%22100%25%22%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cp%20style%3D%22color%3A%23000000%3Bfont-size%3A12pt%3Btext-align%3Aleft%3Bfont-weight%3A100%22%3E%0D%0A%09%0D%0A%3C%2Fp%3E%0D%0A%3C%2Ftd

解码之后:你可以看到中国汉字被解码为????

<div align=center><TABLE width="100 
<TBODY> 
<TR> 
<TD> 
<P style="FONT-SIZE: 20pt; FONT-WEIGHT: bold; COLOR: #000000; TEXT-ALIGN: center"> 
Genie???? 10???????? ???? </P> 
</TD> 

请帮助如何将它正确解码。

Private Const CP_UTF8 As Long = 65001 ' UTF-8 Code Page 

'Sys call to convert multiple byte chars to a char 
Private Declare Function MultiByteToWideChar Lib "kernel32" (_ 
    ByVal CodePage As Long, _ 
    ByVal dwFlags As Long, _ 
    ByVal lpMultiByteStr As Long, _ 
    ByVal cchMultiByte As Long, _ 
    ByVal lpWideCharStr As Long, _ 
    ByVal cchWideChar As Long) As Long 

Private Function URL8Decode(ByVal URLEncoded As String) As String 
On Error GoTo executeError 
    Dim ANSI() As Byte 
    Dim UTF8() As Byte 
    Dim I As Long 
    Dim B As Long 

    URLEncoded = Replace$(URLEncoded, "+", " ") 'Optional, plus-encoding isn't always used. 
    ANSI = StrConv(URLEncoded, vbFromUnicode) 
    ReDim UTF8(UBound(ANSI)) 'Estimate. 
    For I = 0 To UBound(ANSI) 
     If ANSI(I) = &H25 Then 
      UTF8(B) = FromHex(ANSI(I + 1)) * &H10 + FromHex(ANSI(I + 2)) 'Val("&H" & Mid$(URLEncoded, I + 2, 2)) 
      I = I + 2 
     Else 
      UTF8(B) = ANSI(I) 
     End If 
     B = B + 1 
    Next 
    URL8Decode = FromUTF8(UTF8, B) 
    Exit Function 
executeError: 
    LogProcess "ProductDetailFrm URL8Decode - [Err=" & Err.description & "]" 
    Resume 'HANG 

End Function 

Private Function FromHex(ByVal Char As Byte) As Byte 
On Error GoTo executeError 
    If Char <= &H39 Then 
     FromHex = Char - &H30 
    Else 
     FromHex = Char - &H41 + &HA 
    End If 
    Exit Function 
executeError: 
    LogProcess "ProductDetailFrm FromHex - [Err=" & Err.description & "]" 
End Function 
+0

你累了什么?这是VB还是VBA? – Gareth

+0

嗨Gareth,我已经分享了上面的代码。 – Sushi

+1

虽然代码可能会稍微改进,但它可能工作得很好。我敢打赌,你试图在ANSI控件中显示结果,因此你的'''问题。 – Bob77

回答

0

看看这段代码对你有帮助。我正在使用JavaScript功能进行解码。

Option Explicit 

Sub Test() 

    Const sEncoded As String = "%3Ctable%20width%3D%22100%25%22%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cp%20style%3D%22color%3A%23000000%3Bfont-size%3A20pt%3Btext-align%3Acenter%3Bfont-" & _ 
           "weight%3Abold%22%3E%0D%0A%09Genie%E7%93%B6%E4%B8%AD%E7%B2%BE%E9%9D%88%2010%25%E6%9D%8F%E4%BB%81%E9%85%B8%E4%BA%AE%E9%87%87%E7%85%A5%E8%86%9A%E7%B2%BE%E8%8F%AF%E6%B6%B2%20%E8%B2%B7%E4%B8%80%E9%80%81%E4%B8%80%0D%0A%3C%2Fp%3E%0D%0A%3C%2Ftd" & _ 
           "%3E%3C%2Ftr%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cp%20style%3D%22color%3A%23000000%3Bfont-size%3A12pt%3Btext-align%3Acenter%22%3E%0D%0A%09%20%0D%0A%3C%2" & _ 
           "Fp%3E%0D%0A%3C%2Ftd%3E%3C%2Ftr%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cdiv%20align%3D%22center%22%3E%3Cimg%20src%3D%22https%3A%2F%2Fs.yimg.com%2Fwb%2Fimages%" & _ 
           "2F3C8EF489980779600D2E2A95C5BB2E0C15859F8B%22%20%2F%3E%3C%2Fdiv%3E%3C%2Ftd%3E%3C%2Ftr%3E%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3C%2Ftable%3E%3Ctable%20width%3D%22100%25%22%3E%0D%0A%20%20%20%" & _ 
           "20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%3Ctr%3E%3Ctd%3E%3Cp%20style%3D%22color%3A%23000000%3Bfont-size%3A12pt%3Btext-align%3Aleft%3Bfont-weight%3A100%22%3E%0D%0A%09%0D%0A%3C%2Fp%3E%0D%0A%3C%2Ftd" 


    ' I am writing the values to Range("A1") 
    Cells(1, 1).Value = DecodeHTML(sEncoded) 

End Sub 

'Decodes the string using a javasript object. 
Function DecodeHTML(ByVal strCharacters As String) As String 

    Dim oScrip As Object 
    Dim ret As String 

    Set oScrip = CreateObject("MSScriptControl.ScriptControl") 

    With oScrip 
     .Language = "JScript" 
     .AddCode "function decode(x) {return decodeURIComponent(x);}" 
     ret = .Run("decode", strCharacters) 
    End With 

    'Return the value 
    DecodeHTML = ret 

End Function 

只需运行Test()过程。

谢谢,我希望这有助于:)

+0

在Windows 8上,使用['UrlUnescape'](https://msdn.microsoft.com/en-us/library/windows/desktop/bb773791%28v=vs.85%29.aspx)与'URL_UNESCAPE_AS_UTF8'标志设置,但在较早的Windows上,这种脚本编写方式可能是明智的,因为没有该标志的UrlUnescape没有返回部分无效的数据。 – GSerg

+0

嗨弗雷德洛,谢谢!我会试试....在我的VB 6上...并会让你知道它是否工作。 – Sushi

+0

嗨Fredlo,它打错误的“要解码的URI不是一个有效的编码” – Sushi