frmmain1.frm

智能邮件管理信息系统

End Sub
'********************************************************************************


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function:定义邮件列表中的右键菜单
'Author:[e-mail]
'Create Date:2004-03-27
'Last Modify:2004-03-28
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ctlMailList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Dim strsql As String
    Dim strsql1 As String
    Dim lngEmployeeID As Long
    Dim strEmployeeID As String
    Dim strCustomerID As String
    Dim lngCustomerID As Long
    Dim strFilter As String
    
    Dim lngCustomerCounter As Long

    Dim recTmp As New ADODB.Recordset

    mclsMailCreator.GetMail ctlMailList.mlngCurrentSelectID, m_MailType



    '********************************************************************************
    '邮件分发处理
   '"email地址匹配"规则：根据“发件人”email地址到联系人表中找到该信是哪个客户发来的，找到后，就把该客户对应的
   '职员的lngContactID存到mail表的lngContactID.这时该邮件就有了归属人?
   ' 还有考虑到一些特殊情况的分支处理，比如，找不到匹配的客户怎么办？ 有多个客户具有相同的email地址怎么办？

    '此处匹配邮件地址(客户中)
    strsql = "select * FROM contact where lnguserid=" & mlngUserID & "  and blnIsNew=0 and lngType=1 and strEmail='" & m_MailType.StrReceiverString & "'"
    
    
    
    CDepartmentAndConact.GetContacts strsql, m_Contacts
    
    strFilter = IIf(m_E_ViewMode = m_CliendMode, "  and lngType=0 ", " and lngType=0 ")
    strsql1 = "select * from contact  where blnIsNew=0 " & strFilter 'lnguserid
    
    CDepartmentAndConact.GetContacts strsql1, m_ContactZhuans
    strCustomerID = ""

    If m_Contacts.Count > 0 Then
        '可能的客户ID列表
        For lngCustomerCounter = 0 To m_Contacts.Count - 1
            lngCustomerID = m_Contacts.Contact(lngCustomerCounter).lngContactID
            strCustomerID = strCustomerID & lngCustomerID & ","
        Next lngCustomerCounter

        If Trim(strCustomerID) <> "" Then
            If Right(strCustomerID, 1) = "," Then
                strCustomerID = left(strCustomerID, Len(strCustomerID) - 1)
                strCustomerID = "(" & strCustomerID & ")"
            Else
                strCustomerID = "(" & strCustomerID & ")"
            End If
        End If

        '根据客户找到对应的联系人列表ID
        If Trim(strCustomerID) <> "" Then
            strsql = "select lngEmployeeID from Customer where lngCustomerID in " & strCustomerID
        Else
            strsql = "select lngEmployeeID from Customer "
        End If
        Dim i As Long
        If recTmp.State = adStateOpen Then recTmp.Close
        recTmp.Open strsql, gdbCurrentDB, adOpenStatic, adLockReadOnly
        If Not (recTmp.EOF And recTmp.BOF) Then
            recTmp.MoveLast
            recTmp.MoveFirst
        End If
        On Error Resume Next

        While Not recTmp.EOF
            With recTmp
                lngEmployeeID = IIf(IsNull(!lngEmployeeID), 0, !lngEmployeeID)
                strEmployeeID = strEmployeeID & lngEmployeeID & ","
            End With
            recTmp.MoveNext
        Wend


        If Trim(strEmployeeID) <> "" Then
            If Right(strEmployeeID, 1) = "," Then
                strEmployeeID = left(strEmployeeID, Len(strEmployeeID) - 1)
                strEmployeeID = "(" & strEmployeeID & ")"
            Else
                strEmployeeID = "(" & strEmployeeID & ")"
            End If
        End If

        '根据对应的可能的职员,加载菜单
        If Trim(strEmployeeID) <> "" Then
            strsql = "select * FROM contact where lngType=0   and blnIsNew=0 and lngContactID in " & strEmployeeID
        Else
            strsql = "select * FROM contact where  lnguserid=" & mlngUserID & "  and lngType=0"
        End If

    Else
        
