cpop3interface.cls

智能邮件管理信息系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CPop3Interface"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private WithEvents mCReceiveMail As CSMTP.CReceiveMail
Attribute mCReceiveMail.VB_VarHelpID = -1
'example by Donavon Kuhn ([e-mail])
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Private mclsMailOptional As MailOptionalDll.clsMailOptional
Dim mMailOptional As MailOptionalDll.MailOptional
Dim mMailOptionals As MailOptionalDll.MailOptionals

'********************************************************************************
'邮件日志
Dim CclsLog As LogProject.clsLog
Dim m_LogType As LogProject.Log
'********************************************************************************
    
Dim f As New FrmSendMailState


Private Sub Class_Initialize()
    Set mCReceiveMail = New CSMTP.CReceiveMail
    Set CclsLog = New LogProject.clsLog
    CclsLog.Init gdbCurrentDB
    
    ReDim m_MailTypeCatch(0)
End Sub


'接收一封邮件
Public Function ReceiveMail(m_lngUserID As Long, MailIndex() As Long, Optional blnAll As Boolean = True, Optional BlnOnlyHeader As Boolean = False, Optional ByVal blnShowMsg As Boolean = True) As Boolean
    Dim i As Long
    
    blnIsBusy = True
    
    ReceiveMail = True
    
    mCReceiveMail.ProcessCancel = False
    DoEvents
    '********************************************************************************
    '取帐户信息
    
    Dim m_UserTypeType As Account.UserType
    Dim m_MailUserType As CSMTP.AccountType
    
    Dim m_AccountClass1 As Account.AccountClass
    Set m_AccountClass1 = GetAccountClass
    m_AccountClass1.GetUser m_lngUserID, m_UserTypeType
    Set m_AccountClass1 = Nothing


    
    
    
    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

    '********************************************************************************
       
    '********************************************************************************
    '邮件表 得到本地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 Where LngUserID=" & m_lngUserID & IIf(BlnOnlyHeader = True, " and blnIsQuickMail=1", " and blnIsQuickMail=0"), m_MailsType
    '********************************************************************************
    ReceiveMail = True
     
    Dim mcShowModal As New cShowModal
    
    If blnShowMsg Then
        mcShowModal.ShowModal f, frmMain
        f.Refresh
        '显示该窗体
        f.Caption = "接收邮件"
        f.ProgressBar1.value = 0
        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 - 1
        strLocalMailSeq(i) = m_MailsType.Mail(i).StrMailID
    Next i
    
    m_LogType.lngLogID = 0
    m_LogType.lngLogClass = 0 '邮件日志
    m_LogType.dteLogDate = Format(Now, "ddddd ttttt")
    m_LogType.LngEmployeeID = gLngEmployeeID1
    m_LogType.strComputerName = GetCurComputerName
    m_LogType.strUserName = m_UserTypeType.AccountName
    m_LogType.strLogContent = "开始接收邮件->"
    
    
    
    If Not mCReceiveMail.ProcessConnectSever(m_MailUserType, strLocalMailSeq) Then
        ReceiveMail = False
        m_LogType.lngLogClass = 0 '邮件日志
        m_LogType.strLogContent = m_LogType.strLogContent & "连接失败->"
        CclsLog.SaveLog m_LogType, False, False
        blnIsBusy = False
        ReceiveMail = False
        Unload f
        Exit Function
    End If
    
    '接收邮件
    If Not mCReceiveMail.ProcessReceiveMail(MailIndex, BlnOnlyHeader, blnAll, BlnOnlyHeader) Then
        ReceiveMail = False
        m_LogType.lngLogClass = 0 '邮件日志
        m_LogType.strLogContent = m_LogType.strLogContent & "接收邮件失败->"
        CclsLog.SaveLog m_LogType, False, False
        blnIsBusy = False
        ReceiveMail = False
        Unload f
        Exit Function
    End If
    
   '退出邮件登陆(优化后去掉)
'    mCReceiveMail.ProcessQUITRECEIVECommand
    
    
    m_LogType.strLogContent = m_LogType.strLogContent & "接收邮件成功."
    CclsLog.SaveLog m_LogType, False, False
    
    
    Unload f
    blnIsBusy = False
    ReceiveMail = True
    
End Function






'根据帐户ID和将要删除的邮件INDEX数组,彻底删除多个邮件
Public Function DeleteMailOfIndex(m_lngUserID As Long, MailIndex() As Long) As Boolean
    blnIsBusy = True
    Dim i As Long
    
    '取帐户信息(发件人信息 保存到 ReceiveMailUser)
