vfp_roaauto/COMUN/programe/sendmail.prg

PROCEDURE lansez_salvare_mail
LPARAMETERS aryAttach,lcSubiect,lcBody

PRIVATE pcAdresa,pcServer,pcUser,pcPass,pnPort,pcAdresad,pcBody,pcSubiect
STORE [] to pcAdresa,pcServer,pcUser,pcPass,pcAdresad,pcBody,pcSubiect
IF !EMPTY(lcSubiect)
	pcSubiect = lcSubiect
ENDIF 

STORE 25 TO pnPort
lcSql = [select adresa_expeditor,server_mail,user_mail,pass_mail,port from sal_nom_expeditori]
lcCursor = [v_exp]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
IF lnSucces < 0
	MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
	RETURN
ENDIF
lcSql=[select adresa_destinatar from sal_nom_destinatari]
lcCursor=[v_dest]
lnSucces=goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
IF lnSucces < 0
	MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
	RETURN
ENDIF
lotrimitmail = CREATEOBJECT('frm_trimit_mail')
lotrimitmail.show(1)
ENDPROC
************************************************
PROCEDURE adauga_expeditor
LPARAMETERS tcadresa_expeditor,tcserver_mail,tcuser_mail,tcpass_mail,tnPort

lcSql = [begin pack_sal_declaratii.adaugare_expeditor(']+ALLTRIM(tcadresa_expeditor)+[',']+ALLTRIM(tcserver_mail)+[',']+ALLTRIM(tcuser_mail)+[',']+ALLTRIM(tcpass_mail)+[',]+ALLTRIM(STR(tnport))+[); end;]
lnSucces = goExecutor.oExecute(lcSql)
goExecutor.oReset()
IF lnSucces < 0
	MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
	RETURN
ENDIF
ENDPROC
*******************************************
PROCEDURE adauga_destinatar
LPARAMETERS tcadresa_destinatar

lcSql = [begin pack_sal_declaratii.adaugare_destinatar(']+ALLTRIM(tcadresa_destinatar)+['); end;]
lnSucces = goExecutor.oExecute(lcSql)
goExecutor.oReset()
IF lnSucces < 0
	MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
	RETURN
