VBA将二进制图像转换为网页的base64编码的字符串
我正在尝试读取JPG文件并将其转换为base64编码的字符串,可用作网页上的嵌入式jpeg。我在Web上发现了两个功能很广为接受的VBA中的base64编码/解码功能。编码/解码过程产生了我原来的二进制字符串,因此这些函数似乎至少是正确的。但是,我得到的base64字符串与使用在线工具将图像转换为base64时得到的字符串相差无几。
I am trying to read in a JPG file and convert the file to a base64 encoded string that can be used as an embedded jpeg on a web page. I found two functions on the web for base64 encoding/decoding in VBA that appear to be well-accepted. The encode/decode process yields my original binary string, so the functions appear to be at least somewhat correct. However the base64 string I am getting is no where near what I get when I use an online tool to convert my image to base64.
base64字符串应以 /开头9j / 4AAQSkZJRgABAQEAUgBSAAD。而是以 Pz8 / Pz9BYT8 / AD8 / Pz8 / Pz8 / Pz8 / Pz8 / Pz8开头。我不知道为什么我没有得到前一个结果以及为什么我得到了后者。我在读取二进制文件时是否做错了什么?
The base64 string should start: "/9j/4AAQSkZJRgABAQEAUgBSAAD". Instead it is starting with: "Pz8/Pz9BYT8/AD8/Pz8/Pz8/Pz8/Pz8/Pz8". I'm lost as to why I'm not getting the former result and why I'm getting the latter. Am I doing something wrong in my reading of the binary file?
这是我的代码:
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
一些冗长的编码方式。我更喜欢这样:
That's some lengthy way to encode. I prefer this:
您需要添加对 Microsoft XML v6.0(或v3.0) $ b的引用
$ b
You Need to add reference to Microsoft XML, v6.0 (or 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
Output (first few characters): /9j/4AAQSkZJRgABAQEAYABgAAD