'    Call SetMailUserValue(m_lngUserID)
    
    DeleteMailOfIndex = True
    
    Dim mcShowModal As New cShowModal
    mcShowModal.ShowModal f, frmMain
    f.Refresh
    '显示该窗体
    f.Caption = "删除邮件"
    f.ProgressBar1.value = 0
    f.txtMessages.Clear
    
    '删除邮件列表
'    If Not mCReceiveMail.DeleteMailOfIndexBefore(ReceiveMailUser) Then
'        DeleteMailOfIndex = False
'        Exit Function
'    End If
    
    
    For i = 0 To UBound(MailIndex) - 1
        If MailIndex(i) <> 0 Then
            If Not mCReceiveMail.ProcessDeleteMailOfIndex(MailIndex(i)) Then
                DeleteMailOfIndex = False
                blnIsBusy = False
                Unload f
                Exit Function
            End If
        End If
    Next i
    
    DeleteMailOfIndex = mCReceiveMail.ProcessQuitCommand
    
    '删除邮件成功
    
    
    Unload f
    blnIsBusy = False
End Function
            



Private Sub Class_Terminate()
    Set mCReceiveMail = Nothing
    Set CclsLog = Nothing
    
    Unload f
    Set f = Nothing
End Sub



'********************************************************************************
'根据来的邮件写数据库
Private Sub mCReceiveMail_MessageComing(m_CurMailmessage As CSMTP.MessageType)

    mCReceiveMail_MessageComingData m_CurMailmessage
End Sub




