|
摘 要：基于IMAP4的电子邮件系统正在逐渐进入应用阶段。本文用VB6.0实现了一个IMAP邮件后台检测及通知程序，可以使用户更加及时地接收新邮件。
关键词：电子邮件，IMAP4，Visual Basic
一、 两种邮件接收协议的比较--IMAP4 vs POP3
目前Internet上广泛采用的邮件接收协议是邮局协议(POP3)，但POP3是一种工作在脱机方式消息访问机制的协议，客户端邮件程序连接到邮件服务器后，将服务器上的所有邮件取回到本地机，同时服务器上的邮件将被删除，以后对邮件的处理完全在本地机上进行。有时用户需要在不同的时候使用不同的机器（例如分别在办公室和家里）访问某个服务器上的邮件，或者用户希望将邮件保存到他们直接使用的这台机器外的其他机器上，这时使用POP3协议接收邮件极为不便。另外，使用POP3接收邮件时，不管服务器上有多少个邮件，邮件容量有多大，只要客户邮件程序连接到服务器，就会自动下载所有的邮件。这会给目前本就十分有限的网络带宽带来很大的浪费，对垃圾邮件的处理也无能为力。
所幸的是，另一种Internet邮件接收协议，即网际消息访问协议(IMAP4)可以在很大程度上弥补POP3协议带来的不足。这一协议的应用已越来越受到人们的重视，因为它具有很多POP3不支持的功能：如不需下载整个邮件就可以确定邮件的MIME部分，也可以有选择地取出邮件的某一部分（如邮件主题），可以按指定条件搜索服务器上的邮件，可以建立多级信箱等等。基于IMAP4协议的这些良好特性，越来越多的电子邮件服务器软件及电子邮件客户程序都增加了对IMAP4的支持。基于上述原因，也为了使更多IMAP4邮件用户更加准确及时地接收邮件，本文利用Visual Basic6.0实现了一个完整的IMAP4新邮件检测及通知程序。
二、 IMAP邮件检测与通知程序的功能和设计
IMAP4命令比POP3的命令多得多，服务器的响应也更为复杂，但作为新邮件检测程序并不需要像邮件接收程序那样用到所有的IMAP4命令。根据访问邮件服务器身份认证机制和检测过程实现方式的不同，需要的少数几条命令会稍有差别。程序中首先使用了Login命令登录用户信箱，这一命令必须提供明文的用户信箱名和密码。如果需要采用某种身份认证机制，则必须用Authenticate命令指出使用哪种身份认证机制，只要对程序稍加修改即可实现。第二步进行新邮件检测，检测某一个IMAP信箱是否有新邮件可以有两种实现方式：一是分析用Examine或Select命令选定收件箱（Inbox）时的服务器响应以获得新邮件数目；二是先用Examine或Select命令选定收件箱，然后用Search命令搜索其中的新邮件，分析Search命令对应的服务器响应也可获得新邮件数目。显然第一种方法比较省事，因此本文的程序采用了第一种实现方式。最后是用Logout命令结束连接。
采用POP3协议时，邮件客户程序发送一个POP3命令给服务器后，必须等待服务器响应后才能发送另一个命令。但IMAP4与POP3不同，它允许客户机在不等待服务器响应的情况下发送多个命令请求，这就引起怎样来区分服务器返回的响应对应于哪个命令的问题。因此IMAP规定客户机发送命令的时候必须带上一个标识此命令的标签，即完整的IMAP命令应该是一个唯一的标签及命令本身和可能有的参数。在本文的程序中，三条IMAP命令前的“A1”、“A2”、“A3”即为标签。
本程序具有如下几个功能：
(1) 可以定时检测给定的IMAP电子信箱是否有新邮件，有则通知用户。
(2) 可以保存用户的设置参数，保存地点为注册表的HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Email Notifier主键下。
(3) 程序运行后自动检测注册表中是否已保存了设置参数。如果没有，则显示设置窗体；如果有，则将其读出且显示在窗体的各个文本框中，但设置窗体不显示。
(4) 程序运行后不占用拥挤的任务栏空间，只在其右侧通知栏显示一个图标，可以双击或右击该图标以显示设置窗体或菜单。
三、IMAP邮件检测与通知源程序
程序包含一个窗体(Form1)和一个模块(Module1)，设计阶段的窗体如图所示。窗体上两个ActiveX控件为Winsock控件和Timer控件，其中Timer控件的Interval属性值为60000，其它皆按缺省即可。窗体还包括一个不可见的菜单(mainMenu)，有两个菜单项：menuSettings和menuExit，分别用于显示设计窗体和退出。此菜单将作为鼠标右击通知栏图标时的弹出菜单。为节约篇幅，其它控件的属性设置不再列出，可以参考程序来确定。
Module1的内容为用于在通知栏显示或删除图标的API函数及其相关常数的定义：
Option Explicit
Public Declare Function Shell_NotifyIcon Lib "SHELL32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Global Const NIF_MESSAGE = &H1
Global Const NIF_ICON = &H2
Global Const NIF_TIP = &H4
Global Const WM_MOUSEMOVE = &H200
Global Const NIM_ADD = &H0& 'constants & flags for NotifyIcons
Global Const NIM_MODIFY = &H1
Global Const NIM_DELETE = &H2
Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Global NI As NOTIFYICONDATA
Form1中需要输入的程序分别如下：
Option Explicit
Dim result As Long
Dim response As String
Dim CheckInterval As Integer
Private Sub Form_Load()
Dim SettingNeeded As Boolean
Dim Setting As Variant
If App.PrevInstance Then End '本程序只运行一个实例
App.Title = "Email Notifier"
Form1.Visible = False
Timer1.Enabled = False
'以下试图从注册表读入一些设置参数，如果没有，则用缺省的或由用户设置
Setting = GetSetting(App.Title, "Settings", "IMAPServer")
If Setting <> "" Then
txtServer = Setting
Else
SettingNeeded = True
End If
Setting = GetSetting(App.Title, "Settings", "IMAPServerPort", "143") 'IMAP的缺省TCP端口为143
txtServerPort = Setting
Setting = GetSetting(App.Title, "Settings", "User")
If Setting <> "" Then
txtUser = Setting
Else
SettingNeeded = True
End If
Setting = GetSetting(App.Title, "Settings", "Password")
If Setting <> "" Then
txtPassword = Setting
Else
SettingNeeded = True
End If
Setting = GetSetting(App.Title, "Settings", "CheckInterval", "5")
'缺省的邮件检测时间间隔为5分钟
txtCheckInterval = Setting
CheckInterval = Val(Setting)
Setting = GetSetting(App.Title, "settings", "Remember")
chkRemPassword.Value = IIf(Setting = "1", 1, 0)
ShowTrayIcon '在通知栏显示本程序图标
If SettingNeeded Then '如果需要由用户设置参数，在显示设置窗体
Form1.Visible = True
Else
Timer1.Enabled = True '否则启动计时器并马上检测一次有无新邮件
Email_Check_Notify
End If
End Sub
Private Sub ShowTrayIcon()
NI.cbSize = Len(NI)
NI.hwnd = Form1.hwnd
NI.uID = 0
NI.uID = NI.uID + 1
NI.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
NI.uCallbackMessage = WM_MOUSEMOVE
NI.hIcon = Form1.Icon
NI.szTip = "Email Notifier" + Chr$(0)
result = Shell_NotifyIcon(NIM_ADD, NI)
End Sub
Private Sub Email_Check_Notify()
Dim tempStr As String
Dim PosRecent, PosStar As Long
Dim newEmailNumber As Integer
On Error GoTo WinsockError
Winsock1.Connect Trim(txtServer), Val(txtServerPort)
tempStr = GetResponse()
If InStr(1, tempStr, "OK", vbTextCompare) = 0 Then
MsgBox "无法建立连接，可能服务器已关闭！", vbCritical
Winsock1.Close
Exit Sub
End If
Winsock1.SendData "A1 Login " & Trim(txtUser) & " " & Trim(txtPassword) + vbCrLf
tempStr = GetResponse()
If InStr(1, tempStr, "OK", vbTextCompare) = 0 Then
If InStr(1, tempStr, "NO", vbTextCompare) > 0 Then MsgBox "无法登录，可能是用户名或/和密码错误！", vbCritical
Winsock1.Close
Exit Sub
End If
Winsock1.SendData "A2 Examine Inbox" + vbCrLf
tempStr = GetResponse()
'由于Examine命令的响应较长，可能不是一次性到达，因而用一个循环来等待，直到响'应中出现OK或NO
While InStr(1, tempStr, "A2 OK", vbTextCompare) = 0
If InStr(1, tempStr, "A2 NO", vbTextCompare) > 0 Then
MsgBox "无法选择收件箱，可能在服务器上不存在！", vbCritical
Winsock1.Close
Exit Sub
End If
tempStr = tempStr + GetResponse()
Wend
' IMAP命令Examine及其相应的服务器响应类似如下的形式：
' A2 examine inbox
' * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
' * 3 EXISTS
' * 2 RECENT
' * OK [UNSEEN 3] 1 Messages unseen
' * OK [PERMANENTFLAGS ()]
' * OK [UIDVALIDITY 2065508241] UIDs valid
' A2 OK [READ-ONLY] EXAMINE completed
PosRecent = InStr(1, tempStr, "RECENT", vbTextCompare)
tempStr = Mid(tempStr, 1, PosRecent - 2)
PosStar = InStrRev(tempStr, "*", Len(tempStr), vbTextCompare)
newEmailNumber = Val(Mid(tempStr, PosStar + 2))
If newEmailNumber > 0 Then
MsgBox "有" & newEmailNumber & "个新邮件到达！", vbOKOnly + vbInformation
End If
Winsock1.SendData "A3 Logout" + vbCrLf
Winsock1.Close
Exit Sub
WinsockError:
MsgBox Err.Description, vbCritical
Winsock1.Close
End Sub
Private Sub cmdSaveSettings_Click() '保存参数设置
SaveSetting App.Title, "Settings", "IMAPServer", txtServer
SaveSetting App.Title, "Settings", "IMAPServerPort", txtServerPort
SaveSetting App.Title, "Settings", "User", txtUser
SaveSetting App.Title, "Settings", "Remember", chkRemPassword.Value
If chkRemPassword Then
SaveSetting App.Title, "Settings", "Password", txtPassword
Else
If GetSetting(App.Title, "Settings", "Password") <> "" Then _
DeleteSetting App.Title, "Settings", "Password"
End If
CheckInterval = Int(Val(txtCheckInterval)) ‘如果用户输入的时间间隔有小数或有非数字字符，转化成整数
CheckInterval = IIf(CheckInterval > 0, CheckInterval, 1) '如果用户设置的时间间隔小于1分钟，则设置为1
txtCheckInterval = Trim(Str(CheckInterval)) ‘在文本框中显示经过处理的时间间隔值
SaveSetting App.Title, "Settings", "CheckInterval", txtCheckInterval
MsgBox "您的设置信息已成功保存至注册表!", vbInformation
Form1.Visible = False
Timer1.Enabled = True
End Sub
Private Sub cmdClose_Click()
Form1.Visible = False
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub menuSettings_Click()
Form1.Visible = True
Form1.SetFocus
End Sub
Private Sub menuExit_Click()
Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim info As Long
info = (X And &HFF) * &H100
Select Case info
Case &H3C00 '鼠标右键单击，显示弹出菜单
PopupMenu mainMenu
Case &H2D00 ‘鼠标左键双击，显示设置窗体
menuSettings_Click
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
result = Shell_NotifyIcon(NIM_DELETE, NI) '删除通知栏的图标
End Sub
Private Sub Timer1_Timer()
CheckInterval = CheckInterval - 1 '定时器的Interval属性为60000,所以定时器事件每一分钟发生一次
If CheckInterval = 0 Then
Email_Check_Notify
CheckInterval = Val(txtCheckInterval)
End If
End Sub
本程序用VB6.0编制，在局域网上（Windows98, Infradig邮件服务器（www.infradig.com）和WindowsNT4.0, IMAIL邮件服务器（www.ipswitch.com））下调试通过，并且可以成功检测本人IMAP信箱的新邮件，该信箱位于世纪视灵通网站（www.21cn.com）提供的IMAP服务器（imap.21cn.com）上。有兴趣的朋友可以进行修改或增加一些功能，如加入POP3邮件检测功能，多信箱检测功能，通知方法改成同时有屏幕提示和声音提示等等，使之称为一个功能齐全的邮件检测通知程序。若有任何问题请联系：fz26105@21cn.com。
参考文献
1 RFC 2060: Internet Message Access Protocol - version 4rev1, 1996.12
2 RFC 1730: Internet Message Access Protocol - version 4, 1994.12
3 Dilip C. Naik，博彦公司译，Internet标准与协议，清华大学出版社，北京，1999.3
|
