[问题求助] VBS如何以二进制形式输出一个exe文件

wskwfkbdn

VBS如何以二进制形式输出一个exe文件
求教
目的是不想附带一个第三方命令行程序，直接让vbs脚本写出exe文件。

CrLf

http://www.bathome.net/viewthread.php?tid=4435

[拓展]批处理的另一种解决方案：
http://www.bathome.net/thread-12349-1-1.html

wskwfkbdn

回复 2# CrLf


    感谢

codegay

编码后再解码，比如用base64编码。是更简单通用的玩法吧？
x64的系统已经不带debug了

wskwfkbdn

回复 4# codegay


    能不能给个代码

codegay

回复 5# wskwfkbdn


    我又不玩VBS。
不过道理上相通。
base64的编码方法在很多语言里都有标准库。

#以下python3 代码是把wget.exe 的二进制流经过base64编码，然后再把base64编码的字符串还原成xxx.exe，测试还能运行。

"""
python base64 模块学习
#2016年8月28日 13:50:30 codegay

"""

import base64

with open("wget.exe","rb") as f:
    txt=base64.encodebytes(f.read())


with open("xxx.exe","wb") as f:
    f.write(base64.standard_b64decode(txt.decode()))
复制代码

codegay

python3

我把sleep.exe 编码成了字符串。
sleep.exe 是一个第三方命令行工具，用来延迟的。

运行以下python代码可以还原得到resleep.exe

import base64

