midrange.com code scratchpad
Name:
CPYTOPCD command exit program for exit point QIBM_QCA_RTV_COMMAND *AFTER
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
12/17/2013 08:25:50 am
IP:
Logged
Description:
How to synchronize CPYTOPCD PC document to another AS/400 Folder ?

QIBM_QCA_RTV_COMMAND *AFTER support:
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).
Code:
  1. File  : QCLSRC
  2. Member: CPY2PCDXPC
  3. Type  : CLP
  4. Usage : Change CL source &TCPHOST value to your target AS/400 host name
  5.         CRTCLPGM QGPL/CPY2PCDXPC TGTRLS(V7R1M0)
  6. OS    : V7R1 later
  7.         Check PTF SI45985 
  8.         DSPPTF LICPGM(5770SS1) SELECT(SI45985)
  9.  
  10. /* ==================================================================*/
  11. /*                                                                   */
  12. /*  Program . . : CPY2PCDXPC                                         */
  13. /*  Description : CPYTOPCD Command Exit Program                      */
  14. /*  Author  . . : Vengoal Chang                                      */
  15. /*  Published . : AS400ePaper                                        */
  16. /*  Date  . . . : December 17, 2013                                  */
  17. /*                                                                   */
  18. /*  Program function:  Copy PC Document to Another AS/400            */
  19. /*                                                                   */
  20. /*  Usage:                                                           */
  21. /*                                                                   */
  22. /*  ADDEXITPGM EXITPNT(QIBM_QCA_RTV_COMMAND)                         */
  23. /*     FORMAT(RTVC0100) PGMNBR(*LOW)                                 */
  24. /*     PGM(QGPL/CPY2PCDXPC)                                          */
  25. /*     PGMDTA(*JOB 30 'CPYTOPCD  QSYS      *AFTER    ')              */
  26. /*                                                                   */
  27. /*  Compile options:                                                 */
  28. /*    Change CL  &TCPHOST value to your target AS/400 host name      */
  29. /*    CrtClPgm   Pgm( QGPL/CPY2PCDXPC )                              */
  30. /*               SrcFile( QCLSRC )                                   */
  31. /*               SrcMbr( *PGM )                                      */
  32. /*               Log( *YES )                                         */
  33. /*                                                                   */
  34. /* ================================================================= */
  35.     Pgm   ( &Cmd_Info )
  36.  
  37.     Dcl   &Cmd_Info   *Char  4000
  38.     Dcl   &Ep_Name    *Char    20  Stg( *Defined )  DefVar(&Cmd_Info 1)
  39.     Dcl   &Ep_Format  *Char     8  Stg( *Defined )  DefVar(&Cmd_Info 21)
  40.     Dcl   &Cmd_Name   *Char    10  Stg( *Defined )  DefVar(&Cmd_Info 29)
  41.     Dcl   &Cmd_Lib    *Char    10  Stg( *Defined )  DefVar(&Cmd_Info 39)
  42.     Dcl   &Reserved1  *Char     2  Stg( *Defined )  DefVar(&Cmd_Info 49)
  43.     Dcl   &Before_Aft *Char     1  Stg( *Defined )  DefVar(&Cmd_Info 51)
  44.     Dcl   &Reserved2  *Char     1  Stg( *Defined )  DefVar(&Cmd_Info 52)
  45.     Dcl   &Off_InlCmd *Int         Stg( *Defined )  DefVar(&Cmd_Info 53)
  46.     Dcl   &Len_InlCmd *Int         Stg( *Defined )  DefVar(&Cmd_Info 57)
  47.     Dcl   &Off_RplCmd *Int         Stg( *Defined )  DefVar(&Cmd_Info 61)
  48.     Dcl   &Len_RplCmd *Int         Stg( *Defined )  DefVar(&Cmd_Info 65)
  49.     Dcl   &Off_Prx    *Int         Stg( *Defined )  DefVar(&Cmd_Info 69)
  50.     Dcl   &Nbr_Prx    *Int         Stg( *Defined )  DefVar(&Cmd_Info 73)
  51.     Dcl   &Offset     *Int
  52.     Dcl   &Length     *Int
  53.     Dcl   &Cmd        *Char   256
  54.     Dcl   &ToFlr      *Char    63
  55.     Dcl   &ToDoc      *Char    12
  56.     Dcl   &PKD_INLCMD *Dec     (3 0)
  57.     Dcl   &STRPOS     *Dec     (3 0) VALUE(1)
  58.     Dcl   &LEN_OPTION *Dec     (3 0) VALUE(7)
  59.     Dcl   &RESULT     *Dec     (3 0)
  60.     Dcl   &STRLEN     *Dec     (3 0)
  61.     Dcl   &QUOTE      *Char     1    VALUE(X'7D')
  62.     Dcl   &TCPHOST    *Char    10    VALUE('AS400HOST')
  63.     Dcl   &CPYSTR     *Char   256
  64.     Dcl   &CPYSTRLEN  *Dec    (15 5) VALUE(256)
  65.     Dcl   &MDSTR      *Char   256
  66.     Dcl   &I          *Int
  67.     Dcl   &MsgTxt     *Char   256
  68.     Dcl   &MsgId      *Char     7
  69.     Dcl   &FromMbr    *Char    10
  70.     Dcl   &File       *Char    10
  71.     Dcl   &FileLib    *Char    10
  72.     Dcl   &FileLibStr *Char    21
  73.     Dcl   &PKD_FrmF   *dec     (3 0)
  74.     Dcl   &IfsObj     *Char   256
  75.     Dcl   &RtnValDec  *dec     (5 0)
  76.     Dcl   &DirName    *Char   256
  77.  
  78.      MonMsg (CPC0000 CPD0000 CPF0000 HAE0000) *N  (GOTO ERROR)
  79.  
  80.  
  81.      If       ( &BEFORE_AFT *EQ '1' ) Do
  82.      If       ( &OFF_RPLCMD = 0 )     Do
  83.      ChgVar     &OFFSET      ( &OFF_INLCMD + 1 )
  84.      ChgVar     &LENGTH      &LEN_INLCMD
  85.      EndDo
  86.      Else Do
  87.      ChgVar     &OFFSET      (&OFF_RPLCMD + 1)
  88.      ChgVar     &LENGTH      &LEN_RPLCMD
  89.      EndDo
  90.      EndDo
  91.  
  92.      If       ( &CMD_NAME *EQ 'CPYTOPCD  ') Do
  93.      ChgVar     &CMD         %SST(&CMD_INFO &OFFSET &LENGTH)
  94.      ChgVar     &PKD_INLCMD  &LENGTH
  95.  
  96. /*-- Search FROMFILE: -----------------------------------------------*/
  97.      ChgVar     &STRPOS      1
  98.      ChgVar     &LEN_OPTION  9
  99.      CALL       QCLSCAN    ( &CMD                                    +
  100.                              &PKD_INLCMD                             +
  101.                              &STRPOS                                 +
  102.                              'FROMFILE('                             +
  103.                              &LEN_OPTION                             +
  104.                              '0'                                     +
  105.                              '0'                                     +
  106.                              ' '                                     +
  107.                              &RESULT)
  108.  
  109.      If  (&Result > 0 )  Do
  110.      ChgVar     &STRPOS      &RESULT
  111.      ChgVar     &LEN_OPTION  1
  112.      CALL       QCLSCAN    ( &CMD                                    +
  113.                              &PKD_INLCMD                             +
  114.                              &STRPOS                                 +
  115.                              ')'                                     +
  116.                              &LEN_OPTION                             +
  117.                              '0'                                     +
  118.                              '0'                                     +
  119.                              ' '                                     +
  120.                              &RESULT)
  121.      ChgVar     &STRPOS      (&STRPOS + 9)
  122.      ChgVar     &STRLEN      (&RESULT - &STRPOS)
  123.      ChgVar     &FileLibStr  %SST(&CMD &STRPOS &STRLEN)
  124.  
  125.      ChgVar     &STRPOS      1
  126.      ChgVar     &PKD_FrmF    21
  127.      ChgVar     &LEN_OPTION  1
  128.      CALL       QCLSCAN    ( &FileLibStr                             +
  129.                              &PKD_FrmF                               +
  130.                              &STRPOS                                 +
  131.                              '/'                                     +
  132.                              &LEN_OPTION                             +
  133.                              '0'                                     +
  134.                              '0'                                     +
  135.                              ' '                                     +
  136.                              &RESULT)
  137.      If  ( &Result > 0 )  Do
  138.      ChgVar     &STRLEN      (&RESULT - 1)
  139.      ChgVar     &FileLib     %SST(&FileLibStr 1 &StrLen)
  140.      ChgVar     &STRPOS      (&RESULT + 1)
  141.      ChgVar     &File        %SST(&FileLibStr &StrPos 10)
  142.      RtvMbrD    File(&FILELIB/&FILE) RtnLib(&FILELIB)
  143.      MonMsg     CPF0000      *N       (Goto Return)
  144.      EndDo
  145.      Else  Do
  146.      ChgVar     &File        %SST(&FileLibStr 1 10)
  147.      RtvMbrD    File(&FILE) RtnLib(&FILELIB)
  148.      MonMsg     CPF0000      *N       (Goto Return)
  149.      EndDo
  150.  
  151.      ChkObj     Obj(&FILELIB/&FILE) ObjType(*FILE)
  152.      MonMsg     CPF0000      *N       (Goto Return)
  153.      EndDo
  154.  
  155. /*-- Search TOFLR:  -------------------------------------------------*/
  156.      ChgVar     &LEN_OPTION  6
  157.      CALL       QCLSCAN    ( &CMD                                    +
  158.                              &PKD_INLCMD                             +
  159.                              &STRPOS                                 +
  160.                              'TOFLR('                                +
  161.                              &LEN_OPTION                             +
  162.                              '0'                                     +
  163.                              '0'                                     +
  164.                              ' '                                     +
  165.                              &RESULT)
  166.  
  167.      ChgVar     &STRPOS      &RESULT
  168.      ChgVar     &LEN_OPTION  1
  169.      CALL       QCLSCAN    ( &CMD                                    +
  170.                              &PKD_INLCMD                             +
  171.                              &STRPOS                                 +
  172.                              ')'                                     +
  173.                              &LEN_OPTION                             +
  174.                              '0'                                     +
  175.                              '0'                                     +
  176.                              ' '                                     +
  177.                              &RESULT)
  178.      ChgVar     &STRPOS      (&STRPOS + 6)
  179.      ChgVar     &STRLEN      (&RESULT - &STRPOS)
  180.      ChgVar     &TOFLR       %SST(&CMD &STRPOS &STRLEN)
  181.  
  182.      DoFor      &I           1       63
  183.       If        (%SST(&TOFLR &I 1) *EQ &QUOTE) +
  184.          ChgVar  %SST(&TOFLR &I 1) ' '
  185.      EndDo
  186.      ChgVar     &ToFlr       %Trim(&ToFlr)
  187.  
  188. /*-- Search FROMMBR: ------------------------------------------------*/
  189.      ChgVar     &STRPOS      1
  190.      ChgVar     &LEN_OPTION  8
  191.      CALL       QCLSCAN    ( &CMD                                    +
  192.                              &PKD_INLCMD                             +
  193.                              &STRPOS                                 +
  194.                              'FROMMBR('                              +
  195.                              &LEN_OPTION                             +
  196.                              '0'                                     +
  197.                              '0'                                     +
  198.                              ' '                                     +
  199.                              &RESULT)
  200.  
  201.      If  (&Result > 0 )  Do
  202.      ChgVar     &STRPOS      &RESULT
  203.      ChgVar     &LEN_OPTION  1
  204.      CALL       QCLSCAN    ( &CMD                                    +
  205.                              &PKD_INLCMD                             +
  206.                              &STRPOS                                 +
  207.                              ')'                                     +
  208.                              &LEN_OPTION                             +
  209.                              '0'                                     +
  210.                              '0'                                     +
  211.                              ' '                                     +
  212.                              &RESULT)
  213.      ChgVar     &STRPOS      (&STRPOS + 8)
  214.      ChgVar     &STRLEN      (&RESULT - &STRPOS)
  215.      ChgVar     &FromMbr     %SST(&CMD &STRPOS &STRLEN)
  216.  
  217.      If  ( &FromMbr = '*FIRST' )  Do
  218.      RtvMbrD    File(&FILELIB/&FILE) Mbr(*FIRST) RtnMbr(&FromMbr)
  219.      MonMsg     CPF0000      *N       (Goto Return)
  220.      EndDo
  221.      Else  Do
  222.      RtvMbrD    File(&FILELIB/&FILE) Mbr(&FromMbr) RtnMbr(&FromMbr)
  223.      MonMsg     CPF0000      *N       (Goto Return)
  224.      EndDo
  225.  
  226.      EndDo
  227.      Else Do
  228.      RtvMbrD    File(&FILELIB/&FILE) Mbr(*FIRST) RtnMbr(&FromMbr)
  229.      MonMsg     CPF0000      *N       (Goto Return)
  230.      EndDo
  231.  
  232. /*-- Search TODOC:  -------------------------------------------------*/
  233.      ChgVar     &STRPOS      1
  234.      ChgVar     &LEN_OPTION  6
  235.      CALL       QCLSCAN    ( &CMD                                    +
  236.                              &PKD_INLCMD                             +
  237.                              &STRPOS                                 +
  238.                              'TODOC('                                +
  239.                              &LEN_OPTION                             +
  240.                              '0'                                     +
  241.                              '0'                                     +
  242.                              ' '                                     +
  243.                              &RESULT)
  244.  
  245.      If  (&Result > 0 )  Do
  246.      ChgVar     &STRPOS      &RESULT
  247.      ChgVar     &LEN_OPTION  1
  248.      CALL       QCLSCAN    ( &CMD                                    +
  249.                              &PKD_INLCMD                             +
  250.                              &STRPOS                                 +
  251.                              ')'                                     +
  252.                              &LEN_OPTION                             +
  253.                              '0'                                     +
  254.                              '0'                                     +
  255.                              ' '                                     +
  256.                              &RESULT)
  257.      ChgVar     &STRPOS      (&STRPOS + 6)
  258.      ChgVar     &STRLEN      (&RESULT - &STRPOS)
  259.      ChgVar     &TODOC       %SST(&CMD &STRPOS &STRLEN)
  260.      If  ( &FromMbr = '*FROMMBR' )  Do
  261.      ChgVar     &TODOC       &FromMbr
  262.      EndDo
  263.      EndDo
  264.      Else  Do
  265.      ChgVar     &TODOC       &FromMbr
  266.      EndDo
  267.  
  268.      DoFor      &I           1       12
  269.       If        (%SST(&ToDoc &I 1) *EQ &QUOTE) +
  270.          ChgVar  %SST(&ToDoc &I 1) ' '
  271.      EndDo
  272.      ChgVar     &ToDoc       %Trim(&ToDoc)
  273.  
  274. /*-------------------------------------------------------------------*/
  275. /*-- Check IFS Object exist ? ---------------------------------------*/
  276. /*--   The IFS object must exist before CPY operation, because the   */
  277. /*--   exit program run after CPYTOPCD completed.                    */
  278. /*--   But that command completed :                                  */
  279. /*--   1. normal completed.                => We do CPY for this     */
  280. /*--   2. normal completed with exception. => We ignore this         */
  281. /*-------------------------------------------------------------------*/
  282.      ChgVar     &IfsObj      ('/QDLS/' *CAT +
  283.                               &TOFLR *TCAT '/' *CAT &TODOC)
  284.      Call       ChkIfsObj    (&IfsObj &RtnValDec)
  285.      If  (&RtnValDec *NE 0 )  (Goto Return)
  286.  
  287.  
  288.      ChgVar     &CpyStr      ('CPY OBJ(' *CAT &QUOTE *CAT +
  289.                               '/QDLS/' *CAT +
  290.                               &TOFLR *TCAT '/' *CAT &TODOC *TCAT +
  291.                               &QUOTE *CAT ')' *BCAT               +
  292.                               'TODIR(' *CAT &QUOTE *CAT  +
  293.                               '/QFileSvr.400/' *CAT &TCPHOST *TCAT +
  294.                               '/QDLS/' *CAT  +
  295.                               &TOFLR *TCAT   +
  296.                               &QUOTE *CAT ')' *BCAT +
  297.                               'DTAFMT(*BINARY) REPLACE(*YES)')
  298.  
  299.      SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&CpyStr) -
  300.                 TOUSR(*SYSOPR)
  301.  
  302.      ChgVar     &MDSTR       ( '/QFileSvr.400/' *CAT &TCPHOST )
  303.      MD         &MDSTR
  304.      MonMsg     CPFA0A0
  305.  
  306.      Call       QCMDEXC    ( &CPYSTR                                 +
  307.                              &CPYSTRLEN                              +
  308.                            )
  309.  
  310.      EndDo
  311.  
  312.  Return:
  313.      Return
  314.  
  315. /*-- Error handling:  -----------------------------------------------*/
  316.  Error:
  317.      DmpClPgm
  318.  
  319.      Call      QMHMOVPM    ( '    '                                  +
  320.                              '*DIAG'                                 +
  321.                              x'00000001'                             +
  322.                              '*PGMBDY'                               +
  323.                              x'00000001'                             +
  324.                              x'0000000800000000'                     +
  325.                            )
  326.  
  327.      Call      QMHRSNEM    ( '    '                                  +
  328.                              x'0000000800000000'                     +
  329.                            )
  330.  
  331.  EndPgm:
  332.      ChgVar     &DirName     ('/QFileSvr.400/' *CAT &TCPHOST)
  333.      Rmdir      dir(&DirName) Rmvlnk(*Yes)
  334.      EndPgm
  335.  
  336.  
  337. ==========================================================
  338. File  : QCLSRC
  339. Member: CHKIFSOBJ
  340. Type  : CLLE
  341. Usage : CRTBNDCL CHKIFSOBJ
  342.  
  343. Pgm    (&IfsObj  &RtnValDec)
  344.  
  345.   Dcl       VAR(&IFSOBJ)     TYPE(*CHAR) LEN(256)
  346.   Dcl       VAR(&IFSOBJS)    TYPE(*CHAR) LEN(256)
  347.   Dcl       VAR(&RTNVALBIN)  TYPE(*CHAR) LEN(4)
  348.   Dcl       VAR(&RTNVALDEC)  TYPE(*DEC) LEN(5 0)
  349.   Dcl       VAR(&PATH)       TYPE(*CHAR) LEN(100)
  350.   Dcl       VAR(&RECEIVER)   TYPE(*CHAR) LEN(4096)
  351.   Dcl       VAR(&NULL)       TYPE(*CHAR) LEN(1) VALUE(X'00')
  352.   Dcl       VAR(&OBJTYPE)    TYPE(*CHAR) LEN(7)
  353.  
  354.   ChgVar     &IFSOBJS        &IFSOBJ
  355.   ChgVar     &IFSOBJ         (&IFSOBJ *TCAT &NULL)
  356.  
  357.   CallPrc    Prc('stat') Parm(&IFSOBJ &RECEIVER) +
  358.                RtnVal(%BIN(&RTNVALBIN))
  359.  
  360.   ChgVar     &RtnValDec      (%BIN( &RTNVALBIN ))
  361.  
  362.  
  363.   If  (&RtnValDec *NE 0) THEN(SNDPGMMSG +
  364.                MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
  365.                Object ' *CAT &IFSOBJS *TCAT ' not found') +
  366.                MSGTYPE(*DIAG))
  367.  
  368. EndPgm
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css