Board logo

标题: [问题求助] VBS如何解码base64字符串 [打印本页]

作者: Demon    时间: 2011-6-4 13:17     标题: VBS如何解码base64字符串

UTF-8编码的“批处理之家”经过base64编码以后是“5om55aSE55CG5LmL5a62”,怎样从“5om55aSE55CG5LmL5a62”还原成“批处理之家”?
作者: Spring    时间: 2011-6-4 14:05

网上早有人写好了,搜索一下就能得到:
  1. WScript.Echo  utf8to16(Base64Decode("5om55aSE55CG5LmL5a62"))
  2. Function utf8to16(str)
  3.     Dim out, i, len1, c, t
  4.     Dim char2, char3
  5.     out = ""
  6.     len1 = Len(str)
  7.     i = 0
  8.     While (i < len1)
  9.         c = Asc(Mid(str, i + 1, 1))
  10.         i = i + 1
  11.         t = c \ 16
  12.         If t >= 0 And t <= 7 Then
  13.             out = out + Mid(str, i, 1)
  14.         ElseIf t = 12 Or t = 13 Then
  15.             char2 = Asc(Mid(str, i + 1, 1))
  16.             i = i + 1
  17.             out = out + Chr(((c And 31) * 64) Or (char2 And 31))
  18.         ElseIf t = 14 Then
  19.             char2 = Asc(Mid(str, i + 1, 1))
  20.             i = i + 1
  21.             char3 = Asc(Mid(str, i + 1, 1))
  22.             i = i + 1
  23.             out = out + ChrW(((c And 15) * 4096) Or ((char2 And 63) * 64) Or ((char3 And 63)))
  24.         End If
  25.     Wend
  26.     utf8to16 = out
  27. End Function
  28. ' Decodes a base-64 encoded string (BSTR type).
  29. ' 1999 - 2004 Antonin Foller, http://www.motobit.com
  30. ' 1.01 - solves problem with Access And 'Compare Database' (InStr)
  31. Function Base64Decode(ByVal base64String)
  32.   'rfc1521
  33.   '1999 Antonin Foller, Motobit Software, http://Motobit.cz
  34.   Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  35.   Dim dataLength, sOut, groupBegin
  36.   
  37.   'remove white spaces, If any
  38.   base64String = Replace(base64String, vbCrLf, "")
  39.   base64String = Replace(base64String, vbTab, "")
  40.   base64String = Replace(base64String, " ", "")
  41.   
  42.   'The source must consists from groups with Len of 4 chars
  43.   dataLength = Len(base64String)
  44.   If dataLength Mod 4 <> 0 Then
  45.     Err.Raise 1, "Base64Decode", "Bad Base64 string."
  46.     Exit Function
  47.   End If
  48.   
  49.   ' Now decode each group:
  50.   For groupBegin = 1 To dataLength Step 4
  51.     Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
  52.     ' Each data group encodes up To 3 actual bytes.
  53.     numDataBytes = 3
  54.     nGroup = 0
  55.     For CharCounter = 0 To 3
  56.       ' Convert each character into 6 bits of data, And add it To
  57.       ' an integer For temporary storage.  If a character is a '=', there
  58.       ' is one fewer data byte.  (There can only be a maximum of 2 '=' In
  59.       ' the whole string.)
  60.       thisChar = Mid(base64String, groupBegin + CharCounter, 1)
  61.       If thisChar = "=" Then
  62.         numDataBytes = numDataBytes - 1
  63.         thisData = 0
  64.       Else
  65.         thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
  66.       End If
  67.       If thisData = -1 Then
  68.         Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
  69.         Exit Function
  70.       End If
  71.       nGroup = 64 * nGroup + thisData
  72.     Next
  73.    
  74.     'Hex splits the long To 6 groups with 4 bits
  75.     nGroup = Hex(nGroup)
  76.    
  77.     'Add leading zeros
  78.     nGroup = String(6 - Len(nGroup), "0") & nGroup
  79.    
  80.     'Convert the 3 byte hex integer (6 chars) To 3 characters
  81.     pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
  82.       Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
  83.       Chr(CByte("&H" & Mid(nGroup, 5, 2)))
  84.    
  85.     'add numDataBytes characters To out string
  86.     sOut = sOut & Left(pOut, numDataBytes)
  87.   Next
  88.   Base64Decode = sOut
  89. End Function
复制代码

作者: Demon    时间: 2011-6-4 14:07

网上早有人写好了,搜索一下就能得到:
WScript.Echo  utf8to16(Base64Decode("5om55aSE55CG5LmL5a62"))

Function utf8to16(str)
    Dim out, i, len1, c, t
    Dim char2, char3
    out = ""
    len1 = ...
Spring 发表于 2011-6-4 14:05

复制粘贴之前起码验证一下吧,上面代码输出“???????????????”
作者: mglouis    时间: 2011-6-4 21:34