ss = """TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAA4AAAAA4fug4AtAnNIbgBTM0hVGhpcyBwcm9ncmFtIGNhbm5vdCBiZSBydW4gaW4gRE9TIG1v
ZGUuDQ0KJAAAAAAAAAD+ls8EuvehV7r3oVe696FXOf+uV7v3oVe696BXrvehVzn//Fe/96FXNP/+
V7T3oVc5//9Xu/ehVzn/+1e796FXUmljaLr3oVcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQRQAA
TAEDAAmhoD4AAAAAAAAAAOAADwELAQcKAAgAAAAIAAAAAAAA7hIAAAAQAAAAIAAAAAAAAQAQAAAA
AgAABQACAAUAAgAEAAAAAAAAAABAAAAABAAAq6UAAAMAAIAAAAQAACAAAAAAEAAAEAAAAAAAABAA
AAAAAAAAAAAAAPAUAAA8AAAAADAAAAgEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABgEAAAHAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgRAABAAAAAAAAAAAAAAAAAEAAAUAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAC50ZXh0AAAAjgYAAAAQAAAACAAAAAQAAAAAAAAAAAAAAAAAACAAAGAu
ZGF0YQAAACQAAAAAIAAAAAIAAAAMAAAAAAAAAAAAAAAAAABAAADALnJzcmMAAAAIBAAAADAAAAAG
AAAADgAAAAAAAAAAAAAAAAAAQAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGIW
AABqFgAAAAAAAJgVAACmFQAAsBUAALgVAADEFQAA1BUAAOAVAACQFQAABBYAABQWAAAiFgAANBYA
AFQWAACGFQAA9BUAAHwVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJoaA+AAAAAAIAAAAaAAAA
cBEAAHAFAAAgICAgICAgICVzIFstY10gY29tbWl0ZWQtbWVtb3J5IHJhdGlvICgxJSUtMTAwJSUp
CgAAICAgICAgICAlcyBbLW1dIHRpbWUtdG8tc2xlZXAtaW4tbWlsbGlzZWNvbmRzCgAAVXNhZ2U6
ICAlcyAgICAgIHRpbWUtdG8tc2xlZXAtaW4tc2Vjb25kcwoAAAAtYwAALW0AAAAAAAD/////OhQA
AU4UAAEAAAAASAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAABCAAAcARAAEBAAAATkIxMAAAAAAJoaA+AQAAAHNsZWVwLnBkYgAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADkFAAAVos1SBAA
AVeLfCQMV2jgEAAB/9ZXaLAQAAH/1ldofBAAAf/Wg8QYX17CBACLVCQEM8DrFYD5MHwYgPk5fxMP
vsmNBICNREHQQooKhMl15esDg8j/wgQAVYvsg+wsg030/4NN/P+DfQgCU4tdDFbHRfjoAwAAdQ3/
cwTorf///4lF/OtZagNZOU0IdVeLcwRXvxARAAEzwPOmdRL/cwjoif///4lF/MdF+AEAAACLcwRq
A1m/DBEAATPA86ZfdR7/cwjoZf///4P4ZIlF9H8Ox0X8CgAAAMdF+AEAAACDffz/dQz/M+gW////
M8BA6zeLdfSD/v90H41F1FD/FQQQAAE5ddh8HotF+A+vRfxQ/xUAEAAB6+GLRfgPr0X8UP8VABAA
ATPAXlvJw2ooaBgRAAHongEAAGaBPQAAAAFNWnUooTwAAAGBuAAAAAFQRQAAdRcPt4gYAAABgfkL
AQAAdCGB+QsCAAB0BoNl5ADrKoO4hAAAAQ528TPJOYj4AAAB6xGDuHQAAAEOdt4zyTmI6AAAAQ+V
wYlN5INl/ABqAf8VNBAAAVmDDRggAAH/gw0cIAAB//8VMBAAAYsNFCAAAYkI/xUsEAABiw0QIAAB
iQihRBAAAYsAoyAgAAHo7QAAAIM9ACAAAQB1DGiSFAAB/xUkEAABWejBAAAAaFwQAAFoWBAAAeis
AAAAoQwgAAGJRdyNRdxQ/zUIIAABjUXgUI1F2FCNRdRQ/xUcEAABiUXMaFQQAAFoUBAAAeh2AAAA
i0Xgiw0YEAABiQH/deD/ddj/ddTo/v3//4PEMIvwiXXIg33kAHUHVv8VFBAAAf8VEBAAAesti0Xs
iwiLCYlN0FBR6CkAAABZWcOLZeiLddCDfeQAdQdW/xUoEAAB/xVAEAABg038/4vG6GEAAADDzP8l
DBAAAf8lIBAAAWgAAAMAaAAAAQDoWwAAAFlZwzPAw8zMzGjkFAABZKEAAAAAUItEJBCJbCQQjWwk
ECvgU1ZXi0X4iWXoUItF/MdF/P////+JRfiNRfBkowAAAADDi03wZIkNAAAAAFlfXlvJUcP/JTgQ
AAH/JTwQAAE4FQAAAAAAAAAAAABIFgAADBAAACwVAAAAAAAAAAAAAIAWAAAAEAAAAAAAAAAAAAAA
AAAAAAAAAAAAAABiFgAAahYAAAAAAACYFQAAphUAALAVAAC4FQAAxBUAANQVAADgFQAAkBUAAAQW
AAAUFgAAIhYAADQWAABUFgAAhhUAAPQVAAB8FQAAAAAAAO8CcHJpbnRmAADKAF9jX2V4aXQA+wBf
ZXhpdABOAF9YY3B0RmlsdGVyAM0AX2NleGl0AACaAmV4aXQAAHEAX19pbml0ZW52AHAAX19nZXRt
YWluYXJncwBAAV9pbml0dGVybQCeAF9fc2V0dXNlcm1hdGhlcnIAALsAX2FkanVzdF9mZGl2AACD
AF9fcF9fY29tbW9kZQAAiABfX3BfX2Ztb2RlAACcAF9fc2V0X2FwcF90eXBlAADyAF9leGNlcHRf
aGFuZGxlcjMAAG1zdmNydC5kbGwAANsAX2NvbnRyb2xmcAAASQNTbGVlcAD6AUdsb2JhbE1lbW9y
eVN0YXR1cwAAS0VSTkVMMzIuZGxsAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAE7m
QLsAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAEAEAAAABgAAIAAAAAAAAAAAAAAAAAAAAEAAQAAADAAAIAAAAAAAAAAAAAAAAAAAAEA
CQQAAEgAAABgMAAApAMAAAAAAAAAAAAAAAAAAAAAAACkAzQAAABWAFMAXwBWAEUAUgBTAEkATwBO
AF8ASQBOAEYATwAAAAAAvQTv/gAAAQACAAUAAADODgIABQAAAM4OPwAAAAgAAAAEAAQAAQAAAAAA
AAAAAAAAAAAAAAIDAAABAFMAdAByAGkAbgBnAEYAaQBsAGUASQBuAGYAbwAAAN4CAAABADAANAAw
ADkAMAA0AEIAMAAAAEwAFgABAEMAbwBtAHAAYQBuAHkATgBhAG0AZQAAAAAATQBpAGMAcgBvAHMA
bwBmAHQAIABDAG8AcgBwAG8AcgBhAHQAaQBvAG4AAAA8AAoAAQBGAGkAbABlAEQAZQBzAGMAcgBp
AHAAdABpAG8AbgAAAAAASQBEAFcAIAB0AG8AbwBsAHMAAABwACgAAQBGAGkAbABlAFYAZQByAHMA
aQBvAG4AAAAAADUALgAyAC4AMwA3ADkAMAAuADAAIABiAHUAaQBsAHQAIABiAHkAOgAgAGQAbgBz
AHIAdgBfAGQAZQB2ACgAdgAtAHMAbQBnAHUAbQApAAAATgAXAAEASQBuAHQAZQByAG4AYQBsAE4A
YQBtAGUAAABTAGwAZQBlAHAALgBFAHgAZQAgAGEAbgBkACAAQgBlAGUAcAAuAEUAeABlAAAAAACA
AC4AAQBMAGUAZwBhAGwAQwBvAHAAeQByAGkAZwBoAHQAAACpACAATQBpAGMAcgBvAHMAbwBmAHQA
IABDAG8AcgBwAG8AcgBhAHQAaQBvAG4ALgAgAEEAbABsACAAcgBpAGcAaAB0AHMAIAByAGUAcwBl
AHIAdgBlAGQALgAAAFYAFwABAE8AcgBpAGcAaQBuAGEAbABGAGkAbABlAG4AYQBtAGUAAABTAGwA
ZQBlAHAALgBFAHgAZQAgAGEAbgBkACAAQgBlAGUAcAAuAEUAeABlAAAAAABqACUAAQBQAHIAbwBk
AHUAYwB0AE4AYQBtAGUAAAAAAE0AaQBjAHIAbwBzAG8AZgB0AK4AIABXAGkAbgBkAG8AdwBzAK4A
IABPAHAAZQByAGEAdABpAG4AZwAgAFMAeQBzAHQAZQBtAAAAAAA6AAsAAQBQAHIAbwBkAHUAYwB0
AFYAZQByAHMAaQBvAG4AAAA1AC4AMgAuADMANwA5ADAALgAwAAAAAABEAAAAAQBWAGEAcgBGAGkA
bABlAEkAbgBmAG8AAAAAACQABAAAAFQAcgBhAG4AcwBsAGEAdABpAG8AbgAAAAAACQSwBAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA="""

