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

下面的例子是转载国外的，可以实现不使用CDO和IIS发送邮件。说明：本例子没有经过测试，原地址在：
http://www.dotnetforums.net/t81508.html 

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: office@ngs.at" & 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 = "rsandoval@ceo-system.com"
'    xx.SenderName = "Rodrigo Sandoval"
'    xx.Server = "ceo-system.com"
'    xx.Subject = "Test"
'    xx.Body = "Test Test Test Test Test"
'    xx.Recipient = "rodrigo_sandoval_v@msn.com"
'    xx.RecipientName = "RSV"
'    xx.Port = 25

'    yy = xx.Send()
'    MsgBox(yy)
'End Sub