Question

我正在尝试读入JPG文件并将文件转换为base64编码的字符串，该字符串可用作网页上的嵌入式jpeg。我在网上找到了两个在VBA中进行base64编码/解码的功能，这些功能似乎被广泛接受。编码/解码过程产生我原始的二进制字符串，因此函数看起来至少有点正确。然而，当我使用在线工具将我的图像转换为base64时，我得到的base64字符串并不是我所接近的。

base64字符串应该开始：＆＃34; / 9j / 4AAQSkZJRgABAQEAUgBSAAD＆＃34;。相反，它开始于：＆＃34; Pz8 / Pz9BYT8 / AD8 / Pz8 / Pz8 / Pz8 / Pz8 / Pz8＆＃34;。我迷失了为什么我没有得到前一个结果以及为什么我得到了后者。我在阅读二进制文件时做错了吗？

这是我的代码：

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

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

1 个答案: