2009-10-12 18:24 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

* contrib/hbtip/encqp.prg + Implemented quoted-printable encoder/decoder. Not yet used. Not extremely well tested, just something to start with. Please review. Probably should be done in C for speed, but anyway. * contrib/hbtip/sendmail.prg * contrib/hbtip/mail.prg + Added 'charset' property and setting hb_sendmail(). Not yet effective, as Harbour uses 7-bit encoding yet. * utils/hbmk2/examples/hmg.hbc * Updated HMG hbmk2 config file with some extra tricks.
2009-10-12 16:25:28 +00:00
parent 1db202323b
commit c400f79d5a
5 changed files with 86 additions and 10 deletions
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -17,6 +17,21 @@
   past entries belonging to author(s): Viktor Szakats.
 */

+2009-10-12 18:24 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
+  * contrib/hbtip/encqp.prg
+    + Implemented quoted-printable encoder/decoder.
+      Not yet used. Not extremely well tested, just something 
+      to start with. Please review. Probably should be done 
+      in C for speed, but anyway.
+
+  * contrib/hbtip/sendmail.prg
+  * contrib/hbtip/mail.prg
+    + Added 'charset' property and setting hb_sendmail().
+      Not yet effective, as Harbour uses 7-bit encoding yet.
+
+  * utils/hbmk2/examples/hmg.hbc
+    * Updated HMG hbmk2 config file with some extra tricks.
+
 2009-10-12 06:01 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
  * contrib/hbssl/evpciph.c
  * contrib/hbssl/evpmd.c
--- a/harbour/contrib/hbtip/encqp.prg
+++ b/harbour/contrib/hbtip/encqp.prg
@@ -3,10 +3,10 @@
 */

 /*
- * xHarbour Project source code:
- * TIP Class oriented Internet protocol library
+ * Harbour Project source code:
+ * TIP quoted-printable encoder/decoder class
 *
- * Copyright 2003 Giancarlo Niccolai <gian@niccolai.ws>
+ * Copyright 2009 Viktor Szakats (harbour.01 syenar.hu)
 * www - http://www.harbour-project.org
 *
 * This program is free software; you can redistribute it and/or modify
@@ -61,3 +61,52 @@ ENDCLASS
 METHOD New() CLASS TIPEncoderQP
   ::cName := "Quoted-Printable"
   RETURN Self
+
+METHOD Encode( cData ) CLASS TIPEncoderQP
+   LOCAL c
+   LOCAL cString := ""
+   LOCAL nLineLen := 0
+
+   FOR EACH c IN cData
+      IF c == Chr( 13 )
+         cString += Chr( 13 ) + Chr( 10 )
+         nLineLen := 0
+      ELSEIF Asc( c ) > 127 .OR. ;
+         c == "=" .OR. ;
+         ( Asc( c ) < 32 .AND. !( c $ Chr( 13 ) + Chr( 10 ) + Chr( 9 ) ) ) .OR. ;
+         ( c $ " " + Chr( 9 ) .AND. SubStr( cData, c:__enumIndex() + 1 ) $ Chr( 13 ) + Chr( 10 ) )
+         IF nLineLen + 3 > 76
+            cString += "=" + Chr( 13 ) + Chr( 10 )
+            nLineLen := 0
+         ENDIF
+         cString += "=" + hb_NumToHex( Asc( c ), 2 )
+         nLineLen += 3
+      ELSEIF !( c == Chr( 10 ) )
+         cString += c
+         nLineLen += 1
+      ENDIF
+   NEXT
+
+   RETURN cString
+
+METHOD Decode( cData ) CLASS TIPEncoderQP
+   LOCAL tmp
+   LOCAL c
+   LOCAL nLen
+   LOCAL cString := ""
+
+   /* delete soft line break. */
+   cData := StrTran( cData, "=" + Chr( 13 ) + Chr( 10 ) )
+
+   nLen := Len( cData )
+   FOR tmp := 1 TO nLen
+      c := SubStr( cData, tmp, 1 )
+      IF c == "=" .AND. Len( SubStr( cData, tmp + 1, 2 ) ) == 2
+         cString += Chr( hb_HexToNum( SubStr( cData, tmp + 1, 2 ) ) )
+         tmp += 2
+      ELSE
+         cString += c
+      ENDIF
+   NEXT
+
+   RETURN cString
--- a/harbour/contrib/hbtip/mail.prg
+++ b/harbour/contrib/hbtip/mail.prg
@@ -87,6 +87,7 @@ CREATE CLASS TipMail
   METHOD GetFieldOption( cField )
   METHOD SetFieldPart( cField, cValue )
   METHOD SetFieldOption( cField, cValue )
