VBS如何解码base64字符串

Demon · 发表于 2011-6-4 13:17:39

UTF-8编码的“批处理之家”经过base64编码以后是“5om55aSE55CG5LmL5a62”，怎样从“5om55aSE55CG5LmL5a62”还原成“批处理之家”？

Spring · 发表于 2011-6-4 14:05:35

网上早有人写好了，搜索一下就能得到：

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:26

网上早有人写好了，搜索一下就能得到：
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:37

拿来主义啊................

zqz0012005 · 发表于 2011-6-27 21:51:25

WScript.Echo binaryToText(base64ToBin("5om55aSE55CG5LmL5a62"), "utf-8")

Demon · 发表于 2011-6-27 23:50:00

WScript.Echo binaryToText(base64ToBin("5om55aSE55CG5LmL5a62"), "utf-8")
zqz0012005 发表于 2011-6-27 21:51

WScript.Echo "批处理之家"

复制代码

batman · 发表于 2011-6-28 00:23:01

6# Demon
五楼不是演示解密的。。。

dahual · 发表于 2011-6-28 15:37:04

主要还是编码的问题。
通过解决这个问题，让我觉得字节是最完美的。

'参考链接：
'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:29

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

既然版主没帖出来，我也不能越俎代庖。

HAT · 发表于 2011-6-28 22:01:26

敝帚自珍的思想，要不得。

broly · 发表于 2011-7-12 20:31:04

9# powerbat

powerbat把代码都贴了吧，最好在“VBS原创&转载区”，让大家都学习学习。

yu2n · 发表于 2017-10-17 22:53:05

正好翻出来一个有意思的点 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
---------------------------
确定
---------------------------

复制代码

		自动登录	找回密码
密码			注册

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

[问题求助] VBS如何解码base64字符串

评分

评分