打印本文 打印本文 关闭窗口 关闭窗口
用VB实现一个简单的ESMTP客户端
作者:武汉SEO闵涛  文章来源:敏韬网  点击数2604  更新时间:2009/4/23 18:59:49  文章录入:mintao  责任编辑:mintao
sp;       state = 7
        Case Else
        End Select
    Case 3  ''''FROM
        Select Case msgType
        Case 250
            SetRcpt "rpct@domain.com"
            state = 4
        Case 221
            Quit
            state = 7
        Case 573
            Quit
            state = 7
        Case 552, 451, 452  ''''failed
        Case 500, 501, 421  ''''error
        End Select
    Case 4  ''''RCPT
        Select Case msgType
        Case 250, 251  ''''user is ok
            msgsend = "DATA" + FLAG_LINE_END
            smtpClient.SendData msgsend
            Text1.Text = Text1.Text + msgsend + FLAG_LINE_END
            state = 5
        Case 550, 551, 552, 553, 450, 451, 452    ''''failed
                Quit
                state = 7

        Case 500, 501, 503, 421 ''''error
            Quit
            state = 7
        End Select
    Case 5  ''''DATA been sent
        Select Case msgType
        Case 354
            Send "from", "to", "no subject", "plain", "test"
            Text1.Text = Text1.Text + msgsend + FLAG_LINE_END
            state = 6
        Case 451, 554
        Case 500, 501, 503, 421
        End Select
    Case 6  ''''body been sent
        Select Case msgType
        Case 250
                Quit
                state = 7
        Case 552, 451, 452
        Case 500, 501, 502, 421
        End Select
    Case 7
        Select Case msgType
        Case 221    ''''process disconnected
            state = 0
        Case 500    ''''command error
        End Select
    End Select
   
End Sub

Private Sub Quit()
    Dim msgsend As String
    rs.Close
    conn.Close
    msgsend = "QUIT" + FLAG_LINE_END
    smtpClient.SendData msgsend
    Text1.Text = Text1.Text + msgsend + FLAG_LINE_END
End Sub

Private Sub Send(from As String, to1 As String, subject As String, ctype As String, content As String)
    Dim msgsend As String
    msgsend = "From: " + from + FLAG_LINE_END
    msgsend = msgsend + "To: " + to1 + FLAG_LINE_END
    msgsend = msgsend + "Subject: " + subject + FLAG_LINE_END
    msgsend = msgsend + "Date: " + CStr(Now) + FLAG_LINE_END
    msgsend = msgsend + "MIME-Version: 1.0" + FLAG_LINE_END
    msgsend = msgsend + "Content-Type: text/" + ctype + ";charset=gb2312" + FLAG_LINE_END
    ''''msgSend = msgSend + "Content-Transfer-Encoding: base64" + flag_line_end
    msgsend = msgsend + content + FLAG_LINE_END
    smtpClient.SendData msgsend
    smtpClient.SendData FLAG_MAIL_END
End Sub
Private Sub SetFrom(from As String)
    msgsend = "MAIL FROM: <" + from + ">" + FLAG_LINE_END
    smtpClient.SendData msgsend
    Text1.Text = Text1.Text + msgsend + FLAG_LINE_END
End Sub
Private Sub SetRcpt(rcpt As String)
    Dim msgsend As String
   
    msgsend = "RCPT TO: <" + rcpt + ">" + FLAG_LINE_END
    smtpClient.SendData msgsend
    Text1.Text = Text1.Text + msgsend + FLAG_LINE_END
End Sub

Private Sub smtpClient_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description
End Sub

2 func.bas

Attribute VB_Name = "Module1"
Private base64EncodeChars As String
Private base64DecodeChars(127) As Integer


Function base64encode(str As String) As String
    base64EncodeChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   
    Dim out, i, len1
    Dim c1, c2, c3
    len1 = Len(str)
    i = 0
    out = ""
   
    While i < len1
        c1 = Asc(Mid(str, i + 1, 1))
        i = i + 1
   
        If (i = len1) Then
            out = out + Mid(base64EncodeChars, c1 \ 4 + 1, 1)
            out = out + Mid(base64EncodeChars, (c1 And 3) * 16 + 1, 1)
            out = out + "=="
            base64encode = out
            Exit Function
        End If
        c2 = Asc(Mid(str, i + 1, 1))
        i = i + 1
        If (i = len1) Then
            out = out + Mid(base64EncodeChars, c1 \ 4 + 1, 1)
            out = out + Mid(base64EncodeChars, (((c1 And 3) * 16) Or ((c2 And 240) \ 16)) + 1, 1)
            out = out + Mid(base64EncodeChars, (c2 And 15) * 4 + 1, 1)
            out = out + "="
            base64encode = out
            Exit Function
        End If
        c3 = Asc(Mid(str, i + 1, 1))
        i = i + 1
        out = out + Mid(base64EncodeChars, c1 \ 4 + 1, 1)
        out = out + Mid(base64EncodeChars, (((c1 And 3) * 16) Or ((c2 And 240) \ 16)) + 1, 1)
        out = out + Mid(base64EncodeChars, (((c2 And 15) * 4) Or ((c3 And 192) \ 64)) + 1, 1)
        out = out + Mid(base64EncodeChars, (c3 And 63) + 1, 1)
    Wend

    base64encode = out
End Function

Function base64decode(str As String) As String

    For i = 0 To 127
        base64DecodeChars(i) = -1
    Next
    base64DecodeChars(43) = 62
    base64DecodeChars(47) = 63

    For i = 48 To 57
        base64DecodeChars(i) = i + 4
    Next

    For i = 65 To 90
        base64DecodeChars(i) = i - 65
    Next

    For i = 97 To 122
        base64DecodeChars(i) = i - 71
    Next

    Dim c1, c2, c3, c4
    Dim len1, out

    len1 = Len(str)
  

上一页  [1] [2] [3]  下一页

打印本文 打印本文 关闭窗口 关闭窗口