csmtpinterface.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 = "CSmtpInterface"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

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

Dim f As New FrmSendMailState

Private objFileSystemObject As New FileSystemObject
Dim mMailOptional As MailOptionalDll.MailOptional
Dim mMailOptionals As MailOptionalDll.MailOptionals


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

Public WithEvents mCSendMail As CSMTP.CSendMail
Attribute mCSendMail.VB_VarHelpID = -1





Private Sub Class_Initialize()
    Set mCSendMail = New CSMTP.CSendMail
    Set CclsLog = New LogProject.clsLog
    CclsLog.Init gdbCurrentDB
End Sub



'********************************************************************************
'该函数用于构造信件内容
Public Function MakeMailBody(lngCurrentMailID As Long) As String
    
    '********************************************************************************
    '取邮件信息
    Dim m_MailMessage As MailDll.MailType
    Dim m_MailType As CSMTP.MessageType
    
    Dim m_CMail As MailDll.Mail
    Set m_CMail = New MailDll.Mail
    m_CMail.Init gdbCurrentDB, m_E_ViewMode
    m_CMail.GetMail lngCurrentMailID, m_MailMessage, True, True, False, True
    
    
    m_MailType.lngMailID = m_MailMessage.lngMailID
    m_MailType.LngUserID = m_MailMessage.LngUserID
    m_MailType.strSubject = m_MailMessage.strSubject
    m_MailType.lngReceiverID = m_MailMessage.lngReceiverID
    m_MailType.StrReceiverString = m_MailMessage.StrReceiverString
    m_MailType.strReceiverMailAddress = m_MailMessage.strReceiverMailAddress
    m_MailType.lngCopy = m_MailMessage.lngCopy
    m_MailType.StrCopyString = m_MailMessage.StrCopyString
    m_MailType.StrCCString = m_MailMessage.StrCCString
    m_MailType.strCopyMailAddress = m_MailMessage.strCopyMailAddress
    m_MailType.DteCreateDate = m_MailMessage.DteCreateDate
    m_MailType.DteSendDate = m_MailMessage.DteSendDate
    m_MailType.DteReceiveDate = m_MailMessage.DteReceiveDate
    m_MailType.DteCCDate = m_MailMessage.DteCCDate
    m_MailType.StrReadTag = m_MailMessage.StrReadTag
    m_MailType.StrMailBig = m_MailMessage.StrMailBig
    m_MailType.StrMailID = m_MailMessage.StrMailID
    m_MailType.StrLevel = m_MailMessage.StrLevel
    m_MailType.BlnFlag = m_MailMessage.BlnFlag
    m_MailType.BlnNeedReply = m_MailMessage.BlnNeedReply
    m_MailType.BlnReplyed = m_MailMessage.BlnReplyed
    m_MailType.strMailBodyFile = m_MailMessage.strMailBodyFile
    m_MailType.strMailBoxTag = m_MailMessage.strMailBoxTag
    m_MailType.StrFromMailBoxTag = m_MailMessage.StrFromMailBoxTag
    m_MailType.StrMailFileName = m_MailMessage.StrMailFileName
    m_MailType.StrMemo = m_MailMessage.StrMemo
    m_MailType.strMailText = m_MailMessage.strMailText
    m_MailType.BlnIsDoneTag = m_MailMessage.BlnIsDoneTag
    m_MailType.StrMailTool = m_MailMessage.StrMailTool
    
    m_MailType.btnTrack = m_MailMessage.btnTrack
    m_MailType.intTrackDays = m_MailMessage.intTrackDays
    m_MailType.strTrackContent = m_MailMessage.strTrackContent
    m_MailType.strFromMailAddress = m_MailMessage.strFromMailAddress
    m_MailType.strFromContact = m_MailMessage.strFromContact
    m_MailType.strMailImage = m_MailMessage.strMailImage
    m_MailType.blnHaveAttach = m_MailMessage.blnHaveAttach
    m_MailType.strMailAttach = m_MailMessage.strMailAttach
    m_MailType.strSaveFilePath = m_MailMessage.strSaveFilePath
    m_MailType.LngEmployeeID = m_MailMessage.LngEmployeeID
    m_MailType.LngCustomerID = m_MailMessage.LngCustomerID
    m_MailType.blnIsQuickMail = m_MailMessage.blnIsQuickMail
    m_MailType.lngOwnDefineTreeID = m_MailMessage.lngOwnDefineTreeID
    m_MailType.BlnFenError = m_MailMessage.BlnFenError
        
    '********************************************************************************
    
    '********************************************************************************
    '取收件人信息
    Dim m_ContactType As PContact.Contact
    Dim m_CContact As PContact.clsContact
    Set m_CContact = New PContact.clsContact
    m_CContact.Init gdbCurrentDB
    ReDim m_MailMessage.strReceiverMailAddress(0)
    Dim i As Long
    For i = 0 To UBound(m_MailMessage.lngReceiverID)
        m_CContact.GetContact m_MailMessage.lngReceiverID(i), m_ContactType
        If Trim(m_ContactType.strEmail) <> "" Then
            ReDim Preserve m_MailMessage.strReceiverMailAddress(i)
            m_MailMessage.strReceiverMailAddress(i) = m_ContactType.strEmail
        End If
    Next i
    '********************************************************************************
    
    
    
    
    '********************************************************************************
    '取抄写人信息
    ReDim m_MailMessage.strReceiverMailAddress(0)
    
    For i = 0 To UBound(m_MailMessage.lngReceiverID)
        m_CContact.GetContact m_MailMessage.lngCopy(i), m_ContactType
        If Trim(m_ContactType.strEmail) <> "" Then
            ReDim Preserve m_MailMessage.strReceiverMailAddress(i)
            m_MailMessage.strCopyMailAddress(i) = m_ContactType.strEmail
        End If
    Next i
    '********************************************************************************
    
    
    
    
    '********************************************************************************
    '取HTML邮件体多媒体文件信息/和附件信息 (已经再MAILIMAGE中了,就不用取)
    '********************************************************************************
    
    
    '********************************************************************************
    '取帐户信息
    Dim m_AccountType As Account.UserType
    
    Dim m_AccountClass As Account.AccountClass
    Set m_AccountClass = GetAccountClass
    m_AccountClass.GetUser m_MailMessage.LngUserID, m_AccountType
    Set m_AccountClass = Nothing


    
    '********************************************************************************
    
    
    
    '发出邮件者
    m_MailMessage.strFromMailAddress = m_AccountType.UserEmailAddress
    m_MailMessage.strFromContact = m_AccountType.UserName
    
    '********************************************************************************
    '将编码后的邮件文件保存到附件文件管理文件夹中
    If Right(m_AccountType.StrSendFilePath, 1) <> "\" Then m_AccountType.StrSendFilePath = m_AccountType.StrSendFilePath & "\"
    
    '如果文件夹不存在了
    If Len(Trim(m_AccountType.StrSendFilePath)) = 0 Or (Not objFileSystemObject.FolderExists(m_AccountType.StrSendFilePath)) Then
        m_AccountType.StrSendFilePath = App.Path & "\"
    End If
    
    m_MailMessage.strSaveFilePath = m_AccountType.StrSendFilePath
    '********************************************************************************
       

    
    '********************************************************************************
    '对文件进行编码,并得到最终的编码文件
    #If SubClass = 1 Then
    Call mCSendMail.ProcessMakeSendMailFile(m_MailType, MakeMailBody)
    #End If
    '********************************************************************************
