module1.bas

邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版邮件系统完整版

Public Sub LoadList(mailctl As Control)
'将邮件的信息装载到邮件列表窗体中的列表框
    Form1.Mlist.Clear
    UnRead = 0
    startindex = 0
    For i = 0 To mailctl.MsgCount - 1
        mailctl.MsgIndex = i
        If Not mailctl.MsgRead Then
            '在尚未阅读过的邮件之前用“*”表示（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)
        '将消息的头信息添加到列表框中
        Form1.Mlist.AddItem a$ + Chr$(9) + b$ + Chr$(9) + c$
        Form1.Mlist.Refresh
    Next i
    '消息列表框的索引在第一条没有阅读的消息的位置
    Form1.Mlist.ListIndex = startindex
    Main.Toolbar1.Buttons("Next1").Enabled = True
    Main.Toolbar1.Buttons("Previous1").Enabled = True
    Main.Toolbar1.Buttons("Delete").Enabled = True
    If UnRead Then
        '在状态栏中显示没有阅读的消息的数量
        Main.Statusbar1.Panels(1) = "收信箱里共有" + Format$(Main.MAPIMess.MsgCount) + "邮件，其中有" + Format$(UnRead) + "未读"
    Else
        Main.Statusbar1.Panels(1) = ""
    End If
End Sub
Sub LoadMessage(ByVal Index As Integer, msg As Form)
'将当前消息（根据Index)装载到窗体msg中
'msg窗体可以是查看消息的窗体Form2，
'也可以是书写新消息的窗体Form3
    If TypeOf msg Is Form2 Then
        '如果装载消息到查看消息的窗体，则根据该消息是否
        '被阅读来清楚消息未读的标志“*”
        a$ = Form1.Mlist.List(Index)
        If Mid$(a$, 1, 1) = conUnreadMessage Then
            Mid$(a$, 1, 1) = ""
            Form1.Mlist.List(Index) = a$
            UnRead = UnRead - 1
            If UnRead Then
                '阅读的是新消息，则未读消息的数量-1
                Main.Statusbar1.Panels(1) = "收信箱里共有" + Format$(Main.MAPIMess.MsgCount) + "封邮件，其中有" + Format$(UnRead) + "封未读"
            Else
                Main.Statusbar1.Panels(1) = "收信箱里共有" + Format$(Main.MAPIMess.MsgCount) + "封邮件，其中有" + Format$(UnRead) + "封未读"
            End If
        End If
    End If
    If TypeOf msg Is Form2 Then
    '如果装载消息到查看消息的窗体，则取得消息的日期和发信人
        Main.MAPIMess.MsgIndex = Index
        msg.txtDate.Text = "日期：" + DateFromMapiDate$(Main.MAPIMess.MsgDateReceived, conMailLongDate)
        msg.txtFrom.Text = "发信人：" + Main.MAPIMess.MsgOrigDisplayName
        Form1.Mlist.ItemData(Index) = True
    End If
    '不管消息装载到哪个窗体中，均执行以下程序
    Call Attachments(msg)
    msg.txtNoteText.Text = "邮件" + Chr$(13) + Chr$(10) + Main.MAPIMess.MsgNoteText
    msg.txtSubject.Text = "主题：" + Main.MAPIMess.MsgSubject
    msg.Caption = Main.MAPIMess.MsgSubject
    msg.Tag = Index
    msg.txtTo.Text = "收信人：" + GetRCList(Main.MAPIMess, vbRecipTypeTo)
    msg.txtCc.Text = "抄送：" + GetRCList(Main.MAPIMess, vbRecipTypeCc)
    msg.Refresh
    msg.Show
End Sub
Sub LogOffUser()
'该子程序用于注销发送邮件连接
    On Error Resume Next
    Main.MAPISess.Action = 2
    If Err <> 0 Then
        MsgBox "LogOff failure:" + Error
    Else
        Main.MAPIMess.SessionID = 0
        Main.Logoff.Enabled = 0
        Main.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
        '设置各个菜单项及工具栏按扭的可用状态
        Main.Toolbar1.Buttons("Compose").Enabled = False
        Main.Toolbar1.Buttons("Fetch").Enabled = False
        Main.Toolbar1.Buttons("Previous1").Enabled = False
        Main.Toolbar1.Buttons("Next1").Enabled = False
        Main.Toolbar1.Buttons("Delete").Enabled = False
        Main.Toolbar1.Buttons("Send").Enabled = False
        Main.Toolbar1.Buttons("Reply").Enabled = False
        Main.Toolbar1.Buttons("ReplyAll").Enabled = False
        Main.Toolbar1.Buttons("Forward").Enabled = False
        Main.ShowAB.Enabled = False
        Main.Statusbar1.Panels(1) = "现处于离线状态"
        Main.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 Form2 Then
        '如果当前活动的子窗体为Form2，则打印相应的邮件消息
        Call PrintMessage(Main.MAPIMess, False)
        Printer.EndDoc
    ElseIf TypeOf Screen.ActiveForm Is Form1 Then
        For i = 0 To Form1.Mlist.ListCount - 1
            If Form1.Mlist.Selected(i) Then
                '如果活动的子窗体是邮件消息列表，则根据列表框中的索引打印
                '相应的消息
                Main.MAPIMess.MsgIndex = i
                Call PrintMessage(Main.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 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(Main.MAPIMess, vbRecipTypeTo)
    msg.txtCc.Text = GetRCList(Main.MAPIMess, vbRecipTypeCc)
End Sub

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