谁有可以对图像进行BASE 64编码/解码的代码，急用，马上给分。

[alj]

查过很多Base64的，不过很多对字符串的，对图像的好多都不能用，谁有这样需求的代码能贴出来，马上给分。谢谢了。

[alj]

ShaLongBus(ShaLongBus)和 rfq(任凤泉)能否给出调用图像编码、解码的示例？

[alj]

还是不会用，能不能将调用的过程也示例一下，我实在不太懂！

[行云边]

Function Base64EncodeBinary(inData)
Base64EncodeBinary = Base64Encode(BinaryToString(inData))'BinaryToString 函数上面我已经贴过了
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

[Abyss-Xu]

帮顶一下

[行云边]

使用这个函数把二进制转化为 字符串
Private Function BinaryToString(ByVal i_arybyteSource As Variant) As String
Dim nLength As Integer
nLength = LenB(i_arybyteSource)

Dim sPart1 As String, sPart2 As String, sPart3 As String
sPart1 = ""
sPart2 = ""
sPart3 = ""

Dim i As Integer, nCount2 As Integer, nCount3 As Integer
nCount2 = 0
nCount3 = 0
For i = 1 To nLength
sPart3 = sPart3 & Chr(AscB(MidB(i_arybyteSource, i, 1)))
nCount3 = nCount3 + 1
If nCount3 > 400 Then ' Remove sPart3 to the tail of sPart2
sPart2 = sPart2 & sPart3
sPart3 = ""
nCount2 = nCount2 + 1
If nCount2 > 400 Then ' Remove sPart2 to the tail of sPart1
sPart1 = sPart1 & sPart2
sPart2 = ""
nCount2 = 0
End If
nCount3 = 0
End If
Next i

BinaryToString = sPart1 & sPart2 & sPart3
End Function

[行云边]

http://www.aspsimply.com/vb/MIMECode.aspx

一个dll

[行云边]

http://www.cryptosys.net/encode.html

[rfq]

Public Function BaseEnc(Text As String) As String
Dim a As Long, b As Long
Dim out As String, Pad As String, BasVal As String, bin As String
Dim decval As String, BinVal As String, sixBin As String
For a = 1 To Len(Text)
BinVal = CBase(Asc(Mid$(Text, a, 1)), 2)
BinVal = Format(BinVal, "0000000#")
bin = bin & BinVal
Next
For b = 1 To Len(bin) Step 6
bin = bin & String$(6 - Len(Mid$(bin, b, 6)), "0")
decval = Bin2Dec(Mid$(bin, b, 6))
BasVal = Mid$(Base64, decval + 1, 1)
out = out & BasVal
Next
If InStr(Len(Text) / 3, ".") Then
If Mid$(Len(Text) / 3, InStr(Len(Text) / 3, ".") + 1, 1) < 5 Then Pad = "==" Else Pad = "="
End If
out = out & Pad
BaseEnc = out
End Function

Public Function BaseDec(Text As String) As String
Dim decval As Long, a As Long, b As Long
Dim BinVal As String, bin As String, out As String
For a = 1 To Len(Text)
decval = InStr(Base64, Mid$(Text, a, 1)) - 1
If decval <> "-1" Then
BinVal = CBase(decval, 2)
bin = bin & Format(BinVal, "00000#")
End If
Next
For b = 1 To Len(bin) Step 8
BinVal = Mid$(bin, b, 8)
decval = Bin2Dec(BinVal)
out = out & Chr(decval)
Next
BaseDec = out
End Function

[ShaLongBus]

Public Function Base64Enc(s$) As String
Static Enc() As Byte
Dim b() As Byte, Out() As Byte, i&, j&, L&
If (Not Val(Not Enc)) = 0 Then 'Null-Ptr = not initialized
Enc = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
End If
L = Len(s): b = StrConv(s, vbFromUnicode)
ReDim Preserve b(0 To (UBound(b) \ 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(b) \ 3) * 4 + 3)
For i = 0 To UBound(b) - 1 Step 3
Out(j) = Enc(b(i) \ 4): j = j + 1
Out(j) = Enc((b(i + 1) \ 16) Or (b(i) And 3) * 16): j = j + 1
Out(j) = Enc((b(i + 2) \ 64) Or (b(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(b(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Enc = StrConv(Out, vbUnicode)
End Function

Public Function Base64Dec(Base64String As String) As String
Static Enc() As Byte
Dim b() As Byte, Out() As Byte, i&, j&, L&, Dec(0 To 255) As Byte
If (Not Val(Not Enc)) = 0 Then 'Null-Ptr = not initialized
Enc = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
End If
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(Base64String): b = StrConv(Base64String, vbFromUnicode)
ReDim Preserve Out(0 To (L \ 4) * 3 - 1)
For i = 0 To UBound(b) Step 4
Out(j) = (Dec(b(i)) * 4) Or (Dec(b(i + 1)) \ 16): j = j + 1
Out(j) = (Dec(b(i + 1)) And 15) * 16 Or (Dec(b(i + 2)) \ 4): j = j + 1
Out(j) = (Dec(b(i + 2)) And 3) * 64 Or Dec(b(i + 3)): j = j + 1
Next i
If b(L - 2) = 61 Then j = 2 Else If b(L - 1) = 61 Then j = 1 Else j = 0
ReDim Preserve Out(0 To UBound(Out) - j)
Base64Dec = StrConv(Out, vbUnicode)
End Function

[alj]

这么块就有这么多人跟贴，太感谢CSDN上的兄弟们了，
我测试完之后再给分，非常感谢。

[hwshws123]

关注。。。。。