Visual Basic Base64编码源码:可实现对字符串(中文)和二进制文件编码
来源:互联网 发布:fragment之间传递数据 编辑:程序博客网 时间:2024/05/16 12:38
此文系转载自Aljcn的博客(http://www.cnblogs.com/aljcn/archive/2005/05/25/162013.html),此文解决了我花了很长时间没有解决的一个技术难题。在此表示衷心的感谢!
本模块需要添加Scriping.runtime引用.
Option Explicit
Private Const BASE64CHR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Private psBase64Chr(0 To 63) As String
'从一个经过Base64的字符串中解码到源字符串
Public Function DecodeBase64String(str2Decode As String) As String
DecodeBase64String = StrConv(DecodeBase64Byte(str2Decode), vbUnicode)
End Function
'从一个经过Base64的字符串中解码到源字节数组
Public Function DecodeBase64Byte(str2Decode As String) As Byte()
Dim lPtr As Long
Dim iValue As Integer
Dim iLen As Integer
Dim iCtr As Integer
Dim Bits(1 To 4) As Byte
Dim strDecode As String
Dim str As String
Dim Output() As Byte
Dim iIndex As Long
Dim lFrom As Long
Dim lTo As Long
InitBase
'//除去回车
str = Replace(str2Decode, vbCrLf, "")
'//每4个字符一组(4个字符表示3个字)
For lPtr = 1 To Len(str) Step 4
iLen = 4
For iCtr = 0 To 3
'//查找字符在BASE64字符串中的位置
iValue = InStr(1, BASE64CHR, Mid$(str, lPtr + iCtr, 1), vbBinaryCompare)
Select Case iValue 'A~Za~z0~9+/
Case 1 To 64:
Bits(iCtr + 1) = iValue - 1
Case 65 '=
iLen = iCtr
Exit For
'//没有发现
Case 0: Exit Function
End Select
Next
'//转换4个6比特数成为3个8比特数
Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) / &H10
Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) / &H4
Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)
'//计算数组的起始位置
lFrom = lTo
lTo = lTo + (iLen - 1) - 1
'//重新定义输出数组
ReDim Preserve Output(0 To lTo)
For iIndex = lFrom To lTo
Output(iIndex) = Bits(iIndex - lFrom + 1)
Next
lTo = lTo + 1
Next
DecodeBase64Byte = Output
End Function
'将一个Base64字符串解码,并写入二进制文件
Public Sub DecodeBase64StringToFile(strBase64 As String, strFilePath As String)
Dim fso As New Scripting.FileSystemObject, _
i As Long
If fso.FileExists(strFilePath) Then
fso.DeleteFile strFilePath, True
End If
i = FreeFile
Open strFilePath For Binary Access Write As i
Put i, , DecodeBase64Byte(strBase64)
Close i
Set fso = Nothing
End Sub
'将一个Base64编码文件解码,并写入二进制文件
Public Sub DecodeBase64FileToFile(strBase64FilePath As String, strFilePath As String)
Dim fso As New Scripting.FileSystemObject
Dim ts As TextStream
If Not fso.FileExists(strBase64FilePath) Then Exit Sub
Set ts = fso.OpenTextFile(strBase64FilePath)
DecodeBase64StringToFile ts.ReadAll, strFilePath
End Sub
'将一个字节数组进行Base64编码,并返回字符串
Public Function EncodeBase64Byte(sValue() As Byte) As String
Dim lCtr As Long
Dim lPtr As Long
Dim lLen As Long
Dim sEncoded As String
Dim Bits8(1 To 3) As Byte
Dim Bits6(1 To 4) As Byte
Dim i As Integer
InitBase
For lCtr = 1 To UBound(sValue) + 1 Step 3
For i = 1 To 3
If lCtr + i - 2 <= UBound(sValue) Then
Bits8(i) = sValue(lCtr + i - 2)
lLen = 3
Else
Bits8(i) = 0
lLen = lLen - 1
End If
Next
'//转换字符串为数组,然后转换为4个6位(0-63)
Bits6(1) = (Bits8(1) And &HFC) / 4
Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) / &H10
Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) / &H40
Bits6(4) = Bits8(3) And &H3F
'//添加4个新字符
For lPtr = 1 To lLen + 1
sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
Next
Next
'//不足4位,以=填充
Select Case lLen + 1
Case 2: sEncoded = sEncoded & "=="
Case 3: sEncoded = sEncoded & "="
Case 4:
End Select
EncodeBase64Byte = sEncoded
End Function
'对字符串进行Base64编码并返回字符串
Public Function EncodeBase64String(str2Encode As String) As String
Dim sValue() As Byte
sValue = StrConv(str2Encode, vbFromUnicode)
EncodeBase64String = EncodeBase64Byte(sValue)
End Function
'对文件进行Base64编码并返回编码后的Base64字符串
Public Function EncodFileToBase64String(strFileSource As String)
Dim lpdata() As Byte, _
i As Long, _
n As Long, _
fso As New Scripting.FileSystemObject
If Not fso.FileExists(strFileSource) Then Exit Function
i = FreeFile
Open strFileSource For Binary Access Read Lock Write As i
n = LOF(i) - 1
ReDim lpdata(0 To n)
Get i, , lpdata
Close i
EncodFileToBase64String = EncodeBase64Byte(lpdata)
End Function
'对文件进行Base64编码,并将编码后的内容直接写入一个文本文件中
Public Sub EncodFileToBase64File(strFileSource As String, strFileBase64Desti As String)
Dim fso As New FileSystemObject, _
ts As TextStream
Set ts = fso.CreateTextFile(strFileBase64Desti, True)
ts.Write (EncodFileToBase64String(strFileSource))
ts.Close
Set ts = Nothing
Set fso = Nothing
End Sub
Private Sub InitBase()
Dim iPtr As Integer
'初始化 BASE64数组
For iPtr = 0 To 63
psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)
Next
End Sub
Private Const BASE64CHR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Private psBase64Chr(0 To 63) As String
'从一个经过Base64的字符串中解码到源字符串
Public Function DecodeBase64String(str2Decode As String) As String
DecodeBase64String = StrConv(DecodeBase64Byte(str2Decode), vbUnicode)
End Function
'从一个经过Base64的字符串中解码到源字节数组
Public Function DecodeBase64Byte(str2Decode As String) As Byte()
Dim lPtr As Long
Dim iValue As Integer
Dim iLen As Integer
Dim iCtr As Integer
Dim Bits(1 To 4) As Byte
Dim strDecode As String
Dim str As String
Dim Output() As Byte
Dim iIndex As Long
Dim lFrom As Long
Dim lTo As Long
InitBase
'//除去回车
str = Replace(str2Decode, vbCrLf, "")
'//每4个字符一组(4个字符表示3个字)
For lPtr = 1 To Len(str) Step 4
iLen = 4
For iCtr = 0 To 3
'//查找字符在BASE64字符串中的位置
iValue = InStr(1, BASE64CHR, Mid$(str, lPtr + iCtr, 1), vbBinaryCompare)
Select Case iValue 'A~Za~z0~9+/
Case 1 To 64:
Bits(iCtr + 1) = iValue - 1
Case 65 '=
iLen = iCtr
Exit For
'//没有发现
Case 0: Exit Function
End Select
Next
'//转换4个6比特数成为3个8比特数
Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) / &H10
Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) / &H4
Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)
'//计算数组的起始位置
lFrom = lTo
lTo = lTo + (iLen - 1) - 1
'//重新定义输出数组
ReDim Preserve Output(0 To lTo)
For iIndex = lFrom To lTo
Output(iIndex) = Bits(iIndex - lFrom + 1)
Next
lTo = lTo + 1
Next
DecodeBase64Byte = Output
End Function
'将一个Base64字符串解码,并写入二进制文件
Public Sub DecodeBase64StringToFile(strBase64 As String, strFilePath As String)
Dim fso As New Scripting.FileSystemObject, _
i As Long
If fso.FileExists(strFilePath) Then
fso.DeleteFile strFilePath, True
End If
i = FreeFile
Open strFilePath For Binary Access Write As i
Put i, , DecodeBase64Byte(strBase64)
Close i
Set fso = Nothing
End Sub
'将一个Base64编码文件解码,并写入二进制文件
Public Sub DecodeBase64FileToFile(strBase64FilePath As String, strFilePath As String)
Dim fso As New Scripting.FileSystemObject
Dim ts As TextStream
If Not fso.FileExists(strBase64FilePath) Then Exit Sub
Set ts = fso.OpenTextFile(strBase64FilePath)
DecodeBase64StringToFile ts.ReadAll, strFilePath
End Sub
'将一个字节数组进行Base64编码,并返回字符串
Public Function EncodeBase64Byte(sValue() As Byte) As String
Dim lCtr As Long
Dim lPtr As Long
Dim lLen As Long
Dim sEncoded As String
Dim Bits8(1 To 3) As Byte
Dim Bits6(1 To 4) As Byte
Dim i As Integer
InitBase
For lCtr = 1 To UBound(sValue) + 1 Step 3
For i = 1 To 3
If lCtr + i - 2 <= UBound(sValue) Then
Bits8(i) = sValue(lCtr + i - 2)
lLen = 3
Else
Bits8(i) = 0
lLen = lLen - 1
End If
Next
'//转换字符串为数组,然后转换为4个6位(0-63)
Bits6(1) = (Bits8(1) And &HFC) / 4
Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) / &H10
Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) / &H40
Bits6(4) = Bits8(3) And &H3F
'//添加4个新字符
For lPtr = 1 To lLen + 1
sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
Next
Next
'//不足4位,以=填充
Select Case lLen + 1
Case 2: sEncoded = sEncoded & "=="
Case 3: sEncoded = sEncoded & "="
Case 4:
End Select
EncodeBase64Byte = sEncoded
End Function
'对字符串进行Base64编码并返回字符串
Public Function EncodeBase64String(str2Encode As String) As String
Dim sValue() As Byte
sValue = StrConv(str2Encode, vbFromUnicode)
EncodeBase64String = EncodeBase64Byte(sValue)
End Function
'对文件进行Base64编码并返回编码后的Base64字符串
Public Function EncodFileToBase64String(strFileSource As String)
Dim lpdata() As Byte, _
i As Long, _
n As Long, _
fso As New Scripting.FileSystemObject
If Not fso.FileExists(strFileSource) Then Exit Function
i = FreeFile
Open strFileSource For Binary Access Read Lock Write As i
n = LOF(i) - 1
ReDim lpdata(0 To n)
Get i, , lpdata
Close i
EncodFileToBase64String = EncodeBase64Byte(lpdata)
End Function
'对文件进行Base64编码,并将编码后的内容直接写入一个文本文件中
Public Sub EncodFileToBase64File(strFileSource As String, strFileBase64Desti As String)
Dim fso As New FileSystemObject, _
ts As TextStream
Set ts = fso.CreateTextFile(strFileBase64Desti, True)
ts.Write (EncodFileToBase64String(strFileSource))
ts.Close
Set ts = Nothing
Set fso = Nothing
End Sub
Private Sub InitBase()
Dim iPtr As Integer
'初始化 BASE64数组
For iPtr = 0 To 63
psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)
Next
End Sub
- Visual Basic Base64编码源码:可实现对字符串(中文)和二进制文件编码
- Base64编码算法(Basic编码)之iharder算法源码解析
- Base64编码和解码字符串
- java中,对字符串进行base64编码和解码
- LoadRunner中,对字符串进行Base64编码
- 可对任意类型数据进行编码的Base64编解码源码
- Base64编码的原理及实现(源码)
- 使用JS对中文字符串进行utf-8的Base64编码,使其与Java编码相同的办法
- 使用JS对中文字符串进行utf-8的Base64编码,使其与Java编码相同的办法
- Base64编码实现(Java)
- MINA源码分析---base64编码和解码
- java base64编码源码
- Base64编码源码
- 字符串的编码Base64
- 字符串base64编码
- Base64编码实现(附 base64编码规则)
- 二进制文件和编码文件
- 【Python】二进制文件与Base64编码文本文件转换
- 软件开发中文档设计之我见
- 很好的一个免费空间
- 从HTML文件中抽取正文的简单方案
- google面试题
- InfoWorld宣布2007年度开源软件Bossie奖
- Visual Basic Base64编码源码:可实现对字符串(中文)和二进制文件编码
- 使用resin而不是tomcat进行vxml开发
- 学习笔记:什么是设计模式?
- 网站title与meta的写法与作用
- 参数session_cached_cursors的详细解释
- 中兴和华为的面试经历
- WPF 之Event
- 在ASP.NET 2.0中直接得到本页面生成的HTML代码
- ASP.NET 2.0中实现客户端回调的简化版