怎样用对一个文件进行base64编码?谢了,最好有源码!

shm0718a 2003-08-18 06:06:46
我在网上看到都是对字付串进行base64编码,有人知道怎样对一个文件进行编码?多谢了!
...全文
224 19 打赏 收藏 转发到动态 举报
写回复
用AI写文章
19 条回复
切换为时间正序
请发表友善的回复…
发表回复
shm0718a 2003-08-26
  • 打赏
  • 举报
回复
to calmzeal(杨柳风):
我改了:
For j = 1 To n Step 3
这里改成 For j = 0 To n-1 Step 3
但也不行啊,还是少一个字节,当然图片也看不到,而且这图片的文件名也改了,怎么回事啊?
想不通啊!




test7979 2003-08-22
  • 打赏
  • 举报
回复
最好的说明在此 :)

请看RFC2045中关于Base64编码一节
shm0718a 2003-08-22
  • 打赏
  • 举报
回复
有个问题:将一张图片编码后发出去,然后用outlook 接收,看到的还是经过编码后的字符
请高手指点一二,谢了
calmzeal 2003-08-22
  • 打赏
  • 举报
回复
看到的还是经过编码后的字符
是base64码?
那是你邮件格式的问题
如果是乱码照上面改应该就ok了
calmzeal 2003-08-22
  • 打赏
  • 举报
回复
ReDim a(1 To num) As Byte

For j = 1 To n Step 3
这里改成 For j = 0 To n-1 Step 3
calmzeal 2003-08-22
  • 打赏
  • 举报
回复
你再看看邮件的mime编码
主体和福建要用boundery分开
ps:Cooly兄的代码测试时好像第一个字节丢失了
hxy2003 2003-08-21
  • 打赏
  • 举报
回复
UP...
flxa 2003-08-21
  • 打赏
  • 举报
回复
up
shm0718a 2003-08-21
  • 打赏
  • 举报
回复
上面这代码是Cooly(给我一个开心的理由!),多谢他!这个问题解决后结帐
shm0718a 2003-08-21
  • 打赏
  • 举报
回复
Private Function Base64_EncodeBin(byteSource) As String
Dim BASE64_TABLE(1 To 64) As Byte '用Byte数组保存编码表,可以省掉计算Asc值这一步
Dim j As Double
Dim m As Double
Dim n As Double
Dim num As Double
Dim intPos As Double
Dim BASE64_STR As String
Dim a() As Byte

BASE64_STR = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

For j = 1 To 64
BASE64_TABLE(j) = Asc(Mid(BASE64_STR, j, 1))
Next

n = (UBound(byteSource) - UBound(byteSource) Mod 3)
num = (n \ 3) * 4

m = 0
intPos = 0

ReDim a(1 To num) As Byte

For j = 1 To n Step 3

m = m + 1
a(m) = BASE64_TABLE((byteSource(j) \ 4) + 1)

m = m + 1
a(m) = BASE64_TABLE(((byteSource(j) Mod 4) * 16 + byteSource(j + 1) \ 16) + 1)

m = m + 1
a(m) = BASE64_TABLE(((byteSource(j + 1) Mod 16) * 4 + byteSource(j + 2) \ 64) + 1)

m = m + 1
a(m) = BASE64_TABLE((byteSource(j + 2) Mod 64) + 1)

intPos = intPos + 4

If (intPos Mod 76) = 0 Then
num = num + 2
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = Asc(vbCr)
m = m + 1
a(m) = Asc(vbLf)
End If

DoEvents

Next j

