module1.bas

很好的

        '在尚未阅读过的邮件之前用“*”表示（conUnreadMessage="*"）
        a$ = conUnreadMessage + ""
        If UnRead = 0 Then
            '标识第一封没有阅读过的邮件的位置
            startindex = i
        End If
        'UnRead为计算没有阅读过的邮件的数量
        UnRead = UnRead + 1
    Else
        a$ = " "
    End If
    '取得当前索引消息的原始发件人的名字
    a$ = a$ + Mid$(Format$(mailctl.MsgOrigDisplayName, "!" + String$(10, "@")), 1, 10)
    If mailctl.MsgSubject <> "" Then
        '取得当前索引消息的主题
        b$ = Mid$(Format$(mailctl.MsgSubject, "!" + String$(35, "@")), 1, 35)
    Else
        b$ = String$(30, "")
    End If
    '取得当前消息的接收时间
    c$ = Mid$(Format$(DateFromMapiDate(mailctl.MsgDateReceived, conMailListView), "!" + String$(15, "@")), 1, 15)
    '将消息的头信息添加到列表框中
    MailLst.Mlist.AddItem a$ + Chr$(9) + b$ + Chr$(9) + c$
    MailLst.Mlist.Refresh
Next i
'消息列表框的索引在第一条没有阅读的消息的位置
MailLst.Mlist.ListIndex = startindex
VBMail.Toolbar1.Buttons("Next1").Enabled = True
VBMail.Toolbar1.Buttons("Previous1").Enabled = True
VBMail.Toolbar1.Buttons("Delete").Enabled = True
If UnRead Then
    '在状态栏中显示没有阅读的消息的数量
    VBMail.Statusbar1.Panels(1) = "收信箱里共有" + Format$(VBMail.MAPIMess.MsgCount) + "邮件，其中有" + Format$(UnRead) + "未读"
Else
    VBMail.Statusbar1.Panels(1) = ""
End If
End Sub
Sub LoadMessage(ByVal Index As Integer, msg As Form)
'将当前消息（根据Index)装载到窗体msg中
'msg窗体可以是查看消息的窗体MsgView，
'也可以是书写新消息的窗体NewMsg
If TypeOf msg Is MsgView Then
    '如果装载消息到查看消息的窗体，则根据该消息是否
    '被阅读来清楚消息未读的标志“*”
    a$ = MailLst.Mlist.List(Index)
    If Mid$(a$, 1, 1) = conUnreadMessage Then
        Mid$(a$, 1, 1) = ""
        MailLst.Mlist.List(Index) = a$
        UnRead = UnRead - 1
        If UnRead Then
            '阅读的是新消息，则未读消息的数量-1
            VBMail.Statusbar1.Panels(1) = "收信箱里共有" + Format$(VBMail.MAPIMess.MsgCount) + "邮件，其中有" + Format$(UnRead) + "未读"
        Else
            VBMail.Statusbar1.Panels(1) = "收信箱里共有" + Format$(VBMail.MAPIMess.MsgCount) + "邮件，其中有" + Format$(UnRead) + "未读"
        End If
    End If
End If
If TypeOf msg Is MsgView Then
'如果装载消息到查看消息的窗体，则取得消息的日期和发信人
    VBMail.MAPIMess.MsgIndex = Index
    msg.txtDate.Text = "日期：" + DateFromMapiDate$(VBMail.MAPIMess.MsgDateReceived, conMailLongDate)
    msg.txtFrom.Text = "发信人：" + VBMail.MAPIMess.MsgOrigDisplayName
    MailLst.Mlist.ItemData(Index) = True
End If
'不管消息装载到哪个窗体中，均执行以下程序
Call Attachments(msg)
msg.txtNoteText.Text = "邮件" + Chr$(13) + Chr$(10) + VBMail.MAPIMess.MsgNoteText
msg.txtSubject.Text = "主题：" + VBMail.MAPIMess.MsgSubject
msg.Caption = VBMail.MAPIMess.MsgSubject
msg.Tag = Index
msg.txtTo.Text = "收信人：" + GetRCList(VBMail.MAPIMess, vbRecipTypeTo)
msg.txtCc.Text = "抄送：" + GetRCList(VBMail.MAPIMess, vbRecipTypeCc)
msg.Refresh
msg.Show
End Sub
Sub LogOffUser()
'该子程序用于注销发送邮件连接
On Error Resume Next
VBMail.MAPISess.Action = 2
If Err <> 0 Then
    MsgBox "LogOff failure:" + Error
Else
    VBMail.MAPIMess.SessionID = 0
    VBMail.Logoff.Enabled = 0
    VBMail.Logon.Enabled = -1
    '卸载所有的子窗体
    Do Until Forms.Count = 1
        i = Forms.Count - 1
        If TypeOf Forms(i) Is MDIForm Then
        Else
            Unload Forms(i)
        End If
    Loop
    '设置各个菜单项及工具栏按扭的可用状态
    VBMail.Toolbar1.Buttons("Compose").Enabled = False
    VBMail.Toolbar1.Buttons("Fetch").Enabled = False
    VBMail.Toolbar1.Buttons("Previous1").Enabled = False
    VBMail.Toolbar1.Buttons("Next1").Enabled = False
    VBMail.Toolbar1.Buttons("Delete").Enabled = False
    VBMail.Toolbar1.Buttons("Send").Enabled = False
    VBMail.Toolbar1.Buttons("Reply").Enabled = False
    VBMail.Toolbar1.Buttons("ReplyAll").Enabled = False
    VBMail.Toolbar1.Buttons("Forward").Enabled = False
    VBMail.ShowAB.Enabled = False
    VBMail.EditDelete.Enabled = False
    VBMail.Mforward.Enabled = False
    VBMail.Mreply.Enabled = False
    VBMail.Mreplyall.Enabled = False
    VBMail.Mcompose.Enabled = False
    VBMail.Mfetch.Enabled = False
    VBMail.PrintMessage.Enabled = False
    VBMail.EditDelete.Enabled = False
    VBMail.Statusbar1.Panels(1) = "现处于离线状态"
    VBMail.Statusbar1.Panels(2) = ""
