Email服务器

开发平台：
Visual Basic

base64.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "base64"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Const CHAR_EQUAL As Byte = 61
Private Const CHAR_CR As Byte = 13
Private Const CHAR_LF As Byte = 10
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
'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, vbFromUnicode)
    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
Private Function DecodeArr(bInput() As Byte) As Byte()
  Dim bOutput() As Byte
  Dim OutLength As Long
  Dim CurrentOut As Long
  Dim k As Long
  Dim l As Long
  Dim I As Long
  
  Dim b As Byte
  Dim c As Byte
  Dim d As Byte
  Dim e As Byte
    k = LBound(bInput)
    l = UBound(bInput)
    'Calculate the length of the input
    I = l - k + 1
    'Allocate the output
  Dim BytesDataIn As Long ':(燤ove line to top of current Function
  Dim BytesDataOut As Long ':(燤ove line to top of current Function
  Dim ExtraBytes As Integer ':(燤ove line to top of current Function
    If bInput(l) = 61 Then
        ExtraBytes = 1
        If bInput(l - 1) = 61 Then
            ExtraBytes = 2
        End If
    End If
    BytesDataIn = l + 1 'BytesDataIn of the string
    BytesDataOut = (BytesDataIn * 0.75) - ExtraBytes ' how many bytes will the decoded string have
    ReDim bOutput(BytesDataOut - 1)
    CurrentOut = 0
    For I = k To l
        Select Case bInput(I)
          Case CHAR_CR
            'Do nothing
          Case CHAR_LF
            'Do nothing
          Case Else
            If l - I >= 3 Then
                b = bInput(I)
                c = bInput(I + 1)
                d = bInput(I + 2)
                e = bInput(I + 3)
                If e <> CHAR_EQUAL Then
                    bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
                    bOutput(CurrentOut + 1) = m_ReverseIndex2(c, 1) Or m_ReverseIndex3(d, 0)
                    bOutput(CurrentOut + 2) = m_ReverseIndex3(d, 1) Or m_ReverseIndex4(e)
                    CurrentOut = CurrentOut + 3
                    I = I + 3 ':(燤odifies active For-Variable
                  ElseIf d <> CHAR_EQUAL Then 'NOT E...
                    bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
                    bOutput(CurrentOut + 1) = m_ReverseIndex2(c, 1) Or m_ReverseIndex3(d, 0)
                    CurrentOut = CurrentOut + 2
                    I = I + 3 ':(燤odifies active For-Variable
                  Else 'NOT D...
                    bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
                    CurrentOut = CurrentOut + 1
                    I = I + 3 ':(燤odifies active For-Variable
                End If
              Else 'NOT L...
                'Possible input code error, but may also be
                'an extra CrLf, so we will ignore it.
            End If
        End Select
    Next I
    'On properly formed input we should have to do this.
    If OutLength <> CurrentOut + 1 Then
        ReDim Preserve bOutput(0 To CurrentOut - 1)
    End If
    DecodeArr = bOutput
End Function

						