© steven e.bacher@newsgroup

Das Programm kann benutzt werden, um eine beliebige Tabelle anzuzeigen.

/* REXX


Here's yet another REXX exec to print the contents of a table.
This one includes support for extension variables, without which
you won't get much useful info about ISPCMDS.

Note that you'll probably have to copy ISPCMDS into a junk member
of your table library and then run this exec against that.

 - seb

signal on failure
signal on halt
signal on novalue
*/
parse value "" with ,
      cdate ctime udate utime user rowcreat rowcurr rowupd tableupd ,
      service retcode status1 status2 status3 library ,
      keys names rownum keynum namenum position

/* "XPROC 1 TABLENAME" ; if rc -= 0 then exit rc */

parse upper arg tablename .

address ISPEXEC "CONTROL ERRORS RETURN"
address ISPEXEC "TBCLOSE" tablename
address ISPEXEC "TBOPEN" tablename
if translate(zerrsm) = "TABLE ALREADY OPEN" then nop
else if rc = 8 then do
 say "Table does not exist:" tablename
 exit 8
end
else if rc > 0 then signal ispferror
call ispf "TBSTATS" tablename ,
     "CDATE(CDATE) CTIME(CTIME) UDATE(UDATE) UTIME(UTIME)",
     "USER(USER) ROWCREAT(ROWCREAT) ROWCURR(ROWCURR)",
     "ROWUPD(ROWUPD) TABLEUPD(TABLEUPD) SERVICE(SERVICE)",
     "RETCODE(RETCODE)  STATUS1(STATUS1) STATUS2(STATUS2)",
     "STATUS3(STATUS3) LIBRARY(LIBRARY)"

say
say "Data from TBSTATS"
say
say "Creation date......."  cdate
say "Creation time......."  ctime
say "Date last updated..."  udate
say "Time last updated..."  utime
say "Last updated by....."  user
say "Rows at creation...." rowcreat
say "Current rows........" rowcurr
say "Rows updated........" rowupd
say "Table updates......." tableupd
/*
say "Last ISPF service..." service
say "Last ISPF retcode..." retcode
say "Status in input library........" status1
say "Status in logical screen......." status2
say "Status of write availability..." status3
say "Alternate input library........" library
*/
call ispf "TBQUERY" tablename ,
     "KEYS(KEYS) NAMES(NAMES) ROWNUM(ROWNUM) KEYNUM(KEYNUM)" ,
     "NAMENUM(NAMENUM) POSITION(POSITION)"

say
say "Data from TBQUERY"
say
say "Key variables............." keys
say "Row variables............." names
say "Number of rows............" rownum
say "Number of key variables..." keynum
say "Number of row variables..." namenum
/*
say "Current row number........" position
*/

if keynum = 0 then call dumpUnkeyedTable tablename, names
else               call dumpKeyedTable     tablename, names, keys

halt:
call ispf "TBCLOSE" tablename
exit 0

dumpUnkeyedTable: procedure
parse arg tablename, variablenames
variablenames = translate(variablenames,"  ","()")
variablecount = words(variablenames)
call ispf "TBTOP" tablename
do forever
 call ispf "TBSKIP" tablename
 if result = 8 then leave
 parse value "" with savename rowid position
 call ispf "TBGET" tablename ,
     "SAVENAME(SAVENAME) ROWID(ROWID) POSITION(POSITION)"
 if result > 0 then leave
 say
 say "Table row:" rowid+0
 /*
 say
 say "savename...." savename
 say "rowid......." rowid
 say "position...." position
 */
 say
 say "Row variables:"
 say
 do variableindex = 1 to variablecount
  call showvar word(variablenames,variableindex)
 end
 extensionvariablenames = translate(savename,"  ","()")
 extensionvariablecount = words(extensionvariablenames)
 if extensionvariablecount > 0 then do
  say
  say "Extension variables:"
  say
  do extensionindex = 1 to extensionvariablecount
   call showvar word(extensionvariablenames,extensionindex)
  end
 end
end
return 0

dumpKeyedTable: procedure
parse arg tablename, variablenames, keyvariablenames
variablenames = translate(variablenames,"  ","()")
variablecount = words(variablenames)
keyvariablenames = translate(keyvariablenames,"  ","()")
keyvariablecount = words(keyvariablenames)

call ispf "TBTOP" tablename

do forever
 parse value "" with savename rowid position
 call ispf "TBSKIP" tablename ,
     "SAVENAME(SAVENAME) ROWID(ROWID) POSITION(POSITION)"
 if result = 8 then leave
 say
 say "Table row:" rowid+0
 /*
 say
 say "savename...." savename
 say "rowid......." rowid
 say "position...." position
 */
 say
 say "Key variables:"
 say
 do keyvariableindex = 1 to keyvariablecount
  call showvar word(keyvariablenames,keyvariableindex)
 end
 say
 say "Row variables:"
 say
 do variableindex = 1 to variablecount
  call showvar word(variablenames,variableindex)
 end
 extensionvariablenames = translate(savename,"  ","()")
 extensionvariablecount = words(extensionvariablenames)
 if extensionvariablecount > 0 then do
  say
  say "Extension variables:"
  say
  do extensionindex = 1 to extensionvariablecount
   call showvar word(extensionvariablenames,extensionindex)
  end
 end
end
return 0

showvar:  parse arg variable
 say left(variable,16,".")"--"value(variable)
return 0

ispf: parse arg icmd
zerrsm =
zerrlm =
zerrhm =
zerralrm =
address ispexec icmd
irc = rc
if irc >= 9  then do
 say word(icmd,1)": rc = " rc
 if zerrsm <> "" then signal ispferror
end
return irc

ispferror:
ispfrc = rc
address ISPEXEC "DISPLAY PANEL(ISPTERM)"
exit ispfrc