End If
End Sub
Sub PrintLongText(ByVal LongText As String)
'打印消息的子程序之一，用于打印消息的正文
Do Until LongText = ""
    word$ = Token$(LongText, "")
    If Printer.TextHeight(word$) + Printer.CurrentX > Printer.Width - Printer.TextWidth("ZZZZZZZ") Then
        Printer.Print
    End If
    Printer.Print "" + word$
Loop
End Sub
Sub Printmail()
'打印消息的子程序之一，用于取得要打印的消息
If TypeOf Screen.ActiveForm Is MsgView Then
    '如果当前活动的子窗体为MsgView，则打印相应的邮件消息
    Call PrintMessage(VBMail.MAPIMess, False)
    Printer.EndDoc
ElseIf TypeOf Screen.ActiveForm Is MailLst Then
    For i = 0 To MailLst.Mlist.ListCount - 1
        If MailLst.Mlist.Selected(i) Then
            '如果活动的子窗体是邮件消息列表，则根据列表框中的索引打印
            '相应的消息
            VBMail.MAPIMess.MsgIndex = i
            Call PrintMessage(VBMail.MAPIMess, False)
        End If
    Next i
    Printer.EndDoc
End If
End Sub
Sub PrintMessage(msg As Control, fNewPage As Integer)
'打印消息的子程序之一，用于设置打印机和取得打印消息头
Screen.MousePointer = 11
If fNewPage Then
    Printer.NewPage
End If
Printer.FontName = "Arial"
Printer.FontBold = True
Printer.DrawWidth = 10
Printer.Line (0, Printer.CurrentY)-(Printer.Width, Printer.CurrentY)
Printer.Print
Printer.FontSize = 9.75
Printer.Print "From:"
Printer.CurrentX = Printer.TextWidth(String$(30, ""))
Printer.Print msg.MsgOrigDisplayName
Printer.Print "To:"
Printer.CurrentX = Printer.TextWidth(String$(30, ""))
Printe.Print GetRCList(msg, vbRecipTypeTo)
Printer.Print "Cc:"
Printer.CurrentX = Printer.TextWidth(String$(30, ""))
Printer.Print GetRCList(msg, vbRecipTypeCc)
Printer.Print "Subject:"
Printer.CurrentX = Printer.TextWidth(String$(30, ""))
Printer.Print msg.MsgSubject
Printer.Print "Date:"
Printer.CurrentX = Printer.TextWidth(String$(30, ""))
Printer.Print DateFromMapiDate$(msg.MsgDateReceived, conMailLongDate)
Printer.Print
Printer.DrawWidth = 5
Printer.Line (0, Printer.CurrentY)-(Printer.Width, Printer.CurrentY)
Printer.FontSize = 9.75
Printer.FontBold = False
Call PrintLongText(msg.MsgNoteText)
Printer.Print
Screen.MousePointer = 0
End Sub

Sub SaveMessage(msg As Form)
'???该子程序的调用在何处？？？？？
svSub = msg.txtSubject
svNote = msg.txtNoteText
VBMail.MAPIMess.Action = vbMessageCopy
VBMail.MAPIMess.MsgSubject = svSub
VBMail.MAPIMess.MsgNoteText = svNote
VBMail.MAPIMess.Action = vbMessageSaveMsg
End Sub

Sub SetRCList(ByVal NameList As String, msg As Control, RCType As Integer, fResolveNames As Integer)
'根据存储收信人姓名的字符串NameList（姓名用分号隔开）
'设置收信人姓名。
If NameList = "" Then
    Exit Sub
End If
i = msg.RecipCount
Do
    msg.RecipIndex = i
    msg.RecipDisplayName = Trim$(Token(NameList, ";"))
    If fresolvename Then
        msg.Action = vbMessageResolveName
    End If
    msg.RecipType = RCType
    i = i + 1
Loop Until (NameList = "")
End Sub

Function Token$(tmp$, search$)
x = InStr(1, tmp$, search$)
If x Then
   Token$ = Mid$(tmp$, 1, x - 1)
   tmp$ = Mid$(tmp$, x + 1)
Else
   Token$ = tmp$
   tmp$ = ""
End If
End Function

Sub UpdateRecips(msg As Form)
'更新收信人和转发的地址
msg.txtTo.Text = GetRCList(VBMail.MAPIMess, vbRecipTypeTo)
msg.txtCc.Text = GetRCList(VBMail.MAPIMess, vbRecipTypeCc)
End Sub

Sub ViewNextMsg()
'查看下一个消息
windowNum% = FindMsgWindow(MailLst.Mlist.ListIndex)
If windowNum% > 0 Then
    Forms(windowNum%).Show
Else
    If TypeOf Screen.ActiveForm Is MsgView Then
        Call LoadMessage(MailLst.Mlist.ListIndex, Screen.ActiveForm)
    Else
        Call LoadMessage(MailLst.Mlist.ListIndex, MsgView)
    End If
End If
End Sub