Mail Functions

This code has been declared by its author to be Public Domain code.
Mail Functions by Cpt. Sovok
2002
Now you can receive and send mails without messing with the POP and SMTP-Protocol. All Functions return "+OK" for Success or various "-ERR" messages with errorcode for... no success.
; EMail Functions v0.1
; Robert Gerlach 2.2002
; www.robsite.de


; 13 usefull Functions for receiving (POP) and sending (SMTP) mails with outstandingly ease. 

; Works only good with Plain-text-Mails

; Poorly translated from german... 



;------------
; This and the functions must be in your Program

Global com 
; In every Array-Element a mail-line is saved. easier to read afterwards... 
Global mailzeilen_anzahl
Dim mailzeilen$(mailzeilen_anzahl)
;---------------










;------------------------------------------------------------
; Testprogramm for the POP-Functions


server$ = "pop3.your_server.de"
user$ = "wombat"
pass$ = "xxxxxx"


; Connect with POP-Server
login$ = popAccountLogin$(server$, user$, pass$)




If Mid(login$, 1, 3) = "+OK" Then


; Get Number and Bytes of new mails.
statstring$ = popAccountStat$()


anzahl = zahlausstring(statstring$, 1)

; If there are any mails
If anzahl > 0 Then

popMailReceive$(1) ; receive Mail #1



Print anzahl + " new Mail(s)."
Print

sender$ =  popMailFrom$()
Print "Sendernam: " + stringausstring(sender$,1,0)
Print "Senderadress: " + stringausstring(sender$,2,0)
Print "SenderIP: " + popMailIP$()
Print "Date: " + popMailDateDate$()
Print "Day: " + popMailDateDay$()
Print "Time: " + popMailDateTime$()
Print
Print 
Print "Subject: " + popMailSubject$()
Print 

mailtext$ = popMailText$()

i = 1
Repeat 
	Print stringausstring$(mailtext$, i, 0)
	i = i + 1 
Until Len(stringausstring$(mailtext$, i, 0)) = 1 And stringausstring$(mailtext$, i, 0) = "0"


; To do more things you must seemingly login again. Mysteriously...
;Print popAccountLogin$("pop3.xxx.de", "user", "pass")
;Print popMailDelete$(1)
;Print popAccountLogout$()

Else
Print "no new messages"
EndIf
Else
Print "connection failed"
EndIf
WaitKey()
End
;...................................................................


; SMTP-Mail-Sending is much easier:

; mailtext$ = "Bla... Blablah" + Chr$(0) + "Next line" + Chr$(0) + "end"

; Print smtpSendMail$(server$, to_name$, to_adress$, from_name$, from_adress$, subject$, mailtext$)

; Sometimes you must POP-Login first to send mail via SMTP (SMTP after POP)...

;----------------------------------------------------------------------------













; Extract Sendingtime from Mailheader
Function popMailDateTime$()
 For i = 1 To Len(mailzeilen$(4))
		If Mid(mailzeilen$(4), i, 1) = ";" Then
      For ii = i+7 To Len(mailzeilen$(4))
       If Mid(mailzeilen$(4), ii, 1) = " " Then leer = leer + 1
       If leer = 4 Then Return Mid(mailzeilen$(4), i+19, ii-(i+19)) 
		  Next
		EndIf
	Next
End Function

;**********************************************************************
; Extracts Sending-Time.
Function popMailDateDate$()
  For i = 1 To Len(mailzeilen$(4))
		If Mid(mailzeilen$(4), i, 1) = ";" Then
      For ii = i+7 To Len(mailzeilen$(4))
       If Mid(mailzeilen$(4), ii, 1) = " " Then leer = leer + 1
       If leer = 3 Then Return Mid(mailzeilen$(4), i+7, ii - (i+7)) 
		  Next
		EndIf
	Next
End Function

;**********************************************************************
; Get the Sending-Day in short version (Mon, Thu, ...)
Function popMailDateDay$()
	For i = 1 To Len(mailzeilen$(4))
		If Mid(mailzeilen$(4), i, 1) = ";" Then
      For ii = i+2 To i+5
				If Mid(mailzeilen$(4), ii, 1) = "," Then Return Mid(mailzeilen$(4), i+2, ii-(i+2))
		  Next
		EndIf
	Next	
End Function

;****************************************************************
; Get the IP-Adress from Sender.
Function popMailIP$()
	For i = 1 To Len(mailzeilen$(1))
		If Mid(mailzeilen$(1), i, 1) = "[" Then
			For ii = i+1 To Len(mailzeilen$(1))
				If Mid(mailzeilen$(1), ii, 1) = "]" Then
					Return Mid(mailzeilen$(1), i+1, ii - (i+1))
				EndIf
			Next
		EndIf
	Next
