www.pudn.com > c++smtp.rar > Form1.frm
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6705
ClientLeft = 60
ClientTop = 345
ClientWidth = 6450
LinkTopic = "Form1"
ScaleHeight = 6705
ScaleWidth = 6450
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtEmailBodyOfMessage
Height = 3015
Left = 120
TabIndex = 6
Top = 3240
Width = 6135
End
Begin VB.TextBox txtEmailSubject
Height = 375
Left = 120
TabIndex = 5
Top = 2400
Width = 6135
End
Begin VB.TextBox txtToEmailAddress
Height = 375
Left = 120
TabIndex = 4
Top = 1440
Width = 1695
End
Begin VB.TextBox txtFromEmailAddress
Height = 375
Left = 2280
TabIndex = 3
Top = 1440
Width = 1935
End
Begin VB.TextBox txtFromName
Height = 375
Left = 2280
TabIndex = 2
Top = 600
Width = 1935
End
Begin VB.TextBox txtEmailServer
Height = 375
Left = 120
TabIndex = 1
Top = 600
Width = 1695
End
Begin MSWinsockLib.Winsock Winsock1
Left = 6000
Top = 1920
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "连接"
Height = 495
Left = 4920
TabIndex = 0
Top = 240
Width = 1215
End
Begin VB.Label StatusTxt
Caption = "Label7"
Height = 255
Left = 120
TabIndex = 13
Top = 6360
Width = 6135
End
Begin VB.Label Label6
Caption = "邮件正文"
Height = 255
Left = 120
TabIndex = 12
Top = 2880
Width = 975
End
Begin VB.Label Label5
Caption = "发件人地址"
Height = 255
Left = 2280
TabIndex = 11
Top = 1080
Width = 1575
End
Begin VB.Label Label4
Caption = "邮件主题"
Height = 255
Left = 120
TabIndex = 10
Top = 2040
Width = 1575
End
Begin VB.Label Label3
Caption = "收件人地址"
Height = 255
Left = 120
TabIndex = 9
Top = 1080
Width = 1335
End
Begin VB.Label Label2
Caption = "邮件发送人姓名"
Height = 255
Left = 2280
TabIndex = 8
Top = 240
Width = 1455
End
Begin VB.Label Label1
Caption = "邮件服务器地址"
Height = 255
Left = 120
TabIndex = 7
Top = 240
Width = 1695
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Response As String, Reply As Integer
Dim DateNow As String, first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single
Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or
'you can only send 1 e-mail per program
'start
If Winsock1.State = sckClosed Then 'Check to see if socet is closed
DateNow = Format(Date, "Ddd") & ", " _
& Format(Date, "dd Mmm YYYY") & " " _
& Format(Time, "hh:mm:ss") & "" & " -0600"
' Get who's sending E-Mail address
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
' Get who mail is going to
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
' Date when being sent
Third = "Date:" + Chr(32) + DateNow + vbCrLf
' Who's Sending
Fourth = "From:" + Chr(32) + FromName + vbCrLf
' Who it going to
Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
' Subject of E-Mail
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
' E-mail message body
Seventh = EmailBodyOfMessage + vbCrLf
' What program sent the e-mail, customize this
Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
' Combine for proper SMTP sending
Eighth = Fourth + Third + Ninth + Fifth + Sixth
Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
Winsock1.RemoteHost = MailServerName ' Set the server address
Winsock1.RemotePort = 25 ' Set the SMTP Port
Winsock1.Connect ' Start connection
WaitFor ("220")
StatusTxt.Caption = "Connecting...."
StatusTxt.Refresh
Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
WaitFor ("250")
StatusTxt.Caption = "Connected"
StatusTxt.Refresh
Winsock1.SendData (first)
StatusTxt.Caption = "Sending Message"
StatusTxt.Refresh
WaitFor ("250")
Winsock1.SendData (Second)
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)
WaitFor ("354")
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
WaitFor ("250")
Winsock1.SendData ("quit" + vbCrLf)
StatusTxt.Caption = "Disconnecting"
StatusTxt.Refresh
WaitFor ("221")
Winsock1.Close
Else
MsgBox (Str(Winsock1.State))
End If
End Sub
Sub WaitFor(ResponseCode As String)
Start = Timer ' Time event so won't get stuck in loop
While Len(Response) = 0
Tmr = Start - Timer
DoEvents ' Let System keep checking for incoming response **IMPORTANT**
If Tmr > 50 Then ' Time in seconds to wait
MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
Exit Sub
End If
Wend
While Left(Response, 3) <> ResponseCode
DoEvents
If Tmr > 50 Then
MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
Exit Sub
End If
Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub
Private Sub Command1_Click()
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text 'MsgBox ("Mail Sent")
StatusTxt.Caption = "Mail Sent"
StatusTxt.Refresh
Beep
Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub