当前位置:首页 > 编程开发 > VB SMTP用户验证发送mail

VB SMTP用户验证发送mail

这几天技术宅在捣鼓怎么发送“垃圾邮件”,呵呵其实是想做一个群发邮件的小软件,希望通过vb来应用smtp进行发信息。怎耐自己功夫其实还不到家,折腾了好久也没有成功。倒是在这个过程中学习到了一些东西,也找到了一些比较不错的源码,有很多都是花费了九牛二虎之力才找到的,不能说不辛苦。今天的,技术宅给大家分享一份源码:VB SMTP用户验证发送mail。

这封源码技术宅因为后来实在弄到焦头烂额了,没有仔细研究,不过他的注释都是很清楚的,肯定有值得大家学习的地方。

Option Explicit
Private WithEvents Sock As MSWinsockLib.Winsock
Private StrCharset As String                    '语言编码
Private StrContentType As String                '邮件编码
Private StrServerAddress As String              'SMTP服务器地址
Private StrMailServerUserName As String        'SMTP验证用户名
Private StrMailServerPassword As String        'SMTP验证密码
Private StrFrom As String                      '发信人地址
Private StrFromName As String                  '发信人姓名
Private StrSubject As String                    '邮件标题
Private StrBody As String                      '邮件内容
Private StrRecipient As String                  '收件人地址
Private LngPriority As Long                    '邮件级别
Private LngPort As Long                        'SMTP服务器端口
Private ErrInt As Integer
Private ErrStr As String
'语言编码
Public Property Let Charset(ByVal Str As String)
    StrCharset = Str
End Property
'邮件编码
Public Property Let ContentType(ByVal Str As String)
    StrContentType = Str
End Property
'SMTP服务器地址
Public Property Let ServerAddress(ByVal Str As String)
    StrServerAddress = Str
End Property
'SMTP服务器端口
Public Property Let Port(ByVal II As Long)
    LngPort = II
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)
    StrRecipient = Str
End Sub
'邮件内容
Public Property Let Body(ByVal Str As String)
    StrBody = Str
End Property
'邮件级别
Public Property Let Priority(ByVal II As Long)
    LngPriority = II
End Property
'应该在执行过可能产生错误的函数后及时调用此函数,获取最新的错误信息。
Public Property Get OnErr() As Integer
    OnErr = ErrInt
End Property
Public Property Get Description() As String
    Description = ErrStr
End Property
Private Sub Class_Initialize()
Set Sock = New MSWinsockLib.Winsock
End Sub
Private Sub Class_Terminate()
Sock.Close
Set Sock = Nothing
End Sub
Public Sub Send() '发送
    If LngPort < 1 Then LngPort = 25
    If LngPriority < 1 Or LngPriority > 5 Then LngPriority = 2
    If StrCharset = "" Then StrCharset = "GB2312"
    If StrC Then StrC
    If Right(StrRecipient, 1) <> ";" Then StrRecipient = StrRecipient & ";"
    Sock.Close '关闭连接
    Sock.Connect StrServerAddress, LngPort '连接邮件服务器
