Attribute VB_Name = "Module1"
Public Const conMailLongDate = 0
Public Const conMailListView = 1
'標(biāo)識(shí)取消發(fā)送的變量
Public SendWithApi
Public Const conOptionGeneral = 1
Public Const conOptionMessage = 2
Public Const conUnreadMessage = "*"
Public Const vbRecipTypeTo = 1
Public Const vbRecipTypeCc = 2
'定義當(dāng) MAPIMessages 控件被激活時(shí)，Action屬性使用的常數(shù)
'該屬性決定將執(zhí)行什么操作
Public Const vbMessageFetch = 1
Public Const vbMessageSenddlg = 2
Public Const vbMessageSend = 3
Public Const vbMessageSaveMsg = 4
Public Const vbMessageCopy = 5
Public Const vbMessageCompose = 6
Public Const vbMessageReply = 7
Public Const vbMessageReplyAll = 8
Public Const vbMessageForward = 9
Public Const vbMessageDelete = 10
Public Const vbMessageShowADBook = 11
Public Const vbMessageShowDetails = 12
Public Const vbMessageResolveName = 13
Public Const vbRecipientDelete = 14
Public Const vbAttachmentDelete = 15
Public Const vbAttachTypeData = 0
Public Const vbAttachTypeEOLE = 1
Public Const vbAttachTypeSOLE = 2
'定義存儲(chǔ)郵件信息的結(jié)構(gòu)
Type ListDisplay
     Name As String * 20
     Subject As String * 40
     Date As String * 20
End Type
Public currentRCIndex As Integer
Public UnRead As Integer
Public SendWithMapi As Integer
Public ReturnRequest As Integer
Public OptionType As Integer
    
'聲明讀取注冊表內(nèi)容的函數(shù)
#If Win32 Then
Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
#Else
Public Declare Function GetProfileString% Lib "kernel" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long)
#End If

Public Sub Attachments(msg As Form)
'將有附件的信息裝載到窗體msg的列表框alist中
    msg.alist.Clear
    msg.numAtt = "附加文件數(shù)量：" & Main.MAPIMess.AttachmentCount
    If Main.MAPIMess.AttachmentCount Then
        For i% = 0 To Main.MAPIMess.AttachmentCount - 1
        Main.MAPIMess.AttachmentIndex = i%
        a$ = Main.MAPIMess.AttachmentName
        Select Case Main.MAPIMess.AttachmentType
            Case vbAttachTypeData
                a$ = a$ + "(Data File)"
            Case vbAttachTypeEOLE
                a$ = a$ + "(Embedded OLE Object)"
            Case vbAttachTypeSOLE
                a$ = a$ + "(Static OLEObject)"
            Case Else
                a$ = a$ + "(Unknown attachment type)"
        End Select
        msg.alist.AddItem a$
        Next i%
    End If
    msg.Refresh
End Sub

Public Sub CopyNamestoMsgBuffer(msg As Form, fResolveNames As Integer)
    '刪除原來的收信人地址
    Call KillRecips(Main.MAPIMess)
    '窗體msg中填寫的收信人和抄送人地址添加到發(fā)送郵件的地址
    Call SetRCList(msg.txtTo, Main.MAPIMess, vbRecipTypeTo, fResolveNames)
    Call SetRCList(msg.txtCc, Main.MAPIMess, vbRecipTypeTo, fResolveNames)
End Sub

