📄 frmmain.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "RFC822邮件"
ClientHeight = 6000
ClientLeft = 45
ClientTop = 330
ClientWidth = 7335
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6000
ScaleWidth = 7335
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdDel
Caption = "退出"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5880
TabIndex = 10
Top = 5520
Width = 1335
End
Begin VB.CommandButton cmdCheckMail
Caption = "收信"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4440
TabIndex = 9
Top = 5520
Width = 1335
End
Begin MSWinsockLib.Winsock Winsock1
Left = 3480
Top = 2760
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox txtBody
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2655
Left = 180
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 7
Text = "frmMain.frx":0000
Top = 2760
Width = 7035
End
Begin VB.Frame Frame4
Caption = "信件"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1815
Left = 120
TabIndex = 6
Top = 840
Width = 7095
Begin ComctlLib.ListView lvMessages
Height = 1455
Left = 60
TabIndex = 8
Top = 240
Width = 6975
_ExtentX = 12303
_ExtentY = 2566
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 327682
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Text = "From"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 1
Key = ""
Object.Tag = ""
Text = "Subject"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 2
Key = ""
Object.Tag = ""
Text = "Date"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 3
Key = ""
Object.Tag = ""
Text = "Size"
Object.Width = 2540
EndProperty
End
End
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 = 615
Left = 4920
TabIndex = 4
Top = 120
Width = 2295
Begin VB.TextBox txtPassword
Height = 285
IMEMode = 3 'DISABLE
Left = 120
PasswordChar = "*"
TabIndex = 5
Text = "1"
Top = 240
Width = 2055
End
End
Begin VB.Frame Frame2
Caption = "信箱用户名"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 2520
TabIndex = 2
Top = 120
Width = 2295
Begin VB.TextBox txtUserName
Height = 285
Left = 120
TabIndex = 3
Text = "zj"
Top = 240
Width = 2055
End
End
Begin VB.Frame Frame1
Caption = "POP3服务器"
BeginProperty Font
Name = "幼圆"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 120
TabIndex = 0
Top = 120
Width = 2295
Begin VB.TextBox txtHost
Height = 285
Left = 120
TabIndex = 1
Text = "10.11.111.119"
Top = 240
Width = 2055
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义POP3会话状态的枚举类型
Private Enum POP3States
POP3_Connect
POP3_USER
POP3_PASS
POP3_STAT
POP3_RETR
POP3_DELE
POP3_QUIT
End Enum
'表示当前POP3会话的枚举变量
Private m_State As POP3States
Private m_oMessage As CMessage
Private m_colMessages As New CMessages
'
Private Sub cmdCheckMail_Click()
'检查除了txtBody之外的TextBox是否为空
For Each c In Controls
If TypeOf c Is TextBox And c.Name <> "txtBody" Then
If Len(c.Text) = 0 Then
MsgBox c.Name & " can't be empty", vbCritical
Exit Sub
End If
End If
Next
'
'改变表示当前状态的变量
m_State = POP3_Connect
'在打开一个新的会话之前先关闭Winsock
Winsock1.Close
'指定服务器地址和端口并连接服务器
Winsock1.RemotePort = 110
Winsock1.RemoteHost = txtHost.Text
Winsock1.Connect
End Sub
Private Sub cmdDel_Click()
Unload Me
End Sub
Private Sub lvMessages_ItemClick(ByVal Item As ComctlLib.ListItem)
txtBody = m_colMessages(Item.Key).MessageBody
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Static intMessages As Integer '记录信箱的信件数
Static intCurrentMessage As Integer '当前下载的信件
Static strBuffer As String '接收消息的字符串变量
'
'从winsock接收缓冲区中读取数据
Winsock1.GetData strData
Debug.Print strData
If Left$(strData, 1) = "+" Or m_State = POP3_RETR Then
'如果接收字符串的第一个字符为“+”表示服务器接收了来自客户端的请求命令
'If the first character of the server's response is "+" then
'如果接到的第一个字符为“-”，则表示服务器认为来自客户端的请求是错误的。
'如果会话状态正处于接收邮件，则不需要判断第一个字符。
Select Case m_State
Case POP3_Connect
'
'将消息（信件）记数设置为0 Reset the number of messages
intMessages = 0
'
'改变当前会话状态为发送用户名 Change current state of session
m_State = POP3_USER
'
'发送USER及其参数
Winsock1.SendData "USER " & txtUserName & vbCrLf
Debug.Print "USER " & txtUserName
Case POP3_USER
'
'如果能够执行到这一步，表示发送给服务器的用户名已经通过服务器的验证
'改变当前会话状态为发送密码阶段
m_State = POP3_PASS
'发送密码
Winsock1.SendData "PASS " & txtPassword & vbCrLf
Debug.Print "PASS " & txtPassword
Case POP3_PASS
'
' Change the state of the session
'如果能够执行到这一步，表示发送给服务器的密码已经通过服务器的验证
'改变当前会话状态为取得邮箱信息阶段
m_State = POP3_STAT
'
'发送STAT命令，要求服务器返回邮箱信息
Winsock1.SendData "STAT" & vbCrLf
Debug.Print "STAT"
Case POP3_STAT
'
'从接收的从服务器返回的邮箱状态字符串中获得邮件数量
intMessages = CInt(Mid$(strData, 5, _
InStr(5, strData, " ") - 5))
If intMessages > 0 Then
'如果邮件的数量>0，设置当前会话状态为取回信件阶段
m_State = POP3_RETR
'设置变量表明当前取回的是哪个信件
intCurrentMessage = intCurrentMessage + 1
'
'发送RETR及参数取回第一封邮件
Winsock1.SendData "RETR 1" & vbCrLf
Debug.Print "RETR 1"
Else
'如果是处于其它状态，设置当前状态为退出会话阶段
m_State = POP3_QUIT
'发送QUIT命令退出会话过程
Winsock1.SendData "QUIT" & vbCrLf
Debug.Print "QUIT"
MsgBox "You have not mail.", vbInformation
End If
Case POP3_RETR
'如果执行到这个阶段，说明邮箱中存在至少一封以上的信件
'循环执行该过程取得信件的内容
strBuffer = strBuffer & strData
'
If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
'如果接收到的信件内容的字符串中存在vbLf & "." & vbCrLf表示
'使用RETR返回的信件数据已经完毕
'
'从服务器接收到信件的数据中将响应行去掉
strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
'
'从信件的数据中去掉最后的vbLf & "." & vbCrLf
strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
'
'创建CMessage分析取得的信件数据
Set m_oMessage = New CMessage
m_oMessage.CreateFromText strBuffer
'将分析结果加入到m_colMessages对象的集合中
m_colMessages.Add m_oMessage, m_oMessage.MessageID
Set m_oMessage = Nothing
'
'清除接收信件数据的字符串
strBuffer = ""
'判断是否已经取完信件
If intCurrentMessage = intMessages Then
m_State = POP3_QUIT
'退出POP3会话
Winsock1.SendData "QUIT" & vbCrLf
Debug.Print "QUIT"
Else
intCurrentMessage = intCurrentMessage + 1
m_State = POP3_RETR
'发送RETR命令取回下一封信
Winsock1.SendData "RETR " & _
CStr(intCurrentMessage) & vbCrLf
Debug.Print "RETR " & intCurrentMessage
End If
End If
Case POP3_QUIT
'关闭Winsock连接
Winsock1.Close
'调用该函数将信件内容加入到ListView中
Call ListMessages
End Select
Else
'出错关闭Winsock连接并提示
Winsock1.Close
MsgBox "POP3 Error: " & strData, _
vbExclamation, "POP3 Error"
End If
End Sub
Private Sub Winsock1_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 "Winsock Error: #" & Number & vbCrLf & _
Description
End Sub
Private Sub ListMessages()
'将信件的主题，发送日期，大小加入到ListView中
Dim oMes As CMessage
Dim lvItem As ListItem
For Each oMes In m_colMessages
Set lvItem = lvMessages.ListItems.Add
lvItem.Key = oMes.MessageID
lvItem.Text = oMes.From
lvItem.SubItems(1) = oMes.Subject
lvItem.SubItems(2) = oMes.SendDate
lvItem.SubItems(3) = oMes.Size
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -