Function SET195A: Copy iSeries Folder to Windows Directory

LANSA

previous page next page
Function SET195A: Copy iSeries Folder to Windows Directory
********** COMMENT(=======================================================);
********** COMMENT();
********** COMMENT(Process ........: SET_195);
********** COMMENT(Function .......: SET195A);
********** COMMENT(Created on .....: 31st October 2000);
********** COMMENT(Description ....: Copy AS/400 folder to PC);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function copies all the files in);
********** COMMENT( an AS/400 folder to a Windows directory.);
********** 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 *LIGHTUSAGE);
********** COMMENT();
********** COMMENT( Values that must be exchanged in by the caller);
********** COMMENT();
DEFINE FIELD(#S_195USER) REFFLD(#STD_OBJ) DESC('The AS/400 User Profile to use');
DEFINE FIELD(#S_195PSPW) REFFLD(#STD_OBJ) DESC('The password for the AS/400 User Profile');
DEFINE FIELD(#S_195PSWD) REFFLD(#STD_OBJ) DESC('The local Windows DBMS Password (eg:SQL)');
DEFINE FIELD(#S_195PSLU) TYPE(*CHAR) LENGTH(020) DESC('The network name of the AS/400');
DEFINE FIELD(#S_195FRF) TYPE(*CHAR) LENGTH(100) DESC('Copy from AS/400 Folder with this Name');
DEFINE FIELD(#S_195TOF) TYPE(*CHAR) LENGTH(100) DESC('Copy to Windows Directory with this Name');
********** COMMENT();
********** COMMENT(Return value (exchanged back to caller));
********** COMMENT();
DEFINE FIELD(#S_195RETC) TYPE(*CHAR) LENGTH(002) DESC('Return Code');
********** COMMENT();
********** COMMENT( Other Local Definitions);
********** COMMENT();
DEFINE FIELD(#S_195CMD) REFFLD(#SYSVAR$AV);
DEFINE FIELD(#S_195CM1) TYPE(*CHAR) LENGTH(010) TO_OVERLAY(#S_195CMD 007);
DEFINE FIELD(#S_195CM2) TYPE(*CHAR) LENGTH(200) TO_OVERLAY(#S_195CMD 017);
DEFINE FIELD(#S_195SAVU) REFFLD(#STD_OBJ) DESC('Saved User Profile');
DEFINE FIELD(#S_195OSRC) REFFLD(#STD_NUM) DESC('OS Return Code');
DEFINE FIELD(#S_195WRIT) REFFLD(#TIMEC);
DEF_COND NAME(*OKAY) COND('#S_195RETC *EQ OK');
DEF_COND NAME(*NOTOKAY) COND('#S_195RETC *NE OK');
********** COMMENT();
********** COMMENT(Save user details and alter to the required user);
********** COMMENT();
CHANGE FIELD(#S_195SAVU) TO(*USER);
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS(USER #S_195USER);
********** COMMENT();
********** COMMENT(Use a psedo loop to make exiting from errors easier);
********** COMMENT();
BEGIN_LOOP TO(1);
********** COMMENT();
********** COMMENT(Attempt a connection using details supplied);
********** COMMENT();
USE BUILTIN(DEFINE_OS_400_SERVER) WITH_ARGS(SET195A #S_195PSLU N N N N) TO_GET(#S_195RETC);
LEAVE IF(*NOTOKAY);
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(SET195A #S_195PSPW) TO_GET(#S_195RETC);
LEAVE IF(*NOTOKAY);
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(SET195A) TO_GET(#S_195RETC);
LEAVE IF(*NOTOKAY);
USE BUILTIN(CLR_MESSAGES);
********** COMMENT();
********** COMMENT(Create the LXXDIR.DEL control file);
********** COMMENT();
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS('"LXXADF"' TRUE);
EXECUTE SUBROUTINE(SAVEFILE) WITH_PARMS('LXXDIR.DEL');
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Create the LXXADF.ASC layout file);
********** COMMENT();
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS('XDFCON 01A 60 1 6' TRUE);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS('XDFCMD 00A 100 7 16' FALSE);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS('XDFPRM 00A 2560 17 272' FALSE);
EXECUTE SUBROUTINE(SAVEFILE) WITH_PARMS('LXXADF.ASF');
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Create the LXXADF.ASF directive file);
********** COMMENT();
CHANGE FIELD(#S_195CMD) TO(*BLANKS);
CHANGE FIELD(#S_195CM1) TO(COPYFOLDER);
USE BUILTIN(TCONCAT) WITH_ARGS('"' #S_195FRF '"') TO_GET(#S_195CM2);
USE BUILTIN(TCONCAT) WITH_ARGS('"' *TEMP_DIR '"') TO_GET(#SYSVAR$AV);
USE BUILTIN(BCONCAT) WITH_ARGS(#S_195CM2 #SYSVAR$AV) TO_GET(#S_195CM2);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS(#S_195CMD TRUE);
********** COMMENT();
CHANGE FIELD(#S_195CMD) TO(*BLANKS);
CHANGE FIELD(#S_195CM1) TO(COPYGROUP);
USE BUILTIN(BCONCAT) WITH_ARGS('*' '"%DIRF%" "') TO_GET(#S_195CM2);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_195CM2 #S_195TOF '"') TO_GET(#S_195CM2);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS(#S_195CMD FALSE);
********** COMMENT();
CHANGE FIELD(#S_195CMD) TO(*BLANKS);
CHANGE FIELD(#S_195CM1) TO(OPEN);
USE BUILTIN(TCONCAT) WITH_ARGS(*TEMP_DIR 'SET195.DAT') TO_GET(#S_195CM2);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS(#S_195CMD FALSE);
USE BUILTIN(OV_FILE_SERVICE) WITH_ARGS('REMOVE_FILE' #S_195CM2);
USE BUILTIN(CLR_MESSAGES);
********** COMMENT();
CHANGE FIELD(#S_195CMD) TO(*BLANKS);
CHANGE FIELD(#S_195CM1) TO(WRITE);
CHANGE FIELD(#S_195WRIT) TO(*TIMEC);
CHANGE FIELD(#S_195CM2) TO(#S_195WRIT);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS(#S_195CMD FALSE);
********** COMMENT();
CHANGE FIELD(#S_195CMD) TO(*BLANKS);
CHANGE FIELD(#S_195CM1) TO(CLOSE);
EXECUTE SUBROUTINE(ADDTOFILE) WITH_PARMS(#S_195CMD FALSE);
********** COMMENT();
EXECUTE SUBROUTINE(SAVEFILE) WITH_PARMS('LXXADF.ASC');
LEAVE IF(*NOTOKAY);
********** COMMENT();
********** COMMENT(Build the X_RUN command to run the LIMPORT);
********** COMMENT();
CHANGE FIELD(#S_195CMD) TO('X_RUN.EXE PROC=*LIMPORT');
EXECUTE SUBROUTINE(DUPPARM) WITH_PARMS(#S_195CMD LANG);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD PART *PARTITION);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD USER #S_195USER);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD PSPW #S_195PSPW);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD PSLU #S_195PSLU);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD PSTY AS400);
EXECUTE SUBROUTINE(DUPPARM) WITH_PARMS(#S_195CMD DBID);
EXECUTE SUBROUTINE(DUPPARM) WITH_PARMS(#S_195CMD DBII);
EXECUTE SUBROUTINE(DUPPARM) WITH_PARMS(#S_195CMD DBIT);
EXECUTE SUBROUTINE(DUPPARM) WITH_PARMS(#S_195CMD DBUS);
EXECUTE SUBROUTINE(DUPPARM) WITH_PARMS(#S_195CMD DBUT);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD PSWD #S_195PSWD);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD MODE B);
EXECUTE SUBROUTINE(ADDPARM) WITH_PARMS(#S_195CMD EXPR *TEMP_DIR);
********** COMMENT();
********** COMMENT(Execute the X_RUN *LIMPORT command and wait for result);
********** COMMENT();
USE BUILTIN(SYSTEM_COMMAND) WITH_ARGS(X #S_195CMD) TO_GET(#S_195OSRC);
********** COMMENT();
********** COMMENT(Look for the correct result in the temporary file);
********** COMMENT(set195.dat (it must contain the correct time stamp).);
********** COMMENT(Read in it's contents (if any) and then delete it.);
********** COMMENT();
DEF_LIST NAME(#RESULT) FIELDS(#TIMEC) TYPE(*WORKING) ENTRYS(0000001);
USE BUILTIN(TCONCAT) WITH_ARGS(*TEMP_DIR 'SET195.DAT') TO_GET(#SYSVAR$AV);
CLR_LIST NAMED(#RESULT);
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#RESULT #SYSVAR$AV T) TO_GET(#S_195RETC);
USE BUILTIN(OV_FILE_SERVICE) WITH_ARGS('REMOVE_FILE' #SYSVAR$AV);
USE BUILTIN(CLR_MESSAGES);
CHANGE FIELD(#TIMEC) TO(*NULL);
GET_ENTRY NUMBER(1) FROM_LIST(#RESULT);
IF COND('#TIMEC = #S_195WRIT');
CHANGE FIELD(#S_195RETC) TO(OK);
ELSE;
CHANGE FIELD(#S_195RETC) TO(ER);
ENDIF;
********** COMMENT();
END_LOOP;
********** COMMENT();
********** COMMENT(Restore original user details and finish;);
********** COMMENT();
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS(USER #S_195SAVU);
EXCHANGE FIELDS(#S_195RETC);
RETURN;
********** COMMENT(----------------------------------------------------);
********** COMMENT(AddParm : Add a standard X_RUN parameter to an X_RUN);
********** COMMENT(----------------------------------------------------);
SUBROUTINE NAME(ADDPARM) PARMS( (#SYSVAR$AV) (#S_195KEY *RECEIVED) (#S_195VAL *RECEIVED) );
DEFINE FIELD(#S_195KEY) TYPE(*CHAR) LENGTH(004);
DEFINE FIELD(#S_195VAL) TYPE(*CHAR) LENGTH(050);
USE BUILTIN(BCONCAT) WITH_ARGS(#SYSVAR$AV #S_195KEY) TO_GET(#SYSVAR$AV);
USE BUILTIN(TCONCAT) WITH_ARGS(#SYSVAR$AV '=' #S_195VAL) TO_GET(#SYSVAR$AV);
ENDROUTINE;
********** COMMENT(----------------------------------------------);
********** COMMENT(DupParm : Duplicate a standard X_RUN parameter);
********** COMMENT(----------------------------------------------);
SUBROUTINE NAME(DUPPARM) PARMS( (#SYSVAR$AV) (#S_195KEY *RECEIVED) );
USE BUILTIN(GET_SESSION_VALUE) WITH_ARGS(#S_195KEY) TO_GET(#S_195VAL #S_195RETC);
USE BUILTIN(BCONCAT) WITH_ARGS(#SYSVAR$AV #S_195KEY) TO_GET(#SYSVAR$AV);
USE BUILTIN(TCONCAT) WITH_ARGS(#SYSVAR$AV '=' #S_195VAL) TO_GET(#SYSVAR$AV);
ENDROUTINE;
********** COMMENT(----------------------------------------------------);
********** COMMENT(AddtoFile: Add a new line to an intended output file);
********** COMMENT(----------------------------------------------------);
SUBROUTINE NAME(ADDTOFILE) PARMS( (#SYSVAR$AV *RECEIVED) (#STD_BOOL *RECEIVED) );
DEF_LIST NAME(#TEMPFILE) FIELDS(#SYSVAR$AV) TYPE(*WORKING);
IF COND('#STD_BOOL = TRUE');
CLR_LIST NAMED(#TEMPFILE);
ENDIF;
ADD_ENTRY TO_LIST(#TEMPFILE);
ENDROUTINE;
********** COMMENT(-----------------------------------------------------);
********** COMMENT(SaveFile: Save an intended output file into *TEMP_DIR);
********** COMMENT(-----------------------------------------------------);
SUBROUTINE NAME(SAVEFILE) PARMS( (#SYSVAR$AV *RECEIVED) );
USE BUILTIN(TCONCAT) WITH_ARGS(*TEMP_DIR #SYSVAR$AV) TO_GET(#SYSVAR$AV);
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#TEMPFILE #SYSVAR$AV C I T) TO_GET(#S_195RETC);
ENDROUTINE;
previous page start next page