在VB6中写的一个发送简单邮件的类

 

None.gif'*****************************************************************************************
None.gif'
功能: 实现简单发送邮件的一个类
None.gif'
设计: OK_008
None.gif'
时间: 2007-07
None.gif'
*****************************************************************************************
None.gif
Option Explicit
None.gif
Private cdoMessage As CDO.Message
None.gif
None.gif
Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
None.gif
Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
None.gif
Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
None.gif
Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
None.gif
Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
None.gif
Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
None.gif
Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
None.gif
Private Const SMTPConnectionTimeout = 60
None.gif
None.gif
Private E_SendUsingMethod As Byte       '邮件发送选项
None.gif
Private E_SendSMTPAuthenticate As Byte  'SMTP验证选项
None.gif
Private E_SMTPServer As String          'SMTP服务器
None.gif
Private E_SMTPServerPort As Integer     'SMTP服务器端口
None.gif
Private E_SendUserName As String        '用户名
None.gif
Private E_SendPassword As String        '密码
None.gif

None.gif
Private E_EmailTo As String
None.gif
Private E_EmailFrom As String
None.gif
Private E_EmailSubject As String
None.gif
Private E_EmailTextBody As String
None.gif
None.gif
Public Property Get SendUsingPort() As Byte
None.gif    SendUsingPort 
= E_SendUsingMethod
None.gif
End Property
None.gif
None.gif
Public Property Let SendUsingPort(SUPort As Byte)
None.gif    E_SendUsingMethod 
= SUPort
None.gif
End Property
None.gif
None.gif
Public Property Get SMTPAuthenticate() As Byte
None.gif    SMTPAuthenticate 
= E_SendSMTPAuthenticate
None.gif
End Property
None.gif
None.gif
Public Property Let SMTPAuthenticate(SMTPType As Byte)
None.gif    E_SendSMTPAuthenticate 
= SMTPType
None.gif
End Property
None.gif
None.gif
Public Property Get SMTPServer() As String
None.gif    SMTPServer 
= E_SMTPServer
None.gif
End Property
None.gif
None.gif
Public Property Let SMTPServer(sServerName As String)
None.gif    E_SMTPServer 
= sServerName
None.gif
End Property
None.gif
None.gif
Public Property Get SMTPServerPort() As Integer
None.gif    SMTPServerPort 
= E_SMTPServerPort
None.gif
End Property
None.gif
None.gif
Public Property Let SMTPServerPort(ServerPort As Integer)
None.gif    E_SMTPServerPort 
= ServerPort
None.gif
End Property
None.gif
None.gif
Public Property Get SendUserName() As String
None.gif    SendUserName 
= E_SendUserName
None.gif
End Property
None.gif
None.gif
Public Property Let SendUserName(ServerLoginUser As String)
None.gif    E_SendUserName 
= ServerLoginUser
None.gif
End Property
None.gif
None.gif
Public Property Get SendPassword() As String
None.gif    SendPassword 
= E_SendPassword
None.gif
End Property
None.gif
None.gif
Public Property Let SendPassword(Pwd As String)
None.gif    E_SendPassword 
= Pwd
None.gif
End Property
None.gif
None.gif
Public Property Get EmailTo() As String
None.gif    EmailTo 
= E_EmailTo
None.gif
End Property
None.gif
None.gif
Public Property Let EmailTo(strEmail As String)
None.gif    E_EmailTo 
= strEmail
None.gif
End Property
None.gif
None.gif
Public Property Get EmailFrom() As String
None.gif    EmailFrom 
= E_EmailFrom
None.gif
End Property
None.gif
None.gif
Public Property Let EmailFrom(strEmail As String)
None.gif    E_EmailFrom 
= strEmail
None.gif
End Property
None.gif
None.gif
Public Property Get EmailSubject() As String
None.gif    EmailSubject 
= E_EmailSubject
None.gif
End Property
None.gif
None.gif
Public Property Let EmailSubject(strSubject As String)
None.gif    E_EmailSubject 
= strSubject
None.gif
End Property
None.gif
None.gif
Public Property Get EmailTextBody() As String
None.gif    EmailTextBody 
= E_EmailTextBody
None.gif
End Property
None.gif
None.gif
Public Property Let EmailTextBody(strTextBody As String)
None.gif    E_EmailTextBody 
= strTextBody
None.gif
End Property
None.gif
None.gif
'Error sub
None.gif
Private Sub ErrorSub()
None.gif    
MsgBox "Error " & Err.Number & " " & Err.Description, vbInformation + vbOKOnly, "Error Information"
None.gif
End Sub
None.gif
None.gif
'Send Email
None.gif
Public Function SendEmail() As Boolean
None.gif    
On Error GoTo Err_SendEmail
None.gif    
None.gif    
'Configuration
None.gif
    With cdoMessage.Configuration.Fields
