/*
 * Xailer source code:
 *
 * BlatMail.prg
 * XBlatMail() class
 *
 * Copyright 2007 José Luis Capel
 * Copyright 2007 José Lalín
 * Copyright 2007 Ignacio Ortiz de Zúñiga
 * Copyright 2007 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#include "Error.ch"
#include "BlatMail.ch"

//------------------------------------------------------------------------------

CLASS XBlatMail FROM TComponent

PUBLISHED:
   PROPERTY aReceipts         INIT {}  EDITOR PE_StringList
   PROPERTY aCC               INIT {}  EDITOR PE_StringList
   PROPERTY aBCC              INIT {}  EDITOR PE_StringList
   PROPERTY aAttachments      INIT {}  EDITOR PE_StringList
   PROPERTY cUser             INIT ""  EDITOR PE_ExtendedString
   PROPERTY cPassword         INIT ""
   PROPERTY cAddress          INIT ""  EDITOR PE_ExtendedString
   PROPERTY cSubject          INIT ""  EDITOR PE_ExtendedString
   PROPERTY cBody             INIT ""  EDITOR PE_ExtendedString
   PROPERTY cServer           INIT ""
   PROPERTY nPort             INIT 25
   PROPERTY nType             INIT btTEXT    VALUES btTEXT, btHTML
   PROPERTY nAttachAs         INIT baBINARY  VALUES baBINARY, baTEXT, baINLINETEXT
   PROPERTY nPriority         INIT bpNORMAL  VALUES bpNORMAL, bpLOW, bpHIGH
   PROPERTY nEncoding         INIT beNONE    VALUES beNONE, beBASE64, beUUENCODE
   PROPERTY lReceipt          INIT .F.
   PROPERTY cCharset          INIT "" //ISO-8859-1

   PROPERTY lUndisclosedRecipient   INIT .F.

   PROPERTY nAuth             INIT bmNONE VALUES bmNONE, bmAUTH, bmPOP3, bmIMAP
   PROPERTY nTimeout          INIT 0
   PROPERTY nTries            INIT 0
   PROPERTY cExtra            INIT ""

   EVENT OnError( oSender, nError ) // --> Nil

PUBLIC:
   DATA nLastError            INIT 0   READONLY
   DATA lLog                  INIT .F.
   DATA lInstalled            INIT .F. READONLY

   METHOD Create( oParent ) CONSTRUCTOR
   METHOD Destroy() // --> Nil

   METHOD Send() // --> lSuccess

   METHOD AddReceipt( cAddress ) // --> Nil
   METHOD AddCC( cAddress ) // --> Nil
   METHOD AddBCC( cAddress ) // --> Nil

   METHOD AsString( cString )

PROTECTED:
   DATA pfnSend
   DATA hLib

   METHOD Initialize()
   METHOD Uninitialize()
   METHOD SendMail()

ENDCLASS

//------------------------------------------------------------------------------

METHOD Create( oParent ) CLASS XBlatMail

   ::Super:Create()
   ::lInstalled := ::Initialize()

RETURN Self

//------------------------------------------------------------------------------

METHOD Destroy() CLASS XBlatMail

   ::Uninitialize()
   ::Super:Destroy()

RETURN Nil

//------------------------------------------------------------------------------

METHOD AddReceipt( cAddress ) CLASS XBlatMail

   IF ! Empty( cAddress )
      AAdd( ::aReceipts, cAddress )
   ENDIF

RETURN Nil

//--------------------------------------------------------------------------

METHOD AddCC( cAddress ) CLASS XBlatMail

   IF ! Empty( cAddress )
      AAdd( ::aCC, cAddress )
   ENDIF

RETURN Nil

//--------------------------------------------------------------------------

METHOD AddBCC( cAddress ) CLASS XBlatMail

   IF ! Empty( cAddress )
      AAdd( ::aBCC, cAddress )
   ENDIF

RETURN Nil

//--------------------------------------------------------------------------

METHOD Send() CLASS XBlatMail

//   LOCAL cInstall
   LOCAL cSend := ""
   LOCAL cTemp := ""

   IF ! ::lInstalled
      WITH OBJECT ErrorNew()
         :SubSystem   := "XAILER"
         :SubCode     := 0
         :Severity    := ES_ERROR
         :Description := "TBlatMail Invalid object (BLAT.DLL may be missing)"
         :Operation   := "TBlatMail:Send()"
         Eval( ErrorBlock(), :__WithObject() )
      END WITH
   ENDIF

//   cInstall := "-install " + ::cServer
//   cInstall += " " + ::cAddress
//   cInstall += " - "
//   cInstall += " " + AllTrim( Str( ::nPort, 5 ) ) + " "
//   cInstall += " - "
//   cInstall += " " + ::cUser
//   cInstall += " " + ::cPassword
//   cInstall += " -q"
//
//   ::SendMail( cInstall )

//   IF ::nLastError == 0

      cSend := ""
      cSend := "-server " + ::cServer
      cSend += " -port " + AllTrim( Str( ::nPort ) )
      IF ! Empty( ::cUser )
         cSend += " -f " + ::AsString( ::cUser )
      ENDIF

      IF ! Empty( ::cAddress )
         cSend += " -from " + ::AsString( ::cAddress )
      ENDIF

      AEval( ::aReceipts, {|cName| cTemp += ::AsString( cName ) + "," } )
      cSend += " -to " + SubStr( cTemp, 1, Len( cTemp ) - 1 )

      IF ! Empty( ::aCC )
         cTemp := ""
         AEval( ::aCC, {|cName| cTemp += ::AsString( cName ) + "," } )
         cSend += " -cc " + SubStr( cTemp, 1, Len( cTemp ) - 1 )
      ENDIF

      IF ! Empty( ::aBCC )
         cTemp := ""
         AEval( ::aBCC, {|cName| cTemp += ::AsString( cName ) + "," } )
         cSend += " -bcc " + SubStr( cTemp, 1, Len( cTemp ) - 1 )
      ENDIF

      IF ! Empty( ::cSubject )
         cSend += " -subject " + ::AsString( ::cSubject )
      ELSE
         cSend += " -ss"
      ENDIF

      DO CASE
         CASE ::nAuth == bmAUTH
            cSend += ' -u "' + ::cUser + '"'
            cSend += ' -pw "' + ::cPassword + '"'
         CASE ::nAuth == bmPOP3
            cSend += ' -pu "' + ::cUser + '"'
            cSend += ' -ppw "' + ::cPassword + '"'
         CASE ::nAuth == bmIMAP
            cSend += ' -iu "' + ::cUser + '"'
            cSend += ' -ipw "' + ::cPassword + '"'
      ENDCASE

      IF ::lReceipt
         cSend += " -r"
      ENDIF

      IF ::lUndisclosedRecipient
         cSend += " -ur"
      ENDIF

      IF ::nPriority != bpNORMAL
         cSend += " -priority " + AllTrim( Str( ::nPriority ) )
      ENDIF

      IF ::nEncoding == beBASE64
         cSend += " -base64"
      ELSEIF ::nEncoding == beUUENCODE
         cSend += " -uuencode"
      ENDIF

      IF ! Empty( ::aAttachments )

         SWITCH ::nAttachAs
            CASE baBINARY
               cSend += " -attach"
               EXIT
            CASE baTEXT
               cSend += " -attacht"
               EXIT
            CASE baINLINETEXT
               cSend += " -attachi"
               EXIT
            OTHERWISE
               cSend += " -attach"
         END

         cTemp := ""
         AEval( ::aAttachments, {|cFile| cTemp += Chr(34) + cFile + Chr(34) + "," } )
         cSend += " " + SubStr( cTemp, 1, Len( cTemp ) - 1 )
      ENDIF

      IF ::nType == btHTML
         cSend += " -html"
      ENDIF

      IF ! Empty( ::cBody )
         IF At( " ", ::cBody ) > 0
            cSend += ' -body "' + StrTran( ::cBody, Chr(34), "'" ) + '"'
         ELSE
            cSend += " -body " + ::cBody
         ENDIF
      ENDIF

      IF ::lLog
         cSend += " -log blat.log"
      ENDIF

      IF ! Empty( ::cCharset )
         cSend += " -charset " + ::cCharset
      ENDIF

      IF ! Empty( ::nTimeout )
         cSend += " -ti " + AllTrim( ToString( ::nTimeout ) )
      ENDIF

      IF ! Empty( ::nTries )
         cSend += " -try " + AllTrim( ToString( ::nTries ) )
      ENDIF

      IF ! Empty( ::cExtra )
         cSend += " " + ::cExtra
      ENDIF

      ::SendMail( cSend )

//   ENDIF

RETURN ::nLastError == 0

//--------------------------------------------------------------------------

METHOD AsString( cString ) CLASS XBlatMail

RETURN IIF( At( " ", cString ) == 0, cString, Chr(34) + cString + Chr(34) )

//--------------------------------------------------------------------------

#pragma BEGINDUMP

#include <windows.h>
#include <xailer.h>

typedef int (WINAPI * BLATSEND)( LPSTR );


//------------------------------------------------------------------------------

/*
Códigos de error:

   -100: No se encuentra o no se puede cargar Blat.dll
   -101: No se encuentra la función SendMail.

    -2: e"The server actively denied our connection.\nThe mail server doesn't like the sender name. "
    -1: e"Unable to open SMTP socket.\n" + ;
         "SMTP get line did not return 220.\n" + ;
         "Command unable to write to socket.\n" + ;
         "Server does not like To: address.\n" + ;
         "Mail server error accepting message data."
     0: "Ok."
     1: e"File name (message text) not given.\nBad argument given."
     2: "File (message text) does not exist."
     3: "Error reading the file (message text) or attached file."
     4: "File (message text) not of type FILE_TYPE_DISK."
     5: "Error Reading File (message text)."
    12: "-server or -f options not specified and not found in registry."
    13: "Error opening temporary file in temp directory."
*/

