I recently found that Jmail actually didn't have a for VB. I wanted to write one with C #, but the computer's computer had only one VB, and the good programmer cannot be subject to development tools (although I am not a programmer).
It took a night, facing the results of RFC0821 and Ethereal, Kung Fu did not have a person, and finally there was a simple example to share with you, I hope everyone will discuss it. (The format is not good, many abnormalities have not been dealt, the syntax of the VB has been forgotten, please understand!)
The project includes two files
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 = "connection" 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 StringPrivate Sub Command1_Click () Text2.Text = base64encode (utf16to8 (Text2.Text)) 'Text2.Text = Base64Decode (UTF8TO16 (TEXT2.TEXT)) End Sub
Private sub fascist2_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 = 0nd 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 MSGTYP e 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 "@@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 SubPrivate 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 SMT pClient.SendData msgsend Text1.Text = Text1.Text msgsend FLAG_LINE_ENDEnd SubPrivate 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 Do c3 = base64decodechars (ASC (MID (STR (STR (STR (STR (I 1))) and 255) i = i 1 IF (C3 = 61) Then Base64Decode = OUT C3 = Base64DecodeChars (C3) end if loop while (i Do C4 = Base64Decodechars (ASC (STR (STR (STR (STR (STR (I 1))) and 255) i = i 1 f (c4 = 61) Then Base64decode = OUT C4 = Base64DECodechars (C4) end if loop while (i 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
