csmtpinterface.cls

智能邮件管理信息系统

                    m_ContractType(i).strHomePostalCode = m_ContactReceiverType(i).strHomePostalCode
                    m_ContractType(i).strHomeProvince = m_ContactReceiverType(i).strHomeProvince
                    m_ContractType(i).strHomeCity = m_ContactReceiverType(i).strHomeCity
                    m_ContractType(i).strHomeAddress = m_ContactReceiverType(i).strHomeAddress
                    m_ContractType(i).strHomeTel = m_ContactReceiverType(i).strHomeTel
                    m_ContractType(i).strHomeTel2 = m_ContactReceiverType(i).strHomeTel2
                    m_ContractType(i).strHomeFax = m_ContactReceiverType(i).strHomeFax
                    m_ContractType(i).strEmail = m_ContactReceiverType(i).strEmail
                    If Trim(m_ContractType(i).strEmail) = "" Then
                        BlnReceiverOK = False
                    Else
                        BlnReceiverOK = True
                    End If
                    m_ContractType(i).strEmail2 = m_ContactReceiverType(i).strEmail2
                    m_ContractType(i).strMobiePhone = m_ContactReceiverType(i).strMobiePhone
                    m_ContractType(i).strICQ = m_ContactReceiverType(i).strICQ
                    m_ContractType(i).strMessager = m_ContactReceiverType(i).strMessager
                    m_ContractType(i).strQQ = m_ContactReceiverType(i).strQQ
                    m_ContractType(i).strPersonalWeb = m_ContactReceiverType(i).strPersonalWeb
                    m_ContractType(i).strBeeper = m_ContactReceiverType(i).strBeeper
                    m_ContractType(i).StrMemo = m_ContactReceiverType(i).StrMemo
                    m_ContractType(i).strOffice = m_ContactReceiverType(i).strOffice
                    m_ContractType(i).strCustomWork = m_ContactReceiverType(i).strCustomWork
                    m_ContractType(i).strNickName = m_ContactReceiverType(i).strNickName
                    m_ContractType(i).strGender = m_ContactReceiverType(i).strGender
                    m_ContractType(i).dteBirthday = m_ContactReceiverType(i).dteBirthday
                    m_ContractType(i).strPreference = m_ContactReceiverType(i).strPreference
                    m_ContractType(i).strStrongSuit = m_ContactReceiverType(i).strStrongSuit
                    m_ContractType(i).strPersonalCustom = m_ContactReceiverType(i).strPersonalCustom
                    m_ContractType(i).strHomeCustom = m_ContactReceiverType(i).strHomeCustom
                    m_ContractType(i).strSpouse = m_ContactReceiverType(i).strSpouse
                    m_ContractType(i).strHomeMember = m_ContactReceiverType(i).strHomeMember
                    m_ContractType(i).lngCommunicationAddress = m_ContactReceiverType(i).lngCommunicationAddress
                    m_ContractType(i).strPhotoFilePath = m_ContactReceiverType(i).strPhotoFilePath
                    m_ContractType(i).dteUpdateDate = m_ContactReceiverType(i).dteUpdateDate
                    m_ContractType(i).blnIsNew = m_ContactReceiverType(i).blnIsNew
                    m_ContractType(i).LngEmployeeID = m_ContactReceiverType(i).LngEmployeeID
                End If
            Next i
            
    
            If Not BlnReceiverOK Then
                If blnShowMsg Then
                    f.MsgTop.Caption = "缺少收件人信息."
                    On Error Resume Next
                    '显示一些操作信息，比如系统正在干什么
                    f.txtMessages.AddItem ("缺少收件人信息")
                    f.txtMessages.ListIndex = f.txtMessages.NewIndex
                End If
                SendOneUserMail = False
                blnIsBusy = False
                Unload f
                Exit Function
            End If
            
            
            SendOneUserMail = True
    
            
            m_LogType.lngLogID = 0
            m_LogType.lngLogClass = 0
            m_LogType.lngMailID = m_MailType.lngMailID
            m_LogType.strMailSubject = m_MailType.strSubject
            m_LogType.strSendTo = m_MailType.StrReceiverString
            m_LogType.dteLogDate = Format(Now, "ddddd ttttt")
            m_LogType.LngEmployeeID = gLngEmployeeID1
            m_LogType.strComputerName = GetCurComputerName
            m_LogType.strUserName = m_UserTypeType.AccountName
            m_LogType.strLogContent = "开始发送邮件->"
        
            '连接服务器(根据本地帐户连接)
            mCSendMail.ProcessCancel = False
            If mCSendMail.ProcessConnectSever(m_MailUserType) Then
            Else
                SendOneUserMail = False
                m_LogType.strLogContent = m_LogType.strLogContent & "连接失败->"
                CclsLog.SaveLog m_LogType, False, False
                blnIsBusy = False
                Unload f
                Exit Function
            End If
    
           
            '设置收件人地址
            If Not mCSendMail.ProcessSetReceiver(m_ContractType, m_ContactCopyTypeCSMTP) Then
                SendOneUserMail = False
                m_LogType.strLogContent = m_LogType.strLogContent & "设置收件人失败->"
                CclsLog.SaveLog m_LogType, False, False
                blnIsBusy = False
                Unload f
                Exit Function
            End If
            
    
    
            
            
            '取待发数据文件
            
        
    
            f.MsgCount.Caption = "待发邮件" & m_MailTypes.Count & "封，正在发第" & lngMailCounter + 1 & "封"
            '发送数据包
            'strFileName 为编码后待发邮件的文件名称
            If mCSendMail.ProcessSendMailData(m_MailType.StrMailFileName) Then
            Else
                SendOneUserMail = False
                m_LogType.strLogContent = m_LogType.strLogContent & "发送邮件文件失败->"
                CclsLog.SaveLog m_LogType, False, False
                blnIsBusy = False
                Unload f
                Exit Function
            End If
            
            
            '退出邮件登陆
             mCSendMail.ProcessQuitCommand
             
            SendOneUserMail = True
            '修改原来的邮件体文件
            '修改原来的附件文件
            
            '修改发送日期
            C_Mail.GetMailSimple m_MailType.lngMailID, m_MailType
            m_MailType.DteSendDate = Format(Now, "ddddd ttttt")
            m_MailType.strMailBoxTag = "SendedBox"
            m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.SendMail
            m_MailType.StrReadTag = MailDll.msReceiveReaded
            m_MailType.StrFromMailBoxTag = "SendBox"
            '发送的邮件自动加入追踪列表
            RefreshOption
            If mMailOptional.intSendRemind Then
                m_MailType.btnTrack = 1
            End If
            
