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