Public Class JSDecoder
Private Const STATE_COPY_INPUT = 100
Private Const STATE_READLEN = 101
Private Const STATE_DECODE = 102
Private Const STATE_UNESCAPE = 103
Private Pick_Encoding, rawData As Integer()
Private Transformed(2, 287), Digits(122) As Integer
Public Sub New()
InitArrayData()
End Sub
Private Sub InitArrayData()
Dim i, j As Integer
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 _
}
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 _
}
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
End Sub
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) 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
Public Function Decode(ByRef encodingString As String) As String
Dim marker 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 = STATE_COPY_INPUT
Dim unEncodingString As String = ""
While state <> 0
Select Case state
Case STATE_COPY_INPUT
scriptIndex = encodingString.IndexOf(marker, stringIndex)
If scriptIndex <> -1 Then
unEncodingString &= Mid(encodingString, stringIndex + 1, scriptIndex - stringIndex)
scriptIndex += marker.Length
state = STATE_READLEN
Else
stringIndex = IIf(stringIndex = 0, 0, stringIndex)
unEncodingString &= Mid(encodingString, stringIndex + 1)
state = 0
End If
Case STATE_READLEN
getCodeString = Mid(encodingString, scriptIndex + 1, 6)
unEncodinglength = DecodeBase64(getCodeString)
scriptIndex += 8
state = STATE_DECODE
Case STATE_DECODE
If unEncodinglength = 0 Then
stringIndex = scriptIndex + "DQgAAA==^#~@".Length
unEncodingIndex = 0
state = STATE_COPY_INPUT
Else
strChar = Mid(encodingString, scriptIndex + 1, 1)
If strChar = "@" Then
state = STATE_UNESCAPE
unEncodingString &= UnEscape(Mid(encodingString, scriptIndex + 2, 1))
scriptIndex += 2
unEncodinglength -= 2
unEncodingIndex += 1
state = STATE_DECODE
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 STATE_UNESCAPE
unEncodingString &= UnEscape(Mid(encodingString, ++scriptIndex, 1))
scriptIndex += 1
unEncodinglength -= 2
unEncodingIndex += 1
state = STATE_DECODE
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
End Class