© 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