用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
附源程序:
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
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货