ENDIF
ENDPROC
****************************************
PROCEDURE SendViaBLAT(tcReturn, tcFrom, tcTo, tcSubject, tcBody, taFiles, tcCC, tcBCC, tcMailServer, tnPort, tcUserName, tcPassword, tnPriority, tlHTMLFormat)
*******************************************
 LOCAL lcBlatParam, lcBodyFile, lnCountAttachments, lnResult, loError as Exception
 
 lcBodyFile = ""
 
 TRY
  *!* Include full path in Declare, such as "C:\Blat240\full\blat.dll"
  *!* or make sure that blat.dll is included in the system's PATH variable
  DECLARE INTEGER Send IN "D:\ROA_TRUNK\ROADECL\blat.dll" STRING cParam
  
  lcBodyFile = ADDBS(SYS(2023)) + SYS(2015) + ".txt"
  STRTOFILE(tcBody, lcBodyFile, 0) && body is placed in a text file to be sent by BLAT
  
  lcBlatParam = GetShortPath(lcBodyFile)
  lcBlatParam = lcBodyFile
  IF TYPE("tcTo") = "C"
    lcBlatParam = lcBlatParam + " -to " + ALLTRIM(tcTo)
  ENDIF
  IF TYPE("tcFrom") = "C"
    lcBlatParam = lcBlatParam + " -f " + ALLTRIM(tcFrom)
  ENDIF
  IF TYPE("tcCC") = "C"
    lcBlatParam = lcBlatParam + " -cc " + ALLTRIM(tcCC)
  ENDIF
  IF TYPE("tcBCC") = "C" and !empty(tcBCC) 
    lcBlatParam = lcBlatParam + " -bcc " + ALLTRIM(tcBCC)
  ENDIF
  IF TYPE("tcSubject") = "C"
    lcBlatParam = lcBlatParam + [ -s "] + ALLTRIM(tcSubject) + ["]
  ENDIF
  IF TYPE("tcMailserver") = "C"
    lcBlatParam = lcBlatParam + " -server " + ALLTRIM(tcMailserver)
  ENDIF
  IF TYPE("tnPort") = "N"
    lcBlatParam = lcBlatParam + ":" + TRANSFORM(tnPort)
  ENDIF
  IF TYPE("tcUsername") = "C"
    lcBlatParam = lcBlatParam + " -u " + ALLTRIM(tcUsername)
  ENDIF
  IF TYPE("tcPassword") = "C"
    lcBlatParam = lcBlatParam + " -pw " + ALLTRIM(tcPassword)
  ENDIF
  IF TYPE("tnPriority") = "N" AND BETWEEN(tnPriority, 0, 1)
    lcBlatParam = lcBlatParam + " -priority " + TRANSFORM(tnPriority)
  ENDIF
  IF TYPE("tlHTMLFormat") = "L" AND tlHTMLFormat
    lcBlatParam = lcBlatParam + " -html"
  ENDIF

  IF TYPE("taFiles", 1) = "A"
    lcBlatParam = lcBlatParam + " -attach "
   FOR lnCountAttachments = 1 TO ALEN(taFiles)
     lcBlatParam = lcBlatParam + GetShortPath(ALLTRIM(taFiles(lnCountAttachments))) + ","
   ENDFOR
   lcBlatParam = LEFT(lcBlatParam, LEN(lcBlatParam) - 1) && Remove Extra Comma
  ENDIF

  lnResult = Send(ALLTRIM(lcBlatParam))
  
  IF lnResult != 0
   DO CASE
    CASE lnResult = -2
     THROW "The server actively denied our connection./The mail server doesn't like the sender name. "
    CASE lnResult = -1
     THROW "Unable to open SMTP socket" OR ;
       "SMTP get line did not return 220" OR ;
       "command unable to write to socket" OR ;
       "Server does not like To: address" OR ;
       "Mail server error accepting message data."
    CASE lnResult = 1
     THROW "File name (message text) not given" OR ;
       "Bad argument given"
    CASE lnResult = 2
     THROW "File (message text) does not exist"
    CASE lnResult = 3
     THROW "Error reading the file (message text) or attached file"
    CASE lnResult = 4
     THROW "File (message text) not of type FILE_TYPE_DISK "
    CASE lnResult = 5
     THROW "Error Reading File (message text)"
    CASE lnResult = 12
     THROW "-server or -f options not specified and not found in registry"
    CASE lnResult = 13
     THROW "Error opening temporary file in temp directory"
    OTHERWISE
     THROW "Unknown Error"
   ENDCASE
  ENDIF

 CATCH TO loError
  tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
   [LineNo: ] + STR(loError.LINENO) + CHR(13) + ;
   [Message: ] + loError.MESSAGE + CHR(13) + ;
   [Procedure: ] + loError.PROCEDURE + CHR(13) + ;
   [Details: ] + loError.DETAILS + CHR(13) + ;
   [StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;
   [LineContents: ] + loError.LINECONTENTS
 FINALLY
  CLEAR DLLS "Send"
  IF FILE(lcBodyFile)
   ERASE (lcBodyFile)
  ENDIF
 ENDTRY
ENDPROC

****************************************
Function GetShortPath
****************************************
 LPARAMETERS lcFileName
 LOCAL lnReturn, lcBuffer

 Declare Integer GetShortPathNameA In Win32API As GetShortPathName String, String, Integer

 lcBuffer = SPACE(255)
 lnReturn= GetShortPathName(lcFileName, @lcBuffer, 255)

 Clear Dlls "GetShortPathName"
 
 Return (Left(lcBuffer, lnReturn))
ENDFUNC