cpop3interface.cls

智能邮件管理信息系统

        m_MailType.lngOwnDefineTreeID = m_CurMailmessage.lngOwnDefineTreeID
        m_MailType.BlnFenError = m_CurMailmessage.BlnFenError
        
        m_MailType.DteReceiveDate = Format(Now, "ddddd ttttt")
        m_MailType.StrReadTag = MailDll.msReceiveNoRead
        m_MailType.strMailBoxTag = "ReceptBox"
        m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.InMailBox
        m_MailType.StrMailFileName = WriteTempMail(m_CurMailmessage.StrMailFileNameAscii)
        
        
        '接收的邮件自动加入追踪列表
        RefreshOption
        
        If mMailOptional.intReceiveRemind Then
            m_CurMailmessage.btnTrack = 1
        End If
'        If m_UserType.intReceiveRemind Then
'            m_CurMailmessage.btnTrack = 1
'        End If
        
        
        '当接收时,将发出的接收人用来存对方地址
        m_MailType.StrReceiverString = m_CurMailmessage.strFromMailAddress
        m_MailType.strFromContact = m_CurMailmessage.strFromContact
        
        
        '抄送人
        ReDim m_MailType.lngCopy(0)
        
        '快速收发时才触发该事件
        m_MailType.BlnHaveDoneAttach = 0
        m_MailType.BlnHaveDoneBody = 0
    
        
        Dim m_CMail As MailDll.Mail
        Set m_CMail = New MailDll.Mail
        m_CMail.Init gdbCurrentDB, m_E_ViewMode
        Call m_CMail.SaveMail(m_MailType, True, True, True, True)
        Set m_CMail = Nothing
        
        If ObjFileSystem.FileExists(m_MailType.StrMailFileName) Then
            ObjFileSystem.DeleteFile m_MailType.StrMailFileName, True
        End If
        
'        m_CurMailmessage.lngMailID = m_MailType.lngMailID
        
'        RaiseEvent MailMessageComing(m_MailType)
         
        '********************************************************************************
    End If
    
    Set ObjFileSystem = Nothing
    Set recTmp = Nothing
    
'********************************************************************************
End Sub

'********************************************************************************
Private Sub mCReceiveMail_MessageOnlyHeaderComing(m_CurMailmessage As CSMTP.MessageType)
    m_CurMailmessage.blnIsQuickMail = 1
    m_CurMailmessage.lngMailID = 0
    mCReceiveMail_MessageComingData m_CurMailmessage
End Sub

Private Sub mCReceiveMail_ReplayMailCount(ByVal sMessage As String)
    f.MsgCount.Caption = sMessage
End Sub

Private Sub mCReceiveMail_ReplaySendProgress(ByVal lngAllByte As Double, ByVal lngSendedByte As Double)
    On Error Resume Next
    
    f.ProgressBar1.Max = lngAllByte
    If lngSendedByte <= lngAllByte Then
        f.ProgressBar1.value = lngSendedByte
        f.MsgProgress.Caption = "当前进度: 已经接收" & Format(f.ProgressBar1.value / f.ProgressBar1.Max, "0.00%") & "   余" & Format(1 - f.ProgressBar1.value / f.ProgressBar1.Max, "0.00%")
        f.MsgProgress.Refresh
        
    End If
End Sub

Private Sub mCReceiveMail_ReplayTopMessage(ByVal sMessage As String)
    f.MsgTop.Caption = sMessage
End Sub

Private Sub mCReceiveMail_ReplyMessage(ByVal sMessage As String)
    On Error Resume Next
    '显示一些操作信息，比如系统正在干什么
    If Len(Trim(sMessage)) <> 0 Then
        f.txtMessages.AddItem (sMessage)
        f.txtMessages.ListIndex = f.txtMessages.NewIndex
        frmMain.Status sMessage
    End If
End Sub










Public Sub BlnCancel(m_BlnCancel)
     mCReceiveMail.ProcessCancel = m_BlnCancel
End Sub






Private Function GetCurComputerName() As String
    Dim dwLen As Long
    Dim strString As String
    'Create a buffer
    dwLen = MAX_COMPUTERNAME_LENGTH + 1
    strString = String(dwLen, "X")
    'Get the computer name
    GetComputerName strString, dwLen
    'get only the actual data
    strString = left(strString, dwLen)
    'Show the computer name
    GetCurComputerName = strString
End Function















