VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAccounts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"CAccount"
Attribute VB_Ext_KEY = "Member0" ,"CAccount"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'plus de fichier à énumérer
Private Const ERROR_NO_MORE_FILES As Long = 18&

'taille max d'un nom de fichier
Private Const MAX_PATH As Long = 260
'date et heure d'un fichier
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
'infos sur un fichier énuméré d'un dossier
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

'énumère le premier fichier correspondant aux critères
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
'énumère les fichiers suivants
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
'ferme l'énumération
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long

'variable locale pour la collection
Private mCol As Collection
Private WithEvents acc As CAccount
Attribute acc.VB_VarHelpID = -1

'l'évènement de loging des connexions aux serveurs
'=================================================
'szText : texte à logguer
Public Event Logging(ByVal szText As String)

'l'évènement déclenché pour chaque mail lu dans un des dossiers du compte ou à chaque reception d'un mail
'=================================================
'szEnumType   : indique le type de mail
'               -> ToSend   : mail à envoyer
'               -> Sent     : mail envoyé
'               -> Received : mail reçu et/ou non lu
'               -> Read     : mail lu
'szSubject    : indique le sujet du mail
'szTo         : indique le To
'szFrom       : indique le From
'MailDate     : indique la date d'envoi du mail
'bAttachments : indique si le fichier contient des pièces jointes
'szFileName   : nom du fichier EML contenant le mail
Public Event EnumMail(ByVal szEnumType As String, ByVal szTo As String, ByVal szFrom As String, ByVal szSubject As String, ByVal MailDate As String, ByVal bAttachments As Boolean, ByVal szFileName As String, ByVal dwSize As Long)

'==================================================
'méthodes privées
'==================================================

'retransmission de l'évènement d'énumération
Private Sub acc_EnumMail(ByVal szEnumType As String, ByVal szTo As String, ByVal szFrom As String, ByVal szSubject As String, ByVal MailDate As String, ByVal bAttachments As Boolean, ByVal szFileName As String, ByVal dwSize As Long)
RaiseEvent EnumMail(szEnumType, szTo, szFrom, szSubject, MailDate, bAttachments, szFileName, dwSize)
End Sub

'retransmission de l'évènement de logging
Private Sub acc_Logging(ByVal szText As String)
RaiseEvent Logging(szText)
End Sub

'==================================================
'méthodes publics
'==================================================

'marque un email comme lu
'==========================================
'szFileName : nom du fichier EML à marquer
'revnoie le nouveau nom du fichier
Public Function MarkRead(szFileName As String) As String
    MarkRead = Replace(szFileName, "\Received", "\Read")
    Name szFileName As MarkRead
End Function

'marque un email comme non lu
'==========================================
'szFileName : nom du fichier EML à marquer
'renvoie le nouveau nom du fichier
Public Function MarkUnRead(szFileName As String) As String
    MarkUnRead = Replace(szFileName, "\Read", "\Received")
    Name szFileName As MarkUnRead
End Function

'supprime un email
'==========================================
'szFileName : nom du fichier EML à supprimer
Public Sub Delete(szFileName As String)
'name szFileName as replace(szFileName,
Kill szFileName
End Sub

'reçoit les mails non reçus de tous les comptes
'==========================================
'renvoie le nombre de mails reçus
Public Function ReceiveAll() As Long
Dim nbnew As Long, Account As CAccount

For Each Account In mCol
    Set acc = Account
    nbnew = nbnew + acc.Receive
Next
ReceiveAll = nbnew
End Function

'envoie un mail particulier
'==========================================
'szFileName : nom du fichier à envoyer
'renvoie False en cas d'échec
Public Function SendThis(ByVal szFileName As String) As Boolean
Dim Mail As CMail, szError As String

Set Mail = New CMail
Mail.MailOpen szFileName
        
Set acc = mCol(Mail.MailHeader.from(1).Address)
If acc.SendMail(Mail, szError) = 250 Then
    RaiseEvent Logging("Mail successfully sent !")
    Name szFileName As Replace(szFileName, "\ToSend", "\Sent")
    SendThis = True
Else
    'RaiseEvent Logging("Failed to send the mail !")
    RaiseEvent Logging(szError)
    SendThis = False
End If
End Function

'envoie tous les mails non envoyés de tous les comptes
'==========================================
'renvoie le nombre de mails envoyés
Public Function SendAll() As Long
Dim nbsent As Long, Account As CAccount
Dim ret As Long

For Each Account In mCol
    Set acc = Account
    ret = acc.SendAll
    If ret = -1 Then SendAll = -1: Exit Function Else nbsent = nbsent + ret
Next
SendAll = nbsent
End Function

