版主:没谁帮我解决,我已经通过其它途径解决了。能否要回这点血汗钱?
代码如下:
    Private Function UnEscape(ByVal strChar As String) As String
        Dim escapes As String
        Dim escaped As String
        Dim iIndex As Integer
        escapes = "#&!*$"
        escaped = Chr(13) & Chr(10) & "<>@"
        If AscW(strChar.Substring(0, 1)) > 126 Then Return strChar
        iIndex = escapes.IndexOf(strChar)
        If iIndex <> -1 Then Return escaped.Substring(iIndex, 1)
        Return "?"
    End Function    Private Function DecodeBase64(ByVal strString As String, ByVal Digits() As Integer) As Integer
        Dim iVal As Integer = 0
        iVal += (Digits(AscW(strString.Substring(0, 1))) << 2)
        iVal += (Digits(AscW(strString.Substring(1, 1))) >> 4)
        iVal += (Digits(AscW(strString.Substring(1, 1))) And &HF) << 12
        iVal += ((Digits(AscW(strString.Substring(2, 1))) >> 2) << 8)
        iVal += ((Digits(AscW(strString.Substring(2, 1))) And &H3) << 22)
        iVal += (Digits(AscW(strString.Substring(3, 1))) << 16)
        Return iVal
    End Function    Private Function Decode(ByRef encodingString As String) As String
        Dim Digits(122) As Integer
        Dim Pick_Encoding = New Integer() { _
            1, 2, 0, 1, 2, 0, 2, 0, 0, 2, 0, 2, 1, 0, 2, 0, _
            1, 0, 2, 0, 1, 1, 2, 0, 0, 2, 1, 0, 2, 0, 0, 2, _
            1, 1, 0, 2, 0, 2, 0, 1, 0, 1, 1, 2, 0, 1, 0, 2, _
            1, 0, 2, 0, 1, 1, 2, 0, 0, 1, 1, 2, 0, 1, 0, 2 _
            }
        Dim rawData = New Integer() { _
            &H64, &H37, &H69, &H50, &H7E, &H2C, &H22, &H5A, &H65, &H4A, &H45, &H72, _
            &H61, &H3A, &H5B, &H5E, &H79, &H66, &H5D, &H59, &H75, &H5B, &H27, &H4C, _
            &H42, &H76, &H45, &H60, &H63, &H76, &H23, &H62, &H2A, &H65, &H4D, &H43, _
            &H5F, &H51, &H33, &H7E, &H53, &H42, &H4F, &H52, &H20, &H52, &H20, &H63, _
            &H7A, &H26, &H4A, &H21, &H54, &H5A, &H46, &H71, &H38, &H20, &H2B, &H79, _
            &H26, &H66, &H32, &H63, &H2A, &H57, &H2A, &H58, &H6C, &H76, &H7F, &H2B, _
            &H47, &H7B, &H46, &H25, &H30, &H52, &H2C, &H31, &H4F, &H29, &H6C, &H3D, _
            &H69, &H49, &H70, &H3F, &H3F, &H3F, &H27, &H78, &H7B, &H3F, &H3F, &H3F, _
            &H67, &H5F, &H51, &H3F, &H3F, &H3F, &H62, &H29, &H7A, &H41, &H24, &H7E, _
            &H5A, &H2F, &H3B, &H66, &H39, &H47, &H32, &H33, &H41, &H73, &H6F, &H77, _
            &H4D, &H21, &H56, &H43, &H75, &H5F, &H71, &H28, &H26, &H39, &H42, &H78, _
            &H7C, &H46, &H6E, &H53, &H4A, &H64, &H48, &H5C, &H74, &H31, &H48, &H67, _
            &H72, &H36, &H7D, &H6E, &H4B, &H68, &H70, &H7D, &H35, &H49, &H5D, &H22, _
            &H3F, &H6A, &H55, &H4B, &H50, &H3A, &H6A, &H69, &H60, &H2E, &H23, &H6A, _
            &H7F, &H9, &H71, &H28, &H70, &H6F, &H35, &H65, &H49, &H7D, &H74, &H5C, _
            &H24, &H2C, &H5D, &H2D, &H77, &H27, &H54, &H44, &H59, &H37, &H3F, &H25, _
            &H7B, &H6D, &H7C, &H3D, &H7C, &H23, &H6C, &H43, &H6D, &H34, &H38, &H28, _
            &H6D, &H5E, &H31, &H4E, &H5B, &H39, &H2B, &H6E, &H7F, &H30, &H57, &H36, _
            &H6F, &H4C, &H54, &H74, &H34, &H34, &H6B, &H72, &H62, &H4C, &H25, &H4E, _
            &H33, &H56, &H30, &H56, &H73, &H5E, &H3A, &H68, &H73, &H78, &H55, &H9, _
            &H57, &H47, &H4B, &H77, &H32, &H61, &H3B, &H35, &H24, &H44, &H2E, &H4D, _
            &H2F, &H64, &H6B, &H59, &H4F, &H44, &H45, &H3B, &H21, &H5C, &H2D, &H37, _
            &H68, &H41, &H53, &H36, &H61, &H58, &H58, &H7A, &H48, &H79, &H22, &H2E, _
            &H9, &H60, &H50, &H75, &H6B, &H2D, &H38, &H4E, &H29, &H55, &H3D, &H3F _
            }
        Dim Transformed(2, 287)        Dim er As String = "#@~^"
        Dim stringIndex As Integer = 0
        Dim scriptIndex As Integer = -1
        Dim unEncodingIndex As Integer = 0
        Dim strChar As String = ""
        Dim getCodeString As String = ""
        Dim unEncodinglength As Integer = 0        Dim state As Integer = 100
        Dim unEncodingString As String = ""
        Dim i, j As Integer        For i = 31 To 126
            For j = 0 To 2
                Transformed(j, rawData((i - 31) * 3 + j)) = IIf(i = 31, 9, i)
            Next
        Next        For i = 0 To 25
            Digits(65 + i) = i
            Digits(97 + i) = i + 26
        Next
        For i = 0 To 9
            Digits(48 + i) = i + 52
        Next
        Digits(43) = 62
        Digits(47) = 63        While state <> 0
            Select Case state
                Case 100
                    scriptIndex = encodingString.IndexOf(er, stringIndex)
                    If scriptIndex <> -1 Then
                        unEncodingString &= Mid(encodingString, stringIndex + 1, scriptIndex - stringIndex)
                        scriptIndex += er.Length
                        state = 101
                    Else
                        stringIndex = IIf(stringIndex = 0, 0, stringIndex)
                        unEncodingString &= Mid(encodingString, stringIndex + 1)
                        state = 0
                    End If
                Case 101
                    getCodeString = Mid(encodingString, scriptIndex + 1, 6)
                    unEncodinglength = DecodeBase64(getCodeString, Digits)
                    scriptIndex += 8
                    state = 102
                Case 102
                    If unEncodinglength = 0 Then
                        stringIndex = scriptIndex + "DQgAAA==^#~@".Length
                        unEncodingIndex = 0
                        state = 100
                    Else
                        strChar = Mid(encodingString, scriptIndex + 1, 1)
                        If strChar = "@" Then
                            state = 103
                            unEncodingString &= UnEscape(Mid(encodingString, scriptIndex + 2, 1))
                            scriptIndex += 2
                            unEncodinglength -= 2
                            unEncodingIndex += 1
                            state = 102
                        Else
                            If AscW(strChar) < &HFF Then
                                unEncodingString &= Chr(Transformed(Pick_Encoding(unEncodingIndex Mod 64), AscW(strChar)))
                                unEncodingIndex += 1
                            Else
                                unEncodingString &= strChar
                            End If
                            scriptIndex += 1
                            unEncodinglength -= 1
                        End If
                    End If
                Case 103
                    unEncodingString &= UnEscape(Mid(encodingString, ++scriptIndex, 1))
                    scriptIndex += 1
                    unEncodinglength -= 2
                    unEncodingIndex += 1
                    state = 102
            End Select
        End While
        Dim Pattern As String
        Pattern = "(JScript|VBscript).encode"
        unEncodingString = System.Text.RegularExpressions.Regex.Replace(unEncodingString, Pattern, "$1", System.Text.RegularExpressions.RegexOptions.IgnoreCase)
        Return unEncodingString
    End Function