OS/2 Shareware BBS: 18 REXX/18-REXX.zip/DSL.ZIP/DSL.CMD

OS/2 REXX Batch file | 1993-01-07 | 4KB | 159 lines

/* DSL.CMD - version 1.0 - 2/17/90 */
/* Author: Anton Versteeg          */
Trace 'o'
rcx = Rxfuncquery('SQLDBS')
If rcx <> 0 then
   rcy = Rxfuncadd('SQLDBS','SQLAR','SQLDBS')
rcx = Rxfuncquery('SQLEXEC')
If rcx <> 0 then
   rcy = Rxfuncadd('SQLEXEC','SQLAR','SQLEXEC')
Say "DSL.CMD - version 1.0 - 2/17/90"

DT.384 = 'DATE'
DT.388 = 'TIME'
DT.392 = 'TIMESTAMP'
DT.448 = 'VARCHAR'
DT.452 = 'CHAR'
DT.456 = 'LONG VCHAR'
DT.464 = 'VARGRAPH'
DT.468 = 'GRAPHIC'
DT.472 = 'LONG VGRAPH'
DT.480 = 'FLOAT'
DT.484 = 'DECIMAL'
DT.496 = 'INTEGER'
DT.500 = 'SMALLINT'


dbs.1 = 8;
dbs.2 = 8;
dbs.3 = 2;
dbs.4 = 6;
dbs.5 = 8;
dbs.6 = 8;
dbs.7 = 8;
dbs.8 = 3;
dbs.9 = 1;


sample_rc = 0
call SQLDBS 'START DATABASE MANAGER'
if result<>0 then signal ERROR
if (SQLCA.SQLCODE <> -1026 & SQLCA.SQLCODE <> 0)
  then signal ERROR
call SQLDBS 'OPEN DATABASE DIRECTORY ON 0 USING :scan_db'
if scan_db.2 = 0 then do
  "Sorry, you don't have any databases."
  Signal FINISH
End

Else Do
  Say ""
  Say " --ALIAS- | -DBNAME- | DR |INTNAME | NODENAME | DBTYPE   | COMMENT  | CP  | ET|"
  Say " ---------|----------|----|--------|----------|----------|----------|-----|---|"
  Do i=1 to scan_db.2
    CALL SQLDBS 'GET DATABASE DIRECTORY ENTRY :scan_db.1 USING :entry'
    outa = ''
    Do j=1 to 9
      outa=outa Left(entry.j,dbs.j) '|'
    End
    Say outa
  End
End

Do forever
  Say ""
  Say "Please enter a database name or Press Enter to exit."
  Pull db1
  if db1="" then leave
  Say "Starting:" db1
  call SQLDBS 'START USING DATABASE' db1
  if SQLCA.SQLCODE <> 0 then do
    if SQLCA.SQLCODE=-1013 Then Say "Database does not exist"
    else say "Error:" SQLMSG
  end
  else do forever
    Say "Enter select statement or press Enter to return to database selection."
    Say "Enter a ? to get a list of your tables."
    parse pull sel_jobs
    say sel_jobs
    If sel_jobs = '' Then Leave
    If sel_jobs = '?' Then Do
      Say "You have the following tables:"
      sel_jobs = "SELECT CREATOR,NAME,TYPE,CTIME,COLCOUNT,CARD FROM SYSIBM.SYSTABLES"
    End
    Call SQLEXEC 'DECLARE c1 CURSOR FOR s1'
    if result <> 0 | SQLCA.SQLCODE <> 0 Then signal ERROR
    sqlda = ""
    Call SQLEXEC 'PREPARE s1 FROM :sel_jobs'
    if result <> 0 | SQLCA.SQLCODE <> 0 Then Do
      say SQLMSG
      Iterate
    End
    Call SQLEXEC 'DESCRIBE s1 INTO :sqlda '
    if result <> 0 | SQLCA.SQLCODE <> 0 Then signal ERROR
    line. = ''
    do i=1 to sqlda.sqld
      t=sqlda.i.sqltype
      Nulls=0
      if t//2>0 then do
        t=t-1
        Nulls=1
      End
      line.1 = line.1 Left(DT.t,10)
      if t = 484 | t = 485
      Then l =  sqlda.i.sqllen.precision','sqlda.i.sqllen.scale
      Else l =  sqlda.i.sqllen
      line.2  =  line.2 left(l,10)
      If Nulls=1 Then line.3 = line.3 'Nulls OK  '
                 Else line.3 = line.3 'Required  '
      line.4=line.4 left(sqlda.i.sqlname,10)
    end
    line.5 = copies('-',sqlda.sqld*11)
    do i=1 to 5
      say line.i
    end
    call SQLEXEC 'OPEN c1'
    if result <> 0 | SQLCA.SQLCODE <> 0 Then signal ERROR

    do while result=0  & SQLCA.SQLCODE = 0
      call SQLEXEC 'FETCH c1 USING DESCRIPTOR :sqlda'
      if result=0 & SQLCA.SQLCODE=0 then do
        line=''
        do i=1 to sqlda.sqld
          if sqlda.i.sqlind = -1 then line = line '-         '
                                 else line = line left(sqlda.i.sqldata,10)
        end
        say line
      end
      else if SQLCA.SQLCODE <> 100 then signal ERROR
    end
    call SQLEXEC 'CLOSE c1'
    if result <> 0 | SQLCA.SQLCODE <> 0 Then signal ERROR
  end
  Say "Stopping:" db1
  call SQLDBS 'STOP  USING DATABASE'
  Say "Stopped. RC =" SQLCA.SQLCODE
  If SQLCA.SQLCODE <> 0 Then Say SQLMSG
end

result=0
signal FINISH

ERROR: sample_rc = SQLCA.SQLCODE
       say "return code:" sample_rc
       say SQLMSG
       exit sample_rc

FINISH: say 'DSL finished with rc = 'sample_rc
        say 'and result ='result
        call sqlDBS 'STOP USING DATABASE'
        exit sample_rc

rcy = Rxfuncdrop('SQLDBS')
   If rcy <> 0 Then
     Say "RXfuncdrop rc =" rcy
rcy = Rxfuncdrop('SQLEXEC')
   If rcy <> 0 Then
     Say "RXfuncdrop rc =" rcy