📄 winsoc~1.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain
Caption = "邮件发送"
ClientHeight = 4845
ClientLeft = 60
ClientTop = 345
ClientWidth = 7185
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4845
ScaleWidth = 7185
StartUpPosition = 2 '屏幕中心
Begin MSWinsockLib.Winsock Winsock1
Left = 240
Top = 4200
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox Text1
Height = 1395
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 16
Top = 1920
Width = 5955
End
Begin VB.Frame Frame1
Caption = "Status:"
Height = 615
Left = 960
TabIndex = 15
Top = 3480
Width = 5175
Begin MSComctlLib.StatusBar Statustxt
Height = 255
Left = 0
TabIndex = 17
Top = 240
Width = 5175
_ExtentX = 9128
_ExtentY = 450
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
End
Begin VB.TextBox txtEmailServer
Height = 285
Left = 3600
TabIndex = 13
Text = "xx.163.com"
Top = 1440
Width = 3375
End
Begin VB.TextBox ToNametxt
Height = 285
Left = 3600
TabIndex = 11
Top = 840
Width = 3375
End
Begin VB.TextBox txtFromName
Height = 285
Left = 3600
TabIndex = 9
Top = 240
Width = 3375
End
Begin VB.CommandButton Command2
Caption = "&Exit"
Height = 495
Left = 4440
TabIndex = 8
Top = 4200
Width = 1695
End
Begin VB.TextBox txtEmailBodyOfMessage
Height = 1455
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 1920
Width = 6855
End
Begin VB.TextBox txtEmailSubject
Height = 285
Left = 120
TabIndex = 5
Text = "你还好吗！"
Top = 1440
Width = 3255
End
Begin VB.TextBox txtToEmailAddress
Height = 285
Left = 120
TabIndex = 3
Text = "stard001@sohu.com"
Top = 840
Width = 3255
End
Begin VB.TextBox txtFromEmailAddress
Height = 285
Left = 120
TabIndex = 1
Text = "hoary@163.com"
Top = 240
Width = 3255
End
Begin VB.CommandButton Command1
Caption = "&Send E-Mail"
Height = 495
Left = 960
TabIndex = 0
Top = 4200
Width = 2175
End
Begin VB.Label Label6
Caption = "E-Mail Server"
Height = 255
Left = 3600
TabIndex = 14
Top = 1200
Width = 3375
End
Begin VB.Label Label5
Caption = "There Name"
Height = 255
Left = 3600
TabIndex = 12
Top = 600
Width = 3375
End
Begin VB.Label Label4
Caption = "Your Name"
Height = 255
Left = 3600
TabIndex = 10
Top = 0
Width = 3135
End
Begin VB.Label Label3
Caption = "Subject"
Height = 255
Left = 120
TabIndex = 6
Top = 1200
Width = 1215
End
Begin VB.Label Label2
Caption = "To"
Height = 255
Left = 120
TabIndex = 4
Top = 600
Width = 1575
End
Begin VB.Label Label1
Caption = "From (e-mail address)"
Height = 255
Left = 120
TabIndex = 2
Top = 0
Width = 2175
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Response As String, Reply As Integer, DateNow As String
Dim 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
Dim mn As String
Private Sub Command1_Click()
Winsock1.RemoteHost = "xx.163.com" '返回或设置远程计算机，控件向它发送数据或从它那里接收数据。既可提供主机名，比如 "FTP://ftp.microsoft.com"，也可提供点格式下的 IP 地址字符串，比如 "100.0.1.1"。
Winsock1.RemotePort = 25 '返回或设置要连接的远程端口号
Winsock1.Connect '返回与远程计算机的连接。
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Winsock1_Connect()
On Error Resume Next '在错误处理程序结束后，恢复原有的运行
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
' Winsock1.Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim webData As String
Winsock1.GetData webData, vbString '检取当前的数据块
Text1.Text = Text1.Text + webData
Debug.Print Text1.Text
End Sub
Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
On Error Resume Next
DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
Eighth = Fourth + Third + Ninth + Fifth + Sixth ' Combine for proper SMTP sending
Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
Winsock1.SendData (first)
Winsock1.SendData (Second)
Winsock1.SendData ("data" + vbCrLf)
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
Winsock1.SendData ("quit" + vbCrLf)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -