1.5.1 L4WEX01 Example of On Top Connect/Disconnect
Refer to 1.3 Test with the Verification and Sample Applications for details on using the following example.
FUNCTION OPTIONS(*DIRECT);
**********;
DEFINE FIELD(#L4W_AS400) TYPE(*CHAR) LENGTH(1) LABEL('AS/400') INPUT_ATR(RB01);
DEFINE FIELD(#L4W_OTHER) TYPE(*CHAR) LENGTH(1) LABEL('Other (eg: NT)') INPUT_ATR(RB01);
DEFINE FIELD(#L4W_ANAM) TYPE(*CHAR) LENGTH(20) LABEL('Server Name') DEFAULT('?????????????');
DEFINE FIELD(#L4W_ONAM) TYPE(*CHAR) LENGTH(20) LABEL('Server Name') DEFAULT('?????????????');
DEFINE FIELD(#L4W_LOCK) TYPE(*CHAR) LENGTH(1) LABEL('Divert Locks') INPUT_ATR(CBOX) DEFAULT('''1''');
DEFINE FIELD(#L4W_SHOWM) TYPE(*CHAR) LENGTH(1) LABEL('Startup Message') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_COMC) TYPE(*CHAR) LENGTH(1) LABEL('Commit Control') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_DBCS) TYPE(*CHAR) LENGTH(1) LABEL('DBCS Capable') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_CTST) TYPE(*CHAR) LENGTH(10) DESC('C->S Table') DEFAULT(ANSEBC1140);
DEFINE FIELD(#L4W_STCT) TYPE(*CHAR) LENGTH(10) DESC('S->C Table') DEFAULT(EBC1140ANS);
DEFINE FIELD(#L4W_EXEP) TYPE(*CHAR) LENGTH(2) LABEL('Exec Priority') DEFAULT('''20''');
DEFINE FIELD(#L4W_RETC) TYPE(*CHAR) LENGTH(2) LABEL('Return Code');
DEFINE FIELD(#L4W_EARG) TYPE(*CHAR) LENGTH(255) LABEL('X_RUN Overrides');
DEFINE FIELD(#L4W_EAR1) TYPE(*CHAR) LENGTH(60) LABEL('Override 1') INPUT_ATR(LC) TO_OVERLAY(#L4W_EARG);
DEFINE FIELD(#L4W_EAR2) TYPE(*CHAR) LENGTH(60) LABEL('Override 2') INPUT_ATR(LC) TO_OVERLAY(#L4W_EARG 62);
DEFINE FIELD(#L4W_EAR3) TYPE(*CHAR) LENGTH(60) LABEL('Override 3') INPUT_ATR(LC) TO_OVERLAY(#L4W_EARG 123);
DEFINE FIELD(#L4W_EAR4) TYPE(*CHAR) LENGTH(60) LABEL('Override 4') INPUT_ATR(LC) TO_OVERLAY(#L4W_EARG 184);
DEFINE FIELD(#L4W_USER) TYPE(*CHAR) LENGTH(10) LABEL('Server User') DEFAULT(*user);
DEFINE FIELD(#L4W_PSWD) TYPE(*CHAR) LENGTH(10) LABEL('Server Password') INPUT_ATR(LC ND);
DEFINE FIELD(#L4W_PROC) TYPE(*CHAR) LENGTH(10) LABEL('Call Process') DEFAULT('??????????');
DEFINE FIELD(#L4W_FUNC) TYPE(*CHAR) LENGTH(7) LABEL('Call Function') DEFAULT('???????');
DEFINE FIELD(#L4W_BLKS) TYPE(*DEC) LENGTH(7) DECIMALS(0) LABEL('Blocking Size') EDIT_CODE(4) DEFAULT(100);
DEFINE FIELD(#L4W_TRC2) TYPE(*CHAR) LENGTH(1) LABEL('Trace Level 2') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_TRC4) TYPE(*CHAR) LENGTH(1) LABEL('Trace Level 4') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_TST1) TYPE(*CHAR) LENGTH(1) LABEL('Perform Test 1') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_TST2) TYPE(*CHAR) LENGTH(1) LABEL('Perform Test 2') INPUT_ATR(CBOX);
DEFINE FIELD(#L4W_APND) TYPE(*CHAR) LENGTH(1) DEFAULT(A);
**********;
DEF_LIST NAME(#SAVE1) FIELDS(#L4W_AS400 #L4W_OTHER #L4W_ANAM #L4W_ONAM #L4W_LOCK #L4W_SHOWM #L4W_COMC #L4W_DBCS #L4W_CTST #L4W_STCT #L4W_EXEP #L4W_PROC #L4W_FUNC #L4W_BLKS #L4W_TRC2 #L4W_TRC4) TYPE(*WORKING) ENTRYS(1);
DEF_LIST NAME(#SAVE2OUT) FIELDS(#L4W_APND #L4W_EARG) TYPE(*WORKING) ENTRYS(1);
DEF_LIST NAME(#SAVE2IN) FIELDS(#L4W_EARG) TYPE(*WORKING) ENTRYS(1);
**********;
DEF_COND NAME(*L4W_OTHER) COND('#L4W_OTHER = ''1''');
DEF_COND NAME(*L4W_AS400) COND('#L4W_AS400 = ''1''');
DEF_COND NAME(*OKAY) COND('#L4W_RETC = OK');
DEF_COND NAME(*NOTOKAY) COND('#L4W_RETC *NE OK');
DEF_COND NAME(*TRACEL2) COND('#L4W_TRC2 = ''1'' ');
DEF_COND NAME(*TRACEL4) COND('#L4W_TRC4 = ''1''');
DEF_COND NAME(*TEST1) COND('#L4W_TST1 = ''1'' ');
DEF_COND NAME(*TEST2) COND('#L4W_TST2 = ''1''');
DEF_COND NAME(*NOTEST) COND('(#L4W_TST1 *NE ''1'') *AND (#L4W_TST2 *NE ''1'')');
**********;
EXECUTE SUBROUTINE(LOAD_DFT);
POP_UP FIELDS((#L4W_AS400 *IN) (#L4W_OTHER *IN)) IDENTIFY(*LABEL) PANEL_TITL('Select Server Type') EXIT_KEY(*NO) PROMPT_KEY(*NO) STD_HEAD(*YES);
EXECUTE SUBROUTINE(SAVE_DFT);
**********;
BEGIN_LOOP;
IF COND(*L4W_OTHER);
REQUEST FIELDS(#L4W_ONAM #L4W_LOCK #L4W_SHOWM #L4W_TRC2 #L4W_TRC4 #L4W_TST1 #L4W_TST2 #L4W_BLKS #L4W_EAR1 #L4W_EAR2 #L4W_EAR3 #L4W_EAR4 (#L4W_USER *OUT) #L4W_PSWD #L4W_PROC #L4W_FUNC) DESIGN(*DOWN) EXIT_KEY(*NO) PROMPT_KEY(*NO) PANEL_TITL('Specify non-AS400 Server Details ');
EXECUTE SUBROUTINE(BLD_ARGS);
USE BUILTIN(DEFINE_ANY_SERVER) WITH_ARGS(SERVER #L4W_ONAM Y #L4W_ARG #L4W_LOCK #L4W_SHOWM) TO_GET(#L4W_RETC);
ELSE;
REQUEST FIELDS(#L4W_ANAM #L4W_LOCK #L4W_SHOWM #L4W_COMC #L4W_DBCS #L4W_TST1 #L4W_TST2 #L4W_BLKS #L4W_CTST #L4W_STCT #L4W_EXEP (#L4W_USER *OUT) #L4W_PSWD #L4W_PROC #L4W_FUNC) DESIGN(*DOWN) EXIT_KEY(*NO) PROMPT_KEY(*NO) PANEL_TITL('Specify AS/400 Server Details');
USE BUILTIN(DEFINE_OS_400_SERVER) WITH_ARGS(SERVER #L4W_ANAM #L4W_COMC #L4W_DBCS #L4W_LOCK #L4W_SHOWM #L4W_EXEP #L4W_CTST #L4W_STCT) TO_GET(#L4W_RETC);
ENDIF;
EXECUTE SUBROUTINE(SAVE_DFT);
IF COND(*OKAY);
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(SERVER #L4W_PSWD) TO_GET(#L4W_RETC);
IF COND(*OKAY);
USE BUILTIN(CONNECT_FILE) WITH_ARGS('*' SERVER #L4W_BLKS);
IF COND(*TEST1);
CALL PROCESS(*DIRECT) FUNCTION(L4WEX02) EXIT_USED(*NEXT) MENU_USED(*NEXT) IF_ERROR(*NEXT);
ENDIF;
IF COND(*TEST2);
CALL PROCESS(*DIRECT) FUNCTION(L4WEX03) EXIT_USED(*NEXT) MENU_USED(*NEXT) IF_ERROR(*NEXT);
ENDIF;
IF COND(*NOTEST);
CALL PROCESS(#L4W_PROC) FUNCTION(#L4W_FUNC) EXIT_USED(*NEXT) MENU_USED(*NEXT) IF_ERROR(*NEXT);
ENDIF;
USE BUILTIN(DISCONNECT_FILE) WITH_ARGS('*' SERVER);
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(SERVER) TO_GET(#L4W_RETC);
IF COND(*OKAY);
MESSAGE MSGTXT('Disconnection from server completed normally');
ELSE;
MESSAGE MSGTXT('Error detected when disconnecting from server');
ENDIF;
MENU;
ENDIF;
ENDIF;
END_LOOP;
**********;
SUBROUTINE NAME(BLD_ARGS);
DEFINE FIELD(#L4W_ARG) TYPE(*CHAR) LENGTH(256);
CHANGE FIELD(#L4W_ARG) TO(#L4W_EARG);
IF COND(*TRACEL4);
USE BUILTIN(BCONCAT) WITH_ARGS(#L4W_ARG 'ITRO=Y') TO_GET(#L4W_ARG);
USE BUILTIN(BCONCAT) WITH_ARGS(#L4W_ARG 'ITRL=4') TO_GET(#L4W_ARG);
ELSE;
IF COND(*TRACEL2);
USE BUILTIN(BCONCAT) WITH_ARGS(#L4W_ARG 'ITRO=Y') TO_GET(#L4W_ARG);
USE BUILTIN(BCONCAT) WITH_ARGS(#L4W_ARG 'ITRL=2') TO_GET(#L4W_ARG);
ENDIF;
ENDIF;
ENDROUTINE;
**********;
SUBROUTINE NAME(LOAD_DFT);
CLR_LIST NAMED(#SAVE1);
CLR_LIST NAMED(#SAVE2IN);
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#SAVE1 *FUNCTION T I Y *BLANK Y N 0 NONE #SAVE2IN) TO_GET(#L4W_RETC);
GET_ENTRY NUMBER(1) FROM_LIST(#SAVE1);
GET_ENTRY NUMBER(1) FROM_LIST(#SAVE2IN);
ENDROUTINE;
********** COMMENT(Routine);
SUBROUTINE NAME(SAVE_DFT);
CLR_LIST NAMED(#SAVE1);
CLR_LIST NAMED(#SAVE2OUT);
ADD_ENTRY TO_LIST(#SAVE1);
ADD_ENTRY TO_LIST(#SAVE2OUT);
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#SAVE1 *FUNCTION T I Y *BLANK Y #SAVE2OUT) TO_GET(#L4W_RETC);
ENDROUTINE;
Ý 1.5 Verification Application Code (L4WEX functions)