don't know if this is of any use to you but below is my translation of the VB code (Just practicing

It seems to work fine up to the 'AUTH LOGIN' command. See debugger output below.
I'm not sure why I'm getting an error there..
Would be nice to get this going though.
Code: Select all
;BASIC SMTPS
; SMTP Client to send email via a gmail account using the CryptLib library
;#COMPILE EXE
XIncludeFile "Cryptlib_Header.pb" ; v3.33
Global hDbg.l
;$DEBUG_FILE = "CryptLib_dbg.txt"
#TCP_PORT = 465
#SMTP_RESPONSE_TIMEOUT = 5000 ; m/s
;****************************************************************************************
Procedure.s Err2Str(RetVal.l)
If RetVal <> #CRYPT_OK
Select RetVal
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 initialised"
Case #CRYPT_ERROR_INITED : ProcedureReturn "Data has already been init;d"
Case #CRYPT_ERROR_NOSECURE : ProcedureReturn "Operation not avail at requested sec 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 extnl.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!"
EndSelect
EndIf
EndProcedure
;¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤;
Procedure.s MimeEncode(sFileData.s)
string$ = sFileData
outputlength = Len(string$) * 1.4
If outputlength < 64
outputlength = 64
EndIf
*InputBuffer = AllocateMemory(Len(string$))
*OutputBuffer = AllocateMemory(outputlength)
PokeS(*InputBuffer, string$)
length = Base64Encoder(*InputBuffer, Len(string$), *OutputBuffer, outputlength)
If length
result$ = PeekS(*OutputBuffer, length)
Else
result$ = ""
EndIf
ProcedureReturn result$
; Protected lBlock.l, lcBlocks.l, lByte1.l, lByte2.l, lByte3.l, lIndex1.l, lIndex2.l, lIndex3.l, lIndex4.l
; Protected pInput.b, pOutput.b, pTable.b
; Protected sBase64.s, sResult.s, mPad.s
; sBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ; Set up Base64 translation table
; ;mPad = STRING$(2 - (Len(sFileData) - 1) MOD 3, "=") ; Calculate padding for Base64 stream
; mPad = Str(2 - (Len(sFileData) - 1) % 3) ; Calculate padding for Base64 stream
; lcBlocks = (Len(sFileData) + 2) \ 3 ; Round up the length of the input data to a multiple of three
; If lcBlocks * 3 > Len(sFileData) : sFileData = LSET$(sFileData, lcBlocks * 3 USING $NUL) : EndIf
; sResult = SPACE$(lcBlocks * 4) ; Allocate the space for the output string
; pInput = STRPTR(sFileData) ; Set up pointers so we can treat the data as byte streams
; pOutput = STRPTR(sResult)
; pTable = STRPTR(sBase64)
; For lBlock = 1 To lcBlocks ; Loop through our entire input buffer
; lByte1 = @pInput ; Get the next three binary data bytes to process
; INCR pInput
; lByte2 = @pInput
; INCR pInput
; lByte3 = @pInput
; INCR pInput
; lIndex1 = lByte1 \ 4 ; Translate the three data bytes into four Base64 table indices
; lIndex2 = (lByte1 And 3) * 16 + lByte2 \ 16
; lIndex3 = (lByte2 And 15)* 4 + lByte3 \ 64
; lIndex4 = lByte3 And 63
; @pOutput = @pTable[lIndex1] ; Use the Base64 table to encode the output string
; INCR pOutput
; @pOutput = @pTable[lIndex2]
; INCR pOutput
; @pOutput = @pTable[lIndex3]
; INCR pOutput
; @pOutput = @pTable[lIndex4]
; INCR pOutput
; Next
; RSET ABS sResult = mPad ; Merge in the padding bytes
;ProcedureReturn sResult
EndProcedure
;****************************************************************************************
Procedure.s ErrorExStr(hCrypt.l)
Protected MsgLen.l, RetVal.l
Protected sErr.s
sErr = Space(512) ; Should be big enough for most messages
RetVal = CryptGetAttributeString(hCrypt, #CRYPT_ATTRIBUTE_INT_ERRORMESSAGE, @sErr, @MsgLen)
ProcedureReturn Left(sErr, MsgLen) ; PRINT #hDbg, "RetVal="+Err2Str(RetVal) + " " + ", MsgLen="+STR$(MsgLen) + " " + TRIM$(zErr) : EXIT LOOP
EndProcedure
;****************************************************************************************
Procedure.l TLSPushPop( hCrypt.l, sErr.s, sReply.s, sSend.s )
Define k.l, RetVal.l, BytesSent.l, BytesReply.l, Last.l, Totms.l
Define pByte.b
;Global sBuff.s
If Len(sSend) < 1 : sErr = "No data sent" : ProcedureReturn -21 : EndIf
If sBuff = 0 : sBuff = AllocateMemory(256) : EndIf; sBuff = Space(256) :EndIf; Create buffer
;- Trap unexpected returns
RetVal = CryptPopData( hCrypt, sBuff, 256, @BytesReply )
If RetVal <> #CRYPT_OK
sErr = "CryptPopData ERROR: "+Err2Str(RetVal)
ProcedureReturn -22
ElseIf BytesReply > 0
sErr = "ERROR:"+Str(BytesReply)+" unexpected bytes in buffer: "+ Left(PeekS(sBuff,256), BytesReply)
ProcedureReturn -23
EndIf
;- Push Data PRINT #hDbg, "Sent:" + STR$(Len(sSend)) + " Bytes: " + PARSE$(sSend, $CRLF, 1)
RetVal = CryptPushData( hCrypt, @sSend, Len(sSend), @BytesSent )
If RetVal <> #CRYPT_OK : sErr = "CryptPushData ERROR "+Err2Str(RetVal) : ProcedureReturn -24 : EndIf
If Len(sSend) <> BytesSent : sErr = "LEN(sSend)="+Str(Len(sSend))+", BytesSent="+Str(BytesSent) : ProcedureReturn -24 : EndIf
Debug "<C>: " + sSend
;"Flush outgoing data"
RetVal = CryptFlushData(hCrypt)
If RetVal <> #CRYPT_OK : sErr = "CryptFlushData ERROR "+Err2Str(RetVal) : ProcedureReturn -25 : EndIf
;"Recover response"
sReply = ""
Totms = 0
Repeat
Delay(20) ; Wait For a response
Totms = Totms + 20
If Totms > #SMTP_RESPONSE_TIMEOUT
sErr = "Response timeout >" + Str(#SMTP_RESPONSE_TIMEOUT) + "m/s"
ProcedureReturn -27
EndIf ; PRINT #hDbg, STR$(Totms) + "m/s"
RetVal = CryptPopData( hCrypt, sBuff, 256, @BytesReply ) ;Len(sBuff)
If RetVal <> #CRYPT_OK : sErr = "CryptPopData ERROR "+Err2Str(RetVal) : Debug sErr : ProcedureReturn -29 : EndIf
If BytesReply > 0
sReply = sReply + Left(PeekS(sBuff), BytesReply)
Last = Len(sReply) ; PRINT #hDbg, "Rply:" + STR$(BytesReply) + " Bytes: " + LEFT$(sBuff, BytesReply)
pByte = @sReply ; Check last line For SMTP code follwed by space
Break
If Last > 7 And PeekS(pByte+Last-1) = Chr(10) And PeekS(pByte+Last-2) = Chr(13) : EndIf;' CRLF
If Last > 7 And Mid(sReply, Last-1, 1) = Chr(10) And Mid(sReply, Last-2,1) = Chr(13) ;' CRLF
For k = 3 To Last ; PRINT #hDbg, "CharNum=" + STR$(Last-k+1) + ", " + CHR$(@pByte[Last-k])
If Mid(sReply, Last-k) = Chr(10) And Mid(sReply, Last-k+4,1) = Chr(32) : Break : EndIf ; Space Not a hyphen "-", Response complete
If k = last And Mid(sReply, Last-k+3,1) = Chr(32) : Break : EndIf ; Space Not a hyphen "-", Response complete
Next
EndIf
EndIf
ForEver ; PRINT #hDbg, BytesToHexPtr( STRPTR(sBuff), BytesReply )
Debug "<S>: " + sReply
;FreeMemory(sBuff)
ProcedureReturn Val(StringField(sReply,1," ")) ; PRINT #hDbg, "----------------------"
EndProcedure
;****************************************************************************************
Procedure.l SendGmail( sSrvr.s, sUser.s, sPass.s, sFrom.s, sTo.s, sBody.s, sRet.s)
; Returns 1 = message sent
; -ve = Error (sRet = error description)
Protected RetVal.l, hSess.l, BytesReply.l
Protected sReply.s, sEnc.s, sErr.s
CRLF$ = Chr(10) + Chr(13)
If Len(sSrvr) = 0 Or Len(sUser) = 0 Or Len(sPass) = 0 Or Len(sFrom) = 0 Or Len(sTo) = 0 Or Len(sBody) = 0
sRet = "A required parameter string is missing"
ProcedureReturn -1
EndIf
; Initialize the Library
RetVal = CryptInit()
If RetVal <> #CRYPT_OK : sRet = Err2Str(RetVal) : ProcedureReturn -2 : EndIf
Repeat
; Create the session
RetVal = CryptCreateSession(@hSess, #CRYPT_UNUSED, #CRYPT_SESSION_SSL)
If RetVal <> #CRYPT_OK : sRet = Err2Str(RetVal) : ProcedureReturn -4 : EndIf
;Debug "hSess = " + Str(hSess)
; Add the server name "smtp.gmail.com"
RetVal = CryptSetAttributeString( hSess, #CRYPT_SESSINFO_SERVER_NAME, @sSrvr, Len(sSrvr))
If RetVal <> #CRYPT_OK : sRet = Err2Str(RetVal) : ProcedureReturn -6 : EndIf
; Specify the Port
RetVal = CryptSetAttribute( hSess, #CRYPT_SESSINFO_SERVER_PORT, 465 )
If RetVal <> #CRYPT_OK : sRet = Err2Str(RetVal) : ProcedureReturn -8 : EndIf
; Activate the session
RetVal = CryptSetAttribute( hSess, #CRYPT_SESSINFO_ACTIVE, 1 )
If RetVal <> #CRYPT_OK : sRet = Err2Str(RetVal) : ProcedureReturn -9 : EndIf
; Remove any response created by connecting
sReply = Space(255)
RetVal = CryptPopData( hSess, @sReply, Len(sReply),@BytesReply )
If RetVal <> #CRYPT_OK : sErr = "CryptPopData1 ERROR "+Err2Str(RetVal) : ProcedureReturn -10 : EndIf
; MIME dialog
RetVal = TLSPushPop(hSess, sErr, sReply, "EHLO" + CRLF$) ;
If RetVal <> 250 : sRet = "EHLO Failed: "+sErr : Debug sRet : ProcedureReturn -11 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, "AUTH LOGIN" + CRLF$);
If RetVal <> 334 : sRet = "AUTH Failed: "+sErr : Debug sRet : ProcedureReturn -12 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, MimeEncode(sUser) + CRLF$) ; Username
If RetVal <> 334 : sRet = "user Failed: "+sErr : Debug sRet : ProcedureReturn -13 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, MimeEncode(sPass) + CRLF$) ; Password
If RetVal <> 235 : sRet = "pass Failed: "+sErr : Debug sRet : ProcedureReturn -14 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, "MAIL FROM: <" + sFrom + ">" + CRLF$) ; Sender
If RetVal <> 250 : sRet = "MAIL FROM Failed: "+sErr : Debug sRet : ProcedureReturn -15 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, "RCPT TO: <" + sTo + ">" + CRLF$) ; Recipient
If RetVal <> 250 : sRet = "RCPT TO Failed: "+sErr : Debug sRet : ProcedureReturn -16 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, "DATA " + Chr(10)) ; Body begins
If RetVal <> 354 : sRet = "DATA Failed: "+sErr : Debug sRet : ProcedureReturn -17 : EndIf
RetVal = TLSPushPop(hSess, sErr, sReply, sBody + CRLF$ + "." + CRLF$) ; Body
If RetVal <> 250 : sRet = "body Failed: "+sErr : Debug sRet : ProcedureReturn -18 : EndIf
ProcedureReturn 1 ; 250 2.0.0 OK - Message sent
RetVal = TLSPushPop(hSess, sErr, sReply, "QUIT " + CRLF$) ; Terminate MIME
If RetVal <> 221 : sRet = "QUIT Failed: "+sErr : Debug sRet : ProcedureReturn -19 : EndIf
Break ; done
ForEver
If hSess : CryptDestroySession(hSess) : EndIf; Close the session
CryptEnd() ; Close the Library
EndProcedure
;****************************************************************************************
Procedure PBMAIN()
Protected RetVal.l
Protected sBody.s, sRet.s
MailHost$ = "smtp.gmail.com" ; SMTP Host
MailFrom$ = "noreply@gmail.com"
UserName$ = "justtesting@gmail.com" ; your gmail account
Password$ = "testpassword" ; your gmail account
MailTo$ = "anyone@hotmail.com" ;
;hDbg = FREEFILE : OPEN $DEBUG_FILE For OUTPUT LOCK Shared As hDbg ;
;PRINT #hDbg, "-------- "+DATE$+" "+TIME$+" ---------"
sBody = ""
sBody = sBody + "From: " + Mailfrom$ + Chr(10)
sBody = sBody + "To: " + MailTo$ + Chr(10)
sBody = sBody + "Subject: " + "Gmail Test using TLS Encryption" + Chr(10) + Chr(10)
sBody = sBody + "Dear John, this email is brought to you courtesy of cryptlib"
RetVal = SendGmail(MailHost$, UserName$, Password$, Mailfrom$, MailTo$, sBody, sRet)
If RetVal < 0 : Debug "ERROR: "+ Err2Str(retVal) : EndIf
;CLOSE #hDbg
MessageRequester("","DONE")
EndProcedure
;****************************************************************************************
PBMAIN()
Cheers! B.<C>: EHLO
<S>: 250-mx.google.com at your service, [87.211.230.154]
250-SIZE 35651584
250-8BITMIME
250-AUTH LOGIN PLAIN
250-ENHANCEDSTATUSCODES
250 PIPELINING
<C>: AUTH LOGIN
<S>: 502 5.5.1 Unrecognized command. 13sm2265370ewy.13
AUTH Failed:
ERROR: Data has already been init;d
p.s. I've used PB's bas64 encoder for the MimeEncode function.. Think that should work alright.