vbmime.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 = "vbMime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'
'--------------------------------------------------------------------------

Option Explicit
Option Base 0

'Base64
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

'Mime
Private m_strMessageText     As String
Private m_strMessageBody     As String
Private m_strHeaders         As String

'Pop3 Class
'Dim intMailSelected As Integer

Private Enum POP3States
    POP3_Connect
    POP3_USER
    POP3_PASS
    POP3_STAT
    Pop3_retr
    Pop3_dele
    POP3_QUIT
End Enum

Private m_State       As POP3States
Private m_strPop3Host As String
Private m_strUsername As String
Private m_strPassword As String
Private bolDelMail As Boolean
Private pbExitImmediately As Boolean
Private bRaiseTimeOutError As Boolean
Private pbConnected As Boolean

Private intMessages          As Integer
Private intCurrentMessage    As Integer
Private strBuffer            As String
Private DataPointer&
Private Const BlockSize = 2048
' Class Events
Private WithEvents Pop3sck As CSocket
Attribute Pop3sck.VB_VarHelpID = -1
Public Event ReceivedSuccesful()
Public Event MimeFailed(Explanation As String)
Public Event Pop3Status(Status As String)
Public Event Progress(PercentComplete As Long)
'For WaitUntilTrue()
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim vbBase64 As New base64



'==========
' Class_Initialize;
' initializes codec tables.
'==========
Private Sub Class_Initialize()

  'Initiate Winsock

    Set Pop3sck = New CSocket
    

    'initialize the base64 table
    Dim I As Long

    'Setup the encodeing and decoding lookup arrays.
    'Essentially we speed up the routine by pre-shifting
    'the data so it only needs combined with And and Or.
    
    m_ReverseIndex4(65) = 0 'Asc("A")
    m_ReverseIndex4(66) = 1 'Asc("B")
    m_ReverseIndex4(67) = 2 'Asc("C")
    m_ReverseIndex4(68) = 3 'Asc("D")
    m_ReverseIndex4(69) = 4 'Asc("E")
    m_ReverseIndex4(70) = 5 'Asc("F")
    m_ReverseIndex4(71) = 6 'Asc("G")
    m_ReverseIndex4(72) = 7 'Asc("H")
    m_ReverseIndex4(73) = 8 'Asc("I")
    m_ReverseIndex4(74) = 9 'Asc("J")
    m_ReverseIndex4(75) = 10 'Asc("K")
    m_ReverseIndex4(76) = 11 'Asc("L")
    m_ReverseIndex4(77) = 12 'Asc("M")
    m_ReverseIndex4(78) = 13 'Asc("N")
    m_ReverseIndex4(79) = 14 'Asc("O")
    m_ReverseIndex4(80) = 15 'Asc("P")
    m_ReverseIndex4(81) = 16 'Asc("Q")
    m_ReverseIndex4(82) = 17 'Asc("R")
    m_ReverseIndex4(83) = 18 'Asc("S")
    m_ReverseIndex4(84) = 19 'Asc("T")
    m_ReverseIndex4(85) = 20 'Asc("U")
    m_ReverseIndex4(86) = 21 'Asc("V")
    m_ReverseIndex4(87) = 22 'Asc("W")
    m_ReverseIndex4(88) = 23 'Asc("X")
    m_ReverseIndex4(89) = 24 'Asc("Y")
    m_ReverseIndex4(90) = 25 'Asc("Z")
    m_ReverseIndex4(97) = 26 'Asc("a")
    m_ReverseIndex4(98) = 27 'Asc("b")
    m_ReverseIndex4(99) = 28 'Asc("c")
    m_ReverseIndex4(100) = 29 'Asc("d")
    m_ReverseIndex4(101) = 30 'Asc("e")
    m_ReverseIndex4(102) = 31 'Asc("f")
    m_ReverseIndex4(103) = 32 'Asc("g")
    m_ReverseIndex4(104) = 33 'Asc("h")
    m_ReverseIndex4(105) = 34 'Asc("i")
    m_ReverseIndex4(106) = 35 'Asc("j")
    m_ReverseIndex4(107) = 36 'Asc("k")
    m_ReverseIndex4(108) = 37 'Asc("l")
    m_ReverseIndex4(109) = 38 'Asc("m")
    m_ReverseIndex4(110) = 39 'Asc("n")
    m_ReverseIndex4(111) = 40 'Asc("o")
    m_ReverseIndex4(112) = 41 'Asc("p")
    m_ReverseIndex4(113) = 42 'Asc("q")
    m_ReverseIndex4(114) = 43 'Asc("r")
    m_ReverseIndex4(115) = 44 'Asc("s")
    m_ReverseIndex4(116) = 45 'Asc("t")
    m_ReverseIndex4(117) = 46 'Asc("u")
    m_ReverseIndex4(118) = 47 'Asc("v")
    m_ReverseIndex4(119) = 48 'Asc("w")
    m_ReverseIndex4(120) = 49 'Asc("x")
    m_ReverseIndex4(121) = 50 'Asc("y")
    m_ReverseIndex4(122) = 51 'Asc("z")
    m_ReverseIndex4(48) = 52 'Asc("0")
    m_ReverseIndex4(49) = 53 'Asc("1")
    m_ReverseIndex4(50) = 54 'Asc("2")
    m_ReverseIndex4(51) = 55 'Asc("3")
    m_ReverseIndex4(52) = 56 'Asc("4")
    m_ReverseIndex4(53) = 57 'Asc("5")
    m_ReverseIndex4(54) = 58 'Asc("6")
    m_ReverseIndex4(55) = 59 'Asc("7")
    m_ReverseIndex4(56) = 60 'Asc("8")
    m_ReverseIndex4(57) = 61 'Asc("9")
    m_ReverseIndex4(43) = 62 'Asc("+")
    m_ReverseIndex4(47) = 63 'Asc("/")

    'Calculate the other arrays.
    For I = 0 To 255
        If m_ReverseIndex4(I) <> 0 Then
            m_ReverseIndex1(I) = m_ReverseIndex4(I) * 4

            m_ReverseIndex2(I, 0) = m_ReverseIndex4(I) \ 16
            m_ReverseIndex2(I, 1) = (m_ReverseIndex4(I) And &HF) * 16

            m_ReverseIndex3(I, 0) = m_ReverseIndex4(I) \ 4
            m_ReverseIndex3(I, 1) = (m_ReverseIndex4(I) And &H3) * 64
        End If
    Next I
    

End Sub

Private Sub Class_Terminate()

  ' make sure sckMail is closed

    If Pop3sck.State <> sckClosed Then
        Pop3sck.CloseSocket
    End If

    ' release memory
    Set Pop3sck = Nothing

End Sub

Public Sub GetMail(strUsername As String, strPassword As String, strHost As String, Optional intPort As Integer)

    m_strPop3Host = strHost
    m_strUsername = strUsername
    m_strPassword = strPassword

    'Change current state of session
    m_State = POP3_Connect
    '
    'Reset current state of socket
    Pop3sck.CloseSocket
    '
    'Reset local port value to prevent "Address in use" error
    Pop3sck.LocalPort = 0
    '
    'POP3 server software is listening for client connection
    'requests on 110 port, therefore we need connect to host
    'on 110 port
    If intPort = 0 Then
        intPort = 110
    End If
    RaiseEvent Pop3Status("Connecting to Pop3 Server...")
    
    Pop3sck.Connect m_strPop3Host, intPort
    
    Call WaitUntilTrue(pbConnected, 30, True)
End Sub

Private Sub Pop3sck_OnConnect()
    pbConnected = True
    RaiseEvent Pop3Status("")
End Sub

'Retrieves all waiting E-Mails and send the raw E-Mail to the
'ParseMail function

