《VB-Base64.doc》由会员分享，可在线阅读，更多相关《VB-Base64.doc（5页珍藏版）》请在三一文库上搜索。
1、Private Sub about_Click()MsgBox "Made By Yida 2012-9-10"End SubPrivate Sub bug_Click()MsgBox ("1.打开文件时 会自动在末尾加一个换行符" + vbCrLf + "2.保存文件时 会自动在末尾加一个换行符" + vbCrLf + "3.对较大文件加解密时 速度较慢 容易死掉")End SubPrivate Sub deCrypt_Click()Dim data As Stringdata = Text1.TextCall
2、Base64_DeCrypt(data)Text2.Text = ""Text2.Text = dataText2.SetFocusEnd SubPrivate Sub enCrypt_Click()Dim data As Stringdata = Text1.TextCall Base64_EnCrypt(data)Text2.Text = ""Text2.Text = dataText2.SetFocusEnd SubPrivate Sub Form_Load()Dim test As Stringtest = "ABCDEFGHIJKLM
3、NOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="For i = 0 To 64Base64T(i) = Mid(test, i + 1, 1)Next iFor i = 0 To 64Text3.Text = Text3.Text & Base64T(i)Next iEnd SubPrivate Sub infile_Click()CDg1.ShowOpenOpen CDg1.FileName For Input As #1Do While Not EOF(1)Line Input #1, aText1.Text =
4、Text1.Text & a & vbCrLf推荐精选LoopClose #1End SubPrivate Sub outfile_Click()CDg1.ShowSaveOpen CDg1.FileName For Output As #1Print #1, Text2.TextClose #1End SubPrivate Sub table_Click()Dim test As Stringtest = Text3.TextFor i = 0 To 64Base64T(i) = Mid(test, i + 1, 1)Next iText3.Text = "&quo
5、t;For i = 0 To 64Text3.Text = Text3.Text & Base64T(i)Next iMsgBox "Success"End SubPrivate Sub Text1_GotFocus()Text1.SelStart = 0Text1.SelLength = Len(Text1.Text)End SubPrivate Sub Text2_GotFocus()Text2.SelStart = 0Text2.SelLength = Len(Text2.Text)End Sub推荐精选Public Base64T(0 To 64) As S
6、tringPublic Function Base64_EnCrypt(ByRef data As String)Dim dataH As StringDim data_3 As StringDim data_3_1 As StringDim data_3_2 As StringDim data_3_3 As StringDim data_3_4 As StringDim sign As IntegerDim out As StringFor j = 1 To Len(data) If Mid(data, j, 2) = vbCrLf Then dataH = dataH & &quo
7、t;0D0A" j = j + 1 Else dataH = dataH & Hex(Asc(Mid(data, j, 1) Debug.Print dataH End IfNext j Debug.Print dataHFor i = 1 To Len(dataH) Step 6 data_3 = Mid(dataH, i, 6) If Len(data_3) = 2 Then data_3 = data_3 & "0000" sign = 2ElseIf Len(data_3) = 4 Then data_3 = data_3 & &q
8、uot;00" sign = 1End If Debug.Print data_3 data_3_1 = Base64T("&h" & data_3) And &HFC0000) 262144) Debug.Print data_3_1 data_3_2 = Base64T("&h" & data_3) And &H3F000) 4096) Debug.Print data_3_2 data_3_3 = Base64T("&h" & data_3) And &a
9、mp;HFC0) 64) Debug.Print data_3_3 data_3_4 = Base64T("&h" & data_3) And &H3F) Debug.Print data_3_4 out = out & data_3_1 & data_3_2 & data_3_3 & data_3_4Next iSelect Case sign推荐精选Case 2: out = Left(out, Len(out) - 2) & "="Case 1: out = Left(out, Len
10、(out) - 1) & "="End Selectdata = outEnd FunctionPublic Function Base64_DeCrypt(data As String)Dim out As StringDim data1 As IntegerDim data2 As IntegerDim data3 As IntegerDim data4 As IntegerDim hex1 As LongDim hex2 As LongDim hex3 As LongDim hex_all As StringFor i = 1 To Len(data) Ste
11、p 4 data1 = t(Mid(data, i, 1) data2 = t(Mid(data, i + 1, 1) data3 = t(Mid(data, i + 2, 1) data4 = t(Mid(data, i + 3, 1) If data4 = 64 Then data4 = 0 If data3 = 64 Then data3 = 0 hex1 = data1 * 4 + data2 16 hex2 = (data2 And &HF) * 16 + data3 4 hex3 = (data3 And &H3) * 64 + data4 Debug.Print
12、hex1 Debug.Print hex2 Debug.Print hex3 hex_all = hex_all & MyHex(hex1) & MyHex(hex2) & MyHex(hex3) Debug.Print hex_allNext i j = 1 Do While (j < Len(hex_all) If Mid(hex_all, j, 2) > "7E" Then Debug.Print Mid(hex_all, j, 2) out = out & Chr("&H" + Mid(hex_
13、all, j, 4) j = j + 4 Else Debug.Print Mid(hex_all, j, 2) out = out & Chr("&H" + Mid(hex_all, j, 2)推荐精选 j = j + 2 End If Loopdata = outEnd FunctionPublic Function MyHex(test As Long)If test = 13 ThenMyHex = "0D"ElseIf test = 10 ThenMyHex = "0A"ElseMyHex = Hex(test)End IfEnd FunctionPublic Function t(test As String)For i = 0 To 64 If test = Base64T(i) Then Exit ForNext it = iEnd Function （注：可编辑下载，若有不当之处，请指正，谢谢!） 推荐精选