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