Private Sub mCReceiveMail_MessageComingData(m_CurMailmessage As CSMTP.MessageType)
    '********************************************************************************
    '根据来的邮件写数据库
    Dim m_MailType As MailDll.MailType
    Dim ObjFileSystem As New FileSystemObject
    

    '防止数据丢失，写数据库
    ReDim m_CurMailmessage.strCopyMailAddress(0)
    ReDim m_CurMailmessage.strMailImage(0)
    
    ReDim m_CurMailmessage.strReceiverMailAddress(0)
    ReDim m_CurMailmessage.strMailAttach(0)
    
    '如果是系统操作员建立的统一帐户，操作员在客户段接收后，是不应该看见邮件

    Dim m_UserTypeType As Account.UserType
    Dim m_AccountClass As Account.AccountClass
    Set m_AccountClass = GetAccountClass
    m_AccountClass.GetUser m_CurMailmessage.LngUserID, m_UserTypeType
    Set m_AccountClass = Nothing

    
    If m_UserTypeType.blnIsSystem Then
        m_CurMailmessage.LngEmployeeID = 0
    Else
        m_CurMailmessage.LngEmployeeID = gLngEmployeeID1
    End If
    
    

    m_CurMailmessage.strFromMailAddress = Replace(m_CurMailmessage.strFromMailAddress, vbCrLf, "", 1)
    m_CurMailmessage.strFromMailAddress = Replace(m_CurMailmessage.strFromMailAddress, vbCr, "", 1)
    m_CurMailmessage.strFromMailAddress = Replace(m_CurMailmessage.strFromMailAddress, vbLf, "", 1)
    
    m_CurMailmessage.strFromContact = m_CurMailmessage.strFromContact
    
    Dim i As Long
    For i = 0 To UBound(m_CurMailmessage.strCopyMailAddress)
        m_CurMailmessage.strCopyMailAddress(i) = Replace(m_CurMailmessage.strCopyMailAddress(i), vbCrLf, "", 1)
        m_CurMailmessage.strCopyMailAddress(i) = Replace(m_CurMailmessage.strCopyMailAddress(i), vbCr, "", 1)
        m_CurMailmessage.strCopyMailAddress(i) = Replace(m_CurMailmessage.strCopyMailAddress(i), vbLf, "", 1)
    Next
    
    For i = 0 To UBound(m_CurMailmessage.strReceiverMailAddress)
        m_CurMailmessage.strReceiverMailAddress(i) = Replace(m_CurMailmessage.strReceiverMailAddress(i), vbCrLf, "", 1)
        m_CurMailmessage.strReceiverMailAddress(i) = Replace(m_CurMailmessage.strReceiverMailAddress(i), vbCr, "", 1)
        m_CurMailmessage.strReceiverMailAddress(i) = Replace(m_CurMailmessage.strReceiverMailAddress(i), vbLf, "", 1)
    Next i
    
    m_CurMailmessage.StrReceiverString = Replace(m_CurMailmessage.StrReceiverString, vbCrLf, "", 1)
    m_CurMailmessage.StrReceiverString = Replace(m_CurMailmessage.StrReceiverString, vbCr, "", 1)
    m_CurMailmessage.StrReceiverString = Replace(m_CurMailmessage.StrReceiverString, vbLf, "", 1)
    
    '记录邮件主题到日志中
    m_LogType.strMailSubject = m_LogType.strMailSubject & ";" & m_CurMailmessage.strSubject
    ReDim m_CurMailmessage.lngReceiverID(0)
    
    '********************************************************************************
    '判断邮件是否已经存在
    Dim strsql As String
    Dim recTmp As New ADODB.Recordset
    If recTmp.State = adStateOpen Then recTmp.Close
    strsql = "Select * From Mail Where strMailID='" & m_CurMailmessage.StrMailID & "' And lngUserID=" & m_CurMailmessage.LngUserID & IIf(m_CurMailmessage.blnIsQuickMail = True, "  and blnIsQuickMail=1", "  and blnIsQuickMail=0")
    recTmp.Open strsql, gdbCurrentDB, adOpenStatic, adLockReadOnly
    '添加接收邮件信息到数据库_处理
    If Not recTmp.EOF Then
    Else
         '********************************************************************************
        '添加数据到数据库
        Dim m_UserType As Account.UserType
        Set m_AccountClass = GetAccountClass
        m_AccountClass.GetUser m_CurMailmessage.LngUserID, m_UserType
        Set m_AccountClass = Nothing
        
        m_MailType.lngMailID = m_CurMailmessage.lngMailID
        m_MailType.LngUserID = m_CurMailmessage.LngUserID
        m_MailType.strSubject = m_CurMailmessage.strSubject
        m_MailType.lngReceiverID = m_CurMailmessage.lngReceiverID
        m_MailType.StrReceiverString = m_CurMailmessage.StrReceiverString
        m_MailType.strReceiverMailAddress = m_CurMailmessage.strReceiverMailAddress
        m_MailType.lngCopy = m_CurMailmessage.lngCopy
        m_MailType.StrCopyString = m_CurMailmessage.StrCopyString
        m_MailType.StrCCString = m_CurMailmessage.StrCCString
        m_MailType.strCopyMailAddress = m_CurMailmessage.strCopyMailAddress
        m_MailType.DteCreateDate = m_CurMailmessage.DteCreateDate
        m_MailType.DteSendDate = m_CurMailmessage.DteSendDate
        m_MailType.DteReceiveDate = m_CurMailmessage.DteReceiveDate
        m_MailType.DteCCDate = m_CurMailmessage.DteCCDate
        m_MailType.StrReadTag = m_CurMailmessage.StrReadTag
        m_MailType.StrMailBig = m_CurMailmessage.StrMailBig
        m_MailType.StrMailID = m_CurMailmessage.StrMailID
        m_MailType.StrLevel = m_CurMailmessage.StrLevel
        m_MailType.BlnFlag = m_CurMailmessage.BlnFlag
        m_MailType.BlnNeedReply = m_CurMailmessage.BlnNeedReply
        m_MailType.BlnReplyed = m_CurMailmessage.BlnReplyed
        m_MailType.strMailBodyFile = m_CurMailmessage.strMailBodyFile
        m_MailType.strMailBoxTag = m_CurMailmessage.strMailBoxTag
        m_MailType.StrFromMailBoxTag = m_CurMailmessage.StrFromMailBoxTag
        m_MailType.StrMailFileName = m_CurMailmessage.StrMailFileName
        m_MailType.StrMemo = m_CurMailmessage.StrMemo
        m_MailType.strMailText = m_CurMailmessage.strMailText
        m_MailType.BlnIsDoneTag = m_CurMailmessage.BlnIsDoneTag
        m_MailType.StrMailTool = m_CurMailmessage.StrMailTool
        
        m_MailType.btnTrack = m_CurMailmessage.btnTrack
        m_MailType.intTrackDays = m_CurMailmessage.intTrackDays
        m_MailType.strTrackContent = m_CurMailmessage.strTrackContent
        m_MailType.strFromMailAddress = m_CurMailmessage.strFromMailAddress
        m_MailType.strFromContact = m_CurMailmessage.strFromContact
        m_MailType.strMailImage = m_CurMailmessage.strMailImage
        m_MailType.blnHaveAttach = m_CurMailmessage.blnHaveAttach
        m_MailType.strMailAttach = m_CurMailmessage.strMailAttach
        m_MailType.strSaveFilePath = m_CurMailmessage.strSaveFilePath
        m_MailType.LngEmployeeID = m_CurMailmessage.LngEmployeeID
        m_MailType.LngCustomerID = m_CurMailmessage.LngCustomerID
        m_MailType.blnIsQuickMail = m_CurMailmessage.blnIsQuickMail