📄 smtp.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form smtp
Caption = "发送电子邮件"
ClientHeight = 6585
ClientLeft = 60
ClientTop = 345
ClientWidth = 8040
LinkTopic = "Form1"
ScaleHeight = 6585
ScaleWidth = 8040
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame3
Caption = "信息提示"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1935
Left = 60
TabIndex = 14
Top = 4620
Width = 7935
Begin VB.TextBox txtMsg
Height = 1455
Left = 60
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 15
Top = 360
Width = 7755
End
End
Begin VB.Frame Frame2
Height = 2055
Left = 60
TabIndex = 2
Top = 60
Width = 7935
Begin VB.CommandButton cmdSetUp
Caption = "服务器设置"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4920
TabIndex = 16
Top = 1500
Width = 1275
End
Begin VB.CommandButton cmdSend
Caption = "发送"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6300
TabIndex = 13
Top = 1500
Width = 1215
End
Begin VB.TextBox txtTo
Appearance = 0 'Flat
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1500
TabIndex = 7
Text = "busywang@zhongjun"
Top = 180
Width = 2355
End
Begin VB.TextBox txtFrom
Appearance = 0 'Flat
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5160
TabIndex = 6
Text = "busyzhong@10.11.111.119"
Top = 240
Width = 2355
End
Begin VB.TextBox txtSName
Appearance = 0 'Flat
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1500
TabIndex = 5
Text = "busyzhong"
Top = 600
Width = 2355
End
Begin VB.TextBox txtRName
Appearance = 0 'Flat
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5160
TabIndex = 4
Text = "busywang"
Top = 600
Width = 2355
End
Begin VB.TextBox txtSubject
Appearance = 0 'Flat
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1500
TabIndex = 3
Text = "你接到信了吗？"
Top = 1020
Width = 6015
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "To:"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 60
TabIndex = 12
Top = 180
Width = 1215
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "From:"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 11
Top = 240
Width = 1215
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "发送方姓名:"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 10
Top = 600
Width = 1215
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "接收方姓名:"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3840
TabIndex = 9
Top = 600
Width = 1215
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "主题："
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 60
TabIndex = 8
Top = 1020
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "正文"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2295
Left = 60
TabIndex = 0
Top = 2220
Width = 7935
Begin VB.TextBox txtContent
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1875
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Text = "smtp.frx":0000
Top = 300
Width = 7695
End
End
Begin MSWinsockLib.Winsock Wsock
Left = 6600
Top = 1680
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
Attribute VB_Name = "smtp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public ServerIp As String 'SMTP服务器地址
Public ServerPort As Long 'SMTP服务器端口
Dim strSendName As String '发送人姓名
Dim strReceiveName As String '接收人姓名
Dim strFromMail As String '发送人地址
Dim strToMail As String '接收人地址
Dim m_Date As String '发送日期
Dim strSubject As String '主题
Dim strContent As String '正文
Dim Information As String '从服务器接收响应消息
Private Sub cmdSend_Click()
'设置Winsock
Wsock.Close
Wsock.RemoteHost = ServerIp
Wsock.RemotePort = ServerPort
strSendName = txtSName.Text
strReceiveName = txtRName.Text
strFromMail = txtFrom.Text
strToMail = txtTo.Text
m_Date = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
strSubject = txtSubject.Text
strContent = txtContent.Text
Dim mData As String
'构造信件标题字段
mData = "From:" & Chr(32) & strSendName & vbCrLf & _
"Date:" & Chr(32) & m_Date & vbCrLf & _
"X-Mailer: BigAnt Smtp Mailer V1.0" & vbCrLf & _
"To:" & Chr(32) & strReceiveName & vbCrLf & _
"Subject:" & Chr(32) & strSubject & vbCrLf
Wsock.Close
'连接SMTP服务器
Wsock.Connect
If Not WaitForResponse("220", 10) Then
txtMsg.Text = "邮件服务器连接不上......"
Exit Sub
End If
'打开对话
Wsock.SendData "HELO" & " " & Wsock.LocalHostName & vbCrLf
If Not WaitForResponse("250", 10) Then
txtMsg.Text = txtMsg.Text & "无法打开邮件发送对话" & vbCrLf
Exit Sub
End If
'发送发送方地址
Wsock.SendData "MAIL FROM:" & " " & strFromMail & vbCrLf
If Not WaitForResponse("250", 10) Then
txtMsg.Text = txtMsg.Text & "无法发送发送方地址" & vbCrLf
Exit Sub
End If
'发送接收方地址
Wsock.SendData "RCPT TO:" & " " & strToMail & vbCrLf
If Not WaitForResponse("250", 10) Then
txtMsg.Text = txtMsg.Text & "无法发送接收方地址" & vbCrLf
Exit Sub
End If
'发送消息体
Wsock.SendData "DATA" & vbCrLf
If Not WaitForResponse("354", 10) Then
txtMsg.Text = txtMsg.Text & "无法发送消息体" & vbCrLf
Exit Sub
End If
Wsock.SendData mData & vbCrLf
Wsock.SendData strContent & vbCrLf
Wsock.SendData "." & vbCrLf
If Not WaitForResponse("250", 20) Then
txtMsg.Text = txtMsg.Text & "消息体发送不成功" & vbCrLf
Exit Sub
End If
'结束邮件发送对话
Wsock.SendData "QUIT" & vbCrLf
If Not WaitForResponse("221", 10) Then
Exit Sub
End If
Wsock.Close
txtMsg.Text = txtMsg.Text & "邮件发送成功"
txtMsg.Text = txtMsg.Text & mData & vbCrLf & strContent & vbCrLf
End Sub
'该按扭事件过程用于设置smtp服务器
Private Sub cmdSetUp_Click()
frmSetup.Show
End Sub
'程序加载时读出上次的设置
Private Sub Form_Load()
ServerIp = GetSetting("email", "smtpserver", "serverip", "")
ServerPort = GetSetting("email", "smtpserver", "serverport", 25)
Wsock.Protocol = sckTCPProtocol
End Sub
'程序退出时保存设置
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
SaveSetting "email", "smtpserver", "serverip", ServerIp
SaveSetting "email", "smtpserver", "serverport", ServerPort
End Sub
'接收服务器的响应消息
Private Sub Wsock_DataArrival(ByVal bytesTotal As Long)
Wsock.GetData Information
txtMsg.Text = txtMsg.Text & Information & vbCrLf
End Sub
'该函数用于等待服务器响应码
Private Function WaitForResponse(strResponse As String, WaitTime As Integer) As Boolean
Dim WaitSt As Date
WaitSt = Now()
While InStr(1, Information, strResponse, vbTextCompare) < 1
DoEvents
If DateDiff("s", WaitSt, Now) > WaitTime Then
Information = ""
WaitForResponse = False
Exit Function
End If
Wend
Information = ""
WaitForResponse = True
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -