home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
netdor2.zip
/
DISK_10
/
IMAGE9.ZIP
/
REGFUNC.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-08-24
|
12KB
|
288 lines
/*****************************************************************************
* Register External REXX Functions *
* NetDoor Development (CORE at WATSON) *
*****************************************************************************
* Licensed Materials-Property of IBM *
* 5604-472 (c) Copyright IBM Corporation, 1993 *
* All rights reserved. *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted *
* by GSA ADP Schedule Contract with IBM Corp. *
*****************************************************************************/
trace 'O'
signal on syntax
signal on novalue
parse upper arg Pkg Extra
parse source . How Me
Globals = 'Opt. IUO'
Opt.!Cmd = (How = 'COMMAND')
if LoadCouEnv('QUIET') <> 0
then IUO = 1
else IUO = (rxCouInfo('VER') = 0)
select
when Pkg = '' | abbrev(Pkg, '?') | Extra <> '' | arg() > 1
then call BadInvoke
when Pkg = 'RXUTILS'
then XC = LoadRxUtils()
when Pkg = 'REXXUTIL'
then XC = LoadRexxUtil()
when Pkg = 'COUENV'
then XC = LoadCouEnv()
when Pkg = 'COUCOPY'
then XC = LoadCouCopy()
when Pkg = 'DBOXMGR2' & IUO
then XC = LoadDBoxMgr2()
otherwise
call BadInvoke
end
exit XC
/*****************************************************************************
* LoadRXUTILS *
*****************************************************************************/
LoadRxUtils: procedure expose (Globals)
if Opt.!Cmd then say 'Registering RXUTILS functions...'
call rxfuncadd 'RXLOADFUNCS', 'RXUTILS', 'RXLOADFUNCS'
signal on syntax name LoadRxUtils2
call rxLoadFuncs 'QUIET'
signal on syntax name syntax
if Opt.!Cmd then say 'Registered.'
return 0
LoadRxUtils2:
signal on syntax name syntax
select
when rc = 40
then call rxLoadFuncs
when rc = 43
then do
if Opt.!Cmd then say 'Error: RXUTILS.DLL not found.'
return 2
end
otherwise do
if Opt.!Cmd then say 'Error: Error' rc 'registering RXUTILS functions.'
return 1000 + rc
end
end
if Opt.!Cmd then say 'Registered.'
return 0
/*****************************************************************************
* LoadREXXUTIL *
*****************************************************************************/
LoadRexxUtil: procedure expose (Globals)
if Opt.!Cmd then say 'Registering REXXUTIL functions...'
call rxfuncadd 'SYSLOADFUNCS', 'REXXUTIL', 'SYSLOADFUNCS'
signal on syntax name LoadRexxUtil2
call sysLoadFuncs
signal on syntax name syntax
if Opt.!Cmd then say 'Registered.'
return 0
LoadRexxUtil2:
signal on syntax name syntax
select
when rc = 43
then do
if Opt.!Cmd then say 'Error: REXXUTIL.DLL not found.'
return 2
end
otherwise do
if Opt.!Cmd then say 'Error: Error' rc 'registering REXXXUTIL functions.'
return 1000 + rc
end
end
return 0
/*****************************************************************************
* LoadCOUENV *
*****************************************************************************/
LoadCouEnv: procedure expose (Globals)
Quiet = (arg(1) = 'QUIET')
if Opt.!Cmd & \Quiet then say 'Registering COUENV functions...'
call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
signal on syntax name LoadCouEnv2
call rxCouInfo 'VER'
signal on syntax name syntax
if Opt.!Cmd & \Quiet then say 'Registered.'
return 0
LoadCouEnv2:
signal on syntax name syntax
select
when rc = 43
then do
if Opt.!Cmd & \Quiet then say 'Error: COUENV.DLL not found.'
return 2
end
otherwise do
if Opt.!Cmd & \Quiet then say 'Error: Error' rc 'registering COUENV functions.'
return 1000 + rc
end
end
return 0
/*****************************************************************************
* LoadCOUCOPY *
*****************************************************************************/
LoadCouCopy: procedure expose (Globals)
if Opt.!Cmd then say 'Registering COUCOPY functions...'
call rxfuncadd 'RXCOUCOPY', 'COUCOPY', 'RXCOUCOPY'
signal on syntax name LoadCouCopy2
call rxCouCopy
signal on syntax name syntax
if Opt.!Cmd then say 'Registered.'
return 0
LoadCouCopy2:
signal on syntax name syntax
select
when rc = 40
then do
call rxfuncadd 'RXCOUDELETE', 'COUCOPY', 'RXCOUDELETE'
call rxfuncadd 'RXCOUDELETEALL', 'COUCOPY', 'RXCOUDELETEALL'
call rxfuncadd 'RXCOUASSOCIATEAPPFILE', 'COUCOPY',,
'RXCOUASSOCIATEAPPFILE'
call rxfuncadd 'RXCOUREMOVEAPPFILE', 'COUCOPY',,
'RXCOUREMOVEAPPFILE'
if Opt.!Cmd then say 'Registered.'
end
when rc = 43
then do
if Opt.!Cmd then say 'Error: COUCOPY.DLL not found.'
return 2
end
otherwise do
if Opt.!Cmd then say 'Error: Error' rc 'registering COUCOPY functions.'
return 1000 + rc
end
end
return 0
/*****************************************************************************
* LoadDBOXMGR2 *
*****************************************************************************/
LoadDBoxMgr2: procedure expose (Globals)
if Opt.!Cmd then say 'Registering DBOXMGR2 functions...'
call rxfuncadd 'DBOXMGR2', 'DBOXMGR2', 'DBOXMGR2'
do 1000 until Res <> -1 /* test code - dboxmgr timing problems? */
signal on syntax name LoadDBoxMgr2
Res = 'DBoxMgr2'()
signal on syntax name syntax
end
if Res = -1
then do
if Opt.!Cmd then say 'Error: DBOXMGR2.DLL not found.'
exit 2
end
if Opt.!Cmd then say 'Registered.'
return 0
signal on syntax name LoadCouCopy2
call rxCouCopy 'BADARG', 'BADARG'
signal on syntax name syntax
if Opt.!Cmd then say 'Registered.'
return 0
LoadDBoxMgr2:
signal on syntax name syntax
select
when rc = 43
then do
if Opt.!Cmd then say 'Error: DBOXMGR2.DLL not found.'
return 2
end
otherwise do
if Opt.!Cmd then say 'Error: Error' rc 'registering DBOXMGR2 functions.'
return 1000 + rc
end
end
return 0
/*****************************************************************************
* BadInvoke *
*****************************************************************************/
BadInvoke: procedure expose (Globals)
if Opt.!Cmd then do
say 'REGFUNC - Register an external REXX function package'
say
say 'Syntax: REGFUNC packname'
say
say 'packname: COUCOPY'
say ' COUENV'
if IUO then
say ' DBOXMGR2'
say ' REXXUTIL'
say ' RXUTILS'
say
say 'Return codes:'
say ' 2 - DLL not found'
say ' 40 - Bad invocation'
say ' 255 - Programming error'
say '1nnn - Unexpected error nnn'
end
exit 40
/*****************************************************************************
* DEBUGGING and ERROR RECOVERY *
*****************************************************************************/
DebugInit:
if wordpos('/DEBUG', Args) > 0
then do
Parms.!Debug = 1
Parms.!Wait = 1
parse var Args ArgA '/DEBUG' DArg '/' ArgB
Args = strip(ArgA '/'ArgB, 'T', '/')
call Report '9999W', 'Debug mode activated.'
call SetMsgClass 'X', 'X'
end
else do
Parms.!Debug = 0
call SetMsgClass 'I', 'X'
end
return 0
BugInit:
if symbol('GLOBALS') = 'LIT'
then do
Globals = 'TrVal'
TrVal = 'O'
end
parse upper source . . Me /* See if we're running from the macrospace */
say
say 'Error from' Me':'
MS = pos('\', Me) = 0 /* since we can't use sourceline if we are */
return MS
Syntax:
signal off error; signal off failure; signal off halt
signal off novalue; signal off notready; signal off syntax
Where = sigl
MacroSp = BugInit()
Msg = 'Syntax error' rc '('errortext(rc)') raised in line' Where'.'
signal DebugExit
Novalue:
signal off error; signal off failure; signal off halt
signal off novalue; signal off notready; signal off syntax
Where = sigl
MacroSp = BugInit()
Msg = 'Novalue error ('condition('D')') raised in line' Where'.'
signal DebugExit
DebugExit:
signal off syntax
if Parms.!Wait = 1
then if translate(linein('STDIN:')) = '/D'
then do
say 'Trace mode started. TRACE O to exit.'
say
trace ?i
nop
end
say Msg
exit 255