Code
Find a File
Utility to find a file name by searching with the file description.Mbr: UF, Type: CMD, Text: Find a File: Command
CMD PROMPT('Find A File')
/* CPP UFC */
PARM KWD(TXT) TYPE(*CHAR) LEN(50) PROMPT('File +
Name')
PARM KWD(LIB) TYPE(*CHAR) LEN(10) DFT(DTA_LIB) +
PROMPT('Library Name')
Mbr: UFC, Type: CLLE, Text: Find a File: CL Program
pgm parm(&Txt &Lib)
dcl &Txt *char ( 50 )
dcl &Lib *char ( 10 )
dcl &TxtQ *char ( 52 )
dcl &LibQ *char ( 14 )
chgvar &TxtQ ('''' *cat '%' *CAT &Txt *tcat '%' *CAT '''')
chgvar &LibQ ('''' *cat &Lib *TCAT '''')
strqmqry qmqry(QGPL/UFQ) +
setvar( (TXT &TxtQ) +
(LIB &LibQ) )
endpgm
Mbr: UFQ, Type: QMQRY, Text: Find a File: QM Query
select
substr(TABLE_NAME,1,15) as TABLE_NAME ,
TABLE_TYPE ,
TABLE_TEXT ,
SYSTEM_TABLE_SCHEMA
from QSYS2/SYSTABLES
where upper(TABLE_TEXT) like upper(&TXT)
and SYSTEM_TABLE_SCHEMA = &LIB
and TABLE_TYPE = 'P'
order by TABLE_NAMEFind a Field
Utility to find a field name by searching with the field description.Mbr: UFLD, Type: CMD, Text: Find a Field
CMD PROMPT('Find A Field')
/* CPP UFLDC */
PARM KWD(FLD) TYPE(*CHAR) LEN(50) PROMPT('Field +
Name')
PARM KWD(LIB) TYPE(*CHAR) LEN(10) DFT(CKJEURO) +
PROMPT('Library Name')
Mbr: UFLDC, Type: CLLE, Text: Find a Field
pgm parm(&Fld &Lib)
dcl &Fld *char ( 10 )
dcl &Lib *char ( 10 )
dcl &FldQ *char ( 14 )
dcl &LibQ *char ( 14 )
chgvar &FldQ ('''' *cat &Fld *tcat '''')
chgvar &LibQ ('''' *cat &Lib *TCAT '''')
strqmqry qmqry(ANEWNS/UFLDQ) +
setvar( (FLD &FldQ) +
(LIB &LibQ) )
endpgm
Mbr: UFLDQ, Type: QMQRY, Text: Find a Field
/* Find a field name */
SELECT substr(c.COLUMN_NAME ,1 ,10) as COLUMN ,
substr(c.COLUMN_TEXT ,1 ,50) as COLUMN_TEXT ,
substr(c.TABLE_NAME ,1 ,10) as TABLE ,
substr(t.TABLE_TEXT ,1 ,50) as TABLE_TEXT ,
substr(c.TABLE_SCHEMA ,1 ,10) as SCHEMA
FROM qsys2/syscolumns c
join systables t
on c.table_name = t.table_name
and c.table_schema = t.table_schema
WHERE c.COLUMN_NAME = &FLD
and c.TABLE_SCHEMA = &LIB
and t.TABLE_TYPE = 'P'
order by c.TABLE_NAME
Set Source to Lowercase
Utility to change source code to lowercase.Mbr: LO, Type: CMD, Text: Set Source to Lowercase
CMD PROMPT('Convert SRCDTA to lowercase')
/* CONVERT SRCDTA TO LOWERCASE */
/* A.NEWNS 02/09/10 */
/* CPP LOC */
PARM KWD(MBR) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('Member')
/* PARM KWD(FILE) TYPE(FIL) DFT(QSRC) SNGVAL((QSRC +
QSRC)) MIN(0) PROMPT('Source File') */
PARM KWD(FILE) TYPE(FIL) MIN(1) PROMPT('Source +
File')
FIL: QUAL TYPE(*NAME)
QUAL TYPE(*NAME) PROMPT('Library')
Mbr: LOC, Type: CLLE, Text: Set Source to Lowercase
pgm parm( &mbr +
&fillib )
/*šconvert srcdta to lowercase €*/
/*ša.newns 02/09/10 €*/
dcl &mbr *char ( 10 )
dcl &fillib *char ( 20 )
dcl &lib *char ( 10 )
dcl &fil *char ( 10 )
dcl &libq *char ( 12 )
dcl &filq *char ( 12 )
dcl &msgdta *char ( 50 )
dcl &msgid *char ( 7 )
dcl &msgf *char ( 10 )
dcl &msgflib *char ( 10 )
monmsg (cpf0000 mch0000 rnx0000) exec(goto error)
chgvar &fil (%sst(&fillib 1 10))
chgvar &lib (%sst(&fillib 11 10))
chkobj &lib/&fil *file &mbr
monmsg cpf9801 exec(goto error)
ovrdbf &fil tofile(&lib/&fil) mbr(&mbr)
chgvar &libq ('"' *cat &lib *tcat '"')
chgvar &filq ('"' *cat &fil *tcat '"')
/*šset srcdat = lower(srcdat) €*/
strqmqry qmqry(anewns/loq) +
setvar( (lib &libq) +
(fil &filq) )
dltovr &fil
/*šcompletion message */
chgvar &msgdta (&lib *tcat '/' *cat &fil *bcat &mbr *bcat 'updated')
sndpgmmsg msgid(cpf9898) msgf(qcpfmsg) +
msgdta(&msgdta) topgmq(*ext) msgtype(*status)
dlyjob dly(2)
goto endpgm
/*ˆabnormal end ---------------------------------------------------------€*/
error:
rcvmsg msgdta(&msgdta) msgid(&msgid) +
msgf(&msgf) msgflib(&msgflib)
monmsg cpf0001
sndpgmmsg msgid(&msgid) msgf(&msgflib/&msgf) +
msgdta(&msgdta)
monmsg cpf0001
endpgm: endpgm
Mbr: LOQ, Type: QMQRY, Text: Set Source to Lowercase
update &LIB/&FIL set srcdta = lower(srcdta),
srcdat = 0
SQL Execute Immediate string
Utility to execute an SQL string.Mbr: SQL0_PR, Type: TXT, Text: Execute SQL string
d execute_sql_i pr extpgm('SQL0')
d i_sql 5000a varying
d o_return 7a
Mbr: SQL0, Type: SQLRPGLE, Text: SQL Execute Immediate string
/title Execute SQL Immediate
/if defined (*CRTBNDRPG)
h dftactgrp(*no) actgrp(*caller)
/endif
//‚:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
//šSystem
//šTitle Execute SQL Immediate
//šMember SQL0 SQLRPGLE
//šPgmr Andrew Newns dd/mm/yy
//šObjective
//šThis program will perform an execute immediate on an sql string.
//šParameters
//šI i_sql sql string
//šO o_return Blank if OK
//‚.......................................................................
//šChanges:
//šdd/mm/yyyy xxnn name
//š.
//‚:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
//‚Prototypes
//šPrototype: *ENTRY -------------------------------------------------------------------------
/copy qrpglesrc,sql0_pr
d execute_sql_i pi
d i_sql 5000 varying
d o_return 7a
//šPrototype: Test assertion -----------------------------------------------------------------
d assert pr
d condition n value
d message 80a value
//šPrototype: SQL error trapping -------------------------------------------------------------
d sql_check pr
//‚Data structues
//šProgram Status ds
dProgStatus sds
d PsProgram *PROC
d PsMsgPq *PROC
d PsStatus *STATUS
d PsRoutine *ROUTINE
d PsParms *PARMS
d PsMsgArea 30a overlay( progstatus:51 )
d PsJobName 10a overlay( progstatus:244 )
d PsUser 10a overlay( progstatus:254 )
d PsJobNbr 6s 0 overlay( progstatus:264 )
//šNull indicators
d null ds qualified
d col01 5i 0
//‚Constants
d Yes c const( 'Y' )
d No c const( 'N' )
d SQ c const( x'7D' )
d true s n inz( '1' )
d false s n inz( '0' )
d #NULL c -1
//‚Workfields
d screen s 10a
d screrror s n
d sqlstr s 5000a
d w_errtxt s 120a
d w_jobtxt s 100a
d w_pgmtxt s 20a
//‚Mainline
/free
monitor ;
exsr inz_pgm ;
exsr inz_sql ;
exsr process ;
exsr end_normal ;
on-error 1211 ;
assert (*off : 'File not open.' + w_errtxt) ;
on-error *FILE ;
assert (*off : 'Unexpected *FILE error' + w_errtxt) ;
on-error *PROGRAM ;
assert (*off : 'Unexpected *PROGRAM error' + w_errtxt) ;
on-error ;
assert (*off : 'Unexpected error' + w_errtxt) ;
endmon ;
//š----------------------------------------------------------------------
//šProcess
begsr process ;
exec sql EXECUTE IMMEDIATE : i_sql ;
sql_check() ;
endsr ;
//š----------------------------------------------------------------------
//šInitialise program
begsr inz_pgm ;
o_return = 'INZ' ;
w_pgmtxt = ' PGM: ' + psprogram ;
w_jobtxt = ' JOB: '
+ %char(psjobnbr) + '/' + %trimr(psuser) + '/' + psjobname ;
w_errtxt = %trimr(w_pgmtxt) + w_jobtxt ;
endsr ;
//š----------------------------------------------------------------------
//šInitialise SQL
begsr inz_SQL ;
endsr ;
//š----------------------------------------------------------------------
//šNormal end
begsr end_normal ;
o_return = *blank ;
exsr end_pgm ;
endsr ;
//š----------------------------------------------------------------------
//šAbnormal end
begsr end_abnormal ;
assert (*off : 'Program has ended abnormally' + w_errtxt ) ;
endsr ;
//š----------------------------------------------------------------------
//šEnd the program
begsr end_pgm ;
*inlr = true ;
return ;
endsr ;
/end-free
//‚======================================================================
//‚Sub-Procedures
//‚======================================================================
//š----------------------------------------------------------------------
//šSQL Error Check
p sql_check b
d sql_check pi
d nbrofrows s 10u 0
d errtxt s 200a
/free
select;
when %subst(SQLSTATE :1 :2) = '00' ; //šOK
// exec sql get diagnostics :NbrOfRows = ROW_COUNT ;
return ;
when %subst(SQLSTATE :1 :2) = '01' ; //šWarning
exec sql get diagnostics condition 1 :errtxt = MESSAGE_TEXT ;
return ;
when %subst(SQLSTATE :1 :2) = '02' ; //šNo more rows
exec sql get diagnostics condition 1 :errtxt = MESSAGE_TEXT ;
return ;
when %subst(SQLSTATE :1 :2) >= '03' ; //šError
exec sql get diagnostics condition 1 :errtxt = MESSAGE_TEXT ;
o_return = 'ERR:SQL' ;
assert (*off : %trimr(errtxt) + w_errtxt ) ;
return ;
endsl ;
/end-free
p e
//š-------------------------------------------------------------------
//šTest the assertion
p assert b
d assert pi
d condition n value
d message 80a value
d sendescmsg pr extpgm('QMHSNDPM')
d msgid 7 const
d msgfile 20 const
d msgdta 80 const
d msgdtalen 10i 0 const
d msgtype 10 const
d msgq 10 const
d msgqnbr 10i 0 const
d msgkey 4
d errords 16
d
d errords ds 16
d bytesprov 10i 0 inz( 16 )
d bytesavail 10i 0
d exceptionid 7
d msgdta s 80
d msgkey s 4
d msgtypeA s 7
/free
if (not condition);
dump(a) ;
*inlr = *on;
sendescmsg ('CPF9898' : 'QCPFMSG QSYS':
message : %len(message) :
'*ESCAPE' : '*PGMBDY' : 1 : msgkey : errords) ;
endif;
return ;
/end-free
p e
SQL Execute Immediate string and return a parameter
Utility to execute an SQL string and return a numeric parameter.Mbr: SQL1_PR, Type: TXT, Text: Execute SQL string with return parm
d execute_sql pr extpgm('SQL1')
d i_sql 5000a varying
d o_nbr 15 5
d o_return 7a
Mbr: SQL1, Type: SQLRPGLE, Text: SQL Execute Immediate string with return parm
/title Execute SQL
/if defined (*CRTBNDRPG)
h dftactgrp(*no) actgrp(*caller)
/endif
//‚:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
//šSystem
//šTitle Execute SQL
//šMember SQL1 SQLRPGLE
//šPgmr Andrew Newns dd/mm/yy
//šObjective
//šThis program will execute a sql string and then return a single
//šnumeric output parameter.
//šParameters
//šI i_sql sql string
//šI o_nbr numeric value
//šO o_return Blank if OK
//‚.......................................................................
//šChanges:
//šdd/mm/yyyy xxnn name
//š.
//‚:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
//‚Prototypes
//šPrototype: *ENTRY -------------------------------------------------------------------------
/copy qrpglesrc,sql1_pr
d execute_sql pi
d i_sql 5000 varying
d o_nbr 15 5
d o_return 7a
//šPrototype: Test assertion -----------------------------------------------------------------
d assert pr
d condition n value
d message 80a value
//šPrototype: SQL error trapping -------------------------------------------------------------
d sql_check pr
//‚Data structues
//šProgram Status ds
dProgStatus sds
d PsProgram *PROC
d PsMsgPq *PROC
d PsStatus *STATUS
d PsRoutine *ROUTINE
d PsParms *PARMS
d PsMsgArea 30a overlay( progstatus:51 )
d PsJobName 10a overlay( progstatus:244 )
d PsUser 10a overlay( progstatus:254 )
d PsJobNbr 6s 0 overlay( progstatus:264 )
//šNull indicators
d null ds qualified
d col01 5i 0
//‚Constants
d Yes c const( 'Y' )
d No c const( 'N' )
d SQ c const( x'7D' )
d true s n inz( '1' )
d false s n inz( '0' )
d #NULL c -1
//‚Workfields
d screen s 10a
d screrror s n
d sqlstr s 5000a
d w_errtxt s 120a
d w_jobtxt s 100a
d w_pgmtxt s 20a
//‚Mainline
/free
monitor ;
exsr inz_pgm ;
exsr inz_sql ;
exsr process ;
exsr end_normal ;
on-error 1211 ;
assert (*off : 'File not open.' + w_errtxt) ;
on-error *FILE ;
assert (*off : 'Unexpected *FILE error' + w_errtxt) ;
on-error *PROGRAM ;
assert (*off : 'Unexpected *PROGRAM error' + w_errtxt) ;
on-error ;
assert (*off : 'Unexpected error' + w_errtxt) ;
endmon ;
//š----------------------------------------------------------------------
//šProcess
begsr process ;
exec sql FETCH c1 into :o_nbr : null.col01 ;
sql_check() ;
if null.col01 = #NULL ;
o_nbr = 0 ;
endif ;
endsr ;
//š----------------------------------------------------------------------
//šInitialise program
begsr inz_pgm ;
o_return = 'INZ' ;
w_pgmtxt = ' PGM: ' + psprogram ;
w_jobtxt = ' JOB: '
+ %char(psjobnbr) + '/' + %trimr(psuser) + '/' + psjobname ;
w_errtxt = %trimr(w_pgmtxt) + w_jobtxt ;
endsr ;
//š----------------------------------------------------------------------
//šInitialise SQL
begsr inz_SQL ;
exec sql PREPARE s1 from :i_sql ;
sql_check() ;
exec sql DECLARE c1 cursor for s1 ;
sql_check() ;
exec sql OPEN c1 ;
sql_check() ;
endsr ;
//š----------------------------------------------------------------------
//šNormal end
begsr end_normal ;
exec sql CLOSE c1 ;
sql_check() ;
o_return = *blank ;
exsr end_pgm ;
endsr ;
//š----------------------------------------------------------------------
//šAbnormal end
begsr end_abnormal ;
assert (*off : 'Program has ended abnormally' + w_errtxt ) ;
endsr ;
//š----------------------------------------------------------------------
//šEnd the program
begsr end_pgm ;
*inlr = true ;
return ;
endsr ;
/end-free
//‚======================================================================
//‚Sub-Procedures
//‚======================================================================
//š----------------------------------------------------------------------
//šSQL Error Check
p sql_check b
d sql_check pi
d nbrofrows s 10u 0
d errtxt s 200a
/free
select;
when %subst(SQLSTATE :1 :2) = '00' ; //šOK
// exec sql get diagnostics :NbrOfRows = ROW_COUNT ;
return ;
when %subst(SQLSTATE :1 :2) = '01' ; //šWarning
exec sql get diagnostics condition 1 :errtxt = MESSAGE_TEXT ;
return ;
when %subst(SQLSTATE :1 :2) = '02' ; //šNo more rows
exec sql get diagnostics condition 1 :errtxt = MESSAGE_TEXT ;
return ;
when %subst(SQLSTATE :1 :2) >= '03' ; //šError
exec sql get diagnostics condition 1 :errtxt = MESSAGE_TEXT ;
o_return = 'ERR:SQL' ;
assert (*off : %trimr(errtxt) + w_errtxt ) ;
return ;
endsl ;
/end-free
p e
//š-------------------------------------------------------------------
//šTest the assertion
p assert b
d assert pi
d condition n value
d message 80a value
d sendescmsg pr extpgm('QMHSNDPM')
d msgid 7 const
d msgfile 20 const
d msgdta 80 const
d msgdtalen 10i 0 const
d msgtype 10 const
d msgq 10 const
d msgqnbr 10i 0 const
d msgkey 4
d errords 16
d
d errords ds 16
d bytesprov 10i 0 inz( 16 )
d bytesavail 10i 0
d exceptionid 7
d msgdta s 80
d msgkey s 4
d msgtypeA s 7
/free
if (not condition);
dump(a) ;
*inlr = *on;
sendescmsg ('CPF9898' : 'QCPFMSG QSYS':
message : %len(message) :
'*ESCAPE' : '*PGMBDY' : 1 : msgkey : errords) ;
endif;
return ;
/end-free
p e
Display EBCDIC character set
Utility to display wth EBCIDIC character set and to also show the decimal, hexadecimal and binary conversion.Mbr: SYM, Type: RPGLE, Text: Display EBCDIC character set
/title Display EBCDIC character set
h copyright('Andrew Newns 2010')
h option(*nodebugio:*srcstmt)
/if defined (*CRTBNDRPG)
h dftactgrp(*no) actgrp(*caller)
/endif
//š::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
//šAndrew Newns, dd/mm/yy
//šDisplay EBCDIC character set
//š::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
fsymd cf e workstn extdesc('ANEWNS/SYMD') compile time
f extfile('ANEWNS/SYMD') run time
f prefix(scr_)
f sfile(sfl:scr_sflrrn)
f indds(indds_1)
d cvthex pr 2a
d #i 10i 0 const
d cvtbin pr 8a
d #i 10i 0 const
d cvtchr pr 1a
d #c 3u 0 const
d bin 8a const
//šDisplay File Indicator Data Structure
d indds_1 ds
d ScrExit n overlay( indds_1 : 03 )
d SflClr n overlay( indds_1 : 30 )
d SflDsp n overlay( indds_1 : 31 )
d SflDspCtl n overlay( indds_1 : 32 )
d SflEnd n overlay( indds_1 : 33 )
d SflNxtChg n overlay( indds_1 : 34 )
d SflMsgInd n overlay( indds_1 : 35 )
d ScrVldCmd n overlay( indds_1 : 40 )
d true s n inz( *on )
d false s n inz( *off )
d #SCREEN01 c const( 'SCREEN01' )
d screen s 10a
D #i s 10i 0
d hex s like(scr_hex )
d bin s like(scr_bin )
d chr s like(scr_chr )
d SQ c const(x'7D') Single Quote
//š-------------------------------------------------------------------------------------------
//šmainline
/free
//šClear sfl
sflclr = true ;
write sflctl ;
sflclr = false ;
sflend = false ;
screen = #SCREEN01 ;
//šFill sfl
for #i = 0 to 255 ;
scr_dec = #i ;
scr_hex = cvthex( #i );
scr_bin = cvtbin( #i );
scr_chr = cvtchr( #i : scr_bin ) ;
scr_sflrrn += 1 ;
if #i < 64 ;
//šhex codes lower than '40' are invalid, but can be used as display attributes
scr_txt = 'AAA' ;
scr_dspatr = %bitor( x'00' : scr_chr ) ;
scr_chr = *blank ;
else ;
scr_txt = *blank ;
scr_dspatr = x'20' ;
endif ;
write sfl ;
endfor ;
sflend = true ;
//šDisplay sfl
dow screen = #SCREEN01 ;
write sflftr ;
SflDsp = true ;
SflDspCtl = true ;
exfmt sflctl ;
if screxit ;
screen = *blank ;
leave ;
endif ;
enddo ;
//šEnd
*inlr = *on ;
return ;
/end-free
//š-------------------------------------------------------------------------------------------
p cvthex b
d cvthex pi 2a
d #i 10i 0 const
d hex_ds ds
d 16a inz( '0123456789ABCDEF' )
d hex_a 1a dim( 16 ) overlay(hex_ds)
d hex s 8a
d div s 10u 0
d rem s 10u 0
/free
div = %div(#i :16) ;
rem = %rem(#i :16) ;
return hex_a( div+1 ) + hex_a( rem+1 ) ;
/end-free
p cvthex e
//š-------------------------------------------------------------------------------------------
p cvtbin b
d cvtbin pi 8a
d #i 10i 0 const
d bin ds 8
d bin_a 1a dim(8) overlay(bin:1)
d rem s 10i 0 inz( 0 )
d #p s 10i 0 inz( 7 )
/free
rem = #i ;
bin = '00000000' ;
for #p = 7 downto 0 by 1;
if rem >= 2 ** #p ;
bin_a( 8-#p ) = '1' ;
rem -= 2 ** #p ;
endif ;
endfor ;
return bin ;
/end-free
p cvtbin e
//š-------------------------------------------------------------------------------------------
p cvtchr b
d cvtchr pi 1a
d #c 3u 0 const
d bin 8a const
d #p s 10i 0 inz( 7 )
d chr s 1a
d x00 s 1a inz(x'00')
d x01 s 1a inz(x'01') 2[0 = 1
d x02 s 1a inz(x'02') 2[1 = 2
d x03 s 1a inz(x'04') 2[2 = 4
d x04 s 1a inz(x'08') 2[3 = 8
d x05 s 1a inz(x'10') 2[4 = 16
d x06 s 1a inz(x'20') 2[5 = 32
d x07 s 1a inz(x'40') 2[6 = 64
d x08 s 1a inz(x'80') 2[7 = 128
/free
chr = x00 ;
if %subst( bin : 1 : 1 ) = '1' ;
chr = %bitor( chr : x08 ) ;
endif ;
if %subst( bin : 2 : 1 ) = '1' ;
chr = %bitor( chr : x07 ) ;
endif ;
if %subst( bin : 3 : 1 ) = '1' ;
chr = %bitor( chr : x06 ) ;
endif ;
if %subst( bin : 4 : 1 ) = '1' ;
chr = %bitor( chr : x05 ) ;
endif ;
if %subst( bin : 5 : 1 ) = '1' ;
chr = %bitor( chr : x04 ) ;
endif ;
if %subst( bin : 6 : 1 ) = '1' ;
chr = %bitor( chr : x03 ) ;
endif ;
if %subst( bin : 7 : 1 ) = '1' ;
chr = %bitor( chr : x02 ) ;
endif ;
if %subst( bin : 8 : 1 ) = '1' ;
chr = %bitor( chr : x01 ) ;
endif ;
return chr ;
/end-free
p cvtchr e
Mbr: SYMD, Type: DDS, Text: Display EBCDIC character set
A*%%TS SD 20101216 022353 ANEWNS REL-V6R1M0 5761-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A INDARA
A PRINT
A CA03(03 'Exit')
A*š=================================================================
A R SFL SFL
A*%%TS SD 20101216 022353 ANEWNS REL-V6R1M0 5761-WDS
A TEXT('EBCDIC Subfile')
A DSPATR 1A P TEXT('Display Attributes')
A DEC 3S 0O 4 2
A HEX 2A O 4 7
A BIN 8A O 4 11
A CHR 1A O 4 21
A TXT 3A O 4 27DSPATR(&DSPATR)
A*š.................................................................
A R SFLCTL SFLCTL(SFL)
A*%%TS SD 20101216 022353 ANEWNS REL-V6R1M0 5761-WDS
A SFLSIZ(0999)
A SFLPAG(0018)
A TEXT('EBCDIC Subfile control')
A OVERLAY
A 31 SFLDSP
A 32 SFLDSPCTL
A 30 SFLCLR
A 33 SFLEND(*MORE)
A SFLRRN 4S 0H
A 1 2'SYM'
A DSPATR(HI)
A 1 7'Display EBCDIC character set'
A DSPATR(HI)
A 3 2'Dec'
A DSPATR(HI)
A 3 7'Hex'
A DSPATR(HI)
A 3 11'Bin'
A DSPATR(HI)
A 3 21'Char'
A DSPATR(HI)
A 3 27'DspAtr'
A DSPATR(HI)
*š---------------------------------------------------------------
A R SFLFTR
A*%%TS SD 20100823 100336 ANEWNS REL-V6R1M0 5761-WDS
A SETCSR 1A B 23 2DSPATR(ND)
A PUSHBTN 2Y 0B 23 4PSHBTNFLD((*GUTTER 1))
A PSHBTNCHC(1 'F3/Exit' CA03)
Backup IBM source on PC
Utility to backup IBM source on the local PC.Mbr: BACKUP_IBM, Type: TXT, Text: Backup IBM to PC
:http://forums.systeminetwork.com/isnetforums/showthread.php?t=106881 open SYSTEM USER_PROFILE PASSWORD ascii quote site namefmt 0 cd anewns lcd c:\data\source prompt off mget qsrc.* mget qsqlsrc.* mget qsrvsrc.* quit