HB_FUNC_STATIC( XBLATMAIL_INITIALIZE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINSTANCE hBlat;
   HINSTANCE hLib = (HINSTANCE) XA_ObjGetNL( Self, "hLib" );
   BLATSEND fnSend;
   BOOL bSuccess = FALSE;

   if( hLib < (HINSTANCE) 32 )
   {
      hBlat = LoadLibrary( "Blat.dll" );

      if( hBlat == NULL )
      {
         XA_ObjSendNL( Self, "_nLastError", -100 );
         XA_ObjSendNL( Self, "OnError", -100 );   // No inicializado
      }
      else
      {
         XA_ObjSendNL( Self, "_hLib", (LONG) hBlat );
         fnSend  = (BLATSEND) GetProcAddress( hBlat, "Send" );
         if( fnSend )
         {
            XA_ObjSendNL( Self, "_pfnSend", (LONG) fnSend );
            bSuccess = TRUE;
         }
         else
         {
            XA_ObjSendNL( Self, "_nLastError", -101 );
            XA_ObjSendNL( Self, "OnError", -101 );
         }
      }
   }

   hb_retl( bSuccess );
}

//------------------------------------------------------------------------------

HB_FUNC_STATIC( XBLATMAIL_UNINITIALIZE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINSTANCE hLib = (HINSTANCE) XA_ObjGetNL( Self, "hLib" );

   if( hLib >= (HINSTANCE) 32 )
   {
      FreeLibrary( hLib );
      XA_ObjSendNL( Self, "_hLib", 0 );
      XA_ObjSendNL( Self, "_pfnSend", 0 );
   }
}

//------------------------------------------------------------------------------

HB_FUNC_STATIC( XBLATMAIL_SENDMAIL )
{
   if( HB_ISCHAR( 1 ) )
   {
      PHB_ITEM Self = hb_stackSelfItem();
      BLATSEND fnSend = (BLATSEND) XA_ObjGetNL( Self, "pfnSend" );
      char * cLine = (LPSTR) hb_parc( 1 );
      int nResult;

      nResult = (fnSend)( cLine );
      XA_ObjSendNL( Self, "_nLastError", nResult );
      XA_ObjSendNL( Self, "OnError", nResult );
   }
}

#pragma ENDDUMP

//------------------------------------------------------------------------------