End Function
'********************************************************************************













Public Function SendAMail(mlngCurrentMailID As Long, Optional ByVal blnShowMsg As Boolean = True) As Boolean
        SendAMail = True
        On Error Resume Next
        Dim m_lngUserID As Long
        
        If mlngCurrentMailID = 0 Then
            Exit Function
        End If
        
        '********************************************************************************
        '取邮件信息
        Dim m_MailType As MailDll.MailType
        Dim C_Mail As MailDll.Mail
        Set C_Mail = New MailDll.Mail
        C_Mail.Init gdbCurrentDB, m_E_ViewMode
        C_Mail.GetMail mlngCurrentMailID, m_MailType, False, False, True, False
        '********************************************************************************
        
        m_lngUserID = m_MailType.LngUserID
    
        mCSendMail.ProcessCancel = False
        
        Dim BlnReceiverOK As Boolean
        BlnReceiverOK = True
        
        DoEvents
        '********************************************************************************
        '取帐户信息
        Dim m_UserTypeType As Account.UserType
        Dim m_AccountClass As Account.AccountClass
        Set m_AccountClass = GetAccountClass
        m_AccountClass.GetUser m_lngUserID, m_UserTypeType
        Set m_AccountClass = Nothing

        
        Dim m_MailUserType As CSMTP.AccountType
        
        m_MailUserType.LngUserID = m_UserTypeType.LngUserID