End Sub
Private Sub Sock_DataArrival(ByVal bytesTotal As Long)
    Dim StrServerResponse  As String '服务器返回的信息
    Dim StrResponseCode As String
    Dim StrRe() As String
    Dim II As Long
    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

    '获取邮件服务器返回信息
    Sock.GetData StrServerResponse
    StrResponseCode = Left(StrServerResponse, 3)

    '登陆邮件服务器,SMTP验证
    Sock.SendData "HELO " & Trim$(StrFrom) & vbCrLf
    Sock.SendData "AUTH LOGIN" & vbCrLf
    Sock.SendData (StrMailServerUserName) & vbCrLf
    Sock.SendData (StrMailServerPassword) & vbCrLf

    StrRe = Split(StrRecipient, ";")
    For II = 0 To UBound(StrRe) - 1 '发送到多个收件人
    If StrResp Or _
      StrResp Or _
      StrResp Or _
      StrResp Or _
      StrResp Then
        Sock.SendData "MAIL FROM:" & Trim$(StrFrom) & vbCrLf '寄件人
        Sock.SendData "RCPT TO:" & Trim$(StrRe(II)) & vbCrLf '收件人
        Sock.SendData "DATA" & vbCrLf
        Sock.SendData "From: " & StrFromName & " <" & StrFrom & ">" & vbCrLf '寄件人
        Sock.SendData "To: " & Mid(StrRe(II), 1, InStr(StrRe(II), "@") - 1) & " <" & StrRe(II) & ">" & vbCrLf '收件人
        Sock.SendData "Subject:" & Chr(32) & StrSubject & vbCrLf '邮件主题
        Sock.SendData "X-Mailer: SkyGz MAIL1.0" & vbCrLf '邮件发送者
        Sock.SendData "X-Priority: " & CStr(LngPriority) & vbCrLf '邮件发送级别
        Sock.SendData "MIME-Version: 1.0" & vbCrLf
        Sock.SendData "Content-Type: multipart/alternative;" & vbCrLf & Chr(9) & "boundary=""----=_NextPart_" & GlobalStr & """" & vbCrLf & vbCrLf
        Sock.SendData "This Is A Multi-Part Message In MIME Format." & vbCrLf & vbCrLf
        Sock.SendData "------=_NextPart_" & GlobalStr & vbCrLf
        Sock.SendData "Content-Type: " & StrContentType & "; charset=" & StrCharset & ";" & vbCrLf & vbCrLf '语言编码和邮件编码
        Sock.SendData StrBody & vbCrLf & vbCrLf '邮件内容
        Sock.SendData "------=_NextPart_" & GlobalStr & "--" & vbCrLf
        Sock.SendData "." & vbCrLf
        ErrInt = 3
        ErrStr = "发送成功"
        'Sock.Close
        'Send = True
    Else
        ErrInt = 4
        ErrStr = "发送失败"
        'Sock.Close
        'Send = False
    End If
    Next II
        Sock.SendData "QUIT" & vbCrLf '退出邮件服务器
End Sub
Private Function Base64(ByVal Str As String) As String 'base6加密算法
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim StrTempLine As String
    Dim j As Integer
    For j = 1 To (Len(Str) - Len(Str) Mod 3) Step 3
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1))  4) + 1, 1)
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, ((Asc(Mid(Str, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(Str, j + 1, 1))  16) + 1, 1)
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, ((Asc(Mid(Str, j + 1, 1)) Mod 16) * 4 _
                      + Asc(Mid(Str, j + 2, 1))  64) + 1, 1)
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j + 2, 1)) Mod 64) + 1, 1)
    Next j
    If Not (Len(Str) Mod 3) = 0 Then
        If (Len(Str) Mod 3) = 2 Then
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1))  4) + 1, 1)
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(Str, j + 1, 1))  16 + 1, 1)
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j + 1, 1)) Mod 16) * 4 + 1, 1)
            StrTempLine = StrTempLine & "="
        ElseIf (Len(Str) Mod 3) = 1 Then
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, Asc(Mid(Str, j, 1))  4 + 1, 1)
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1)) Mod 4) * 16 + 1, 1)
            StrTempLine = StrTempLine & "=="
        End If
    End If
    Base64 = StrTempLine
End Function

最后技术宅想说,就算做好了群发软件希望也只是测试,不要真正拿来干一些非法的事情哈。

感谢:源码来源 http://www.mailwhy.com/yjkf/VB/585.html

友荐云推荐
  • «
  • »
  • 作者:
    除非注明,本文原创:技术宅,欢迎转载!转载请以链接形式注明本文地址,谢谢。
    原文链接:http://www.jishuzh.com/program/vb-smtp用户验证发送mail.html

    One thought on “VB SMTP用户验证发送mail

    1. 疯子

      VB不会,不过PHP也是可以实现的!但由于php是放在服务端的。可行性不大!再加上性能没有VB这些的好!所以没有出现过违法的事情!处理正常的邮件还是没得问题。

    评论已关闭.