'********************************************************************************
'接收本地所有帐户的邮件
Public Function ReceiveLocalAllMail(MailIndex() As Long, Optional BlnOnlyHeader As Boolean = False, Optional ByVal blnShowMsg As Boolean = True) As Boolean
    Dim i As Long
    Dim strsql As String
    blnIsBusy = True
            
    ReceiveLocalAllMail = True
    mCReceiveMail.ProcessCancel = False
    DoEvents
    '********************************************************************************
    '取帐户信息
    
    Dim m_UserTypeType As Account.UserType
    Dim m_UserTypeTypes As Account.UserTypes
    Dim m_AccountClass1 As Account.AccountClass
    Set m_AccountClass1 = GetAccountClass
    m_AccountClass1.GetUsers strAccountSql, m_UserTypeTypes
    Set m_AccountClass1 = Nothing

    
    
    
    '********************************************************************************
    Dim m_MailUserType As CSMTP.AccountType
    
    
    '********************************************************************************
    '邮件表 得到本地SEQ(已经接收到本地的邮件唯一标识列表,如果本地已经有了,就不收取邮件了 )
    Dim CMail As MailDll.Mail
    Dim m_MailsType As MailDll.Mails
    
    Set CMail = New MailDll.Mail
    CMail.Init gdbCurrentDB, m_E_ViewMode
    CMail.GetMailsSimple "Select * From Mail" & IIf(BlnOnlyHeader = True, "  where blnIsQuickMail=1", " where blnIsQuickMail=0"), m_MailsType
    '********************************************************************************
    ReceiveLocalAllMail = True
     
    
    '显示该窗体
    
    Dim mcShowModal As New cShowModal
    If blnShowMsg Then
        mcShowModal.ShowModal f, frmMain
        f.Refresh
        f.Caption = "接收邮件"
        f.txtMessages.Clear
    End If
    
    
    
    
    
    '连接服务器m_UserTypeType中包括 POP3/smtp地址 密码,用户,接收地址等信息
    Dim strLocalMailSeq() As String
    ReDim strLocalMailSeq(m_MailsType.Count)
    
    For i = 0 To m_MailsType.Count
        strLocalMailSeq(i) = m_MailsType.Mail(i).StrMailID
    Next i
    
   
    
    For i = 0 To m_UserTypeTypes.Count - 1
        If mCReceiveMail.ProcessCancel Then
            Unload f
            Exit Function
        End If
        LSet m_UserTypeType = m_UserTypeTypes.UserType(i)

    
        m_MailUserType.LngUserID = m_UserTypeType.LngUserID
        m_MailUserType.AccountName = m_UserTypeType.AccountName
        m_MailUserType.Password = m_UserTypeType.Password
        m_MailUserType.UserName = m_UserTypeType.UserName
        m_MailUserType.lngDepartmentID = m_UserTypeType.lngDepartmentID
        m_MailUserType.UserEmailAddress = m_UserTypeType.UserEmailAddress
        m_MailUserType.BlnInclude = m_UserTypeType.BlnInclude
        m_MailUserType.POP3SeverName = m_UserTypeType.POP3SeverName
        m_MailUserType.SMTPSeverName = m_UserTypeType.SMTPSeverName
        m_MailUserType.StrSMTPPort = m_UserTypeType.StrSMTPPort
        m_MailUserType.StrPOP3Port = m_UserTypeType.StrPOP3Port
        m_MailUserType.LngTimeOut = m_UserTypeType.LngTimeOut
        'm_MailUserType.BlnDefault = m_UserTypeType.BlnDefault
        m_MailUserType.blnSendMailCheck = m_UserTypeType.blnSendMailCheck
        m_MailUserType.BlnSameAsReceiptMail = m_UserTypeType.BlnSameAsReceiptMail
        m_MailUserType.StrCheckUserName = m_UserTypeType.StrCheckUserName
        m_MailUserType.StrCheckPassWord = m_UserTypeType.StrCheckPassWord
        m_MailUserType.StrReceiveAttchPath = m_UserTypeType.StrReceiveAttchPath
        m_MailUserType.StrReceiveFilePath = m_UserTypeType.StrReceiveFilePath
        m_MailUserType.StrSendAttchPath = m_UserTypeType.StrSendAttchPath
        m_MailUserType.StrSendFilePath = m_UserTypeType.StrSendFilePath
        m_MailUserType.BlnSetMangeDir = m_UserTypeType.BlnSetMangeDir
        m_MailUserType.strContactName = m_UserTypeType.strContactName
        m_MailUserType.intAutoReceive = m_UserTypeType.intAutoReceive
        m_MailUserType.intAutoMinute = m_UserTypeType.intAutoMinute
        m_MailUserType.intAutoFenFa = m_UserTypeType.intAutoFenFa
        m_MailUserType.intAutoFenFaMinute = m_UserTypeType.intAutoFenFaMinute
        m_MailUserType.BlnNotDelete = m_UserTypeType.BlnNotDelete
    
            
        m_LogType.lngLogID = 0
        m_LogType.lngLogClass = 0 '邮件日志
        m_LogType.dteLogDate = Format(Now, "ddddd ttttt")
        m_LogType.LngEmployeeID = m_UserTypeType.LngEmployeeID
        m_LogType.strComputerName = GetCurComputerName
        m_LogType.strUserName = m_UserTypeType.AccountName
        m_LogType.strLogContent = "开始接收邮件->"
        
        
        mCReceiveMail.ProcessCancel = False
        
        If Not mCReceiveMail.ProcessConnectSever(m_MailUserType, strLocalMailSeq) Then
            ReceiveLocalAllMail = False
            m_LogType.lngLogClass = 0 '邮件日志
            m_LogType.strLogContent = m_LogType.strLogContent & "连接失败->"
            CclsLog.SaveLog m_LogType, False, False
            blnIsBusy = False
        Else
            '接收邮件
            If Not mCReceiveMail.ProcessReceiveMail(MailIndex, BlnOnlyHeader, True, BlnOnlyHeader) Then
                ReceiveLocalAllMail = False
                m_LogType.lngLogClass = 0 '邮件日志
                m_LogType.strLogContent = m_LogType.strLogContent & "接收邮件失败->"
                CclsLog.SaveLog m_LogType, False, False
                '不退出来,继续下一个帐户
                blnIsBusy = False
            End If
        End If
        
    Next i
    
    
   '退出邮件登陆(优化后去掉)
