一个我自己拼凑的Base64编码/解码模块

说是拼凑，因为核心代码是我下载来的，不是我自己写的。我只是把核心代码整改下外观，方便调用而已，惭愧。

 

 'Attribute VB_Name = "base64EN_DE" Option Explicit '' Public Function Encade64FileTOFile(SfileN As String, TfileN As String) As Boolean Dim ni As Long, nj As Long Dim nFileno1 As Integer 'Dim tmpdir As String Dim nFileno2 As Integer Dim bByte As Byte Dim sInp As String Dim nFilelen As Long Dim A(3) As Byte Dim B(4) As Byte Dim delayX As Integer 'Dim EnStr As String '---------------------------------------- On Error GoTo Errchk '----------------------------- nFileno1 = FreeFile Open TfileN For Output As #nFileno1 Close #nFileno1 '------------------ '------------------------------------------ nFileno1 = FreeFile Open SfileN For Binary As #nFileno1 nFileno2 = FreeFile Open TfileN For Binary As #nFileno2 '--------------------------------- nFilelen = LOF(nFileno1) If nFilelen = 0 Then GoTo Fail If nFilelen <= 3 Then If nFilelen Mod 3 = 1 Then Get #nFileno1, , A(1) B(1) = (Int(A(1) / 4) + 65) B(2) = ((A(1) Mod 4) * 16 + 65) B(3) = (61) B(4) = (61) Else If nFilelen Mod 3 = 2 Then Get #nFileno1, , A(1) Get #nFileno1, , A(2) B(1) = (Int(A(1) / 4) + 65) B(2) = ((A(1) Mod 4) * 16 + Int(A(2) / 16) + 65) B(3) = ((A(2) Mod 16) * 4 + 65 + 1) B(4) = (61) Else Get #nFileno1, , A(1) Get #nFileno1, , A(2) Get #nFileno1, , A(3) B(1) = (Int(A(1) / 4) + 65) B(2) = ((A(1) Mod 4) * 16 + Int(A(2) / 16) + 65) B(3) = ((A(2) Mod 16) * 4 + Int(A(3) / 64) + 65) B(4) = (A(3) Mod 64 + 65) End If End If For ni = 1 To 4 Step 1 If B(ni) > 90 And B(ni) <= 116 Then B(ni) = B(ni) + 6 Else If B(ni) > 116 And B(ni) <= 126 Then B(ni) = B(ni) - 69 Else If B(ni) = 127 Then B(ni) = 43 If B(ni) = 128 Then B(ni) = 47 End If End If Next ni Put #nFileno2, , B(1) Put #nFileno2, , B(2) Put #nFileno2, , B(3) Put #nFileno2, , B(4) Else nj = Int(nFilelen / 3) * 3 Do While Loc(nFileno1) < nj For ni = 1 To 3 Step 1 Get #nFileno1, , (A(ni)) Next ni B(1) = (Int(A(1) / 4) + 65) B(2) = ((A(1) Mod 4) * 16 + Int(A(2) / 16) + 65) B(3) = ((A(2) Mod 16) * 4 + Int(A(3) / 64) + 65) B(4) = (A(3) Mod 64 + 65) For ni = 1 To 4 Step 1 If B(ni) > 90 And B(ni) <= 116 Then B(ni) = B(ni) + 6 Else If B(ni) > 116 And B(ni) <= 126 Then B(ni) = B(ni) - 69 Else If B(ni) = 127 Then B(ni) = 43 If B(ni) = 128 Then B(ni) = 47 End If End If Next ni Put #nFileno2, , B(1) Put #nFileno2, , B(2) Put #nFileno2, , B(3) Put #nFileno2, , B(4) If Int((Loc(nFileno2) + 2) / 78) = (Loc(nFileno2) + 2) / 78 Then Put #nFileno2, , vbCrLf End If delayX = delayX + 1 If delayX > 500 Then DoEvents delayX = 0 End If Loop If nFilelen Mod 3 = 1 Then Get #nFileno1, , A(1) B(1) = (Int(A(1) / 4) + 65) B(2) = ((A(1) Mod 4) * 16 + 65) If nFilelen = 4 Then B(2) = B(2) + 3 B(3) = (61) B(4) = (61) For ni = 1 To 4 Step 1 If B(ni) > 90 And B(ni) <= 116 Then B(ni) = B(ni) + 6 Else If B(ni) > 116 And B(ni) <= 126 Then B(ni) = B(ni) - 69 Else If B(ni) = 127 Then B(ni) = 43 If B(ni) = 128 Then B(ni) = 47 End If End If Next ni Put #nFileno2, , B(1) Put #nFileno2, , B(2) Put #nFileno2, , B(3) Put #nFileno2, , B(4) If Int((Loc(nFileno2) + 2) / 78) = (Loc(nFileno2) + 2) / 78 Then Put #nFileno2, , vbCrLf End If Else If nFilelen Mod 3 = 2 Then Get #nFileno1, , A(1) Get #nFileno1, , A(2) B(1) = (Int(A(1) / 4) + 65) B(2) = ((A(1) Mod 4) * 16 + Int(A(2) / 16) + 65) B(3) = ((A(2) Mod 16) * 4 + 65) If nFilelen = 8 Then B(3) = B(3) + 1 B(4) = (61) For ni = 1 To 4 Step 1 If B(ni) > 90 And B(ni) <= 116 Then B(ni) = B(ni) + 6 Else If B(ni) > 116 And B(ni) <= 126 Then B(ni) = B(ni) - 69 Else If B(ni) = 127 Then B(ni) = 43 If B(ni) = 128 Then B(ni) = 47 End If End If Next ni Put #nFileno2, , B(1) Put #nFileno2, , B(2) Put #nFileno2, , B(3) Put #nFileno2, , B(4) If Int((Loc(nFileno2) + 2) / 78) = (Loc(nFileno2) + 2) / 78 Then Put #nFileno2, , vbCrLf End If End If End If End If 'MsgBox Str(nFilelen), vbOKOnly 'MsgBox Str(Loc(nFileno1)), vbOKOnly Close #nFileno1 Close #nFileno2 '-------------------------------------- ' nFileno1 = FreeFile ' Open tmpdir + "BBASE64.TMP" For Input As #nFileno1 ' Input #nFileno1, EnStr ' Close #nFileno1 ' Encode64 = EnStr Encade64FileTOFile = True EndEn64: Exit Function Errchk: MsgBox "发生错误，编码失败！" & err.Number & "." & err.Description & "." & err.Source, vbCritical, "错误" Encade64FileTOFile = False Close #nFileno1 Close #nFileno2 Resume EndEn64 Fail: MsgBox "源文件尺寸为零，无法继续转换！", vbCritical, "错误" ' MsgBox "发生错误，编码失败！" & err.Number & "." & err.Description & "." & err.Source, vbCritical, "错误" Encade64FileTOFile = False Close #nFileno1 Close #nFileno2 'Encode64 = "" End Function '' Public Function Decode64_filetofile(SfileN As String, TfileN As String) As Boolean Dim nFileno1 As Integer Dim nFileno2 As Integer Dim bByte As Byte Dim sInp1 As Byte Dim sInp2 As Byte Dim nFilelen As Long Dim A(3) As Byte Dim B(4) As Byte Dim ni As Integer Dim tmpdir As String Dim EnStr As String ', nj As Integer Dim delayX As Integer 'Dim Infomation As String '11 'Infomation = "From: < [email protected]> " + Chr(13) + Chr(10) + "To: < [email protected]> " + Chr(13) + Chr(10) + "Cc: " + Chr(13) + Chr(10) + "Subject: Test" + Chr(13) + Chr(10) + "Date: Wed,21 Feb 2001 20:00:00" + Chr(13) + Chr(10) On Error GoTo err '------------------------------------ nFileno1 = FreeFile Open TfileN For Output As #nFileno1 Close #nFileno1 '------------------ '------------------------------------ ' nFileno1 = FreeFile ' Open SfileN For Binary Lock Read Write As #nFileno1 ' Put #nFileno1, , InstrS ' Close #nFileno1 '----------------------------------- nFileno1 = FreeFile Open SfileN For Binary Lock Read Write As #nFileno1 nFileno2 = FreeFile Open TfileN For Binary Lock Read Write As #nFileno2 nFilelen = LOF(nFileno1) Do While Loc(nFileno1) < nFilelen If Int((Loc(nFileno1) + 2) / 78) = ((Loc(nFileno1) + 2) / 78) Then Get #nFileno1, , B(1) Get #nFileno1, , B(1) End If For ni = 1 To 4 Step 1 Get #nFileno1, , B(ni) If B(ni) = 43 Then B(ni) = 127 GoTo NINEXT End If If B(ni) = 47 Then B(ni) = 128 GoTo NINEXT End If If B(ni) > 47 And B(ni) <= 57 Then B(ni) = B(ni) + 69 GoTo NINEXT End If If B(ni) > 96 And B(ni) <= 122 Then B(ni) = B(ni) - 6 GoTo NINEXT End If NINEXT: Next ni If B(3) = 61 Then A(1) = ((B(1) - 65) Mod 64) * 4 + Int((B(2) - 65) / 16) Put #nFileno2, , A(1) GoTo Endtranslat End If If B(4) = 61 Then A(1) = ((B(1) - 65) Mod 64) * 4 + Int((B(2) - 65) / 16) A(2) = ((B(2) - 65) Mod 16) * 16 + Int((B(3) - 65) / 4) Put #nFileno2, , A(1) Put #nFileno2, , A(2) GoTo Endtranslat End If A(1) = ((B(1) - 65) Mod 64) * 4 + Int((B(2) - 65) / 16) A(2) = ((B(2) - 65) Mod 16) * 16 + Int((B(3) - 65) / 4) A(3) = ((B(3) - 65) Mod 4) * 64 + (B(4) - 65) Put #nFileno2, , A(1) Put #nFileno2, , A(2) Put #nFileno2, , A(3) Endtranslat: delayX = delayX + 1 If delayX > 500 Then DoEvents delayX = 0 End If Loop Close #nFileno1 Close #nFileno2 '--------------------------- ' ----------------- '------------------------------------------- '--------------------------- Decode64_filetofile = True endF: Exit Function err: Decode64_filetofile = False Close #nFileno1 Close #nFileno2 MsgBox "发生错误，解码失败！" & err.Number & "." & err.Description & "." & err.Source, vbCritical, "错误" Resume endF End Function Public Function Decode64(InstrS As String) As String Dim nFileno1 As Integer Dim nFileno2 As Integer Dim bByte As Byte Dim sInp1 As Byte Dim sInp2 As Byte Dim nFilelen As Long Dim A(3) As Byte Dim B(4) As Byte Dim ni As Integer Dim tmpdir As String Dim EnStr As String ', nj As Integer 'Dim Infomation As String '11 'Infomation = "From: < [email protected]> " + Chr(13) + Chr(10) + "To: < [email protected]> " + Chr(13) + Chr(10) + "Cc: " + Chr(13) + Chr(10) + "Subject: Test" + Chr(13) + Chr(10) + "Date: Wed,21 Feb 2001 20:00:00" + Chr(13) + Chr(10) On Error GoTo err '------------------------------------ tmpdir = Getwindir + "/TEMP/" '----------------------------------------- nFileno1 = FreeFile Open tmpdir + "aBASE64.TMP" For Output As #nFileno1 Close #nFileno1 '----------------------------- nFileno1 = FreeFile Open tmpdir + "bBASE64.TMP" For Output As #nFileno1 Close #nFileno1 '------------------ '------------------------------------ nFileno1 = FreeFile Open tmpdir + "aBASE64.TMP" For Binary Lock Read Write As #nFileno1 Put #nFileno1, , InstrS ' Print #nFileno1, Text1.caption Close #nFileno1 '----------------------------------- nFileno1 = FreeFile Open tmpdir + "aBASE64.TMP" For Binary Lock Read Write As #nFileno1 nFileno2 = FreeFile Open tmpdir + "bBASE64.TMP" For Binary Lock Read Write As #nFileno2 'Put #nFileno2, , Infomation nFilelen = LOF(nFileno1) Do While Loc(nFileno1) < nFilelen If Int((Loc(nFileno1) + 2) / 78) = ((Loc(nFileno1) + 2) / 78) Then Get #nFileno1, , B(1) Get #nFileno1, , B(1) End If For ni = 1 To 4 Step 1 Get #nFileno1, , B(ni) If B(ni) = 43 Then B(ni) = 127 GoTo NINEXT End If If B(ni) = 47 Then B(ni) = 128 GoTo NINEXT End If If B(ni) > 47 And B(ni) <= 57 Then B(ni) = B(ni) + 69 GoTo NINEXT End If If B(ni) > 96 And B(ni) <= 122 Then B(ni) = B(ni) - 6 GoTo NINEXT End If NINEXT: Next ni If B(3) = 61 Then A(1) = ((B(1) - 65) Mod 64) * 4 + Int((B(2) - 65) / 16) Put #nFileno2, , A(1) GoTo Endtranslat End If If B(4) = 61 Then A(1) = ((B(1) - 65) Mod 64) * 4 + Int((B(2) - 65) / 16) A(2) = ((B(2) - 65) Mod 16) * 16 + Int((B(3) - 65) / 4) Put #nFileno2, , A(1) Put #nFileno2, , A(2) GoTo Endtranslat End If A(1) = ((B(1) - 65) Mod 64) * 4 + Int((B(2) - 65) / 16) A(2) = ((B(2) - 65) Mod 16) * 16 + Int((B(3) - 65) / 4) A(3) = ((B(3) - 65) Mod 4) * 64 + (B(4) - 65) Put #nFileno2, , A(1) Put #nFileno2, , A(2) Put #nFileno2, , A(3) Endtranslat: Loop Close #nFileno1 Close #nFileno2 '--------------------------- nFileno1 = FreeFile Open tmpdir + "bBASE64.TMP" For Input Lock Read Write As #nFileno1 Input #nFileno1, EnStr Close #nFileno1 ' ----------------- '-----------------------------清除临时文件。 nFileno1 = FreeFile Open tmpdir + "bBASE64.TMP" For Output As #nFileno1 Close #nFileno1 '------------------ Kill tmpdir + "bBASE64.TMP" '--------------------------- '-------------------------------清除临时文件。 nFileno1 = FreeFile Open tmpdir + "aBASE64.TMP" For Output As #nFileno1 Close #nFileno1 Kill tmpdir + "aBASE64.TMP" '------------------------------------------- ' Dim i As Long, ReadBit As Byte ' EnStr = "" ' Seek #nFileno2, 1 ' For i = 1 To LOF(nFileno2) ' Get #nFileno2, , ReadBit ' EnStr = EnStr + Chr$(ReadBit) ' Next i ' Close #nFileno2 '? ' nFileno1 = FreeFile ' Open tmpdir + "bBASE64.TMP" For Input Lock Read Write As #nFileno1 ' Input #nFileno1, EnStr ' Close #nFileno1 ' ' Decode64 = EnStr '--------------------------- '--------------------------- Decode64 = EnStr endF: Exit Function err: 'Select Case err.Number ' Case 6 Decode64 = "" Close #nFileno1 Close #nFileno2 '-------------------------------清除临时文件。 nFileno1 = FreeFile Open tmpdir + "aBASE64.TMP" For Output As #nFileno1 Close #nFileno1 Kill tmpdir + "aBASE64.TMP" '------------------------------------------- '-----------------------------清除临时文件。 nFileno1 = FreeFile Open tmpdir + "bBASE64.TMP" For Output As #nFileno1 Close #nFileno1 '------------------ Kill tmpdir + "bBASE64.TMP" '--------------------------- ' Kill tmpdir + "aBASE64.TMP": Kill tmpdir + "bBASE64.TMP" Resume endF End Function '--------------------------------------------------------------另一个编码程序 Public Function Base64EncodeStr(ByVal StrIn As String) As String Dim mAllByteIn() As Byte, mAllByteOut() As Byte Dim mInByte(2) As Byte, mOutByte(3) As Byte Dim myByte As Byte Dim i As Integer, LineLen As Integer, j As Integer, m As Integer, n As Integer n = 3: m = 0 mAllByteIn() = StrConv(StrIn, vbFromUnicode) For i = 0 To UBound(mAllByteIn()) Step 3 j = 0 Do While j < 3 mInByte(j) = mAllByteIn(i + j) j = j + 1 If i + j > UBound(mAllByteIn()) Then Exit Do Loop Base64EncodeByte mInByte, mOutByte, j ReDim Preserve mAllByteOut(n) For j = 0 To 3 mAllByteOut(n - 3 + j) = mOutByte(j) Next j n = n + 4 m = m + 4 If m > 70 Then m = 0 n = n + 2 ReDim Preserve mAllByteOut(n) mAllByteOut(n - 2) = &HD mAllByteOut(n - 1) = &HA End If Next i Base64EncodeStr = StrConv(mAllByteOut(), vbUnicode) 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

此文仅作为为相关连接：http://topic.csdn.net/u/20090707/00/0b3b4c31-8cef-4bd2-817e-4a2a445e8b87.html?seed=1568730854 

 

提供素材之用，别无它意。