311 lines
10 KiB
Plaintext
311 lines
10 KiB
Plaintext
Function SRP_MAIL_DEMO_EVENTS(CtrlEntID, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8)
|
|
/*
|
|
* Subroutine Name :SRP_MAIL_DEMO_EVENTS
|
|
*
|
|
* Description : Commuter Module for SRP_MAIL_DEMO
|
|
*
|
|
* Date : 01/07/2016
|
|
*
|
|
* Author : SYSPROG
|
|
*
|
|
* OI Version : 9.4.0
|
|
*
|
|
********************************************************/
|
|
|
|
Declare Subroutine Msg, FsMsg, Set_Status, Center_Window, Set_Property, Send_Message, Yield
|
|
|
|
Declare Function Msg, Get_Property, Get_Status, Set_Property, Popup
|
|
Declare Function Repository, Send_Message, Send_Event, Unassigned, Utility
|
|
Declare Function ContextMenu, SRP_Send_Mail
|
|
|
|
$Insert MSG_Equates
|
|
$Insert Popup_Equates
|
|
$INSERT LOGICAL
|
|
$Insert RTI_STYLE_EQUATES
|
|
|
|
If Unassigned(CtrlEntID) Then CtrlEntID = ''
|
|
If Unassigned(Event) Then Event = ''
|
|
If Unassigned(Param1) Then Param1 = ''
|
|
If Unassigned(Param2) Then Param2 = ''
|
|
If Unassigned(Param3) Then Param3 = ''
|
|
If Unassigned(Param4) Then Param4 = ''
|
|
If Unassigned(Param5) Then Param5 = ''
|
|
If Unassigned(Param6) Then Param6 = ''
|
|
If Unassigned(Param7) Then Param7 = ''
|
|
If Unassigned(Param8) Then Param8 = ''
|
|
|
|
|
|
If index(CtrlEntID,".",1) then
|
|
WinName = Field(CtrlEntID,'.',1)
|
|
Control = Field(CtrlEntID,'.',2)
|
|
End else
|
|
WinName = CtrlEntID
|
|
Control = WinName
|
|
End
|
|
|
|
Parent = @window
|
|
Frame = Get_Property(Parent,'MDIFRAME')
|
|
If len(Frame) then Parent = Frame
|
|
|
|
Retval = 1
|
|
|
|
Begin Case
|
|
Case Event _EQC 'CREATE' ; Gosub CREATE
|
|
|
|
Case Event _EQC 'CHANGED'
|
|
Begin Case
|
|
Case Control _EQC 'COB_BODY_TYPE' ; GoSub CHANGED.COB_BODY_TYPE
|
|
Case Control _EQC 'COB_SERVER_PORT' ; GoSub CHANGED.COB_SERVER_PORT
|
|
Case Control _EQC 'COB_ENCRYPTION' ; GoSub CHANGED.COB_ENCRYPTION
|
|
End Case
|
|
|
|
Case Event _EQC 'OPTIONS'
|
|
Begin Case
|
|
Case Control _EQC 'EDT_ATTACHMENTS' ; GoSub OPTIONS.EDT_ATTACHMENTS
|
|
End Case
|
|
|
|
Case Event _EQC 'CLICK'
|
|
Begin Case
|
|
Case Control _EQC 'PUB_SEND_EMAIL' ; GoSub CLICK.PUB_SEND_EMAIL
|
|
End Case
|
|
End Case
|
|
|
|
return retval
|
|
|
|
|
|
CREATE:
|
|
HTMLCtrl = @Window : '.OLE_BODY'
|
|
Send_Message(HTMLCtrl, 'OLE.Navigate2', 'about:blank')
|
|
Loop
|
|
Status = Get_Property(HTMLCtrl, 'OLE.ReadyState')
|
|
While (Status NE 4)
|
|
Yield()
|
|
Repeat
|
|
|
|
OSRead Body from Drive() : '\Sample HTML Email.htm' then
|
|
Send_Message(HTMLCtrl, 'OLE.document.open')
|
|
Send_Message(HTMLCtrl, 'OLE.document.write', Body)
|
|
Send_Message(HTMLCtrl, 'OLE.document.close')
|
|
end
|
|
|
|
Send_Message(@Window : '.EDT_ATTACHMENTS', 'STYLE_BY_POS', 1, 0, DTCS_OPTIONSBUTTON$)
|
|
|
|
Open "SYSLISTS" to hSYSLISTS then
|
|
Read Cache from hSYSLISTS, "SRP_MAIL_DEMO_CACHE" then
|
|
Set_Property(@Window : '.EDL_SUBJECT', 'TEXT', Cache<1>)
|
|
Set_Property(@Window : '.EDL_FROM', 'TEXT', Cache<2>)
|
|
Set_Property(@Window : '.EDL_TO', 'TEXT', Cache<3>)
|
|
Set_Property(@Window : '.EDL_CC', 'TEXT', Cache<4>)
|
|
Set_Property(@Window : '.EDL_BCC', 'TEXT', Cache<5>)
|
|
Set_Property(@Window : '.EDL_REPLY_TO', 'TEXT', Cache<6>)
|
|
Set_Property(@Window : '.COB_BODY_TYPE', 'TEXT', Cache<7>)
|
|
Set_Property(@Window : '.COB_SERVER_PORT', 'TEXT', Cache<8>)
|
|
Set_Property(@Window : '.COB_ENCRYPTION', 'TEXT', Cache<9>)
|
|
Set_Property(@Window : '.EDL_SMTP_SERVER', 'TEXT', Cache<10>)
|
|
Set_Property(@Window : '.EDL_ACCOUNT_USERNAME', 'TEXT', Cache<11>)
|
|
Set_Property(@Window : '.CHB_AUTHENTICATE', 'CHECK', Cache<12>)
|
|
Set_Property(@Window : '.EDT_ATTACHMENTS', 'ARRAY', Cache<13>:@FM:Cache<14>)
|
|
* Set_Property(@Window : '.EDL_ACCOUNT_PASSWORD', 'TEXT', Cache<15>)
|
|
GoSub CHANGED.COB_BODY_TYPE
|
|
end
|
|
end
|
|
|
|
Size = Get_Property(@Window, 'SIZE')
|
|
TrackingSize = Size<3> : @FM : Size<4> : @FM : Size<3> : @FM : Size<4>
|
|
Set_Property(@Window, 'TRACKINGSIZE', TrackingSize)
|
|
|
|
Center_Window(@Window)
|
|
Return
|
|
|
|
|
|
CHANGED.COB_BODY_TYPE:
|
|
BodyType = Get_Property(@Window : '.COB_BODY_TYPE', 'TEXT')
|
|
If BodyType _EQC 'HTML' Then
|
|
Set_Property(@Window : '.OLE_BODY', 'VISIBLE', True$)
|
|
Set_Property(@Window : '.EDB_BODY', 'VISIBLE', False$)
|
|
End Else
|
|
Set_Property(@Window : '.EDB_BODY', 'VISIBLE', True$)
|
|
Set_Property(@Window : '.OLE_BODY', 'VISIBLE', False$)
|
|
end
|
|
Return
|
|
|
|
|
|
OPTIONS.EDT_ATTACHMENTS:
|
|
SelPos = Get_Property(CtrlEntId, 'SELPOS')
|
|
RowPos = SelPos<2>
|
|
CurPath = Send_Message(CtrlEntId, 'TEXT_BY_POS', 2, RowPos)
|
|
If Len(CurPath) Then
|
|
FileName = CurPath[-1, 'B\']
|
|
NumDelims = Count(CurPath, '\')
|
|
InitDir = Field(CurPath, '\', 1, NumDelims)
|
|
End Else
|
|
FileName = ''
|
|
InitDir = Drive()
|
|
end
|
|
ConfigOptions = ''
|
|
ConfigOptions<1> = 0
|
|
ConfigOptions<4> = FileName
|
|
ConfigOptions<6> = InitDir
|
|
Path = Utility('CHOOSEFILE', @Window, ConfigOptions)
|
|
If Len(Path) And (Path NE CurPath) Then
|
|
Set_Property(CtrlEntId, 'ROWDATA', '' : @FM : Path)
|
|
end
|
|
Return
|
|
|
|
|
|
CHANGED.COB_SERVER_PORT:
|
|
ServerPort = Param1
|
|
Begin Case
|
|
Case ServerPort[1, 2] EQ 25 ; Set_Property(@Window : '.COB_ENCRYPTION', 'TEXT', '<none>')
|
|
Case ServerPort[1, 3] EQ 465 ; Set_Property(@Window : '.COB_ENCRYPTION', 'TEXT', 'SSL')
|
|
Case ServerPort[1, 3] EQ 587 ; Set_Property(@Window : '.COB_ENCRYPTION', 'TEXT', 'TLS')
|
|
End Case
|
|
Return
|
|
|
|
|
|
CHANGED.COB_ENCRYPTION:
|
|
Encryption = Param1
|
|
Begin Case
|
|
Case Encryption EQ '<none>' ; Set_Property(@Window : '.COB_SERVER_PORT', 'TEXT', '25 (Non-Secure SMTP)')
|
|
Case Encryption EQ 'SSL' ; Set_Property(@Window : '.COB_SERVER_PORT', 'TEXT', '465 (SSL)')
|
|
Case Encryption EQ 'TLS' ; Set_Property(@Window : '.COB_SERVER_PORT', 'TEXT', '587 (TLS)')
|
|
End Case
|
|
Return
|
|
|
|
|
|
CLICK.PUB_SEND_EMAIL:
|
|
TestResults = @Window : '.EDB_TEST_RESULTS'
|
|
Set_Property(TestResults, 'TEXTVAL', '')
|
|
Send_Message(TestResults, 'INSERT', -1, 'Attempting to send email...')
|
|
|
|
Continue = True$
|
|
Gosub Get_Message_Parameters
|
|
If Continue Then Gosub Get_Configuration_Parameters
|
|
If Continue Then Gosub Send_Email
|
|
|
|
If Not(Continue) Then Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Sending email failed.')
|
|
|
|
Cache = ''
|
|
Cache<-1> = Get_Property(@Window : '.EDL_SUBJECT', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_FROM', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_TO', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_CC', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_BCC', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_REPLY_TO', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.COB_BODY_TYPE', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.COB_SERVER_PORT', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.COB_ENCRYPTION', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_SMTP_SERVER', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.EDL_ACCOUNT_USERNAME', 'TEXT')
|
|
Cache<-1> = Get_Property(@Window : '.CHB_AUTHENTICATE', 'CHECK')
|
|
Cache<-1> = Get_Property(@Window : '.EDT_ATTACHMENTS', 'ARRAY')
|
|
* Cache<-1> = Get_Property(@Window : '.EDL_ACCOUNT_PASSWORD', 'TEXT')
|
|
Open "SYSLISTS" to hSYSLISTS then
|
|
Write Cache to hSYSLISTS, "SRP_MAIL_DEMO_CACHE" then NULL
|
|
end
|
|
|
|
Return
|
|
|
|
|
|
Get_Message_Parameters:
|
|
Subject = Get_Property(@Window : '.EDL_SUBJECT', 'TEXT')
|
|
From = Get_Property(@Window : '.EDL_FROM', 'TEXT')
|
|
To = Get_Property(@Window : '.EDL_TO', 'TEXT')
|
|
CC = Get_Property(@Window : '.EDL_CC', 'TEXT')
|
|
BCC = Get_Property(@Window : '.EDL_BCC', 'TEXT')
|
|
ReplyTo = Get_Property(@Window : '.EDL_REPLY_TO', 'TEXT')
|
|
BodyType = Get_Property(@Window : '.COB_BODY_TYPE', 'TEXT')
|
|
If BodyType _EQC 'HTML' Then
|
|
OSRead Body from Drive() : '\Sample HTML Email.htm' else Body = ''
|
|
End Else
|
|
Body = Get_Property(@Window : '.EDB_BODY', 'TEXT')
|
|
End
|
|
Attachments = Send_Message(@Window : '.EDT_ATTACHMENTS', 'TEXT_BY_POS', 2, 0)
|
|
NumAttachments = DCount(Attachments, @FM)
|
|
Loop
|
|
Attachment = Attachments<NumAttachments>
|
|
Until Len(Attachment) Or NumAttachments LT 1
|
|
Attachments = Delete(Attachments, NumAttachments, 0, 0)
|
|
NumAttachments -= 1
|
|
Repeat
|
|
Convert @FM To @VM In Attachments
|
|
|
|
If Len(From) Else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Missing the From email address.')
|
|
end
|
|
|
|
If Len(To) Else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Missing the To email address.')
|
|
end
|
|
Return
|
|
|
|
|
|
Get_Configuration_Parameters:
|
|
ServerPort = Get_Property(@Window : '.COB_SERVER_PORT', 'TEXT')
|
|
ServerPort = ServerPort[1, ' ']
|
|
Encryption = Get_Property(@Window : '.COB_ENCRYPTION', 'TEXT')
|
|
If Encryption _EQC '<none>' Then Encryption = ''
|
|
Authenticate = Get_Property(@Window : '.CHB_AUTHENTICATE', 'CHECK')
|
|
SMTPServer = Get_Property(@Window : '.EDL_SMTP_SERVER', 'TEXT')
|
|
AccountUsername = Get_Property(@Window : '.EDL_ACCOUNT_USERNAME', 'TEXT')
|
|
AccountPassword = Get_Property(@Window : '.EDL_ACCOUNT_PASSWORD', 'TEXT')
|
|
|
|
If Len(ServerPort) else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Missing the Server Port.')
|
|
End
|
|
|
|
If Len(SMTPServer) else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Missing the SMTP Server URL.')
|
|
end
|
|
|
|
If Len(AccountUsername) else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Missing the Account Username.')
|
|
End
|
|
|
|
If Len(AccountPassword) else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Missing the Account Password.')
|
|
end
|
|
Return
|
|
|
|
|
|
Send_Email:
|
|
Message = ''
|
|
Message<1> = Subject
|
|
Message<2> = From
|
|
Message<3> = To
|
|
Message<4> = CC
|
|
Message<5> = BCC
|
|
Message<6> = ReplyTo
|
|
Message<7> = BodyType
|
|
Message<8> = Body
|
|
Message<9> = Attachments
|
|
Message<10> = ''
|
|
Message<11> = ''
|
|
Message<12> = ''
|
|
|
|
Config = ''
|
|
Config<1> = '' ; // Send Using is deprecated
|
|
Config<2> = '' ; // Server Directory is deprecated
|
|
Config<3> = ServerPort
|
|
Config<4> = SMTPServer
|
|
Config<5> = Authenticate
|
|
Config<6> = AccountUsername
|
|
Config<7> = AccountPassword
|
|
Config<8> = Encryption
|
|
|
|
Response = SRP_Send_Mail(Message, Config)
|
|
If Response EQ 1 Then
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'Sending email was successful.')
|
|
End Else
|
|
Continue = False$
|
|
Send_Message(TestResults, 'INSERT', -1, \0D0A\ : 'SMTP Server Response: ' : Response)
|
|
end
|
|
Return
|
|
|