Verification d'arrivé d'email

Soyez le premier à donner votre avis sur cette source.

Vue 6 535 fois - Téléchargée 881 fois

Télécharger le projet
Commenter

Description

ce prog vous previent de l'arrivé de nouveau mail
il utilise les agents microsoft en anglais pour dire combien de mail sont arrivé.

Source / Exemple : 


Option Explicit

Private Type IconeTray
    cbSize As Long      'Taille de l'icône (en octets)
    hwnd As Long        'Handle de la fenêtre chargée de recevoir les messages envoyés lors des évènements sur l'icône (clics, doubles-clics...)
    uID As Long         'Identificateur de l'icône
    uFlags As Long
    uCallbackMessage As Long    'Messages à renvoyer
    hIcon As Long               'Handle de l'icône
    szTip As String * 64        'Texte à mettre dans la bulle d'aide
End Type
Dim IconeT As IconeTray

'Constantes nécessaires
Private Const AJOUT = &H0
Private Const MODIF = &H1
Private Const SUPPRIME = &H2
Private Const MOUSEMOVE = &H200
Private Const MESSAGE = &H1
Private Const Icone = &H2
Private Const TIP = &H4

Private Const DOUBLE_CLICK_GAUCHE = &H203
Private Const BOUTON_GAUCHE_POUSSE = &H201
Private Const BOUTON_GAUCHE_LEVE = &H202
Private Const DOUBLE_CLICK_DROIT = &H206
Private Const BOUTON_DROIT_POUSSE = &H204
Private Const BOUTON_DROIT_LEVE = &H205

'API nécessaire
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As IconeTray) As Boolean

Private Declare Function Beep Lib "kernel32" ( _
                 ByVal dwFreq As Long, _
                 ByVal dwDuration As Long) As Long

Private WithEvents evt As Winsock
Private nextSend As Boolean
Private AnSwEr As String
Private nbrecept As Long
Private Sub evt_DataArrival(ByVal bytesTotal As Long)
  Dim tmp As String
  If ws.State = sckClosed Or ws.State = sckClosing Then Exit Sub
  ws.GetData tmp, vbString, bytesTotal
  AnSwEr = tmp
  nextSend = True
End Sub

Private Sub evt_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  MsgBox Number & " : " & Description
End Sub

