VBA将二进制图像转换为网页的base64编码string

我试图阅读一个JPG文件，并将文件转换为base64编码的string，可以作为一个网页上的embedded式JPEG使用。 我在网上发现了两个在VBA中进行base64编码/解码的函数，这些函数似乎被广泛接受。 编码/解码过程产生我原来的二进制string，所以function似乎至less有点正确。 然而，我得到的base64string没有什么地方，当我使用在线工具将我的图像转换为base64时得到的。

base64string应该启动：“/ 9j / 4AAQSkZJRgABAQEAUgBSAAD”。 而是从“Pz8 / Pz9BYT8 / AD8 / Pz8 / Pz8 / Pz8 / Pz8 / Pz8”开始。 我失去了为什么我没有得到以前的结果，为什么我得到后者。 我在阅读二进制文件时做错了什么？

这是我的代码：

Sub TestBase64() Dim bytes, b64 With CreateObject("ADODB.Stream") .Open .Type = ADODB.adTypeBinary .LoadFromFile "c:\temp\TestPic.jpg" bytes = .Read .Close End With Debug.Print bytes b64 = Base64Encode(bytes) Debug.Print vbCrLf + vbCrLf Debug.Print b64 Debug.Print vbCrLf + vbCrLf Debug.Print Base64Decode(CStr(b64)) End Sub ' 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 Function Base64Encode(inData) 'rfc1521 '2001 Antonin Foller, Motobit Software, http://Motobit.cz Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim cOut, sOut, i 'For each group of 3 bytes For i = 1 To Len(inData) Step 3 Dim nGroup, pOut, sGroup 'Create one long from this 3 bytes. nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _ &H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1)) 'Oct splits the long To 8 groups with 3 bits nGroup = Oct(nGroup) 'Add leading zeros nGroup = String(8 - Len(nGroup), "0") & nGroup 'Convert To base64 pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _ Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _ Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _ Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1) 'Add the part To OutPut string sOut = sOut + pOut 'Add a new line For Each 76 chars In dest (76*3/4 = 57) 'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf Next Select Case Len(inData) Mod 3 Case 1: '8 bit final sOut = Left(sOut, Len(sOut) - 2) + "==" Case 2: '16 bit final sOut = Left(sOut, Len(sOut) - 1) + "=" End Select Base64Encode = sOut End Function Function MyASC(OneChar) If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar) End Function 

Answer 1

这是一个冗长的编码方式。 我更喜欢这个：

您需要添加对Microsoft XML，v6.0（或v3.0）的引用，

 Sub TestBase64() Dim bytes, b64 With CreateObject("ADODB.Stream") .Open .Type = ADODB.adTypeBinary .LoadFromFile "c:\temp\TestPic.jpeg" bytes = .Read .Close End With Debug.Print bytes b64 = EncodeBase64(bytes) Debug.Print vbCrLf + vbCrLf Debug.Print Left(b64, 100) ' Debug.Print vbCrLf + vbCrLf ' Debug.Print Base64Decode(CStr(b64)) End Sub Private Function EncodeBase64(bytes) As String Dim objXML As MSXML2.DOMDocument Dim objNode As MSXML2.IXMLDOMElement Set objXML = New MSXML2.DOMDocument Set objNode = objXML.createElement("b64") objNode.DataType = "bin.base64" objNode.nodeTypedValue = bytes EncodeBase64 = objNode.Text Set objNode = Nothing Set objXML = Nothing End Function 

输出（前几个字符）： /9j/4AAQSkZJRgABAQEAYABgAAD