If Not (UBound(byteSource) Mod 3) = 0 Then
If (UBound(byteSource) Mod 3) = 2 Then
num = num + 4
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = BASE64_TABLE((byteSource(j) \ 4) + 1)
If m Mod 76 = 0 Then
num = num + 2
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = Asc(vbCr)
m = m + 1
a(m) = Asc(vbLf)
End If
m = m + 1
a(m) = BASE64_TABLE((byteSource(j) Mod 4) * 16 + byteSource(j + 1) \ 16 + 1)
If m Mod 76 = 0 Then
num = num + 2
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = Asc(vbCr)
m = m + 1
a(m) = Asc(vbLf)
End If
m = m + 1
a(m) = BASE64_TABLE((byteSource(j + 1) Mod 16) * 4 + 1)
If m Mod 76 = 0 Then
num = num + 2
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = Asc(vbCr)
m = m + 1
a(m) = Asc(vbLf)
End If
m = m + 1
a(m) = Asc("=")
ElseIf (UBound(byteSource) Mod 3) = 1 Then
num = num + 3
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = BASE64_TABLE(byteSource(j) \ 4 + 1)
If m Mod 76 = 0 Then
num = num + 2
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = Asc(vbCr)
m = m + 1
a(m) = Asc(vbLf)
End If
m = m + 1
a(m) = BASE64_TABLE((byteSource(j) Mod 4) * 16 + 1)
If m Mod 76 = 0 Then
num = num + 2
ReDim Preserve a(1 To num) As Byte
m = m + 1
a(m) = Asc(vbCr)
m = m + 1
a(m) = Asc(vbLf)
End If
m = m + 1
a(m) = Asc("==")
End If
End If
ReDim Preserve a(1 To m) As Byte '去掉有可能多出的空格

Base64_EncodeBin = StrConv(a, vbUnicode)

End Function

''======应用



Private Sub Command1_Click()
Dim b() As Byte
Dim resultstring As String
Open "d:\aa.jpg" For Binary Access Read As #1
ReDim b(LOF(1)) As Byte
Get #1, , b()
Close #1

resultstring = Base64_EncodeBin(b)
MsgBox resultstring
End Sub


这也有个问题:将一张图片编码后发出去,然后用outlook 接收,看到的还是经过编码后的字符,不知怎样还原,盼高手能指点一二,谢谢
calmzeal 2003-08-19
  • 打赏
  • 举报
回复
我拿图片测试时有问题
好像是Get #1, , b
a = a + Chr$(b)
有问题
你看看
搞好了通知我
calmzeal 2003-08-19
  • 打赏
  • 举报
回复
我目前的代码:(还有问题)


Public Sub Base64EncodeFile(strFile As String, txtOutput As String)
Dim intCount As Long
Dim strTemp As String
Dim lngMax As Long
Dim a As String
Dim b As Byte
lngMax = 0
txtOutput = ""
Open strFile For Binary As #1

Do While Not EOF(1)
Get #1, , b
a = a + Chr$(b)
Loop
Close #1
a = Mid$(a, 1, Len(a) - 1)'这里因为前面eof()多读了一个字节

For intCount = 1 To Len(a) Step 3
strTemp = Mid(a, intCount, 3)
txtOutput = txtOutput & Base64_Encode(strTemp)'Base64_Encode就用前面兄弟们给的
lngMax = lngMax + 4
If lngMax = 72 Then
lngMax = 0
txtOutput = txtOutput & vbCrLf '这里是在邮件里换行
End If
DoEvents
Next intCount
calmzeal 2003-08-19
  • 打赏
  • 举报
回复
呵呵
经过一个通宵
终于自己解决了~~
calmzeal 2003-08-19
  • 打赏
  • 举报
回复
gz
楼上的都是对字符串进行编码阿
那要是图片怎么办?
最好有代码演示
相信这也是楼主想要的
我也可以另开贴给分
现在还是人类 2003-08-19
  • 打赏
  • 举报
回复
老问题了:
http://expert.csdn.net/Expert/topic/1912/1912325.xml?temp=.3943292
shm0718a 2003-08-19
  • 打赏
  • 举报
回复
to : calmzeal(杨柳风)
我和你想的一样,如果是对一图片或是声音进行base64编码,不知怎样做了?
你是怎么解决的,能透露一点吗?谢谢
since1990 2003-08-18
  • 打赏
  • 举报
回复
帮你 up
onlineboy 2003-08-18
  • 打赏
  • 举报
回复
'Base64编码函数:Base64Encode
'Instr1 编码前字符串
'Outstr1 编码后字符串
Public Function Base64Encode(InStr1 As String, OutStr1 As String)
Dim mInByte(3) As Byte, mOutByte(4) As Byte
Dim myByte As Byte
Dim i As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray) + 1
For i = 0 To LenArray Step 3
If LenArray - i = 0 Then
Exit For
End If
If LenArray - i = 2 Then
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
Base64EncodeByte mInByte, mOutByte, 2
ElseIf LenArray - i = 1 Then
mInByte(0) = myBArray(i)
Base64EncodeByte mInByte, mOutByte, 1
Else
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
mInByte(2) = myBArray(i + 2)
Base64EncodeByte mInByte, mOutByte, 3
End If
For j = 0 To 3
OutStr1 = OutStr1 & Chr(mOutByte(j))
Next j
Next i
End Function


Private Sub Base64EncodeByte(mInByte() As Byte, mOutByte() As Byte, Num As Integer)
Dim tByte As Byte
Dim i As Integer
If Num = 1 Then
mInByte(1) = 0
mInByte(2) = 0
ElseIf Num = 2 Then
mInByte(2) = 0
End If
tByte = mInByte(0) And &HFC
mOutByte(0) = tByte / 4
tByte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tByte
tByte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tByte
tByte = (mInByte(2) And &H3F)
mOutByte(3) = tByte
For i = 0 To 3
If mOutByte(i) >= 0 And mOutByte(i) <= 25 Then
mOutByte(i) = mOutByte(i) + Asc("A")
ElseIf mOutByte(i) >= 26 And mOutByte(i) <= 51 Then
mOutByte(i) = mOutByte(i) - 26 + Asc("a")
ElseIf mOutByte(i) >= 52 And mOutByte(i) <= 61 Then
mOutByte(i) = mOutByte(i) - 52 + Asc("0")
ElseIf mOutByte(i) = 62 Then
mOutByte(i) = Asc("+")
Else
mOutByte(i) = Asc("/")
End If
Next i
If Num = 1 Then
mOutByte(2) = Asc("=")
mOutByte(3) = Asc("=")
ElseIf Num = 2 Then
mOutByte(3) = Asc("=")
End If
End Sub

shawls 2003-08-18
  • 打赏
  • 举报
回复
use Base64DecodeByte & Base64EncodeByte


[名称] Enc-Base64位加密程序源代码

[数据来源] dxymm-csdn

[内容简介]
Enc-Base64位加密程序包括源代码(支持中文和特殊符号)
作  者:dxymm
所属论坛:Visual Basic

[源代码内容]

创建一个新类,即可调用该类的加密和解密方法
Option Explicit

'Base64编码函数:Base64Encode
'Instr1 编码前字符串
'Outstr1 编码后字符串
Public Function Base64Encode(InStr1 As String) As String
Dim mInByte(3) As Byte, mOutByte(4) As Byte
Dim myByte As Byte
Dim i As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
Dim OutStr1 As String

myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray) + 1
For i = 0 To LenArray Step 3
If LenArray - i = 0 Then
Exit For
End If
If LenArray - i = 2 Then
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
Base64EncodeByte mInByte, mOutByte, 2
ElseIf LenArray - i = 1 Then
mInByte(0) = myBArray(i)
Base64EncodeByte mInByte, mOutByte, 1
Else
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
mInByte(2) = myBArray(i + 2)
Base64EncodeByte mInByte, mOutByte, 3
End If
For j = 0 To 3
OutStr1 = OutStr1 & Chr(mOutByte(j))
Next j
Next i
Base64Encode = OutStr1
End Function

Private Sub Base64EncodeByte(mInByte() As Byte, mOutByte() As Byte, Num As Integer)
Dim tByte As Byte
Dim i As Integer

If Num = 1 Then
mInByte(1) = 0
mInByte(2) = 0
ElseIf Num = 2 Then
mInByte(2) = 0
End If
tByte = mInByte(0) And &HFC
mOutByte(0) = tByte / 4
tByte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tByte
tByte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tByte
tByte = (mInByte(2) And &H3F)
mOutByte(3) = tByte
For i = 0 To 3
If mOutByte(i) >= 0 And mOutByte(i) <= 25 Then
mOutByte(i) = mOutByte(i) + Asc("A")
ElseIf mOutByte(i) >= 26 And mOutByte(i) <= 51 Then
mOutByte(i) = mOutByte(i) - 26 + Asc("a")
ElseIf mOutByte(i) >= 52 And mOutByte(i) <= 61 Then
mOutByte(i) = mOutByte(i) - 52 + Asc("0")
ElseIf mOutByte(i) = 62 Then
mOutByte(i) = Asc("+")
Else
mOutByte(i) = Asc("/")
End If
Next i
If Num = 1 Then
mOutByte(2) = Asc("=")
mOutByte(3) = Asc("=")
ElseIf Num = 2 Then
mOutByte(3) = Asc("=")
End If
End Sub