'            If m_UserTypeType.intSendRemind Then
'                m_MailType.btnTrack = 1
'            End If

            C_Mail.SaveMail m_MailType, False, False, False, False
            
            m_LogType.strLogContent = m_LogType.strLogContent & "发送邮件文件成功."
            CclsLog.SaveLog m_LogType, False, False
        
        Next lngMailCounter
        
        
        Unload f
        blnIsBusy = False
End Function





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







Private Sub Class_Terminate()
    Set mCSendMail = Nothing
    Set CclsLog = Nothing
End Sub

Private Sub mCSendMail_ReplaySendProgress(ByVal lngAllByte As Double, ByVal lngSendedByte As Double)

    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%")
    End If
End Sub

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

Private Sub mCSendMail_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









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 SendLocalAllMail(m_EmployeeID As Long, ByVal blnShowMsg As Boolean) As Boolean
        SendLocalAllMail = True
        Dim strsql As String
        blnIsBusy = True
        On Error Resume Next
        
        mCSendMail.ProcessCancel = False
        DoEvents
        
        Dim BlnReceiverOK As Boolean
        BlnReceiverOK = True
        
        '********************************************************************************
        '取帐户信息
        Dim m_UserTypeType As Account.UserType
        Dim m_UserTypeTypes As Account.UserTypes
        Dim m_MailUserType As CSMTP.AccountType