談談 BASE64 加密 VBA編

hopkinslau

'嚴格來說，這不能算是一种加密方式，只能算是一种編碼方式。

' 用如下方法使用:
'    Dim b as Base64
'    b = New Base64
'    Debug.Print b.Encode("This is a test.") ' Prints "VGhpcyBpcyBhIHRlc3Qu"
'    Debug.Print b.Decode("VGhpcyBpcyBhIHRlc3Qu") ' Prints "This is a test."

'建立一個類模塊，然後輸入這段代碼

Private Const MAX_LINELENGTH As Long = 76 ' Must be a multiple of 4
Private Const CHAR_EQUAL As Byte = 61
Private Const CHAR_CR As Byte = 13
Private Const CHAR_LF As Byte = 10


Private m_Index1(0 To 255) As Byte
Private m_Index2(0 To 255) As Byte
Private m_Index3(0 To 255) As Byte
Private m_Index4(0 To 63) As Byte
Private m_ReverseIndex1(0 To 255) As Byte
Private m_ReverseIndex2(0 To 255, 0 To 1) As Byte
Private m_ReverseIndex3(0 To 255, 0 To 1) As Byte
Private m_ReverseIndex4(0 To 255) As Byte

' Encode a string to a string.
Public Function Encode(sInput As String) As String
   Dim bTemp() As Byte
   
   'Convert to a byte array then convert.
   'This is faster the repetitive calls to asc() or chr$()
   bTemp = StrConv(sInput, vbFromUnicode)
   Encode = StrConv(EncodeArr(bTemp), vbUnicode)
End Function

'Decode a string to a string.
Public Function Decode(sInput As String) As String
   Dim bTemp() As Byte
   
   'Convert to a byte array then convert.
   'This is faster the repetitive calls to asc() or chr$()
   bTemp = StrConv(sInput, vbFromUnicode)
   Decode = StrConv(DecodeArr(bTemp), vbUnicode)
End Function

Public Sub DecodeToFile(sInput As String, sOutputFile As String)
   Dim bTemp() As Byte
   Dim fh As Long
   
   bTemp = StrConv(sInput, vbformunicode)
   bTemp = DecodeArr(bTemp)
   
   fh = FreeFile(0)
   Open sOutputFile For Binary Access Write As fh
   Put fh, , bTemp
   Close fh
End Sub

Public Sub DecodeFile(sInputFile As String, sOutputFile As String)
   Dim bTemp() As Byte
   Dim fh As Long
   
   fh = FreeFile(0)
   Open sInputFile For Binary Access Read As fh
   ReDim bTemp(0 To LOF(fh) - 1)
   Get fh, , bTemp
   Close fh
   
   bTemp = DecodeArr(bTemp)
   Open sOutputFile For Binary Access Write As fh
   Put fh, , bTemp
   Close fh
End Sub

Public Function EncodeFromFile(sFileName As String) As String
   Dim bTemp() As Byte
   Dim fh As Long
   
   fh = FreeFile(0)
   Open sFileName For Binary Access Read As fh
   ReDim bTemp(0 To LOF(fh) - 1)
   Get fh, , bTemp
   Close fh
   
   EncodeFromFile = StrConv(EncodeArr(bTemp), vbUnicode)
End Function

Public Sub EncodeFile(sInputFile As String, sOutputFile As String)
   Dim bTemp() As Byte
   Dim fh As Long
   
   fh = FreeFile(0)
   Open sInputFile For Binary Access Read As fh
   ReDim bTemp(0 To LOF(fh) - 1)
   Get fh, , bTemp
   Close fh
   
   bTemp = EncodeArr(bTemp)
   Open sOutputFile For Binary Access Write As fh
   Put fh, , bTemp
   Close fh
End Sub


Private Function EncodeArr(bInput() As Byte) As Byte()
   Dim bOutput() As Byte
   Dim k As Long
   Dim l As Long
   Dim i As Long
   Dim evenBound As Long
   Dim CurrentOut As Long
   Dim b As Byte
   Dim c As Byte
   Dim d As Byte
   Dim linelength As Long
   
   k = LBound(bInput)
   l = UBound(bInput)
   
   'Calculate the input size
   i = l - k + 1
   
   'Calculate the output size
   Select Case i Mod 3
      Case 0:
         i = (i \ 3) * 4
         evenBound = l
      Case 1:
         i = ((i \ 3) * 4) + 4
         evenBound = l - 1
      Case 2:
         i = ((i \ 3) * 4) + 4
         evenBound = l - 2
      Case 3:
         i = ((i \ 3) * 4) + 4
         evenBound = l - 3
   End Select
   
   'Add in the line feeds.
   If i Mod MAX_LINELENGTH = 0 Then
      i = i + (i \ MAX_LINELENGTH) * 2 - 2
   Else
      i = i + (i \ MAX_LINELENGTH) * 2
   End If<B

haxoo

[em02]

jweng

晕

台灯

很晕

chaojianan

有无实例分享。

LeeTien

没功能介绍啊