*======================================================================== * * CRTBNDRPG PGM(QGPL/F_TO_STMF) SRCFILE(*LIBL/QRPGLESRC) * DFTACTGRP(*NO) ACTGRP(*CALLER) DBGVIEW(*SOURCE) * *======================================================================== D F_TO_STMF pr D fromfilelib 20 D toStmf 256 D mbr 10 D dtafmt 7 D toccsid 5p 0 D dspstmf 4 D F_TO_STMF pi D fromfilelib 20 D toStmf 256 D mbr 10 D dtafmt 7 D toccsid 5p 0 D dspstmf 4 *=================================== D file s 10 D lib s 10 D toMbr s 10 D toCCSIDchar s 10 varying D rc s 10i 0 D srcf s 10 inz('SRC_F') D rcdlen s 10i 0 D fromMbr s 128 varying D cvtdta s 5 D job_CCSIDSave s 10u 0 D chgJobCCSIDIn s n D msg s 500 D rcvvar1 ds D job_data 600 D job_type 1 overlay(job_data:61) job type D job_CCSID 10u 0 overlay(job_data:301) job CCSID D job_dftCCSID 10u 0 overlay(job_data:373) job default CCSID D rcvvar2 ds D qdb_data 4000 D QdbfMaxRcdL 5u 0 overlay(qdb_data:305) max record length D qusec ds D qusbprv 10i 0 inz(%size(qusec)) Bytes Provided D qusbavl 10i 0 inz(0) Bytes Available D qusei 7 Exception Id D qursvd1 1 Reserved D qusMsgData 500 *=================================== D DoCmd pr 10i 0 D cmd 2000 const varying options(*varsize) D RtvJobI pr 600 D RtvDBFD pr 4000 D filename 10 D filelib 10 D DspError pr D msg 500 *======================================================================== /free if dtafmt='*BINARY' and toCCSID<>0; msg='DTAFMT(*BINARY) supported only for TOCCSID(*DFT)'; dspError(msg); endif; // Retrieve job CCSID "job_CCSID" and job default CCSID "job_dftCCSID" rcvvar1=RtvJobI(); // If needed, change the job CCSID to the job default CCSID if job_CCSID=65535; rc=doCmd('chgjob CCSID(' + %trim(%char(job_dftCCSID)) + ')'); if rc=0; chgJobCCSIDIn=*on; job_CCSIDsave=job_CCSID; endif; endif; file=%subst(fromfilelib:1:10); lib=%subst(fromfilelib:11:10); if mbr='*FIRST'; toMbr='FIRST'; endif; select; when toCCSID=0; toCCSIDchar=%trim(%char(job_dftCCSID)); when toCCSID=-1; toCCSIDchar='*STDASCII'; when toCCSID=-2; toCCSIDchar='*PCASCII'; other; toCCSIDchar=%trim(%char(toCCSID)); endsl; if dtafmt='*BINARY'; toCCSIDchar='*STMF'; endif; select; when dtafmt='*BINARY'; cvtdta='*NONE'; when dtafmt='*TEXT'; cvtdta='*AUTO'; endsl; // Check input db file rc=doCmd('chkobj ' + %trim(lib) + '/' + %trim(file) + ' *file'); if rc<>0; msg='File ' + %trim(lib) + '/' + %trim(file) + ' not found'; dspError(msg); endif; // Check input db file member rc=doCmd('chkobj ' + %trim(lib) + '/' + %trim(file) + ' *file mbr(' + %trim(mbr) + ')'); if rc<>0; msg='Member ' + %trim(mbr) + ' not found in + file ' + %trim(lib) + '/' + %trim(file); dspError(msg); endif; // Retrieve record length "QdbfMaxRcdL" rcvvar2=RtvDbfD(file:lib); // Create source file QSRC_F in library QTEMP rc=doCmd('dltf qtemp/' + %trim(srcf)); rcdlen=QdbfMaxRcdL+12; rc=doCmd('crtsrcpf qtemp/' + %trim(srcf) + ' rcdlen(' + %trim(%char(rcdlen)) + ')'); // Copy file data to source file QSRC_F in library QTEMP rc=doCmd('cpyf fromfile(' + %trim(lib) + '/' + %trim(file) + ') + tofile(qtemp/' + %trim(srcf) + ') + frommbr(' + %trim(mbr) + ') + tombr(' + %trim(toMbr) + ') + mbropt(*replace) crtfile(*yes) fmtopt(*cvtsrc)'); // Copy source file member to stream file rc=docmd('del ''' + %trim(tostmf) + ''''); frommbr='/QSYS.LIB/QTEMP.LIB/' + %trim(srcf) + '.FILE/' + %trim(tombr) + '.MBR'; rc=doCmd('cpytostmf frommbr(''' + frommbr + ''') + tostmf(''' + %trim(tostmf) + ''') + stmfopt(*replace) cvtdta(' + %trim(cvtdta) + ') + stmfcodpag(' + toCCSIDchar + ')'); if rc<>0; msg='Command failed. See previous joblog message'; dspError(msg); endif; if dspstmf='*YES' and job_type='I'; rc=docmd('dspf ''' + %trim(tostmf) + ''''); endif; // reset job CCSID to its original value if chgJobCCSIDIn=*on; rc=doCmd('chgjob CCSID(' + %trim(%char(job_CCSIDsave)) + ')'); endif; return; /end-free *======================================================================== * Execute command P doCmd b D doCmd pi 10i 0 D cmd 2000 const varying options(*varsize) D qcmdexc pr extpgm('QCMDEXC') D theCmd 2000 const D theCmdLen 15p 5 const /free monitor; qcmdexc(%subst(cmd:1:%len(cmd)):%len(cmd)); on-error; return 1; endmon; return 0; /end-free P doCmd e *======================================================================== * Retrieve job information P RtvJobI b D RtvJobI pi 600 D API pr extpgm('QUSRJOBI') D rcvvar 600 D rcvvarl 9b 0 D fmtname 8 D qualJobname 26 D intJobID 16 D errcode like(qusec) D xrcvvar s 600 D xrcvvarl s 9b 0 inz(%size(xrcvvar)) D xfmtname s 8 inz('JOBI0400') D xqualJobname s 26 inz('*') D xintJobID s 16 /free API(xrcvvar:xrcvvarl:xfmtname: xqualJobname:xintJobID:qusec); return xrcvvar; /end-free P RtvJobI e *======================================================================== * Retrieve database description P RtvDBFD b D RtvDBFD pi 4000 D filename 10 D filelib 10 D API pr extpgm('QDBRTVFD') D rcvvar 400 D rcvvarl 9b 0 D rtnqfilename 20 D fmtname 8 D qfilename 8 D rcdfmtname 10 D ovrprc 1 D system 10 D fmttype 10 D errcode like(qusec) D xrcvvar s 4000 D xrcvvarl s 9b 0 inz(%size(xrcvvar)) D xrtnqfilename s 20 D xfmtname s 8 inz('FILD0100') D xqfilename s 20 D xrcdfmtname s 10 D xovrprc s 1 inz('0') D xsystem s 10 inz('*LCL') D xfmttype s 10 inz('*EXT') /free xqfilename=filename+filelib; API(xrcvvar:xrcvvarl:xrtnqfilename:xfmtname: xqfilename:xrcdfmtname:xovrprc:xsystem: xfmttype:qusec); return xrcvvar; /end-free P RtvDBFD e *======================================================================== * Send an escape error message P DspError b D DspError pi D msg 500 * To call API QMHSNDPM()--Send Program Message D qmhsndpm PR ExtPgm('QMHSNDPM') D i_msgID 7 const D i_qMsgF 20 const D i_msgText 32767 const options(*varsize) D i_lenMsgText 10i 0 const D i_msgType 10 const D i_stackEntry 10 const D i_stackCountr 10i 0 const D i_msgKey 4 const D io_errCode 32767 options(*varsize) /free // reset job CCSID to its original value if chgJobCCSIDIn=*on; rc=doCmd('chgjob CCSID(' + %trim(%char(job_CCSIDsave)) + ')'); endif; QMHSNDPM('CPF9898':'QCPFMSG *LIBL ': msg:%len(msg):'*ESCAPE':'*PGMBDY':1:' ':qusec); /end-free P DspError e