BASIC MultiPart

BASIC Code to send a Multi Part email containing default text, HTML and an image


An example in powerbasic

'****************************************************************************************
FUNCTION MultiPart( sSrvr      AS STRING,_
                         sUser      AS STRING,_
                         sPass      AS STRING,_
                         sFrom      AS STRING,_
                         sTo        AS STRING,_
                         sMailDate  AS STRING,_   
                         sSubject   AS STRING,_
                         sTextBody  AS STRING,_ 
                         sHTMLBody  AS STRING,_ 
                         sMIMEFile  AS STRING,_  
                         sFileName  AS STRING,_
                         sRet       AS STRING ) AS LONG

' Each line of characters must be no more than 1000 chars (including the CRLF)
' Single Quote is equivelent to Double Quote only in the HTML file (sFileName)
                 
  LOCAL i AS LONG
  LOCAL sBody, sFileType AS STRING
                          

    i = INSTR(-1, sFileName, ".")
    sFileType = RIGHT$(sFileName, -i) '   
    IF i = 0 OR INSTR(sFileName, ANY"/\*") THEN
      sRet = "ERROR: SendMultipart() Bad FileName"  
      FUNCTION = -5
      EXIT FUNCTION   
    END IF

    IF LEN(sMailDate) THEN sBody = "Date: " + sMailDate             + $CRLF

    sBody = sBody + "From: "    + sFrom                             + $CRLF
    sBody = sBody + "To: "      + sTo                               + $CRLF
    sBody = sBody + "Subject: " + sSubject                          + $CRLF
    sBody = sBody + "MIME-Version: 1.0"                             + $CRLF

    sBody = sBody + "Content-TYPE: multipart/mixed; boundary="+$DQ+ _
                    "----=_Part_143153_16168498.1228041684669"+$DQ  + $CRLF
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator 

    sBody = sBody + "------=_Part_143153_16168498.1228041684669"    + $CRLF
    sBody = sBody + "Content-TYPE: multipart/alternative; boundary="+$DQ  _
                  +"----=_Part_143151_18856144.1228041684669"+$DQ   + $CRLF
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator 

    sBody = sBody + "------=_Part_143151_18856144.1228041684669"    + $CRLF
    sBody = sBody + "Content-TYPE: text/plain; charset=ISO-8859-1"  + $CRLF
    sBody = sBody + "Content-Transfer-Encoding: 7bit"               + $CRLF  ' VIP        
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator   

    sBody = sBody + sTextBody                                       + $CRLF  ' Text Message
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator 


    sBody = sBody + "------=_Part_143151_18856144.1228041684669"    + $CRLF            
    sBody = sBody + "Content-TYPE: multipart/related; boundary="+$DQ _
                  + "----=_Part_143152_27170728.1228041684669"  +$DQ+ $CRLF
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator 
                                              
    sBody = sBody + "------=_Part_143152_27170728.1228041684669"    + $CRLF            
    sBody = sBody + "Content-TYPE: text/html"                       + $CRLF                               
    sBody = sBody + "Content-Transfer-Encoding: 7bit"               + $CRLF  
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator 
                          
    sBody = sBody + sHTMLBody                                       + $CRLF  ' HTML part
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator 
                         
    sBody = sBody + "------=_Part_143152_27170728.1228041684669"    + $CRLF
    sBody = sBody + "Content-Type: image/"+sFileType                + $CRLF
    sBody = sBody + "Content-Transfer-Encoding: base64"             + $CRLF  
    sBody = sBody + "Content-ID: "+sFileName                        + $CRLF
    sBody = sBody + "Content-Disposition: inline"                   + $CRLF
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator

    sBody = sBody + sMIMEFile                                       + $CRLF  ' Mime Encoded file
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator

    sBody = sBody + "------=_Part_143152_27170728.1228041684669-- " + $CRLF 
    sBody = sBody + "                                             " + $CRLF
    sBody = sBody + "------=_Part_143151_18856144.1228041684669-- " + $CRLF
    sBody = sBody + "                                             " + $CRLF
    sBody = sBody + "------=_Part_143153_16168498.1228041684669-- " + $CRLF
    sBody = sBody + ""                                              + $CRLF  ' VIP seperator

  FUNCTION = SMTPTLS( sSrvr, sUser, sPass, sFrom, sTo, sBody, sRet )      

END FUNCTION 