Public Function Base64Decode(InStr1 As String) As String
Dim mInByte(4) As Byte, mOutByte(3) As Byte
Dim i As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
Dim OutStr1 As String
Dim tmpArray() As Byte

myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray)
ReDim tmpArray(((LenArray + 1) / 4) * 3)
j = 0

For i = 0 To LenArray Step 4
If LenArray - i = 0 Then
Exit For
Else
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)



mInByte(2) = myBArray(i + 2)
mInByte(3) = myBArray(i + 3)
Base64DecodeByte mInByte, mOutByte, 4
End If
tmpArray(j * 3) = mOutByte(0)
tmpArray(j * 3 + 1) = mOutByte(1)
tmpArray(j * 3 + 2) = mOutByte(2)
j = j + 1
Next i
Base64Decode = BinaryToString(tmpArray)
End Function

Private Sub Base64DecodeByte(mInByte() As Byte, mOutByte() As Byte, ByteNum As Integer)
Dim tByte As Byte
Dim i As Integer
ByteNum = 0
For i = 0 To 3
If mInByte(i) >= Asc("A") And mInByte(i) <= Asc("Z") Then
mInByte(i) = mInByte(i) - Asc("A")
ElseIf mInByte(i) >= Asc("a") And mInByte(i) <= Asc("z") Then
mInByte(i) = mInByte(i) - Asc("a") + 26
ElseIf mInByte(i) >= Asc("0") And mInByte(i) <= Asc("9") Then
mInByte(i) = mInByte(i) - Asc("0") + 52
ElseIf mInByte(i) = Asc("+") Then
mInByte(i) = 62
ElseIf mInByte(i) = Asc("/") Then
mInByte(i) = 63
Else '"="
ByteNum = ByteNum + 1
mInByte(i) = 0
End If
Next i
'取前六位
tByte = (mInByte(0) And &H3F) * 4 + (mInByte(1) And &H30) / 16
'0的六位和1的前两位
mOutByte(0) = tByte
tByte = (mInByte(1) And &HF) * 16 + (mInByte(2) And &H3C) / 4
'1的后四位和2的前四位
mOutByte(1) = tByte
tByte = (mInByte(2) And &H3) * 64 + (mInByte(3) And &H3F)
mOutByte(2) = tByte
'2的后两位和3的六位
End Sub
Private Function BinaryToString(ByVal BinaryStr As Variant) As String '二进制转换为字符串
Dim lnglen As Long
Dim tmpBin As Variant
Dim strC As String
Dim skipflag As Long
Dim i As Long
skipflag = 0
strC = ""

If Not IsNull(BinaryStr) Then
lnglen = LenB(BinaryStr)
For i = 1 To lnglen
If skipflag = 0 Then
tmpBin = MidB(BinaryStr, i, 1)
If AscB(tmpBin) > 127 Then
strC = strC & Chr(AscW(MidB(BinaryStr, i + 1, 1) & tmpBin))
skipflag = 1
Else
strC = strC & Chr(AscB(tmpBin))
End If
Else
skipflag = 0
End If
Next
End If
BinaryToString = strC
End Function

Private Function StringToBinary(ByVal VarString As String) As Variant '字符串转成二进制
Dim strBin As Variant
Dim varchar As Variant
Dim varasc As Long
Dim varlow, varhigh
Dim i As Long
strBin = ""

For i = 1 To Len(VarString)
varchar = Mid(VarString, i, 1)
varasc = Asc(varchar)
If varasc < 0 Then
varasc = varasc + 65535
End If
If varasc > 255 Then
varlow = Left(Hex(Asc(varchar)), 2)
varhigh = Right(Hex(Asc(varchar)), 2)
strBin = strBin & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
Else
strBin = strBin & ChrB(AscB(varchar))
End If
Next
StringToBinary = strBin
End Function


7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