©
serviceprofessionalgmbh
Sucht Membernamen innerhalb von DD-Namen. Die Ergebnisse (alle Dateinamen, die Anzahl der dort abgelegten Member
und wie oft das gesuchte Member in der Datei gefunden wurde) werden als Tabelle angezeigt. Bei der Suche sind generische
Angaben möglich.
Bei Programmstart kann der DD-Typ und der Membername direkt mitgegeben werden. Erfolgen keine Angaben, wird ein
entsprechendes Datenpanel angezeigt.
Wird ein Parameter ~INFO mitgegeben, kann eine Wortkette mit den betreffenden Dateinamen ermittelt werden.
Die benutzten Panels werden hinter dem Programm gelistet.
Programm
/* 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
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
Panell 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
Treiber-Programm für den Funktionstest
/* 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
zurück zu REXX mit Dialog Manager