None.gif        .Item(cdoSendUsingMethod) 
= E_SendUsingMethod
None.gif        .Item(cdoSMTPServer) 
= E_SMTPServer
None.gif        .Item(cdoSMTPServerPort) 
= E_SMTPServerPort
None.gif        .Item(cdoSMTPConnectionTimeout) 
= SMTPConnectionTimeout
None.gif        .Item(cdoSMTPAuthenticate) 
= E_SendSMTPAuthenticate
None.gif        .Item(cdoSendUserName) 
= E_SendUserName
None.gif        .Item(cdoSendPassword) 
= E_SendPassword
None.gif        .Update
None.gif    
End With
None.gif    
'Message
None.gif
    With cdoMessage
None.gif        .To 
= E_EmailTo
None.gif        .From 
= E_EmailFrom
None.gif        .Subject 
= E_EmailSubject
None.gif        .TextBody 
= E_EmailTextBody
None.gif        .Send
None.gif    
End With
None.gif    SendEmail 
= True
None.gif    
Exit Function
None.gifErr_SendEmail:
None.gif    ErrorSub
None.gif
End Function
None.gif
None.gif
'Verify Data
None.gif
Private Function VerifyData() As Boolean
None.gif    
Dim StrMsg As String
None.gif    
If E_SMTPServer = "" Then
None.gif        StrMsg 
= "SMTP服务器名没有填写|"
None.gif        
GoTo ErrorInput
None.gif    
End If
None.gif    
If E_SMTPServerPort <= 0 Then
None.gif        StrMsg 
= "SMTP 端口没有填写|"
None.gif        
GoTo ErrorInput
None.gif    
End If
None.gif    
If E_SendUserName = "" Then
None.gif        StrMsg 
= "用户名没有填写|"
None.gif        
GoTo ErrorInput
None.gif    
End If
None.gif    
If E_SendPassword = "" Then
None.gif        StrMsg 
= "密码没有填写|"
None.gif        
GoTo ErrorInput
None.gif    
End If
None.gif    VerifyData 
= True
None.gif    
Exit Function
None.gifErrorInput:
None.gif    
MsgBox GetLanguageStr(StrMsg), vbInformation + vbOKOnly, GetLanguageStr("信息提示|")
None.gif
End Function
None.gif
None.gif
'Save messages of configuration to database
None.gif
Public Function SaveConfigInfo(Optional ByVal intUpdateTyp As Integer = 1As Boolean
None.gif    
Dim objDBB As Object
None.gif    
Dim strSQL As String
None.gif    
On Error GoTo Err_SaveConfigInfo
None.gif    
None.gif    
If Not VerifyData Then Exit Function
None.gif    
'代码略
None.gif
    SaveConfigInfo = True
None.gif    
Exit Function
None.gifErr_SaveConfigInfo:
None.gif    ErrorSub
None.gif
End Function
None.gif
None.gif
'Read messages of configuration from database
None.gif
Public Sub ReadConfigInfo()
None.gif    
Dim objDBB As Object
None.gif    
Dim objRst As ADODB.Recordset
None.gif    
On Error GoTo Err_ReadConfigInfo
None.gif    
'其中的代码略
None.gif
    If Not objRst.EOF Then
None.gif        E_SendUsingMethod 
= objRst!SendUsingMethod
None.gif        E_SMTPServer 
= objRst!SMTPServer
None.gif        E_SMTPServerPort 
= objRst!ServerPort
None.gif        E_SendSMTPAuthenticate 
= objRst!Authenticate
None.gif        E_SendUserName 
= objRst!SendUserName
None.gif        E_SendPassword 
= objRst!SendPassword
None.gif        E_EmailTo 
= objRst!EmailTo
None.gif    
End If
None.gif    
If objRst.State = adStateOpen Then objRst.Close
None.gif    
Set objRst = Nothing
None.gif    
Set objDBB = Nothing
None.gif    
Exit Sub
None.gifErr_ReadConfigInfo:
None.gif    ErrorSub
None.gif
End Sub
None.gif
None.gif
Private Sub Class_Initialize()
None.gif    E_SendUsingMethod 
= 2
None.gif    E_SendSMTPAuthenticate 
= 1
None.gif    E_SMTPServerPort 
= 25
None.gif    
Set cdoMessage = New CDO.Message
None.gif
End Sub
None.gif
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值