用Winsock控件实现。
附源程序:
Dim REC() As String
Private Enum SMTP_State
    MAIL_CONNECT
    MAIL_HELO
    MAIL_FROM
    MAIL_RCPTTO
    MAIL_DATA
    MAIL_DOT
    MAIL_QUIT
End EnumPrivate m_State As SMTP_State
Dim Index As Integer
Dim recIndex      As Integer'Private Sub cmdClose_Click()    Unload Me
    
End SubPrivate Sub cmdNew_Click()    txtRecipient = ""
    txtSubject = ""
    txtMessage = ""
    
End SubPrivate Sub cmdSend_Click()    Winsock1.Connect Trim$(txtHost), 25
    m_State = MAIL_CONNECT
    recIndex = 1
    
End SubPrivate Sub Form_Load()
    '
    'clear all textboxes
    '
'    For Each ctl In Me.Controls
'        If TypeOf ctl Is TextBox Then
'            ctl.Text = ""
'        End If
'    Next
    '
        Index = 1
End Sub
Private Sub txtRecipient_LostFocus()Dim I As Integer, J As Integer, INDEX_I As Integer
    
    J = 1
    INDEX_I = 1
    For I = 1 To Len(txtRecipient)
        If Mid(txtRecipient, I, 1) = ";" Or Mid(txtRecipient, I, 1) = " " Then
            If I = J Then
                J = I + 1
            ElseIf Trim(Mid(txtRecipient, J, I - J)) = ";" Or Trim(Mid(txtRecipient, J, I - J)) = "" Then
                J = I + 1
            Else
                ReDim Preserve REC(1 To INDEX_I)
                REC(INDEX_I) = Trim(Mid(txtRecipient, J, I - J))
                INDEX_I = INDEX_I + 1
                J = I + 1
            End If
        End If
    Next I
    
    If Not J = Len(txtRecipient) + 1 Then
        ReDim Preserve REC(1 To INDEX_I)
        REC(INDEX_I) = Trim(Mid(txtRecipient, J, Len(txtRecipient) - J + 1))
    End If
    
    For I = 1 To UBound(REC)
        Debug.Print REC(I)
    Next I
    
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)    Dim strServerResponse   As String
    Dim strResponseCode     As String
    Dim strDataToSend       As String
    
    '
    'Retrive data from winsock buffer
    '
    Winsock1.GetData strServerResponse
    '
    Debug.Print strServerResponse
    '
    'Get server response code (first three symbols)
    '
    strResponseCode = Left(strServerResponse, 3)
    '
    'Only these three codes tell us that previous
    'command accepted successfully and we can go on
    '
    If strResponseCode = "250" Or _
       strResponseCode = "220" Or _
       strResponseCode = "354" Then
       
        Select Case m_State
            Case MAIL_CONNECT
                'Change current state of the session
                m_State = MAIL_HELO
                '
                'Remove blank spaces
                strDataToSend = Trim$(txtSender)
                '
                'Retrieve mailbox name from e-mail address
                strDataToSend = Left$(strDataToSend, _
                                InStr(1, strDataToSend, "@") - 1)
                'Send HELO command to the server
                Winsock1.SendData "HELO " & strDataToSend & vbCrLf
                '
                Debug.Print "HELO " & strDataToSend
                '
            Case MAIL_HELO
                '
                'Change current state of the session
                m_State = MAIL_FROM
                '
                'Send MAIL FROM command to the server
                Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
                '
                Debug.Print "MAIL FROM:" & Trim$(txtSender)
                '
            Case MAIL_FROM
                '
                'Change current state of the session
                '
                'Send RCPT TO command to the server
                
                If recIndex < UBound(REC) Then
                   Winsock1.SendData "RCPT TO:" & REC(recIndex) & vbCrLf
                   m_State = MAIL_FROM
                   recIndex = recIndex + 1
                Else
                   Winsock1.SendData "RCPT TO:" & REC(recIndex) & vbCrLf
                   m_State = MAIL_RCPTTO
                End If
                '
                Debug.Print "RCPT TO:" & Trim$(txtRecipient)
                '
            Case MAIL_RCPTTO
                '
                'Change current state of the session
                m_State = MAIL_DATA
                '
                'Send DATA command to the server
                Winsock1.SendData "DATA" & vbCrLf
                '
                Debug.Print "DATA"
                '
            Case MAIL_DATA
                '
                'Change current state of the session
                m_State = MAIL_DOT
                '
                'So now we are sending a message body
                'Each line of text must be completed with
                'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
                '
                'Send Subject line
                Winsock1.SendData "Subject:" & txtSubject & vbLf
                '
                Debug.Print "Subject:" & txtSubject
                '
                Dim varLines    As Variant
                Dim varLine     As Variant
                '
                'Parse message to get lines (for VB6 only)
                varLines = Split(txtMessage, vbCrLf)
                '
                'Send each line of the message
                For Each varLine In varLines
                    Winsock1.SendData CStr(varLine) & vbLf
                    '
                    Debug.Print CStr(varLine)
                Next
                '
                'Send a dot symbol to inform server
                'that sending of message comleted
                Winsock1.SendData "." & vbCrLf
                '
                Debug.Print "."
                '
            Case MAIL_DOT
                'Change current state of the session
                m_State = MAIL_QUIT
                '
                'Send QUIT command to the server
                Winsock1.SendData "QUIT" & vbCrLf
                '
                Debug.Print "QUIT"
            Case MAIL_QUIT
                '
                'Close connection
                Winsock1.Close
                '
        End Select
       
    Else
        '
        'If we are here server replied with
        'unacceptable respose code therefore we need
        'close connection and inform user about problem
        '
        Winsock1.Close
        '
        If Not m_State = MAIL_QUIT Then
            MsgBox "SMTP Error: " & strServerResponse, _
                    vbInformation, "SMTP Error"
        Else
            MsgBox "Message sent successfuly.", vbInformation
        End If
        '
    End If
    
End SubPrivate Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)    MsgBox "Winsock Error number " & Number & vbCrLf & _
            Description, vbExclamation, "Winsock Error"End Sub