Freelog 19/Freelog019.iso/Prog/Internet/source.txt

Text File | 2001-01-05 | 5KB | 226 lines

Private Sub Form_Load()

    On Error GoTo ErrHandler

    ' Affiche la feuille pour activer la boεte de dialogue de connexion.
    Me.Show

    ' DΘmarre une session MAPI.
    mpsSession.DownLoadMail = True
    mpsSession.LogonUI = True
    mpsSession.SignOn
    mpmMessages.SessionID = mpsSession.SessionID

    ' Lecture des messages α partir du serveur.
    FetchMessages

    ' S'il y a des messages, affichage du premier.
    If listMessages.ListCount > 0 Then
        listMessages.ListIndex = 0
        listMessages_Click
    End If
    Exit Sub

  ErrHandler :
  CriticalError
End Sub

Public Sub CriticalError()

    ' Erreur !
    ' Message d'information et fin du programme.
MsgBox Error$, vbCritical, "Erreur critique : " & Str(Err)
    If mpsSession.SessionID Then
        mpsSession.SignOff
    End If
    End
End Sub

Public Sub FetchMessages()

    Dim intMsgIndex As Integer

    On Error GoTo ErrHandler

    ' Lecture des messages sur le serveur
    ' et les trie .
    mpmMessages.FetchSorted = True
    mpmMessages.FetchUnreadOnly = False
    mpmMessages.Fetch

    ' Mise α jour de la liste dΘroulante.
    listMessages.Clear
    intMsgIndex = 0
    If mpmMessages.MsgCount > 0 Then
        Do
            mpmMessages.MsgIndex = intMsgIndex
            listMessages.AddItem mpmMessages.MsgSubject
            intMsgIndex = intMsgIndex + 1
        Loop Until (intMsgIndex = mpmMessages.MsgCount)
    End If

  ErrHandler :
  CriticalError
End Sub


Private Sub cmdMsgNew_Click()

    On Error GoTo ErrHandler

    ' CrΘation nouveau message.
    mpmMessages.Compose
    mpmMessages.Send True

    listMessages.SetFocus
    Exit Sub

    ErrHandler:
    CriticalError
End Sub

Private Sub cmdMsgReply_Click()

    On Error GoTo ErrHandler

    ' RΘponse au message .
    mpmMessages.MsgIndex = listMessages.ListIndex
    mpmMessages.Reply
    mpmMessages.Send True

    listMessages.SetFocus
    Exit Sub

    ErrHandler:
    CriticalError
End Sub

Private Sub cmdMsgReplyAll_Click()

    On Error GoTo ErrHandler

    ' RΘponse α tous les destinataires du message.
    mpmMessages.MsgIndex = listMessages.ListIndex
    mpmMessages.ReplyAll
    mpmMessages.Send True

    listMessages.SetFocus
    Exit Sub

    ErrHandler:
    CriticalError
End Sub

Private Sub cmdMsgForward_Click()

    On Error GoTo ErrHandler

    ' TransfΦre le message α un autre destinataire.
    mpmMessages.MsgIndex = listMessages.ListIndex
    mpmMessages.Forward
    mpmMessages.Send True

    listMessages.SetFocus
    Exit Sub

    ErrHandler:
    CriticalError
End Sub

Private Sub cmdMsgCopy_Click()

    On Error GoTo ErrHandler

    ' Copie du message.
    mpmMessages.MsgIndex = listMessages.ListIndex
    mpmMessages.Copy
    mpmMessages.Send True

    listMessages.SetFocus
    Exit Sub

   ErrHandler:
    CriticalError
End Sub

Private Sub cmdMsgDelete_Click()

    On Error GoTo ErrHandler

    ' DΘtruit le message Mise α jour de la liste dΘroulante.
    mpmMessages.MsgIndex = listMessages.ListIndex
    mpmMessages.Delete
    listMessages.RemoveItem listMessages.ListIndex

    If listMessages.ListCount > 0 Then
        listMessages.ListIndex = 0
    Else
        lblMsgInfo = ""
        txtMsgBody = ""
    End If

    listMessages.SetFocus
    Exit Sub

    ErrHandler:
    CriticalError
End Sub

Private Sub listMessages_Click()

    ' Lorsque l'utilisateur clique sur un message,
    ' affichage des informations (expΘditeur, sujet et date)
    ' dans un label et du texte du message dans la zone textMsgBody.

    mpmMessages.MsgIndex = listMessages.ListIndex
    lblMsgInfo = "De: " + mpmMessages.MsgOrigDisplayName + Chr$(13) _
        + "Sujet: " + mpmMessages.MsgSubject + Chr$(13) _
        + "Date: " + mpmMessages.MsgDateReceived
    txtMsgBody = mpmMessages.MsgNoteText

End Sub

Private Sub cmdAddrBook_Click()

    On Error GoTo ErrHandler

    ' Affichage du Carnet d'adresses.
    mpmMessages.Show

    listMessages.SetFocus
    Exit Sub

    ErrHandler:
    CriticalError
End Sub

Private Sub cmdExit_Click()

    Dim intExit As Integer

    ' Demande de confirmation.
intExit = MsgBox("Quitter le programme ?", vbYesNo, _
        "Fin du programme")
    If intExit = vbYes Then
        mpsSession.SignOff
        End
    End If

    listMessages.SetFocus

End Sub

Private Sub txtMsgBody_KeyPress(KeyAscii As Integer)

    'Protection de la zone texte du message.
KeyAscii = 0

End Sub