The Bereznikers

&& pop3EmailClass.prg
 
#DEFINE crlf CHR(13) + CHR(10) 
#DEFINE CONNECTION_CHECK 0 
#DEFINE USER_CHECK 1 
#DEFINE PASSWORD_CHECK 2 
#DEFINE QUIT_CHECK 3 
#DEFINE DELETE_CHECK 4 
#DEFINE RSET_CHECK 5 
#DEFINE STAT_CHECK 6 
#DEFINE NOOP_CHECK 7 
#DEFINE LIST_CHECK 8 
#DEFINE RETR_CHECK 9 
#DEFINE vbString 8 
#DEFINE TIME_OUT 5 
 
DEFINE CLASS Pop3Mail AS CUSTOM 
    cErrorMessage = "" 
    cPassword = "" 
    cUser = "" 
 
    cServerPort = 110 
    cServerName = "" 
 
    cMsgContents = "" 
    nTotalMailSize = 0 
    nNumberOfEmails = 0 
 
    lConnected = .F. 
    nConnectTimeOut = 5 
 
    cServerResponse = '' 
    oSocket = .NULL. 
    DIMENSION aSizeOfMsg[1] 
 
 
    PROCEDURE INIT 
    THIS.oSocket = CREATEOBJECT('mswinsock.winsock') 
    ENDPROC 
 
    FUNCTION Connect(tcServerName, tcUser, tcPassword) 
    LOCAL lnTime, lConnected 
    THIS.cServerName = ALLTRIM( IIF( VARTYPE(tcServerName)='C', tcServerName, THIS.cServerName ) ) 
    THIS.cUser = ALLTRIM( IIF( VARTYPE(tcUser)='C', tcUser, THIS.cUser ) ) 
    THIS.cPassword = IIF( VARTYPE(tcPassword)='C', tcPassword, THIS.cPassword ) 
 
    This.lConnected = .F. 
    THIS.oSocket.CONNECT(THIS.cServerName, THIS.cServerPort) && 110 Pop3 Port 
    lnTime = SECONDS() 
    DO WHILE THIS.oSocket.State <> 7 
        && ?"Waiting to connect..." 
        INKEY(0.01) 
        && ?"state="+tran(THIS.oSocket.State) 
        IF This.Elapsed(SECONDS(), lnTime) > This.nConnectTimeOut 
            THIS.cErrorMessage = "Time out connecting to the server " + THIS.cServerName 
            RETURN .F. 
        ENDIF 
    ENDDO 
    This.lConnected = .T. 
    && ?"State="+tran(THIS.oSocket.State) 
    IF NOT THIS.CheckResponse(CONNECTION_CHECK) 
        RETURN .F. 
    ENDIF 
 
    IF NOT THIS.SendMessageOk( "USER " + This.cUser, User_CHECK ) 
        RETURN .F. 
    ENDIF 
    IF NOT THIS.SendMessageOk( "PASS " + This.cPassword, Password_CHECK ) 
        RETURN .F. 
    ENDIF 
    RETURN .T. 
    &&--------------------------------------------------- 
 
    FUNCTION DELETE(tnMsgNumber) 
    RETURN THIS.SendMessageOk( "DELE " + TRANSFORM(tnMsgNumber), DELETE_CHECK ) 
    &&--------------------------------------------------- 
 
    FUNCTION NOOP 
    RETURN THIS.SendMessageOk( "NOOP ", NOOP_CHECK ) 
    &&--------------------------------------------------- 
    && Return the Msg Size for given message number 
    FUNCTION GetMessageSize(tnMsgNumber) 
    IF ALEN(THIS.aSizeOfMsg) <= tnMsgNumber 
        RETURN 0 
    ENDIF 
    RETURN THIS.aSizeOfMsg[MsgNumber+1] 
    &&--------------------------------------------------- 
 
    FUNCTION RESET() 
    RETURN THIS.SendMessageOk( "RSET ", RSET_CHECK ) 
    &&--------------------------------------------------- 
    && cMsgContents will hold the message body 
    FUNCTION Retrieve(tnMsgNumber) 
    RETURN THIS.SendMessageOk( "RETR " + TRANSFORM(tnMsgNumber), RETR_CHECK ) 
    &&--------------------------------------------------- 
 
    FUNCTION Statistics() 
    RETURN THIS.SendMessageOk( "STAT ", STAT_CHECK ) 
    &&--------------------------------------------------- 
 
    FUNCTION ListMessages 
    RETURN THIS.SendMessageOk( "LIST ", LIST_CHECK ) 
    &&--------------------------------------------------- 
 
    FUNCTION Disconnect() 
    RETURN THIS.SendMessageOk( "QUIT ", QUIT_CHECK ) 
    &&--------------------------------------------------- 
 
    FUNCTION SendMessageOk( tcMsg, tnType ) 
    THIS.oSocket.SendData(tcMsg+crlf) 
    RETURN THIS.CheckResponse(tnType) 
    &&--------------------------------------------------- 
 
    FUNCTION CheckResponse(ResponseType) 
    LOCAL lcBuf, laList, lnI, lcSamp, lnLine 
    lcBuf = THIS.ReadData() 
    THIS.cServerResponse = lcBuf 
    DO CASE 
    CASE ResponseType = CONNECTION_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Bad Connection" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = User_CHECK 
        IF lcBuf="-ERR" 
            cErrorMessage = "Bad User Name" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = Password_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Bad Password Name" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = QUIT_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during QUIT" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = DELETE_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during DELE" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = RSET_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during RSET" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = STAT_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during STAT" 
            RETURN .F. 
        ENDIF 
 
        DIMENSION laList[1] 
        IF ALINES(laList, lcBuf,.T., SPACE(1)) <> 3 
            THIS.cErrorMessage = "Error occurred during STAT" 
            RETURN .F. 
        ENDIF 
        THIS.nNumberOfEmails = INT(VAL(laList[2])) 
        THIS.nTotalMailSize  = INT(VAL(laList[3])) 
 
    CASE ResponseType = NOOP_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during NOOP" 
            RETURN .F. 
        ENDIF 
    CASE ResponseType = LIST_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during LIST" 
            RETURN .F. 
        ENDIF 
 
        lnI = 1 
        lcSamp = SUBSTR(lcBuf,lnI,1) 
        lnLine = 1 
        DO WHILE lcSamp<>'.' AND lnI<1000 && '\0' 
            IF lcSamp=CHR(13) 
                lnLine = lnLine + 1 
            ENDIF 
            IF lnLine > 1 
                IF (lcSamp=CHR(9) OR lcSamp=' ') && *p == '\t' || *p == ' ') 
                    DIMENSION THIS.aSizeOfMsg[ ALEN(THIS.aSizeOfMsg)+1 ] 
                    THIS.aSizeOfMsg[ALEN(THIS.aSizeOfMsg)] = VAL(SUBSTR(lcBuf,lnI)) 
                    &&? " Email #"+TRAN(ALEN(THIS.aSizeOfMsg)-1)+" size="+TRAN(THIS.aSizeOfMsg[alen(THIS.aSizeOfMsg)]) 
                ENDIF 
            ENDIF 
            lnI = lnI + 1 
            lcSamp = SUBSTR(lcBuf,lnI,1) 
        ENDDO 
        THIS.nNumberOfEmails = ALEN(THIS.aSizeOfMsg)-1 
 
    CASE ResponseType = RETR_CHECK 
        IF lcBuf="-ERR" 
            THIS.cErrorMessage = "Error occurred during RETR" 
            RETURN .F. 
        ELSE 
            THIS.cMsgContents = lcBuf + THIS.ReadData() 
        ENDIF 
    ENDCASE 
    RETURN .T. 
    &&--------------------------------------------------- 
 
    FUNCTION ReadData 
    LOCAL lcMsgIn, lnTime, lcBuffer 
    lnTime = SECONDS() 
    DO WHILE THIS.oSocket.BytesReceived = 0 
        && ?"Waiting to Receive data..." 
        INKEY(0.2) 
        &&Sleep(100) 
        IF This.Elapsed(SECONDS(), lnTime) > This.nConnectTimeOut 
            && ?"Timed Out" 
            RETURN "" 
        ENDIF 
        DOEVENTS 
    ENDDO 
    lcBuffer = REPL(CHR(0),10000) && chr(0),10000) 
    && ?"(in) Bytes Received: "+tran(THIS.oSocket.BytesReceived) 
    && THIS.oSocket.Receive(lcBuf, len(lcBuf)) 
 
    DOEVENTS 
 
    lcMsgIn = "" 
    IF THIS.oSocket.State = 7 
        DO WHILE THIS.oSocket.BytesReceived > 0 
            THIS.oSocket.GETDATA(@lcBuffer,vbString) 
            lcMsgIn =  lcMsgIn + lcBuffer 
            INKEY(0.1) 
        ENDDO 
    ENDIF 
    && lcMsgIn = LEFT( lcMsgIn, AT(chr(0),lcMsgIn) ) 
    && ?"(in) Data Read: ("+tran(len(lcMsgIn))+","+tran(THIS.oSocket.BytesReceived)+" bytes) "+lcMsgIn 
    RETURN lcMsgIn 
    &&--------------------------------------------------- 
 
    PROCEDURE DESTROY 
    DODEFAULT() 
    IF THIS.lConnected 
        THIS.Disconnect() 
    ENDIF 
    &&--------------------------------------------------- 
 
    FUNCTION Elapsed 
	LPARAMETERS tnENdSeconds, tnStartSeconds  
	LOCAL lnElapsed 
	lnElapsed = tnENdSeconds - tnStartSeconds  
	DO WHILE (lnElapsed < 0) 
	    lnElapsed = lnElapsed + 86400       && 1day = 24h*60m*60s 
	ENDDO 
	RETURN lnElapsed        
 