with open("resleep.exe","wb") as f:
    f.write(base64.standard_b64decode(ss))
复制代码

codegay

PowerShell 脚本中嵌入二进制文件
http://www.pstips.net/powershell ... in-your-script.html

B魔方大人

base64处理后数据量会变大，事实上不如用原码，如果对编码方面有需求，当然base64是不错的！
如果是稍微大点的数据或许可以考虑LZ算法系列，不过由于解码过程抵消了一部分压缩量，所以处理稍微大点的数据比较合适！

codegay

回复 9# B魔方大人


   光给出一个“最NB的”解决方向，但是没有可行性或者很难实现，是没用的。

类似“坐直升机上班快”这种建议对大家真的一点用的都没有。因为都造不出直升机也买不起。

B魔方大人

回复 10# codegay


    呵呵，请认真看！

more

这是我以前写的一个还原铃声的代码,可以借鉴一下:

Option Explicit

'把保存为 TXT 的文件恢复为原文件
Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
Dim blnStart, strTmp

blnStart = False
lngCnt = 0

Set objFso = CreateObject("Scripting.FileSystemObject")
strFile = objFso.GetSpecialFolder(2) & "\不要用我的爱来伤害我.mp3"	'文件还原到"临时文件夹"

'如果已经存在指定文件(非第一次运行此脚本)则直接调用播放的过程
If objFso.FileExists(strFile) Then
	Call PlaySong(strFile)
	Set objFso = Nothing
	WScript.Quit
End If

Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
Set objADODB = CreateObject("ADODB.Stream")

'把文件内容赋值给数组
Do Until objFile.AtEndOfStream
	If blnStart = True Then
		ReDim Preserve arrBit(lngCnt)
		strTmp = objFile.ReadLine
		arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
		lngCnt = lngCnt + 1
	Else
		If objFile.ReadLine = "'不要用我的爱来伤害我.mp3" Then blnStart = True
	End If
Loop
objFile.Close
Set objFile = Nothing

'还原文件
lngCnt = lngCnt - 1
ReDim arrChr(lngCnt \ 2)
For i = 0 To lngCnt - 1 Step 2
	arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
Next
If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
arrChr = Join(arrChr, "")
objADODB.Type = 1
objADODB.Open
With CreateObject("ADODB.Stream")
	.Type = 2
	.Open
	.Writetext arrChr
	.Position =  2
	.Copyto objADODB
	.Close
End With
objADODB.SaveToFile strFile, 2
objADODB.Close
Set objADODB = Nothing
Set objFso = Nothing

Call PlaySong(strFile)

Sub PlaySong(strMusic)
	Dim i
	For i = 0 To 2	'播放三次
		With CreateObject("WMPlayer.ocx")
			.url = strMusic
			.controls.play
			Do Until .playstate = 1
				WScript.Sleep 500
			Loop
		End With
	Next
End Sub

'不要用我的爱来伤害我.mp3
'255
'250
'179
复制代码

'由于 2M 的铃声文件(txt后缀)提示文件过大而无法上传,遗憾

'分隔符#######################
'这个函数可以把文件以二进制分解后存储为 txt 后缀