'énumère les dossiers de chaque compte
'==========================================
'renvoie le nombre total de mails dans tous les comptes
Public Function EnumAccountsDirs() As Long
Dim Account As CAccount, nbmail As Long

For Each Account In mCol
    Set acc = Account
    
    nbmail = nbmail + acc.EnumDir("Received")
    nbmail = nbmail + acc.EnumDir("Read")
    nbmail = nbmail + acc.EnumDir("Sent")
    nbmail = nbmail + acc.EnumDir("ToSend")
Next
EnumAccountsDirs = nbmail
End Function

'énumère les comptes
Public Sub EnumAccounts()
Dim szFile As String, Account As CAccount
Dim hFind As Long, lpFindData As WIN32_FIND_DATA
Dim Error As Long

hFind = FindFirstFile(App.Path & "\*.acc", lpFindData)
If hFind = -1 Then Exit Sub

szFile = Trim$(lpFindData.cFileName)
Do Until Error '<> ERROR_NO_MORE_FILES
    Set Account = New CAccount
    Account.LoadAccount App.Path & "\" & szFile
    mCol.Add Account, Account.Email
    
    hFind = FindNextFile(hFind, lpFindData)
    Error = Err.LastDllError
    szFile = Trim$(lpFindData.cFileName)
Loop

FindClose hFind
End Sub

'ajoute un compte à la liste
'=========================================================
'Email       : email du compte
'AccountPath : chemin de stockage des dossiers de mails du compte
'POP3Server  : nom du serveur POP3 du compte
'SMTPServer  : nom du serveur SMTP du compte
'domain      : nom de domaine de l'email (après le @)
'UserName    : nom d'utilisateur de l'email (avant le @)
'Optional Password    : mot du passe du compte
'Optional POP3Port    : port du serveur POP3 du compte (par défaut 110)
'Optional SMTPPort    : port du serveur SMTP du compte (par défaut 25)
'renvoie le compte créé
Public Function Add( _
        Email As String, _
        AccountPath As String, _
        POP3Server As String, _
        SMTPServer As String, _
        domain As String, _
        UserName As String, _
        Optional Password As String, _
        Optional POP3Port As Long = 110, _
        Optional SMTPPort As Long = 25 _
        ) As CAccount
    'créer un nouvel objet
    Dim objNewMember As CAccount
    Set objNewMember = New CAccount

    'définir les propriétés passées à la méthode
    objNewMember.POP3Password = Password
    objNewMember.POP3Port = POP3Port
    objNewMember.POP3Server = POP3Server
    objNewMember.POP3UserName = UserName
    objNewMember.domain = domain
    objNewMember.SMTPPort = SMTPPort
    objNewMember.SMTPServer = SMTPServer
    objNewMember.Email = Email
    objNewMember.AccountPath = AccountPath
    mCol.Add objNewMember, Email

    'renvoyer l'objet créé
    Set Add = objNewMember
    Set objNewMember = Nothing
End Function

'renvoie un compte
'===========================================
'vntIndexKey : index ou Email du compte à renvoyer
Public Property Get Item(vntIndexKey As Variant) As CAccount
Attribute Item.VB_UserMemId = 0
    'Utilisé pour référencer un élément dans la collection
    'vntIndexKey contient l'index ou la clé dans la collection
    'Il est donc déclaré en tant que Variant
    'Syntaxe: Set toto = x.Item(xyz) ou Set toto = x.Item(5)
  Set Item = mCol(vntIndexKey)
End Property

'renvoie nombre de compte de la liste
Public Property Get Count() As Long
    'utilisée pour lire le nombre d'éléments dans la
    'collection. Syntaxe: Debug.Print x.Count
    Count = mCol.Count
End Property

'efface toute la collection de comptes
Public Sub Clear()
    Set mCol = New Collection
End Sub

'supprime un compte de la liste
'===========================================
'vntIndexKey : index ou Email du compte à supprimer
Public Sub Remove(vntIndexKey As Variant)
    'utilisée lors de la suppression d'un élément de la collection
    'vntIndexKey contient l'index ou la clé, il est donc
    'déclaré en tant que Variant
    'Syntaxe: x.Remove(xyz)

    mCol.Remove vntIndexKey
    'todo : suppression de l'item = suppression du compte
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    'Cette propriété vous permet d'énumérer
    'cette collection avec la syntaxe For...Each
    Set NewEnum = mCol.[_NewEnum]
End Property

'==================================================
'constructeur et destructeur
'==================================================
Private Sub Class_Initialize()
    'Crée la collection lorsque cette classe est créée
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    'Détruit la collection lorsque cette classe est détruite
    Set mCol = Nothing
End Sub
