用VB实现一个简单的ESMTP客户端

    技术2022-05-11  26

    最近发现JMail居然没有for VB的例子,本来想用C#写一个的,可是家里的电脑只有一个VB,好的程序员是不能受制于开发工具的(虽然我并不是个程序员)。

    花了一个晚上,面对着RFC0821和Ethereal的截包结果,功夫不负有心人,终于有一个简单的例子可以和大家共享了,希望大家讨论一下。(格式不怎么好,许多异常也没处理,另外VB的语法已经忘得差不多了,请大家谅解!)

    项目包括两个文件

    1 main.frm

    VERSION 5.00Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"Begin VB.Form Form1    Caption         =   "Form1"   ClientHeight    =   4725   ClientLeft      =   60   ClientTop       =   345   ClientWidth     =   5550   LinkTopic       =   "Form1"   ScaleHeight     =   4725   ScaleWidth      =   5550   StartUpPosition =   3  'Windows Default   Begin MSWinsockLib.Winsock smtpClient       Left            =   1680      Top             =   120      _ExtentX        =   741      _ExtentY        =   741      _Version        =   393216      RemoteHost      =   "mail.domain.com"      RemotePort      =   25   End   Begin VB.CommandButton Command2       Caption         =   "Connect"      Height          =   495      Left            =   120      TabIndex        =   3      Top             =   120      Width           =   1215   End   Begin VB.CommandButton Command1       Caption         =   "Send"      Height          =   375      Left            =   4560      TabIndex        =   2      Top             =   4200      Width           =   855   End   Begin VB.TextBox Text2       Height          =   315      Left            =   120      TabIndex        =   1      Top             =   4200      Width           =   4215   End   Begin VB.TextBox Text1       Height          =   3255      Left            =   120      MultiLine       =   -1  'True      ScrollBars      =   2  'Vertical      TabIndex        =   0      Top             =   840      Width           =   5295   EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate state As IntegerPrivate FLAG_LINE_END As StringPrivate FLAG_MAIL_END As String

    Private Sub Command1_Click()    Text2.Text = base64encode(utf16to8(Text2.Text))    'Text2.Text = base64decode(utf8to16(Text2.Text))End Sub

    Private Sub Command2_Click()    state = 0    smtpClient.Close    smtpClient.ConnectEnd Sub

    Private Sub Form_Load()    mailcount = 2    FLAG_LINE_END = Chr(13) + Chr(10)    FLAG_MAIL_END = FLAG_LINE_END + "." + FLAG_LINE_ENDEnd Sub

    Private Sub Form_Terminate()    smtpClient.CloseEnd Sub

    Private Sub smtpClient_Close()    'MsgBox "closed!"    state = 0End Sub

    Private Sub smtpClient_DataArrival(ByVal bytesTotal As Long)    Dim s As String    smtpClient.GetData s    Text1.Text = Text1.Text + s + FLAG_LINE_END    Dim msgHead As String    msgHead = Left(s, 3)    Dim msgBody As String    msgBody = Mid(s, 5)        Dim msgType As Integer    msgType = CInt(msgHead)    Dim msgsend As String        Select Case state    Case 0  'start state        Select Case msgType        Case 220            msgsend = "EHLO yourname" + FLAG_LINE_END            smtpClient.SendData msgsend            Text1.Text = Text1.Text + msgsend + FLAG_LINE_END            state = 1        Case 421    'Service not available        End Select    Case 1  'EHLO        Select Case msgType        Case 250            msgsend = "AUTH LOGIN" + FLAG_LINE_END            smtpClient.SendData msgsend            Text1.Text = Text1.Text + msgsend + FLAG_LINE_END            state = 2        Case 500, 501, 504, 421 'error happened        End Select    Case 2  'AUTH LOGIN        Select Case msgType        Case 334            If msgBody = "VXNlcm5hbWU6" + FLAG_LINE_END Then                msgsend = base64encode(utf16to8("username")) + FLAG_LINE_END                smtpClient.SendData msgsend                Text1.Text = Text1.Text + msgsend + FLAG_LINE_END            ElseIf msgBody = "UGFzc3dvcmQ6" + FLAG_LINE_END Then                msgsend = base64encode(utf16to8("password")) + FLAG_LINE_END                smtpClient.SendData msgsend                Text1.Text = Text1.Text + msgsend + FLAG_LINE_END            End If        Case 235    'correct            SetFrom "you@domain.com"            state = 3        Case 535    'incorrect            Quit            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_ENDEnd 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_ENDEnd SubPrivate Sub SetFrom(from As String)    msgsend = "MAIL FROM: <" + from + ">" + FLAG_LINE_END    smtpClient.SendData msgsend    Text1.Text = Text1.Text + msgsend + FLAG_LINE_ENDEnd SubPrivate 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_ENDEnd 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 DescriptionEnd Sub

    2 func.bas

    Attribute VB_Name = "Module1"Private base64EncodeChars As StringPrivate 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 = outEnd 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)    i = 0    out = ""        While (i < len1)           Do            c1 = base64DecodeChars(Asc(Mid(str, i + 1, 1)) And 255)            i = i + 1        Loop While (i < len1 And c1 = -1)        If (c1 = -1) Then            base64decode = out            Exit Function        End If           Do            c2 = base64DecodeChars(Asc(Mid(str, i + 1, 1)) And 255)            i = i + 1        Loop While (i < len1 And c2 = -1)        If (c2 = -1) Then            base64decode = out            Exit Function        End If        out = out + Chr((c1 * 4) Or ((c2 And 48) / 16))

            Do            c3 = base64DecodeChars(Asc(Mid(str, i + 1, 1)) And 255)            i = i + 1            If (c3 = 61) Then                base64decode = out                c3 = base64DecodeChars(c3)            End If        Loop While (i < len1 And c3 = -1)        If (c3 = -1) Then            base64decode = out            Exit Function        End If        out = out + Chr(((c2 And 15) * 16) Or ((c3 And 60) / 4))

            Do            c4 = base64DecodeChars(Asc(Mid(str, i + 1, 1)) And 255)            i = i + 1            If (c4 = 61) Then                base64decode = out                c4 = base64DecodeChars(c4)            End If        Loop While (i < len1 And c4 = -1)        If (c4 = -1) Then            base64decode = out            Exit Function        End If

            out = out + Chr(((c3 And 3) * 64) Or c4)    Wend        base64decode = outEnd Function

    Function utf16to8(str As String) As String

        Dim out, i, len1, c    out = ""    len1 = Len(str)    For i = 1 To len1        c = Asc(Mid(str, i, 1))        If ((c >= 1) And (c <= 127)) Then            out = out + Mid(str, i, 1)        ElseIf (c > 2047) Then            out = out + Chr(224 Or ((c / 4096) And 15))            out = out + Chr(128 Or ((c / 64) And 63))            out = out + Chr(128 Or (c And 63))        Else            out = out + Chr(192 Or ((c / 64) And 31))            out = out + Chr(128 Or (c And 63))        End If    Next    utf16to8 = outEnd Function

    Function utf8to16(str As String) As String

        Dim out, i, len1, c    Dim char2, char3

        out = ""    len1 = Len(str)    i = 0    While (i < len1)        c = Asc(Mid(str, i + 1, 1))        i = i + 1        Select Case (c / 16)            Case 0 To 7            out = out + Mid(str, i, 1)                Case 12, 13            char2 = Asc(Mid(str, i + 1, 1))            i = i + 1            out = out + Chr(((c And 31) * 64) Or (char2 And 31))        Case 14            char2 = Asc(Mid(str, i + 1, 1))            i = i + 1            char3 = Asc(Mid(str, i + 1, 1))            i = i + 1            out = out + Chr(((c And 15) * 4096) Or ((char2 And 63) * 64) Or ((char3 And 63)))        End Select    Wend

        utf8to16 = outEnd Function

     


    最新回复(0)