PureBasic Forums - English

Posted: **Sat Dec 22, 2012 2:27 am**

This is a 64 bit SSL based SMTP process that I created to be able to send email via GMail. Credit goes to the fine people who wrote cryptlib.dll, Mike Trader from coastrd.com and the many good people who have helped me on the forum. Note that I renamed the dll's to a name a bit more descriptive than they were, and I reduced the header include file to it's bare minimum for SSL Email. You can find the entire project here:

http://www.rca2.com/dlls/Cryptlibdlls.zip

ssl_mail64.pbi

Code: Select all

;*****************************************************************************
;*                                                                           *
;*                        cryptlib External API Interface                    *
;*                       Copyright Peter Gutmann 1997-2008                   *
;*                                                                           *
;*                 Adapted For BASIC Nov 2009 - Coast Research               *
;*                 Adapted for PureBasic by Bart                             *
;*                                                                           *
;*****************************************************************************
;
;* Translated for PureBasic Nov 2009 from: http://www.coastrd.com/smtps/cryptlib/cryptlib_header-inc

#CRYPTLIB_VERSION    = 3330   ;  Not the same As 3.32

; cutdown version for SSL SMTP, 64 bit

;  /****************************************************************************
;  *                                            General Constants               *
;  ****************************************************************************/

#CRYPT_MAX_KEYSIZE              =  256 ; /* The maximum user key size - 2048 bits */
#CRYPT_MAX_IVSIZE               =  32  ; /* The maximum IV size - 256 bits */
#CRYPT_MAX_PKCSIZE              =  512 ; The maximum public-key component size - 4096 bits, and maximum component
#CRYPT_MAX_PKCSIZE_ECC          =  72  ; size FOR ECCs - 576 bits (TO HANDLE the P521 curve) */
#CRYPT_MAX_HASHSIZE             =  32  ; /* The maximum hash size - 256 bits */
#CRYPT_MAX_TEXTSIZE             =  64  ; /* The maximum size of a text string (e.g.key owner name) */
#CRYPT_USE_DEFAULT              = -100 ; A magic value indicating that the default setting
#CRYPT_UNUSED                   = -101 ; /* A magic value for unused parameters */
#CRYPT_SESSION_SSL              =  03  ; /* SSL/TLS */
#CRYPT_SESSINFO_ACTIVE          = 6001 ; /* Whether session is active */
#CRYPT_SESSINFO_SERVER_NAME     = 6008 ; /* SERVER NAME */
#CRYPT_SESSINFO_SERVER_PORT     = 6009 ; /* SERVER PORT number */

;  /****************************************************************************
;  *                                           STATUS Codes                     *
;  ****************************************************************************/

