ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Connaître le nombre de nouveaux courriels   


L'auteur

Christophe Chenavier
France France
Membre Simple
# 0000000023
enregistré le 14/10/2004
http://www.corwin.fr
59 ans
CHENAVIER Christophe
80440 BOVES
de la société Corwin
Fiche personnelle

Note des membres
pas de note

Contributions > 12 - Envoyer des Emails

Connaître le nombre de nouveaux courriels
# 0000000252
ajouté le 31/10/2005 07:45:36 et modifié le 31/10/2005
consulté 9974 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
Description

Cette fonction basée sur Winsock permet de connaître le nombre de courriels reçus en attente sur le serveur POP.

On peut très bien imaginer l'extension de cette classe à la lecture des courriels, mais il faut alors réaliser le travail de décodage du message. Si cela tente quelqu'un....

Code source :
*!* Objet : Connaître de nombre de courriels sur le serveur pop
*!* Auteur : C.Chenavier
*!* Version : 1.00 - 26/08/2005
*!* Documentation sur POP : http://www.faqs.org/rfcs/std/std53.html
*!*
*!* ? GetNumberOfMails("pop3.xxxxx.yy", "adresse mail à tester", "mot de passe")



FUNCTION GetNumberOfMails

LPARAMETERS cServeur, cMailAdress, cPassword

LOCAL oPop3, nNbMails

M.nNbMails = -1
oPop3 = CREATEOBJECT("Pop3", M.cServeur)
IF VARTYPE(oPop3) = 'O'
   IF oPop3.Login(M.cMailAdress, M.cPassword)
      M.nNbMails = oPop3.GetNumberOfMails()
   ELSE
      MESSAGEBOX("Connexion refusée.", 16)
   ENDIF
ELSE
   MESSAGEBOX("Problème de connexion au serveur POP3", 16)
ENDIF

RETURN M.nNbMails





******* Winsock
#DEFINE SOCK_STREAM    1
#DEFINE WSADATA_SIZE  0x18E
#DEFINE WS_VERSION    0x202
#DEFINE AF_INET         2
#DEFINE IPPROTO_TCP    6