Private Sub Pop3sck_OnDataArrival(ByVal lngBytesTotal As Long)

  Dim strData As String

    '  Static intMessages          As Integer
    '  Static intCurrentMessage    As Integer
    '  Static strBuffer            As String
    'Dim intSwap As Integer
    
   ' On Error GoTo error

    'Retrieve, received from server, data.
    Pop3sck.GetData strData

    If Left$(strData, 1) = "+" Or m_State = Pop3_retr Then
        'If first symbol of server response is "+"
        'server has accepted previous client command
        'and it is waiting for next actions.
        Select Case m_State
            'This should be tohe most realistic case
          Case Pop3_retr
            '
            'Accumulate message data in strBuffer static variable

            'Set initial condition
            If Len(strBuffer) = 0 Then DataPointer = 1
            'Test to see if new string will fit within current strBuffer
            If (DataPointer + Len(strData)) > Len(strBuffer) Then
                'If not, allocate more memory
                strBuffer = strBuffer & Space$(Len(strData) + BlockSize)
            End If

            'Assign the new data
            Mid$(strBuffer, DataPointer, Len(strData)) = strData
            'Move pointer to end of new data
            DataPointer = DataPointer + Len(strData)
            '
            'Until we have been found single dot symbol on a line.
            If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
                '
                'OK! We have received a message.
                '
                'Remove server response string
                strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
                '
                'Remove dot symbol that is at the end of a message
                strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
                '
                RaiseEvent Pop3Status("Decode Mail..." & CStr(intCurrentMessage))

                ParseMail strBuffer, intCurrentMessage
                

        
                '
                'Clear buffer for next message
                strBuffer = ""
                '
                If intCurrentMessage = intMessages Then
                    '
                    'We have received all messages, and
                    'we need say QUIT
                    AttachmentCounter = 0
                    intCurrentMessage = 1
                    
                    If bolDelMail Then
                        m_State = Pop3_dele
                        RaiseEvent Pop3Status("All mails received!")
                        Pop3sck.SendData "DELE " & intCurrentMessage & vbCrLf
                    Else
                        m_State = POP3_QUIT
                        RaiseEvent Pop3Status("All mails received!")
                        Pop3sck.SendData "QUIT" & vbCrLf
                    End If
                    

                  Else
                    '
                    'We have messages to download
                    'Increase message counter
                    intCurrentMessage = intCurrentMessage + 1
                    '
                    'Change current state of session
                    m_State = Pop3_retr
                    '
                    'Send RETR command to download next message
                    RaiseEvent Pop3Status("Receive next mail...")
                    Pop3sck.SendData "RETR " & _
                                     CStr(intCurrentMessage) & vbCrLf

                End If
            End If

          Case POP3_Connect
            '
            'Reset message counter
            intMessages = 0
            intCurrentMessage = 0
            '
            'Change current state of session
            m_State = POP3_USER
            '
            'Send to server USER command to tell him
            'which mailbox we want check out
            RaiseEvent Pop3Status("Authenticate User...")
            Pop3sck.SendData "USER " & m_strUsername & vbCrLf

          Case POP3_USER
            '
            'Change current state of session
            m_State = POP3_PASS
            '
            'Send password with PASS command
            RaiseEvent Pop3Status("Send Password...")
            Pop3sck.SendData "PASS " & m_strPassword & vbCrLf

          Case POP3_PASS
            '
            'Change current state of session
            m_State = POP3_STAT
            '
            'Send STAT command to know how many
            'messages in the mailbox
            RaiseEvent Pop3Status("Get Number of E-Mails...")
            Pop3sck.SendData "STAT" & vbCrLf

          Case POP3_STAT
            '
            'Parse server response to get number
            'of messages in the mailbox
            intMessages = CInt(Mid$(strData, 5, _
                          InStr(5, strData, " ") - 5))

            If intMessages > 0 Then

                'Redim Buffer to download all Mails
                ReDim Mails(intMessages - 1)
                '
                'OK! We have one or more.
                'Change current state of session
                m_State = Pop3_retr
                '
                'Increase counter to know wich message
                'we will retrieving
                intCurrentMessage = intCurrentMessage + 1
                '
                'And send RETR command to download
                'first message
                Pop3sck.SendData "RETR 1" & vbCrLf

              Else
                '
                'We have not any message in the mailbox.
                'Send QUIT command and show to user a message
                'that she or he has not mail.
                m_State = POP3_QUIT
                Pop3sck.SendData "QUIT" & vbCrLf

                RaiseEvent Pop3Status("You have not mail!")
            End If
            
          Case Pop3_dele
            If intCurrentMessage = intMessages Then
                m_State = POP3_QUIT
                Pop3sck.SendData "QUIT" & vbCrLf
            Else
                m_State = Pop3_dele
                intCurrentMessage = intCurrentMessage + 1
                Pop3sck.SendData "DELE " & intCurrentMessage & vbCrLf
                
            End If
            
          Case POP3_QUIT
            AttachmentCounter = 0
            RaiseEvent Pop3Status("")
            RaiseEvent ReceivedSuccesful
            Pop3sck.CloseSocket

        End Select
      Else
error:
        'Hide Status
        RaiseEvent Pop3Status("")
        'Show Error
        RaiseEvent MimeFailed(strData)
        Pop3sck.CloseSocket
    End If

End Sub

Private Sub Pop3sck_OnError(ByVal intNumber As Integer, strDescription As String, ByVal lngScode As Long, ByVal strSource As String, ByVal strHelpFile As String, ByVal lngHelpContext As Long, fCancelDisplay As Boolean)

    RaiseEvent MimeFailed("Winsock Error: #" & intNumber & "Desc: " & strDescription)

End Sub

Public Sub ParseMail(strMessage As String, MailCounter As Integer)

  Dim intPosA         As Long
  Dim intPosB         As Long
  Dim intPos          As Long
  Dim intCount        As Long
  Dim intFrom         As Long
  Dim intTo           As Long
  Dim intTemp         As Long
  Dim EndBoundary     As Long
  'Dim Counter         As Long
  Dim Counter2        As Long
  Dim vHeaders        As Variant
  Dim strTemp         As String
  Dim BoundArray      As Variant
  Dim strHeader       As String
  Dim strHeaderName   As String
  Dim strHeaderValue  As String
  Dim TmpString       As String
  Dim Boundary        As String
  Dim BoundaryVal     As String
  Dim strFilename     As String
  Dim MimeHeaders()   As String


    intPosA = InStr(1, strMessage, vbCrLf & vbCrLf)

    'A little Error Check
    If Not intPosA > 0 Then
        Exit Sub
    End If