+   METHOD SetCharset( cCharset ) INLINE ::cCharset := iif( ISCHARACTER( cCharset ), cCharset, "ISO-8859-1" )

   METHOD GetContentType() INLINE ::GetFieldPart( "Content-Type" )
   METHOD GetCharEncoding() INLINE ::GetFieldOption( "Content-Type", "encoding" )
@@ -114,6 +115,7 @@ CREATE CLASS TipMail
   VAR oEncoder
   VAR aAttachments
   VAR nAttachPos   INIT 1
+   VAR cCharset

 ENDCLASS

@@ -131,6 +133,8 @@ METHOD New( cBody, oEncoder ) CLASS TipMail
      ::setBody( cBody )
   ENDIF

+   ::SetCharset()
+
   RETURN Self

 METHOD SetEncoder( cEnc ) CLASS TipMail
@@ -346,7 +350,7 @@ METHOD ToString() CLASS TipMail
      ELSE
         //GD - if there are attachements the body of the message has to be treated as an attachment.
         cRet += "--" + cBoundary + e"\r\n"
-         cRet += "Content-Type: text/plain; charset=ISO-8859-1; format=flowed" + e"\r\n"
+         cRet += "Content-Type: text/plain; charset=" + ::cCharset + "; format=flowed" + e"\r\n"
         cRet += "Content-Transfer-Encoding: 7bit" + e"\r\n"
         cRet += "Content-Disposition: inline" + e"\r\n" + e"\r\n"
         cRet += ::cBody + e"\r\n"
--- a/harbour/contrib/hbtip/sendmail.prg
+++ b/harbour/contrib/hbtip/sendmail.prg
@@ -55,7 +55,7 @@

 #translate ( <exp1> LIKE <exp2> )   => ( hb_regexLike( (<exp2>), (<exp1>) ) )

-FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aFiles, cUser, cPass, cPopServer, nPriority, lRead, bTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo, lTLS, cSMTPPass )
+FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aFiles, cUser, cPass, cPopServer, nPriority, lRead, bTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo, lTLS, cSMTPPass, cCharset )
   /*
   cServer    -> Required. IP or domain name of the mail server
   nPort      -> Optional. Port used my email server
@@ -134,6 +134,9 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
   IF ! ISCHARACTER( cSMTPPass )
      cSMTPPass := cPass
   ENDIF
+   IF ! ISCHARACTER( cCharset )
+      cCharset := "ISO-8859-1"
+   ENDIF

   cUser := StrTran( cUser, "@", "&at;" )

@@ -228,12 +231,14 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF

   oMail := tipMail():new()
   oMail:SetEncoder( "7bit" )
+   oMail:SetCharset( cCharset )
   IF ! Empty( aFiles )
      oAttach := tipMail():new()
      oAttach:SetEncoder( "7bit" )
+      oAttach:SetCharset( cCharset )

      IF ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody )
-         cMimeText := "text/html; charset=ISO-8859-1"
+         cMimeText := "text/html; charset=" + cCharset
         oAttach:hHeaders[ "Content-Type" ] := cMimeText
         cBodyTemp := cBody
         cBody     := MemoRead( cBodyTemp ) + Chr( 13 ) + Chr( 10 )
@@ -244,7 +249,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
      oMail:Attach( oAttach )
   ELSE
      IF ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody )
-         cMimeText := "text/html ; charset=ISO-8859-1"
+         cMimeText := "text/html ; charset=" + cCharset
         oMail:hHeaders[ "Content-Type" ] := cMimeText
         cBodyTemp := cBody
         cBody     := MemoRead( cBodyTemp ) + Chr( 13 ) + Chr( 10 )
@@ -388,6 +393,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
      cData += Chr( 13 ) + Chr( 10 )

      oAttach := TipMail():New()
+      oAttach:SetCharset( cCharset )

      hb_FNameSplit( cFile,, @cFname, @cFext )
      cFile := Lower( cFile )
@@ -427,7 +433,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
      // Some EMAIL readers use Content-Type to check for filename

      IF ".html" $ Lower( cFext ) .OR. ".htm" $ Lower( cFext )
-         cMimeText += "; charset=ISO-8859-1"
+         cMimeText += "; charset=" + cCharset
      ENDIF

      oAttach:hHeaders[ "Content-Type" ] := cMimeText
--- a/harbour/utils/hbmk2/examples/hmg.hbc
+++ b/harbour/utils/hbmk2/examples/hmg.hbc
@@ -4,10 +4,12 @@

 # Copy this file to hmg root dir and include it in hbmk2
 # command line to build an app:
-# > hbmk2 -hb10 test.prg C:\hmg\hmg.hbc
+# > hbmk2 test.prg C:\hmg\hmg.hbc

 {win}incpaths=include
-{win}libpaths=lib harbour\lib
+{win}libpaths=lib
+{win}sources=${hb_curdir}*.rc
+{win}sources=resources\minigui.rc

 {win}gt=gtgui