; /* Errors in function calls */
#CRYPT_OK                       =   0  ; /* No error */
#CRYPT_ERROR_PARAM1             =  -1  ; /* Bad argument, parameter 1 */
#CRYPT_ERROR_PARAM2             =  -2  ; /* Bad argument, parameter 2 */
#CRYPT_ERROR_PARAM3             =  -3  ; /* Bad argument, parameter 3 */
#CRYPT_ERROR_PARAM4             =  -4  ; /* Bad argument, parameter 4 */
#CRYPT_ERROR_PARAM5             =  -5  ; /* Bad argument, parameter 5 */
#CRYPT_ERROR_PARAM6             =  -6  ; /* Bad argument, parameter 6 */
#CRYPT_ERROR_PARAM7             =  -7  ; /* Bad argument, parameter 7 */
;/* Errors due to insufficient resources */
#CRYPT_ERROR_MEMORY             = -10  ; /* Out of memory */
#CRYPT_ERROR_NOTINITED          = -11  ; /* Data has not been initialised */
#CRYPT_ERROR_INITED             = -12  ; /* Data has already been init;d */
#CRYPT_ERROR_NOSECURE           = -13  ; /* Opn.not avail.at requested sec.level */
#CRYPT_ERROR_RANDOM             = -14  ; /* No reliable random data available */
#CRYPT_ERROR_FAILED             = -15  ; /* Operation failed */
#CRYPT_ERROR_INTERNAL           = -16  ; /* Internal consistency check failed */
;/* Security violations */
#CRYPT_ERROR_NOTAVAIL           = -20  ; /* This type of opn.not available */
#CRYPT_ERROR_PERMISSION         = -21  ; /* No permiss.TO perform this operation */
#CRYPT_ERROR_WRONGKEY           = -22  ; /* Incorrect key used to decrypt data */
#CRYPT_ERROR_INCOMPLETE         = -23  ; /* Operation incomplete/still IN progress */
#CRYPT_ERROR_COMPLETE           = -24  ; /* Operation complete/can;t Continue */
#CRYPT_ERROR_TIMEOUT            = -25  ; /* Operation timed out before completion */
#CRYPT_ERROR_INVALID            = -26  ; /* Invalid/inconsistent information */
#CRYPT_ERROR_SIGNALLED          = -27  ; /* Resource destroyed by extnl.event */
;/* High-level function errors */
#CRYPT_ERROR_OVERFLOW           = -30  ; /* Resources/space exhausted */
#CRYPT_ERROR_UNDERFLOW          = -31  ; /* Not enough data available */
#CRYPT_ERROR_BADDATA            = -32  ; /* Bad/unrecognised data format */
#CRYPT_ERROR_SIGNATURE          = -33  ; /* Signature/integrity check failed */
;/* Data access function errors */
#CRYPT_ERROR_OPEN               = -40  ; /* Cannot OPEN object */
#CRYPT_ERROR_READ               = -41  ; /* Cannot READ item from object */
#CRYPT_ERROR_WRITE              = -42  ; /* Cannot WRITE item to object */
#CRYPT_ERROR_NOTFOUND           = -43  ; /* Requested item not found in object */
#CRYPT_ERROR_DUPLICATE          = -44  ; /* Item already present in object */
;/* Data enveloping errors */
#CRYPT_ENVELOPE_RESOURCE        = -50  ; /* Need resource to proceed */

;  /****************************************************************************
;  *                                        General Functions                   *
;  ****************************************************************************/

Global cryptLib.i               = OpenLibrary(#PB_Any, "cryptlib64.dll")

Global *cryptInit               = GetFunction(cryptLib, "cryptInit")
Global *cryptEnd                = GetFunction(cryptLib, "cryptEnd")
Global *cryptSetAttribute       = GetFunction(cryptLib, "cryptSetAttribute")
Global *cryptSetAttributeString = GetFunction(cryptLib, "cryptSetAttributeString")
Global *cryptCreateSession      = GetFunction(cryptLib, "cryptCreateSession")
Global *cryptDestroySession     = GetFunction(cryptLib, "cryptDestroySession")
Global *cryptCreateEnvelope     = GetFunction(cryptLib, "cryptCreateEnvelope")
Global *cryptDestroyEnvelope    = GetFunction(cryptLib, "cryptDestroyEnvelope")
Global *cryptPushData           = GetFunction(cryptLib, "cryptPushData")
Global *cryptFlushData          = GetFunction(cryptLib, "cryptFlushData")
Global *cryptPopData            = GetFunction(cryptLib, "cryptPopData")

Procedure.i cryptInit()
    ProcedureReturn CallFunctionFast(*cryptInit)
EndProcedure

Procedure.i cryptEnd()
    ProcedureReturn CallFunctionFast(*cryptEnd)
EndProcedure

Procedure.i cryptSetAttribute(hCrypt.i,CryptAttType.i, value.i)
   ProcedureReturn CallFunctionFast(*cryptSetAttribute, hCrypt.i,CryptAttType.i, value.i)
EndProcedure

Procedure.i cryptSetAttributeString(hCrypt.i, CryptAttType.i, pBuff.i, StrLen.i)
    ProcedureReturn CallFunctionFast(*cryptSetAttributeString, hCrypt.i, CryptAttType.i, pBuff.i, StrLen.i)
EndProcedure

;  /****************************************************************************
;  *                                        Envelope & Session Functions        *
;  ****************************************************************************/

Procedure.i cryptCreateSession(pSession.i, cryptUser.i, SessionType.i)
    ProcedureReturn CallFunctionFast(*cryptCreateSession, pSession.i, cryptUser.i, SessionType.i)
EndProcedure

Procedure.i cryptDestroySession(session.i)
    ProcedureReturn CallFunctionFast(*cryptDestroySession, session.i)
EndProcedure

Procedure.i cryptCreateEnvelope(penvelope.i, cryptUser.i, FormatType.i)
    ProcedureReturn CallFunctionFast(*cryptCreateEnvelope, penvelope.i, cryptUser.i, FormatType.i)
EndProcedure

Procedure.i cryptDestroyEnvelope(envelope.i)
    ProcedureReturn CallFunctionFast(*cryptDestroyEnvelope, envelope.i)
EndProcedure

Procedure.i cryptPushData(envelope.i, pBuff.i, StrLen.i,  pBytesCopied.i)
    ProcedureReturn CallFunctionFast(*cryptPushData, envelope.i, pBuff.i, StrLen.i,  pBytesCopied.i)
EndProcedure

Procedure.i cryptFlushData(envelope.i)
    ProcedureReturn CallFunctionFast(*cryptFlushData, envelope.i)
EndProcedure

Procedure.i cryptPopData(envelope.i, pBuff.i, StrLen.i, pBytesCopied.i)
    ProcedureReturn CallFunctionFast(*cryptPopData, envelope.i, pBuff.i, StrLen.i, pBytesCopied.i)
EndProcedure

;  /*****************************************************************************                                                                                                                 *
;  *                                          User Interface Functions          *
;  ****************************************************************************/

Procedure.s lookupError(errorCode.i)

    Select errorCode
    Case #CRYPT_OK
        ProcedureReturn  ""
    Case #CRYPT_ERROR_PARAM1
        ProcedureReturn  "Bad argument - parameter 1"
    Case #CRYPT_ERROR_PARAM2
        ProcedureReturn  "Bad argument - parameter 2"
    Case #CRYPT_ERROR_PARAM3
        ProcedureReturn  "Bad argument - parameter 3"
    Case #CRYPT_ERROR_PARAM4
        ProcedureReturn  "Bad argument - parameter 4"
    Case #CRYPT_ERROR_PARAM5
        ProcedureReturn  "Bad argument - parameter 5"
    Case #CRYPT_ERROR_PARAM6
        ProcedureReturn  "Bad argument - parameter 6"
    Case #CRYPT_ERROR_PARAM7
        ProcedureReturn  "Bad argument - parameter 7"
    Case #CRYPT_ERROR_MEMORY
        ProcedureReturn  "Out of memory"
    Case #CRYPT_ERROR_NOTINITED
        ProcedureReturn  "Data has not been initialized"
    Case #CRYPT_ERROR_INITED
        ProcedureReturn  "Data has already been initialized"
    Case #CRYPT_ERROR_NOSECURE
        ProcedureReturn  "Operation not available at requested security level"
    Case #CRYPT_ERROR_RANDOM
        ProcedureReturn  "No reliable random data available"
    Case #CRYPT_ERROR_FAILED
        ProcedureReturn  "Operation failed"
    Case #CRYPT_ERROR_INTERNAL
        ProcedureReturn  "Internal consistency check failed"
    Case #CRYPT_ERROR_NOTAVAIL
        ProcedureReturn  "This type of operation not available"
    Case #CRYPT_ERROR_PERMISSION
        ProcedureReturn  "No permission to perform this operation"
    Case #CRYPT_ERROR_WRONGKEY
        ProcedureReturn  "Incorrect key used to decrypt data"
    Case #CRYPT_ERROR_INCOMPLETE
        ProcedureReturn  "Operation incomplete/still in progress"
    Case #CRYPT_ERROR_COMPLETE
        ProcedureReturn  "Operation complete/can't continue"
    Case #CRYPT_ERROR_TIMEOUT
        ProcedureReturn  "Operation timed out before completion"
    Case #CRYPT_ERROR_INVALID
        ProcedureReturn  "Invalid/inconsistent information"
    Case #CRYPT_ERROR_SIGNALLED
        ProcedureReturn  "Resource destroyed by external event"
    Case #CRYPT_ERROR_OVERFLOW
        ProcedureReturn  "Resources/space exhausted"
    Case #CRYPT_ERROR_UNDERFLOW
        ProcedureReturn  "Not enough data available"
    Case #CRYPT_ERROR_BADDATA
        ProcedureReturn  "Bad/unrecognised data format"
    Case #CRYPT_ERROR_SIGNATURE
        ProcedureReturn  "Signature/integrity check failed"
    Case #CRYPT_ERROR_OPEN
        ProcedureReturn  "Cannot open object"
    Case #CRYPT_ERROR_READ
        ProcedureReturn  "Cannot read item from object"
    Case #CRYPT_ERROR_WRITE
        ProcedureReturn  "Cannot write item to object"
    Case #CRYPT_ERROR_NOTFOUND
        ProcedureReturn  "Requested item not found in object"
    Case #CRYPT_ERROR_DUPLICATE
        ProcedureReturn  "Item already present in object"
    Case #CRYPT_ENVELOPE_RESOURCE
        ProcedureReturn  "Need resource to proceed"
    Default
        ProcedureReturn  "Unknown error code: " + Str(errorCode)
    EndSelect

EndProcedure

email_ssl64.pb

Code: Select all

EnableExplicit

XIncludeFile "ssl_mail64.pbi"

#SMTP_RESPONSE_TIMEOUT = 5000 ; m/s

;****************************************************************************************
; receive data from the email server encrypted by ssl
;****************************************************************************************

Procedure.i sslRecvData(secureSession.i, *sslError, *returnData, *lenRtnData, buffSize.i)

    Protected retValue.i
    Protected totReturned = 0
    Protected totalMS.i   = 0

; get server response, wait as needed

    Repeat
        Delay(100)
        totalMS = totalMS + 100
        If totalMS > #SMTP_RESPONSE_TIMEOUT
            Break
        EndIf

        retValue = CryptPopData(secureSession, *returnData, buffSize, @totReturned)
        If retValue <> #CRYPT_OK
            PokeS(*sslError, "CryptPopData ERROR: " + lookupError(retValue))
            ProcedureReturn -999
        Else
            If totReturned > 0
                PokeI(*lenRtnData, totReturned)
                Break
            EndIf
        EndIf
    ForEver

    PrintN("Recd:")
    If totReturned > 0
        ConsoleColor(10,0)
        PrintN(PeekS(*returnData, totReturned))
        ConsoleColor(15,0)
    EndIf

    ProcedureReturn retValue

EndProcedure

;****************************************************************************************
; send data to the email server encrypted by ssl
;****************************************************************************************

Procedure.i sslSendData(secureSession.i, *sslError, *sendText, lenSendText)

    Protected retValue.i
    Protected bytesSent.i

; send data to email server

    retValue = CryptPushData(secureSession, *sendText, lenSendText, @bytesSent); used to copy data into an encrypted envelope
    If retValue <> #CRYPT_OK Or lenSendText <> bytesSent
        PokeS(*sslError, "CryptPushData ERROR " + lookupError(retValue) + ", lenSend = " + Str(lenSendText) + ", bytesSent = " + Str(bytesSent))
        ProcedureReturn -998
    EndIf

    retValue = CryptFlushData(secureSession); used to send data to remote machine
    If retValue <> #CRYPT_OK
        PokeS(*sslError, "CryptFlushData ERROR " + lookupError(retValue))
        ProcedureReturn -997
    EndIf

    PrintN("Sent:")
    ConsoleColor(14,0)
    PrintN(PeekS(*sendText, lenSendText))
    ConsoleColor(15,0)

    ProcedureReturn retValue

EndProcedure

;****************************************************************************************

Procedure.i SendPage(*mailHost, lenMailHost.i, mailPort.i, *userName, lenUserName, *password, lenPassword, *mailfrom, *mailTo, *emailBody, *rtnError)

    Protected retValue.i
    Protected cmdString.s
    Protected cmdNumber.i
    Protected lenghtTTS.i
    Protected sslSession.i
    Protected base64Size.i
    Protected base64Data.s
    Protected bytesRecvd.i
    Protected textToSend.s
    Protected serverReply.s
    Protected lenToEncode.i
    Protected replySize   = 255
    Protected mailfrom.s  = PeekS(*mailfrom)
    Protected mailTo.s    = PeekS(*mailTo)
    Protected emailBody.s = PeekS(*emailBody)

; create the ssl session

    retValue = CryptCreateSession(@sslSession, #CRYPT_UNUSED, #CRYPT_SESSION_SSL)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; add the server name "smtp.gmail.com"

    retValue = CryptSetAttributeString(sslSession, #CRYPT_SESSINFO_SERVER_NAME, *mailHost, lenMailHost)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; specify the Port, for SSL GMail, it's 465

    retValue = CryptSetAttribute(sslSession, #CRYPT_SESSINFO_SERVER_PORT, mailPort)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; activate the ssl session

    retValue = CryptSetAttribute(sslSession, #CRYPT_SESSINFO_ACTIVE, 1)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response created by connecting

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need 220, connection okay, begin enhanced smtp dialog

    If cmdNumber <> 220
        PokeS(*rtnError, "Invalid handshake received: " + cmdString)
        ProcedureReturn -996
    EndIf

; send EHLO to server

    textToSend = "EHLO" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from EHLO command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need 250, requested mail action okay, begin enhanced smtp dialog

    If cmdNumber <> 250
        PokeS(*rtnError, "EHLO Failed: " + cmdString)
        ProcedureReturn -995
    EndIf

; send auth login to server

    textToSend = "AUTH LOGIN" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from AUTH LOGIN command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need 334, ok to login, send username but encode the user name to base64 (mime) first

    If cmdNumber <> 334
        PokeS(*rtnError, "AUTH LOGIN Failed: " + cmdString)
        ProcedureReturn -994
    EndIf

; send the username to server

    base64Size  = lenUserName * 2
    If  base64Size < 64
        base64Size = 64
    EndIf

    base64Data = Space(base64Size + 1)
    Base64Encoder(*userName, lenUserName, @base64Data, base64Size)

    textToSend = base64Data + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from username command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need 334, username ok, send password but encode the password to base64 (mime) first

    If cmdNumber <> 334
        PokeS(*rtnError, "Username Failed: " + cmdString)
        ProcedureReturn -993
    EndIf

; send the password to server

    base64Size  = lenPassword * 2
    If  base64Size < 64
        base64Size = 64
    EndIf

    base64Data = Space(base64Size + 1)
    Base64Encoder(*password, lenPassword, @base64Data, base64Size)

    textToSend = base64Data + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from password command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need 235 = authentication ok or 250 = all ok, enter the from email address

    If cmdNumber <> 235 And cmdNumber <> 250
        PokeS(*rtnError, "Password Failed: " + cmdString)
        ProcedureReturn -992
    EndIf

; send the mail from address to server

    textToSend = "MAIL FROM: <" + mailfrom + ">" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from 'mail from' command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need a 250 here, sender ok, enter the receiving email address

    If cmdNumber <> 250
        PokeS(*rtnError, "MAIL FROM Failed: " + cmdString)
        ProcedureReturn -991
    EndIf

; send the receiving email address to server

    textToSend = "RCPT TO: <" + mailTo + ">" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from 'send to' command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; need a 250 or 251 here, ok to proceed, send the data command

    If cmdNumber <> 250 And cmdNumber <> 251
        PokeS(*rtnError, "RCPT TO Failed: " + cmdString)
        ProcedureReturn -990
    EndIf

; send the 'DATA' command

    textToSend = "DATA" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from 'DATA' command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; we should receive 354

    If cmdNumber <> 354
        PokeS(*rtnError, "DATA Failed: " + cmdString)
        ProcedureReturn -989
    EndIf

; send the mail itself, end with "." on a line by itself

    textToSend = emailBody + #CRLF$ + "." + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from 'end of data' command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; doesn't matter what we have received, we're going to quit anyway

    textToSend = "QUIT" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *rtnError, @textToSend, lenghtTTS)
    If retValue <> #CRYPT_OK
        PokeS(*rtnError, "sslSendData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; receive response from 'quit' command

    serverReply = Space(replySize)
    retValue    = sslRecvData(sslSession, *rtnError, @serverReply, @bytesRecvd, replySize)
    If retValue = #CRYPT_OK
        cmdString = PeekS(@serverReply, 3)
        cmdNumber = Val(cmdString)    
    Else
        PokeS(*rtnError, "sslRecvData ERROR: " + lookupError(retValue))
        ProcedureReturn retValue
    EndIf

; now end the ssl session

    If sslSession
        CryptDestroySession(sslSession)
    EndIf

    ProcedureReturn 0
EndProcedure

Define emailBody.s
Define errReturn.s = Space(255)
Define retValue.i, bytesRecvd.i

Define mailHost.s         = "smtp.gmail.com"               ; SMTP Host
Define lenMailHost.i      = Len(mailHost)
Define mailPort.i         = 465
Define mailFrom.s         = "my_email@gmail.com"
Define userName.s         = "my_email@gmail.com"           ; your gmail account
Define lenUserName.i      = Len(userName)
Define password.s         = "somepassword"                 ; your password
Define lenPassword.i      = Len(password)
Define mailTo.s           = "user@user.com"

emailBody = "From: "    + Mailfrom  + #CRLF$
emailBody + "To: "      + MailTo    + #CRLF$
emailBody + "Subject: " + "64 bit Gmail Test using SSL Encryption" + #CRLF$
emailBody + "Dear Sir, this email is brought to you courtesy of 64 bit SSL Encryption."

OpenConsole()
ConsoleColor(15,0)

; Initialize the crypt Library

Define initValue = CryptInit()
If initValue <> #CRYPT_OK
    errReturn = lookupError(initValue)
    PrintN(errReturn)
    End
EndIf

retValue = SendPage(@mailHost, lenMailHost, mailPort, @userName, lenUserName, @password, lenPassword, @mailfrom, @mailTo, @emailBody, @errReturn)
If retValue <> #CRYPT_OK
    PrintN(errReturn)
Else
    PrintN("EMail sent successfully!")
EndIf

CryptEnd() ; Close the Library

Input()

CloseConsole()
; IDE Options = PureBasic 4.61 (Windows - x64)
; ExecutableFormat = Console
; CursorPosition = 5
; Folding = -
; Executable = email_ssl64.exe
; CompileSourceDirectory
; Compiler = PureBasic 4.61 (Windows - x64)

Posted: **Sun Dec 23, 2012 5:52 pm**

Hi Rich again seen no one interested to reply guess all busy with 5.10b1 just tested with 5.10b1 x64 again works floorless

Zebuddi.

Merry Xmas & happy NewYear

I have tried using this with yahoo service no joy returns -32 (bad/unrecognized data format) from the crypt.lib both 32 & 64 just have a look at http://www.coastrd.com/ and downloaded cryptlib source to have a look c/c++ not my bag

anyways from what i`m gathering it should work with other services yahoo etc. any thoughts ?

Thanks again Rich.

Posted: **Sun Dec 23, 2012 9:49 pm**

Zeb, I'll take a look at Yahoo and let you know.

Merry Christmas to all!

Posted: **Sun Dec 23, 2012 10:34 pm**

Thanks Rich

Zebuddi.

Posted: **Sun Dec 23, 2012 10:40 pm**

You should merge the x86 and x64 version, like:

Code: Select all

;  /****************************************************************************
;  *                                        General Functions                   *
;  ****************************************************************************/

CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
Global cryptLib.i               = OpenLibrary(#PB_Any, "cryptlib64.dll")
CompilerElse
Global cryptLib.i               = OpenLibrary(#PB_Any, "cryptlib32.dll")
CompilerEndIf

Merry Christmas

Posted: **Sun Dec 23, 2012 11:14 pm**

Here's what I found Zeb, the server needs to be 'plus.smtp.mail.yahoo.com' for Yahoo, but you also need to pay for SMTP service.

530 Access denied : Need SMTP privileges to access this server.

I've also tested with my 'smtp.1and1.com' server, and I had to tweak the return numbers, you may need to do this also. For instance, a server should respond with a 334 after a user name is sent, but 1and1.com responded with a 250 for some reason. The email did go through successfully, however.

That is the same for 64 bit.

Posted: **Mon Dec 24, 2012 1:01 am**

Thank you Rich your a Genius and a Gentleman

thanks for going through the trouble for me. I`ll make do with the Gmail for now !

Zebuddi.

Posted: **Mon Dec 24, 2012 1:06 am**

And you are a fine judge of character Zeb!

Merry Christmas from the colonies!

Posted: **Mon Dec 24, 2012 1:26 am**

RichAlgeni wrote:And you are a fine judge of character Zeb!

Merry Christmas from the colonies!

Rich you smell of wee

but you are providing some very interesting code... Thanks very much!

Posted: **Mon Dec 24, 2012 2:26 am**

Posted: **Sat Dec 29, 2012 5:46 am**

Just in case anyone was having a problem seeing the body of their email, RFC 2822 requires a blank line between the Subject field and the message body. So just add an extra #CRLF$ to the Subject line.

PureBasic Forums - English

64 bit SSL SMTP

64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP

Re: 64 bit SSL SMTP