WEB Mail

Development Platform:
Visual Basic

Module_Base64.bas：Code Content
							Attribute VB_Name = "Module_Base64"
Option Explicit
Private Declare Function ArrPtr Lib "msvbvm60.dll" _
Alias "VarPtr" (Ptr() As Any) As Long '<-- VB6
Private Declare Sub PokeLng Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal Addr As Long, Source As Long, _
Optional ByVal Bytes As Long = 4)
Private Base64EncodeByte(0 To 63) As Byte
Private Base64EncodeWord(0 To 63) As Integer
Const Base64EmptyByte As Byte = 61
Const Base64EmptyWord As Integer = 61
Public Sub Base64Init()
  '建立Base64码数组
  Const Chars64 As String _
    = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" _
    & "abcdefghijklmnopqrstuvwxyz" _
    & "0123456789+/"
  Static i As Long
  Dim Code As Integer
  If i Then Exit Sub
  For i = 0 To 63
    Code = Asc(Mid$(Chars64, i + 1, 1))
    Base64EncodeByte(i) = Code
    Base64EncodeWord(i) = Code
  Next i
End Sub
Public Static Function Base64EncodeString(ByRef Text As String) As String
'Base64码转换函数
  Dim Chars() As Integer
  Dim SavePtr As Long
  Dim SADescrPtr As Long
  Dim DataPtr As Long
  Dim CountPtr As Long
  Dim TextLen As Long
  Dim i As Long
  Dim Chars64() As Integer
  Dim SavePtr64 As Long
  Dim SADescrPtr64 As Long
  Dim DataPtr64 As Long
  Dim CountPtr64 As Long
  Dim TextLen64 As Long
  Dim j As Long
  Dim b1 As Integer
  Dim b2 As Integer
  Dim b3 As Integer
  j = 0
  TextLen = Len(Text)
  If TextLen = 0 Then Exit Function
  '输入字符串校验
  TextLen64 = ((TextLen + 2)  3) * 4
  '字符串转换为Base64码后的长度
  Base64EncodeString = Space$(TextLen64)
  If SavePtr = 0 Then
    ReDim Chars(1 To 1)
    SavePtr = VarPtr(Chars(1))
    'SavePtr=*Chars(1)
    PokeLng VarPtr(SADescrPtr), ByVal ArrPtr(Chars)
    '*SADescrPtr=*Chars
    DataPtr = SADescrPtr + 12
    CountPtr = SADescrPtr + 16
    ReDim Chars64(0 To 0)
    SavePtr64 = VarPtr(Chars64(0))
    'SavePtr64=*Chars64(0)
    PokeLng VarPtr(SADescrPtr64), ByVal ArrPtr(Chars64)
    '*SADescrPtr64=*Chars64
    DataPtr64 = SADescrPtr64 + 12
    CountPtr64 = SADescrPtr64 + 16
  End If
  PokeLng DataPtr, StrPtr(Text)
  'DataPtr=*Text
  PokeLng CountPtr, TextLen
  'CountPtr=TextLen
  PokeLng DataPtr64, StrPtr(Base64EncodeString)
  'DataPtr64=*Base64EncodeString
  PokeLng CountPtr64, TextLen64
  'CountPtr64=Textlen64
  Base64Init
  '输入字符串转换为Base64码
  For i = 1 To TextLen - 2 Step 3
    b1 = Chars(i)
    b2 = Chars(i + 1)
    b3 = Chars(i + 2)
    'Base64-Bytes:
    Chars64(j) = Base64EncodeWord(b1  &H4)
    Chars64(j + 1) = Base64EncodeWord((b1 And &H3) * &H10 + b2  &H10)
    Chars64(j + 2) = Base64EncodeWord((b2 And &HF) * &H4 + b3  &H40)
    Chars64(j + 3) = Base64EncodeWord(b3 And &H3F)
    j = j + 4
  Next i
  '继续将未转换完的输入字符串转换为Base64码
  Select Case TextLen - i
    Case 0 '2 Bytes
      b1 = Chars(i)
      Chars64(j) = Base64EncodeWord(b1  &H4)
      Chars64(j + 1) = Base64EncodeByte((b1 And &H3) * &H10)
      Chars64(j + 2) = Base64EmptyWord
      Chars64(j + 3) = Base64EmptyWord
    Case 1 '1 Byte
      b1 = Chars(i)
      b2 = Chars(i + 1)
      Chars64(j) = Base64EncodeWord(b1  &H4)
      Chars64(j + 1) = Base64EncodeWord((b1 And &H3) * &H10 + b2  &H10)
      Chars64(j + 2) = Base64EncodeWord((b2 And &HF) * &H4)
      Chars64(j + 3) = Base64EmptyWord
  End Select
  '返回转换成Base64码的字符串
  PokeLng DataPtr64, SavePtr64
  PokeLng CountPtr64, 1
  PokeLng DataPtr, SavePtr
  PokeLng CountPtr, 1
End Function

						