拿来主义啊................
作者: zqz0012005    时间: 2011-6-27 21:51

WScript.Echo binaryToText(base64ToBin("5om55aSE55CG5LmL5a62"), "utf-8")
作者: Demon    时间: 2011-6-27 23:50

WScript.Echo binaryToText(base64ToBin("5om55aSE55CG5LmL5a62"), "utf-8")
zqz0012005 发表于 2011-6-27 21:51
  1. WScript.Echo "批处理之家"
复制代码

作者: batman    时间: 2011-6-28 00:23

6# Demon
五楼不是演示解密的。。。
作者: dahual    时间: 2011-6-28 15:37

主要还是编码的问题。
通过解决这个问题,让我觉得字节是最完美的。
  1. '参考链接:
  2. 'http://maclife.net/tools/base64/
  3. 'http://blog.csdn.net/zym_123456/archive/2008/03/30/2230695.aspx
  4. Option Explicit
  5. MsgBox Base64ToText_Utf8Encode("5om55aSE55CG5LmL5a62")
  6. 'Base64ToText_utf8Encode
  7. Function Base64ToText_Utf8Encode(s)
  8. Dim i
  9. Dim bArr,bRet
  10. ReDim bArr(Len(s)-1)
  11. For i=1 To Len(s)
  12. bArr(i-1)=Asc(Mid(s,i,1))
  13. Next
  14. bRet=Base64_Decode(bArr)
  15. Base64ToText_utf8Encode=Utf8ToUnicode(bRet)
  16. End Function
  17. 'Utf8ToUnicode
  18. Function Utf8ToUnicode(src)
  19. Dim IsAsc
  20. Dim utfLen
  21. utfLen = -1
  22. On Error Resume Next
  23. utfLen = UBound(src)-LBound(src)+1
  24. If utfLen = -1 Then Exit Function
  25. On Error GoTo 0
  26. Dim i,j,k,N
  27. Dim B,cnt
  28. ReDim Buf(utfLen)
  29. i = 1
  30. j = 0
  31. Do While i <= utfLen
  32. B = src(i-1)
  33. If (B And &HFC) = &HFC Then
  34. cnt = 6
  35. ElseIf (B And &HF8) = &HF8 Then
  36. cnt = 5
  37. ElseIf (B And &HF0) = &HF0 Then
  38. cnt = 4
  39. ElseIf (B And &HE0) = &HE0 Then
  40. cnt = 3
  41. ElseIf (B And &HC0) = &HC0 Then
  42. cnt = 2
  43. Else
  44. cnt = 1
  45. End If
  46. If i + cnt - 1 > utfLen Then
  47. Buf(j) = "?"
  48. Exit Do
  49. End If
  50. Select Case cnt
  51. Case 2
  52. N = B And &H1F
  53. Case 3
  54. N = B And &HF
  55. Case 4
  56. N = B And &H7
  57. Case 5
  58. N = B And &H3
  59. Case 6
  60. N = B And &H1
  61. Case Else
  62. Buf(j) = Chr(B)
  63. IsAsc=True
  64. End Select
  65. If IsAsc=False Then
  66. For k = 1 To cnt - 1
  67. B = src(i+k-1)
  68. N = N * &H40 + (B And &H3F)
  69. Next
  70. Buf(j) = ChrW(N)
  71. End If
  72. i = i + cnt
  73. j = j + 1
  74. IsAsc=False
  75. Loop
  76. Utf8ToUnicode = Join(Buf, "")
  77. End Function
  78. 'Base64解码函数
  79. Public Function Base64_Decode(bytInText)
  80.     Dim Base64DecodeTable(122)
  81.     Dim lngInTextLen, i
  82.     Dim bytDecode, lngDecodeLen
  83.    
  84.     Base64_Decode = Chr(0)  '初始化函数返回值
  85.    
  86.     If LBound(bytInText) <> 0 Then Exit Function  'bytInText数组下标不从零开始则出错返回
  87.    
  88.     lngInTextLen = UBound(bytInText) - LBound(bytInText) + 1  '计算bytInText数组长度
  89.     If lngInTextLen Mod 4 <> 0 Then Exit Function  '输入编码不是4的倍数则出错返回
  90.    
  91.     For i = 1 To 122  '初始化Base64解码表
  92.         Select Case True
  93.         Case i=43  '+
  94.             Base64DecodeTable(i) = 62
  95.         Case i=47  '/
  96.             Base64DecodeTable(i) = 63
  97.         Case i>=48 And i<=57  '0 - 9
  98.             Base64DecodeTable(i) = 52 + (i - 48)
  99.         Case i>=65 And i<=90  'A - Z
  100.             Base64DecodeTable(i) = 0 + (i - 65)
  101.         Case i>=97 And i<=122  'a - z
  102.             Base64DecodeTable(i) = 26 + (i - 97)
  103.         Case Else
  104.             Base64DecodeTable(i) = 255
  105.         End Select
  106.     Next
  107.     lngDecodeLen = lngInTextLen / 4 * 3  '求解码后的最大长度
  108.     ReDim bytDecode(lngDecodeLen - 1)  '重新定义解码缓冲区
  109.     'MsgBox "解码后的最大长度为:" & lngDecodeLen
  110.    
  111.     lngDecodeLen = 0  '初始化解码长度
  112.    
  113.     For i = 0 To lngInTextLen - 1 Step 4
  114.         bytDecode(lngDecodeLen) = (Base64DecodeTable(bytInText(i)) * (2 ^ 2)) Or ((Base64DecodeTable(bytInText(i + 1)) And &H30) \ (2 ^ 4))
  115.         bytDecode(lngDecodeLen + 1) = ((Base64DecodeTable(bytInText(i + 1)) And &HF) * (2 ^ 4)) Or ((Base64DecodeTable(bytInText(i + 2)) And &H3C) \ (2 ^ 2))
  116.         bytDecode(lngDecodeLen + 2) = ((Base64DecodeTable(bytInText(i + 2)) And &H3) * (2 ^ 6)) Or Base64DecodeTable(bytInText(i + 3))
  117.         lngDecodeLen = lngDecodeLen + 3
  118.     Next
  119.    
  120.     If bytInText(lngInTextLen - 1) = &H3D Then  '判断最后两个字节的情况,求解码后的实际长度
  121.         If bytInText(lngInTextLen - 2) = &H3D Then
  122.             lngDecodeLen = lngDecodeLen - 2  '最后两个字节为"="
  123.         Else
  124.             lngDecodeLen = lngDecodeLen - 1  '最后一个字节为"="
  125.         End If
  126.         bytDecode(lngDecodeLen) = 0  '在实际长度的后一个字节放个结束符
  127.     End If
  128.     'MsgBox "解码后的实际长度为:" & lngDecodeLen
  129.    
  130.     Base64_Decode = bytDecode
  131. End Function
