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', '') 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 '' ; 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 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 '' 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