'    mCReceiveMail.ProcessQUITRECEIVECommand
    
    
    m_LogType.strLogContent = m_LogType.strLogContent & "接收邮件成功."
    CclsLog.SaveLog m_LogType, False, False
    
    
    
    Unload f
    blnIsBusy = False
End Function






Private Sub RefreshOption()
    Dim strsql As String
    
    Set mclsMailOptional = New MailOptionalDll.clsMailOptional
    mclsMailOptional.Init gdbCurrentDB
    
    mMailOptional.LngEmployeeID = gLngEmployeeID1
                
    If mMailOptional.LngEmployeeID > 0 Then
        strsql = "select * from MailOptional where lngEmployeeID=" & mMailOptional.LngEmployeeID
        mclsMailOptional.GetMailOptionals strsql, mMailOptionals
        If mMailOptionals.Count = 1 Then
            mMailOptional.LngMailOptionalID = mMailOptionals.MailOptional(0).LngMailOptionalID
        End If
    End If
    mclsMailOptional.GetMailOptional mMailOptional.LngMailOptionalID, mMailOptional
End Sub




Private Function strAccountSql()
    If m_E_ViewMode = m_ServerMode Then
        strAccountSql = "Select * from MailAccount"
    Else
        strAccountSql = "Select * from MailAccount Where lngEmployeeID=" & gLngEmployeeID1 & " OR lngUserID IN (SELECT LngMailAccountID  from EmployeeAccount where LngEmployeeID=" & gLngEmployeeID1 & ")"
    End If
    
End Function









Private Function WriteTempMail(ByVal strMailText As String) As String
        Dim strAttachFilePath As String
        If Right(App.Path, 1) <> "\" Then
            strAttachFilePath = App.Path & "\"
        Else
            strAttachFilePath = App.Path
        End If
        
        Dim lngmailMaxID As Long
        
        Dim objRecordset As New ADODB.Recordset
        Dim strsql As String
        strsql = "select max(lngmailid) as lngmailMaxID FROM MAIL"
        If objRecordset.State = adStateOpen Then objRecordset.Close
        objRecordset.Open strsql, gdbCurrentDB, adOpenStatic, adLockReadOnly
        
        If Not objRecordset.EOF Then
            lngmailMaxID = IIf(IsNull(objRecordset!lngmailMaxID), 0, objRecordset!lngmailMaxID) + 1
        Else
            lngmailMaxID = 1
        End If
        
        Dim intTemp As Integer
        intTemp = FreeFile
        
retry:
        On Error Resume Next
        Dim objFileSystemObject As New FileSystemObject
        If objFileSystemObject.FileExists(strAttachFilePath & "Temp" & lngmailMaxID & ".Eml") Then
            Call objFileSystemObject.DeleteFile(strAttachFilePath & "Temp" & lngmailMaxID & ".Eml", True)
        End If
        Open strAttachFilePath & "Temp" & lngmailMaxID & ".Eml" For Output As #intTemp
        Print #intTemp, strMailText
        Close intTemp
        
        WriteTempMail = strAttachFilePath & "Temp" & lngmailMaxID & ".Eml"
        
End Function