如何将图片进行Base64编码

[ineedchrist]

已知我有一个图片文件，如何对这个图片进行Base64编码，得到编码后的字符串呢？

[dong127]

二进制读文件，变换后赋值给变量。

[rainstormmaster]

Option Explicit

Private Function Base64encode(ByteArray() As Byte) As String
Dim charlist As String
charlist = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim tempstr As String
Dim stemp As String
Dim i As Long
Dim j As Long, k As Long
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long
i = UBound(ByteArray)
i = (i + 1) Mod 3
Select Case i
Case 0
For j = 0 To UBound(ByteArray) Step 3
num1 = ByteArray(j) \ 2 ^ 2 '右移2位，即取前6位
num2 = (ByteArray(j) And 3) * 2 ^ 4 + ByteArray(j + 1) \ 2 ^ 4
num3 = (ByteArray(j + 1) And 15) * 2 ^ 2 + ByteArray(j + 2) \ 2 ^ 6
num4 = ByteArray(j + 2) And 63
stemp = Mid(charlist, num1 + 1, 1) & Mid(charlist, num2 + 1, 1) & Mid(charlist, num3 + 1, 1) & Mid(charlist, num4 + 1, 1)
tempstr = tempstr + stemp
Next
Case 1
For j = 0 To UBound(ByteArray) - 1 Step 3
num1 = ByteArray(j) \ 2 ^ 2 '右移2位，即取前6位
num2 = (ByteArray(j) And 3) * 2 ^ 4 + ByteArray(j + 1) \ 2 ^ 4
num3 = (ByteArray(j + 1) And 15) * 2 ^ 2 + ByteArray(j + 2) \ 2 ^ 6
num4 = ByteArray(j + 2) And 63
stemp = Mid(charlist, num1 + 1, 1) & Mid(charlist, num2 + 1, 1) & Mid(charlist, num3 + 1, 1) & Mid(charlist, num4 + 1, 1)
tempstr = tempstr + stemp
Next
'处理数组的最后1个元素
k = UBound(ByteArray)
num1 = ByteArray(k) \ 2 ^ 2
num2 = (ByteArray(k) And 3) * 2 ^ 4
stemp = Mid(charlist, num1 + 1, 1) & Mid(charlist, num2 + 1, 1) & "=="
tempstr = tempstr + stemp
Case 2
For j = 0 To UBound(ByteArray) - 2 Step 3
num1 = ByteArray(j) \ 2 ^ 2 '右移2位，即取前6位
num2 = (ByteArray(j) And 3) * 2 ^ 4 + ByteArray(j + 1) \ 2 ^ 4
num3 = (ByteArray(j + 1) And 15) * 2 ^ 2 + ByteArray(j + 2) \ 2 ^ 6
num4 = ByteArray(j + 2) And 63
stemp = Mid(charlist, num1 + 1, 1) & Mid(charlist, num2 + 1, 1) & Mid(charlist, num3 + 1, 1) & Mid(charlist, num4 + 1, 1)
tempstr = tempstr + stemp
Next
'处理数组的最后2个元素
k = UBound(ByteArray)
num1 = ByteArray(k - 1) \ 2 ^ 2 '右移2位，即取前6位
num2 = (ByteArray(k - 1) And 3) * 2 ^ 4 + ByteArray(k) \ 2 ^ 4
num3 = (ByteArray(k) And 15) * 2 ^ 2
stemp = Mid(charlist, num1 + 1, 1) & Mid(charlist, num2 + 1, 1) & Mid(charlist, num3 + 1, 1) & "="
tempstr = tempstr + stemp
End Select

Base64encode = tempstr
End Function


Private Sub Command1_Click()
Dim mfile As String
mfile = "你的文件路径"
Dim buff() As Byte
Dim i As Long
i = FileLen(mfile)
If i = 0 Then Exit Sub
ReDim buff(i - 1)
Open mfile For Binary As #1
Get #1, , buff
Close #1
MsgBox "下面将对文件进行base64编码，请耐心等待"
Dim s As String
s = Base64encode(buff)
MsgBox "编码结束"
End Sub

[hxy2003]

不错

[rainstormmaster]

Option Explicit

'需要引用Microsoft XML, v3.0
Private Function Encode(iArray() As Byte) As String
Dim iXml As New MSXML2.DOMDocument30
With iXml.createElement("Encoder")
.dataType = "bin.base64"
.nodeTypedValue = iArray()
Encode = .Text
End With
End Function


Private Function Decode(ByVal iStrbase64 As String) As Byte()
Dim strXML As String
strXML = "<DECODER xmlns:dt=" & Chr(34) & "urn:schemas-microsoft-com:datatypes" & Chr(34) & " dt:dt=" & Chr(34) & "bin.base64" & Chr(34) & ">" & iStrbase64 & "</DECODER>"
With New MSXML2.DOMDocument30
.loadXML strXML
Decode = .selectSingleNode("DECODER").nodeTypedValue
End With
End Function

Private Sub Command1_Click()
Dim mfile As String
mfile = "你的文件路径"
Dim buff() As Byte
Dim i As Long
i = FileLen(mfile)
If i = 0 Then Exit Sub
ReDim buff(i - 1)
Open mfile For Binary As #1
Get #1, , buff
Close #1
MsgBox "下面将对文件进行base64编码，这次编码要快很多，不过好象不是特别准确"
Dim s As String
s = Encode(buff)
MsgBox "编码结束"
End Sub

[ineedchrist]

其实我自己已经解决了，不过还是要感谢楼上的参与者！