32 bit SSL SMTP

RichAlgeni · Post by **RichAlgeni** » Fri Sep 12, 2014 5:11 pm

Are you trying to use Unicode mode? It will only work in ASCII mode, I believe.

doctorized · Post by **doctorized** » Fri Sep 12, 2014 6:28 pm

RichAlgeni wrote:Are you trying to use Unicode mode? It will only work in ASCII mode, I believe.

Whatever I do with unicode, the result is the same. You can do a small test by yourself.

RichAlgeni · Post by **RichAlgeni** » Fri Sep 12, 2014 6:40 pm

This is my latest code from a Windows Service. It's compiled in ASCII mode, and sends about 5000 email messages a day through Google email servers. You should be able to compare it to your code and see what fixes you need. It is multithreaded.

Rich

Code: Select all

; **********************************************************************************
; procedure below sends SSL smtp page
; **********************************************************************************

Procedure.i ProcessEMTP(requestNumber.i)

    Protected itemId.s
    Protected thisDay.s
    Protected subject.s
    Protected command.s
    Protected strData.s
    Protected logText.s
    Protected retValue.l;   this is a 32 bit return code
    Protected fileName.s
    Protected smtpPort.s
    Protected thisYear.s
    Protected *b64MemLoc
    Protected *sendMemory
    Protected *recvMemory
    Protected cmdString.s
    Protected cmdNumber.i
    Protected emailBody.s
    Protected lenghtTTS.i
    Protected thisMonth.i
    Protected textToSend.s
    Protected bytesRecvd.i
    Protected sslSession.i
    Protected smtpServer.s
    Protected rtnAddress.s
    Protected passModule.s
    Protected cnsPortNum.i
    Protected tempString.s
    Protected errorReturn.s
    Protected smtpRtnName.s
    Protected conSendHost.s
    Protected conSendPort.s
    Protected passCallNum.s
    Protected passPersNum.s
    Protected emailAddress.s
    Protected debugOverride.s
    Protected smtpServerPort.i
    Protected thisSource.s{17}
    Protected *cnsData.connectSendData
    Protected netClient.i   = thisThread(requestNumber)
    Protected sslTimeout.i  = 250
    Protected sslAttempts.i = 20
    Protected processNum.i  = 64
    Protected sendString.s  = PeekS(*thisReceived(requestNumber))
    Protected recvLength.i  = 511
    Protected sendLength.i  = 32766
    Protected debugThis.i   = processNum & debuggerLevel
    Protected logThis.i     = processNum & loggingLevel

    thisSource  = IPString(GetClientIP(netClient))

    If logThis
        logText = "ProcessEMTP() > Start, Request number = " + Str(requestNumber)
        logText + ", clientNumber = " + Str(netClient) + ", " + thisSource
        WriteToLog(@logText)
    EndIf

; parse the message received

    sendString    = StringField(sendString,  1, #RS$)
    conSendHost   = StringField(sendString,  2, #FS$)
    conSendPort   = StringField(sendString,  3, #FS$)
    emailAddress  = StringField(sendString,  4, #FS$)
    emailBody     = StringField(sendString,  5, #FS$)
    rtnAddress    = StringField(sendString,  6, #FS$)
    subject       = StringField(sendString,  7, #FS$)
    smtpServer    = StringField(sendString,  8, #FS$)
    passCallNum   = StringField(sendString,  9, #FS$)
    passModule    = StringField(sendString, 10, #FS$)
    passPersNum   = StringField(sendString, 11, #FS$)
    smtpPort      = StringField(sendString, 12, #FS$)
    smtpRtnName   = StringField(sendString, 13, #FS$)

; check for the debugger override command

    debugOverride      = StringField(sendString,  2, #US$)
    If debugOverride   = "1"
        debugThis      = #True
    EndIf

; check for and set the defaults as needed

    If  smtpServer     = ""
        smtpServer     = serverName;       defaults from ini file
    EndIf

    If  smtpPort       = ""
        smtpServerPort = serverPort;       defaults from ini file
    Else
        smtpServerPort = Val(smtpPort)
    EndIf

    If  rtnAddress     = ""
        rtnAddress     = returnAddress;    defaults from ini file
    EndIf

    If  smtpRtnName    = ""
        smtpRtnName    = returnName;       defaults from ini file
    EndIf

    If logThis
        logText = "ProcessEMTP() > smtpServer = " + smtpServer + ", smtpServerPort = " + Str(smtpServerPort)
        logText + ", emailAddress = " + emailAddress + ", rtnAddress = " + rtnAddress + ", smtpRtnName = " + smtpRtnName
        WriteToLog(@logText)
    EndIf

; allocate the memory needed, then attempt to connect

    cmdNumber     = 0
    errorReturn   = Space(recvLength + 1)

    *recvMemory   = AllocateMemory(recvLength + 1)
    *sendMemory   = AllocateMemory(sendLength + 1)

; create the ssl session

    retValue = CryptCreateSession(@sslSession, #CRYPT_UNUSED, #CRYPT_SESSION_SSL)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > CryptCreateSession error: " + lookupError(retValue)
        WriteToLog(@logText)
    EndIf

; add the server name

    If retValue = #CRYPT_OK
        retValue    = CryptSetAttributeString(sslSession, #CRYPT_SESSINFO_SERVER_NAME, @smtpServer, Len(smtpServer))
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > CryptSetAttributeString error: " + lookupError(retValue) + ", smtpServer = " + smtpServer
            WriteToLog(@logText)
        EndIf
    EndIf

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

    If retValue = #CRYPT_OK
        retValue    = CryptSetAttribute(sslSession, #CRYPT_SESSINFO_SERVER_PORT, smtpServerPort)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > CryptSetAttribute error: " + lookupError(retValue) + ", smtpServerPort = " + Str(smtpServerPort)
            WriteToLog(@logText)
        EndIf
    EndIf

; activate the ssl session

    If retValue = #CRYPT_OK
        retValue    = CryptSetAttribute(sslSession, #CRYPT_SESSINFO_ACTIVE, 1)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > CryptSetAttribute error: " + lookupError(retValue) + ", for #CRYPT_SESSINFO_ACTIVE"
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response created by connecting

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn, *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS(*recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; need 220, connection okay, begin enhanced smtp dialog

    If retValue = #CRYPT_OK
        If cmdNumber <> 220
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > Invalid handshake received: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send EHLO to server

    If retValue = #CRYPT_OK
        textToSend = "EHLO " + Hostname() + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from EHLO command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

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

    If retValue = #CRYPT_OK
        If cmdNumber <> 250
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > EHLO Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send auth login to server

    If retValue = #CRYPT_OK
        textToSend = "AUTH LOGIN" + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from AUTH LOGIN command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; need 250 or 334 here

    If retValue = #CRYPT_OK
        If cmdNumber <> 250 And cmdNumber <> 334
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > AUTH LOGIN Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send the base64 (mime) encoded smtpUserName now

    If retValue = #CRYPT_OK
        textToSend = smtpUserName + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from smtpUserName command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; need 250 or 334

    If retValue = #CRYPT_OK
        If cmdNumber <> 250 And cmdNumber <> 334
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > smtpUserName Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send the base64 (mime) encoded smtpPassword now

    If retValue = #CRYPT_OK
        textToSend = smtpPassword + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from smtpPassword command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; need 235, 250, or 334 for all ok, enter the from email address

    If retValue = #CRYPT_OK
        If cmdNumber <> 235 And cmdNumber <> 250 And cmdNumber <> 334
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > smtpPassword Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send the mail from address to server

    If retValue = #CRYPT_OK
        textToSend = "MAIL FROM: <" + rtnAddress + ">" + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from 'mail from' command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

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

    If retValue = #CRYPT_OK
        If cmdNumber <> 235 And cmdNumber <> 250
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > MAIL FROM Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send the receiving email address to server

    If retValue = #CRYPT_OK
        textToSend = "RCPT TO: <" + emailAddress + ">" + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from 'send to' command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

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

    If retValue = #CRYPT_OK
        If cmdNumber <> 250 And cmdNumber <> 251
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > RCPT TO Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

; send the 'DATA' command

    If retValue = #CRYPT_OK
        textToSend = "DATA" + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from 'DATA' command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; we should receive 250, 251 or 354 here

    If retValue = #CRYPT_OK
        If cmdNumber <> 250 And cmdNumber <> 251 And cmdNumber <> 354
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > DATA Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

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

    If retValue = #CRYPT_OK
        thisDay    = FormatDate("%dd", Date())
        thisMonth  = Val(FormatDate("%mm", Date()))
        thisYear   = FormatDate("%yyyy", Date())

        textToSend = "X-Mailer: eSMTP 1.0" + #CRLF$
        textToSend + "To: " + emailAddress + #CRLF$
        textToSend + "From: " + smtpRtnName + " <" + rtnAddress + ">" + #CRLF$
        textToSend + "Reply-To: " + rtnAddress + #CRLF$
        textToSend + "Date: " + thisDay + " " + displayMonths(thisMonth) + " " + thisYear + " " + FormatDate("%hh:%ii:%ss", Date()) + #CRLF$
        textToSend + "Subject: " + subject + #CRLF$
        textToSend + "MIME-Version: 1.0" + #CRLF$
        textToSend + "Content-Type: text/plain; charset=ISO-8859-1; format=flowed" + #CRLF$
        textToSend + "Content-Transfer-Encoding: 7bit" + #CRLF$

; RFC 2822 requires a blank line between the Subject: header field and the message body

        textToSend + #CRLF$
        textToSend + emailBody + #CRLF$
        textToSend + "." + #CRLF$

        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from 'end of data' command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        Else
            logText = "ProcessEMTP() > sslRecvData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; we should receive 250 here

    If retValue = #CRYPT_OK
        If cmdNumber <> 250
            retValue = #CRYPT_SMTP_ERROR
            logText  = "ProcessEMTP() > Message Body Failed: " + cmdString
            WriteToLog(@logText)
        EndIf
    EndIf

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

    If retValue = #CRYPT_OK
        textToSend = "QUIT" + #CRLF$
        lenghtTTS  = Len(textToSend)
        retValue   = sslSendData(sslSession, @errorReturn, @textToSend, lenghtTTS, @smtpServer, debugThis)
        If retValue <> #CRYPT_OK
            logText = "ProcessEMTP() > sslSendData ERROR: " + errorReturn
            WriteToLog(@logText)
        EndIf
    EndIf

; receive response from 'quit' command

    If retValue = #CRYPT_OK
        retValue    = sslRecvData(sslSession, @errorReturn,  *recvMemory, @bytesRecvd, recvLength, sslTimeout, sslAttempts, @smtpServer, debugThis)
        If retValue = #CRYPT_OK
            cmdString = PeekS( *recvMemory, 3)
            cmdNumber = Val(cmdString)
        EndIf
    Else
        cmdNumber = -1; command did not complete
    EndIf

; now end the ssl session

    If sslSession
        CryptDestroySession(sslSession)
    EndIf

; now free the memory we have used

    FreeMemory(*recvMemory)
    FreeMemory(*sendMemory)

; now report the result back to the originating server

    command  = "SMTP"
    fileName = Str(cmdNumber)
    itemId   = emailAddress
    strData  = subject + " | " + emailBody

    If  conSendHost = ""
        conSendHost = destinationServer
    EndIf
    If  conSendPort = ""
        cnsPortNum  = destinationPort
    Else
        cnsPortNum  = Val(conSendPort)
    EndIf

; create the structure data to report back to cad

    *cnsData.connectSendData = AllocateMemory(SizeOf(connectSendData))
    InitializeStructure(*cnsData, connectSendData)

    tempString       = command + #FS$ + fileName + #FS$ + itemId + #FS$ + strData + #FS$ + passModule + #FS$ + passCallNum + #FS$ + passPersNum + #RS$
    *cnsData\csdHost = conSendHost
    *cnsData\csdPort = cnsPortNum
    *cnsData\csdText = tempString
    *cnsData\csdLeng = Len(tempString)

    ConnectAndSend(*cnsData)

; now clear the structure, then free the memory used

    ClearStructure(*cnsData, connectSendData)
    FreeMemory(*cnsData)

    If logThis
        logText = "ProcessEMTP() > End,   Request number = " + Str(requestNumber)
        logText + ", clientNumber = " + Str(netClient) + ", " + thisSource
        WriteToLog(@logText)
    EndIf

EndProcedure

RichAlgeni · Post by **RichAlgeni** » Fri Sep 12, 2014 6:49 pm

Here is procedure to encode the user name and password.

Code: Select all

; **********************************************************************************
; procedure to encode username and password
; **********************************************************************************

Procedure.i EncodeUserData()

    Protected base64Size.i
    Protected lenToEncode.i

    If encodeUserData

; encode the user name here, if required

        lenToEncode = Len(userName)
        If lenToEncode > 0
            base64Size   = lenToEncode * 2

            smtpUserName = Space(base64Size + 1)
            Base64Encoder(@userName, lenToEncode, @smtpUserName, base64Size)
        EndIf

; encode the user password here, if required

        lenToEncode = Len(userPassword)
        If lenToEncode > 0
            base64Size   = lenToEncode * 2

            smtpPassword = Space(base64Size + 1)
            Base64Encoder(@userPassword, lenToEncode, @smtpPassword, base64Size)
        EndIf
    Else
        smtpUserName = userName
        smtpPassword = userPassword
    EndIf

EndProcedure

doctorized · Post by **doctorized** » Sat Sep 13, 2014 10:45 am

My code is much simplier and maybe this is the problem. How do you use this procedure? You are passing server name etc as global variables? Some structure and procedures are missing and I cannot run it to test it.

EDIT: can somebody post a fully functional code that sends SSL mails, a code that will only need to add the account settings by me?

RichAlgeni · Post by **RichAlgeni** » Sat Sep 13, 2014 8:09 pm

This is as far as I go, if you want to be a developer, you have to learn this!

Any place you see ; *************************** change this!!!!!!!!!!!!!!!!!!!!!!!!! you will need to change to your data!

This is the 64 bit version, just change '64' to '32' if you need 32 bit.

Code: Select all

EnableExplicit

#debugIn  = 1
#debugOut = 2

Global NewList programList.s()
Global NewList progVersions.s()

;****************************************************************************************
; write to the log
;****************************************************************************************

Procedure WriteToLog(*logtext)

    PrintN("Error!!!")
    PrintN(PeekS(*logtext))

EndProcedure

;****************************************************************************************
; write to the debugger (console window in this case)
;****************************************************************************************

Procedure DebugString(*debugData, returnLength.l, *netSource, debugThis.l, returnValue.l, *sslError)

    Protected errorText.s = PeekS(*sslError)

    If errorText <> ""
        ConsoleColor(12,0)
        PrintN(errorText)
    EndIf

    If debugThis = #debugIn
        ConsoleColor(10,0)
    Else
        ConsoleColor(14,0)
    EndIf

    PrintN(PeekS(*debugData))
    ConsoleColor(15,0)

EndProcedure

XIncludeFile "\dev\purebasic\\utilities\ssl_client64.pbi"; *************************** change this!!!!!!!!!!!!!!!!!!!!!!!!!

;****************************************************************************************
; send out the page to the secure server
;****************************************************************************************

Procedure SendPage()

    Protected logText.s
    Protected rtnError.s
    Protected retValue.l
    Protected emailBody.s
    Protected cmdString.s
    Protected cmdNumber.l
    Protected lenghtTTS.l
    Protected *errorReturn
    Protected *serverReply
    Protected sslSession.l
    Protected base64Size.l
    Protected base64Data.s
    Protected bytesRecvd.l
    Protected textToSend.s
    Protected lenToEncode.l

    Protected portTimeout.l  = 100
    Protected maxAttempts.l  = 100
    Protected debugThis.l    = 1
    Protected bufferSize.l   = 255

    Protected mailHost.s     = "smtp.gmail.com"
    Protected userName.s     = "username@gmail.com"; *************************** change this!!!!!!!!!!!!!!!!!!!!!!!!!
    Protected password.s     = "password"          ; *************************** change this!!!!!!!!!!!!!!!!!!!!!!!!!
    Protected mailFrom.s     = "username@gmail.com"; *************************** change this!!!!!!!!!!!!!!!!!!!!!!!!!

    Protected lenMailHost.l  = Len(mailHost)
    Protected mailPort.l     = 465
    Protected lenUserName.l  = Len(userName)
    Protected lenPassword.l  = Len(password)
    Protected mailTo.s       = "somebody@email.com"; *************************** change this!!!!!!!!!!!!!!!!!!!!!!!!!

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

    *errorReturn = AllocateMemory(bufferSize)
    *serverReply = AllocateMemory(bufferSize)

; create the ssl session

    retValue = CryptCreateSession(@sslSession, #CRYPT_UNUSED, #CRYPT_SESSION_SSL)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > CryptCreateSession error: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    retValue = CryptSetAttributeString(sslSession, #CRYPT_SESSINFO_SERVER_NAME, @mailHost, lenMailHost)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > CryptSetAttributeString error: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    retValue = CryptSetAttribute(sslSession, #CRYPT_SESSINFO_SERVER_PORT, mailPort)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > CryptSetAttribute error: " + lookupError(retValue) + ", mailPort = " + Str(mailPort)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; activate the ssl session

    retValue = CryptSetAttribute(sslSession, #CRYPT_SESSINFO_ACTIVE, 1)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > CryptSetAttribute error: " + lookupError(retValue) + ", for #CRYPT_SESSINFO_ACTIVE"
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response created by connecting

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; need 220, connection okay, begin enhanced smtp dialog

    If cmdNumber <> 220
        logText = "ProcessEMTP() > Invalid handshake received: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; send EHLO to server

    textToSend = "EHLO " + Hostname() + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from EHLO command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    If cmdNumber <> 250
        logText = "ProcessEMTP() > EHLO Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; send auth login to server

    textToSend = "AUTH LOGIN" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from AUTH LOGIN command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    If cmdNumber <> 250 And cmdNumber <> 334
        logText = "ProcessEMTP() > AUTH LOGIN Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    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, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from username command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    If cmdNumber <> 250 And cmdNumber <> 334
        logText = "ProcessEMTP() > Username Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    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, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from password command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; need 235, 250, or 334 for all ok, enter the from email address

    If cmdNumber <> 235 And cmdNumber <> 250 And cmdNumber <> 334
        logText = "ProcessEMTP() > Password Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; send the mail from address to server

    textToSend = "MAIL FROM: <" + mailfrom + ">" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from 'mail from' command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    If cmdNumber <> 235 And cmdNumber <> 250
        logText = "ProcessEMTP() > MAIL FROM Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; send the receiving email address to server

    textToSend = "RCPT TO: <" + mailTo + ">" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from 'send to' command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    If cmdNumber <> 250 And cmdNumber <> 251
        logText = "ProcessEMTP() > RCPT TO Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; send the 'DATA' command

    textToSend = "DATA" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from 'DATA' command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; we should receive 250, 251 or 354 here

    If cmdNumber <> 250 And cmdNumber <> 251 And cmdNumber <> 354
        logText = "ProcessEMTP() > DATA Failed: " + cmdString
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    textToSend = emailBody + #CRLF$ + "." + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from 'end of data' command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

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

    textToSend = "QUIT" + #CRLF$
    lenghtTTS  = Len(textToSend)
    retValue   = sslSendData(sslSession, *errorReturn, @textToSend, lenghtTTS, @mailHost, debugThis)
    If retValue <> #CRYPT_OK
        logText = "ProcessEMTP() > sslSendData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; receive response from 'quit' command

    retValue    = sslRecvData(sslSession, *errorReturn, *serverReply, @bytesRecvd, bufferSize, portTimeout, maxAttempts, @mailHost, debugThis)
    If retValue = #CRYPT_OK
        cmdString = PeekS(*serverReply, 3)
        cmdNumber = Val(cmdString)
    Else
        logText = "ProcessEMTP() > sslRecvData ERROR: " + lookupError(retValue)
        WriteToLog(@logText)
        ProcedureReturn
    EndIf

; now end the ssl session

    If sslSession
        CryptDestroySession(sslSession)
    EndIf

EndProcedure

; open the console window, initialize the crypt Library, send the message, then quit

OpenConsole()

cryptInitialize()
SendPage()
CryptEnd()

Input()

CloseConsole()

doctorized · Post by **doctorized** » Sun Sep 14, 2014 10:37 am

RichAlgeni wrote:This is as far as I go, if you want to be a developer, you have to learn this!

I apologize for troubling you my friend. I just make some small programs for fun, for me and my friends. I am not a commercial developer. I know that I have to learn too many things. I must confess that I know too few things in comparison to all those that a real developer should know or at least should be aware of. So, please forgive me.
Let me do a last question. What is "ssl_client64.pbi" that I shoud change? What does it contain? I see "sslSendData", "sslRecvData" and some constants, am I correct? I have the procedures but they take different number of arguments and some constants are missing like #SMTP_RESPONSE_TIMEOUT.

RichAlgeni · Post by **RichAlgeni** » Sun Sep 14, 2014 5:23 pm

You just have to change the line to show where it resides on your system.

Here is a slimmed down version of the include file:

Code: Select all

; **********************************************************************************
; initialization of crypt library variables
; **********************************************************************************

; cutdown version for SSL SMTP, 64 bit version

Declare.l cryptInit()
Declare.l cryptEnd()
Declare.l cryptSetAttribute(hCrypt.l,CryptAttType.l, value.l)
Declare.l cryptSetAttributeString(hCrypt.l, CryptAttType.l, pBuff.l, StrLen.l)
Declare.l cryptCreateSession(pSession.l, cryptUser.l, SessionType.l)
Declare.l cryptDestroySession(session.l)
Declare.l cryptCreateEnvelope(penvelope.l, cryptUser.l, FormatType.l)
Declare.l cryptDestroyEnvelope(envelope.l)
Declare.l cryptPushData(envelope.l, pBuff.l, StrLen.l,  pBytesCopied.l)
Declare.l cryptFlushData(envelope.l)
Declare.l cryptPopData(envelope.l, pBuff.l, StrLen.l, pBytesCopied.l)
Declare.s lookupError(errorCode.l)

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

#CRYPTLIB_VERSION               = 3330
#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 */

;/* User defined errors here */

#CRYPT_HTTP_ERROR               = -498 ; /* Error with HTTP protocol */
#CRYPT_SMTP_ERROR               = -499 ; /* Error with SMTP protocol */

;  /****************************************************************************
;  *                           initialization                                  *
;  ****************************************************************************/

Procedure.l cryptInitialize()

    Global cryptLib.l               = OpenLibrary(#PB_Any, "\Utilities\cryptlib64.dll"); * change this to where the dll is located!

    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")

; Initialize the crypt Library

    Protected initValue.l = CryptInit()
    Protected initResult.l

    If  initValue = #CRYPT_OK
        initResult = #True
    Else
        initResult = #False
    EndIf

    ProcedureReturn initResult

EndProcedure

;****************************************************************************************
; receive data from a server encrypted by ssl
;****************************************************************************************

Procedure.l sslRecvData(secureSession.l, *sslError, *returnData, *returnLength, bufferSize.l, socketTimeout.l, maxReadTrys.l, *netSource, debugThis.l)

    Protected returnValue.l  = 0
    Protected attemptCount.l = 0

; initialize the return data

    PokeI(*returnLength, 0)
    FillMemory(*returnData, bufferSize)

; get incoming data from server, wait as needed

    Repeat
        Delay(socketTimeout)
        attemptCount = attemptCount + 1
        If attemptCount > maxReadTrys; if still nothing received, just get out
            Break
        EndIf

        returnValue = CryptPopData(secureSession, *returnData, bufferSize, *returnLength)
        If returnValue = #CRYPT_OK
            If PeekI(*returnLength) > 0
                Break
            EndIf
        Else
            PokeS(*sslError, "CryptPopData ERROR: " + lookupError(returnValue))
            Break
        EndIf
    ForEver

; send the data we have read to the debugger listing, if needed

    If debugThis
        DebugString(*returnData, PeekI(*returnLength), *netSource, #debugIn, returnValue, *sslError)
    EndIf

    ProcedureReturn returnValue

EndProcedure

;****************************************************************************************
; send data to a server encrypted by ssl
;****************************************************************************************

Procedure.l sslSendData(secureSession.l, *sslError, *sendText, lenSendText, *netSource, debugThis.l)

    Protected returnValue.l = 0
    Protected bytesSent.l   = 0

; copy data into an encrypted envelope

    returnValue = CryptPushData(secureSession, *sendText, lenSendText, @bytesSent)
    If returnValue <> #CRYPT_OK Or lenSendText <> bytesSent
        PokeS(*sslError, "CryptPushData ERROR " + lookupError(returnValue) + ", lenSend = " + Str(lenSendText) + ", bytesSent = " + Str(bytesSent))
    EndIf

; send encrypted data to server

    If returnValue = #CRYPT_OK
        returnValue = CryptFlushData(secureSession)
        If returnValue <> #CRYPT_OK
            PokeS(*sslError, "CryptFlushData ERROR " + lookupError(returnValue))
        EndIf
    EndIf

; send the result of the send to the debugger listing, if needed

    If debugThis
        DebugString(*sendText, bytesSent, *netSource, #debugOut, returnValue, *sslError)
    EndIf

    ProcedureReturn returnValue

EndProcedure

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Procedure.s lookupError(errorCode.l)

    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

ricardo · Post by **ricardo** » Sun Sep 14, 2014 6:26 pm

Hi,

I there any code tO receive emails using SSL?

RichAlgeni · Post by **RichAlgeni** » Sun Sep 14, 2014 8:38 pm

I haven't needed code to receive email. You can search the forums for POP3, then graft the SSL code into it.

ricardo · Post by **ricardo** » Sun Sep 14, 2014 9:06 pm

RichAlgeni wrote:I haven't needed code to receive email. You can search the forums for POP3, then graft the SSL code into it.

I did but didnt find anything

RichAlgeni · Post by **RichAlgeni** » Sun Sep 14, 2014 9:19 pm

This is a Pop3 implementation courtesy of HeX0R
http://www.purebasic.fr/english/viewtop ... hilit=pop3

This will explain if you have any questions on Pop3:
https://www.ietf.org/rfc/rfc1939.txt

doctorized · Post by **doctorized** » Mon Sep 15, 2014 1:34 pm

@RichAlgeni
Your code was not working after using the pbi file. Error 534 was still there. Then, I tried to access my account via browser and I saw some incoming emails telling about an app that tried to access the account and was blocked. All these mails were sent today. No mail from the previous attempts. Weird? I enabled the option for less secure apps, as it was recommended, and I succeeded in sending the mail!! I also downloaded Mozilla Thunderbird to do a test. I disabled the above setting and tried to use Thunderbird to access my account. It couldn't connect. Username or password error. I re-enabled the setting and everything was fine. the code works only with gmail (no yahoo, no hotmail), it is ok for me.

If someone wants the latest version of cryptlib and cannot visit the site (I tried to visit http://www.cryptlib.com and I got this: "Forbidden - Users from your country are not permitted to browse this site.") this is the link: http://www.cryptlib.com/downloads/cl342.zip
The manual: http://www.cryptlib.com/downloads/manual.pdf

ricardo · Post by **ricardo** » Wed Sep 17, 2014 8:51 pm

RichAlgeni wrote:This is a Pop3 implementation courtesy of HeX0R
http://www.purebasic.fr/english/viewtop ... hilit=pop3

This will explain if you have any questions on Pop3:
https://www.ietf.org/rfc/rfc1939.txt

Hi, Thanks.

The problem is that ATM having a pop3 without SSL is not much usefull.
Does anybody have a working example of pop3 with SSL?

Liqu · Post by **Liqu** » Thu Sep 18, 2014 9:47 am

Hi RichAgeni,

would you please help me add the attachments function?
i got the attachment code, but i don't know how to merge it to SSL function

Thank you very much

below is the attachment code from clipper

Code: Select all

Global ConnectionID.l
Global CrLf.s
CrLf.s=Chr(13)+Chr(10)

Enumeration
#eHlo
#RequestAuthentication
#Username
#Password
#MailFrom
#RcptTo
#Data
#Quit
#Complete
EndEnumeration

 NewList Attachments.s()
 InsertElement(Attachments())
 Attachments() = "c:\afile.htm"
;InsertElement(Attachments())
;Attachments() = "c:\another.jpg"

Declare.s Base64Encode(strText.s)
Declare SendFiles()
Declare.s GetMIMEType(Extension.s)
Declare Send(msg.s)
Declare SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s)



;Sending Mail with SMTP-AUTH
sendesmtpmail("Clipper","my@email.com","your@email.com","username","password","auth.smtp.mailserver.com","Hallo","This is the body")


; DonÂ´t fill the Username if you want to sent regular
;sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body")

Procedure SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s)
If InitNetwork()
   ConnectionID = OpenNetworkConnection(smtpserver, 25)
   If ConnectionID
      loop250.l=0
      Repeat   
         If NetworkClientEvent(ConnectionID)
            ReceivedData.s=Space(9999)
            ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,9999)
            If ct
               cmdID.s=Left(ReceivedData,3)
               cmdText.s=Mid(ReceivedData,5,ct-6)
               Debug "<" + cmdID + " " + cmdText
               Select cmdID
                  Case "220"
                     If Len(username)>0
                        Send("Ehlo " + Hostname())
                        state=#eHlo
                     Else
                        send("HELO " + Hostname())
                        state=#MailFrom
                     EndIf   
                  Case "221"
                     send("[connection closed]")
                     state=#Complete
                     quit=1     
                  Case "235"
                     Send("MAIL FROM: <" + sender + ">")
                     state=#RcptTo
                   
                  Case "334"
                     If state=#RequestAuthentication
                        Send(Base64Encode(username))
                        state=#Username
                     EndIf
                     If state=#Username
                        Send(Base64Encode(password))
                        state=#Password
                     EndIf
 
                  Case "250"
                     Select state
                        Case #eHlo
                           send("AUTH LOGIN")
                           state=#RequestAuthentication     
                        Case #MailFrom   
                           Send("MAIL FROM: <" + sender + ">")
                           state=#RcptTo
                        Case #RcptTo
                           Send("RCPT TO: <" + recipient + ">")
                           state=#Data
                        Case #Data
                           Send("DATA")
                           state=#QUIT
                        Case #QUIT
                           Send("QUIT")
                     EndSelect
             
                  Case "251"
                        Send("DATA")
                        state=#Data
                  Case "354"
                     send("X-Mailer: eSMTP 1.0")
                     send("To: " + recipient)
                     send("From: " + name + " <" + sender + ">")
                     send("Reply-To: "+sender)
                     send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )
                     send("Subject: " + Subject)
                     send("MIME-Version: 1.0")
                     send("Content-Type: multipart/mixed; boundary="+Chr(34)+"MyBoundary"+Chr(34))
                     Send("")
                     send("--MyBoundary")
                     Send("Content-Type: text/plain; charset=us-ascii")
                     Send("Content-Transfer-Encoding: 7bit")
                     send("")                     
                     Send(body.s)
                     SendFiles()
                     send("--MyBoundary--")
                     Send(".")
             
                  Case "550"
                       
                     quit=1     
               EndSelect
            EndIf
         EndIf
         
      Until Quit = 1
      CloseNetworkConnection(ConnectionID)
      MessageRequester("","Ende")
   EndIf
EndIf         
EndProcedure

Procedure Send(msg.s)
;Delay(10)
Debug "> " + msg
msg+crlf.s
SendNetworkData(ConnectionID, @msg, Len(msg))
EndProcedure


Procedure SendFiles()
ResetList(Attachments())
While(NextElement(Attachments()))
file.s=Attachments()
Send("")
If ReadFile(0,file.s)
   Debug file
   InputBufferLength.l = Lof()
   OutputBufferLength.l = InputBufferLength * 1.4
   *memin=AllocateMemory(InputBufferLength)
   If *memin
      *memout=AllocateMemory(OutputBufferLength)
      If *memout
         Boundry.s = "--MyBoundary"
         Send(Boundry)
         Send("Content-Type: "+GetMIMEType(GetExtensionPart(file.s)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
         send("Content-Transfer-Encoding: base64")
         send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
         send("")
         ReadData(*memin,InputBufferLength)
         Base64Encoder(*memin,60,*memout,OutputBufferLength)
         send(PeekS(*memout,60)) ; this must be done because For i=0 To OutputBufferLength/60 doesnÂ´t work
         Base64Encoder(*memin,InputBufferLength,*memout,OutputBufferLength)               
         For i=1 To OutputBufferLength/60
             temp.s=Trim(PeekS(*memout+i*60,60))
             If Len(temp)>0
              send(temp)
             EndIf
         Next
      EndIf
   EndIf
   FreeMemory(-1)
   CloseFile(0)
EndIf
Wend
ProcedureReturn
EndProcedure


Procedure.s Base64Encode(strText.s)
    DefType.s Result
    *B64EncodeBufferA = AllocateMemory(Len(strText)+1)
    *B64EncodeBufferB = AllocateMemory((Len(strText)*3)+1)
    PokeS(*B64EncodeBufferA, strText)
    Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText)*3)
    Result = PeekS(*B64EncodeBufferB)
    FreeMemory(-1)
    ProcedureReturn Result
EndProcedure


Procedure.s GetMIMEType(Extension.s)
    Extension = "." + Extension
    hKey.l = 0
    KeyValue.s = Space(255)
    DataSize.l = 255
    If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey)
        KeyValue = "application/octet-stream"
    Else
        If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @DataSize)
            KeyValue = "application/octet-stream"
        Else
            KeyValue = Left(KeyValue, DataSize-1)
        EndIf
        RegCloseKey_(hKey)
    EndIf
    ProcedureReturn KeyValue
EndProcedure

PureBasic Forums - English

32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP

Re: 32 bit SSL SMTP