ENDDEFINE

LOCAL loMail
lcCrLf =  CHR(13) + CHR(10)
loMail = NEWOBJECT("pop3mail", "pop3EmailClass.fxp")
&& Change configuration data to your POP3 server
loMail.cServerName = "mail.whatever.com"
loMail.cUser = "john"
loMail.cPassword = "secret"
 
lcTempPath = ADDBS(SYS(2023))
lcFilePrefix = "Mail"
lcFileSuffix = SYS(2015)
lcFileExt = ".txt"
 
IF NOT loMail.Connect()
	? "Error Connecting:" + loMail.cErrorMessage
	RETURN .F.
ENDIF
 
IF NOT loMail.Statistics()
	? "STAT failed"
	RETURN .F.
ENDIF
 
IF loMail.nNumberOfEmails = 0
	? "No Emails to download"
	RETURN .T.
ENDIF
 
IF loMail.nNumberOfEmails > 1
	? "Total # of Emails: " + TRANSFORM(loMail.nNumberOfEmails)
	? "Total Size of Emails: " + TRANSFORM(loMail.nTotalMailSize)
ENDIF
 
FOR lnI = 1 TO loMail.nNumberOfEmails
	IF loMail.nNumberOfEmails > 1
		? "Downloading Email # " + TRANSFORM(lnI)
	ENDIF
	=  loMail.Retrieve(lnI)
	lcEmail = loMail.cMsgContents
	IF lcEmail = "+OK" AND RIGHT(lcEmail, 5) = lcCrLf + "." + lcCrLf
		lnPos = AT(lcCrLf, lcEmail)
		lcEmail = SUBSTR(lcEmail, lnPos+2, LEN(lcEmail) - (lnPos+6))
		lcTempFileName = lcTempPath + lcFilePrefix + TRANSFORM(lnI) + lcFileSuffix + lcFileExt
		&& Write email to file
		STRTOFILE(lcEmail + lcCrLf, lcTempFileName )
		&& Process email here
		&&...
		&& Delete email from server
		&&IF llDeleteMail AND NOT loMail.Delete(lnI)
		&&    ? "Couldn't delete email.")
		&&ENDIF
 
	ELSE
		? "Email " + TRANSFORM(lnI) +  + " wasn't downloaded correctly from POP3."
	ENDIF
ENDFOR
 
loMail = NULL