VBAバイナリイメージをWebページのbase64でエンコードされた文字列に変換する

Question

JPGファイルを読み込み、ファイルをWebページの埋め込みjpegとして使用できるbase64でエンコードされた文字列に変換しようとしています。私は、VBAのbase64エンコーディング/デコードのために、ウェブ上で2つの機能を見つけました。エンコード/デコード処理で元のバイナリ文字列が得られるので、関数は少なくとも多少正しいと思われます。しかし、私が得ているbase64文字列は、オンラインツールを使って自分のイメージをbase64に変換するときに得られるもののどこにもありません。

base64文字列は、 "/ 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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/" 
    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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/" 
    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

：

は、ここに私のコードです。

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 

あなたはのMicrosoft XML、V6.0（またはV3.0）への参照を追加する必要があり

出力（最初の数文字）：私はこれを好む/9j/4AAQSkZJRgABAQEAYABgAAD