UID 1 精华 积分 76361 威望 点
宅币 个
贡献 次
宅之契约 份
最后登录 1970-1-1
在线时间 小时
Base64的编码方式很简单，每3个8-bit字节转换为4个6-bit字节来存储，而每个6 bit字节都转换为64个可打印字符。字符表如下。值 字符 值 字符 值 字符 值 字符 0 A 17 R 34 i 51 z 1 B 18 S 35 j 52 0 2 C 19 T 36 k 53 1 3 D 20 U 37 l 54 2 4 E 21 V 38 m 55 3 5 F 22 W 39 n 56 4 6 G 23 X 40 o 57 5 7 H 24 Y 41 p 58 6 8 I 25 Z 42 q 59 7 9 J 26 a 43 r 60 8 10 K 27 b 44 s 61 9 11 L 28 c 45 t 62 + 12 M 29 d 46 u 63 / 13 N 30 e 47 v 14 O 31 f 48 w 15 P 32 g 49 x 16 Q 33 h 50 y
VERSION 5.00 Begin VB.Form frmMain Caption = "Base64" ClientHeight = 5190 ClientLeft = 120 ClientTop = 450 ClientWidth = 8340 LinkTopic = "Form1" ScaleHeight = 346 ScaleMode = 3 'Pixel ScaleWidth = 556 StartUpPosition = 3 '窗口缺省 Begin VB.PictureBox picCenterBar Align = 3 'Align Left BorderStyle = 0 'None Height = 5190 Left = 3135 MousePointer = 9 'Size W E ScaleHeight = 346 ScaleMode = 3 'Pixel ScaleWidth = 8 TabIndex = 4 Top = 0 Width = 120 End Begin VB.PictureBox picBase64 Align = 3 'Align Left BorderStyle = 0 'None Height = 5190 Left = 3255 ScaleHeight = 346 ScaleMode = 3 'Pixel ScaleWidth = 232 TabIndex = 2 Top = 0 Width = 3480 Begin VB.TextBox txtBase64 Height = 2775 Left = 0 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 6 Top = 240 Width = 2655 End Begin VB.Label lblBase64 AutoSize = -1 'True Caption = "Base64编码：" Height = 180 Left = 0 TabIndex = 3 Top = 0 Width = 1080 End End Begin VB.PictureBox picSrc Align = 3 'Align Left BorderStyle = 0 'None Height = 5190 Left = 0 ScaleHeight = 346 ScaleMode = 3 'Pixel ScaleWidth = 209 TabIndex = 0 Top = 0 Width = 3135 Begin VB.TextBox txtSrc Height = 2895 Left = 0 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 5 Top = 240 Width = 3135 End Begin VB.Label lblSrc AutoSize = -1 'True Caption = "原始信息：" Height = 180 Left = 0 TabIndex = 1 Top = 0 Width = 900 End End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '字符串用UTF-8编码 Private Const CP_UTF8 = 65001 Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpWideCharStr As Any, ByVal cchWideChar As Long) As Long Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpDefaultChar As Any, ByVal lpUsedDefaultChar As Long) As Long Dim SW!, SH! '窗口宽度和高度 Dim IsManagedChange As Boolean '确定是不是程序自身修改了文本框。防止循环修改。 '将字符串转换为UTF-8编码的字节数组 Sub StringToUTF8Bytes(Src As String, UTF8Bytes() As Byte) '先计算需求字节数 Dim BytesRequired As Long BytesRequired = WideCharToMultiByte(CP_UTF8, 0, ByVal StrPtr(Src), Len(Src), ByVal 0, 0, ByVal 0, ByVal 0) '然后转换 ReDim UTF8Bytes(BytesRequired - 1) WideCharToMultiByte CP_UTF8, 0, ByVal StrPtr(Src), Len(Src), UTF8Bytes(0), BytesRequired, ByVal 0, ByVal 0 End Sub '将UTF-8编码的字节数组转换为字符串 Function UTF8BytesToString(UTF8Bytes() As Byte) As String '先计算需求字节数 Dim BytesRequired As Long BytesRequired = MultiByteToWideChar(CP_UTF8, 0, UTF8Bytes(0), UBound(UTF8Bytes) + 1, ByVal 0, 0) '然后转换 UTF8BytesToString = String(BytesRequired, 0) MultiByteToWideChar CP_UTF8, 0, UTF8Bytes(0), UBound(UTF8Bytes) + 1, ByVal StrPtr(UTF8BytesToString), BytesRequired End Function '将6-bit字节转换为Base64字符 Function EncBase64Char(ByVal Value As Byte) As Byte If Value < 26 Then '26个大写英文字母 EncBase64Char = Value + &H41 ElseIf Value < 52 Then '26个小写英文字母 EncBase64Char = Value + &H61 - 26 ElseIf Value < 62 Then '10个数字 EncBase64Char = Value + &H30 - 52 ElseIf Value = 62 Then EncBase64Char = &H2B '+ Else EncBase64Char = &H2F '/ End If End Function '将Base64字符转换为6 bit字节 Function DecBase64Char(ByVal Value As Byte) As Byte If Value >= &H41 And Value <= &H5A Then DecBase64Char = Value - &H41 ElseIf Value >= &H61 And Value <= &H7A Then DecBase64Char = Value - &H61 + 26 ElseIf Value >= &H30 And Value <= &H39 Then DecBase64Char = Value - &H30 + 52 ElseIf Value = &H2B Then DecBase64Char = 62 ElseIf Value = &H2F Then DecBase64Char = 63 End If End Function '进行Base64编码，返回Base64的字符串 Function Encode(Src As String) As String On Error GoTo ErrHandler If Len(Src) = 0 Then Exit Function '原始内容 Dim SrcBytes() As Byte, SrcLen As Long StringToUTF8Bytes Src, SrcBytes '先将原文以UTF-8的方式编码 SrcLen = UBound(SrcBytes) + 1 '编码后的内容 Dim DestBytes() As Byte, DestLen As Long DestLen = SrcLen + ((SrcLen - 1) \ 3 + 1) ReDim DestBytes(DestLen - 1) '将8-bit字节数组转换为6-bit字节数组 Dim I&, J&, Bit& For I = 0 To SrcLen - 1 If Bit = 0 Then 'DestBytes(J)未被写入 DestBytes(J) = (SrcBytes(I) And &HFC) \ &H4 J = J + 1 DestBytes(J) = (SrcBytes(I) And &H3) * &H10 Bit = 2 '234567 'NNNN01 'N:Next byte ElseIf Bit = 2 Then 'DestBytes(J)已被写入两位 DestBytes(J) = DestBytes(J) Or ((SrcBytes(I) And &HF0) \ &H10) J = J + 1 DestBytes(J) = (SrcBytes(I) And &HF) * &H4 Bit = 4 '4567PP 'P:Prev byte 'NN0123 'N:Next byte ElseIf Bit = 4 Then 'DestBytes(J)已被写入四位 DestBytes(J) = DestBytes(J) Or ((SrcBytes(I) And &HC0) / &H40) J = J + 1 DestBytes(J) = SrcBytes(I) And &H3F J = J + 1 Bit = 0 '67PPPP 'P:Prev byte '012345 End If Next For I = 0 To DestLen - 1 DestBytes(I) = EncBase64Char(DestBytes(I)) '转换为Base64字符 Next Encode = StrConv(DestBytes, vbUnicode) & String(2 - (SrcLen - 1) Mod 3, "=") '原文剩余内容不足3个字节需要补齐 Exit Function '出错返回错误描述。 ErrHandler: Encode = Err.Description End Function '将Base64的字符串解码为原文。 Function Decode(Src As String) As String On Error GoTo ErrHandler If Len(Src) = 0 Then Exit Function '编码后的内容 Dim SrcBytes() As Byte, SrcLen As Long SrcBytes = StrConv(Src, vbFromUnicode) SrcLen = UBound(SrcBytes) + 1 '原始内容 Dim DestBytes() As Byte, DestLen As Long DestLen = SrcLen - SrcLen \ 4 ReDim DestBytes(DestLen - 1) Dim I&, J&, Bit& For J = 0 To SrcLen - 1 SrcBytes(J) = DecBase64Char(SrcBytes(J)) '从Base64字符转换为6-bit字节 Next '将6-bit字节数组转换为8-bit字节数组 For J = 0 To DestLen - 1 If Bit = 0 Then 'DestBytes(J)未被写入 DestBytes(J) = SrcBytes(I) * &H4 I = I + 1 If I > UBound(SrcBytes) Then Exit For DestBytes(J) = DestBytes(J) Or ((SrcBytes(I) And &H30) \ &H10) Bit = 2 ElseIf Bit = 2 Then 'DestBytes(J)已被写入两字节 DestBytes(J) = (SrcBytes(I) And &HF) * &H10 I = I + 1 If I > UBound(SrcBytes) Then Exit For DestBytes(J) = DestBytes(J) Or ((SrcBytes(I) And &H3C) \ &H4) Bit = 4 ElseIf Bit = 4 Then 'DestBytes(J)已被写入四字节 DestBytes(J) = (SrcBytes(I) And &H3) * &H40 I = I + 1 If I > UBound(SrcBytes) Then Exit For DestBytes(J) = DestBytes(J) Or SrcBytes(I) I = I + 1 If I > UBound(SrcBytes) Then Exit For Bit = 0 End If Next '最后将转换得到的UTF-8字符串转换为VB支持的Unicode字符串以便于显示。 Decode = UTF8BytesToString(DestBytes) Exit Function ErrHandler: Decode = Err.Description End Function Private Sub Form_Load() Form_Resize End Sub '窗口大小更改时，左右两个文本框的宽度比例保持不变。 Private Sub Form_Resize() On Error Resume Next SW = ScaleWidth SH = ScaleHeight Dim LWidth!, RWidth!, MWidth! LWidth = picSrc.Width RWidth = picBase64.Width MWidth = picCenterBar.Width picSrc.Width = (SW - MWidth) * LWidth / (LWidth + RWidth) picBase64.Width = (SW - MWidth) * RWidth / (LWidth + RWidth) End Sub '容器大小修改时，里面的文本框适应容器的尺寸。 Private Sub picSrc_Resize() On Error Resume Next txtSrc.Move 0, txtSrc.Top, picSrc.ScaleWidth, picSrc.ScaleHeight - txtSrc.Top End Sub Private Sub picBase64_Resize() On Error Resume Next txtBase64.Move 0, txtBase64.Top, picBase64.ScaleWidth, picBase64.ScaleHeight - txtBase64.Top End Sub '中间的分隔，可以用鼠标拖动。鼠标按下时变暗。 Private Sub picCenterBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) picCenterBar.BackColor = vbButtonShadow End Sub Private Sub picCenterBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next Static DragX! If Button And 1 Then '是否鼠标左键按下。 Dim NewWidth!, MWidth! MWidth = picCenterBar.Width NewWidth = picSrc.Width + (X - DragX) '限制拖动的范围。 If NewWidth < 1 Then NewWidth = 1 If NewWidth > SW - MWidth - 1 Then NewWidth = SW - MWidth - 1 '调整UI尺寸 picSrc.Width = NewWidth picBase64.Width = SW - MWidth - NewWidth Else DragX = X End If End Sub '拖动停止时变回原来的颜色。 Private Sub picCenterBar_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) picCenterBar.BackColor = vbButtonFace End Sub '修改文本框的时候。进行编码工作 Private Sub txtSrc_Change() If IsManagedChange Then IsManagedChange = False '防止循环修改 Else IsManagedChange = True txtBase64.Text = "" IsManagedChange = True txtBase64.SelText = Encode(txtSrc.Text) IsManagedChange = False End If End Sub '修改文本框的时候。进行解码工作 Private Sub txtBase64_Change() If IsManagedChange Then IsManagedChange = False '防止循环修改 Else IsManagedChange = True txtSrc.Text = "" IsManagedChange = True txtSrc.SelText = Decode(txtBase64.Text) IsManagedChange = False End If End Sub 复制代码
Base64编码转换.exe
(32 KB, 下载次数: 26)
Base64.7z
(9.79 KB, 下载次数: 49)
rfc2045.7z
(18.83 KB, 下载次数: 20)
|Archiver|小黑屋|技术宅的结界
( 滇ICP备16008837号 )|网站地图
发表于 2015-1-29 05:10:48
发表于 2016-10-2 20:57:50
居然让我坐了沙发？