Private Sub Form_Load()
'Préparation de la variable IconeT
IconeT.cbSize = Len(IconeT) 'Taille de l'icône en octet
IconeT.hwnd = Me.hwnd       'Handle de l'application (pour qu'elle reçoive les messages envoyés lors d'un clic, double-clic...
IconeT.uID = 1&             'Identificateur de l'icône
IconeT.uFlags = Icone Or TIP Or MESSAGE
IconeT.uCallbackMessage = MOUSEMOVE     'Renvoyer les messages concernant l'action de la souris
IconeT.hIcon = Image1.Picture   'Mettre en icône l'image qui est dans le contrôle "Image1"
IconeT.szTip = "Mails-Cortex - deconnécter" & Chr$(0)    'Texte de la bulle d'aide

'Appel de la fonction pour mettre l'icône dans le système tray
Shell_NotifyIcon AJOUT, IconeT

Me.Hide     'Cache la fenêtre
App.TaskVisible = False     'Retire le bouton de l'application de la barre
                            'des tâches
    

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static rec As Boolean, msg As Long

'Se produit lorsque l'utilisateur agit avec la souris sur
'l'icône placée dans le système tray

msg = X / Screen.TwipsPerPixelX
If rec = False Then
    rec = True
    Select Case msg     'Différentes possibilité d'action
        Case DOUBLE_CLICK_GAUCHE:   'mettez
                                    'ici
        Case BOUTON_GAUCHE_POUSSE:  'ce
        Case BOUTON_GAUCHE_LEVE:    'que
        Case DOUBLE_CLICK_DROIT:    'vous
        Case BOUTON_DROIT_POUSSE:   'voudrez
        Case BOUTON_DROIT_LEVE:     'qu'il se passe
            PopupMenu mnuconf     'fait apparaitre le menu
            '"A propos de" apparaitra en gras
    End Select
    rec = False
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Refait appel à l'API pour retirer l'icône du système tray
'lorsque le programme se ferme, en utilisant cette fois la constante SUPPRIME
'au lieu de AJOUT

IconeT.cbSize = Len(IconeT)
IconeT.hwnd = Me.hwnd
IconeT.uID = 1&
Shell_NotifyIcon SUPPRIME, IconeT

End Sub

Private Sub mnuconn_Click()
If LireINI("email", "utilisateur") <> vbNullString Then
Timer1.Interval = 5000
Else
    MsgBox "Vous devez remplir les parametre de la connection"
    Form2.Show
End If
End Sub

Private Sub mnufin_Click()
End
End Sub

Private Sub mnupara_Click()
Form2.Show
End Sub

Private Sub Timer1_Timer()
Dim tmp As String
Set evt = ws
If evt.State = sckConnected Then Exit Sub
nbrecept = 0
ws.Connect LireINI("email", "pop"), 110

While ws.State <> sckConnected
DoEvents
Wend

'Attente du message de bienvenue
nextSend = False
While nextSend = False
DoEvents
Wend

nextSend = False
ws.SendData "USER " & LireINI("email", "utilisateur") & vbCrLf
While nextSend = False
DoEvents
Wend

nextSend = False
ws.SendData "PASS " & UncryptMsg(LireINI("email", "mdp")) & vbCrLf
While nextSend = False
DoEvents
Wend

nextSend = False
ws.SendData "STAT" & vbCrLf
While nextSend = False
DoEvents
Wend

Text1.Text = Mid(AnSwEr, 4, 3) & " emails"

nextSend = False
ws.SendData "QUIT" & vbCrLf
While nextSend = False
DoEvents
Wend

ws.Close

If Text1.Text <> Text2.Text Then
TextToSpeech1.Speak (Text1.Text)
Text2.Text = Text1.Text
'suppression icone
IconeT.cbSize = Len(IconeT)
IconeT.hwnd = Me.hwnd
IconeT.uID = 1&
Shell_NotifyIcon SUPPRIME, IconeT
'ajout icone
IconeT.cbSize = Len(IconeT)
IconeT.hwnd = Me.hwnd
IconeT.uID = 1&
IconeT.uFlags = Icone Or TIP Or MESSAGE
IconeT.uCallbackMessage = MOUSEMOVE
IconeT.szTip = "Mails-Cortex - " & Text2.Text & Chr$(0)
    If Text2.Text = "0 mails" Then
    IconeT.hIcon = Image1.Picture
    Else
    IconeT.hIcon = Image2.Picture
    End If
Shell_NotifyIcon AJOUT, IconeT
Beep 2000, 200
Beep 4000, 200
Beep 2000, 200
If LireINI("email", "box") <> vbNullString Then
    If LireINI("email", "box") = 1 Then
        MsgBox "Vous avez reçu un nouvelle email !", vbInformation, "Mails-Cortex"
    End If
End If

End If

End Sub

Conclusion :


ce prog utilise une source de ce site pour mettre le prog dans la barre des taches

bonne prog

NeoCortex
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
Optitech
Messages postés
134
Date d'inscription
samedi 19 octobre 2002
Statut
Membre
Dernière intervention
3 janvier 2009
Slt JIPEF

Pour l'utilsiateur tu met le nom de l'une de tes boite sans le @wanadoo.fr


@++

Optitech
Signaler
cs_jipef
Messages postés
56
Date d'inscription
lundi 23 août 2004
Statut
Membre
Dernière intervention
1 août 2008
J'ai compris la saisie des infos comme ceci
Pop.? je mets pop.wanadoo.fr
utilisateur : je mets quoi ? le nom d'une de mes box
ou le login de connexion à mon compte wanadoo ?? fti/uwxxxxxx
le mot de passe est celui de cette mailBox ???

j'ai fait fonctionné mais je veux pouvoir prélever les messages dont l'objet est "MonObjet" par exemple , et copier la ou les pièces jointes

Comment Faire ???

merci
Signaler
mythic_kruger
Messages postés
242
Date d'inscription
jeudi 8 janvier 2004
Statut
Membre
Dernière intervention
10 novembre 2005
bip bip. XPSP1 tout est bon aussi. bip.
Signaler
cs_Sator2
Messages postés
137
Date d'inscription
samedi 11 septembre 2004
Statut
Membre
Dernière intervention
10 septembre 2006
alors moi je dis merci, bravo c'est ce que je cherchais et chez moi ça marche!
win XP service pack 2 pro....
@+Sator 2
Signaler
cs_jipef
Messages postés
56
Date d'inscription
lundi 23 août 2004
Statut
Membre
Dernière intervention
1 août 2008
j'aurais besoin des 3 DLL et leur source VBtext , VBdict et Command.DLL
en attente de les trouver sur le site
merci

j'ai un besoin précis détecter si des mails sont arrivés avec un objet "MonMail" par exemple ??
Afficher les 8 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_NeoCortex)