End Function

;*****************************************************************
; Gets Subject of mail.
Function popMailSubject$()
	For i = 1 To mailzeilen_anzahl
		If Mid(mailzeilen$(i), 1, 8) = "Subject:" Then Return Mid(mailzeilen$(i), 10, Len(mailzeilen$(i)) - 9)
	Next
End Function

;*******************************************************************
; Extracts the Mail Text
Function popMailText$()
	For i = 1 To mailzeilen_anzahl
		If mailzeilen$(i) = "" Then	
			For ii = i+1 To mailzeilen_anzahl-2
				If ii = mailzeilen_anzahl-2 Then
					message$ = message$ + mailzeilen$(ii)
				Else
					message$ = message$ + mailzeilen$(ii) + Chr$(0)
				EndIf
			Next
			Return message$
		EndIf
  Next
End Function

;**********************************************************************
; Extracts Sendername and Adress from Mail-Header
; In Form : "Name" and "nickname@xxx.com"
Function popMailFrom$()
For i = 1 To mailzeilen_anzahl
	If Mid(mailzeilen$(i), 1, 5) = "From:" Then
    ; Extracting the string with both Names
    For ii = 7 To Len(mailzeilen$(i))
      If Mid(mailzeilen$(i), ii, 1) = ">" Then
        from$ = Mid(mailzeilen$(i), 7, Len(mailzeilen$(i)) - 6)
        Exit
      EndIf
    Next
    For ii = 1 To Len(from$)
      If Mid(from$, ii, 1) = " " Then
        name$ = Mid(from$, 1, ii-1)
        email$ = Mid(from$, ii+2, Len(from$)- (ii+2))
        Return name$ + Chr$(0) + email$
      EndIf
    Next
  EndIf
Next
End Function

; *************************************************************************
; Recieves the mail an stores it in the mailzeilen$()-Array
Function popMailReceive$(nummer)
mailzeilen_anzahl = 0
WriteLine com, "RETR " + nummer
i$ = ReadLine(com)
If Mid(i$, 1, 1) = "-" Then
  Return "-ERR no such mail"
Else
  Repeat
    mailzeilen_anzahl = mailzeilen_anzahl + 1
    WriteLine com, Chr$(28) ; Recieve new line with 'Return'
    i$ = ReadLine(com)
    If Mid(i$, 1, 1) = "." And Len(i$) = 1 Then
      message$ = message$ + i$
    Else
      message$ = message$ + i$ + Chr$(0); Save the whole message in a string which is divided by chr$(0).
    EndIf
  Until Mid(i$, 1, 1) = "." And Len(i$) = 1
  ; redDim the mailzeilen$()-Array
  Dim mailzeilen$(mailzeilen_anzahl)  
  ; parse through the message and save every new line in mailzeilen$()
  For z = 1 To mailzeilen_anzahl
  mailzeilen$(z) = stringausstring$(message$, z, 0)
  Next 
EndIf 
End Function

;***************************************************************************
; Deletes a mail. To delete it really you must Logout.
Function popMailDelete$(mailnummer)
	WriteLine com, "DELE " + mailnummer ; Send Mail-Delete-commando
	r$ = ReadLine(com) ; get returning-line
	If Mid(r$, 1, 3) = "+OK" Then Return "+OK mail was deleted successful"
	If Mid(r$, 1, 4) = "-ERR" Then Return "-ERR mail could not be deleted"
End Function

; *************************************************************************
; Returns the Number and bigness of all meils in the account
Function popAccountStat$()
WriteLine com, "STAT"
i$ = ReadLine(com)
If Mid(i$, 1, 1) = "-" Then
  Return "-ERR no new messages"
Else
  For z = 5 To Len(i$)
    If Mid(i$, z, 1) = " " Then
      anzahl$ = Mid(i$, 5, z-5)
      groesse$ = Mid(i$, z+1, Len(i$))
      Return anzahl$ + "," + groesse$
    EndIf
  Next   
EndIf
End Function

; **************************************************************************
; Connect and login
Function popAccountLogin$(server$, user$, pass$)
com = OpenTCPStream(server$, 110)
If com = 0 Then
  Return "-ERR connection failed"
Else
  i$ = ReadLine(com) ; Intercept the greeting
  WriteLine com, "USER " + user$
  i$ = ReadLine(com)
  If Mid(i$, 1, 1) = "-" Then
    Return "-ERR no such user"  
  Else
    WriteLine com, "PASS " + pass$
    i$ = ReadLine(com)
    If Mid(i$, 1, 1) = "-" Then
      Return "-ERR password wrong"
    Else
      Return "+OK logged in   
    EndIf
  EndIf
