Function SET1932: Send Email via NT Server
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET1932);
********** COMMENT(Created on .....: 12th October 2000);
********** COMMENT(Description ....: Demonstration Function 2);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how AS/400 function can invoke email);
********** COMMENT( logic on a Windows NT or 2000 server system.);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT( example material only. No warranty concerning the);
********** COMMENT( material or its use in any way whatsoever is);
********** COMMENT( expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum Release of LANSA Required : 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DIRECT *HEAVYUSAGE);
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
********** COMMENT(--------------------------------------);
********** COMMENT(If on an AS/400 execute "client" logic);
********** COMMENT(--------------------------------------);
IF COND(*AS400);
EXECUTE SUBROUTINE(AS_CLIENT);
ELSE;
********** COMMENT(-----------------------------------);
********** COMMENT(else execute NT/2000 "server" logic);
********** COMMENT(-----------------------------------);
EXECUTE SUBROUTINE(NT_SERVER);
ENDIF;
********** COMMENT(--------);
********** COMMENT(Finished);
********** COMMENT(--------);
MENU;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( AS_Client: AS/400 "Client" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(AS_CLIENT);
DEFINE FIELD(#S_193EFR) TYPE(*CHAR) LENGTH(040) DESC('From (Email Address)') INPUT_ATR(LC);
DEFINE FIELD(#S_193ETO) TYPE(*CHAR) LENGTH(040) DESC('To (Email Address)') INPUT_ATR(LC);
DEFINE FIELD(#S_193ESU) TYPE(*CHAR) LENGTH(040) DESC('Subject') INPUT_ATR(LC) SHIFT(E);
DEFINE FIELD(#S_193ETX) TYPE(*CHAR) LENGTH(078) DESC('Message') INPUT_ATR(LC) SHIFT(E);
DEFINE FIELD(#S_193RSP) TYPE(*CHAR) LENGTH(002) DESC('Response from server');
DEF_COND NAME(*NOTOKAY) COND('#S_193RSP *NE OK');
DEFINE FIELD(#S_193EMC) REFFLD(#STD_NUM) DESC('Message text lines count');
DEFINE FIELD(#S_193AT1) TYPE(*CHAR) LENGTH(040) DESC('Attachment 1') INPUT_ATR(LC) DEFAULT('c:\autoexec.bat');
DEFINE FIELD(#S_193AT2) TYPE(*CHAR) LENGTH(040) DESC('Attachment 2') INPUT_ATR(LC);
DEFINE FIELD(#S_193AT3) TYPE(*CHAR) LENGTH(040) DESC('Attachment 3') INPUT_ATR(LC);
DEF_LIST NAME(#S_193MSG) FIELDS(#S_193ETX);
********** COMMENT();
********** COMMENT(Initialize 20 blank lines into the email message text);
********** COMMENT(area);
********** COMMENT();
CHANGE FIELD(#S_193ETX) TO(*NULL);
INZ_LIST NAMED(#S_193MSG) NUM_ENTRYS(0000020) WITH_MODE(*ADD);
********** COMMENT();
********** COMMENT(Now loop around sending emails until cancelled);
********** COMMENT();
MESSAGE MSGTXT('Specify From and To email addresses and Message Text then press enter.');
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Request email details (from, to, subject, text));
********** COMMENT();
REQUEST FIELDS((#S_193EFR *L4 *P2) (#S_193ETO *L5 *P2) (#S_193ESU *L6 *P2) (#S_193AT1 *L7 *P2) (#S_193AT2 *L8 *P2) (#S_193AT3 *L9 *P2)) DESIGN(*DOWN) IDENTIFY(*DESC) BROWSELIST(#S_193MSG) EXIT_KEY(*NO) MENU_KEY(*YES E10) PROMPT_KEY(*NO);
********** COMMENT();
********** COMMENT(Validate details:);
********** COMMENT();
BEGINCHECK;
VALUECHECK FIELD(#S_193EFR) WITH_LIST(*BLANKS) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('A From email address must be specified');
VALUECHECK FIELD(#S_193ETO) WITH_LIST(*BLANKS) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('A To email address must be specified');
VALUECHECK FIELD(#S_193ESU) WITH_LIST(*BLANKS) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('A Subject must be specified');
MESSAGE MSGTXT('Verifying any attachments specified exist on the NT/2000 server system') TYPE(*STATUS);
EXECUTE SUBROUTINE(CHECKFILE) WITH_PARMS(#S_193AT1);
IF COND(*NOTOKAY);
SET_ERROR FOR_FIELD(#S_193AT1) MSGTXT('Attachment could not be located on NT/2000 server');
ENDIF;
EXECUTE SUBROUTINE(CHECKFILE) WITH_PARMS(#S_193AT2);
IF COND(*NOTOKAY);
SET_ERROR FOR_FIELD(#S_193AT2) MSGTXT('Attachment could not be located on NT/2000 server');
ENDIF;
EXECUTE SUBROUTINE(CHECKFILE) WITH_PARMS(#S_193AT3);
IF COND(*NOTOKAY);
SET_ERROR FOR_FIELD(#S_193AT3) MSGTXT('Attachment could not be located on NT/2000 server');
ENDIF;
ENDCHECK;
********** COMMENT();
********** COMMENT(Send the values of the address, subject and attachments);
********** COMMENT(out with the symbolic names FROM, TO, SUBJECT);
********** COMMENT(ATTACHMENT_1, ATTACHMENT_2 and ATTACHMENT_3);
********** COMMENT();
MESSAGE MSGTXT('Sending email details to Windows NT/2000 server') TYPE(*STATUS);
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FROM #S_193EFR);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(TO #S_193ETO);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(SUBJECT #S_193ESU);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ATTACHMENT_1 #S_193AT1);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ATTACHMENT_2 #S_193AT2);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ATTACHMENT_3 #S_193AT3);
********** COMMENT();
********** COMMENT(Put out all non-blank message lines with the);
********** COMMENT(symbolic name MESSAGETEXT as a series of instances);
********** COMMENT();
CHANGE FIELD(#S_193EMC) TO(0);
SELECTLIST NAMED(#S_193MSG) GET_ENTRYS(*NOTNULL);
CHANGE FIELD(#S_193EMC) TO('#S_193EMC + 1');
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS('MESSAGE_TEXT' #S_193ETX);
EXECUTE SUBROUTINE(NEXT_SET);
ENDSELECT;
********** COMMENT();
********** COMMENT(Put the count of the number of lines out under the);
********** COMMENT(symbolic name MESSAGE_COUNT);
********** COMMENT();
EXECUTE SUBROUTINE(FIRST_SET);
EXECUTE SUBROUTINE(PUT_NUMBER) WITH_PARMS('MESSAGE_COUNT' #S_193EMC);
********** COMMENT();
********** COMMENT(Send the values to a service named GENL);
********** COMMENT(Ask that this RDML function be used to);
********** COMMENT(handle the request on the NT/2000 server.);
********** COMMENT();
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL *FUNCTION *BLANKS);
********** COMMENT();
********** COMMENT(Wait 30 seconds for the GENL service to respond);
********** COMMENT();
MESSAGE MSGTXT('Waiting for response from Windows NT/2000 server') TYPE(*STATUS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
********** COMMENT();
********** COMMENT(Set the response code to a default value (eg: Error));
********** COMMENT(and then see if it was returned by the server);
********** COMMENT(If it was not returned OK issue an error message);
********** COMMENT();
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(RESPONSE #S_193RSP ER);
IF COND('#S_193RSP *NE OK');
MESSAGE MSGTXT('Error when attempting to send email - GENL service may not be available');
ENDIF;
********** COMMENT();
********** COMMENT(Loop around for next email to be sent);
********** COMMENT();
END_LOOP;
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
E10: EXECUTE SUBROUTINE(ENDSERVICE);
RETURN;
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT( CheckFile : Check a file exists on NT server);
********** COMMENT(===============================================);
SUBROUTINE NAME(CHECKFILE) PARMS((#SYSVAR$AV *RECEIVED));
********** COMMENT(Accept blank value as a valid value);
IF_NULL FIELD(#SYSVAR$AV);
CHANGE FIELD(#S_193RSP) TO(OK);
********** COMMENT(else use SET1938 logic to check if the file exists);
ELSE;
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ACTION EXISTS);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FILE_NAME #SYSVAR$AV);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL SET1938 *BLANKS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(STATUS #S_193RSP ER);
ENDIF;
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( NT_Server: Windows NT/2000 "Server" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(NT_SERVER);
DEFINE FIELD(#S_193SMTP) TYPE(*CHAR) LENGTH(050) DESC('SMTP Email Address');
********** COMMENT();
********** COMMENT(Else the action must be to send the mail);
********** COMMENT();
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Start the mail session);
********** COMMENT();
USE BUILTIN(MAIL_START) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Insert the from details);
********** COMMENT();
EXECUTE SUBROUTINE(FIRST_SET);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(FROM #S_193EFR *BLANKS);
USE BUILTIN(CONCAT) WITH_ARGS('SMTP:' #S_193EFR) TO_GET(#S_193SMTP);
USE BUILTIN(MAIL_ADD_ORIGINATOR) WITH_ARGS(#S_193EFR #S_193SMTP) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Insert the to details);
********** COMMENT();
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(TO #S_193ETO *BLANKS);
USE BUILTIN(CONCAT) WITH_ARGS('SMTP:' #S_193ETO) TO_GET(#S_193SMTP);
USE BUILTIN(MAIL_ADD_RECIPIENT) WITH_ARGS(TO #S_193ETO #S_193SMTP) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Add the subject);
********** COMMENT();
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(SUBJECT #S_193ESU *BLANKS);
USE BUILTIN(MAIL_SET_SUBJECT) WITH_ARGS(#S_193ESU) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
**********;
********** COMMENT(Add the optional first attachment);
**********;
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ATTACHMENT_1 #S_193AT1 *BLANKS);
IF COND('#S_193AT1 *NE *BLANKS');
USE BUILTIN(MAIL_ADD_ATTACHMENT) WITH_ARGS(#S_193AT1) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
ENDIF;
**********;
********** COMMENT(Add the optional second attachment);
**********;
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ATTACHMENT_2 #S_193AT2 *BLANKS);
IF COND('#S_193AT2 *NE *BLANKS');
USE BUILTIN(MAIL_ADD_ATTACHMENT) WITH_ARGS(#S_193AT2) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
ENDIF;
**********;
********** COMMENT(Add the optional third attachment);
**********;
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ATTACHMENT_3 #S_193AT3 *BLANKS);
IF COND('#S_193AT3 *NE *BLANKS');
USE BUILTIN(MAIL_ADD_ATTACHMENT) WITH_ARGS(#S_193AT3) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
ENDIF;
********** COMMENT();
********** COMMENT(Add in the message text details);
********** COMMENT();
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS('MESSAGE_COUNT' #S_193EMC 0);
BEGIN_LOOP TO(#S_193EMC);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS('MESSAGE_TEXT' #S_193ETX *BLANKS);
USE BUILTIN(MAIL_ADD_TEXT) WITH_ARGS(#S_193ETX) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
EXECUTE SUBROUTINE(NEXT_SET);
END_LOOP;
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Send the mail);
********** COMMENT();
USE BUILTIN(MAIL_SEND) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Clean Finish);
********** COMMENT();
MESSAGE MSGTXT('Email has been accepted by NT/2000 server system');
LEAVE;
END_LOOP;
********** COMMENT();
********** COMMENT(Begin the reply session and put back the response);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(RESPONSE #S_193RSP);
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
RETURN;
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(==== Windows NT/2000 Interface Routines ====);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(These subroutines are used to simplify and);
********** COMMENT( standardize interfacing with a NT/2000);
********** COMMENT( service via function SET193T);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(Begin: Sets or Resets an interaction between);
********** COMMENT( this program and an NT/2000 server. Use);
********** COMMENT( this subroutine at the start of each);
********** COMMENT( logical transaction.);
********** COMMENT(============================================);
SUBROUTINE NAME(BEGIN);
CHANGE FIELD(#S_193GSR) TO(I);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(EndService: Ends any existing connection with);
********** COMMENT( an NT/200 server and frees resources. Use);
********** COMMENT( when all interactions have been completed.);
********** COMMENT(============================================);
SUBROUTINE NAME(ENDSERVICE);
CHANGE FIELD(#S_193GSR) TO(T);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(First_Set : Sets up for the processing the);
********** COMMENT( first set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(FIRST_SET);
CHANGE FIELD(#S_193VIN) TO(1);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(Next_Set : Sets up for the processing the);
********** COMMENT( next set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(NEXT_SET);
CHANGE FIELD(#S_193VIN) TO('#S_193VIN + 1');
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Alpha: Set the value of an alpha variable);
********** COMMENT( instance. Used as Put_Alpha ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_ALPHA) PARMS( (#S_193VNM *RECEIVED) (#S_193VAV *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(A);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Number: Set the value of a numeric variable);
********** COMMENT( instance. Used as Put_Number ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_NUMBER) PARMS( (#S_193VNM *RECEIVED) (#S_193VNV *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(B);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Alpha: Get the value of an alpha variable);
********** COMMENT( instance. Used as Get_Alpha (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_ALPHA) PARMS( (#S_193VNM *RECEIVED) (#S_193VAV *RETURNED) (#D_193VAV *RECEIVED) );
DEFINE FIELD(#D_193VAV) REFFLD(#S_193VAV) DESC('Alphanumeric Default Value');
CHANGE FIELD(#S_193GSR) TO(C);
CHANGE FIELD(#S_193VAV) TO(#D_193VAV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Number: Get the value of a numeric variable);
********** COMMENT( instance. Used as Get_Number (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_NUMBER) PARMS( (#S_193VNM *RECEIVED) (#S_193VNV *RETURNED) (#D_193VNV *RECEIVED) );
DEFINE FIELD(#D_193VNV) REFFLD(#S_193VNV) DESC('Numeric Default Value');
CHANGE FIELD(#S_193GSR) TO(D);
CHANGE FIELD(#S_193VNV) TO(#D_193VNV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Send: Send all variables to a service);
********** COMMENT( Used as Send ( <nam> <fun> <com> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <fun> is the RDML function to invoke);
********** COMMENT( <com> is the RDML component to invoke);
********** COMMENT(================================================);
SUBROUTINE NAME(SEND) PARMS( (#S_193SERV *RECEIVED) (#S_193FUN *RECEIVED) (#S_193COM *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(S);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193FUN #S_193COM);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Receive: Receive all variables from a service);
********** COMMENT( Used as Receive ( <nam> <max> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <max> is the maximum time to wait);
********** COMMENT(================================================);
SUBROUTINE NAME(RECEIVE) PARMS( (#S_193SERV *RECEIVED) (#S_193MAXW *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(R);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193MAXW);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Call_193T: Used to call function SET193T);
********** COMMENT(================================================);
SUBROUTINE NAME(CALL_193T);
CALL PROCESS(*DIRECT) FUNCTION(SET193T);
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET1932);
********** COMMENT(Created on .....: 12th October 2000);
********** COMMENT(Description ....: Demonstration Function 2);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how AS/400 function can invoke email);
********** COMMENT( logic on a Windows NT or 2000 server system.);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT( example material only. No warranty concerning the);
********** COMMENT( material or its use in any way whatsoever is);
********** COMMENT( expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum Release of LANSA Required : 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DIRECT *HEAVYUSAGE);
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
********** COMMENT(--------------------------------------);
********** COMMENT(If on an AS/400 execute "client" logic);
********** COMMENT(--------------------------------------);
IF COND(*AS400);
EXECUTE SUBROUTINE(AS_CLIENT);
ELSE;
********** COMMENT(-----------------------------------);
********** COMMENT(else execute NT/2000 "server" logic);
********** COMMENT(-----------------------------------);
EXECUTE SUBROUTINE(NT_SERVER);
ENDIF;
********** COMMENT(--------);
********** COMMENT(Finished);
********** COMMENT(--------);
MENU;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( AS_Client: AS/400 "Client" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(AS_CLIENT);
DEFINE FIELD(#S_193EFR) TYPE(*CHAR) LENGTH(040) DESC('From (Email Address)') INPUT_ATR(LC);
DEFINE FIELD(#S_193ETO) TYPE(*CHAR) LENGTH(040) DESC('To (Email Address)') INPUT_ATR(LC);
DEFINE FIELD(#S_193ESU) TYPE(*CHAR) LENGTH(040) DESC('Subject') INPUT_ATR(LC) SHIFT(E);
DEFINE FIELD(#S_193ETX) TYPE(*CHAR) LENGTH(078) DESC('Message') INPUT_ATR(LC) SHIFT(E);
DEFINE FIELD(#S_193RSP) TYPE(*CHAR) LENGTH(002) DESC('Response from server');
DEF_COND NAME(*NOTOKAY) COND('#S_193RSP *NE OK');
DEFINE FIELD(#S_193EMC) REFFLD(#STD_NUM) DESC('Message text lines count');
DEFINE FIELD(#S_193AT1) TYPE(*CHAR) LENGTH(040) DESC('Attachment 1') INPUT_ATR(LC) DEFAULT('c:\autoexec.bat');
DEFINE FIELD(#S_193AT2) TYPE(*CHAR) LENGTH(040) DESC('Attachment 2') INPUT_ATR(LC);
DEFINE FIELD(#S_193AT3) TYPE(*CHAR) LENGTH(040) DESC('Attachment 3') INPUT_ATR(LC);
DEF_LIST NAME(#S_193MSG) FIELDS(#S_193ETX);
********** COMMENT();
********** COMMENT(Initialize 20 blank lines into the email message text);
********** COMMENT(area);
********** COMMENT();
CHANGE FIELD(#S_193ETX) TO(*NULL);
INZ_LIST NAMED(#S_193MSG) NUM_ENTRYS(0000020) WITH_MODE(*ADD);
********** COMMENT();
********** COMMENT(Now loop around sending emails until cancelled);
********** COMMENT();
MESSAGE MSGTXT('Specify From and To email addresses and Message Text then press enter.');
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Request email details (from, to, subject, text));
********** COMMENT();
REQUEST FIELDS((#S_193EFR *L4 *P2) (#S_193ETO *L5 *P2) (#S_193ESU *L6 *P2) (#S_193AT1 *L7 *P2) (#S_193AT2 *L8 *P2) (#S_193AT3 *L9 *P2)) DESIGN(*DOWN) IDENTIFY(*DESC) BROWSELIST(#S_193MSG) EXIT_KEY(*NO) MENU_KEY(*YES E10) PROMPT_KEY(*NO);
********** COMMENT();
********** COMMENT(Validate details:);
********** COMMENT();
BEGINCHECK;
VALUECHECK FIELD(#S_193EFR) WITH_LIST(*BLANKS) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('A From email address must be specified');
VALUECHECK FIELD(#S_193ETO) WITH_LIST(*BLANKS) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('A To email address must be specified');
VALUECHECK FIELD(#S_193ESU) WITH_LIST(*BLANKS) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('A Subject must be specified');
MESSAGE MSGTXT('Verifying any attachments specified exist on the NT/2000 server system') TYPE(*STATUS);
EXECUTE SUBROUTINE(CHECKFILE) WITH_PARMS(#S_193AT1);
IF COND(*NOTOKAY);
SET_ERROR FOR_FIELD(#S_193AT1) MSGTXT('Attachment could not be located on NT/2000 server');
ENDIF;
EXECUTE SUBROUTINE(CHECKFILE) WITH_PARMS(#S_193AT2);
IF COND(*NOTOKAY);
SET_ERROR FOR_FIELD(#S_193AT2) MSGTXT('Attachment could not be located on NT/2000 server');
ENDIF;
EXECUTE SUBROUTINE(CHECKFILE) WITH_PARMS(#S_193AT3);
IF COND(*NOTOKAY);
SET_ERROR FOR_FIELD(#S_193AT3) MSGTXT('Attachment could not be located on NT/2000 server');
ENDIF;
ENDCHECK;
********** COMMENT();
********** COMMENT(Send the values of the address, subject and attachments);
********** COMMENT(out with the symbolic names FROM, TO, SUBJECT);
********** COMMENT(ATTACHMENT_1, ATTACHMENT_2 and ATTACHMENT_3);
********** COMMENT();
MESSAGE MSGTXT('Sending email details to Windows NT/2000 server') TYPE(*STATUS);
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FROM #S_193EFR);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(TO #S_193ETO);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(SUBJECT #S_193ESU);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ATTACHMENT_1 #S_193AT1);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ATTACHMENT_2 #S_193AT2);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ATTACHMENT_3 #S_193AT3);
********** COMMENT();
********** COMMENT(Put out all non-blank message lines with the);
********** COMMENT(symbolic name MESSAGETEXT as a series of instances);
********** COMMENT();
CHANGE FIELD(#S_193EMC) TO(0);
SELECTLIST NAMED(#S_193MSG) GET_ENTRYS(*NOTNULL);
CHANGE FIELD(#S_193EMC) TO('#S_193EMC + 1');
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS('MESSAGE_TEXT' #S_193ETX);
EXECUTE SUBROUTINE(NEXT_SET);
ENDSELECT;
********** COMMENT();
********** COMMENT(Put the count of the number of lines out under the);
********** COMMENT(symbolic name MESSAGE_COUNT);
********** COMMENT();
EXECUTE SUBROUTINE(FIRST_SET);
EXECUTE SUBROUTINE(PUT_NUMBER) WITH_PARMS('MESSAGE_COUNT' #S_193EMC);
********** COMMENT();
********** COMMENT(Send the values to a service named GENL);
********** COMMENT(Ask that this RDML function be used to);
********** COMMENT(handle the request on the NT/2000 server.);
********** COMMENT();
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL *FUNCTION *BLANKS);
********** COMMENT();
********** COMMENT(Wait 30 seconds for the GENL service to respond);
********** COMMENT();
MESSAGE MSGTXT('Waiting for response from Windows NT/2000 server') TYPE(*STATUS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
********** COMMENT();
********** COMMENT(Set the response code to a default value (eg: Error));
********** COMMENT(and then see if it was returned by the server);
********** COMMENT(If it was not returned OK issue an error message);
********** COMMENT();
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(RESPONSE #S_193RSP ER);
IF COND('#S_193RSP *NE OK');
MESSAGE MSGTXT('Error when attempting to send email - GENL service may not be available');
ENDIF;
********** COMMENT();
********** COMMENT(Loop around for next email to be sent);
********** COMMENT();
END_LOOP;
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
E10: EXECUTE SUBROUTINE(ENDSERVICE);
RETURN;
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT( CheckFile : Check a file exists on NT server);
********** COMMENT(===============================================);
SUBROUTINE NAME(CHECKFILE) PARMS((#SYSVAR$AV *RECEIVED));
********** COMMENT(Accept blank value as a valid value);
IF_NULL FIELD(#SYSVAR$AV);
CHANGE FIELD(#S_193RSP) TO(OK);
********** COMMENT(else use SET1938 logic to check if the file exists);
ELSE;
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ACTION EXISTS);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FILE_NAME #SYSVAR$AV);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL SET1938 *BLANKS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(STATUS #S_193RSP ER);
ENDIF;
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( NT_Server: Windows NT/2000 "Server" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(NT_SERVER);
DEFINE FIELD(#S_193SMTP) TYPE(*CHAR) LENGTH(050) DESC('SMTP Email Address');
********** COMMENT();
********** COMMENT(Else the action must be to send the mail);
********** COMMENT();
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Start the mail session);
********** COMMENT();
USE BUILTIN(MAIL_START) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Insert the from details);
********** COMMENT();
EXECUTE SUBROUTINE(FIRST_SET);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(FROM #S_193EFR *BLANKS);
USE BUILTIN(CONCAT) WITH_ARGS('SMTP:' #S_193EFR) TO_GET(#S_193SMTP);
USE BUILTIN(MAIL_ADD_ORIGINATOR) WITH_ARGS(#S_193EFR #S_193SMTP) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Insert the to details);
********** COMMENT();
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(TO #S_193ETO *BLANKS);
USE BUILTIN(CONCAT) WITH_ARGS('SMTP:' #S_193ETO) TO_GET(#S_193SMTP);
USE BUILTIN(MAIL_ADD_RECIPIENT) WITH_ARGS(TO #S_193ETO #S_193SMTP) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Add the subject);
********** COMMENT();
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(SUBJECT #S_193ESU *BLANKS);
USE BUILTIN(MAIL_SET_SUBJECT) WITH_ARGS(#S_193ESU) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
**********;
********** COMMENT(Add the optional first attachment);
**********;
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ATTACHMENT_1 #S_193AT1 *BLANKS);
IF COND('#S_193AT1 *NE *BLANKS');
USE BUILTIN(MAIL_ADD_ATTACHMENT) WITH_ARGS(#S_193AT1) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
ENDIF;
**********;
********** COMMENT(Add the optional second attachment);
**********;
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ATTACHMENT_2 #S_193AT2 *BLANKS);
IF COND('#S_193AT2 *NE *BLANKS');
USE BUILTIN(MAIL_ADD_ATTACHMENT) WITH_ARGS(#S_193AT2) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
ENDIF;
**********;
********** COMMENT(Add the optional third attachment);
**********;
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ATTACHMENT_3 #S_193AT3 *BLANKS);
IF COND('#S_193AT3 *NE *BLANKS');
USE BUILTIN(MAIL_ADD_ATTACHMENT) WITH_ARGS(#S_193AT3) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
ENDIF;
********** COMMENT();
********** COMMENT(Add in the message text details);
********** COMMENT();
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS('MESSAGE_COUNT' #S_193EMC 0);
BEGIN_LOOP TO(#S_193EMC);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS('MESSAGE_TEXT' #S_193ETX *BLANKS);
USE BUILTIN(MAIL_ADD_TEXT) WITH_ARGS(#S_193ETX) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
EXECUTE SUBROUTINE(NEXT_SET);
END_LOOP;
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Send the mail);
********** COMMENT();
USE BUILTIN(MAIL_SEND) TO_GET(#S_193RSP);
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Clean Finish);
********** COMMENT();
MESSAGE MSGTXT('Email has been accepted by NT/2000 server system');
LEAVE;
END_LOOP;
********** COMMENT();
********** COMMENT(Begin the reply session and put back the response);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(RESPONSE #S_193RSP);
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
RETURN;
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(==== Windows NT/2000 Interface Routines ====);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(These subroutines are used to simplify and);
********** COMMENT( standardize interfacing with a NT/2000);
********** COMMENT( service via function SET193T);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(Begin: Sets or Resets an interaction between);
********** COMMENT( this program and an NT/2000 server. Use);
********** COMMENT( this subroutine at the start of each);
********** COMMENT( logical transaction.);
********** COMMENT(============================================);
SUBROUTINE NAME(BEGIN);
CHANGE FIELD(#S_193GSR) TO(I);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(EndService: Ends any existing connection with);
********** COMMENT( an NT/200 server and frees resources. Use);
********** COMMENT( when all interactions have been completed.);
********** COMMENT(============================================);
SUBROUTINE NAME(ENDSERVICE);
CHANGE FIELD(#S_193GSR) TO(T);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(First_Set : Sets up for the processing the);
********** COMMENT( first set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(FIRST_SET);
CHANGE FIELD(#S_193VIN) TO(1);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(Next_Set : Sets up for the processing the);
********** COMMENT( next set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(NEXT_SET);
CHANGE FIELD(#S_193VIN) TO('#S_193VIN + 1');
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Alpha: Set the value of an alpha variable);
********** COMMENT( instance. Used as Put_Alpha ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_ALPHA) PARMS( (#S_193VNM *RECEIVED) (#S_193VAV *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(A);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Number: Set the value of a numeric variable);
********** COMMENT( instance. Used as Put_Number ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_NUMBER) PARMS( (#S_193VNM *RECEIVED) (#S_193VNV *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(B);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Alpha: Get the value of an alpha variable);
********** COMMENT( instance. Used as Get_Alpha (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_ALPHA) PARMS( (#S_193VNM *RECEIVED) (#S_193VAV *RETURNED) (#D_193VAV *RECEIVED) );
DEFINE FIELD(#D_193VAV) REFFLD(#S_193VAV) DESC('Alphanumeric Default Value');
CHANGE FIELD(#S_193GSR) TO(C);
CHANGE FIELD(#S_193VAV) TO(#D_193VAV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Number: Get the value of a numeric variable);
********** COMMENT( instance. Used as Get_Number (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_NUMBER) PARMS( (#S_193VNM *RECEIVED) (#S_193VNV *RETURNED) (#D_193VNV *RECEIVED) );
DEFINE FIELD(#D_193VNV) REFFLD(#S_193VNV) DESC('Numeric Default Value');
CHANGE FIELD(#S_193GSR) TO(D);
CHANGE FIELD(#S_193VNV) TO(#D_193VNV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Send: Send all variables to a service);
********** COMMENT( Used as Send ( <nam> <fun> <com> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <fun> is the RDML function to invoke);
********** COMMENT( <com> is the RDML component to invoke);
********** COMMENT(================================================);
SUBROUTINE NAME(SEND) PARMS( (#S_193SERV *RECEIVED) (#S_193FUN *RECEIVED) (#S_193COM *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(S);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193FUN #S_193COM);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Receive: Receive all variables from a service);
********** COMMENT( Used as Receive ( <nam> <max> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <max> is the maximum time to wait);
********** COMMENT(================================================);
SUBROUTINE NAME(RECEIVE) PARMS( (#S_193SERV *RECEIVED) (#S_193MAXW *RECEIVED) );
CHANGE FIELD(#S_193GSR) TO(R);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193MAXW);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Call_193T: Used to call function SET193T);
********** COMMENT(================================================);
SUBROUTINE NAME(CALL_193T);
CALL PROCESS(*DIRECT) FUNCTION(SET193T);
ENDROUTINE;