vfp_roaauto/COMUN/programe/blat.prg

*!* 23.06.2014
*!* marius.mutu
*!* SendViaBlat: Am pus calea copleta catre blat.dll

*******************************
*!* Example of using SendViaBLAT
*******************************
#Define PRIORITYHIGH 1
#Define PRIORITYLOW 0


*!*	SET PROCEDURE TO blat.prg ADDITIVE
#If .F.
	Dimension aryAttach(2)
	aryAttach(1) = "G:\conpress_ziare\PUBLICATIISERVER\log\server_PUBLICATIISERVER_20090810.log" && change to an actual file that exists on your computer
	aryAttach(2) = "G:\conpress_ziare\PUBLICATIISERVER\log\serverupdate_PUBLICATIISERVER_20090810.log" && change to an actual file that exists on your computer

	Local lcFrom, lcTo, lcSubject, lcBody, lcCC, lcBCC, lcMailServer, lcUserName, lcPassword, lnPort, lnPriority, llHTMLFormat, lcErrReturn

	lcFrom = "publicatiiserver@conpressgroup.ro"
	lcTo = "marius.mutu@romfast.ro"
	lcSubject = "Hey Have You Tried VFP Email?"
	*!* Sending the body in HTML format
	llHTMLFormat = .T. && change to .F. to send plain text message
	lcBody = "<a href='http://www.sweetpotatosoftware.com/SPSBlog/default.aspx'>" + ;
		"Hey Have You Tried VFP Email?" + ;
		"</a>"
	lcCC = "mmarius28@yahoo.com"
	lcBCC = "mmarius28@google.com"
	lcMailServer = "romfast.ro" && my SMTP Server
	lnPort = 25 && default SMTP Server port
	lcUserName = "marius.mutu" && my SMTP username
	lcPassword = "parola" && my SMTP password
	lnPriority = PRIORITYHIGH

	SendViaBLAT(@lcErrReturn, lcFrom, lcTo, lcSubject, lcBody, @aryAttach, lcCC, lcBCC, lcMailServer, lnPort, lcUserName, lcPassword, lnPriority, llHTMLFormat)

	If Empty(lcErrReturn)
		Messagebox("'" + lcSubject + "' sent successfullly.", 64, "Send email via BLAT")
	Else
		Messagebox("'" + lcSubject + "' failed to be sent.  Reason:" + Chr(13) + lcErrReturn, 64, "Send email via BLAT")
	Endif


	*!* BlatEmail.SendViaBlat RETURNS .T. IF SUCCES
	*!*	BlatEmail.IsError
	*!*	BlatEmail.ErrorMessage
	loBlatEmail = Createobject("BlatEmail")

	loBlatEmail.From = 'my@server.ro'
	loBlatEmail.To = 'marius.mutu@romfast.ro'
	loBlatEmail.Subject = 'Subject'
	loBlatEmail.HtmlFormat = .T.
	loBlatEmail.Body = 'Body'
	loBlatEmail.CC = 'marius.mutu@yahoo.com'
	loBlatEmail.BCC = ''
	loBlatEmail.Files = "c:\file1.txt,c:\file2.txt"
	loBlatEmail.MailServer = 'mail.romfast.ro'
	loBlatEmail.Port = 25
	loBlatEmail.UserName = 'marius.mutu'
	loBlatEmail.Password = 'parola'

	llReturn = loBlatEmail.SendViaBLAT()
	If llReturn
		Messagebox("'" + loBlatEmail.Subject + "' sent successfullly.", 64, "Send email via BLAT")
	Else
		Messagebox("'" + loBlatEmail.Subject + "' failed to be sent.  Reason:" + Chr(13) + loBlatEmail.ErrorMessage, 64, "Send email via BLAT")
	Endif

#Endif