EndIf
End Function

;*******************************************************************************
; Disconnect from server. After that the mails get really deleted
Function popAccountLogout$()
	WriteLine com, "QUIT" ; Disconnect-Commando
	r$ = ReadLine(com) ; Get Returnstring
	If Mid(r$, 1, 3) = "+OK" Then Return "+OK disconnected"
	If Mid(r$, 1, 4) = "-ERR" Then Return "-ERR not disconnected. waaah!"
End Function


;********************************************************************************
; Sending a mail with smtp and Error-handling. Much shorter than BlitzMail Deluxe ^_^
Function smtpSendMail$(server$, an_name$, an_adresse$, von_name$, von_adresse$, subject$, mailtext$)
	com2 = OpenTCPStream(server$ ,25)
	If com2 = 0 Then
		Return "-ERR smtp connection failed"
	Else
		s$ = ReadLine(com) ; Die Begrüßung abfangen
		WriteLine com2, "HELO R-Mail"
  	s$ = ReadLine(com2)
		If Mid(s$, 1, 3) <> "250" Then
		  Return "-ERR HELO failed"
		Else
		  WriteLine com2, "MAIL FROM: " + von_adresse$
		  s$ = ReadLine(com)
  	  If Mid(s$, 1, 3) <> "250" Then
		    If Mid(s$, 1, 3) = "501" Then
		      Return "-ERR use POP-login first"
		    Else
		      Return "-ERR MAIL FROM failed"
        EndIf
		  Else
		    WriteLine com2, "RCPT TO: " + an_adresse$
		    s$ = ReadLine(com2)
		    If Mid(s$, 1, 3) <> "250" Then
		      Return "-ERR RCPT TO failed"
		    Else
		      WriteLine com2, "DATA"
		      s$ = ReadLine(com2)
		      If Mid(s$, 1, 3) <> "354" Then
		        Return "DATA failed"
		      Else
		        WriteLine com2, "Date: " + CurrentDate$ ()
		        WriteLine com2, "From: " + von_name$ + " <" + von_adresse$ + ">"
    		    WriteLine com2, "To: " + an_name$ + " <" + an_adresse$ + ">"
        		WriteLine com2, "Subject: " + subject$
        		WriteLine com2, "X-Mailer: R-Mail"
		        i = 1
						Repeat 
							WriteLine com2, stringausstring$(mailtext$, i, 0)
							i = i + 1 
						Until Len(stringausstring$(mailtext$, i, 0)) = 1 And stringausstring$(mailtext$, i, 0) = "0"
			      WriteLine com2, ""
			      WriteLine com2, "."
			      s$ = ReadLine(com2)
			      If Mid(s$, 1, 3) <> "250" Then
		  	      Return "SendMail failed"
		    	  Else
		     	    WriteLine com2, "QUIT" 
		    	      s$ = ReadLine(com2)
		   	      If Mid(s$, 1, 3) <> "221" Then
		  	        Return "Mail delivery failed"   
		  	      Else
		  	        CloseTCPStream(com2)
		  	        Return "+OK mail delivered"
		  	      EndIf 
	 	   	    EndIf  
		      EndIf  
		    EndIf    
		  EndIf       
		EndIf         
	EndIf	    
End Function

;...............................................................................

; String-Functions


; extracts Numbers that are stored within a string, divided by commas...
 Function zahlausstring(zahlstring$, stelle)
	anzahl = 1 
	letzteskomma = 1 
	For i = 1 To Len(zahlstring$)
		If Mid(zahlstring$, i, 1) = "," Or i = Len(zahlstring$) Then 
			If anzahl = stelle Then zahl = Mid(zahlstring$, letzteskomma, i) 
			letzteskomma = i+1 
			anzahl = anzahl + 1
		EndIf
	Next
	Return zahl 
End Function



; Extracts a string from an big string ("string1|string2|string2")
 Function stringausstring$(s$, stelle, trenncode)
	anzahl = 1 
	letzteskomma = 1 
	For i = 1 To Len(s$)
		If Asc(Mid(s$, i, 1)) = trenncode Or i = Len(s$) Then 
			If anzahl = stelle Then 
				s2$ = Mid(s$, letzteskomma, i-letzteskomma) 
				If i = Len(s$) Then s2$ = Mid(s$, letzteskomma, i-(letzteskomma-1)) 
			  If Len(Mid(s$,letzteskomma,i-letzteskomma)) = 1 Then s2$ = Chr$(0)
			EndIf
			letzteskomma = i+1
			anzahl = anzahl + 1
		EndIf
	Next
	If stelle > (anzahl-1) Then Return "0"
	Return s2$
End Function


;----------------------------------------------------------------------------------
Comments

None.

Code Archives Forum