Import initial din SVN ROAAUTO/Trunk @HEAD
This commit is contained in:
175
COMUN/programe/sendmail.prg
Normal file
175
COMUN/programe/sendmail.prg
Normal file
@@ -0,0 +1,175 @@
|
||||
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
|
||||
Reference in New Issue
Block a user