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
复制代码