Define Class BlatEmail As Custom
	From = ''
	To = ''
	Subject = ''
	HtmlFormat = .T.
	Body = ''
	CC = ''
	BCC = ''
	MailServer = ''
	Port = 25
	UserName = ''
	Password = ''
	Priority = PRIORITYLOW
	Files = ''

	ErrorMessage = ''
	ISERROR = .F.


	*******************************************
	Procedure SetAttachment
		Lparameters tcFile
		This.Files = This.Files + Iif(!Empty(This.Files), [,], []) + tcFile
	Endproc && SetAttachment

	*******************************************
	Procedure ResetAttachments
		This.Files = ''
	Endproc && ResetAttachments

	Procedure SendViaBLAT
		Local lcErrReturn, lcFrom, lcTo, lcSubject, lcBody, lcCC, lcBCC, lcMailServer, lnPort, lcUserName, lcPassword, lnPriority, llHTMLFormat

		lcErrReturn = ''
		lcFrom = This.From
		lcTo = This.To
		lcSubject = This.Subject
		lcBody = This.Body
		lcCC = This.CC
		lcBCC = This.BCC
		lcMailServer= This.MailServer
		lnPort = This.Port
		lcUserName = This.UserName
		lcPassword = This.Password
		lnPriority = This.Priority
		llHTMLFormat = This.HtmlFormat
		lcFiles = This.Files

		SendViaBLAT(@lcErrReturn, lcFrom, lcTo, lcSubject, lcBody, lcFiles, lcCC, lcBCC, lcMailServer, lnPort, lcUserName, lcPassword, lnPriority, llHTMLFormat)
		This.ISERROR = !Empty(lcErrReturn)
		This.ErrorMessage = lcErrReturn

		Return !This.ISERROR
	Endproc
Enddefine && BlatEmail


*******************************************
Procedure SendViaBLAT(tcReturn, tcFrom, tcTo, tcSubject, tcBody, tcFiles, tcCC, tcBCC, tcMailServer, tnPort, tcUserName, tcPassword, tnPriority, tlHtmlFormat)
	*******************************************
	Local lcBlatParam, lcBodyFile, lnCountAttachments, lnResult, loError As Exception, lcFiles
	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
		lcBlatPath = ADDBS(m.dirgen) + [COMUNROA\blat.dll]
		Declare Integer Send In (m.lcBlatPath) 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)

		If Type("tcTo") = "C"
			lcBlatParam = lcBlatParam + " -to " + Alltrim(tcTo)
		Endif
		If Type("tcFrom") = "C"
			lcBlatParam = lcBlatParam + " -f " + Alltrim(tcFrom)
		Endif
		If Type("tcCC") = "C" And !Empty(tcCC)
			lcBlatParam = lcBlatParam + " -cc " + Alltrim(tcCC)
		Endif
		If Type("tcBCC") = "C" And !Empty(tcBCC)
			lcBlatParam = lcBlatParam + " -bcc " + Alltrim(tcBCC)
		Endif
		If Type("tcSubject") = "C" And !Empty(tcSubject)
			lcBlatParam = lcBlatParam + [ -s "] + Alltrim(tcSubject) + ["]
		Endif
		If Type("tcMailserver") = "C" And !Empty(tcMailServer)
			lcBlatParam = lcBlatParam + " -server " + Alltrim(tcMailServer)
		Endif
		If Type("tnPort") = "N" And !Empty(tnPort)
			lcBlatParam = lcBlatParam + ":" + Transform(tnPort)
		Endif
		If Type("tcUsername") = "C" And !Empty(tcUserName)
			lcBlatParam = lcBlatParam + " -u " + Alltrim(tcUserName)
		Endif
		If Type("tcPassword") = "C" And !Empty(tcPassword)
			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

		If Vartype(tcFiles) = "C" And !Empty(tcFiles)
			tcFiles = Strtran(tcFiles, [;], [,])
			lcFiles = ""
			For lnCountAttachments = 1 To Getwordcount(tcFiles,",")
				lcFile = GetShortPath(Alltrim(Getwordnum(tcFiles,lnCountAttachments,",")))
				If File(lcFile)
					lcFiles = lcFiles + GetShortPath(Alltrim(Getwordnum(tcFiles,lnCountAttachments,","))) + ","
				Endif
			Endfor
			If !Empty(lcFiles)
				lcBlatParam = lcBlatParam + " -attach "
				lcBlatParam = lcBlatParam + lcFiles
				lcBlatParam = Left(lcBlatParam, Len(lcBlatParam) - 1) && Remove Extra Comma
			Endif
		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