Function SET192A: Send Email via NT Server

LANSA

Function SET192A: Send Email via NT Server

********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_192);
********** COMMENT(Function .......: SET192A);
********** COMMENT(Created on .....: 24th October 2000);
********** COMMENT(Description ....: Demonstration Function);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how a LANSA for the WEB 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();
FUNCTION OPTIONS(*DIRECT *WEBEVENT);
********** COMMENT();
********** COMMENT(TEXT AREA field definitions);
DEFINE FIELD(#S_192TX01) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX02) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX03) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX04) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX05) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX06) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX07) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX08) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX09) REFFLD(#S_192TX);
DEFINE FIELD(#S_192TX10) REFFLD(#S_192TX);
********** COMMENT();
********** COMMENT(Maximum number of characters that can be typed in the);
********** COMMENT(TA. It will be equal to the number of lines);
********** COMMENT(times the length of the field.);
DEFINE FIELD(#MAXCHAR) TYPE(*DEC) LENGTH(005) DECIMALS(0);
DEFINE FIELD(#TXTLENGTH) TYPE(*DEC) LENGTH(003) DECIMALS(0) DEFAULT(78);
DEFINE FIELD(#NUM_LINES) TYPE(*DEC) LENGTH(005) DECIMALS(0) DEFAULT(11);
********** COMMENT(It is easier to handle the text entered in the TA by);
********** COMMENT(defining an array of its fields.);
DEF_ARRAY NAME(#TXT) INDEXES(#II) OF_FIELDS(#S_192TX #S_192TX01 #S_192TX02 #S_192TX03 #S_192TX04 #S_192TX05 #S_192TX06 #S_192TX07 #S_192TX08 #S_192TX09 #S_192TX10);
GROUP_BY NAME(#PANELDATA) FIELDS((#STDRENTRY *HIDDEN)(#S_192EFR)(#S_192ETO)(#S_192ESU)(#S_192TX)(#MAXCHAR *HIDDEN)(#S_192SNDE));
********** COMMENT();
CHANGE FIELD(#MAXCHAR) TO('#txtlength * #num_lines');
********** COMMENT();
********** COMMENT(Mainline);
********** COMMENT();
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= *blanks');
CHANGE FIELD(#STDRENTRY) TO(Y);
OTHERWISE;
EXECUTE SUBROUTINE(VAL_DETAIL);
IF COND(*NO_ERRORS);
EXECUTE SUBROUTINE(AS_CLIENT);
EXECUTE SUBROUTINE(ENDSERVICE);
ENDIF;
ENDCASE;
********** COMMENT(=======================================================);
********** COMMENT(Request email details (from, to, subject, text));
********** COMMENT(=======================================================);
REQUEST FIELDS(#PANELDATA) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(=======================================================);
********** COMMENT(===============================================);
********** COMMENT( AS_Client: AS/400 "Client" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(AS_CLIENT);
DEFINE FIELD(#S_192EFR) TYPE(*CHAR) LENGTH(040) DESC('From (Email Address)') INPUT_ATR(LC);
DEFINE FIELD(#S_192ETO) TYPE(*CHAR) LENGTH(040) DESC('To (Email Address)') INPUT_ATR(LC);
DEFINE FIELD(#S_192ESU) TYPE(*CHAR) LENGTH(040) DESC('Subject') INPUT_ATR(LC) SHIFT(E);
DEFINE FIELD(#S_192ETX) TYPE(*CHAR) LENGTH(078) DESC('Message') INPUT_ATR(LC) SHIFT(E);
DEFINE FIELD(#S_192RSP) TYPE(*CHAR) LENGTH(002) DESC('Response from server');
DEFINE FIELD(#S_192EMC) REFFLD(#STD_NUM) DESC('Message text lines count');
DEF_LIST NAME(#S_192MSG) FIELDS(#S_192ETX) TYPE(*WORKING);
********** COMMENT();
********** COMMENT(Send the values of the from and to address and subject);
********** COMMENT(out with the symbolic names FROM, TO and SUBJECT);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FROM #S_192EFR);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(TO #S_192ETO);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(SUBJECT #S_192ESU);
********** COMMENT();
********** COMMENT(Put out all non-blank message lines with the);
********** COMMENT(symbolic name MESSAGETEXT as a series of instances);
********** COMMENT();
CLR_LIST NAMED(#S_192MSG);
BEGIN_LOOP USING(#II) TO(#NUM_LINES);
CONTINUE IF('#txt#ii = *blank');
CHANGE FIELD(#S_192ETX) TO(#TXT#II);
ADD_ENTRY TO_LIST(#S_192MSG);
END_LOOP;
********** COMMENT();
CHANGE FIELD(#S_192EMC) TO(0);
SELECTLIST NAMED(#S_192MSG);
CHANGE FIELD(#S_192EMC) TO('#S_192EMC + 1');
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS('MESSAGE_TEXT' #S_192ETX);
EXECUTE SUBROUTINE(NEXT_SET);
ENDSELECT;
********** 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_192EMC);
********** 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 SET1932 *BLANKS);
********** COMMENT();
********** COMMENT(Wait 30 seconds for the GENL service to respond);
********** COMMENT();
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();
CHANGE FIELD(#S_192RSP) TO(ER);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(RESPONSE #S_192RSP);
IF COND('#S_192RSP *NE OK');
MESSAGE MSGTXT('Error when attempting to send email - GENL service may not be available');
ENDIF;
********** COMMENT();
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** 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> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RETURNED));
CHANGE FIELD(#S_193GSR) TO(C);
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> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_NUMBER) PARMS((#S_193VNM *RECEIVED) (#S_193VNV *RETURNED));
CHANGE FIELD(#S_193GSR) TO(D);
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(Validate input details);
********** COMMENT(================================================);
SUBROUTINE NAME(VAL_DETAIL);
********** COMMENT();
DEF_COND NAME(*NO_ERRORS) COND('(#s_192efr *ne *blanks) and (#s_192eto *ne *blanks) and (#s_192esu *ne *blanks)');
********** COMMENT();
IF COND('#s_192efr = *blanks');
MESSAGE MSGTXT('A From email address must be specified');
ENDIF;
********** COMMENT();
IF COND('#s_192eto = *blanks');
MESSAGE MSGTXT('A To email address must be specified');
ENDIF;
********** COMMENT();
IF COND('#s_192esu = *blanks');
MESSAGE MSGTXT('A Subject must be specified');
ENDIF;
********** COMMENT();
ENDROUTINE;