复制代码

作者: powerbat    时间: 2011-6-28 21:47

幸好我在verybat收藏了zqz版主的binaryToText()、base64ToBin()、字符编码转换等很多常用函数。

既然版主没帖出来,我也不能越俎代庖。
作者: HAT    时间: 2011-6-28 22:01

敝帚自珍的思想,要不得。
作者: broly    时间: 2011-7-12 20:31

9# powerbat

powerbat把代码都贴了吧,最好在“VBS原创&转载区”,让大家都学习学习。
作者: yu2n    时间: 2017-10-17 22:53

正好翻出来一个有意思的点 utf8 bom…
  1. Option Explicit
  2. WScript.Echo base64utf8("5om55aSE55CG5LmL5a62", False) & vbCrLf & _
  3. base64utf8("批处理之家", True)
  4. '************************************************************************
  5. '字符串 Base64 编码、解码 (utf-8)
  6. '************************************************************************
  7. Function base64utf8(ByVal sText, ByVal bAsEncodeDecode)
  8. Dim oStream, oXML, oNode
  9. On Error Resume Next
  10. Set oStream = CreateObject("ADODB.Stream")
  11. Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
  12. Set oNode = oXML.CreateElement("base64")
  13. oNode.DataType = "bin.base64"
  14. base64utf8 = ""
  15. If bAsEncodeDecode Then
  16. oStream.Type = 2 'adTypeText = 2
  17. oStream.Charset = "utf-8"
  18. oStream.Open
  19. oStream.WriteText sText
  20. oStream.Position = 0
  21. oStream.Type = 1 'adTypeBinary = 1
  22. oStream.Position = 0
  23. oNode.nodeTypedValue = oStream.Read
  24. If Err.Number = 0 Then
  25. base64utf8 = oNode.Text '移除 utf-8 文件的 BMO头 efbbbf。base64_decode('77u/')
  26. If Left(base64utf8, 4) = "77u/" Then base64utf8 = Mid(base64utf8,5)
  27. End If
  28. Else
  29. oStream.Type = 1 'adTypeBinary = 1
  30. oStream.Open
  31. oNode.Text = sText
  32. oStream.Write oNode.nodeTypedValue
  33. oStream.Position = 0
  34. oStream.Type = 2 'adTypeText = 2
  35. oStream.Charset = "utf-8"
  36. If Err.Number = 0 Then base64utf8 = oStream.ReadText
  37. End If
  38. Set oStream = Nothing
  39. Set oNode = Nothing
  40. Set oXML = Nothing
  41. End Function
复制代码
结果如下:
  1. ---------------------------
  2. Windows Script Host
  3. ---------------------------
  4. 批处理之家
  5. 5om55aSE55CG5LmL5a62
  6. ---------------------------
  7. 确定   
  8. ---------------------------
复制代码





欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2