'        strsql = "select * FROM contact where lnguserid=" & mlngUserID & "  and blnIsNew=0 and lngType=0"
    End If
    CDepartmentAndConact.GetContacts strsql, m_Contacts
    '********************************************************************************


    '********************************************************************************
    '邮件归并

    '********************************************************************************


    If Button = vbRightButton Then
        Set mnuPopMenu = New XpPopMenu.cPopupMenu

        With mnuPopMenu
            '在什么组件上显示出来(以那个组件为弹出坐标参照）
    '        .ImageList = imgNormal
            .OfficeXpStyle = True
            .MenuBackgroundColor = -1
            .InActiveMenuForeColor = -1
            .ActiveMenuForeColor = -1
            .ActiveMenuBackgroundColor = -1
            .Font = Nothing
            .BackgroundPicture = Nothing
            .HeaderStyle = ecnmHeaderSeparator

            .HideInfrequentlyUsed = True
            .OfficeXpStyle = False
            Dim blnSelectMail As Boolean
            blnSelectMail = (ctlMailList.mlngCurrentSelectID > 0)


            .ClearMenuItems
            .hwndOwner = ctlMailList.hwnd
            .ImageList = m_CImageListHot.hIml
            
            .AddMenuItem "OpenMail", IIf(BlnEnglishVersion, "Open(&O)", "打开(&O)"), "EditMail", , , , , blnSelectMail
            .MenuItemVisible("OpenMail") = BlnOneUser And m_E_ViewMode = m_ServerMode  '帐户信箱只保留“收件箱”，“垃圾箱”两个.
            
            .AddMenuItem "PrintMail", IIf(BlnEnglishVersion, "Print(&P)", "打印(&P)"), "EditMail", , , 30, , blnSelectMail
            .AddMenuItem "Sep001", "-", "EditMail"

            
            .AddMenuItem "ReSend", IIf(BlnEnglishVersion, "ReSend(&R)", "再次发送(&R)"), "EditMail", , , 13, , (ctlMailList.mlngCurrentSelectID > 0), (ctlMailList.mlngViewID = 4)
            .MenuItemVisible("ReSend") = BlnOneUser And m_E_ViewMode = m_ServerMode '帐户信箱只保留“收件箱”，“垃圾箱”两个.
            
            .MenuItemVisible(mnuPopMenu.IndexFromKey("ReSend")) = (ctlMailList.mlngViewID = 4)
            .AddMenuItem "ReSender", IIf(BlnEnglishVersion, "回复(&S)", "回复(&S)"), "EditMail", , , , , (ctlMailList.mlngCurrentSelectID > 0) And (ctlMailList.mlngViewID = 2)
            .MenuItemVisible("ReSender") = BlnOneUser And m_E_ViewMode = m_ServerMode '帐户信箱只保留“收件箱”，“垃圾箱”两个.
            
            .AddMenuItem "ReAllMail", IIf(BlnEnglishVersion, "全部回复(&A)", "全部回复(&A)"), "EditMail", , , , , (ctlMailList.mlngCurrentSelectID > 0) And (ctlMailList.mlngViewID = 2)
            .MenuItemVisible("ReAllMail") = BlnOneUser And m_E_ViewMode = m_ServerMode '帐户信箱只保留“收件箱”，“垃圾箱”两个.
            
            .AddMenuItem "ResendMail", IIf(BlnEnglishVersion, "转发(&F)", "转发(&F)"), "EditMail", , , , , (ctlMailList.mlngCurrentSelectID > 0) And (ctlMailList.mlngViewID = 2)
            .MenuItemVisible("ResendMail") = BlnOneUser And m_E_ViewMode = m_ServerMode '帐户信箱只保留“收件箱”，“垃圾箱”两个.
                                                         
            .AddMenuItem "ResendAsFJ", IIf(BlnEnglishVersion, "作为附件转发(&W)", "作为附件转发(&W)"), "EditMail", , , 50, , (ctlMailList.mlngCurrentSelectID > 0) And (ctlMailList.mlngViewID = 2)
            .MenuItemVisible("ResendAsFJ") = BlnOneUser And m_E_ViewMode = m_ServerMode  '帐户信箱只保留“收件箱”，“垃圾箱”两个.
            
            .AddMenuItem "Sep002", "-", "EditMail"
            .MenuItemVisible("Sep002") = BlnOneUser And m_E_ViewMode = m_ServerMode  '帐户信箱只保留“收件箱”，“垃圾箱”两个.
            
            #If SimpleVersion = 0 Then
                .AddMenuItem "SendToOtherFenAll", IIf(BlnEnglishVersion, "内部分发所有(&F)", "内部分发所有(&F)"), "EditMail", , , 52, , (m_E_TreeViewType = m_OutlookTreeView And ctlMailList.mlngViewID = 2), (m_E_ViewMode = m_ServerMode)
                .MenuItemVisible(.IndexFromKey("SendToOtherFenAll")) = (m_E_ViewMode = m_ServerMode)
    
                .AddMenuItem "SendToOtherFen", IIf(BlnEnglishVersion, "内部分发(&F)", "内部分发(&F)"), "EditMail", , , , , blnSelectMail And (m_E_TreeViewType = m_OutlookTreeView And ctlMailList.mlngViewID = 2), (m_E_ViewMode = m_ServerMode)
                .MenuItemVisible(.IndexFromKey("SendToOtherFen")) = (m_E_ViewMode = m_ServerMode)
                If m_Contacts.Count > 0 Then
                    For i = 0 To m_Contacts.Count - 1
                        LSet m_Contact = m_Contacts.Contact(i)
                        .AddMenuItem "SendToOtherFen" & m_Contact.lngContactID, m_Contact.strContactName & "(" & m_Contact.strEmail & ")", "SendToOtherFen", , 10, , , blnSelectMail And (m_E_TreeViewType = m_OutlookTreeView)
                    Next i
                End If
    
                .AddMenuItem "SendToOtherZhuan", IIf(BlnEnglishVersion, "内部转发(&F)", "内部转发(&F)"), "EditMail", , , , , blnSelectMail
                If m_Contacts.Count > 0 Then
                    For i = 0 To m_ContactZhuans.Count - 1
                        LSet m_Contact = m_ContactZhuans.Contact(i)
                        .AddMenuItem "SendToOtherZhuan" & m_Contact.lngContactID, m_Contact.strContactName & "(" & m_Contact.strEmail & ")", "SendToOtherZhuan", , 100, , , blnSelectMail
                    Next i
                End If
                '转发给多个联系人
                .AddMenuItem "Sep001000", "-", "SendToOtherZhuan"
                .AddMenuItem "SendToOtherSZhuan", IIf(BlnEnglishVersion, "选择多个收件人", "选择多个收件人"), "SendToOtherZhuan", , , , , blnSelectMail
                .AddMenuItem "Sep0010", "-", "EditMail"
    
                '*归并的条件: 1.只有看过的邮件可以归并.
                '2.只有"收件箱"和"已发送邮件箱"中的邮件可以归并.
                .AddMenuItem "SendToCustomerAll", IIf(BlnEnglishVersion, "全部归并", "全部归并"), "EditMail", , , 27, , ctlMailList.mlngViewID = 2 Or ctlMailList.mlngViewID = 4
                .AddMenuItem "SendToCustomer", IIf(BlnEnglishVersion, "归并所选邮件", "归并所选邮件"), "EditMail", , , , , blnSelectMail And (ctlMailList.mlngViewID = 2 Or ctlMailList.mlngViewID = 4)
                .AddMenuItem "Sep0011", "-", "EditMail"
            #End If
            .AddMenuItem "MarkReaded", IIf(BlnEnglishVersion, "MarkReaded(&K)", "标记为""已读""(&K)"), "EditMail", , , , , blnSelectMail
            .AddMenuItem "MarkUnRead", IIf(BlnEnglishVersion, "MarkUnRead(&N)", "标记为""未读""(&N)"), "EditMail", , , , , blnSelectMail
            .AddMenuItem "Sep005", "-", "EditMail"

            .AddMenuItem "MailTrack", IIf(BlnEnglishVersion, "MailTrack", IIf(m_MailType.btnTrack, "查看跟踪", "新建跟踪")), "EditMail", , , 20, , blnSelectMail
            .AddMenuItem "MailUNTrack", IIf(BlnEnglishVersion, "UnMailTrack", "取消跟踪"), "EditMail", , , , , blnSelectMail And (m_MailType.btnTrack <> 0)
            .AddMenuItem "Sep003", "-", "EditMail"

            .AddMenuItem "MoveToFolder", IIf(BlnEnglishVersion, "MoveToFolder(&V)...", "移动到文件夹(&V)..."), "EditMail", , , , , blnSelectMail
            .AddMenuItem "CopyToFolder", IIf(BlnEnglishVersion, "CopyToFolder(&C)...", "复制到文件夹(&C)..."), "EditMail", , , , , blnSelectMail
            .AddMenuItem "DeleteMail", IIf(BlnEnglishVersion, "DeleteMail(&D)", "删除(&D)"), "EditMail", , , 6, , blnSelectMail
