Problem solve
Get help with specific problems with your technologies, process and projects.
Easily send source file member to a remote system
Quick "SNDSRC" utility sends source file member to a remote system.
This quick "SNDSRC" utility, evoked from PDM user defined options, sends source file member to a remote system.
DSPF - SNDSRCD A DSPSIZ(24 80 *DS3) A PRINT A R SNDFMT A CF03(03 'EXIT') A CF12(12 'CANCEL') A OVERLAY A 1 32'Send Source Member' A DSPATR(HI) A 3 2'From File . . . . . . . :' A FRMFIL 10A O 3 30 A 4 4'From Library. . . . . :' A FRMLIB 10A O 4 32 A 7 2'Type the file name, library, and s- A ystem to receive the source member.' A COLOR(BLU) A 9 4'To File . . . . . . . :' A TOFIL 10A B 9 30 A 50 DSPATR(PC) A 50 DSPATR(RI) A 10 6'To Library . . . . :' A TOLIB 10A B 10 32 A 51 DSPATR(RI) A 51 DSPATR(PC) A 5 8'From System . . . :' A TOSYS 8A B 11 34 A 52 DSPATR(RI) A 52 DSPATR(PC) A 13 2'To rename copied member, type New - A Name, press Enter.' A COLOR(BLU) A 15 2'Member' A DSPATR(HI) A 15 17'New Name' A DSPATR(HI) A FRMMBR 10A O 16 2 A TOMBR 10A B 16 17 A 53 DSPATR(RI) A 53 DSPATR(PC) A 11 8'To System . . . . :' A FRMSYS 8A O 5 34 A R MSGSFL SFL A SFLMSGRCD(24) A MSGKEY SFLMSGKEY A PGMQ SFLPGMQ(10) A*/ A R MSGCTL SFLCTL(MSGSFL) A OVERLAY A SFLSIZ(0050) A SFLPAG(0001) A SFLDSP A SFLDSPCTL A SFLINZ A N99 SFLEND A PGMQ SFLPGMQ(10) A 23 2'F3=Exit' A COLOR(BLU) A 23 11'F12=Cancel' A COLOR(BLU) ------------------------------ CLP - SNDSRC /*------------------------------------------------------------------*/ /* PROGRAM NAME: SNDSRC */ /* DATE WRITTEN: 04/24/2003 */ /* AUTHOR......: RICHARD CRANSTON */ /* FUNCTION....: THIS IS USED TO SEND A SOURCE FILE FROM A */ /* SOURCE SYSTEM TO A TARGET SYSEM */ /* */ /* NOTE........: THIS IS CALLED FROM PDM USER OPTION. */ /* EX: CALL PGM(QGPL/SNDSRC) PARM(&F &L &N) */ /* THE TARGET SOURCE FILE MUST HAVE QUSER *AUTHORITY */ /*------------------------------------------------------------------*/ PGM PARM(&FRMFIL &FRMLIB &FRMMBR) DCLF FILE(SNDSRCD) RCDFMT(*ALL) /*------------------------------------------------------------------*/ /* DEFINE ERROR VARIABLES */ /*------------------------------------------------------------------*/ DCL VAR(&ERRORSW) TYPE(*LGL) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /*------------------------------------------------------------------*/ /* DEFINE AS400 SYSTEM NAMES VARIABLES (PUT YOUR AS400 SYSTEM NAMES HERE) */ /*------------------------------------------------------------------*/ DCL VAR(&SYSNM1) TYPE(*CHAR) LEN(8) + VALUE('FIRST_SYSNAME') DCL VAR(&SYSNM2) TYPE(*CHAR) LEN(8) + VALUE('SECOND_SYSNAME') /*------------------------------------------------------------------*/ /* GLOBAL MESSAGE MONITOR TO TRAP ANY UNMONITORED ERRORS */ /*------------------------------------------------------------------*/ MONMSG (CPF9999 CPF0000 MCH0000) EXEC(GOTO ERROR) /*------------------------------------------------------------------*/ /* SET DEFAULT VALUES */ /*------------------------------------------------------------------*/ CHGVAR VAR(&TOFIL) VALUE(&FRMFIL) CHGVAR VAR(&TOLIB) VALUE(&FRMLIB) CHGVAR VAR(&TOMBR) VALUE(&FRMMBR) RTVNETA SYSNAME(&FRMSYS) IF COND(&FRMSYS *EQ &SYSNM1) THEN(CHGVAR + VAR(&TOSYS) VALUE(&SYSNM2)) IF COND(&FRMSYS *EQ &SYSNM2) THEN(CHGVAR + VAR(&TOSYS) VALUE(&SYSNM1)) /*------------------------------------------------------------------*/ /* BEGIN PROGRAM LOGIC */ /*------------------------------------------------------------------*/ CHGVAR VAR(&PGMQ) VALUE('SNDSRC') RMVMSG PGMQ(*SAME (&PGMQ)) CLEAR(*ALL) LOOP: SNDF RCDFMT(MSGCTL) SNDRCVF RCDFMT(SNDFMT) RMVMSG PGMQ(*SAME (&PGMQ)) CLEAR(*ALL) IF COND((&IN03 *EQ '1') *OR (&IN12 *EQ '1')) + THEN(GOTO CMDLBL(ENDPGM)) /*------------------------------------------------------------------*/ /* CREATE DDMF TO REMOTE SYSTEM */ /*------------------------------------------------------------------*/ CRTDDMF FILE(QTEMP/DDMF) RMTFILE(&TOLIB/&TOFIL) + RMTLOCNAME(&TOSYS) /*------------------------------------------------------------------*/ /* COPY SOURCE MEMBER TO DDMF */ /*------------------------------------------------------------------*/ CPYF FROMFILE(&FRMLIB/&FRMFIL) TOFILE(QTEMP/DDMF) + FROMMBR(&FRMMBR) TOMBR(&TOMBR) + MBROPT(*REPLACE) FMTOPT(*NOCHK) /*------------------------------------------------------------------*/ /* DELETE THE TEMPORARY DDMFILE */ /*------------------------------------------------------------------*/ DLTF FILE(QTEMP/DDMF) GOTO CMDLBL(ENDPGM) /*-------------------------------------------------------------------*/ /* GLOBAL ERROR HANDLING ROUTINE */ /*-------------------------------------------------------------------*/ ERROR: STDERR1: IF COND(&ERRORSW) THEN(SNDPGMMSG MSGID(CPF9999) + MSGF(QCPFMSG) MSGTYPE(*ESCAPE)) CHGVAR VAR(&ERRORSW) VALUE('1') STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) MSGFLIB(&MSGFLIB) IF COND(&MSGID *EQ ' ') THEN(GOTO + CMDLBL(STDERR3)) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*DIAG) GOTO CMDLBL(LOOP) STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) MSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) GOTO CMDLBL(LOOP) /*-------------------------------------------------------------------*/ /* END PROGRAM */ /*-------------------------------------------------------------------*/ ENDPGM: RETURN ENDPGM
Start the conversation
0 comments