midrange.com code scratchpad
Name:
DUPSPLF
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
07/29/2015 03:44:38 pm
IP:
Logged
Description:
Command to duplicate a spoolfile. Options to change user, outq, hold status, and save status.
Code:
  1. CMD:
  2.  UTKDUPSPLF: CMD        PROMPT('DUPLICATE AND CHANGE SPLF')
  3.  
  4.              PARM       KWD(SPLFILE) TYPE(*NAME) LEN(10) DFT(QPRINT) +
  5.                           PROMPT('SPOOLED FILE NAME')
  6.  
  7.              PARM       KWD(JOB) TYPE(JOBNAME) DFT(*) SNGVAL((*)) +
  8.                           PROMPT('JOB NAME')
  9.  
  10.              PARM       KWD(SPLNBR) TYPE(*INT4) DFT(*LAST) RANGE(1 +
  11.                           9999) SPCVAL((*ONLY 0) (*LAST -1)) MIN(0) +
  12.                           PROMPT('SPOOLED FILE NUMBER')
  13.  
  14.              PARM       KWD(NEWUSER) TYPE(*NAME) LEN(10) DFT(*SAME) +
  15.                           SPCVAL((*SAME)) PROMPT('NEW USER')
  16.  
  17.              PARM       KWD(OUTQ) TYPE(OUTQ) DFT(*SAME) +
  18.                           SNGVAL((*SAME)) MIN(0) PROMPT('OUTPUT QUEUE')
  19.  
  20.              PARM       KWD(HOLD) TYPE(*CHAR) LEN(10) RSTD(*YES) +
  21.                           DFT(*SAME) VALUES(*YES *NO) +
  22.                           SPCVAL((*SAME)) PROMPT('HOLD FILE BEFORE +
  23.                           WRITTEN')
  24.  
  25.              PARM       KWD(SAVE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
  26.                           DFT(*SAME) VALUES(*YES *NO) +
  27.                           SPCVAL((*SAME)) PROMPT('SAVE FILE AFTER +
  28.                           WRITTEN')
  29.  
  30.  OUTQ:       QUAL       TYPE(*NAME) LEN(10) MIN(1)
  31.              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
  32.                           SPCVAL((*CURLIB) (*LIBL)) PROMPT('LIBRARY')
  33.  
  34.  JOBNAME:    QUAL       TYPE(*NAME) LEN(10) MIN(1)
  35.              QUAL       TYPE(*NAME) LEN(10) DFT(' ') SPCVAL((' ')) +
  36.                           CHOICE('NAME') PROMPT('USER')
  37.              QUAL       TYPE(*CHAR) LEN(6) DFT(' ') RANGE(000000 +
  38.                           999999) SPCVAL((' ')) FULL(*YES) +
  39.                           CHOICE('000000-999999') PROMPT('NUMBER')
  40.  
  41. RPGLE Command processing program:
  42.      hoption(*nodebugio:*srcstmt) dftactgrp(*no) actgrp('DUPSPLF')
  43.  
  44.      dDupSplf          pr
  45.      d SpoolName                     10a
  46.      d QualJob                       26a
  47.      d SplNbr                        10i 0
  48.      d NewUser                       10a
  49.      d OutQ                          20a
  50.      d Hold                          10a
  51.      d Save                          10a
  52.  
  53.      dDupSplf          pi
  54.      d SpoolName                     10a
  55.      d QualJob                       26a
  56.      d SplNbr                        10i 0
  57.      d NewUser                       10a
  58.      d OutQ                          20a
  59.      d Hold                          10a
  60.      d Save                          10a
  61.  
  62.       * Delete User Space API Procedure
  63.      DDltUsrSpc        pr                  ExtPgm('QUSDLTUS')
  64.      DCUSQualUSName                  20a   CONST
  65.      DErrorCode                   32766A   options(*varsize)
  66.  
  67.       * Create User Space API Procedure
  68.      DCrtUsrSpc        pr                  ExtPgm('QUSCRTUS')
  69.      DCUSQualUSName                  20a   CONST
  70.      DCUSExtAttribut                 10a   CONST
  71.      DCUSInitSize                    10I 0 CONST
  72.      DCUSInitValue                    1a   CONST
  73.      DCUSPublicAuth                  10a   CONST
  74.      DCUSDescription                 50a   CONST
  75.      DCUSReplace                     10a   CONST
  76.      DErrorCode                   32766A   options(*varsize)
  77.  
  78.       * Change User Space API Procedure
  79.      D ChgUsrSpc       PR                  ExtPgm('QUSCUSAT')
  80.      D RtnLib                        10A
  81.      D CUSQualUSName                 20A   CONST
  82.      D CUSAttributes              32766A   Options(*Varsize)
  83.      D ErrorCode                  32766A   Options(*VarSize)
  84.  
  85.       * Get User Space Pointer API Procedure
  86.      D UserSpacePntr   PR                  ExtPgm('QUSPTRUS')
  87.      D CUSQualUSName                 20A   CONST
  88.      D  CUSPointer                     *
  89.  
  90.       * Update User Space API Procedure
  91.      D UpdUsrSpc       PR                  ExtPgm('QUSCHGUS')
  92.      D CUSQualUSName                 20A   Const
  93.      d Start                         10i 0 Const
  94.      d DataLength                    10i 0 Const
  95.      d Data                       32767a   Options(*Varsize) Const
  96.      d ForceASP                       1a   Const
  97.      D ErrorCode                  32766A   Options(*VarSize)
  98.  
  99.       * User Space Header DS
  100.      D USHeader        ds                  Based(CUSPointer) Qualified
  101.      d    UserArea                   64a
  102.      d    HdrSize                    10i 0
  103.      d    StrLvl                      4a
  104.      d    Format                      8a
  105.      d    APIUsed                    10a
  106.      d    CrtDate                    13a
  107.      d    InfoSts                     1a
  108.      d    SizeOfUS                   10i 0
  109.      d    OffsetToInp                10i 0
  110.      d    SizeOfInp                  10i 0
  111.      d    OffsetToHdr                10i 0
  112.      d    SizeOfHdr                  10i 0
  113.      d    OffsetToDtl                10i 0
  114.      d    SizeOfDtl                  10i 0
  115.      d    NumberOfDtl                10i 0
  116.      d    EntrySize                  10i 0
  117.      d    CCSID                      10i 0
  118.      d    Country                     2a
  119.      d    LangID                      3a
  120.      d    SubsetInd                   1a
  121.      d                               42a
  122.  
  123.       * User Space Attributes DS
  124.      D AttributeDS     DS                  Qualified
  125.      D  NbrAttrToChg                 10i 0 Inz(1)
  126.      D  Key                          10i 0 Inz(3)
  127.      D  DataLen                      10i 0 Inz(1)
  128.      D  AutoExtend                    1A   Inz('1')
  129.  
  130.      D RtnLib          s             10a
  131.  
  132.      dErrorDS          ds                  Qualified
  133.      d BytesProvided                 10i 0 Inz(%Size(ErrorDS))
  134.      d BytesAvailable                10i 0
  135.      d MsgID                          7a
  136.      d                                1a
  137.      d Text                         500a   Varying
  138.  
  139.      dSplFUSPtr        s               *
  140.      dSplFUsrSpcHdr    ds                  Qualified Based(SplFUSPtr)
  141.      d UserArea                      64a
  142.      d HeaderSize                    10i 0
  143.      d StructureLvl                   4a
  144.      d SplFLvl                        6a
  145.      d Format                         8a
  146.  
  147.       // I = Incomplete
  148.       // P = Partial
  149.       // C = Complete
  150.      d CompleteInfo                   1a
  151.      d                                1a
  152.      d UsedSizeInUS                  10i 0
  153.      d OffsetToBuffer                10i 0
  154.      d RequestedCount                10i 0
  155.      d ReturnCount                   10i 0
  156.      d DataSize                      10i 0
  157.      d PageCount                     10i 0
  158.      d FirstPage                     10i 0
  159.      d OffsetToFirstPage...
  160.      d                               10i 0
  161.      d                                8a
  162.  
  163.      dBufferInfoPtr    s               *
  164.      dBufferInfo       ds                  Qualified Based(BufferInfoPtr)
  165.      d Length                        10i 0
  166.      d OrdinalPosition...
  167.      d                               10i 0
  168.      d OffsetToGeneralInfo...
  169.      d                               10i 0
  170.      d SizeOfGeneralInfo...
  171.      d                               10i 0
  172.      d OffsetToPageData...
  173.      d                               10i 0
  174.      d SizeOfPageData...
  175.      d                               10i 0
  176.      d PageEntryCount                10i 0
  177.      d PageEntrySize                 10i 0
  178.      d OffsetToPrintData...
  179.      d                               10i 0
  180.      d SizeOfPrintData...
  181.      d                               10i 0
  182.  
  183.      dGeneralInfoPtr   s               *
  184.      dGeneralInfo      ds                  Qualified Based(GeneralInfoPtr)
  185.      d NonBlankLines                 10i 0
  186.      d NonBlanksIn1stPage...
  187.      d                               10i 0
  188.      d ErrorInfoBufferNumber...
  189.      d                               10i 0
  190.      d OffsetToErrorRecovery...
  191.      d                               10i 0
  192.      d SizeOfPrintData...
  193.      d                               10i 0
  194.      d State                         10a
  195.      d LastPageContinues...
  196.      d                                1a
  197.      d AFPDS                          1a
  198.      d LACArrayInBuffer...
  199.      d                                1a
  200.      d LAC                            1a
  201.      d ErrorRecoveryHasLAC...
  202.      d                                1a
  203.      d ErrorRecovery                  1a
  204.      d ZeroPages                      1a
  205.      d LoadFont                       1a
  206.      d IPDSData                       1a
  207.      d                                5a
  208.  
  209.      dPageDataPtr      s               *
  210.      dPageData         ds                  Qualified Based(PageDataPtr)
  211.      d TextStart                     10i 0
  212.      d DataStart                     10i 0
  213.      d Offset                        10i 0
  214.  
  215.      dPrintDataPtr     s               *
  216.      dPrintData        ds                  Qualified Based(PrintDataPtr)
  217.      d Data                       32766a
  218.  
  219.      dRtvSplFA         pr                  ExtPgm('QUSRSPLA')
  220.      d ReturnData                 32766a   Options(*VarSize)
  221.      d ReturnLen                     10i 0 Const
  222.      d Format                         8a   Const
  223.      d QualJob                       26a   Const
  224.      d InternalJobID                 16a   Const
  225.      d InternalSplFID                16a   Const
  226.      d SplFName                      10a   Const
  227.      d SplNum                        10i 0 Const
  228.      d ErrorCode                    584a   Options(*VarSize)
  229.       // Optional Parameters
  230.      d System                         8a   Const Options(*NoPass)
  231.      d SplCrtDate                     7a   Const Options(*NoPass)
  232.      d SplCrtTime                     6a   Const Options(*NoPass)
  233.  
  234.      dOpenSplF         pr                  ExtPgm('QSPOPNSP')
  235.      d SplFHandle                    10i 0
  236.      d QualJob                       26a   Const
  237.      d InternalJobID                 16a   Const
  238.      d InternalSplID                 16a   Const
  239.      d SplF                          10a   Const
  240.      d SplNum                        10i 0 Const
  241.      d BuffersToGet                  10i 0 Const
  242.      d ErrorCode                    584a   Options(*VarSize)
  243.       // Optional Parameters
  244.      d System                         8a   Options(*NoPass)
  245.      d CreateDate                     7a   Options(*NoPass)
  246.      d CreateTime                     6a   Options(*NoPass)
  247.  
  248.      dGetSplFData      pr                  ExtPgm('QSPGETSP')
  249.      d SplFHandle                    10i 0 Const
  250.      d UserSpace                     20a   Const
  251.      d Format                         8a   Const
  252.      d BufferToRead                  10i 0 Const
  253.      d EndOfFile                     10a   Const
  254.      d ErrorCode                    584a   Options(*VarSize)
  255.  
  256.       // Attributes are from SPLA0200 in RtvSplFA
  257.      dCrtSplF          pr                  ExtPgm('QSPCRTSP')
  258.      d Handle                        10i 0
  259.      d Attributes                 32766a   Options(*VarSize) Const
  260.      d ErrorCode                    584a   Options(*VarSize)
  261.  
  262.      dPutSplFData      pr                  ExtPgm('QSPPUTSP')
  263.      d Handle                        10i 0 Const
  264.      d UserSpace                     20a   Const
  265.      d ErrorCode                    584a   Options(*VarSize)
  266.  
  267.      dCloseSplF        pr                  ExtPgm('QSPCLOSP')
  268.      d Handle                        10i 0 Const
  269.      d ErrorCode                    584a   Options(*VarSize)
  270.  
  271.      dDupSplFUS        c                   Const('DUPSPLF   QTEMP')
  272.      dIntJobID         s             16a
  273.      dIntSplID         s             16a
  274.      dSpoolNumber      s             10i 0
  275.      dNumberOfBuffers  s             10i 0 Inz(-1)
  276.      dHandle           s             10i 0
  277.      dNewSplHandle     s             10i 0
  278.      d i               s             10i 0
  279.       /copy QSYSINC/QRPGLESRC,QUSRSPLA
  280.  
  281.       /free
  282.  
  283.            SpoolNumber = SplNbr;
  284.  
  285.          Monitor;
  286.            DltUsrSpc( DupSplFUS
  287.                     : ErrorDS );
  288.          On-Error;
  289.          EndMon;
  290.          Monitor;
  291.            CrtUsrSpc( DupSplFUS
  292.                     : 'USRSPC'
  293.                     : 1024
  294.                     : x'00'
  295.                     : '*ALL'
  296.                     : DupSplFUS
  297.                     : '*NO'
  298.                     : ErrorDS );
  299.            ChgUsrSpc( RtnLib
  300.                     : DupSplFUS
  301.                     : AttributeDS
  302.                     : ErrorDS );
  303.          On-Error;
  304.            ExSR Terminate;
  305.          EndMon;
  306.  
  307.          RtvSplFA( QUSA0200
  308.                  : %Size(QUSA0200)
  309.                  : 'SPLA0200'
  310.                  : QualJob
  311.                  : IntJobID
  312.                  : IntSplID
  313.                  : SpoolName
  314.                  : SpoolNumber
  315.                  : ErrorDS );
  316.  
  317.          If ErrorDS.BytesAvailable <> 0;
  318.            ExSR Terminate;
  319.          EndIf;
  320.  
  321.          OpenSplF( Handle
  322.                  : QualJob
  323.                  : IntJobID
  324.                  : IntSplID
  325.                  : SpoolName
  326.                  : SpoolNumber
  327.                  : NumberOfBuffers
  328.                  : ErrorDS );
  329.          If ErrorDS.BytesAvailable <> 0;
  330.            ExSR Terminate;
  331.          EndIf;
  332.  
  333.          If NewUser <> '*SAME';
  334.            QUSUN13 = NewUser;
  335.          EndIf;
  336.          If OutQ <> '*SAME';
  337.            QUSON01 = %Subst(OutQ:1:10);
  338.            QUSOL01 = %Subst(OutQ:11:10);
  339.          EndIf;
  340.          If Hold <> '*SAME';
  341.            QUSHFIL00 = Hold;
  342.          EndIf;
  343.          If Save <> '*SAME';
  344.            QUSSFIL04 = Save;
  345.          EndIf;
  346.  
  347.          CrtSplF( NewSplHandle
  348.                 : QUSA0200
  349.                 : ErrorDS );
  350.          If ErrorDS.BytesAvailable <> 0;
  351.            ExSR Terminate;
  352.          EndIf;
  353.        For i = 1 To QUSNBRB;
  354.          GetSplFData( Handle
  355.                     : DupSplFUS
  356.                     : 'SPFR0200'
  357.                     : i
  358.                     : '*WAIT'
  359.                     : ErrorDS );
  360.          If ErrorDS.BytesAvailable <> 0;
  361.            ExSR Terminate;
  362.          EndIf;
  363.          UserSpacePntr( DupSplFUS
  364.                     : SplFUSPtr );
  365.  
  366.          PutSplFData( NewSplHandle
  367.                     : DupSplFUS
  368.                     : ErrorDS );
  369.        EndFor;
  370.          CloseSplF( NewSplHandle
  371.                   : ErrorDS );
  372.  
  373.          ExSR Terminate;
  374.  
  375.          BegSR Terminate;
  376.            *InLR = *On;
  377.            Return;
  378.          EndSR;
  379.  
© 2004-2019 by midrange.com generated in 0.011s valid xhtml & css