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