Public Function DateFromMapiDate$(ByVal S$, wFormat%)
'該函數(shù)的功能根據(jù)給定的日期，返回一定格式的日期的表示形式
    Y$ = Left$(S$, 4)
    M$ = Mid$(S$, 6, 2)
    D$ = Mid$(S$, 9, 2)
    T$ = Mid$(S$, 12)
    Ds# = DateValue(M$ + "/" + D$ + "/" + Y$) + TimeValue(T$)
    Select Case wFormat
        Case conMailLongDate
            f$ = "dddd,mmmm,d,yyyy,h:mmAM/PM"
        Case conMailListView
            f$ = "mm/dd/yy hh:mm"
    End Select
    DateFromMapiDate = Format$(Ds#, f$)
End Function

Public Sub DeleteMessage()
'該子程序的刪除當(dāng)前選中的郵件
    If TypeOf Screen.ActiveForm Is Form2 Then
        Form1.Mlist.ListIndex = Val(Screen.ActiveForm.Tag)
        ViewingMsg = ture
    End If
    If Form1.Mlist.ListIndex <> -1 Then
        '如果消息索引不等與-1（不是在書寫新信件），則刪除當(dāng)前消息
        Main.MAPIMess.MsgIndex = Form1.Mlist.ListIndex
        Main.MAPIMess.Action = vbMessageDelete
        '從列表框中刪除相應(yīng)的消息
        x% = Form1.Mlist.ListIndex
        Form1.Mlist.RemoveItem x%
        If x% < Form1.Mlist.ListCount - 1 Then
            Form1.Mlist.ListIndex = x%
        Else
            Form1.Mlist.ListIndex = Form1.Mlist.ListCount - 1
        End If
        Main.Statusbar1.Panels(1) = "收信箱里共有" + Format$(Main.MAPIMess.MsgCount) + "郵件，其中有" + Format$(UnRead) + "未讀"
        If ViewingMsg Then
            '刪除當(dāng)前活動(dòng)窗體的消息后，將其標(biāo)志設(shè)為-1
            Screen.ActiveForm.Tag = Str$(-1)
        End If
        For i = 0 To Forms.Count - 1
            If TypeOf Forms(i) Is Form2 Then
                If Val(Forms(i).ta) > x% Then
                    '將閱讀郵件的窗體的tag屬性設(shè)為郵件的索引
                    Forms(i).Tag = Val(Forms(i).Tag) - 1
                End If
            End If
        Next i
        If vewingmsg Then
            '在刪除當(dāng)前郵件后，下一封郵件的位置設(shè)置為當(dāng)前位置，這時(shí)需要
            '判斷該郵件是否已經(jīng)在子窗體Form2中顯示，如是，將其設(shè)為活動(dòng)
            '窗體，否則，用Form2顯示該郵件
            windowNum% = FindMsgWindow(Form1.Mlist.ListIndex)
            If windowNum% > 0 Then
                If Forms(windowNum%).Caption <> Screen.ActiveForm.Caption Then
                    Unload Screen.ActiveForm
                    Forms(FindMsgWindow((Form1.Mlist.ListIndex))).Show
                Else
                    Forms(windowNum%).Show
                End If
            Else
                Call LoadMessage(Form1.Mlist.ListIndex, Screen.ActiveForm)
            End If
        Else
            windowNum% = FindMsgWindow(x%)
            If windowNum% > 0 Then
               Unload Forms(x%)
            End If
        End If
    End If
End Sub

Public Sub DisplayAttachedFile(ByVal FileName As String)
'該子程序用于根據(jù)文件的類型查看附件文件
    On Error Resume Next
    ext$ = FileName
    junk$ = Token$(ext$, ".")
    Buffer$ = String$(256, "")
    errCode% = GetProfileString("Extensions", ext$, "NOTFOUND", Buffer$, Len(Left(Buffer$, Chr(0)) - 1))
    If errCode% Then
        Buffer$ = Mid$(Buffer$, 1, InStr(Buffer$, Chr(0)) - 1)
        If Buffer$ <> "NOTFOUND" Then
            EXEName$ = Token$(Buffer$, "")
            errCode% = Shell(EXEName$ + "" + FileName, 1)
            If Err Then
                MsgBox "在shell中發(fā)生錯(cuò)誤?。?！" + Error$
             End If
        Else
            MsgBox "在WIN.INI沒發(fā)現(xiàn)使用" + ext$ + "的程序?。?！"
        End If
    End If
End Sub

Public Function FindMsgWindow(Index As Integer) As Integer
'判斷當(dāng)前所有子窗體中是否包含有相對郵件索引的郵件
    '如果沒有則返回值為-1
    For i = 0 To Forms.Count - 1
        If TypeOf Forms(i) Is Form2 Then
            If Val(Forms(i).Tag) = Index Then
                FindMsgWindow = i
                Exit Function
            End If
        End If
    Next i
    FindMsgWindow = -1
End Function

Public Function GetHeader(msg As Control)
'從MAPIMessages控件取得郵件的頭信息
    Dim CR As String
    CR = Chr$(13) + Chr$(10)
    Header$ = String$(25, "-")
    Header$ = Header$ + "From:" + msg.MsgOrigDisplayName + CR
    Header$ = Header$ + "To:" + GetRCList(msg, vbRecipTypeTo) + CR
    Header$ = Header$ + "Cc:" + GetRCList(msg, vbRecipTypeCc) + CR
    Header$ = Header$ + "Subject:" + msg.MsgSubject + CR
    Header$ = Header$ + "Date:" + _
    DateFromMapiDate$(msg.MsgDateReceived, conMailLongDate) + CR + CR
    GetHeader = Header$
End Function

Public Sub GetMessageCount()
    '獲得郵箱中所有消息（郵件）的數(shù)量
    Screen.MousePointer = 11
    Main.MAPIMess.FetchUnreadOnly = 0
    Main.MAPIMess.Action = vbMessageFetch
    Main.Statusbar1.Panels(1) = "收信箱里共有" + Format$(Main.MAPIMess.MsgCount) + "郵件"
    Screen.MousePointer = 0
End Sub

Public Function GetRCList(msg As Control, RCType As Integer) As String
'從MAPIMessages控件中獲得所有收信人的姓名，
    '姓名之間用分號隔開，返回值為所有收信人姓名
    For i = 0 To msg.RecipCount - 1
        msg.RecipIndex = i
        If RCType = msg.RecipType Then
            a$ = a$ + ";" + msg.RecipDisplayName
        End If
    Next i
    If a$ <> "" Then
        a$ = Mid$(a$, 2)
    End If
    GetRCList = a$
End Function

Public Sub KillRecips(Msgcontrol As Control)
'從MAPIMessages控件中刪除所有收信人地址
    While Msgcontrol.RecipCount
        Msgcontrol.Action = vbRecipientDelete
    Wend
End Sub