它可将加密过的迅雷下载地址URL转换成真正的下载地址。
Private Sub Form_Load() '解密 MsgBox thunderToURL("thunder://QUFodHRwOi8vd3d3Lm5ld3hpbmcuY29tWlo=") End Sub
'***************************************************
Private Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private arrBase64() As String
Public Function Base64Decode(strEncoded As String) As String
On Error Resume Next
Dim arrB() As Byte, bTmp(3) As Byte, bT, bRet() As Byte
Dim I As Long, J As Long
arrB = StrConv(strEncoded, vbFromUnicode)
J = InStr(strEncoded & "=", "=") - 2
ReDim bRet(J - J \ 4 - 1)
For I = 0 To J Step 4
Erase bTmp
bTmp(0) = (InStr(cstBase64, Chr$(arrB(I))) - 1) And 63
bTmp(1) = (InStr(cstBase64, Chr$(arrB(I + 1))) - 1) And 63
bTmp(2) = (InStr(cstBase64, Chr$(arrB(I + 2))) - 1) And 63
bTmp(3) = (InStr(cstBase64, Chr$(arrB(I + 3))) - 1) And 63
bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)
bRet((I \ 4) * 3) = bT \ 65536
bRet((I \ 4) * 3 + 1) = (bT And 65280) \ 256
bRet((I \ 4) * 3 + 2) = bT And 255
Next
Base64Decode = StrConv(bRet, vbUnicode)
End Function
Public Function thunderToURL(thunder As String)
thunderToURL = ""
Dim S As String
If Len(thunder) > 7 And LCase$(Left$(thunder, 7)) = "thunder" Then
S = Base64Decode(CStr(Mid$(thunder, InStr(thunder, "://") + 3, Len(thunder) - InStr(thunder, "://") + 1)))
thunderToURL = Mid$(S, 3, Len(S) - 4)
End If
End Function