'            .AddMenuItem "Sep004", "-", "EditMail"

'            .AddMenuItem "AddSenderToAccounts",             iif(blnEnglishVersion,"将发件人添加到通讯簿(&B)","将发件人添加到通讯簿(&B)"),           "EditMail",             ,           ,           ,           ,           blnSelectMail

            .AddMenuItem "Per", IIf(BlnEnglishVersion, "属性(&R)", "属性(&R)"), "EditMail", , , , , blnSelectMail
            .MenuItemVisible(.IndexFromKey("Per")) = False
            .ShowPopupMenu x, y
        End With
    End If
End Sub

Private Sub ctlMailList_ReadCellClick(BlnReadTag As Boolean)
    If ctlMailList.mlngCurrentSelectID > 0 Then
        mclsMailCreator.GetMail ctlMailList.mlngCurrentSelectID, m_MailType
        m_MailType.StrReadTag = IIf(BlnReadTag, MailDll.msReceiveReaded, MailDll.msReceiveNoRead)
        If mclsMailCreator.SaveMail(m_MailType) Then
            If m_E_TreeViewType = m_OutlookTreeView Then
                RefreshTreeView
            End If
        End If
    End If
End Sub
'
Private Sub ctlTopToolBar_ButtonClick(ByVal lButton As Long)
    Dim mlngCurrentSelectID As Long
    Dim lngCurrentID As Long
    
    
    Select Case UCase(ctlTopToolBar.ButtonKey(lButton))
    Case UCase("TOOLSNEW")
        blnIsBusy = True
        mlngCurrentSelectID = mclsMailCreator.AddMail(mlngUserID, m_MailTemplate, m_E_ViewMode, IIf(m_E_ViewMode = m_ServerMode, 0, gLngContactID), gLngOwnDefineTreeID)
        If mlngCurrentSelectID > 0 Then
            If mclsMailCreator.BlnExcuteSendMail Then
                m_CSmtpInterface.SendAMail mlngUserID, mlngCurrentSelectID, True
            End If

            RefreshMailList
            RefreshTreeView
        End If
        blnIsBusy = False
    Case UCase("TOOLSRE") '回复发件人
        blnIsBusy = True
        lngCurrentID = mclsMailCreator.Writeback(ctlMailList.mlngCurrentSelectID, gLngContactID)
        If mclsMailCreator.BlnExcuteSendMail Then
            m_CSmtpInterface.SendAMail mlngUserID, lngCurrentID, True
        End If
        blnIsBusy = False
    Case UCase("TOOLSREALL") '全部回复发件人
        blnIsBusy = True
        lngCurrentID = mclsMailCreator.WriteBackAll(ctlMailList.mlngCurrentSelectID, gLngContactID)
        If mclsMailCreator.BlnExcuteSendMail Then
            m_CSmtpInterface.SendAMail mlngUserID, lngCurrentID, True
        End If
        blnIsBusy = False
    Case UCase("TOOLSRESEND") '转发信件
        blnIsBusy = True
        lngCurrentID = mclsMailCreator.Transmit(ctlMailList.mlngCurrentSelectID, gLngContactID)
        If mclsMailCreator.BlnExcuteSendMail Then
            m_CSmtpInterface.SendAMail mlngUserID, lngCurrentID, True
        End If
        blnIsBusy = False
    Case UCase("TOOLSPRINT")
        ctlMailBrowser.PrintDoc
    Case UCase("TOOLSDELETE")
        '删除当前选择的
        SendRecycle False
        
       
    Case UCase("TOOLSSENDANDREC")
        Dim MailIndex(0) As Long
        
        m_CPop3Interface.ReceiveMail mlngUserID, MailIndex, True, False
        If m_E_ViewMode = m_ServerMode Then
            m_CSmtpInterface.SendOneUserMail mlngUserID, 0
        Else
            m_CSmtpInterface.SendOneUserMail mlngUserID, gLngContactID
        End If
        RefreshTreeView
        RefreshMailList
    Case UCase("TOOLSBOOKS")
        CDepartmentAndConactManager.ShowContactManager gdbCurrentDB, mlngUserID, gLngContactID, m_E_ViewMode
    Case UCase("TOOLSSEAR")
        mCSearchAttach.ShowSearchAttachment gdbCurrentDB, mlngUserID, 3, BlnOneUser
'        SetSearchVis True
    Case UCase("TOOLQuickMail")
        blnIsBusy = True
        FrmQuickMail.Show
    Case UCase("TOOLSCODE")
    End Select
End Sub

'********************************************************************************
'根据帐户加载菜单
Private Sub ctlTopToolBar_DropDownPress(ByVal lButton As Long)
    Dim x As Long, y As Long
    ctlTopToolBar.GetDropDownPosition lButton, x, y
    
    Debug.Print ctlTopToolBar.ButtonKey(lButton)