在写个ASP的邮件发送组件,遇到问题多,请教了
第一次用winsock,郁闷,DLL不知怎么用那个DataArrival事件,又不知该怎么才知道已连通才发信,谁有邮件发送组件的源码啊,弄来看看啊~~~~
提点意见也好啊~~~~~~~~~
Option Explicit
Private StrCharset As String
Private StrContentType As String
Private StrServerAddress As String
Private IntPort As Integer
Private StrMailServerUserName As String
Private StrMailServerPassword As String
Private StrFrom As String
Private StrFromName As String
Private StrSubject As String
Private StrBody As String
Private StrRecipient As String
Private IntPriority As Integer
Private ErrInt As Integer
Private ErrStr As String
Private Enum SMTP_State
MAIL_CONNECT
MAIL_HELO
MAIL_FROM
MAIL_RCPTTO
MAIL_DATA
MAIL_DOT
MAIL_QUIT
MAIL_USER
MAIL_PASS
MAIL_LOGIN
End Enum
Private m_State As SMTP_State
'语言编码
Public Property Let Charset(ByVal Str As String)
If Str = "" Then
StrCharset = "GB2312"
Else
StrCharset = Str
End If
End Property
'邮件编码
Public Property Let ContentType(ByVal Str As String)
If Str = "" Then
StrContentType = "Text/Html"
Else
StrContentType = Str
End If
End Property
'SMTP服务器地址
Public Property Let ServerAddress(ByVal Str As String)
StrServerAddress = Str
End Property
'SMTP服务器端口
Public Property Let Port(ByVal I As Integer)
If Not IsNumeric(I) Or I = 0 Then
IntPort = 25
Else
IntPort = I
End If
End Property
'SMTP验证用户名
Public Property Let MailServerUserName(ByVal Str As String)
StrMailServerUserName = Base64(Trim(Str))
End Property
'SMTP验证密码
Public Property Let MailServerPassword(ByVal Str As String)
StrMailServerPassword = Base64(Str)
End Property
'发信人地址
Public Property Let From(ByVal Str As String)
StrFrom = Str
End Property
'发信人姓名
Public Property Let FromName(ByVal Str As String)
StrFromName = Str
End Property
'邮件标题
Public Property Let Subject(ByVal Str As String)
StrSubject = Str
End Property
'收件人地址,可以多个收件人
Public Sub AddRecipient(ByVal Str As String)
If Right(Str, 1) <> ";" Then Str = Str & ";"
StrRecipient = Str
End Sub
'邮件标题
Public Property Let Body(ByVal Str As String)
StrBody = Str
End Property
'邮件级别
Public Property Let Priority(ByVal I As Integer)
If Not IsNumeric(I) Or I = 0 Or I > 3 Then
IntPriority = 2
Else
IntPriority = I
End If
End Property
'应该在执行过可能产生错误的函数后及时调用此函数,获取最新的错误信息。
Public Property Get OnErr() As Integer
OnErr = ErrInt
End Property
Public Property Get Description() As String
Description = ErrStr
End Property
Public Function Send() As Boolean
'On Error GoTo ErrSend
Dim StrServerResponse As String '服务器返回的信息
Dim StrResponseCode As String
Dim StrReName() As String
Dim StrRe() As String
Dim II As Long
Dim StrData, StrTemp As String
Dim Sock As MSWinsockLib.Winsock
Set Sock = New Winsock
Sock.RemoteHost = StrServerAddress
Sock.RemotePort = IntPort
Sock.Protocol = sckTCPProtocol
Const RandString As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_"
Dim GlobalStr As String
For II = 1 To 24
GlobalStr = GlobalStr & Mid(RandString, Int(Rnd * Len(RandString)) + 1, 1)
Next II
StrData = "Subject:" & Chr(32) & StrSubject & vbCrLf & "X-Mailer: SkyGz MAIL1.0" & vbCrLf & "X-Priority: " & CStr(IntPriority) & vbCrLf & "MIME-Version: 1.0" & _
vbCrLf & "Content-Type: multipart/alternative;" & vbCrLf & Chr(9) & "boundary=""----=_NextPart_" & GlobalStr & """" & vbCrLf & vbCrLf & "This Is A Multi-Part Message In MIME Format." & vbCrLf & vbCrLf & "------=_NextPart_" & GlobalStr & _
vbCrLf & "Content-Type: " & StrContentType & "; charset=" & StrCharset & ";" & vbCrLf & vbCrLf & StrBody & vbCrLf & vbCrLf & "------=_NextPart_" & GlobalStr & "--" & vbCrLf
Dim Net As SkyGz.NetWork
Set Net = New SkyGz.NetWork
StrRe = Split(StrRecipient, ";")
For II = 0 To UBound(StrRe) - 1
Sock.Connect StrServerAddress, IntPort
m_State = MAIL_CONNECT
Sock.GetData StrServerResponse
StrResponseCode = Left(StrServerResponse, 3)
If StrResponseCode = "250" Or StrResponseCode = "220" Or StrResponseCode = "354" Or StrResponseCode = "334" Or StrResponseCode = "235" Then
Select Case m_State
Case MAIL_CONNECT
m_State = MAIL_HELO
Sock.SendData "HELO " & Trim$(StrFrom) & vbCrLf
Case MAIL_HELO
m_State = MAIL_USER
Sock.SendData "AUTH LOGIN" & vbCrLf
Case MAIL_USER
m_State = MAIL_PASS
Sock.SendData (StrMailServerUserName) & vbCrLf
Case MAIL_PASS
m_State = MAIL_LOGIN
Sock.SendData (StrMailServerPassword) & vbCrLf
Case MAIL_LOGIN
m_State = MAIL_FROM
Sock.SendData "MAIL FROM:" & Trim$(StrFrom) & vbCrLf
Case MAIL_FROM
m_State = MAIL_RCPTTO
Sock.SendData "RCPT TO:" & Trim$(StrRe(II)) & vbCrLf
Case MAIL_RCPTTO
m_State = MAIL_DATA
Sock.SendData "DATA" & vbCrLf
Case MAIL_DATA
m_State = MAIL_DOT
StrReName = Split(StrRe(II), "@")
StrTemp = "Data: " & GetMailDateAndTime(Now) & vbCrLf
StrTemp = StrTemp & "From: " & StrFromName & "<" & StrFrom & ">" & vbCrLf
StrTemp = StrTemp & "To: " & StrReName(0) & "<" & StrRe(II) & ">" & vbCrLf
StrData = StrTemp & StrData & "." & vbCrLf
Sock.SendData (StrData)
Case MAIL_DOT
m_State = MAIL_QUIT
Sock.SendData "QUIT" & vbCrLf
Case MAIL_QUIT
ErrInt = 3
ErrStr = "发送成功"
Sock.Close
Send = True
End Select
Else
ErrInt = 4
ErrStr = "发送失败"
Sock.Close
Send = False
End If
Next II
Set Sock = Nothing
'Exit Function
'ErrSend:
'Sock.Close
'Send = False
'Set Sock = Nothing
End Function