标题: [问题求助] VBS如何解码base64字符串 [打印本页]
作者: Demon 时间: 2011-6-4 13:17 标题: VBS如何解码base64字符串
UTF-8编码的“批处理之家”经过base64编码以后是“5om55aSE55CG5LmL5a62”,怎样从“5om55aSE55CG5LmL5a62”还原成“批处理之家”?
作者: Spring 时间: 2011-6-4 14:05
网上早有人写好了,搜索一下就能得到:- WScript.Echo utf8to16(Base64Decode("5om55aSE55CG5LmL5a62"))
-
- Function utf8to16(str)
- Dim out, i, len1, c, t
- Dim char2, char3
- out = ""
- len1 = Len(str)
- i = 0
- While (i < len1)
- c = Asc(Mid(str, i + 1, 1))
- i = i + 1
- t = c \ 16
- If t >= 0 And t <= 7 Then
- out = out + Mid(str, i, 1)
- ElseIf t = 12 Or t = 13 Then
- char2 = Asc(Mid(str, i + 1, 1))
- i = i + 1
- out = out + Chr(((c And 31) * 64) Or (char2 And 31))
- ElseIf t = 14 Then
- char2 = Asc(Mid(str, i + 1, 1))
- i = i + 1
- char3 = Asc(Mid(str, i + 1, 1))
- i = i + 1
- out = out + ChrW(((c And 15) * 4096) Or ((char2 And 63) * 64) Or ((char3 And 63)))
- End If
- Wend
- utf8to16 = out
- End Function
-
- ' Decodes a base-64 encoded string (BSTR type).
- ' 1999 - 2004 Antonin Foller, http://www.motobit.com
- ' 1.01 - solves problem with Access And 'Compare Database' (InStr)
- Function Base64Decode(ByVal base64String)
- 'rfc1521
- '1999 Antonin Foller, Motobit Software, http://Motobit.cz
- Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
- Dim dataLength, sOut, groupBegin
-
- 'remove white spaces, If any
- base64String = Replace(base64String, vbCrLf, "")
- base64String = Replace(base64String, vbTab, "")
- base64String = Replace(base64String, " ", "")
-
- 'The source must consists from groups with Len of 4 chars
- dataLength = Len(base64String)
- If dataLength Mod 4 <> 0 Then
- Err.Raise 1, "Base64Decode", "Bad Base64 string."
- Exit Function
- End If
-
-
- ' Now decode each group:
- For groupBegin = 1 To dataLength Step 4
- Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
- ' Each data group encodes up To 3 actual bytes.
- numDataBytes = 3
- nGroup = 0
-
- For CharCounter = 0 To 3
- ' Convert each character into 6 bits of data, And add it To
- ' an integer For temporary storage. If a character is a '=', there
- ' is one fewer data byte. (There can only be a maximum of 2 '=' In
- ' the whole string.)
-
- thisChar = Mid(base64String, groupBegin + CharCounter, 1)
-
- If thisChar = "=" Then
- numDataBytes = numDataBytes - 1
- thisData = 0
- Else
- thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
- End If
- If thisData = -1 Then
- Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
- Exit Function
- End If
-
- nGroup = 64 * nGroup + thisData
- Next
-
- 'Hex splits the long To 6 groups with 4 bits
- nGroup = Hex(nGroup)
-
- 'Add leading zeros
- nGroup = String(6 - Len(nGroup), "0") & nGroup
-
- 'Convert the 3 byte hex integer (6 chars) To 3 characters
- pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
- Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
- Chr(CByte("&H" & Mid(nGroup, 5, 2)))
-
- 'add numDataBytes characters To out string
- sOut = sOut & Left(pOut, numDataBytes)
- Next
-
- Base64Decode = sOut
- 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
复制代码
作者: batman 时间: 2011-6-28 00:23
6# Demon
五楼不是演示解密的。。。
作者: dahual 时间: 2011-6-28 15:37
主要还是编码的问题。
通过解决这个问题,让我觉得字节是最完美的。- '参考链接:
- 'http://maclife.net/tools/base64/
- 'http://blog.csdn.net/zym_123456/archive/2008/03/30/2230695.aspx
- Option Explicit
-
- MsgBox Base64ToText_Utf8Encode("5om55aSE55CG5LmL5a62")
-
- 'Base64ToText_utf8Encode
- Function Base64ToText_Utf8Encode(s)
- Dim i
- Dim bArr,bRet
- ReDim bArr(Len(s)-1)
-
- For i=1 To Len(s)
- bArr(i-1)=Asc(Mid(s,i,1))
- Next
- bRet=Base64_Decode(bArr)
- Base64ToText_utf8Encode=Utf8ToUnicode(bRet)
- End Function
-
- 'Utf8ToUnicode
- Function Utf8ToUnicode(src)
- Dim IsAsc
- Dim utfLen
- utfLen = -1
-
- On Error Resume Next
- utfLen = UBound(src)-LBound(src)+1
- If utfLen = -1 Then Exit Function
- On Error GoTo 0
-
- Dim i,j,k,N
- Dim B,cnt
- ReDim Buf(utfLen)
- i = 1
- j = 0
- Do While i <= utfLen
- B = src(i-1)
- If (B And &HFC) = &HFC Then
- cnt = 6
- ElseIf (B And &HF8) = &HF8 Then
- cnt = 5
- ElseIf (B And &HF0) = &HF0 Then
- cnt = 4
- ElseIf (B And &HE0) = &HE0 Then
- cnt = 3
- ElseIf (B And &HC0) = &HC0 Then
- cnt = 2
- Else
- cnt = 1
- End If
- If i + cnt - 1 > utfLen Then
- Buf(j) = "?"
- Exit Do
- End If
- Select Case cnt
- Case 2
- N = B And &H1F
- Case 3
- N = B And &HF
- Case 4
- N = B And &H7
- Case 5
- N = B And &H3
- Case 6
- N = B And &H1
- Case Else
- Buf(j) = Chr(B)
- IsAsc=True
- End Select
- If IsAsc=False Then
- For k = 1 To cnt - 1
- B = src(i+k-1)
- N = N * &H40 + (B And &H3F)
- Next
- Buf(j) = ChrW(N)
- End If
- i = i + cnt
- j = j + 1
- IsAsc=False
- Loop
- Utf8ToUnicode = Join(Buf, "")
- End Function
-
- 'Base64解码函数
- Public Function Base64_Decode(bytInText)
- Dim Base64DecodeTable(122)
- Dim lngInTextLen, i
- Dim bytDecode, lngDecodeLen
-
- Base64_Decode = Chr(0) '初始化函数返回值
-
- If LBound(bytInText) <> 0 Then Exit Function 'bytInText数组下标不从零开始则出错返回
-
- lngInTextLen = UBound(bytInText) - LBound(bytInText) + 1 '计算bytInText数组长度
- If lngInTextLen Mod 4 <> 0 Then Exit Function '输入编码不是4的倍数则出错返回
-
- For i = 1 To 122 '初始化Base64解码表
- Select Case True
- Case i=43 '+
- Base64DecodeTable(i) = 62
- Case i=47 '/
- Base64DecodeTable(i) = 63
- Case i>=48 And i<=57 '0 - 9
- Base64DecodeTable(i) = 52 + (i - 48)
- Case i>=65 And i<=90 'A - Z
- Base64DecodeTable(i) = 0 + (i - 65)
- Case i>=97 And i<=122 'a - z
- Base64DecodeTable(i) = 26 + (i - 97)
- Case Else
- Base64DecodeTable(i) = 255
- End Select
- Next
- lngDecodeLen = lngInTextLen / 4 * 3 '求解码后的最大长度
- ReDim bytDecode(lngDecodeLen - 1) '重新定义解码缓冲区
- 'MsgBox "解码后的最大长度为:" & lngDecodeLen
-
- lngDecodeLen = 0 '初始化解码长度
-
- For i = 0 To lngInTextLen - 1 Step 4
- bytDecode(lngDecodeLen) = (Base64DecodeTable(bytInText(i)) * (2 ^ 2)) Or ((Base64DecodeTable(bytInText(i + 1)) And &H30) \ (2 ^ 4))
- bytDecode(lngDecodeLen + 1) = ((Base64DecodeTable(bytInText(i + 1)) And &HF) * (2 ^ 4)) Or ((Base64DecodeTable(bytInText(i + 2)) And &H3C) \ (2 ^ 2))
- bytDecode(lngDecodeLen + 2) = ((Base64DecodeTable(bytInText(i + 2)) And &H3) * (2 ^ 6)) Or Base64DecodeTable(bytInText(i + 3))
- lngDecodeLen = lngDecodeLen + 3
- Next
-
- If bytInText(lngInTextLen - 1) = &H3D Then '判断最后两个字节的情况,求解码后的实际长度
- If bytInText(lngInTextLen - 2) = &H3D Then
- lngDecodeLen = lngDecodeLen - 2 '最后两个字节为"="
- Else
- lngDecodeLen = lngDecodeLen - 1 '最后一个字节为"="
- End If
- bytDecode(lngDecodeLen) = 0 '在实际长度的后一个字节放个结束符
- End If
- 'MsgBox "解码后的实际长度为:" & lngDecodeLen
-
- Base64_Decode = bytDecode
- 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…- Option Explicit
-
- WScript.Echo base64utf8("5om55aSE55CG5LmL5a62", False) & vbCrLf & _
- base64utf8("批处理之家", True)
-
- '************************************************************************
- '字符串 Base64 编码、解码 (utf-8)
- '************************************************************************
- Function base64utf8(ByVal sText, ByVal bAsEncodeDecode)
- Dim oStream, oXML, oNode
- On Error Resume Next
- Set oStream = CreateObject("ADODB.Stream")
- Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
- Set oNode = oXML.CreateElement("base64")
- oNode.DataType = "bin.base64"
- base64utf8 = ""
- If bAsEncodeDecode Then
- oStream.Type = 2 'adTypeText = 2
- oStream.Charset = "utf-8"
- oStream.Open
- oStream.WriteText sText
- oStream.Position = 0
- oStream.Type = 1 'adTypeBinary = 1
- oStream.Position = 0
- oNode.nodeTypedValue = oStream.Read
- If Err.Number = 0 Then
- base64utf8 = oNode.Text '移除 utf-8 文件的 BMO头 efbbbf。base64_decode('77u/')
- If Left(base64utf8, 4) = "77u/" Then base64utf8 = Mid(base64utf8,5)
- End If
- Else
- oStream.Type = 1 'adTypeBinary = 1
- oStream.Open
- oNode.Text = sText
- oStream.Write oNode.nodeTypedValue
- oStream.Position = 0
- oStream.Type = 2 'adTypeText = 2
- oStream.Charset = "utf-8"
- If Err.Number = 0 Then base64utf8 = oStream.ReadText
- End If
- Set oStream = Nothing
- Set oNode = Nothing
- Set oXML = Nothing
- End Function
复制代码
结果如下:- ---------------------------
- Windows Script Host
- ---------------------------
- 批处理之家
-
- 5om55aSE55CG5LmL5a62
- ---------------------------
- 确定
- ---------------------------
复制代码
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |