Do not seen to be able to send email...

AlanFoo · Post by **AlanFoo** » Fri Jul 01, 2011 2:11 am

Dear all,

Hope someone would help me..

I have been able to send emails from Purebasic for months already , but suddenly Yesterday started to get " Unable to send email" in my software.

I tried the sample email.pb from help on which my program was based also got the same result. Previously it was okay.

Code: Select all

InitNetwork()


If CreateMail(0, "fred@purebasic.com", "Hello !")

  SetMailBody(0, "Hello   "+Chr(10)+"This is a mail !")
  
  ;AddMailAttachment(0, "My description", "brook_3d.png")
  ;AddMailAttachment(0, "My description 2", "test.bmp")
  
  
  ;AddMailRecipient(0, "test@yourdomain.com", #PB_Mail_To)
  ;AddMailRecipient(0, "test2@yourdomain.com", #PB_Mail_Cc)
  
  ;Result = SendMail(0, "smtp.free.fr", 25, 1)
  result=SendMail(0, "smtp-proxy.tm.net.my",25, 1) 
  If result>0
    Debug "ok"
  Else
    Debug "failed"
    End
    EndIf
  
  Repeat
    Progress = MailProgress(0)
    Delay(300)
  Until Progress = #PB_Mail_Finished Or Progress = #PB_Mail_Error
  
  If Progress = #PB_Mail_Finished
    MessageRequester("Information", "Mail correctly sent !")
  Else
    MessageRequester("Error", "Can't sent the mail !")
  EndIf
  
EndIf

When I run the script, I got pass the result=SendMail(0, "smtp-proxy.tm.net.my",25, 1)
but seemed to fail at
Progress = MailProgress(0)
.

I am not sure if it is the fault of my ISP "smtp-proxy.tm.net.my", or PureBasic's Progress = MailProgress(0)

Hope someone can try it on his/her own computer to see if it works. If it does then it is the fault of my ISP.

Thanks

Regards
Alan

]Error the

citystate · Post by **citystate** » Fri Jul 01, 2011 5:29 am

my guess, considering that your code was working fine previously - unless you broke it, it's probably a change your ISP has made...

AlanFoo · Post by **AlanFoo** » Fri Jul 01, 2011 5:50 am

Thanks citistate for your comment.

Yes, I think so too. But then when I asked the ISP support, they seemed to say they had not changed anything.

Maybe you can help to confirm by running the said script which is from help section email.pb with the isp "smtp-proxy.tm.net.my" setting changed to your own ISP's smtp setting.

If it runs okay and able to send an email ... then it definitely the fault of my ISP.

So I need another person's Isp to be tested . I need to know to pursue this further.

Regards
Alan

jerico2day · Post by **jerico2day** » Sat Jul 02, 2011 5:34 pm

I'm at work now, so I can't do it, but google mail offers smtp and is free to sign up.

AlanFoo · Post by **AlanFoo** » Sat Jul 02, 2011 5:41 pm

jerico2day wrote:I'm at work now, so I can't do it, but google mail offers smtp and is free to sign up.

May I ask if it is possible to use Google's mail smtp in my pure basic program and not from my own ISP?

.. in my program I can replace
result=SendMail(0, "smtp-proxy.tm.net.my",25, 1) with one that is from Google?

My ISP is tm.net.my.

What is the code to use for Google?

Thanks

Alan

MachineCode · Post by **MachineCode** » Sun Jul 03, 2011 2:48 am

AlanFoo wrote:May I ask if it is possible to use Google's mail smtp in my pure basic program and not from my own ISP?

No, because Gmail requires an SSL connection for POP3 and SMTP, and PureBasic's mail lib doesn't support SSL.
But see here: http://www.purebasic.fr/english/viewtopic.php?t=33066

JackWebb · Post by **JackWebb** » Tue Jul 05, 2011 1:41 am

Alan,

Try this.

SMTPtest.pb

Code: Select all

EnableExplicit
;
;  Sendmail Example. SMTP With Auth in PureBASIC
;  By JackWebb 07/2011
;  PB4.4.51
;  WinXP SP3
;
IncludeFile "c:\PureBasic Projects\AuthSMTP\sendmail.pbi"

Define FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$
Define SmtpServer$, Port, UserName$, Password$
Define Status$

If Not InitNetwork()
  MessageRequester("Network Error", "Could Not Initialize Network", #MB_ICONERROR)
  End
EndIf

SmtpServer$ = "smtp.gmail.com"    ;outbound server
Port        = 587                 ;Gmail port for TLS
UserName$   = "AlanFoo@gmail.com" ;your UserName for AUTH, leave blank to send regular (no AUTH)
Password$   = "YourPassword"      ;your password

FromName$  = "AlanFoo"
FromEmail$ = "AlanFoo@gmail.com"
ToEmail$   = "Fred@purebasic.com"

Subject$ = "This is the subject"
MsgBody$ = "This is the message body." + #CRLF$
MsgBody$ + "The quick brown fox jumped over the lazy dog." + #CRLF$
MsgBody$ + "Mail sent from PureBasic" + #CRLF$

Status$ = SendSmtpMail(FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$) 

If Status$ = "SUCCESS"
  MessageRequester("SMTP Status", "Mail Sent Ok", #PB_MessageRequester_Ok)
Else
  MessageRequester("SMTP Status", "An Error Has Occured", #MB_ICONERROR)
EndIf

Save this as SendMail.pbi

Code: Select all

;{*** ChangeLog *******************************
; This code has been floating around the forum for years.
; Seems To have turned into a community project of sorts.
; Started from Doctorized code.
;
; You can send your mail With SMTP-Auth Or - 
; if you leave the Username blank = regular (no AUTH)
; Also works With multiple large Attachments.
; ---------------------------------------------
;
; July 23, 2010
;    Doctorized - Started from here
;                 http://www.purebasic.fr/english/viewtopic.php?p=329321#p329321
;
; November 10, 2010
;    JackWebb   - Yahoo mail was showing an attached file
;                 when in fact there was none.
;                 Fixed in SendSmtpMail()
;}*********************************************

Global ConnectionID.l 
Global NewList Attachments.s() 

Declare.s base64Encode (strText.s) 
Declare.s GetMIMEType  (Extension.s)
;Declare.s GetUTC       ()
;Declare.s OpenURL      (pUrl.s, pOpenType.b)
;Declare.s ParseTagValue(pString.s, pStartTag.s, pEndTag.s)
Declare Send           (msg.s) 
Declare SendFiles      ()
Declare.s SendSmtpMail (FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$) 

Enumeration ; program constants
  #SM_eHlo
  #SM_RequestAuthentication
  #SM_UserName
  #SM_Password
  #SM_MailFrom
  #SM_RcptTo
  #SM_Data
  #SM_Quit
  #SM_Complete
EndEnumeration 

Procedure.s SendSmtpMail(FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$) 
  Define Junk$, ToMail$
  Define ReceivedData.s
  Define cmdID.s
  Define cmdText.s
  Define Recip, x
  Define ct
  Define state

  ConnectionID = OpenNetworkConnection(SmtpServer$, Port) 
  If Not ConnectionID 
    ProcedureReturn "Connection Failed"
  EndIf       

  For Recip = 1 To 100
    Junk$ = StringField(ToEmail$, Recip, ",")
    If Junk$ = ""
      Recip -1
      Break
    EndIf
  Next

  Repeat    
    If NetworkClientEvent(ConnectionID) 
      ReceivedData.s = Space(256) 
      ct = ReceiveNetworkData(ConnectionID, @ReceivedData, 256) 
      If ct 
        cmdID.s   = Left(ReceivedData, 3) 
        cmdText.s = Mid(ReceivedData, 5, ct - 6) 
        Select cmdID 
        Case "220" 
          If Len(UserName$) > 0 
            Send("Ehlo " + Hostname()) 
            state = #SM_eHlo 
          Else 
            Send("HELO " + Hostname()) 
            state = #SM_MailFrom 
          EndIf    
        Case "221" 
          Send("[connection closed]") 
          state = #SM_Complete 
          Break
        Case "235" 
          Send("MAIL FROM: <" + FromEmail$ + ">") 
          state = #SM_RcptTo 
        Case "334" 
          If state = #SM_RequestAuthentication 
            Send(base64Encode(UserName$)) 
            state = #SM_UserName 
          EndIf 
          If state = #SM_UserName 
            Send(base64Encode(Password$)) 
            state = #SM_Password 
          EndIf 
        Case "250" 
          Select state 
          Case #SM_eHlo 
            Send("AUTH LOGIN") 
            state = #SM_RequestAuthentication      
          Case #SM_MailFrom    
            Send("MAIL FROM: <" + FromEmail$ + ">") 
            state = #SM_RcptTo 
          Case #SM_RcptTo 
            x + 1
            ToMail$ = StringField(ToEmail$, x, ",")
            Send("RCPT TO: <" + ToMail$ + ">")
            state = #SM_RcptTo
            If x = Recip
              state = #SM_Data
            EndIf
          Case #SM_Data 
            Send("DATA") 
            state = #SM_Quit 
          Case #SM_Quit 
            Send("QUIT") 
          EndSelect 
        Case "251" 
          Send("DATA") 
          state = #SM_Data 
        Case "354" 
          Send("X-Mailer: eSMTP 1.0") 
          Send("To: " + ToEmail$) 
          Send("From: " + FromName$ + " <" + FromEmail$ + ">") 
          Send("Reply-To: " + FromEmail$) 
          Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date())) 
          ;Send("Date: " + GetUTC()) ; jp - from Doctorized code
          Send("Subject: " + Subject$) 
          Send("MIME-Version: 1.0") 
          If ListSize(Attachments()) 
            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(MsgBody$)
            SendFiles()
            Send("--MyBoundary--")
          Else
            Send("Content-Type: text/plain; charset=us-ascii")
            Send("Content-Transfer-Encoding: 7bit")
            Send("")
            Send(MsgBody$)
          EndIf 
          Send(".") 
        Case "550", "535"
          CloseNetworkConnection(ConnectionID) 
          ProcedureReturn "error"
        EndSelect 
      EndIf 
    EndIf 
    Delay(10)
  ForEver

  CloseNetworkConnection(ConnectionID) 
  ProcedureReturn "SUCCESS"
EndProcedure 

Procedure Send(msg.s) 
  msg + #CRLF$
  SendNetworkData(ConnectionID, @msg, Len(msg)) 
EndProcedure 

Procedure SendFiles()
  Define InputBufferLength.l, OutputBufferLength.l
  Define file.s, Boundry.s
  Define *memin, *memout

  ResetList(Attachments())

  While(NextElement(Attachments()))
    file.s = Attachments()
    Send("") 
    If ReadFile(0, file.s) 
      InputBufferLength.l = Lof(0) 
     ;If InputBufferLength < 64: InputBufferLength = 64: EndIf
      OutputBufferLength.l = InputBufferLength * 1.4 
      If OutputBufferLength < 80
        OutputBufferLength = 80
      EndIf
      *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(0, *memin, InputBufferLength) 
          Send(base64Encode(PeekS(*memin)))
        EndIf 
      EndIf 
      FreeMemory(*memin) 
      FreeMemory(*memout) 
      CloseFile(0) 
    EndIf 
  Wend 

  ProcedureReturn 
EndProcedure 

Procedure.s base64Encode(strText.s) 
  Define Result.s
  Define *B64EncodeBufferA, *B64EncodeBufferB

  *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(*B64EncodeBufferA) 
  FreeMemory(*B64EncodeBufferB) 

  ProcedureReturn Result 
EndProcedure 

Procedure.s GetMIMEType(Extension.s) 
  Define hKey.l
  Define KeyValue.s
  Define DataSize.l

  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 

Procedure.s OpenURL(pUrl.s, pOpenType.b)
  ; OpenURL procedure by ricardo 2003
  
  Protected isLoop.b, INET_RELOAD.l, hInet.l, hURL.l, Bytes.l
  Protected buffer.s, res.s
  
  isLoop.b = 1
  INET_RELOAD.l = $80000000
  hInet.l  = 0: hURL.l = 0: Bytes.l = 0
  buffer.s = Space(2048)
  hInet    = InternetOpen_("PB@INET", pOpenType, #Null, #Null, 0)
  hURL     = InternetOpenUrl_(hInet, pUrl, #Null, 0, INET_RELOAD, 0)
  Repeat
    Delay(1)
    InternetReadFile_(hURL, @buffer, Len(buffer), @Bytes)
    If Bytes = 0
      isLoop = 0
    Else
      res.s = res + Left(buffer, Bytes)
    EndIf
  Until isLoop = 0

  InternetCloseHandle_(hURL)
  InternetCloseHandle_(hInet)

  ProcedureReturn res
EndProcedure

Procedure.s ParseTagValue(pString.s, pStartTag.s, pEndTag.s)
  Protected lRetVal.s, lPos1.l, lPos2.l
  
  lRetVal.s = ""
  
  lPos1.l = FindString(pString.s, pStartTag.s, 1)
  
  If (lPos1.l > 0)
    lPos2.l = FindString(pString.s, pEndTag.s, lPos1.l)
    If (lPos2.l > 0)
      lPos1.l = (lPos1.l + Len(pStartTag.s))
      lRetVal.s = Mid(pString.s, lPos1.l, (lPos2.l - lPos1.l))
    EndIf
  EndIf
  
  ProcedureReturn lRetVal.s
EndProcedure

Procedure.s GetUTC()
  Protected lRetVal.s, lUrl.s, lUrlResult.s, lPos1.l, lPos2.l
  Protected lFirstString.s, lSecondString.s, lThirdString.s, lFourthString.s
  Protected lMonth.s, lDay.s, lTime.s, lMonthInt.l, lParseResult.s, lDow.s, lYear.s
  
  lRetVal.s       = ""
  lUrl.s          = "http://www.time.gov/timezone.cgi?UTC/s/0"
  lFirstString.s  = "<td align=" + Chr(34) + "center" + Chr(34) + "><font size=" + Chr(34) + "7" + Chr(34) + " color=" + Chr(34) + "white" + Chr(34) + "><b>"
  lSecondString.s = "<br>"
  lThirdString.s  = "</b></font><font size=" + Chr(34) + "5" + Chr(34) + " color=" + Chr(34) + "white" + Chr(34) + ">"
  lFourthString.s = "<br>"

  lUrlResult.s = OpenUrl(lUrl.s,1)
  lUrlResult.s = Trim(lUrlResult.s)
  
  If (Len(lUrlResult.s) > 0)
    lTime.s        = Trim(ParseTagValue(lUrlResult.s, lFirstString.s, lSecondString.s))
    lParseResult.s = Trim(ParseTagValue(lUrlResult.s, lThirdString.s, lFourthString.s))
    
    If ((Len(lTime.s) > 0) And (Len(lParseResult.s)))
      lDow.s   = Left(lParseResult.s, 3)
      lMonth.s = Left(StringField(lParseResult.s, 2, " "), 3)
      lDay.s   = Trim(StringField(lParseResult.s, 3, " "))
      lDay.s   = Mid(lDay.s, 1, Len(lDay.s) - 1)
      lYear.s  = Trim(StringField(lParseResult.s, 4, " "))
      
      lRetVal.s = lDow.s + ", " + lDay.s + " " + lMonth.s + " " + lYear.s + " "  + lTime.s + " -0000"
    EndIf
  EndIf
  
  ProcedureReturn lRetVal.s
EndProcedure

Good Luck!
Jack

AlanFoo · Post by **AlanFoo** » Tue Jul 05, 2011 9:43 am

JackWebb wrote:Alan,

Try this.

SMTPtest.pb

Code: Select all

EnableExplicit
;
;  Sendmail Example. SMTP With Auth in PureBASIC
;  By JackWebb 07/2011
;  PB4.4.51
;  WinXP SP3
;
IncludeFile "c:\PureBasic Projects\AuthSMTP\sendmail.pbi"

Define FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$
Define SmtpServer$, Port, UserName$, Password$
Define Status$

If Not InitNetwork()
  MessageRequester("Network Error", "Could Not Initialize Network", #MB_ICONERROR)
  End
EndIf

SmtpServer$ = "smtp.gmail.com"    ;outbound server
Port        = 587                 ;Gmail port for TLS
UserName$   = "AlanFoo@gmail.com" ;your UserName for AUTH, leave blank to send regular (no AUTH)
Password$   = "YourPassword"      ;your password

FromName$  = "AlanFoo"
FromEmail$ = "AlanFoo@gmail.com"
ToEmail$   = "Fred@purebasic.com"

Subject$ = "This is the subject"
MsgBody$ = "This is the message body." + #CRLF$
MsgBody$ + "The quick brown fox jumped over the lazy dog." + #CRLF$
MsgBody$ + "Mail sent from PureBasic" + #CRLF$

Status$ = SendSmtpMail(FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$) 

If Status$ = "SUCCESS"
  MessageRequester("SMTP Status", "Mail Sent Ok", #PB_MessageRequester_Ok)
Else
  MessageRequester("SMTP Status", "An Error Has Occured", #MB_ICONERROR)
EndIf

Save this as SendMail.pbi

Code: Select all

;{*** ChangeLog *******************************
; This code has been floating around the forum for years.
; Seems To have turned into a community project of sorts.
; Started from Doctorized code.
;
; You can send your mail With SMTP-Auth Or - 
; if you leave the Username blank = regular (no AUTH)
; Also works With multiple large Attachments.
; ---------------------------------------------
;
; July 23, 2010
;    Doctorized - Started from here
;                 http://www.purebasic.fr/english/viewtopic.php?p=329321#p329321
;
; November 10, 2010
;    JackWebb   - Yahoo mail was showing an attached file
;                 when in fact there was none.
;                 Fixed in SendSmtpMail()
;}*********************************************

Global ConnectionID.l 
Global NewList Attachments.s() 

Declare.s base64Encode (strText.s) 
Declare.s GetMIMEType  (Extension.s)
;Declare.s GetUTC       ()
;Declare.s OpenURL      (pUrl.s, pOpenType.b)
;Declare.s ParseTagValue(pString.s, pStartTag.s, pEndTag.s)
Declare Send           (msg.s) 
Declare SendFiles      ()
Declare.s SendSmtpMail (FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$) 

Enumeration ; program constants
  #SM_eHlo
  #SM_RequestAuthentication
  #SM_UserName
  #SM_Password
  #SM_MailFrom
  #SM_RcptTo
  #SM_Data
  #SM_Quit
  #SM_Complete
EndEnumeration 

Procedure.s SendSmtpMail(FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$) 
  Define Junk$, ToMail$
  Define ReceivedData.s
  Define cmdID.s
  Define cmdText.s
  Define Recip, x
  Define ct
  Define state

  ConnectionID = OpenNetworkConnection(SmtpServer$, Port) 
  If Not ConnectionID 
    ProcedureReturn "Connection Failed"
  EndIf       

  For Recip = 1 To 100
    Junk$ = StringField(ToEmail$, Recip, ",")
    If Junk$ = ""
      Recip -1
      Break
    EndIf
  Next

  Repeat    
    If NetworkClientEvent(ConnectionID) 
      ReceivedData.s = Space(256) 
      ct = ReceiveNetworkData(ConnectionID, @ReceivedData, 256) 
      If ct 
        cmdID.s   = Left(ReceivedData, 3) 
        cmdText.s = Mid(ReceivedData, 5, ct - 6) 
        Select cmdID 
        Case "220" 
          If Len(UserName$) > 0 
            Send("Ehlo " + Hostname()) 
            state = #SM_eHlo 
          Else 
            Send("HELO " + Hostname()) 
            state = #SM_MailFrom 
          EndIf    
        Case "221" 
          Send("[connection closed]") 
          state = #SM_Complete 
          Break
        Case "235" 
          Send("MAIL FROM: <" + FromEmail$ + ">") 
          state = #SM_RcptTo 
        Case "334" 
          If state = #SM_RequestAuthentication 
            Send(base64Encode(UserName$)) 
            state = #SM_UserName 
          EndIf 
          If state = #SM_UserName 
            Send(base64Encode(Password$)) 
            state = #SM_Password 
          EndIf 
        Case "250" 
          Select state 
          Case #SM_eHlo 
            Send("AUTH LOGIN") 
            state = #SM_RequestAuthentication      
          Case #SM_MailFrom    
            Send("MAIL FROM: <" + FromEmail$ + ">") 
            state = #SM_RcptTo 
          Case #SM_RcptTo 
            x + 1
            ToMail$ = StringField(ToEmail$, x, ",")
            Send("RCPT TO: <" + ToMail$ + ">")
            state = #SM_RcptTo
            If x = Recip
              state = #SM_Data
            EndIf
          Case #SM_Data 
            Send("DATA") 
            state = #SM_Quit 
          Case #SM_Quit 
            Send("QUIT") 
          EndSelect 
        Case "251" 
          Send("DATA") 
          state = #SM_Data 
        Case "354" 
          Send("X-Mailer: eSMTP 1.0") 
          Send("To: " + ToEmail$) 
          Send("From: " + FromName$ + " <" + FromEmail$ + ">") 
          Send("Reply-To: " + FromEmail$) 
          Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date())) 
          ;Send("Date: " + GetUTC()) ; jp - from Doctorized code
          Send("Subject: " + Subject$) 
          Send("MIME-Version: 1.0") 
          If ListSize(Attachments()) 
            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(MsgBody$)
            SendFiles()
            Send("--MyBoundary--")
          Else
            Send("Content-Type: text/plain; charset=us-ascii")
            Send("Content-Transfer-Encoding: 7bit")
            Send("")
            Send(MsgBody$)
          EndIf 
          Send(".") 
        Case "550", "535"
          CloseNetworkConnection(ConnectionID) 
          ProcedureReturn "error"
        EndSelect 
      EndIf 
    EndIf 
    Delay(10)
  ForEver

  CloseNetworkConnection(ConnectionID) 
  ProcedureReturn "SUCCESS"
EndProcedure 

Procedure Send(msg.s) 
  msg + #CRLF$
  SendNetworkData(ConnectionID, @msg, Len(msg)) 
EndProcedure 

Procedure SendFiles()
  Define InputBufferLength.l, OutputBufferLength.l
  Define file.s, Boundry.s
  Define *memin, *memout

  ResetList(Attachments())

  While(NextElement(Attachments()))
    file.s = Attachments()
    Send("") 
    If ReadFile(0, file.s) 
      InputBufferLength.l = Lof(0) 
     ;If InputBufferLength < 64: InputBufferLength = 64: EndIf
      OutputBufferLength.l = InputBufferLength * 1.4 
      If OutputBufferLength < 80
        OutputBufferLength = 80
      EndIf
      *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(0, *memin, InputBufferLength) 
          Send(base64Encode(PeekS(*memin)))
        EndIf 
      EndIf 
      FreeMemory(*memin) 
      FreeMemory(*memout) 
      CloseFile(0) 
    EndIf 
  Wend 

  ProcedureReturn 
EndProcedure 

Procedure.s base64Encode(strText.s) 
  Define Result.s
  Define *B64EncodeBufferA, *B64EncodeBufferB

  *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(*B64EncodeBufferA) 
  FreeMemory(*B64EncodeBufferB) 

  ProcedureReturn Result 
EndProcedure 

Procedure.s GetMIMEType(Extension.s) 
  Define hKey.l
  Define KeyValue.s
  Define DataSize.l

  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 

Procedure.s OpenURL(pUrl.s, pOpenType.b)
  ; OpenURL procedure by ricardo 2003
  
  Protected isLoop.b, INET_RELOAD.l, hInet.l, hURL.l, Bytes.l
  Protected buffer.s, res.s
  
  isLoop.b = 1
  INET_RELOAD.l = $80000000
  hInet.l  = 0: hURL.l = 0: Bytes.l = 0
  buffer.s = Space(2048)
  hInet    = InternetOpen_("PB@INET", pOpenType, #Null, #Null, 0)
  hURL     = InternetOpenUrl_(hInet, pUrl, #Null, 0, INET_RELOAD, 0)
  Repeat
    Delay(1)
    InternetReadFile_(hURL, @buffer, Len(buffer), @Bytes)
    If Bytes = 0
      isLoop = 0
    Else
      res.s = res + Left(buffer, Bytes)
    EndIf
  Until isLoop = 0

  InternetCloseHandle_(hURL)
  InternetCloseHandle_(hInet)

  ProcedureReturn res
EndProcedure

Procedure.s ParseTagValue(pString.s, pStartTag.s, pEndTag.s)
  Protected lRetVal.s, lPos1.l, lPos2.l
  
  lRetVal.s = ""
  
  lPos1.l = FindString(pString.s, pStartTag.s, 1)
  
  If (lPos1.l > 0)
    lPos2.l = FindString(pString.s, pEndTag.s, lPos1.l)
    If (lPos2.l > 0)
      lPos1.l = (lPos1.l + Len(pStartTag.s))
      lRetVal.s = Mid(pString.s, lPos1.l, (lPos2.l - lPos1.l))
    EndIf
  EndIf
  
  ProcedureReturn lRetVal.s
EndProcedure

Procedure.s GetUTC()
  Protected lRetVal.s, lUrl.s, lUrlResult.s, lPos1.l, lPos2.l
  Protected lFirstString.s, lSecondString.s, lThirdString.s, lFourthString.s
  Protected lMonth.s, lDay.s, lTime.s, lMonthInt.l, lParseResult.s, lDow.s, lYear.s
  
  lRetVal.s       = ""
  lUrl.s          = "http://www.time.gov/timezone.cgi?UTC/s/0"
  lFirstString.s  = "<td align=" + Chr(34) + "center" + Chr(34) + "><font size=" + Chr(34) + "7" + Chr(34) + " color=" + Chr(34) + "white" + Chr(34) + "><b>"
  lSecondString.s = "<br>"
  lThirdString.s  = "</b></font><font size=" + Chr(34) + "5" + Chr(34) + " color=" + Chr(34) + "white" + Chr(34) + ">"
  lFourthString.s = "<br>"

  lUrlResult.s = OpenUrl(lUrl.s,1)
  lUrlResult.s = Trim(lUrlResult.s)
  
  If (Len(lUrlResult.s) > 0)
    lTime.s        = Trim(ParseTagValue(lUrlResult.s, lFirstString.s, lSecondString.s))
    lParseResult.s = Trim(ParseTagValue(lUrlResult.s, lThirdString.s, lFourthString.s))
    
    If ((Len(lTime.s) > 0) And (Len(lParseResult.s)))
      lDow.s   = Left(lParseResult.s, 3)
      lMonth.s = Left(StringField(lParseResult.s, 2, " "), 3)
      lDay.s   = Trim(StringField(lParseResult.s, 3, " "))
      lDay.s   = Mid(lDay.s, 1, Len(lDay.s) - 1)
      lYear.s  = Trim(StringField(lParseResult.s, 4, " "))
      
      lRetVal.s = lDow.s + ", " + lDay.s + " " + lMonth.s + " " + lYear.s + " "  + lTime.s + " -0000"
    EndIf
  EndIf
  
  ProcedureReturn lRetVal.s
EndProcedure

Good Luck!
Jack

Dear Jack,

Thanks for your help.

I tried the above codes from my machine and and seems to get stuck at

Status$ = SendSmtpMail(FromName$, FromEmail$, ToEmail$, Subject$, MsgBody$, SmtpServer$, Port, UserName$, Password$)

You can see from debug that it stops there permanently at debug "333"

If I use smtp.Yahoo.com
at least it exceeds and give an error for status$ as "Smtp Error"

I have placed the sendmail.pbi in its text form in the correct folder "c:\PureBasic Projects\AuthSMTP\sendmail.pbi"

Any advice?

Thanks
Alan

PureBasic Forums - English

Do not seen to be able to send email...

Do not seen to be able to send email...

Re: Do not seen to be able to send email...

Re: Do not seen to be able to send email...

Re: Do not seen to be able to send email...

Re: Do not seen to be able to send email...

Re: Do not seen to be able to send email...

Re: Do not seen to be able to send email...

Re: Do not seen to be able to send email...