DEFINE CLASS Pop3 AS CUSTOM

       PROTECTED cIP
       cIP = ''
       PROTECTED nSocket
       nSocket = 0


       PROCEDURE Init
           LPARAMETERS cServer, nPort

           LOCAL nLibs, cWSADATA, lOK
           LOCAL ARRAY aLibs(1,3)

           M.nLibs = ADLLS(aLibs)
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSAStartup",1,0,1,7) = 0
              DECLARE INTEGER WSAStartup IN ws2_32;
                      INTEGER wVerRq, STRING @lpWSAData
           ENDIF

           M.cWSADATA = REPLICATE(CHR(0), WSADATA_SIZE)
           IF WSAStartup(WS_VERSION, @cWSADATA) = 0
              THIS.InitAPI
              M.lOK = THIS.OpenConnection(M.cServer, M.nPort)
              IF NOT M.lOK
                 WSACleanup()
              ENDIF
           ENDIF

           RETURN M.lOK
       ENDPROC


       FUNCTION Login
           LPARAMETERS cUser, cPwd

           LOCAL lReturn

           THIS.SendCmd("USER " + M.cUser)
           IF LEFT(THIS.GetData(),1) = '+'
              THIS.SendCmd("PASS " + M.cPwd)
              M.lReturn = (LEFT(THIS.GetData(),1) = '+')
           ENDIF

           RETURN M.lReturn
       ENDFUNC


       FUNCTION GetNumberOfMails

           LOCAL nNb, cData

           THIS.SendCmd("STAT")
           M.cData = THIS.GetData()
           IF ATC("+OK ", M.cData) > 0
              M.nNb = INT(VAL(SUBSTR(M.cData, 5)))
           ELSE
              M.nNb = 0
           ENDIF

           RETURN M.nNb
       ENDFUNC


       HIDDEN FUNCTION OpenConnection
           LPARAMETERS cServer, nPort

           LOCAL lResult, cBuffer

           THIS.CloseConnection
           IF THIS.GetIP(M.cServer)
              THIS.nSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
              M.nPort = IIF(EMPTY(M.nPort), 110, M.nPort)
              M.cBuffer = WordToStr(AF_INET) + WordToStr(htons(M.nPort)) +;
                          dWordToStr(inet_addr(THIS.cIP)) + REPLICATE(CHR(0),8)
              M.lResult = (ws_connect(THIS.nSocket, @cBuffer, LEN(M.cBuffer)) = 0)
              IF M.lResult
                 M.lResult = (LEFT(THIS.GetData(),1) = '+')
              ENDIF
              IF NOT M.lResult
                 closesocket(THIS.nSocket)
                 THIS.nSocket = 0
                 MESSAGEBOX("Problème lors de la connexion à " + M.cServer, 16)
              ENDIF
           ENDIF

           RETURN M.lResult
       ENDFUNC


       HIDDEN PROCEDURE CloseConnection

           IF THIS.nSocket > 0
              THIS.SendCmd("QUIT")
              closesocket(THIS.nSocket)
              THIS.nSocket = 0
           ENDIF
       ENDPROC


       FUNCTION GetIP
           LPARAMETERS cHost

           LOCAL nStruct, cBuffer, cIP

           M.nStruct = gethostbyname(M.cHost)
           IF M.nStruct <> 0
              M.cBuffer = REPLICATE(CHR(0), 16)
              M.cIP = REPLICATE(CHR(0), 4)
              M.cBuffer = SYS(2600, M.nStruct, LEN(M.cBuffer))
              M.cIP = SYS(2600, StrTodWord(SUBSTR(M.cBuffer,13,4)), 4)
              M.cIP = SYS(2600, StrTodWord(M.cIP), 4)
              THIS.cIP = inet_ntoa(StrTodWord(M.cIP))
           ELSE
              THIS.cIP = ''
           ENDIF

           RETURN NOT EMPTY(THIS.cIP)
       ENDFUNC


       PROTECTED FUNCTION SendCmd
           LPARAMETERS cCmd
           LOCAL cBuffer, nResult

           M.cBuffer = M.cCmd + CHR(13) + CHR(10)
           M.nResult = Send(THIS.nSocket, @cBuffer, LEN(M.cBuffer), 0)
           RETURN (M.nResult <> -1)
       ENDFUNC


       PROTECTED FUNCTION GetData

           LOCAL hEventRead, nEventResult, cRead, nBytesRead

           M.hEventRead = WSACreateEvent()
           WSAEventSelect(THIS.nSocket, M.hEventRead, 1)
           M.nEventResult = WSAWaitForMultipleEvents(1, @hEventRead, 0, 5000, 0)
           WSACloseEvent(M.hEventRead)

           IF M.nEventResult = 0
              M.cRead = REPLICATE(CHR(0), 2048)
              M.nBytesRead = Recv(THIS.nSocket, @cRead, LEN(M.cRead), 0)
              M.cRead = LEFT(M.cRead, M.nBytesRead)
              IF M.nBytesRead > 512
                 INKEY(0.3)  && Temporisation pour la réception
              ENDIF
           ELSE
              M.cRead = ''
           ENDIF

           RETURN M.cRead
       ENDFUNC


       HIDDEN PROCEDURE Destroy
           LOCAL nLibs
           LOCAL ARRAY aLibs(1,3)

           M.nLibs = ADLLS(aLibs)
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSACleanup",1,0,1,7) = 0
              DECLARE INTEGER WSACleanup IN ws2_32
           ENDIF
           THIS.CloseConnection
           WSACleanup()
       ENDPROC


       HIDDEN PROCEDURE InitAPI
           LOCAL nLibs
           LOCAL ARRAY aLibs(1,3)

           M.nLibs = ADLLS(aLibs)
           IF M.nLibs = 0 OR ASCAN(aLibs,"socket",1,0,1,7) = 0
              DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"closesocket",1,0,1,7) = 0
              DECLARE INTEGER closesocket IN ws2_32 INTEGER s
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"gethostbyname",1,0,1,7) = 0
              DECLARE INTEGER gethostbyname IN ws2_32 STRING host
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"inet_ntoa",1,0,1,7) = 0
              DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"htons",1,0,1,7) = 0
              DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"inet_addr",1,0,1,7) = 0
              DECLARE INTEGER inet_addr IN ws2_32 STRING cp
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"ws_connect",1,0,2,7) = 0
              DECLARE INTEGER connect IN ws2_32 AS ws_connect;
                      INTEGER s, STRING @sname, INTEGER namelen
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"send",1,0,1,7) = 0
              DECLARE INTEGER send IN ws2_32;
                      INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"recv",1,0,1,7) = 0
              DECLARE INTEGER recv IN ws2_32;
                      INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSACreateEvent",1,0,1,7) = 0
              DECLARE INTEGER WSACreateEvent IN ws2_32
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSAEventSelect",1,0,1,7) = 0
              DECLARE INTEGER WSAEventSelect IN ws2_32;
                      INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSAWaitForMultipleEvents",1,0,1,7) = 0
              DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
                      INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
                      INTEGER dwTimeout, INTEGER fAlertable
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSACloseEvent",1,0,1,7) = 0
              DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
           ENDIF
           IF M.nLibs = 0 OR ASCAN(aLibs,"WSACleanup",1,0,1,7) = 0
              DECLARE INTEGER WSACleanup IN ws2_32
           ENDIF

       ENDPROC
ENDDEFINE



*---------------------------------------------------------------- StrTodWord

FUNCTION StrTodWord

LPARAMETERS cString

RETURN ASC(SUBSTR(M.cString,1,1)) + BITLSHIFT(ASC(SUBSTR(M.cString,2,1)),8) + ;
       BITLSHIFT(ASC(SUBSTR(M.cString,3,1)),16) + ;
       BITLSHIFT(ASC(SUBSTR(M.cString, 4,1)), 24)


*---------------------------------------------------------------- WordToStr

FUNCTION WordToStr

LPARAMETERS nValeur

RETURN CHR(MOD(M.nValeur,256)) + CHR(BITRSHIFT(M.nValeur,8))


*---------------------------------------------------------------- dWordToStr

FUNCTION dWordToStr

LPARAMETERS nValeur

LOCAL nB0, nB1, nB2, nB3

IF M.nValeur < 0
   M.nValeur = 2^32 + M.nValeur
ENDIF
M.nB3 = BITRSHIFT(M.nValeur, 24)
M.nB2 = BITRSHIFT(M.nValeur - M.nB3*2^24, 16)
M.nB1 = BITRSHIFT(M.nValeur - M.nB3*2^24 - M.nB2*2^16, 8)
M.nB0 = MOD(M.nValeur, 2^8)

RETURN CHR(M.nB0)+CHR(M.nB1)+CHR(M.nB2)+CHR(M.nB3)
Commentaires
le 31/10/2005, FredA a écrit :
du bel ouvrage
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2025.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3