'****************************************************************************************
FUNCTION WINMAIN()
        
  LOCAL RetVal, TableWidth, hFile, fSize AS LONG
  LOCAL sSubject, sTextBody, sHTML, sFile, sMIMEFile, sFileType, sFileName, sRet AS STRING

hDbg = FREEFILE : OPEN $DEBUG_FILE FOR OUTPUT LOCK SHARED AS hDbg '
PRINT #hDbg, "--------  "+DATE$+"  "+TIME$+"  ---------" 

    sSubject  = "Gmail Encrypted Multi-Part MIME"

    sTextBody = "Hello John," +$CRLF + $CRLF
    sTextBody = sTextBody + "Your question has now been answered:"+$CRLF        
    sTextBody = sTextBody + "http://stackoverflow.com/"+$CRLF+$CRLF 
    sTextBody = sTextBody + "The Question ID is: 555985575"+$CRLF
    sTextBody = sTextBody + "(Please make note of it)"+$CRLF
    sTextBody = sTextBody + $CRLF + $CRLF
    sTextBody = sTextBody + "DO NOT REPLY to this email! It was sent from an automated"+$CRLF 
    sTextBody = sTextBody + "system that that cannot accept incoming e-mail."+$CRLF + $CRLF


    sFileName  = "bear.gif"
    hFile = FREEFILE '
    OPEN sFileName FOR BINARY SHARED AS hFile
      IF ERR THEN
        PRINT #hDbg, "Unable to open: "+sFileName+" Error="+STR$(ERRCLEAR)
        EXIT FUNCTION
      END IF 
      fSize = LOF(hFile)
      GET$ hFile, fSize, sFile ' read the whole file into a string
    CLOSE hFile 
    TableWidth  = 80
    CALL Encode_BASE64( sFile, (TableWidth-4)\3, sMIMEFile ) ' Encode the file data in Base64
                        

    sHTML =         "<HTML>"+$CRLF                                                                                                           
    sHTML = sHTML + "<BODY BGCOLOR='#49ecea'>"+$CRLF ' A Table will wrap the lines of text for you                                                                                       
    sHTML = sHTML + "<bgcolor='#49ecea' width='"+STR$(TableWidth)+"' border='0' bordercolor='#C9C9A1' cellpadding='0' cellspacing='0'>"+$CRLF
    sHTML = sHTML + "<tr><td><CENTER>"+$CRLF                                                                                                 
    sHTML = sHTML + "<IMG SRC='cid:"+sFileName+"' alt='Product Logo'>"+$CRLF                                                                      
    sHTML = sHTML + "</CENTER></td></tr>"+$CRLF                                                                                              
    sHTML = sHTML + "<tr><td style='padding:10px'>"+$CRLF ' Indent slightly                                                                  
    sHTML = sHTML + "<SPAN style='font-size:14px;'>"+$CRLF                                                                                   
    sHTML = sHTML + "<PRE>"+$CRLF ' Show text as formatted
                       
    sHTML = sHTML + "Hello John," + $CRLF + $CRLF 
    sHTML = sHTML + "Your question has now been answered <a href=http://stackoverflow.com/>Download</a>"+$CRLF+$CRLF
    sHTML = sHTML + "The Question ID is: "
    sHTML = sHTML + "<SPAN style='background-color: #FFFF00'>555985575</SPAN>"+$CRLF
    sHTML = sHTML + "(Please make note of it)"+$CRLF                  
    sHTML = sHTML + $CRLF + $CRLF
    sHTML = sHTML + "DO NOT REPLY to this email! It was sent from an automated"+$CRLF 
    sHTML = sHTML + "system that that cannot accept incoming e-mail."+$CRLF + $CRLF

    sHTML = sHTML + "</PRE>"+$CRLF ' Show text as formatted                                                                     
    sHTML = sHTML + "</SPAN></PRE></BODY></HTML>"+$CRLF    
    '==============
       

    RetVal = MultiPart( "smtp.gmail.com", $UserName, $Password, $MailFrom, $MailTo, MailDate(),_
                             sSubject, sTextBody, sHTML, sMIMEFile, sFileName, sRet )
      
    IF RetVal < 0 THEN PRINT #hDbg, "ERROR: " + sRet

CLOSE #hDbg

  MSGBOX sRet,64,"DONE"
        
END FUNCTION  

'****************************************************************************************



Comments