中国DOS联盟论坛

中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名:www.cn-dos.net  论坛域名:www.cn-dos.net/forum
DOS,代表着自由开放与发展,我们努力起来,学习FreeDOS和Linux的自由开放与GNU精神,共同创造和发展美好的自由与GNU GPL世界吧!

游客:  注册 | 登录 | 命令行 | 搜索 | 上传 | 帮助 »
中国DOS联盟论坛 » DOS批处理 & 脚本技术(批处理室) » [求助] 求 BASE64 编码的 VBS 脚本。
作者:
标题: [求助] 求 BASE64 编码的 VBS 脚本。 上一主题 | 下一主题
chishingchan
银牌会员




积分 1282
发帖 538
注册 2002-11-2
状态 离线
『楼 主』:  [求助] 求 BASE64 编码的 VBS 脚本。

想找一个编码任何文件为BASE64的VBS脚本,且拖一个文件到此脚本自动生成BASE64编码的文本文件,找到这个不知管不管用,希望VBS脚本的高手帮忙修改并完善一下,使之能够支持拖放文件的功能及能编码成功。谢谢!


' 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


2008-6-25 12:17
查看资料  发短消息  网志   编辑帖子  回复  引用回复
chishingchan
银牌会员




积分 1282
发帖 538
注册 2002-11-2
状态 离线
『第 2 楼』:  

这里有篇是关于使用BASE64编码的VBS脚本,用它转换及生成文件是没错。
http://hi.baidu.com/zzzevazzz/blog/item/75b8b50a118b6c1e94ca6b36.html
但!!!此BASE64不是通用型,即使用以下 VBS 脚本是恢复出错的。
filename="BASE64编码字符串"
Set xml_dom = CreateObject("MSXML2.DOMDocument")
Set ado_stream = CreateObject("ADODB.Stream")
Set pic = xml_dom.createElement("pic")
pic.dataType = "bin.base64"
pic.nodeTypedvalue = rExp(filename)
ado_stream.Type = 1
ado_stream.Open
ado_stream.Write pic.nodeTypedvalue
ado_stream.SaveToFile "filename.exe",2
ado_stream.Close
Set ado_stream = Nothing

Function rExp(inpStr)
Dim oRe, Matches, match
Set oRe = New RegExp
oRe.Pattern = "\{(+)\}"
oRe.Global = True
Set Matches = oRe.Execute(inpStr)
For each match in matches
character = Mid(Match.SubMatches(0),1,1)
chrnumber = Int(Mid(Match.SubMatches(0),2))
inpStr = Replace(inpStr,Match.Value,String(chrnumber,character))
Next
rExp = inpStr
End Function


Last edited by chishingchan on 2008-6-25 at 08:21 PM ]

2008-6-25 14:59
查看资料  发短消息  网志   编辑帖子  回复  引用回复

请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转: