如何將 CPYTOPCD 指令所產生的文件檔案同步複製至另一部 AS/400的相同目錄中？
(How to synchronize CPYTOPCD PC document to another AS/400 Folder)
ile : QCLSRC
Member: CPY2PCDXPC
Type : CLP
Usage : Change CL source &TCPHOST value to your target AS/400 host name
CRTCLPGM QGPL/CPY2PCDXPC TGTRLS(V7R1M0)
OS : V7R1 later
Check PTF SI45985
DSPPTF LICPGM(5770SS1) SELECT(SI45985)
/* ==================================================================*/
/* */
/* Program . . : CPY2PCDXPC */
/* Description : CPYTOPCD Command Exit Program */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : December 17, 2013 */
/* */
/* Program function: Copy PC Document to Another AS/400 */
/* */
/* Usage: */
/* */
/* ADDEXITPGM EXITPNT(QIBM_QCA_RTV_COMMAND) */
/* FORMAT(RTVC0100) PGMNBR(*LOW) */
/* PGM(QGPL/CPY2PCDXPC) */
/* PGMDTA(*JOB 30 'CPYTOPCD QSYS *AFTER ') */
/* */
/* Compile options: */
/* Change CL &TCPHOST value to your target AS/400 host name */
/* CrtClPgm Pgm( QGPL/CPY2PCDXPC ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* Log( *YES ) */
/* */
/* ================================================================= */
Pgm ( &Cmd_Info )
Dcl &Cmd_Info *Char 4000
Dcl &Ep_Name *Char 20 Stg( *Defined ) DefVar(&Cmd_Info 1)
Dcl &Ep_Format *Char 8 Stg( *Defined ) DefVar(&Cmd_Info 21)
Dcl &Cmd_Name *Char 10 Stg( *Defined ) DefVar(&Cmd_Info 29)
Dcl &Cmd_Lib *Char 10 Stg( *Defined ) DefVar(&Cmd_Info 39)
Dcl &Reserved1 *Char 2 Stg( *Defined ) DefVar(&Cmd_Info 49)
Dcl &Before_Aft *Char 1 Stg( *Defined ) DefVar(&Cmd_Info 51)
Dcl &Reserved2 *Char 1 Stg( *Defined ) DefVar(&Cmd_Info 52)
Dcl &Off_InlCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 53)
Dcl &Len_InlCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 57)
Dcl &Off_RplCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 61)
Dcl &Len_RplCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 65)
Dcl &Off_Prx *Int Stg( *Defined ) DefVar(&Cmd_Info 69)
Dcl &Nbr_Prx *Int Stg( *Defined ) DefVar(&Cmd_Info 73)
Dcl &Offset *Int
Dcl &Length *Int
Dcl &Cmd *Char 256
Dcl &ToFlr *Char 63
Dcl &ToDoc *Char 12
Dcl &PKD_INLCMD *Dec (3 0)
Dcl &STRPOS *Dec (3 0) VALUE(1)
Dcl &LEN_OPTION *Dec (3 0) VALUE(7)
Dcl &RESULT *Dec (3 0)
Dcl &STRLEN *Dec (3 0)
Dcl "E *Char 1 VALUE(X'7D')
Dcl &TCPHOST *Char 10 VALUE('AS400HOST')
Dcl &CPYSTR *Char 256
Dcl &CPYSTRLEN *Dec (15 5) VALUE(256)
Dcl &MDSTR *Char 256
Dcl &I *Int
Dcl &MsgTxt *Char 256
Dcl &MsgId *Char 7
Dcl &FromMbr *Char 10
Dcl &File *Char 10
Dcl &FileLib *Char 10
Dcl &FileLibStr *Char 21
Dcl &PKD_FrmF *dec (3 0)
Dcl &IfsObj *Char 256
Dcl &RtnValDec *dec (5 0)
Dcl &DirName *Char 256
MonMsg (CPC0000 CPD0000 CPF0000 HAE0000) *N (GOTO ERROR)
If ( &BEFORE_AFT *EQ '1' ) Do
If ( &OFF_RPLCMD = 0 ) Do
ChgVar &OFFSET ( &OFF_INLCMD + 1 )
ChgVar &LENGTH &LEN_INLCMD
EndDo
Else Do
ChgVar &OFFSET (&OFF_RPLCMD + 1)
ChgVar &LENGTH &LEN_RPLCMD
EndDo
EndDo
If ( &CMD_NAME *EQ 'CPYTOPCD ') Do
ChgVar &CMD %SST(&CMD_INFO &OFFSET &LENGTH)
ChgVar &PKD_INLCMD &LENGTH
/*-- Search FROMFILE: -----------------------------------------------*/
ChgVar &STRPOS 1
ChgVar &LEN_OPTION 9
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'FROMFILE(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If (&Result > 0 ) Do
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 9)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &FileLibStr %SST(&CMD &STRPOS &STRLEN)
ChgVar &STRPOS 1
ChgVar &PKD_FrmF 21
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &FileLibStr +
&PKD_FrmF +
&STRPOS +
'/' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If ( &Result > 0 ) Do
ChgVar &STRLEN (&RESULT - 1)
ChgVar &FileLib %SST(&FileLibStr 1 &StrLen)
ChgVar &STRPOS (&RESULT + 1)
ChgVar &File %SST(&FileLibStr &StrPos 10)
RtvMbrD File(&FILELIB/&FILE) RtnLib(&FILELIB)
MonMsg CPF0000 *N (Goto Return)
EndDo
Else Do
ChgVar &File %SST(&FileLibStr 1 10)
RtvMbrD File(&FILE) RtnLib(&FILELIB)
MonMsg CPF0000 *N (Goto Return)
EndDo
ChkObj Obj(&FILELIB/&FILE) ObjType(*FILE)
MonMsg CPF0000 *N (Goto Return)
EndDo
/*-- Search TOFLR: -------------------------------------------------*/
ChgVar &LEN_OPTION 6
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'TOFLR(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 6)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &TOFLR %SST(&CMD &STRPOS &STRLEN)
DoFor &I 1 63
If (%SST(&TOFLR &I 1) *EQ "E) +
ChgVar %SST(&TOFLR &I 1) ' '
EndDo
ChgVar &ToFlr %Trim(&ToFlr)
/*-- Search FROMMBR: ------------------------------------------------*/
ChgVar &STRPOS 1
ChgVar &LEN_OPTION 8
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'FROMMBR(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If (&Result > 0 ) Do
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 8)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &FromMbr %SST(&CMD &STRPOS &STRLEN)
If ( &FromMbr = '*FIRST' ) Do
RtvMbrD File(&FILELIB/&FILE) Mbr(*FIRST) RtnMbr(&FromMbr)
MonMsg CPF0000 *N (Goto Return)
EndDo
Else Do
RtvMbrD File(&FILELIB/&FILE) Mbr(&FromMbr) RtnMbr(&FromMbr)
MonMsg CPF0000 *N (Goto Return)
EndDo
EndDo
Else Do
RtvMbrD File(&FILELIB/&FILE) Mbr(*FIRST) RtnMbr(&FromMbr)
MonMsg CPF0000 *N (Goto Return)
EndDo
/*-- Search TODOC: -------------------------------------------------*/
ChgVar &STRPOS 1
ChgVar &LEN_OPTION 6
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'TODOC(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If (&Result > 0 ) Do
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 6)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &TODOC %SST(&CMD &STRPOS &STRLEN)
If ( &FromMbr = '*FROMMBR' ) Do
ChgVar &TODOC &FromMbr
EndDo
EndDo
Else Do
ChgVar &TODOC &FromMbr
EndDo
DoFor &I 1 12
If (%SST(&ToDoc &I 1) *EQ "E) +
ChgVar %SST(&ToDoc &I 1) ' '
EndDo
ChgVar &ToDoc %Trim(&ToDoc)
/*-------------------------------------------------------------------*/
/*-- Check IFS Object exist ? ---------------------------------------*/
/*-- The IFS object must exist before CPY operation, because the */
/*-- exit program run after CPYTOPCD completed. */
/*-- But that command completed : */
/*-- 1. normal completed. => We do CPY for this */
/*-- 2. normal completed with exception. => We ignore this */
/*-------------------------------------------------------------------*/
ChgVar &IfsObj ('/QDLS/' *CAT +
&TOFLR *TCAT '/' *CAT &TODOC)
Call ChkIfsObj (&IfsObj &RtnValDec)
If (&RtnValDec *NE 0 ) (Goto Return)
ChgVar &CpyStr ('CPY OBJ(' *CAT "E *CAT +
'/QDLS/' *CAT +
&TOFLR *TCAT '/' *CAT &TODOC *TCAT +
"E *CAT ')' *BCAT +
'TODIR(' *CAT "E *CAT +
'/QFileSvr.400/' *CAT &TCPHOST *TCAT +
'/QDLS/' *CAT +
&TOFLR *TCAT +
"E *CAT ')' *BCAT +
'DTAFMT(*BINARY) REPLACE(*YES)')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&CpyStr) -
TOUSR(*SYSOPR)
ChgVar &MDSTR ( '/QFileSvr.400/' *CAT &TCPHOST )
MD &MDSTR
MonMsg CPFA0A0
Call QCMDEXC ( &CPYSTR +
&CPYSTRLEN +
)
EndDo
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
DmpClPgm
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
ChgVar &DirName ('/QFileSvr.400/' *CAT &TCPHOST)
Rmdir dir(&DirName) Rmvlnk(*Yes)
EndPgm
File : QCLSRC
Member: CHKIFSOBJ
Type : CLLE
Usage : CRTBNDCL CHKIFSOBJ
Pgm (&IfsObj &RtnValDec)
Dcl VAR(&IFSOBJ) TYPE(*CHAR) LEN(256)
Dcl VAR(&IFSOBJS) TYPE(*CHAR) LEN(256)
Dcl VAR(&RTNVALBIN) TYPE(*CHAR) LEN(4)
Dcl VAR(&RTNVALDEC) TYPE(*DEC) LEN(5 0)
Dcl VAR(&PATH) TYPE(*CHAR) LEN(100)
Dcl VAR(&RECEIVER) TYPE(*CHAR) LEN(4096)
Dcl VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
Dcl VAR(&OBJTYPE) TYPE(*CHAR) LEN(7)
ChgVar &IFSOBJS &IFSOBJ
ChgVar &IFSOBJ (&IFSOBJ *TCAT &NULL)
CallPrc Prc('stat') Parm(&IFSOBJ &RECEIVER) +
RtnVal(%BIN(&RTNVALBIN))
ChgVar &RtnValDec (%BIN( &RTNVALBIN ))
If (&RtnValDec *NE 0) THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
Object ' *CAT &IFSOBJS *TCAT ' not found') +
MSGTYPE(*DIAG))
EndPgm
參考資訊:
This new support allows you to designate a program that is to be called when the command processing program (CPP) of a CL command completes.
This new support—which is available as PTFs for V5R4 (SI45987), 6.1 (SI45986), and 7.1 (SI45985).
The CL Corner: New Support for CL Commands Lets You Know When a Command Ends
星期四, 11月 09, 2023
2013-12-17 如何將 CPYTOPCD 指令所產生的文件檔案同步複製至另一部 AS/400的相同目錄中？
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言