Sub Backup(srcFile)
    Dim objADODB, objFso, objFl, i, arrBit(0)
    Set objADODB = CreateObject("ADODB.Stream")
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFl = objFso.OpenTextFile(srcFile & "_Back.txt", 2, True)
    With objADODB
        .Open
        .Type = 1    'adTypeBinary = 1
        .LoadFromFile srcFile
        For i = 0 To .Size - 1
            arrBit(0) = AscB(.Read(1))
            objFl.WriteLine arrBit(0)
        Next
        .Close
    End With
    Set objADODB = Nothing
    objFl.Close
    Set objFl = Nothing
    Set objFso = Nothing
End Sub
复制代码

yu2n

参考：
VBS 二进制文件 与 Base64编码文本文件 互转工具

Option Explicit

Dim sTitle
sTitle = "二进制文件 与 Base64编码文本文件 互转工具"
If WScript.Arguments.Count = 0 Then
	MsgBox "使用方法：请将要格式化的文件拖动到这个文件上。", vbInformation, sTitle
	WScript.Quit
End If

Dim sReturn
sReturn = Msgbox("请选择转化模式：" & vbCrLf & vbCrLf & _
                "   [ 是(Y) ]   二进制文件 转 Base64编码文本文件" & vbCrLf & _
                "   [ 否(N) ]   Base64编码文本文件 转 二进制文件 " & vbCrLf , _
                vbQuestion + vbYesNoCancel, sTitle)
                
If sReturn = vbCancel Then WScript.Quit

Dim fso, wso
Set fso = Createobject("Scripting.FileSystemObject") 
Set wso = CreateObject("WScript.Shell")

Dim i
For Each i In WScript.Arguments
    If sReturn = vbYes Then BinaryToBase64 i, i & ".base64.txt"
    If sReturn = vbNo  Then Base64ToBinary i, i & ".bin"
Next


wso.popup chr(13) + "文件格式化完成。    " + chr(13), 1, "提示", vbInformation
WScript.Quit


Function BinaryToBase64(ByVal BinaryFile, ByVal TextFile)
    ' This script reads jpg picture named SuperPicture.jpg, converts it to base64
    ' code using encoding abilities of MSXml2.DOMDocument object and saves
    ' the resulting data to encoded.txt file
	' http://stackoverflow.com/questions/496751/base64-encode-string-in-vbscript

    'Option Explicit

    Const fsDoOverwrite     = true  ' Overwrite file with base64 code
    Const fsAsASCII         = false ' Create base64 code file as ASCII file
    Const adTypeBinary      = 1     ' Binary file is encoded

    ' Variables for writing base64 code to file
    Dim objFSO
    Dim objFileOut

    ' Variables for encoding
    Dim objXML
    Dim objDocElem

    ' Variable for reading binary picture
    Dim objStream

    ' Open data stream from picture
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open()
    'objStream.LoadFromFile("SuperPicture.jpg")
    objStream.LoadFromFile(BinaryFile)

    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.dataType = "bin.base64"

    ' Set binary value
    objDocElem.nodeTypedValue = objStream.Read()

    ' Open data stream to base64 code file
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Set objFileOut = objFSO.CreateTextFile("encoded.txt", fsDoOverwrite, fsAsASCII)
    Set objFileOut = objFSO.CreateTextFile(TextFile, fsDoOverwrite, fsAsASCII)

    ' Get base64 value and write to file
    objFileOut.Write objDocElem.text
    objFileOut.Close()

    ' Clean all
    Set objFSO = Nothing
    Set objFileOut = Nothing
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing
    
End Function


Function Base64ToBinary(ByVal sTextFile, ByVal sBinaryFile)

    Const foForReading          = 1 ' Open base 64 code file for reading
    Const foAsASCII             = 0 ' Open base 64 code file as ASCII file
    Const adSaveCreateOverWrite = 2 ' Mode for ADODB.Stream
    Const adTypeBinary          = 1 ' Binary file is encoded

    ' Variables for reading base64 code from file
    Dim objFSO
    Dim objFileIn
    Dim objStreamIn

    ' Variables for decoding
    Dim objXML
    Dim objDocElem

    ' Variable for write binary picture
    Dim objStream

    ' Open data stream from base64 code filr
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Set objFileIn   = objFSO.GetFile("encoded.txt")
    Set objFileIn   = objFSO.GetFile(sTextFile)
    Set objStreamIn = objFileIn.OpenAsTextStream(foForReading, foAsASCII)

    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.DataType = "bin.base64"

    ' Set text value
    objDocElem.text = objStreamIn.ReadAll()

    ' Open data stream to picture file
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open()

    ' Get binary value and write to file
    objStream.Write objDocElem.NodeTypedValue
    'objStream.SaveToFile "SuperPicture.jpg", adSaveCreateOverWrite
    objStream.SaveToFile sBinaryFile, adSaveCreateOverWrite

    ' Clean all
    Set objFSO = Nothing
    Set objFileIn = Nothing
    Set objStreamIn = Nothing
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing
    
End Function
复制代码