©
serviceprofessionalgmbh
Looks for membernames inside DD name concatenations. The results get displayed in form of a table, these are: all filenames, the
number of the members within and how many times the searched member has been found. Generic search arguments may be used.
At the start of the program the DD type and member name can be specified directly. Are no specifications entered, an
equivalent data panel is brought up.
If the program is envoked with the parameter ~INFO, a string with the relevant data set names is generated.
Panels used are listed following the program.
The Program
/* REXX
Suche nach Membernamen innerhalb bestimmter DD-Verkettungen
*/
x=msg("OFF")
parse source . ptyp pname .
if ptyp = "FUNCTION" then do
parms =
do i = 1 to arg()
parms = parms translate(arg(i))
end
end
else arg parms anschluß
address ispexec
"control errors return"
main_start:
call set_defaults
parse value check_parms() with rc_parms trace_opt
if nur_info & (rc_parms > 0 ! parms = "") then return "ERROR"
interpret "trace" trace_opt
call show_info_panel
if nur_info then do
if rc_parms > 0 ! parms = "" then ret_parm = "ERROR"
else ret_parm = dsns
return ret_parm
end
main_end:
exit
check_parms:
nur_info = 0
erg = 0
trace = "OFF"
x=wordpos("TRACE",parms)
if x > 0 then do
parms = delword(parms,x,1)
trace = "?r"
end
x=wordpos("~INFO",parms)
if x > 0 then do
parms = delword(parms,x,1)
nur_info = 1
end
if length(parms) > 0 then do
erg = 12
parse var parms p1 p2 .
if wordpos(p1,tmbrtyps) > 0 then do
smbrtyp = p1
smbr = p2
erg = 0
end
else do
if wordpos(p2,tmbrtyps) > 0 then do
smbrtyp = p2
smbr = p1
erg = 0
end
end
end
return erg trace
search_dd:
arg dd
dsns =
"qbaselib &dd id(base)"
rc_qbase = rc
"qlibdef &dd type(typ) id(libd)"
rc_qlibd = rc
if rc_qbase > 0 & rc_qlibd > 0 then do
zedlmssg = "Zu DD-Name" dd "keine Dateien gefunden"
"setmsg msg(isrz000)"
return 12
end
if rc_qlibd = 0 then do
dsns = translate(libd," ",",'")
end
if rc_qbase = 0 then do
base = translate(base," ",",'")
do I = 1 to words(base)
dsns = dsns "#"word(base,i)
end
end
cdsns = words(dsns)
do i=1 to cdsns
"tbvclear &dsntab"
$dsn = word(dsns,i)
$aloby = "LibDef"
if left($dsn,1) = "#" then do
$aloby = "Allocate"
$dsn = substr($dsn,2)
end
x=listdsi("'"$DSN"',directory")
$found = 0
$info = sysmembers
if $info > 0 then call mbrinfo $dsn smbr
if smbr = "" then $found = 0
"tbadd &dsntab"
end
return 0
set_defaults:
smbrtyps = "C,R,P,S,M,F,T,TA"
ddnames = "SYSPROC SYSEXEC ISPPLIB ISPSLIB ISPMLIB ISPFILE" ,
"ISPTLIB ISPTABL"
tmbrtyps = translate(smbrtyps," ",",")
return
create_dsntab:
dsntab = "T"reverse(userid())
"tbend &dsntab"
"tbcreate &dsntab names($dsn $found $info $aloby) nowrite"
return
show_info_panel:
do forever
if rc_parms > 0 ! parms = "" & ^nur_info then do
"addpop row(4) column(13)"
"display panel(psuch1)"
rc_disp = rc
"rempop"
if rc_disp <> 0 then leave
end
tmp1 = wordpos(smbrtyp,tmbrtyps)
call create_dsntab
call search_dd word(ddnames,tmp1)
call show_table
call reset_all
if rc_parms = 0 & parms <> "" then leave
if nur_info then leave
end
return
show_table:
if nur_info then return
row=1
do forever
"tbtop &dsntab"
"tbskip &dsntab number(&row)"
"addpop row(4) column(9)"
"tbdispl &dsntab panel(psuch2)"
rc_tbdispl = rc
"rempop"
if rc_tbdispl > 4 then leave
row = ztdtop
do while ztdsels > 0 then do
"control display save"
if lcmd <> "" then do
if $found = 0 & lcmd = "M" then do
zedlmsg="Gesamtanzeige, da Auswahl" smbr "nicht gefunden"
"setmsg msg(isrz000)"
end
datei = $dsn
if $found > 0 & lcmd = "M" then datei = datei"("smbr")"
if $info > 0 then do
"view dataset('&datei')"
end
end
"control display restore"
if ztdsels > 1 then "tbdispl &dsntab"
else ztdsels = 0
end
end
return
mbrinfo: procedure expose mbrlist. $found
arg tdsn tmbr
mbrlist =
if pos('*',mbr1) = 0 then mbr1 = strip(left(mbr1'*',8))
"lminit dataid(did) dataset('&TDSN') enq(shr) org(po)"
"lmopen dataid(&DID) option(input)"
"lmmlist dataid(&DID) option(list) member(MBR) pattern(&TMBR)"
do $found = 0 while RC = 0
mbslist.$found = strip(MBR)
"lmmlist dataid(&DID) option(list) member(MBR) pattern(&TMBR)"
end
"lmclose dataid(&DID)"
"lmfree dataid(&DID)"
return
reset_all:
"
tbend &dsntab"
return
Panel PSUCH1
)attr default(%+_)
² type(input) color(red) caps(on) padc('.')
)body expand($$) window(52,14)
+COMMAND ==>_zcmd
+
+Membername....:²smbr + (auch generisch)
+Typ-Definition:²z + (C = CLISTen - SYSPROC)
+ (R = REXXen - SYSEXEC)
+ (P = Panels - ISPPLIB)
+ (S = SkelsIN - ISPSLIB)
+ (F = SkelsOUT - ISPFILE)
+ (T = TableIN - ISPTLIB)
+ (TA = TableOUT - ISPTABL)
+
+
%ENTER+startet Suche$ $%END+Ende Verarbeitung
)init
.zvars = '(smbrtyp)'
&zwinttl = 'Suchen Members in DD-Namen'
)proc
if (ver (&smbr,namef))
if (ver (&smbrtyp,nb,listv,&smbrtyps))
else
&zedlmsg = 'Muss eines der folgenden sein: &smbrtyps'
.MSG = ISRZ000
.CURSOR = SMBRTYP
else
&zedlmsg = 'Memberangabe formal falsch'
.MSG = ISRZ000
.CURSOR = SMBR
&zwinttl = &z
)end
Panel PSUCH2
)attr default(%+_)
² type(input) color(red) caps(on) padc('.')
³ type(text) intens(low) hilite(uscore)
{ type(output) intens(low)
} type(output) intens(high)
] type(output) intens(high) just(right)
)body expand(~~) window(70,19)
+COMMAND ==>_zcmd
+
+.--%M+zeigt Member (nur wenn MATCH >%0+)
+| %D+zeigt Datei
+|
³V³Mbrs ³Match³Dateiname ³Zuweisung
)model clear(LCMD) rows(ALL)
²Z]Z ]z {$dsn {$aloby
)init
.zvars = '(lcmd $info $found)'
&zwinttl = 'Suche &smbr in &dd'
&ztdmark='------------< Ende der Anzeige +
>-------------------------------------'
)proc
&zwinttl = &z
&ztdmark = &z
)end
Driver program for function test purposes
/* rexx
*/
say;say "Subroutine mit PARMS"
call suche "p ~info"
do I = 1 to words(result)
say right(i,3) word(result,i)
end
say;say "Subroutine ohne PARMS"
call suche
do I = 1 to words(result)
say right(i,3) word(result,i)
end
say;say "Subroutine nur INFO"
call suche "~info"
do I = 1 to words(result)
say right(i,3) word(result,i)
end
say;say "Function mit PARMS"
files=suche("p","~info")
do I = 1 to words(files)
say right(i,3) word(files,i)
end
say;say "Function nur INFO"
files=suche("~info")
do I = 1 to words(files)
say right(i,3) word(files,i)
end
back to REXX with ISPF