一个不需要CDO和IIS发送邮件的例子

VB.NET:

Imports System Imports System.Text Imports System.Windows.Forms Public Class cSMTP Private m_sSender As String Private m_sUser As String Private m_sSenderName As String Private m_sRecipient As String Private m_sRecipientName As String Private m_sServer As String Private m_iPort As Integer Private m_sSubject As String Private m_sBody As String Private m_iTimeOut As Integer Private m_colCC As Collection Private m_colCC_OK As Collection Private Structure TRecipient Dim strEMail As String Dim strName As String Dim bBlind As Boolean End Structure Private tcpClient As System.Net.Sockets.TcpClient Private networkStream As System.Net.Sockets.NetworkStream Public Property Timeout() As Integer Get Timeout = m_iTimeOut End Get Set(ByVal Value As Integer) m_iTimeOut = Value End Set End Property Public Property User() As String Get User = m_sUser End Get Set(ByVal s As String) m_sUser = s End Set End Property Public Property Subject() As String Get Subject = m_sSubject End Get Set(ByVal s As String) m_sSubject = s End Set End Property Public Property Body() As String Get Body = m_sBody End Get Set(ByVal s As String) m_sBody = s End Set End Property Public Property Sender() As String Get Sender = m_sSender End Get Set(ByVal s As String) m_sSender = s End Set End Property Public Property SenderName() As String Get SenderName = m_sSenderName End Get Set(ByVal s As String) m_sSenderName = s End Set End Property Public Property Recipient() As String Get Recipient = m_sRecipient End Get Set(ByVal s As String) m_sRecipient = s End Set End Property Public Property RecipientName() As String Get RecipientName = m_sRecipientName End Get Set(ByVal s As String) m_sRecipientName = s End Set End Property Public Property Server() As String Get Server = m_sServer End Get Set(ByVal s As String) m_sServer = s End Set End Property Public Property Port() As Integer Get Port = m_iPort End Get Set(ByVal i As Integer) m_iPort = i End Set End Property Private Sub Init() m_sBody = "" m_sSubject = "" m_sSender = "" m_sSenderName = "" m_sRecipient = "" m_sRecipientName = "" m_sServer = "" m_iPort = -1 m_iTimeOut = 30 CloseCon() tcpClient = New System.Net.Sockets.TcpClient m_colCC = New Collection m_colCC_OK = New Collection End Sub Private Function ExtendedASCIIEncode(ByVal strMsg As String, ByRef arrByte() As Byte) As Boolean Dim i As Integer Try ReDim arrByte(strMsg.Length - 1) For i = 0 To strMsg.Length - 1 arrByte(i) = CByte(Asc(strMsg.Substring(i, 1))) Next i ExtendedASCIIEncode = True Catch ex As Exception If i > 0 Then ReDim Preserve arrByte(i - 1) End If ExtendedASCIIEncode = False End Try End Function Private Sub SendText(ByVal strMsg As String) Dim sendBytes As [Byte]() If Not ExtendedASCIIEncode(strMsg, sendBytes) Then Err.Raise(vbObjectError + 1, "SendText", "Error en el Byte-Array!") Exit Sub End If networkStream.Write(sendBytes, 0, sendBytes.Length) End Sub Private Function GetResponse() As String Dim Start As Double Dim Tmr As Double Dim bytes() As Byte Start = Now.TimeOfDay.TotalSeconds ReDim bytes(tcpClient.ReceiveBufferSize) While Not networkStream.DataAvailable Tmr = Now.TimeOfDay.TotalSeconds - Start Application.DoEvents() If Tmr > m_iTimeOut Then GetResponse = "TIMEOUT!" Exit Function End If End While If networkStream.DataAvailable Then networkStream.Read(bytes, 0, CInt(tcpClient.ReceiveBufferSize)) GetResponse = Encoding.ASCII.GetString(bytes) Else GetResponse = "TIMEOUT!" End If End Function Private Sub CloseCon() If Not tcpClient Is Nothing Then tcpClient.Close() End If tcpClient = Nothing End Sub Public Sub New() Init() End Sub Public Sub Dispose() On Error Resume Next CloseCon() If Not m_colCC Is Nothing Then While m_colCC.Count > 0 m_colCC.Remove(1) End While End If If Not m_colCC_OK Is Nothing Then While m_colCC_OK.Count > 0 m_colCC_OK.Remove(1) End While End If m_colCC = Nothing m_colCC_OK = Nothing End Sub Public Sub Clear() Init() End Sub Public Function Add_cc(ByVal strCC_EMail As String) As Boolean Dim objCC As TRecipient Try objCC = New TRecipient objCC.strEMail = strCC_EMail objCC.strName = "" objCC.bBlind = False m_colCC.Add(objCC) objCC = Nothing Add_cc = True Catch Add_cc = False objCC = Nothing End Try End Function Public Function Add_cc(ByVal strCC_EMail As String, ByVal strCC_Name As String) As Boolean Dim objCC As TRecipient Try objCC = New TRecipient objCC.strEMail = strCC_EMail objCC.strName = strCC_Name objCC.bBlind = False m_colCC.Add(objCC) objCC = Nothing Add_cc = True Catch Add_cc = False objCC = Nothing End Try End Function Public Function Add_Bcc(ByVal strCC_EMail As String) As Boolean Dim objCC As TRecipient Try objCC = New TRecipient objCC.strEMail = strCC_EMail objCC.strName = "" objCC.bBlind = True m_colCC.Add(objCC) objCC = Nothing Add_Bcc = True Catch Add_Bcc = False objCC = Nothing End Try End Function Public Function Add_Bcc(ByVal strCC_EMail As String, ByVal strCC_Name As String) As Boolean Dim objCC As TRecipient Try objCC = New TRecipient objCC.strEMail = strCC_EMail objCC.strName = strCC_Name objCC.bBlind = True m_colCC.Add(objCC) objCC = Nothing Add_Bcc = True Catch Add_Bcc = False objCC = Nothing End Try End Function Public Function Send() As String Dim sResponseCode As String Dim sResponse As String Dim strMsg As String Dim sRegister As String Dim iCnt As Long Dim s As String Dim sTmp As String Dim bOK As Boolean Dim objCC As TRecipient Try Send = "OK" If m_sServer = "" Or m_iPort < 0 Then Send = "Tiene que inicializar el puerto del servidor para poder enviar mensajes" Exit Function End If tcpClient.Connect(m_sServer, m_iPort) networkStream = tcpClient.GetStream() sResponse = GetResponse() sResponseCode = Left(sResponse, 3) If sResponseCode <> "220" Then CloseCon() Send = sResponse Exit Function End If SendText("HELO " & m_sServer & vbCrLf) sResponse = GetResponse() sResponseCode = Left(sResponse, 3) If sResponseCode <> "250" Then CloseCon() Send = sResponse Exit Function End If If m_sUser = "" Then m_sUser = m_sSender End If SendText("MAIL FROM: " & m_sUser & vbCrLf) sResponse = GetResponse() sResponseCode = Left(sResponse, 3) If sResponseCode <> "250" Then CloseCon() Send = sResponse Exit Function End If SendText("RCPT TO: " & m_sRecipient & vbCrLf) sResponse = GetResponse() sResponseCode = Left(sResponse, 3) If sResponseCode <> "250" Then CloseCon() Send = sResponse Exit Function End If For Each objCC In m_colCC SendText("RCPT TO: " & objCC.strEMail & vbCrLf) sResponse = GetResponse() sResponseCode = Left(sResponse, 3) Select Case sResponseCode Case "550" '// Nada Case "250" m_colCC_OK.Add(objCC) Case Else CloseCon() Send = sResponse Exit Function End Select Next SendText("DATA" & vbCrLf) sResponse = GetResponse() sResponseCode = Left(sResponse, 3) If sResponseCode <> "354" Then CloseCon() Send = sResponse Exit Function End If strMsg = "Date: " strMsg = strMsg & Format(Now, "ddd, d. MMM yyyy ") strMsg = strMsg & Format(Now, "Long Time") SendText(strMsg & vbCrLf) If m_sRecipientName <> "" Then SendText("To: " & m_sRecipientName & " <" & m_sRecipient & ">" & vbCrLf) Else SendText("To: " & m_sRecipient & vbCrLf) End If If iCnt < 0 Then SendText("Cc: [email protected]" & vbCrLf) End If For Each objCC In m_colCC_OK If Not objCC.bBlind Then If objCC.strName <> "" Then SendText("Cc: " & objCC.strName & " <" & objCC.strEMail & ">" & vbCrLf) Else SendText("Cc: " & objCC.strEMail & vbCrLf) End If End If Next If m_sSenderName <> "" Then SendText("From: " & m_sSenderName & " <" & m_sSender & ">" & vbCrLf) Else SendText("From: " & m_sSender & vbCrLf) End If SendText("Reply To: " & m_sSender & vbCrLf) SendText("Subject: " & m_sSubject & vbCrLf) SendText(vbCrLf & m_sBody & vbCrLf) SendText("." & vbCrLf) sResponse = GetResponse() SendText("QUIT" & vbCrLf) CloseCon() Catch ex As Exception Send = ex.ToString End Try End Function End Class 'Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click ' Dim xx As SMTPSend.cSMTP = New SMTPSend.cSMTP() ' Dim yy As String ' xx.Sender = "[email protected]" ' xx.SenderName = "Rodrigo Sandoval" ' xx.Server = "ceo-system.com" ' xx.Subject = "Test" ' xx.Body = "Test Test Test Test Test" ' xx.Recipient = "[email protected]" ' xx.RecipientName = "RSV" ' xx.Port = 25 ' yy = xx.Send() ' MsgBox(yy) 'End Sub