下面的例子是转载国外的，可以实现不使用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
