home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
netdor3.zip
/
TOOLS
/
IMPIT.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1996-04-04
|
121KB
|
3,722 lines
/*****************************************************************************
* IMPIT - IMP Installation Tool *
* T. Bridgman / T. Rogers - CORE at WATSON *
* (Change history is at bottom of file) *
*****************************************************************************
* 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'
trace 'E'
call on halt
signal on novalue
signal on syntax
Globals = 'Opts. Imp. File.'
parse source . How .
Opts. = 0
Opts.!CmdMode = (How = 'COMMAND')
if Opts.!CmdMode
then do
say
say 'ITL Interpreter'
end
parse arg File.0In Extra '/' Opts
Rtn = 'IMPIT'
if abbrev(File.0In, '?') | Extra <> ''
then signal Tell
call Initialize
call AddImp
call Msg 'ImpIt complete.'
exit 0
Initialize: procedure expose (Globals) Opts Opts.
Opts.0Echo = 'VERBOSE'
Opts.0NoPause = \Opts.!CmdMode
do while Opts <> ''
parse upper var Opts OKey '/' Opts
/**** PTR 10249 start ****/
parse var OKey OKey Extra ':' OVal
if OVal = ''
then OVal = Extra
else if Extra <> ''
then say 'Warning: Unexpected argument "'Extra'" ignored.'
/**** PTR 10249 end ****/
OVal = strip(OVal)
select
when abbrev('FORCE', OKey)
then Opts.0Force = 1
when abbrev('UPDATE', OKey)
then Opts.0Update = 1
when abbrev('RUN', OKey)
then do
Opts.0Run = 1
Opts.0RunFile = OVal
end
when abbrev('NOBACKUP', Okey)
then Opts.0NoBackup = 1
when OKey = 'COREFIX' | OKey = 'NOPAUSE'
then Opts.0NoPause = 1
otherwise
call EMsg 'Unrecognized option' OKey OVal 'specified.'
end
end
call ImpInit
if Opts.!CmdMode
then do
say 'Version' ImpVersion()
say
end
if Opts.0Run
then do
OutC = RunTagFile(Opts.0RunFile)
if \Opts.0NoPause
then call rxPause 'Installation complete. Press any key to exit.'
exit OutC
end
if File.0In = ''
then signal Tell
say 'IMP Installation Tool'
File.0Backup = XFilespec('QPATH', File.0In)
if File.0Backup = ''
then File.0Backup = '.'
if \rxFileExist(File.0In)
then if rxFileExist(File.0In'.CMD')
then File.0In = File.0In'.CMD'
else call EMsg 'Input file' File.0In 'does not exist.'
call Msg 'Reading' File.0In'...'
call ReadFile File.0In
if result <> 0
then say 'Error' result 'reading file.'
return 0
AddImp: procedure expose (Globals)
if Find(':IMP:', 'ALL+') = 0
then do
parse value GetLine() with ':IMP:' PgmVer ':'
if PgmVer = ImpVersion() & \Opts.0Force
then call EMsg File.0In 'already contains IMP' PgmVer 'routines.'
call Msg 'Deleting IMP' PgmVer 'routines...'
call DelBlock '.', 'BOTTOM'
end
else if Find('IMPINIT:', 'ALL+', 'BEGIN') = 0
then call EMsg 'IMP header not found, but IMP routines seem to be',
'present. Check file and try again.'
else if Opts.0Update
then call EMsg File.0In 'does not contain IMP routines.'
do II = Imp.0File.0 to 1 by -1
if Imp.0File.0 <> ''
then leave
end
if Opts.0NoBackup
then BkUp = 'NOBACKUP'
else BkUp = 2
RetC = WriteFile(File.0Backup, BkUp, Opts.0Echo)
if SetCurL('BOTTOM') = 255
then call EMsg File.0In 'does not contain a program.'
RetC = rxRead(Imp.0Me, 'IMPIT')
RetC = rxGrep(':IMP:'ImpVersion()':', Imp.0Me, 'TEMP', 'N')
parse var Temp.1 L1 .
call Msg 'Adding IMP' ImpVersion() 'routines...'
L1 = L1 - 1
ImpIt.L1 = ''
RetC = rxWrite(File.0In, 'IMPIT', ImpIt.0, L1, 'A')
call Msg File.0In 'written successfully.'
/**
call Msg 'Tokenizing file...'
'CALL' File.0In '//T'
**/
return 0
Msg:
parse arg Msg
if Opts.0Echo = 'VERBOSE'
then say Msg
return 0
EMsg:
parse arg Msg
say Msg
exit 2
Tell:
say
say ' IMPIT - ITL Interpreter'
say
say ' Syntax: IMPIT /R:itlfile [/NOPAUSE]'
say
say ' itlfile - ITL program to execute.'
say ' /NOPAUSE - Don''t pause after execution.'
if abbrev(File.0In, '??') then do
say
say copies('-', 79)
say ' IMPIT as IMP Routine Installation Tool'
say
say ' Syntax: IMPIT sourcefile [/Force] [/Update] [/NOBACKUP]'
say
say ' /Force - Force IMP update even if version number hasn''t changed.'
say ' /Update - Update IMP routines only if they exist.'
say ' /NOBACKUP - Don''t make a backup of sourcefile.'
end
exit 0
/** :IMP:2.46: **************************************************************
* *
* Installation/Modification Routines (IMP) *
* *
****************************************************************************/
call ImpError 'No exit statement in IMP program!'
/****************************************************************************
* IMPINIT *
* Initialize RXUTILS if they are not initialized. *
* Initialize REXXUTIL if running under OS/2 2.0. *
* Initialize IMP control variables (all under IMP. stem): *
* 0Init IMPINIT performed flag; set to 1 *
* 0Mod Buffer modified flag; set to 0 *
* 0FileName Name of file in buffer (null if no file) *
* 0BackDir Name of backup directory (null if not specified) *
* 0BackType Type of backup (UNIQUE, nnn) *
* 0CurL Ptr to file buffer; set to 1 *
* 0Version IMP version number (x.yy) *
* 0File. The file buffer *
* 0Me Name of the running program *
* 0BTypes List of valid backup types *
* 0Digits 0-9 *
****************************************************************************/
ImpInit:
Rtn = 'ImpInit'
if symbol('GLOBALS') = 'LIT'
then Globals = 'Imp.'
else do
Adds = 'Imp.'
do while Adds <> ''
parse upper var Adds Add Adds
if wordpos(Add, translate(Globals)) = 0
then Globals = Globals Add
end
end
parse upper arg InFile, Imp.0BackDir, Imp.0BackType
if value('IMP.0INIT') = 1 /* Previous init */
then call ImpError 'Multiple calls to IMPINIT.'
Imp.0BTypes = 'UNIQUE NAME'
Imp.0Digits = '0123456789'
if Imp.0BackType <> ''
then if \CheckBackupType(Imp.0BackType)
then call ImpError 'Bad argument:' Imp.0BackType
call RxUtilsInit
'@ECHO OFF'
Imp.0Mod = 0
Imp.0Init = 1
Imp.0PosStack = ''
Imp.0FileName = ''
Imp.0Verbose = 0
Imp.0StrRep = 1
if symbol('OPTS.0NOPAUSE') = 'VAR'
then Imp.0ErrPause = \Opts.0NoPause
else Imp.0ErrPause = 0
if rxUtilsVer() >= 1.70
then Imp.0BDr = rxBootDrive()
else if rxOS2Ver() < 2.0
then Imp.0BDr = 'C:'
else Imp.0BDr = left(value('COMSPEC',,'OS2ENVIRONMENT'), 2)
parse upper source . . Imp.0Me
RetC = rxGrep(':IMP:', Imp.0Me, 'TEMP')
do I = 1 to Temp.0
parse var Temp.I ':IMP:' Imp.0Version ':'
if datatype(Imp.0Version) = 'NUM'
then leave
end
if Imp.0BackDir <> ''
then if \CheckBackupDir(Imp.0BackDir)
then do
say 'Backup directory' Imp.0BackDir 'not found. Using' Imp.0BDr 'instead.'
Imp.0BackDir = Imp.0BDr
end
if Imp.0BackType = ''
then Imp.0BackType = 'U'
if InFile <> ''
then do
OutC = ReadFile(InFile)
Imp.0CurL = 1
end
else do
Imp.0File.0 = 0
Imp.0CurL = 0
OutC = 255
end
return OutC
/****************************************************************************
* IMPITLINIT *
* Add variables for ITL support. *
****************************************************************************/
ImpITLInit: procedure expose (Globals)
parse upper arg ModFileSpec ., OtherArgs
Imp.!ITLActive = 1
if ModFileSpec = 'QUEUE'
then do
parse var OtherArgs Who PreQ .
if Who = ''
then call ImpError 'Caller not specified on /R:QUEUE.'
if PreQ = ''
then PreQ = 0
if queued() <= PreQ
then call ImpError 'No lines queued.'
do I = 1 while queued() > PreQ
parse pull Imp.0Mods.I
end
Imp.0Mods.0 = I-1
Imp.0ItlMe = Who
Imp.!QItlMe = ''
Opts.0NoPause = 1
end
else do
if rxFileExist(ModFileSpec)
then ModFile = ModFileSpec
else if rxFileExist(ModFileSpec'.ITL')
then ModFile = ModFileSpec'.ITL'
else do
ModFile = rxSearchPath('DPATH', ModFileSpec)
if ModFile = ''
then ModFile = rxSearchPath('DPATH', ModFileSpec'.ITL')
end
if ModFile = ''
then call ImpError 'ITL file' ModFileSpec 'does not exist.'
Imp.0ItlMe = XFileSpec('NAME', ModFile)
call rxTree ModFile, 'TEMP.', 'FO'
Imp.!QITLMe = Temp.1
call RxRead ModFile, 'Imp.0Mods'
end
Imp.0Verbose = 0 /* No verbose messages */
Imp.0StrRep = 0 /* String replacement off */
Imp.0ErrorMode = 'HALT' /* Halt on error */
Imp.0Error = '' /* Error result */
Imp.0TrVal = 'O' /* Tracing off */
Imp.0ItlResult = '' /* Result from EVAL */
Imp.!ItlZipDir = '.' /* Zip file directory */
if symbol('IMP.0ORG.0') = 'VAR'
then do II = 1 to Imp.0Org.0
Var = Imp.0Org.II
drop Imp.0Rep.Var
end
Imp.0Org.0 = 0 /* Source replace strings */
/*
Imp.0Rep.0 = 0 /* Target replace strings */
*/
Imp.0RepStart = '{' /* List of start characters of replace strings */
Imp.0IfStack.0 = 0
Imp.0IfScan = 0
Imp.0ITLLog = '' /* Name of log file */
Imp.0NullEnv = 1 /* Null env var error flag */
call ITLReplaceStringAdd '{NULL}', d2c(0)
call ITLReplaceStringAdd '{SOURCE.DIR}', XFileSpec('QPATH', Imp.!QItlMe)
call ITLReplaceStringAdd '{COMMA}', ','
call ITLReplaceStringAdd '{SP}', ' '
call ITLReplaceStringAdd '{AMP}', '&'
call ITLReplaceStringAdd '{OS2VER}', rxOs2Ver()
call ITLReplaceStringAdd '{BOOT.DRIVE}', Imp.0BDr
call ITLReplaceStringAdd2 '{CMLIB.DRIVE}',,
left(rxSearchPath('PATH', 'STARTCM.CMD'), 2)
LDr = left(rxSearchPath('PATH', 'NET.EXE'), 2)
if LDr <> '' then do
call ITLReplaceStringAdd '{IBMLAN.DRIVE}', LDr
call RxGrep 'COMPUTERNAME =', LDr'\IBMLAN\IBMLAN.INI', 'GStem.'
if GStem.0 <> 0 then do
parse var GStem.1 'COMPUTERNAME =' Req .
call ITLReplaceStringAdd '{WKSNAME}', Req
end
end
else do
call ITLReplaceStringAdd '{WKSNAME}', ''
call ITLReplaceStringAdd '{DOMNAME}', ''
end
/**** PTR 10128 start ****/
call ITLReplaceStringAdd '{CORE.INI}', CoreData('COREINI')
call ITLReplaceStringAdd '{NETDOOR.INI}', CoreData('COREINI')
call ITLReplaceStringAdd '{CORE.DIR}', CoreData('COREDIR')
call ITLReplaceStringAdd '{NETDOOR.REMOTE}', CoreData('COREDIR')
call ITLReplaceStringAdd '{USER.DIR}', CoreData('USERDIR')
call ITLReplaceStringAdd '{NETDOOR.LOCAL}', CoreData('USERDIR')
call ITLReplaceStringAdd '{USER.DATA}', CoreData('DATADIR')
call ITLReplaceStringAdd '{NETDOOR.DATA}', CoreData('DATADIR')
call ITLReplaceStringAdd '{TEMP.DIR}', CoreData('TEMPDIR')
call ITLReplaceStringAdd '{NETDOOR.TEMP}', CoreData('TEMPDIR')
call ITLReplaceStringAdd '{IMP.VERSION}', Imp.0Version
/**** PTR 10128 end ****/
return 0
/****************************************************************************
*ITLREPLACESTRINGADD source, target *
****************************************************************************/
ITLReplaceStringAdd: procedure expose (Globals)
parse arg Source, Target
if Source = ''
then call ITLErr 'Null source string specified.'
else do
Source = translate(strip(Source))
if pos(left(Source, 1), Imp.0RepStart) = 0
then Imp.0RepStart = Imp.0RepStart||left(Source, 1)
if symbol('IMP.0REP.SOURCE') = 'LIT'
then call rxStemInsert 'Imp.0Org.', Imp.0Org.0 + 1, Source
Imp.0Rep.Source = Target
end
return 0
ITLReplaceStringAdd2: procedure expose (Globals)
parse arg Source, Target
return ITLReplaceStringAdd(Source, strip(Target))
/****************************************************************************
* CHECKBACKUPTYPE *
* Check for valid backup type - return 1 if good 0 o/w *
****************************************************************************/
CheckBackupType: procedure expose (Globals)
parse arg BackType '=' BackArg
GoodType = (verify(BackType, Imp.0Digits) = 0) | BackType = 'NOBACKUP'
do I = 1 to words(Imp.0BTypes) while \GoodType
GoodType = abbrev(word(Imp.0BTypes, I), BackType)
end
if GoodType & abbrev('NAME', BackType)
then GoodType = (BackArg <> '')
return GoodType
/****************************************************************************
* CHECKBACKUPDIR *
* Check for existing backup drive - return 1 if good 0 o/w *
****************************************************************************/
CheckBackupDir: procedure expose (Globals)
parse arg Dir .
return rxDirExist(Dir) | Dir = '.'
/****************************************************************************
* RXUTILSINIT *
* Register all RXUTILS functions if they don't appear to be registered. *
* Register all REXXUTILS functions if we're on 2.0. *
****************************************************************************/
RxUtilsInit: procedure expose (Globals)
Rtn = 'RxUtilsInit'
if rxfuncquery('RXLISTFUNCS')
then do
call rxfuncadd 'RXUTILSVER', 'RXUTILS', 'RXUTILSVER'
if rxfuncquery('RXUTILSVER')
then call ImpError 'RXUTILS not available or downlevel.'
else do
Temp = rxUtilsVer()
if Temp < 1.70
then call ImpError 'RXUTILS version 1.70 required,' Temp 'found.'
end
call rxfuncadd 'RXLISTFUNCS', 'RXUTILS', 'RXLISTFUNCS'
call rxListFuncs 'LIST'
do I = 1 to words(List)
Func = word(List, I)
call rxfuncadd Func, 'RXUTILS', Func
end
end
call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
Syntax.Ref = 'NOCOUENV'
call rxCouInfo 'VER'
drop Syntax.Ref
call rxfuncadd 'RXCOUCOPY', 'COUCOPY', 'RXCOUCOPY'
call rxfuncadd 'RXCOUDELETE', 'COUCOPY', 'RXCOUDELETE'
call rxfuncadd 'RXCOUDELETEALL', 'COUCOPY', 'RXCOUDELETEALL'
call rxfuncadd 'RXCOUASSOCIATEAPPFILE', 'COUCOPY', 'RXCOUASSOCIATEAPPFILE'
call rxfuncadd 'RXCOUREMOVEAPPFILE', 'COUCOPY', 'RXCOUREMOVEAPPFILE'
return 0
/****************************************************************************
* ADDLOCALFILES - Add to local file list *
* 1. Ini, App, 'AUTOUP', LocFile, SrcFile *
* 2. Ini, App, LocFile *
* 3. Ini, App, Dir, LocFileList *
****************************************************************************/
AddLocalFiles: procedure expose (Globals)
Rtn = 'AddLocalFiles'
parse arg Ini, App, Dir, FileList, SrcFile
if Ini = '' | App = '' | Dir = ''
then call ImpError 'Invalid arguments.'
AutoUp = (translate(Dir) = 'AUTOUP')
if AutoUp
then if FileList = '' | SrcFile = ''
then call ImpError 'Invalid arguments.'
else do
Dir = FileList
FileList = ''
end
if FileList = ''
then if rxFileExist(Dir)
then do
FileList = filespec('NAME', Dir)
Dir = XFileSpec('QPATH', Dir)
end
else call ImpError 'Local file' Dir 'does not exist.'
App = translate(App)
if right(Dir, 1) <> '\'
then Dir = Dir'\'
List = IniGet(Ini, 'LocalFiles', App, 'ITLERREXIT ENDNULL')
Files = ''
Entry. = '?'
do while List <> ''
parse var List Entry '0'x List
parse var Entry Local '|' Src
Entry.Local = Src
Files = Files||Local'|'
end
do while FileList <> ''
parse var FileList File FileList
File = Dir||File
if Entry.File = '?'
then do
Entry.File = SrcFile
Files = Files'|'File
end
else if SrcFile <> '' & Entry.File <> SrcFile
then Entry.File = SrcFile
end
List = ''
do while Files <> ''
parse var Files File '|' Files
if File <> ''
then List = List||File'|'Entry.File'0'x
end
Res = IniSet(Ini, 'LocalFiles', App, List, 'ITLERREXIT')
return 0
/****************************************************************************
* DELLOCALFILES - Delete locally installed files *
****************************************************************************/
DelLocalFiles: procedure expose (Globals)
Rtn = 'DelLocalFiles'
if arg() < 1 | arg() > 2
then call ItlErr 'Invalid arguments.'
if arg() = 1
then parse arg App
else parse arg Ini, App
App = translate(App)
XC = 0
if arg() = 1
then do
Defer = 0
Res = rxCouDeleteAll(App, Defer)
if abbrev(Res, 'ERROR:')
then XC = 100 + substr(Res, 7)
end
else do
List = IniGet(Ini, 'LocalFiles', App, 'ITLERREXIT')
Count = 0
do while List <> ''
parse var List File '0'x List
parse var File File '|'
if rxFileExist(File)
then Res = rxDelete(File)
else Res = 0
if Res <> 0
then Count = Count + 1
end
call rxOs2Ini Ini, 'LocalFiles', App, '$RXDEL'
if Count > 0
then XC = 1000 + Count
else XC = 0
end
return XC
/****************************************************************************
* AT n | TOP | BOTTOM *
****************************************************************************/
At: procedure expose (Globals)
Rtn = 'AT'
if Imp.0File.0 = 0
then return 255
parse arg Where
if Where = 'BOTTOM'
then Where = Imp.0File.0
else if Where = 'TOP'
then Where = 1
if \datatype(Where, 'N')
then call ImpError 'Invalid line number' Where'.'
return (Imp.0CurL = Where)
/****************************************************************************
* CHANGE Target, New, Scope, Direction *
****************************************************************************/
Change: procedure expose (Globals)
Rtn = 'CHANGE'
parse arg Target, New, Scope Ex1, Dir Ex2
if Scope = '' then Scope = 'FIRST'
if Dir = '' then Dir = 'LEFT'
if wordpos(Scope, 'FIRST ALL') = 0 | wordpos(Dir, 'LEFT RIGHT') = 0 | Ex1 Ex2 <> ''
then call ImpError 'Bad arguments:' Scope',' Dir
if Imp.0File.0 = 0
then return 255
CL = Imp.0CurL
Temp = ChangeStr(Imp.0File.CL, Target, New, Scope, Dir)
if Temp <> Imp.0File.CL
then do
Imp.0Mod = 1
Imp.0File.CL = Temp
return 0
end
else return 1
/**
WorkLine = Imp.0File.CL
if Dir = 'RIGHT'
then do
Target = reverse(Target)
New = reverse(New)
WorkLine = reverse(WorkLine)
end
LT = length(Target)
Found = 0
do forever
Temp = translate(WorkLine)
Index = pos(Target, Temp)
if Index = 0
then leave
Found = 1
WorkLine = left(WorkLine, Index-1)||New||substr(WorkLine, Index + LT)
if Scope <> 'ALL'
then leave
end
if Dir = 'RIGHT'
then Imp.0File.CL = reverse(WorkLine)
else Imp.0File.CL = WorkLine
Imp.0Mod = Found
return \(Found)
*/
/****************************************************************************
* CHANGESTR String, Target, New, Scope, Direction *
****************************************************************************/
ChangeStr: procedure expose (Globals)
Rtn = 'ChangeStr'
parse arg WorkLine, Target, New, Scope Ex1, Dir Ex2
if Scope = '' then Scope = 'FIRST'
if Dir = '' then Dir = 'LEFT'
if WorkLine = '' | Target = '' | wordpos(Scope, 'FIRST ALL') = 0 |,
wordpos(Dir, 'LEFT RIGHT') = 0 | Ex1 Ex2 <> ''
then call ImpError 'Bad arguments:' WorkLine',' Target',' Scope Ex1',' Dir Ex2
Target = translate(Target)
if Dir = 'RIGHT'
then do
Target = reverse(Target)
New = reverse(New)
WorkLine = reverse(WorkLine)
end
LT = length(Target)
Found = 0
do forever
Temp = translate(WorkLine)
Index = pos(Target, Temp)
if Index = 0
then leave
Found = 1
WorkLine = left(WorkLine, Index-1)||New||substr(WorkLine, Index + LT)
if Scope <> 'ALL'
then leave
end
if Dir = 'RIGHT'
then return reverse(WorkLine)
else return WorkLine
/****************************************************************************
* CMDCOMPARE cmd1, cmd2, ABBREV *
****************************************************************************/
CmdCompare: procedure expose (Globals)
Rtn = 'CmdCompare'
parse upper arg Cmd.1, Cmd.2, Abbrev .
if Cmd.1 = ''
then call ImpError 'Bad arguments: cmd not specified.'
Abbrev = abbrev('ABBREV', Abbrev)
if Cmd.2 = ''
then Cmd.2 = translate(GetLine())
do I = 1 to 2
Cmd.I = strip(Cmd.I, 'L')
if abbrev(space(Cmd.I, 0), 'PATH=') | abbrev(space(Cmd.I, 0), 'DPATH=')
then Cmd.I = 'SET' Cmd.I
if word(Cmd.I, 1) = 'SET' & pos('=', Cmd.I) <> 0
then do
parse var Cmd.I A '=' B
if pos('PATH', A) = 1
then if right(strip(B), 1) <> ';'
then B = strip(B)';'
Cmd.I = space(A)'='||B
end
else if pos('=', Cmd.I) <> 0
then do
parse var Cmd.I A '=' B
Cmd.I = space(A)'='space('B')
end
else Cmd.I = space(B)
end
if Abbrev
then return (abbrev(Cmd.2, Cmd.1))
else return (Cmd.1 = Cmd.2)
/****************************************************************************
* COPYFILE source, destination, [opt], [appname] *
****************************************************************************/
CopyFile: procedure expose (Globals)
Rtn = 'COPYFILE'
parse arg Source, Dest, Opt .
Opt = translate(Opt)
if Source = '' | Dest = ''
then call ImpError 'Bad aruments: source and target must be specified.'
if verify(Source||Dest, '?*', 'M') > 0
then call ImpError 'Bad aruments: wild cards are not supported.'
if Opt <> '' & wordpos(Opt, 'NEWONLY REPLACEONLY COUCOPY') = 0
then call ImpError 'Unrecognized option' Opt'.'
CouCopy = (Opt = 'COUCOPY')
if CouCopy
then do
parse arg , , , AppName ., AutoUp ., Defer .
Defer = (Defer = 1)
AutoUp = (AutoUp = 1)
end
else if pos('[', Source||Dest) > 0
then call ImpError 'Invalid chars in source or target.'
XC = 0
if CouCopy
then do
Res = rxCouCopy(Source, Dest, Defer, AppName, AutoUp)
if abbrev(Res, 'ERROR:')
then XC = 100 + substr(Res, 7)
end
else do
if right(Dest, 1) = '\' & length(Dest) <> 3
then Dest = strip(Dest, 'T', '\')
if rxDirExist(Dest)
then Dest = strip(Dest, 'T', '\')'\'filespec('NAME', Source)
select
when Opt = 'NEWONLY'
then CopyIt = \rxFileExist(Dest)
when Opt = 'REPLACEONLY'
then CopyIt = rxFileExist(Dest)
otherwise
CopyIt = 1
end
if CopyIt
then CopyIt = rxFileExist(Source)
if CopyIt
then do
'COPY /B' Source Dest '>NUL 2>&1'
XC = (rc <> 0)
end
end
return XC
/****************************************************************************
* COREDATA datatype *
****************************************************************************/
CoreData: procedure expose (Globals)
Rtn = 'CoreData'
parse upper arg Data .
TrailSlash = 1
select
when Data = 'COREDIR'
then Act = rxCouInfo('GET', 'REMOTE')
when Data = 'DATADIR'
then do
Act = rxCouInfo('GET', 'DATA')
TrailSlash = 0
end
when Data = 'TEMPDIR'
then do
Act = rxCouInfo('GET', 'TEMP')
TrailSlash = 0
end
when Data = 'USERDIR'
then Act = rxCouInfo('GET', 'LOCAL')
when Data = 'COREINI'
then do
Act = rxCouInfo('GET', 'INIFILE')
TrailSlash = 0
end
otherwise call ImpError 'Bad argument:' Data'.'
end
Act = translate(left(Act, 1))||substr(Act, 2)
if TrailSlash & right(Act, 1) <> '\'
then Act = Act'\'
return Act
/****************************************************************************
* CURLN *
****************************************************************************/
CurLn: procedure expose (Globals)
Rtn = 'CurLn'
Imp.0CurL = min(Imp.0CurL, Imp.0File.0)
return Imp.0CurL
/****************************************************************************
* DELBLOCK Start, End *
****************************************************************************/
DelBlock: procedure expose (Globals)
Rtn = 'DelBlock'
if Imp.0File.0 = 0
then return 255
parse upper arg LStart, LEnd
if LStart = '.' | LStart = 'CURLN' /* . = Compatibility w/ pre 2.14 */
then LStart = Imp.0CurL
if LEnd = 'CURLN'
then LEnd = Imp.0CurL
if datatype(LStart) <> 'NUM' | (datatype(LEnd) <> 'NUM' & LEnd <> 'BOTTOM')
then call ImpError 'Bad arguments:' LStart',' LEnd
if LEnd = 'BOTTOM'
then do
Imp.0File.0 = LStart - 1
Imp.0CurL = min(Imp.0CurL, LStart - 1)
end
else do I = min(LEnd, Imp.0File.0) to LStart by -1
call rxStemDelete('IMP.0FILE', I)
end
Imp.0Mod = 1
return 0
/****************************************************************************
* DELLINE [BACKUP] *
****************************************************************************/
DelLine: procedure expose (Globals)
Rtn = 'DelLine'
parse upper arg Opt
if Imp.0File.0 = 0
then RetC = 255
else do
RetC = rxStemDelete('IMP.0FILE', Imp.0CurL)
if RetC <> 0 then call ImpError '*' RetC
Imp.0CurL = min(Imp.0CurL, Imp.0File.0)
if Opt = 'BACKUP'
then if Imp.0CurL <> Imp.0File.0
then Imp.0CurL = max(Imp.0CurL - 1, 1)
RetC = 0
Imp.0Mod = 1
end
return RetC
/****************************************************************************
* DELPATH path, dir *
****************************************************************************/
DelPath: procedure expose (Globals)
Rtn = 'DelPath'
parse upper arg Path, Dir ';'
Dir = translate(Dir)
if Imp.0File.0 = 0
then return 255
if Path <> 'LIBPATH'
then Path = 'SET' Path
Where = FindIt(Path, 1, Imp.0File.0, 1, 'BEGIN', 1)
/*** PTR 10300 start ***/
if Where = 0
then do
if Path = 'SET PATH' | Path = 'SET DPATH'
then Where = FindIt(word(Path, 2), 1, Imp.0File.0, 1, 'BEGIN', 1)
if Where = 0
then return 1
else parse var Imp.0File.Where . Data
end
else parse var Imp.0File.Where '=' Data
/*** PTR 10300 end ***/
if right(Data, 1) <> ';'
then Data = Data';'
TestLine = translate(Data)
if abbrev(TestLine, Dir';')
then Offset = 1
else Offset = pos(';'Dir';', TestLine)
if Offset > 0
then do
if Offset > 1
then OffSet = Offset + 1
Data = delstr(Data, Offset, length(Dir)+1)
Imp.0File.Where = Path'='Data
Imp.0Mod = 1
end
return 0
/****************************************************************************
* DELSTRING Target *
****************************************************************************/
DelString: procedure expose (Globals)
Rtn = 'DelString'
parse upper arg Target
if Imp.0File.0 = 0
then RetC = 255
else do
CL = Imp.0CurL
Start = pos(Target, translate(Imp.0File.CL))
if Start = 0
then RetC = 1
else do
Imp.0File.CL = delstr(Imp.0File.CL, Start, length(Target))
RetC = 0
Imp.0Mod = 1
end
end
return RetC
/****************************************************************************
* DISCARDFILE *
****************************************************************************/
DiscardFile: procedure expose (Globals)
Rtn = 'DiscardFile'
Imp.0File.0 = 0
Imp.0Mod = 0
Imp.0Filename = ''
return 0
/****************************************************************************
* ECHOFILE *
****************************************************************************/
EchoFile: procedure expose (Globals)
Rtn = 'EchoFile'
parse arg Start ., End .
if Start = ''
then Start = 1
else Start = max(Start, 1)
if End = ''
then End = Imp.0File.0
else End = min(End, Imp.0File.0)
Pad = length(End)
say
do I = Start to End
if I = Imp.0CurL
then Pref = '*'
else Pref = ' '
say Pref||left(I, Pad)':' Imp.0File.I
end
return 0
/****************************************************************************
* ERASEFILE file *
****************************************************************************/
EraseFile: procedure expose (Globals)
Rtn = 'EraseFile'
parse arg File .
return RxDelete(File)
/****************************************************************************
* FILECHANGED *
****************************************************************************/
FileChanged: procedure expose (Globals)
Rtn = 'FileChanged'
return Imp.0Mod
/****************************************************************************
* FILETYPE [type] *
****************************************************************************/
FileType: procedure expose (Globals)
Rtn = 'FileType'
KnownTypes = 'REXX BATCH CONFIG IBMLAN PROTOCOL'
parse arg TestType Extra
if TestType = ''
then return XXFileType()
else if wordpos(TestType, KnownTypes) = 0 | Extra <> ''
then call ImpError 'Bad argument:' TestType Extra
else return (TestType = XXFileType())
/****************************************************************************
* XXFILETYPE *
****************************************************************************/
XXFileType: procedure expose (Globals)
InFile = translate(FileSpec('NAME', Imp.0FileName))
select
when InFile = 'CONFIG.SYS'
then return 'CONFIG'
when InFile = 'IBMLAN.INI'
then return 'IBMLAN'
when InFile = 'PROTOCOL.INI'
then return 'PROTOCOL'
when XFilespec('FEXT', InFile) = 'CMD'
then do
if Imp.0File.0 > 0
then if abbrev(Imp.0File.1, '/'||'*')
then return 'REXX'
return 'BATCH'
end
otherwise
return 'TEXT'
end
/****************************************************************************
* FIND Target, Scope, [Position] *
****************************************************************************/
Find: procedure expose (Globals)
Rtn = 'Find'
parse upper arg Target, Scope, Position
if Imp.0File.0 = 0
then return 255
if Position <> '' & wordpos(Position, 'BEGIN END ALL') = 0
then call ImpError 'Illegal position' Position'.'
CL = Imp.0CurL
select
when Scope = '' | Scope = '+' then do
FStart = CL + 1
FEnd = Imp.0File.0
FIncr = 1
end
when Scope = 'ALL+' then do
FStart = 1
FEnd = Imp.0File.0
FIncr = 1
end
when Scope = '-' then do
FStart = CL - 1
FEnd = 1
FIncr = -1
end
when Scope = 'ALL-' then do
FStart = Imp.0File.0
FEnd = 1
FIncr = -1
end
otherwise
call ImpError 'Illegal scope' Scope'.'
end /* select */
Imp.0Find.0Target = Target
Imp.0Find.0FStart = FStart
Imp.0Find.0FEnd = FEnd
Imp.0Find.0FIncr = FIncr
Imp.0Find.0Position = Position
Where = FindIt(Target, FStart, FEnd, FIncr, Position)
if Where = 0
then RetC = 1
else do
RetC = 0
Imp.0CurL = Where
end
return RetC
/****************************************************************************
* FINDNEXT *
****************************************************************************/
FindNext: procedure expose (Globals)
Rtn = 'FindNext'
if Imp.0File.0 = 0
then RetC = 255
else do
Imp.0Find.0FStart = Imp.0CurL + Imp.0Find.0FIncr
Where = FindIt(Imp.0Find.0Target, Imp.0Find.0FStart, Imp.0Find.0FEnd,,
Imp.0Find.0FIncr, Imp.0Find.0Position)
if Where = 0
then RetC = 1
else do
RetC = 0
Imp.0CurL = Where
end
end
return RetC
/****************************************************************************
* FINDIT Target, StartL, EndL, Increment, Position, XTest *
****************************************************************************/
FindIt: procedure expose (Globals) Rtn
Rtn = Rtn '(Engine)'
parse arg Target, FStart, FEnd, FIncr, Position, XTest
Found = 0
Target = translate(Target)
FEnd = min(FEnd, Imp.0File.0)
XTest = (Xtest = 1)
if XTest
then Target = space(strip(Target))
do I = FStart to FEnd by FIncr
if XTest
then TestLine = translate(space(strip(Imp.0File.I)))
else TestLine = translate(strip(Imp.0File.I))
if pos(Target, TestLine) = 0
then iterate
select
when Position = ''
then Found = 1
when Position = 'BEGIN' & abbrev(TestLine, Target)
then Found = 1
when Position = 'END' & abbrev(reverse(TestLine), reverse(Target))
then Found = 1
when Position = 'ALL' & Target = TestLine
then Found = 1
otherwise nop
end /* select */
if Found
then leave
end /* do */
Rtn = word(Rtn, 1)
if Found
then return I
else return 0
/****************************************************************************
* GETDISK label [, name] *
****************************************************************************/
GetDisk: procedure expose (Globals)
Label = translate(arg(1))
Name = arg(2)
if Name = ''
then Name = 'the disk labeled "'Label'"'
else Name = '"'Name'"'
parse upper value rxDriveInfo('A:') with 'LABEL=' DLabel 'FREE='
do while DLabel <> Label
say 'Please insert' Name 'in drive A:.'
call rxPause 'Press any key when ready.'
parse upper value rxDriveInfo('A:') with 'LABEL=' DLabel 'FREE='
end
return 0
/****************************************************************************
* GETLINE linenum *
****************************************************************************/
GetLine: procedure expose (Globals)
Rtn = 'GetLine'
parse arg LineNum .
if LineNum = ''
then LineNum = Imp.0CurL
if LineNum < 1 | LineNum > Imp.0File.0
then return ''
else return Imp.0File.LineNum
/****************************************************************************
* IMPVERSION *
****************************************************************************/
IMPVersion: procedure expose (Globals)
Rtn = 'ImpVersion'
return Imp.0Version
/****************************************************************************
* INIGET file, app, key, [ENDNULL] [ERREXIT] [ITLERREXIT] *
****************************************************************************/
IniGet: procedure expose (Globals)
Rtn = 'IniGet'
parse arg File, App, Key, Flags
Flags = translate(Flags)
EndNull = wordpos('ENDNULL', Flags) > 0
ErrExit = wordpos('ERREXIT', Flags) > 0
ITLErrExit = wordpos('ITLERREXIT', Flags) > 0
Res = rxOs2Ini(File, App, Key)
select
when Res = '$INIERROR'
then if ErrExit
then call ImpError 'Error reading INI file' File'.'
else if ITLErrExit
then call ITLErr 'Error reading INI file' File'.'
else Res = ''
when Res = '$RXERROR'
then Res = ''
otherwise nop
end
if EndNull & Res <> '' & right(Res, 1) <> '0'x
then Res = Res '0'x
return Res
/****************************************************************************
* INISET file, app, key, val, [ERREXIT] [ITLERREXIT] *
****************************************************************************/
IniSet: procedure expose (Globals)
Rtn = 'IniSet'
parse arg File, App, Key, KVal, Flags
Flags = translate(Flags)
EndNull = wordpos('ENDNULL', Flags) > 0
ErrExit = wordpos('ERREXIT', Flags) > 0
ITLErrExit = wordpos('ITLERREXIT', Flags) > 0
Res = rxOs2Ini(File, App, Key, KVal)
if Res = '$INIERROR'
then if ErrExit
then call ImpError 'Error writing INI file' File'.'
else if ITLErrExit
then call ITLErr 'Error writing INI file' File'.'
else Res = 2
else Res = 0
return Res
/****************************************************************************
* INSBLANK linenum *
****************************************************************************/
InsBlank: procedure expose (Globals)
Rtn = 'InsBlank'
parse arg Where
OutC = InsLine('', Where, 1)
if OutC = 0 & Where = 'BEFORE'
then call SetCurL('DOWN')
return OutC
/****************************************************************************
* INSLINE newline, linenum, InsBlankFlag *
****************************************************************************/
InsLine: procedure expose (Globals)
Rtn = 'InsLine'
parse arg NewLine, Where LineNum, Blank
Blank = (Blank = 1)
if Where = ''
then Where = 'AFTER'
else Where = translate(Where)
if LineNum = '' then LineNum = Imp.0CurL
if verify(LineNum, Imp.0Digits) <> 0 | wordpos(Where, 'BEFORE AFTER') = 0
then call ImpError 'Bad arguments:' NewLine',' Where LineNum
select
when Imp.0File.0 = 0
then LineNum = 1
when Where = 'AFTER'
then LineNum = Linenum + 1
otherwise nop
end
if Blank
then do
L1 = max(LineNum - 1, 1)
L2 = min(LineNum + 1, Imp.0File.0)
if strip(Imp.0File.L1) = '' | strip(Imp.0File.LineNum) = '' |,
strip(Imp.0File.L2 = '')
then return 1
end
LineNum = max(1, min(LineNum, Imp.0File.0 +1))
RetC = rxStemInsert('IMP.0FILE', LineNum, NewLine)
if RetC <> 0 then call ImpError '*' RetC
Imp.0CurL = LineNum
Imp.0Mod = 1
return 0
/****************************************************************************
* INSPATH path, dir, pos, CREATE [loc], GOTO *
****************************************************************************/
InsPath: procedure expose (Globals)
Rtn = 'InsPath'
parse arg Path, Dir ';', Posn, Create AddLn, Goto
parse upper var Posn Posn STarget OrClause
Create = abbrev('CREATE', translate(Create), 1)
Goto = abbrev('GOTO', translate(Goto), 1)
if Path = '' | Dir = '' | Posn = '' | wordpos(Posn, 'BEGIN END BEFORE AFTER') = 0
then call ImpError 'Bad arguments:' Path',' Dir',' Posn'.'
if OrClause <> '' & word(OrClause, 1) <> 'OR'
then call ImpError 'Bad argument:' Posn STarget OrClause
if Imp.0File.0 = 0 & \Create
then return 255
if \abbrev(translate(Path), 'SET') & Path <> 'LIBPATH'
/**
then if \(Path = 'LIBPATH' | (FileType('BATCH') & wordpos(Path, 'PATH DPATH) > 0))
**/
then Path = 'SET' Path
TestPath = ''
Where = FindIt(Path, 1, Imp.0File.0, 1, 'BEGIN', 1)
if Where > 0
then parse upper var Imp.0File.Where Testpath '='
do while (Where <> 0) & (translate(Path) <> TestPath)
Where = FindIt(Path, Where+1, Imp.0File.0, 1, 'BEGIN', 1)
if Where > 0
then parse upper var Imp.0File.Where Testpath '='
end
/*** PTR 10300 start ***/
if Where = 0
then if Path = 'SET PATH' | Path = 'SET DPATH'
then do
Path2 = word(Path, 2)
Where = FindIt(Path2, 1, Imp.0File.0, 1, 'BEGIN', 1)
if Where > 0
then if pos('=', Imp.0File.Where) > 0
then parse upper var Imp.0File.Where Testpath '='
else parse upper var Imp.0File.Where Testpath .
do while (Where <> 0) & (translate(Path2) <> TestPath)
Where = FindIt(word(Path, 2), Where+1, Imp.0File.0, 1, 'BEGIN', 1)
if Where > 0
then if pos('=', Imp.0File.Where) > 0
then parse upper var Imp.0File.Where Testpath '='
else parse upper var Imp.0File.Where Testpath .
/*** PTR 10300 end ***/
end
end
if Where = 0
then if Create
then do
if AddLn = ''
then AddLn = Imp.0File.0 + 1
else if \datatype('+'AddLn'.', 'W')
then AddLn = FindIt(AddLn, 1, Imp.0File.0, 1, '', 1) + 1
if AddLn = 0
then AddLn = Imp.0File.0 + 1
else AddLn = min(AddLn, Imp.0File.0 + 1)
call rxStemInsert 'IMP.0FILE', AddLn, Path'='Dir
if Goto
then Imp.0CurL = AddLn
Imp.0Mod = 1
OutC = 0
end
else OutC = 1
else do
EqSign = (pos('=', Imp.0File.Where) > 0)
if EqSign
then parse var Imp.0File.Where Prefix '=' TestLn
else parse var Imp.0File.Where Prefix TestLn
Prefix = strip(Prefix, 'T')
if EqSign
then Prefix = Prefix'='
else Prefix = Prefix' '
TestLn = strip(space(TestLn, 0))
if right(TestLn, 1) <> ';' & TestLn <> ''
then TestLn = TestLn';'
UTestLn = translate(TestLn)
UDir = translate(Dir)
if pos(';'UDir';', ';'UTestLn) = 0
then do
if STarget <> ''
then Offset = pos(';'STarget';', ';'UTestLn)
else Offset = 0
NewCond = (OrClause <> '' & Offset = 0 & wordpos(Posn, 'BEFORE AFTER') > 0)
select
when NewCond
then do
parse var OrClause 'OR' OrClause
call InsPath Path, Dir, OrClause, Create AddLn, Goto
end
when Posn = 'BEGIN' | (Posn = 'BEFORE' & Offset = 0)
then Imp.0File.Where = Prefix||Dir';'TestLn
when Posn = 'END' | (Posn = 'AFTER' & Offset = 0)
then Imp.0File.Where = Prefix||TestLn||Dir';'
otherwise do
if Posn = 'AFTER'
then Offset = Offset + pos(';', substr(TestLn, Offset))
Imp.0File.Where = Prefix||left(TestLn, Offset-1)||Dir';'||,
substr(TestLn, Offset)
end
end /* select */
Imp.0Mod = 1
end
if Goto
then Imp.0CurL = Where
OutC = 0
end
return OutC
/****************************************************************************
* INSUNIQUE new, where [target], testmode *
****************************************************************************/
InsUnique: procedure expose (Globals)
Rtn = 'InsUnique'
parse arg New, Where Target, Test ., Control .
if Where = ''
then Where = 'AFTER'
else Where = translate(Where)
if Test = ''
then Test = 'EXACT'
else Test = translate(Test)
Control = translate(Control)
if wordpos(Test, 'EXACT COMPRESS PREFIX') = 0 |,
wordpos(Where, 'AFTER BEFORE TOP BOTTOM') = 0 |,
(Control <> '' & wordpos(Control, 'NEWONLY REPLACEONLY') = 0)
then call ImpError 'Bad arguments:' Where',' Test
Compress = (Test <> 'EXACT')
FLn = FindIt(New, 1, Imp.0File.0, 1, 'ALL', Compress)
if FLn <> 0
then do
call SetCurL FLn
return 1
end
if Test = 'PREFIX'
then do
XTest = 'IFS DEVICE CALL DEVINFO RUN CALL'
parse upper var New Word1 .
if pos('=', Word1) > 0
then parse var Word1 Word1 '='
if Word1 = 'SET'
then do
parse upper var New STarget '='
STarget = STarget'='
end
else if wordpos(Word1, XTest) = 0
then STarget = Word1
else STarget = word(New, 1)
SOpt = 'BEGIN'
end
else do
STarget = New
SOpt = 'ALL'
end
if Control <> ''
then do
call SavePos
Found = (Find(STarget, 'ALL+', SOpt) = 0)
call RestorePos
DoIt = ((Control = 'NEWONLY') & \Found) | ((Control = 'REPLACEONLY') & Found)
end
else DoIt = 1
if \DoIt
then return 2
if Control <> 'NEWONLY'
then call RemAll STarget, 'ALL-', SOpt
if Where = 'TOP' | Where = 'BOTTOM'
then do
call SetCurL Where
if Where = 'TOP'
then Where = 'BEFORE'
else Where = 'AFTER'
end
else if Target <> ''
then do
Target = FindIt(Target, 1, Imp.0File.0, 1, '', 0)
if Target = 0
then Target = ''
end
OutC = InsLine(New, Where Target)
return OutC
/****************************************************************************
* INSSTRING new, target, where *
****************************************************************************/
InsString: procedure expose (Globals)
Rtn = 'InsString'
parse arg New, Target, Where
if Imp.0File.0 = 0
then return 255
Where = translate(Where)
if Where <> '' & Where <> 'BEFORE' & Where <> 'AFTER'
then call ImpError 'Illegal position' Where'.'
CL = Imp.0CurL
Target = translate(Target)
Index = pos(Target, translate(Imp.0File.CL))
if Index = 0
then RetC = 1
else do
if Where <> 'BEFORE'
then Index = Index + length(Target)
A = left(Imp.0File.CL, Index-1)
B = substr(Imp.0File.CL, Index)
Imp.0File.CL = A||New||B
RetC = 0
Imp.0Mod = 1
end
return RetC
/****************************************************************************
* MOVEFILE source, target *
****************************************************************************/
MoveFile: procedure expose (Globals)
Rtn = 'MoveFile'
parse arg Source, Target
if rxOS2Ver = 1.1 | left(Source, 3) <> left(Target, 3) |,
pos('\\', left(Source,2)||left(Target,2)) <> 0
then if CopyFile(Source, Target) = 0
then do
'ERASE' Source '> NUL 2>&1'
OutC = 2 * (rc <> 0)
end
else OutC = 1
else do
'MOVE' Source Target '> NUL 2>&1'
OutC = rc
end
return OutC
/****************************************************************************
* NAMEFILE filename *
****************************************************************************/
NameFile: procedure expose (Globals)
Rtn = 'NameFile'
parse arg Name .
if \rxDirExist(XFileSpec('QPATH', Name))
then return 1
Imp.0FileName = Name
Imp.0Mod = (Imp.0Mod | Imp.0File.0 > 0)
return 0
/****************************************************************************
* NUMLINES
****************************************************************************/
NumLines: procedure expose (Globals)
Rtn = 'NumLines'
return Imp.0File.0
/****************************************************************************
* READFILE FileName *
****************************************************************************/
ReadFile: procedure expose (Globals)
Rtn = 'ReadFile'
parse arg InFile .
if InFile = ''
then call ImpError 'Bad argument: input file not specified.'
if Imp.0FileName <> ''
then if Imp.0Mod
then call ImpError 'Attempt to read file' InFile';' Imp.0FileName 'in',
'storage modified and not saved.'
Imp.0Mod = 0
Imp.0FileName = InFile
Imp.0CurL = 0
XCode = 0
if rxFileExist(InFile)
then do
RetC = rxRead(InFile, 'IMP.0FILE')
if RetC <> 0
then XCode = 1
else Imp.0CurL = 1
end
else do
Imp.0File.0 = 0
XCode = 255
end
call SetComment 'IMP'
return XCode
/****************************************************************************
* REMLINE *
****************************************************************************/
RemLine: procedure expose (Globals)
Rtn = 'RemLine'
parse arg RLine
RMode = (RLine <> '') /* Add remark mode */
if \RMode
then if Imp.0File.0 = 0
then return 255
else do
CL = Imp.0CurL
RLine = Imp.0File.CL
end
First = translate(word(RLine, 1))
Last = translate(word(RLine, words(RLine)))
if Imp.0Cmt2 = ''
then RemIt = \abbrev(First, Imp.0Cmt1)
else RemIt = \abbrev(First, Imp.0Cmt1),
& \abbrev(reverse(Last), reverse(Imp.0Cmt2))
if RemIt
then do
RLine = strip(RLine, 'T')
if abbrev(RLine, copies(' ', length(Imp.0Cmt1)+1))
then RLine = overlay(Imp.0Cmt1' ', RLine)
else RLine = Imp.0Cmt1 strip(RLine, 'L')
if RMode
then RLine = RLine Imp.0Cmt2
else RLine = RLine Imp.0CmtD Imp.0Cmt2
end
if RMode
then return RLine
else if RLine <> Imp.0File.CL
then do
Imp.0File.CL = RLine
Imp.0Mod = 1
OutC = 0
end
else OutC = 0
return OutC
/****************************************************************************
* REMALL target, scope, position, exceptions *
****************************************************************************/
RemAll: procedure expose (Globals)
Rtn = 'RemAll'
parse arg Target, Scope ., Pos ., XList
call ImpFindArgs 'PUSH'
RetC = Find(Target, Scope, Pos)
XC = RetC
do while RetC = 0
if \wordpos(Imp.0CurL, XList)
then call RemLine
RetC = FindNext()
end
call ImpFindArgs 'POP'
return XC
/****************************************************************************
* SETCOMMENT *
****************************************************************************/
SetComment: procedure expose (Globals)
Rtn = 'SetComment'
parse arg Func, P1, P2
select
when Func = 'SET'
then do
Imp.0Cmt1 = P1
Imp.0Cmt2 = P2
end
when Func = 'DESC'
then if P1 = ''
then Imp.0CmtD = ''
else Imp.0CmtD = '-' P1
when Func = 'IMP'
then do
Type = FileType()
parse value '' with Imp.0Cmt1 Imp.0Cmt2 Imp.0CmtD
select
when Type = 'BATCH' | Type = 'CONFIG'
then Imp.0Cmt1 = 'REM'
when Type = 'REXX'
then do
Imp.0Cmt1 = '/'"*"; Imp.0Cmt2 = '*'"/"
end
when Type = 'IBMLAN' | Type = 'PROTOCOL'
then Imp.0Cmt1 = ';'
otherwise nop
end
end
otherwise
call ImpError 'Invalid argument' Func
end
return 0
/****************************************************************************
* IMPFINDARGS *
****************************************************************************/
ImpFindArgs: procedure expose (Globals)
parse upper arg Op .
if Op = 'PUSH'
then if symbol('IMP.0FIND.0TARGET') = 'VAL'
then do
Imp.0Save.0Target = Imp.0Find.0Target
Imp.0Save.0FStart = Imp.0Find.0FStart
Imp.0Save.0FEnd = Imp.0Find.0FEnd
Imp.0Save.0FIncr = Imp.0Find.0FIncr
Imp.0Save.0Position = Imp.0Find.0Position
end
else if symbol('IMP.0SAVE.0TARGET') = 'VAL'
then do
Imp.0Find.0Target = Imp.0Save.0Target
Imp.0Find.0FStart = Imp.0Save.0FStart
Imp.0Find.0FEnd = Imp.0Save.0FEnd
Imp.0Find.0FIncr = Imp.0Save.0FIncr
Imp.0Find.0Position = Imp.0Save.0Position
end
return
/****************************************************************************
* REPLACE NewLine *
****************************************************************************/
Replace: procedure expose (Globals)
Rtn = 'REPLACE'
parse arg NewLine
if Imp.0File.0 = 0
then RetC = 255
else do
Temp = Imp.0CurL
Imp.0File.Temp = NewLine
RetC = 0
Imp.0Mod = 1
end
return RetC
/****************************************************************************
* REPLACEFILE source, target *
****************************************************************************/
ReplaceFile: procedure expose (Globals)
Rtn = 'ReplaceFile'
parse arg Source, Target, Opts
if pos('?', Source) + pos('*', Source) > 0
then return ReplaceFileWild(Source, Target)
if \rxFileExist(Source)
then return 2
if \rxFileExist(Target)
then if rxDirExist(Target)
then if right(Target, 1) = '\'
then Target = Target||filespec('NAME', Source)
else Target = Target'\'filespec('NAME', Source)
else do
TargetPath = XFileSpec('QPATH', Target)
if length(TargetPath) > 3
then TargetPath = strip(TargetPath, 'T', '\')
if \rxDirExist(TargetPath)
then return 3
end
call rxTree Target, 'TAR.', 'FT'
if Tar.0 = 0
then CopyIt = 1
else do
call rxTree Source, 'SRC.', 'FT'
CopyIt = word(Src.1, 1) > word(Tar.1, 1)
end
if CopyIt
then do
'COPY' Source Target '> NUL 2>&1'
OutC = rc
end
else OutC = 0
return (OutC <> 0)
ReplaceFileWild: procedure expose (Globals)
Rtn = 'ReplaceFile'
parse arg Source, Target
SDir = left(Source, max(3, lastpos('\', Source)-1))
call rxMkDir Target
if \rxDirExist(SDir) | \rxDirExist(Target)
then return 2
'REPLACE' Source Target '/U'
OutC = (rc > 1)
'REPLACE' Source Target '/A'
OutC = OutC | (rc > 1)
return OutC
/****************************************************************************
* RESTOREPOS *
****************************************************************************/
RestorePos: procedure expose (Globals)
Rtn = 'RestorePos'
if Imp.0PosStack = ''
then call ImpError 'PosStack underflow.'
parse var Imp.0PosStack Imp.0CurL Imp.0PosStack
return 0
/****************************************************************************
* SAVEPOS *
****************************************************************************/
SavePos: procedure expose (Globals)
Rtn = 'SavePos'
Imp.0PosStack = Imp.0PosStack Imp.0CurL
return 0
/****************************************************************************
* SETCURL Where *
****************************************************************************/
SetCurL: procedure expose (Globals)
Rtn = 'SetCurL'
parse upper arg Where
select
when Where = 'BOTTOM'
then where = Imp.0File.0
when Where = 'TOP'
then do
Type = FileType()
if Type = 'TEXT'
then Where = 1
else do
Nest = (wordpos(Type, 'REXX') > 0)
Where = XXScanCmt(1, Imp.0Cmt1, Imp.0Cmt2, Nest)
end
end
when Where = 'DOWN'
then Where = Imp.0CurL + 1
when Where = 'UP'
then Where = Imp.0CurL - 1
otherwise nop
end
if \datatype(Where, 'N')
then call ImpError 'Illegal line number' Where'.'
if Imp.0File.0 = 0
then RetC = 255
else if Where > Imp.0File.0
then RetC = 1
else do
RetC = 0
Imp.0CurL = Where
end
return RetC
/* Return Line number of first non-comment line on or after Start */
XXScanCmt: procedure expose (Globals)
parse arg Start, Cmt1 . , Cmt2 ., Nest
if Nest
then do
Count = 0
do I = Start to Imp.0File.0 until Count <= 0
Last = 0
do until PS = 0 & PE = 0
PS = pos(Cmt1, Imp.0File.I, Last+1)
PE = pos(Cmt2, Imp.0File.I, Last+1)
if PS = 0 & PE = 0
then iterate
if PS > 0
then if PE = 0 | PS < PE
then do
Last = PS
Count = Count + 1
iterate
end
Last = PE
Count = Count - 1
end
end I
I = min(I + 1, Imp.0File.0)
end
else do I = Start to Imp.0File.0 while abbrev(translate(Imp.0File.I), Cmt1)
nop
end
return I
/****************************************************************************
* WRITEFILE *
****************************************************************************/
WriteFile: procedure expose (Globals)
Rtn = 'WriteFile'
parse value '' with BackDir BackType
if arg() = 1
then parse upper arg Echo .
else parse upper arg BackDir, BackType ., Echo .
Echo = abbrev('VERBOSE', Echo, 1)
if \Imp.0Mod
then do
if Echo
then say 'No changes made - file not written.'
return 1
end
if BackDir = ''
then BackDir = Imp.0BackDir
else if \CheckBackupDir(BackDir)
then do
say 'Backup directory' BackDir 'not found.'
BackDir = Imp.0BackDir
end
if BackDir = ''
then do
say 'No default backup directory specified. Using' Imp.0BDr'.'
BackDir = Imp.0BDr
end
if BackType = '' | \CheckBackupType(BackType)
then BackType = Imp.0BackType
parse var BackType BackType '=' BackArg
BackFile = BackDir
if right(BackFile, 1) <> '\'
then BackFile = BackFile'\'
FN = filespec('NAME', Imp.0FileName)
LastDot = lastpos('.', FN)
if LastDot = 0
then BackFile = BackFile||FN'.'
else BackFile = BackFile||left(FN, LastDot)
select
when verify(BackType, Imp.0Digits) = 0
then do
call rxTree BackFile'*', 'BACKS.', 'FT'
call rxStemSort 'BACKS.', 'A', 1, 14
OldBacks = ''
do I = 1 to Backs.0
OldBack = subword(Backs.I, 4)
if verify(XFileSpec('FEXT', OldBack), Imp.0Digits) = 0
then OldBacks = OldBacks OldBack
end
do while words(OldBacks) >= BackType
parse var OldBacks OldBack OldBacks
call rxDelete OldBack
end
BackFile = rxTempFileName(BackFile'???', '?')
end
when abbrev('UNIQUE', BackType)
then BackFile = rxTempFileName(BackFile'???', '?')
when abbrev('NAME', BackType)
then BackFile = BackFile||BackArg
when BackType = 'NOBACKUP'
then BackFile = ''
end
if BackFile <> ''
then do
if Echo
then say 'Backing up' Imp.0FileName 'to' BackFile'...'
'COPY' Imp.0FileName BackFile '2>&1 1>NUL | RXQUEUE'
if rc <> 0
then do
parse pull EMsg
call ImpError 'Error "'EMsg'" creating backup file' BackFile'.'
end
end
if Echo
then say 'Writing' Imp.0FileName'...'
/**
call ImpSaveEAs Imp.0FileName
**/
call rxTree Imp.0FileName, 'TEMP.', 'F'
call rxTree Imp.0FileName, 'JUNK.', 'F',,'*----'
RetC = rxWrite(Imp.0FileName, 'IMP.0FILE', Imp.0File.0)
if RetC <> 0 then call ImpError '*' RetC
/**
call ImpRestoreEAs Imp.0FileName
**/
if Temp.0 > 0
then do
Attribs = word(Temp.1, 4)
NewAttr = translate(Attribs, '+++++', 'ADHRS', '*')
NewAttr = overlay('+', NewAttr, 1) /* Force "A" bit */
call rxTree Imp.0FileName, 'JUNK.', 'F',,NewAttr
end
Imp.0Mod = 0
return 0
ImpSaveEAs: procedure expose (Globals) EASave.
parse arg File
if rxOs2Ver() >= 2.0
then do
drop EASave.
EASave.0 = 0
signal on syntax name ImpSaveEA2
call sysQueryEAList File, 'EASAVE.'
call ImpSaveEA2
end
return 0
ImpSaveEA2:
signal on syntax name syntax
if EASave.0 = 0
then do
call rxStemInsert 'EASAVE.', EASave.0+1, '.TYPE'
call rxStemInsert 'EASAVE.', EASave.0+1, '.LONGNAME'
end
do I = 1 to EASave.0
EA = EASave.I
if sysGetEA(File, EA, 'TEMP') = 0
then EASave.EA = Temp
else EASave.EA = ''
end
return 0
ImpRestoreEAs: procedure expose (Globals) EASave.
parse arg File
if rxOs2Ver() >= 2.0
then do
do I = 1 to EASave.0
EA = EASave.I
if EASave.EA <> ''
then call sysPutEA File, EA, EASave.EA
end
end
return 0
/****************************************************************************
* XFILESPEC Option, FileSpec *
****************************************************************************/
XFileSpec: procedure expose (Globals)
Rtn = 'XFileSpec'
if arg() <> 2
then call ImpError 'Bad arguments.'
parse arg Opt, FS
select
when abbrev('QPATH', Opt)
then return strip(filespec('D', FS)||filespec('P', FS))
when abbrev('FEXT', Opt, 2)
then do
parse value filespec('N', FS) with '.' Ext
return Ext
end
when abbrev('FNAME', Opt, 2)
then do
parse value filespec('N', FS) with Name '.'
return Name
end
when abbrev('DRIVE', Opt) | abbrev('PATH', Opt) | abbrev('NAME', Opt)
then return filespec(Opt, FS)
otherwise call ImpError 'Invalid option' Opt'.'
end
return
/****************************************************************************
* ImpError *
****************************************************************************/
ImpError: procedure expose (Globals) Rtn
parse arg EMsg
if word(EMsg, 1) = '*'
then EMsg = 'Unxepected error' word(EMsg, 2) 'in' Rtn'.'
else if symbol('RTN') = 'VAR'
then Emsg = Emsg '('Rtn')'
if EMsg <> ''
then do
say EMsg
if symbol('Imp.0Org.0') = 'VAR' /* ITL active? */
then do
Imp.0ErrorMode = 'CONTINUE'
call ItlErr EMsg
end
end
if symbol('IMP.0ERRPAUSE') = 'VAR'
then if Imp.0ErrPause = 1
then call rxPause 'Press any key to exit.'
exit 2
/*****************************************************************************
* ASKUSER Question, ResponseList, MinLeng, DefaultFlag *
* Ask the user a question and wait for a valid one word response. Valid *
* reponses are passed in the ResponseList, and the entered response must be *
* of at least the specified minimum length. If DefaultFlag is 1, the first *
* entry of the List will be returned if the user didn't enter anything. *
* *
* Use LINEIN, rather than pull, to avoid (1) annoying '?' and (2) any stack *
* garbage. *
*****************************************************************************/
AskUser: procedure expose (Globals)
trace 'O'
parse arg Question, ResponseList, MinLeng ., DefaultFlag .
say Question
Resp = ''
Responses. = ''
do I = 1 to words(ResponseList)
Responses.I = word(ResponseList, I)
end
do forever
Response = translate(strip(linein('STDIN:')))
if Response = '' & DefaultFlag = 1
then Resp = word(ResponseList, 1)
else do I = 1 to words(ResponseList)
if abbrev(Responses.I, Response, MinLeng) = 1
then do
Resp = Responses.I
leave
end
end
if Resp <> ''
then leave
else say 'Invalid input.'
end /* do forever */
return Resp
/*****************************************************************************
* RUNTAGFILE itlfile *
*****************************************************************************/
RunTagFile: procedure expose (Globals)
parse arg ModFile Rest
if value('IMP.0INIT') <> 1
then call ImpInit
call ImpITLInit ModFile, Rest
Syn. = ''
Syn.ADDOBJECT = 'ADDOBJ'
Syn.ADDPROGRAM = 'ADDP'
Syn.EADDPROGRAM = 'EADDP'
Syn.CHANGEPATH = 'CP'
Syn.CHDIR = 'CD'
Syn.CLEARSCREEN = 'CLS'
Syn.COPYFILE = 'COPY'
Syn.COMMAND = 'CMD'
Syn.DELFILE = 'DEL'
Syn.DELPROGRAM = 'DELP'
Syn.ENVVAR = 'ENV'
Syn.MKDIR = 'MD'
Syn.REMARK = 'REM'
Syn.REPLACEFILE = 'REPFILE'
Syn.REPLACESTRING = 'REPSTR'
Syn.READFILE = 'RF'
Syn.VERBOSE = 'MSGMODE'
Syn.VB = 'MSGMODE'
Syn.WRITEFILE = 'WF'
OneArg. = 0
parse value '1' with OneArg.SAY 1 OneArg.EVAL
NoLook. = 0
parse value '1' with NoLook.REPSTR 1 NoLook.IF
Sep = d2c(255)
do Imp.0PC = 1 to Imp.0Mods.0
trace value Imp.0Trval
PC = Imp.0PC
Line = strip(Imp.0Mods.PC)
do PC = PC + 1 while right(Line, 1) = '+'
LIne = left(Line, length(Line)-1)||strip(Imp.0Mods.PC)
end
Imp.0PC = PC - 1
parse var Line Key Tail
Tail = strip(Tail)
if Key = '' | abbrev(Key, '*') | abbrev(Key, ':')
then iterate
if Imp.0IfScan <> 0
then if wordpos(translate(Key), 'IF ELSE ENDIF') = 0
then iterate
if symbol(Key) = 'BAD'
then call ItlErr 'Illegal keyword' Key'.'
parse upper value value('SYN.'Key) Key with Key .
if \OneArg.Key
then Tail = translate(Tail, Sep, ',')
if \NoLook.Key
then Tail = LookUp(Tail)
Arg. = ''
do I = 1 to 10 while Tail <> ''
parse var Tail Arg.I (Sep) Tail
if \OneArg.Key
then do
Arg.I = strip(Arg.I, 'T')
if abbrev(Arg.I, '..') & right(Arg.I, 2) = '..'
then Arg.I = strip(Arg.I,,'.')
else Arg.I = strip(Arg.I)
end
end
if Tail <> ''
then call ItlErr 'Too many arguments specified.'
NewLine = RunCmd(Key, Arg.1, Arg.2, Arg.3, Arg.4, Arg.5, Arg.6, Arg.7,,
Arg.8, Arg.9, Arg.10)
if left(NewLine, 1) = '!'
then return substr(NewLine, 2)
if NewLine > 0
then Imp.0PC = NewLine
end
if Imp.0IfScan <> 0
then call ItlErr 'ENDIF not found.'
return 0
RunCmd: procedure expose (Globals)
Key = arg(1)
/*
if Imp.0IfScan <> 0
then if wordpos(Key, 'IF ELSE ENDIF') = 0
then return 0
*/
signal on syntax name TagError
trace value Imp.0TrVal
interpret "OutC = ITL!"Key"(arg(2), arg(3), arg(4), arg(5), arg(6), arg(7),",
"arg(8), arg(9), arg(10), arg(11))"
return OutC
TagError:
if rc = 43
then if word(sourceline(sigl), 1) = 'interpret'
then do
Imp.0ErrorMode = 'HALT'
call ItlErr 'Unknown ITL tag:' Key
exit 255
end
call ITLsyntax d2c(0), sigl
exit 255
/** Add INI entry **/
ITL!ADDINI: procedure expose (Globals)
parse arg File, App, Key, Val, ROpt .
File = translate(strip(File))
App = strip(App)
Key = strip(Key)
Val = strip(Val)
ROpt = translate(ROpt)
if (wordpos(File, 'USER SYSTEM') = 0 & pos('\', File) = 0)
then parse value RxSearchPath('DPATH', File) File with File .
/*** PTR 103 start ***/
if (ROpt <> '') & (wordpos(ROpt, 'NEWONLY REPLACEONLY') = 0)
/*** PTR 103 end ***/
then call ITLErr 'Invalid argument' ROpt
if translate(Val) = '$RXDEL'
then ROpt = 'REPLACEONLY'
Exists = (rxOs2Ini(File, App, Key) <> '$RXERROR')
if (ROpt = '' | (ROpt = 'NEWONLY' & \Exists) |,
(ROpt = 'REPLACEONLY' & Exists))
then do
call ITLSay 'Setting' App'/'Key '->' Val 'in' File 'file...'
Res = RxOs2Ini(File, App, Key, Val)
if Res <> ''
then call ITLErr 'Error' Res 'writing to INI file' File'.'
end
return 0
/** Add to local file list **/
ITL!ADDLOCAL: procedure expose (Globals)
parse arg Ini, App, Dir, FileList, Source
parse arg App, Source, Dest, AutoUpdate
XC = AddLocalFiles(Ini, App, Dir, FileList, Source)
if XC <> 0
then call ItlErr 'Error' XC 'from AddLocalFiles.'
return 0
/** Delete a list of local files **/
ITL!DELLOCAL: procedure expose (Globals)
/***** PTR 10017 start *****/
if arg(1) = '' | arg(3) <> ''
/***** PTR 10017 end *****/
then call ItlErr 'Invalid number of arguments.'
XC = DelLocalFiles(arg(1), arg(2))
if XC <> 0
then call ItlErr 'Error' XC 'from DelLocalFiles.'
return 0
/** Create an OS/2 2.0 Object **/
ITL!ADDOBJ: procedure expose (Globals)
parse arg ClassName, Title, Location, Setup, Duplicate, TryDel
if Duplicate = '' /* SysCreateObject bug -- can't be null */
then Duplicate = 'R'
else Duplicate = translate(Duplicate)
TryDel = (TryDel <> '') & \abbrev(Duplicate, 'F')
P = pos('OBJECTID', translate(Setup))
if P > 0
then parse value substr(Setup, P) with '=' ObjId ';'
else ObjId = ''
call ITLSay 'Creating' ClassName 'object "'Title'" in "'Location'".'
call ITLSay '('Duplicate',' Setup')'
if rxOs2ver() < 2.0
then call ITLErr 'AddObject requires OS/2 2.0 or greater.'
XC = SysCreateObject(ClassName, Title, Location, Setup, Duplicate)
/* Test if folder object is viable */
if XC = 1 & ClassName = 'WPFolder' & ObjId <> ''
then do
XC = SysCreateObject('WPAbstract', 'Test', ObjId,,
'OBJECTID=<CORE_TESTOBJ>;', 'R')
call SysDestroyObject '<CORE_TESTOBJ>'
end
if XC <> 1 & TryDel
then do
if ObjId <> ''
then do
call ItlSay 'Object' ObjId 'could not be created. Deleting...'
if SysDestroyObject(ObjId)
then do
call ItlSay 'Retrying creation...'
XC = SysCreateObject(ClassName, Title, Location, Setup, Duplicate)
end
else call ItlSay 'Object could not be deleted.'
end
end
if XC <> 1
then if abbrev(Duplicate, 'F')
then call ItlSay 'Object' Title 'could not be created. May already',
'exist.'
else call ITLErr 'Object' Title 'could not be created.'
return 0
FolderId: procedure expose (Globals)
parse arg FldName, Root
parse source . How Me
Cmd = (How = 'COMMAND')
if pos('\', Me) > 0
then do
MyPath = left(Me, max(3, lastpos('\', Me)-1))
call setlocal
call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
end
FldPath = ''
SynRef = 'QDESKTOP'
if Root = ''
then Root = 'QDESKTOP'()
drop SynRef
if right(Root, 1) <> '\'
then Root = Root'\'
FldName = strip(strip(FldName),,'"')
if Root <> ''
then do
call SysFileTree Root'*', 'DIRS.', 'DSO'
do I = 1 to Dirs.0 while FldPath = ''
if SysGetEA(Dirs.I, '.LONGNAME', 'NAME') = 0
then if substr(Name, 5) == FldName
then FldPath = Dirs.I
end
end
if Cmd
then if FldPath = ''
then say 'The directory for "'FldName'" could not be determined.'
else say 'The "'FldName'" directory is "'FldPath'".'
return FldPath
DesktopId: procedure expose (Globals)
parse upper source . How Me
parse upper arg Opt Extra
Valid = 'SWITCH'
if (Opt <> '' & wordpos(Opt, Valid) = 0) | Extra <> ''
then signal Tell
Cmd = (How = 'COMMAND')
if pos('\', Me) > 0
then do
MyPath = left(Me, max(3, lastpos('\', Me)-1))
call setlocal
call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
end
Desktop = GetPath('<WP_DESKTOP>')
if Desktop = '' /* Second attempt if first fails */
then do
SynRef = 'BOOTDRIVE'
BDr = SysBootDrive()
SynRef = 'QFOLDER'
Desktop = 'QFOLDER'('OS/2 2.0 Desktop', BDr'\')
if Desktop = '' /* Third attempt (for 2.1 systems) if 3rd fails */
then Desktop = 'QFOLDER'('Desktop', BDr'\')
drop SynRef
end
call endlocal
if Cmd
then if Desktop = ''
then say 'The active OS/2 desktop directory could not be located!'
else do
say 'The active OS/2 desktop directory is "'Desktop'".'
if Opt = 'SWITCH'
then call directory Desktop
end
return Desktop
GetPath: procedure
parse arg ObjId
GpiNode = substr(sysIni('USER', 'PM_Workplace:Location', ObjId), 1, 2)
if GetNodes() <> 0
then say 'Warning: Could not locate the node table.'
GP = ''
do GPI = 1 to Nodes.0
if substr(Nodes.GPI, 7, 2) = GpiNode
then do
GP = substr(Nodes.GPI, 33, length(Nodes.GPI)-33) /* Name of desktop */
GPParent = substr(Nodes.GPI, 9, 2)
do until GPParent = '0000'x
do GPL = 1 to Nodes.0
if substr(Nodes.GPL, 7, 2) = GPParent
then do /* Qualified name of desktop */
GP = substr(Nodes.GPL, 33, length(Nodes.GPL)-33)'\'GP
GPParent = substr(Nodes.GPL, 9, 2)
leave GPL
end
end
end
leave GPI
end
end
return GP
GetNodes: procedure expose Nodes.
Handles = sysIni('SYSTEM', 'PM_Workplace:ActiveHandles', 'HandlesAppName')
if abbrev(Handles, 'ERROR:') /* No service pack */
then Handles = 'PM_Workplace:Handles'
Block1 = ''
parse value '0' with 1 Nodes. 1 I 1 L
do I = 1 to 999
Block = sysIni('SYSTEM', Handles, 'BLOCK'I)
if abbrev(Block, 'ERROR:')
then if I = 1
then return 10 /* could not locate NODE table */
else leave
else Block1 = Block1||Block
end I
do until L >= length(Block1)
if substr(Block1, L+5, 4) = 'DRIV'
then do
XL = pos('00'x||'NODE'||'01'x, Block1, L+5) - L
if XL <= 0
then leave
L = L + XL
iterate
end
else if substr(Block1, L+1, 4) = 'DRIV'
then do
XL = pos('00'x||'NODE'||'01'x, Block1, L+1) - L
if XL <= 0
then leave
L = L + XL
iterate
end
else do
Data = substr(Block1, L+1, 32)
XL = c2d(substr(Block1, L+31, 1))
if XL <= 0
then leave
Data = Data||substr(Block1, L+33, XL+1)
L = L + length(Data)
end
I = I + 1
Nodes.I = Data
end
Nodes.0 = I
return 0
/** Add program entry **/
ITL!ADDP: procedure expose (Globals)
parse arg Group, Title, ROpt .
ObjectMode = (rxOs2Ver() >= 2.0)
Conv1.EXE = 'EXENAME'
Conv1.PARAMS = 'PARAMETERS'
Conv1.WORKDIR = 'STARTUPDIR'
Conv1.ICONFILE = 'ICONFILE'
Info.1 = 'TITLE='Title
Info.0 = 1
Setup = 'OBJECTID=<'Title'>;'
Used = 'TITLE'
EndFound = 0
do J = Imp.0PC+1 until (EndFound | J > Imp.0Mods.0)
parse value LookUp(Imp.0Mods.J) with Attr . '=' AttrVal
Attr = translate(Attr)
if abbrev('EADDPROGRAM', Attr, 5)
then do
EndFound = 1
iterate
end
if AttrVal = ''
then call ITLErr 'Null value specified for' Attr 'attribute.'
if wordpos(Attr, Used) <> 0
then call ITLErr 'Duplicate' Attr 'attribute in ADDPROGRAM record.'
else do
Used = Used Attr
select
when \ObjectMode
then call rxStemInsert 'INFO', Info.0 + 1, Attr'='AttrVal
when wordpos(Attr, 'EXE PARAMS WORKDIR ICONFILE') > 0
then Setup = Setup||Conv1.Attr'='AttrVal';'
when wordpos(Attr, 'VISIBILITY XYSIZE') > 0
then nop
when Attr = 'TYPE'
then do
select
when wordpos(AttrVal, 'FULLSCREEN PM') > 0
then nop
when AttrVal = 'VIOWINDOW'
then AttrVal = 'WINDOWABLEVIO'
when AttrVal = 'READ'
then AttrVal = 'VDM'
otherwise AttrVal = ''
end
if AttrVal <> ''
then Setup = Setup||'PROGTYPE='AttrVal';'
end
when Attr = 'XYSTYLE'
then do while AttrVal <> ''
parse var AttrVal Temp . ',' AttrVal
if wordpos(Temp, 'NOAUTOCLOSE MINIMIZED MAXIMIZED') > 0
then Setup = Setup||Temp'=YES;'
end
otherwise call ITLErr 'Illegal ADDPROGRAM attribute' Attr'.'
end
end
end /* do */
if \EndFound
then call ITLErr 'No EADDPROGRAM tag found.'
if wordpos('EXE', Used) = 0
then call ITLErr 'No EXE attribute found in ADDPROGRAM record.'
else do
if ObjectMode
then do
GroupId = FolderId(Group)
if GroupId = ''
then do
call SysCreateObject 'WPFolder', Group, '<WP_DESKTOP>', 'ICONFILE=;'
GroupId = FolderId(Group)
if GroupId = ''
then GroupId = '<WP_DESKTOP>'
end
XC = ITL!AddObj('WPProgram', Title, Groupid, Setup)
end
else do
Exists = (rxQueryProgram('USER', Group, Title, 'TRASH') = 0)
if ROpt = '' | (ROpt = 'REPLACEONLY' & Exists) |,
(ROpt = 'NEWONLY' & \Exists)
then do
call ITLSay 'Adding' Title 'program to' Group 'group...'
call RxDeleteProgram , Group, Title
call RxAddProgram , Group, 'INFO.'
end
end
end
return J
ITL!EADDP: procedure expose (Globals)
call ITLErr 'EADDPROGRAM found outside of ADDPROGRAM record.'
return 0
/*** Ask the user a question ***/
ITL!ASK: procedure expose (Globals)
parse arg Prompt, VarName, Valid, NoConf, Lower
Valid = translate(strip(Valid))
NoConf = (NoConf <> '')
Lower = (Lower <> '')
VarName = strip(VarName)
Key = 'N'
do until (Key = 'Y')
call rxSay Prompt ' '
parse linein Resp
if \Lower
then Resp = translate(Resp)
if Valid = '' | wordpos(Resp, Valid) > 0
then if NoConf
then Key = 'Y'
else do
call rxSay 'You entered "'Resp'" - Is this correct (Y/N)? '
do until pos(Key, 'YN') > 0
parse upper linein Key .
Key = left(Key, 1)
end
end
else do
call beep 200, 150
say 'Valid responses are:' Valid'.'
end
if Key = 'N'
then say
end
call ITLReplaceStringAdd '{'VarName'}', Resp
return 0
/*** Change directory ***/
ITL!CD: procedure expose (Globals)
parse arg NewDir
if rxDirExist(NewDir)
then call directory NewDir
else call ITLErr 'Directory' NewDir 'does not exist.'
return 0
/** Copy file **/
ITL!COPY: procedure expose (Globals)
parse arg Src, Dst, Opt, App, AutoUp, Defer
/**** PTR 10011 start ****/
if Opt <> 'COUCOPY'
then if \rxFileExist(Src)
then call ItlErr 'Source file' Src 'does not exist.'
/**** PTR 10011 end ****/
if Opt = ''
then call ITLSay 'Copying' Src 'to 'Dst'...'
else if Opt = 'COUCOPY'
then call ITLSay 'Copying' Src 'to 'Dst '(COUCOPY:'AutoUp','Defer')...'
else call ITLSay 'Copying' Src 'to 'Dst '('Opt')...'
RetC = CopyFile(Src, Dst, Opt, App, AutoUp, Defer)
if RetC <> 0
then call ITLErr 'Error' RetC 'copying' Src 'to' Dst'.'
return 0
/**********************************************************
* CopyDir src, trg *
* *
* Copies directories, formats screen output. *
* *
* Return: 0 = Successful completion. *
* 2 = Source directory does not exist. *
* 3 = Target directory could not be created. *
* 4 = Certain files or directories could *
* not be copied. *
* 5 = Max number of copy errors encountered *
* and copy was aborted. *
* 6 = Not enough space on target *
**********************************************************/
ITL!COPYDIR: procedure expose (Globals)
parse upper arg src, trg .
/*******************************************************/
/** Check and condition input params. **/
/*******************************************************/
if RxDirExist(src)=0 then do
IMP.0ItlResult = 2; return 0
end
if trg='' then trg='.'
if RxDirExist(trg)=0 then call RxMkDir(trg)
if RxDirExist(trg)=0 then do
IMP.0ItlResult = 3; return 0
end
if right(src,1)<>'\' then src=src'\'
if right(trg,1)<>'\' then trg=trg'\'
/*******************************************************/
/** Setup vars and scan source directory tree. **/
/*******************************************************/
call RxCurPos 4, 0
call RxSay ' Scanning source directory tree...'
call RxTree src'*.*', 'source.', 'SB'
call RxStemSort 'source.', , 38
call RxSay 'done'
off = length(src)+38
RetC = 0
Errors = 0;
j=1
/*************************************/
/* Determine number of bytes to copy */
/*************************************/
BytesCopied=0
BytesToBeCopied=0
do i=1 to source.0
parse var source.i . . size .
BytesToBeCopied = BytesToBeCopied + size
end
/********************************************/
/* Make sure there is enough room on target */
/********************************************/
if substr(trg, 2, 1)=':' then
trgdrv = left(trg, 2)
else
trgdrv=left(directory(),2)
parse upper value rxDriveInfo(trgdrv) with 'LABEL=' DLabel 'FREE='free .
if BytesToBeCopied>free then do
say 'Error - Not enough room to copy files.'
IMP.0ItlResult = 6; return 0
end
call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
call RxCurState 'OFF'
/*******************************************************/
/** Process all source entries. **/
/*******************************************************/
do i=1 to source.0
/************************************************/
/** Clear screen after every 13 files copied. **/
/** (Avoids scrolling). **/
/************************************************/
if j=14 then do
do j=0 to 13
call RxCurPos 4+j, 0
call RxSay copies(' ', 80)
end
j=0
end
/***********************************************/
/** Reset screen pos and get cur file spec. **/
/***********************************************/
call RxCurPos 4+j, 0
file = substr(source.i, off) /* Get file spec */
/************************************************/
/** Check if its a directory and create it if **/
/** needed. **/
/************************************************/
if substr(source.i, 32, 1)='D' then do
if RxDirExist(trg||file)=0 then do
call RxSay ' Creating directory 'trg||file'...'
myRc = RxMkDir(trg||file)
if myRc<>0 then do
say d2c(7)'rc='myRC
RetC = 4
end
else
say 'ok'
j=j+1
end
end
/************************************************/
/** If not a directory, then it is a file, thus**/
/** copy it. **/
/************************************************/
else do
call RxSay ' Copying 'trg||file'...'
'COPY 'src||file' 'trg||file'>nul 2>&1'
if RC<>0 then do
if RxFileExist(trg||file)=1 then
call RxTree trg||file, 'stem.', 'F', '*****', '-*---'
'COPY 'src||file' 'trg||file'>nul 2>&1'
end
if RC<>0 then do
say d2c(7)'rc='RC
RetC = 4
Errors= Errors+1
end
else do
say 'ok'
BytesCopied = BytesCopied + word(source.i, 3)
end
j=j+1
end
/************************************************/
/** Update status bar after every file **/
/************************************************/
call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
/************************************************/
/** Check Errors **/
/************************************************/
if Errors=10 then do
call RxSay ' Maximum file copy errors reached. Aborting...'
call RxSleep 2
IMP.0ItlResult = 5; return 0
end
end
call RxCurState 'ON'
if (rc=0) then BytesCopied = BytesToBeCopied
call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
IMP.0ItlResult = RetC
return 0
/**********************************************************
* !StatusBar *
* *
* Purpose: *
* Used by DirCopy() to draw a status bar. *
**********************************************************/
!StatusBar: procedure expose (Globals)
parse arg row, col, len, size, total .
Meg = '1024000'
inc = trunc(total/(len-2), 2) /* Get increment */
if size=0 then size=1 /* Do not allow / by 0 */
num = trunc(size/inc) /* Get number of increments */
if num>len-2 then num=len-2 /* Check for overflow */
call RxCurPos row, col
call RxSay d2c(192)||copies(d2c(196), len-2)||d2c(217)
call RxCurPos row-1, col
call RxSay d2c(179)||copies(d2c(219), num)||copies(' ', len-2-num)||d2c(179)
call RxCurPos row-2, col
call RxSay d2c(218)||copies(d2c(196), len-2)||d2c(191)
call RxCurPos row-3, col
call RxSay 'Progress:'||right('Copied 'trunc(size/Meg,2)' of',
trunc(total/Meg,2)' Megabytes', 61)
return
/** Clear the screen **/
ITL!CLS: procedure expose (Globals)
'@CLS' /* Safer than RxCls which doesn't support ANSI */
return 0
/** Add any command or statement **/
ITL!CMD: procedure expose (Globals)
parse arg Cmd, Pos String, RemStr, Control
RemStr = strip(RemStr)
if FileType('REXX') & pos(left(Cmd, 1), '"'||"'") = 0
then Cmd = "'"Cmd"'"
call ITLSay 'Inserting command:' Cmd'...'
if FileType('CONFIG') | FileType('IBMLAN') | FileType('PROTOCOL')
then call InsUnique Cmd, Pos String, 'PREFIX', Control
else call InsUnique Cmd, Pos String, 'COMPRESS', Control
if RemStr <> ''
then call RemAll RemStr, 'ALL+', ,CurLn()
return 0
/** Change path statment **/
ITL!CP: procedure expose (Globals)
parse arg Path . , Dir, Ctrl, Force
Force = (translate(Force) = 'FORCE')
if Ctrl = ''
then Ctrl = 'BEGIN'
else Ctrl = translate(Ctrl)
if wordpos(word(Ctrl,1), 'BEGIN END DELETE BEFORE AFTER') = 0
then call ITLErr 'Invalid argument' Ctrl
Dir = strip(Dir, 'T', ';')
Where = Imp.0CurL + 1
if Force & Ctrl <> 'DELETE'
then call ITL!CP Path, Dir, 'DELETE'
if Ctrl = 'DELETE'
then do
call ITLSay 'Deleting' Dir 'from' Path'...'
call DelPath Path, Dir
end
else do
if length(Dir) > 3
then Dir = strip(Dir, 'T', '\')
call ITLSay 'Inserting' Dir 'into' Path'...'
call InsPath Path, Dir, Ctrl, 'CREATE' Where, 'GOTO'
end
return 0
/*** Delete a file ***/
ITL!DEL: procedure expose (Globals)
if abbrev(space(translate(arg(1)),0), 'DIR=')
then do
parse arg '=' Dir
if right(Dir, 1) <> '\'
then Dir = Dir'\'
Start = 2
end
else do
Dir = ''
Start = 1
end
do I = Start while arg(I) <> ''
File = Dir||arg(I)
/*** PTR 102 start */
call rxTree File, 'TEMP.', 'F', , '-----'
if Temp.0 > 0
then do I = 1 to Temp.0
Temp.I = subword(Temp.I, 5)
/*** PTR 102 end ***/
call ITLSay 'Deleting file' Temp.I'...'
rc = rxDelete(Temp.I)
if rc <> 0
then call ItlErr 'Error' rc 'deleting' Temp.I'.'
end
else call ITLSay 'File to be deleted ('File') does not exist.'
end
return 0
/** Delete a program entry **/
ITL!DELP: procedure expose (Globals)
parse arg Group, Title
if Title = '' & pos('\', Group) > 0
then parse var Group Group '\' Title
if Group = '' | Title = ''
then call ITLErr 'DELP: Required argument missing.'
call ITLSay 'Deleting program entry' Group'/'Title'.'
rc = rxDeleteProgram('USER', Group, Title)
if rc <> 0 & rc <> 4
then call ItlSay 'Error' rc 'deleting' Group'/'Program
return 0
/** Add any environment variable statement **/
ITL!ENV: procedure expose (Globals)
parse arg Env . , Val, Pos STarget
Val = strip(Val)
STarget = strip(STarget)
Pos = translate(Pos)
if Pos = 'REMOVE' | Pos = 'DELETE'
then do
call ITLSay 'Removing SET' Env'...'
call RemAll 'SET' Env'='
end
else do
call ITLSay 'Adding SET' Env'='Val'...'
call InsUnique 'SET' Env'='Val, Pos STarget, 'PREFIX'
end
return 0
/** Set ERRORMODE **/
ITL!ERRORMODE: procedure expose (Globals)
parse upper arg EMode EArg .
if wordpos(EMode, 'CONTINUE HALT QUIET RESULT NULLENV') = 0 |,
(EArg <> '' & wordpos(EArg, '0 1') = 0)
then call ITLErr 'Invalid ERRORMODE:' EMode EArg
else select
when EMode = 'NULLENV'
then Imp.0NullEnv = (EArg = 1)
otherwise do
Imp.0ErrorMode = EMode
if EMode = 'RESULT'
then Imp.0Error = ''
end
end
return 0
/** Set MSGMODE **/
ITL!MSGMODE: procedure expose (Globals)
parse upper arg Opt ., Log
Log = strip(Log)
if Opt <> ''
then if wordpos(Opt, 'ON OFF') <> 0
then do
call ITLSay 'Turning message mode' Opt'...'
Imp.0Verbose = (Opt = 'ON')
end
else call ITLErr 'Invalid MSGMODE setting' Opt'.'
if Log <> ''
then do
call ITLSay 'Setting log file to "'Log'"...'
Imp.0ITLLog = Log
call ITLSay copies('-', 70)
end
return 0
/** Evaluate an arbitrary expression **/
ITL!EVAL: procedure expose (Globals)
parse arg Expr
call ITLSay 'Executing' Expr'...'
if left(Expr, 1) = "'" & right(Expr, 1) = "'"
then do
strip(Expr, 'B', "'") /* Strip quotes and pass to OS/2 */
Imp.0ItlResult = rc
end
else do
Forbidden = 'EXIT ITERATE LEAVE PROCEDURE RETURN SIGNAL'
/*
Keywords = 'ADDRESS ARG CALL DO DROP IF INTERPRET NOP NUMERIC OPTIONS',
'PARSE PULL PUSH QUEUE SAY SELECT TRACE'
*/
W1 = translate(word(Expr, 1))
if wordpos(W1, Forbidden) > 0
then call ItlErr 'Illegal keyword' W1 'to EVAL.'
else do
if pos('(', W1) > 0
then do
parse upper var W1 W1 '('
if verify(W1, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!?_') = 0
then Expr = 'result =' Expr
end
signal off novalue
signal off error
signal on syntax name syntax
interpret Expr
if symbol('RC') = 'VAR'
then call ItlSay 'Error' rc 'evaluating' Expr
signal on novalue
signal on error
if symbol('RESULT') = 'LIT'
then Imp.0ItlResult = ''
else Imp.0ItlResult = result
end
end
call ITLSay '... "'Imp.0ItlResult'"'
return 0
/**
ITL!EVAL: procedure expose (Globals)
parse arg Expr
call ITLSay 'Executing' Expr'...'
if left(Expr, 1) = "'" & right(Expr, 1) = "'"
then do
strip(Expr, 'B', "'") /* Strip quotes and pass to OS/2 */
Temp = rc
end
else interpret "Temp =" Expr
Imp.0ItlResult = Temp
call ITLSay '...' Temp
return 0
**/
/** Exit **/
ITL!EXIT: procedure expose (Globals)
parse value arg(1) '0' with OutC .
call ITLSay 'Exiting - rc('OutC')'
return '!'OutC
/** FIND **/
ITL!FIND: procedure expose (Globals)
parse upper arg Target, SMode ., MMode .
call ITLSay 'Searching for' Target'...'
Imp.0ItlResult = Find(Target, SMode, MMode)
return 0
/** Goto **/
ITL!GOTO: procedure expose (Globals)
parse upper arg Label .
if Label = ''
then call ITLErr 'Null label passed to GOTO.'
if Left(Label, 1) <> ':'
then Label = ':'Label
call ITLSay 'Branching to' Label'...'
call rxStemGrep Label, 'IMP.0MODS.', 'TEMP.', 'N'
do J = 1 to Temp.0
if translate(word(Temp.J, 2)) = Label
then return word(Temp.J, 1)
end
call ItlErr 'Label' Label 'not found.'
return 0
/** IF **/
ITL!IF: procedure expose (Globals)
parse upper arg Expr
IfNum = Imp.0IfStack.0 + 1
Imp.0IfStack.0 = IfNum
if Imp.0IfScan <> 0
then return 0
Temp = 'IF ('Expr')'
Expr = LookUp(Expr)
Temp = Temp '('Expr')'
interpret "Bool = ("Expr")"
call ITLSay copies(' ', (IfNum-1) * 2)Temp '::' Bool'...'
if wordpos(Bool, '0 1') = 0
then call ITLErr 'Result ('Bool') not boolean.'
Imp.0IfStack.IfNum = Bool
if \Bool
then Imp.0IfScan = IfNum
return 0
ITL!ENDIF: procedure expose (Globals)
IfNum = Imp.0IfStack.0
if IfNum < 1
then call ITLErr 'ENDIF encountered outside IF.'
else do
Imp.0IfStack.0 = IfNum - 1
if Imp.0IfScan <> 0
then if Imp.0IfScan = IfNum
then Imp.0IfScan = 0
if Imp.0IfScan = 0
then call ItlSay copies(' ', (IfNum-1) * 2)'...ENDIF'
return 0
ITL!ELSE: procedure expose (Globals)
IfNum = Imp.0IfStack.0
if IfNum < 1
then call ItlErr 'ELSE encounted outside IF.'
else do
call ItlSay copies(' ', (IfNum-1) * 2)'...ELSE...'
If Imp.0IfScan <> 0
then if Imp.0IfScan = IfNum
then Imp.0IfScan = 0
else nop
else Imp.0IfScan = IfNum
end
return 0
/** Make a directory **/
ITL!MD: procedure expose (Globals)
parse arg Dir /* May contain embedded blanks */
Dir = strip(Dir)
call ITLSay 'Making directory 'Dir'...'
I = lastpos('"', Dir)
do while I > 0
Dir = delstr(Dir, I, 1)
I = lastpos('"', Dir)
end
I = pos('\', Dir)
do while I <> 0
call ITL!!MD2(left(Dir, I-1))
I = pos('\', Dir, I+1)
end
call ITL!!MD2 Dir
return 0
ITL!!MD2: procedure expose (Globals)
parse arg Dir
if \(length(Dir) = '2' & right(Dir, 1) = ':') & \rxDirExist(Dir)
then do
rc = rxMkDir(Dir)
if rc <> 0
then call ITLErr 'Error' rc 'creating' Dir'.'
end
return 0
/** Check numerical parameter **/
ITL!NUMCHK: procedure expose (Globals)
parse arg NParm Bit . , Min . , Max . , Set .
BitMode = (Bit <> '')
NParm = translate(NParm)
if BitMode
then Desc = NParm 'bit' Bit
else Desc = NParm
call ITLSay 'Checking numerical parameter' Desc '('Min','Max'):'Set'...'
Found = 0
Done = 0
if Find(NParm, 'ALL+', 'BEGIN') = 0
then do until Found | Done
OldLine = GetLine()
parse upper var OldLine TestParm . '=' OrigVal .
Found = (TestParm = NParm)
if \Found
then Done = (FindNext() <> 0)
end
If Found
then if Bit <> ''
then do
TestVal = substr(OrigVal, Bit+1, 1)
if TestVal = ''
then do
call ItlSay '...bit' Bit 'does not exist.'
TestVal = -999999
end
end
else TestVal = OrigVal
if Found
then do
parse value Set Max Min with Set .
parse value Min TestVal with Min .
parse value Max TestVal with Max .
if (TestVal < Min) | (TestVal > Max)
then do
call RemLine
call ITLSay '...'Desc '=' TestVal '- changed to' Set'.'
if Bit <> ''
then Set = overlay(Set, OrigVal, Bit+1)
call InsLine ChangeStr(OldLine, OrigVal, Set)
end
else call ITLSay '...'Desc '=' TestVal '- okay.'
end
else if Bit = '' & Set <> ''
then do
call ITLSay NParm 'not found in file -- adding.'
call ITL!CMD NParm'='Set
end
else call ITLErr NParm 'not found in file.'
return 0
ITL!OPTIONS: procedure expose (Globals)
parse upper arg Opt OptVal
select
when Opt = 'EXITPAUSE'
then if wordpos(OptVal, 'YES NO') = 0
then call ILTErr 'Invalid option value:' Opt
else Imp.0ErrPause = (OptVal = 'YES')
otherwise call ITLErr 'Invalid option:' Opt
end
return 0
/** Add a remark statement **/
ITL!REM: procedure expose (Globals)
parse arg New, Pos Target, Blank .
parse upper value Pos 'AFTER' with Pos .
New = RemLine(New)
call ITLSay 'Inserting remark:' New'...'
call InsUnique New, Pos Target, 'COMPRESS'
if translate(Blank) = 'BLANK'
then call InsBlank 'BEFORE'
return 0
/** Remark all strings **/
ITL!REMALL: procedure expose (Globals)
parse arg String, Del
Del = (translate(Del) = 'DELETE')
if Del
then do
call ITLSay 'Deleting all lines containing "'String'"...'
More = (Find(String, 'ALL+') = 0)
do while More
call DelLine 'BACKUP'
More = (FindNext() = 0)
end
end
else do
call ITLSay 'Remarking all lines containing "'String'"...'
call RemAll String, 'ALL+'
end
return 0
/** Replace a file (if needed) **/
ITL!REPFILE: procedure expose (Globals)
parse arg Src, Dst, Opts
Src = strip(Src)
Dst = strip(Dst)
if Src = '' | Dst = ''
then call ITLErr 'Source and target must be specified.'
/**
if pos('?', Src Dst) + pos('*', Src Dst) > 0
then call ITLErr 'Wildcard characters are not supported by REPFILE.'
**/
call ITLSay 'Replacing' Src 'to' Dst'...'
RetC = ReplaceFile(Src, Dst, Opts)
if RetC <> 0
then call ITLErr 'Error' RetC 'replacing' Src 'to' Dst'.'
return 0
/** Turn on/off string replacement **/
ITL!REPSTR: procedure expose (Globals)
parse arg Opt, Str2
Opt = translate(strip(Opt))
if Str2 = ''
then if wordpos(Opt, 'ON OFF') <> 0
then do
call ITLSay 'Turning string replacement' Opt'...'
Imp.0StrRep = (Opt = 'ON')
end
else call ITLErr 'Invalid REPSTR argument' Opt'.'
else do
Str2 = LookUp(strip(Str2))
if Opt = ''
then call ITLErr 'First REPSTR argument resolved to null.'
else if Opt = Str2
then call ITLErr 'REPSTR source and target are the same.'
else do
call ITLSay 'Replace String ['Opt'|'Str2']'
call ITLReplaceStringAdd Opt, Str2
end
end
return 0
/** Read a file **/
ITL!RF: procedure expose (Globals)
parse arg File
call ITLSay 'Reading 'file'...'
call ReadFile File
call SetComment 'DESC', '('Imp.0ITLMe date()')'
return 0
/* Display information for the edification of the user */
ITL!SAY: procedure expose (Globals)
call ITLSay arg(1), 'FORCE'
return 0
/** Sleep a specified number of seconds **/
ITL!SLEEP: procedure expose (Globals)
parse arg Secs .
call RxSleep Secs
return 0
/** Synchronization services **/
ITL!SYNCH: procedure expose (Globals)
parse arg Point .
if verify(Point, '0123456789') = 0
then call ItlSay '***** Synch point' Point 'encountered.'
return 0
/** Write file **/
ITL!WF: procedure expose (Globals)
if FileChanged()
then do
parse arg Backdir, BackType
call ITLSay 'Writing file ('BackDir BackType')...'
if Imp.0Verbose
then call WriteFile BackDir, BackType, 'VERBOSE'
else call WriteFile BackDir, BackType
end
else call ITLSay 'File not changed - no write performed.'
return 0
ITL!TRACE: procedure expose (Globals)
parse arg Imp.0TrVal .
return 0
ITL!COREINSTDIRCHECK: procedure expose (Globals)
parse upper arg Drive ., Dir ., Label ., MsgOffset .
if Drive = '' | Dir = '' | Label = '' | MsgOffset = ''
then call ITLErr 'Bad DIRCHECK arguments.'
call ItlSay 'Checking for' Label '('Dir','MsgOffset') in drive' Drive'...'
Label = strip(strip(Label),,'"')
App = 'CREQINST'
Msg = 560 + MsgOffset
Imp.!ItlZipDir = Dir
do while \rxDirExist(Imp.!ItlZipDir)
call rxOS2Ini 'USER', App, 'CMD', 'DISK|'Drive'|'Label'|'Msg
say '[*CMD*]'
do until Done
call rxsleep 1
Done = (IniGet('USER', App, 'CMD') = '')
end
end
return 0
ITL!COREINSTUNZIP: procedure expose (Globals)
parse upper arg ZipFile, TargetDir, FileList, ZipArgs, TempDir
if ZipFile = '' | TargetDir = '' | FileList = ''
then call ITLErr 'Bad UNZIP arguments.'
ZipArgs = arg(4) /* Get mixed case copy */
if TempDir <> ''
then if \rxDirExist(TempDir)
then do
call ItlErr 'Temp directory' TempDir 'does not exist.'
return 0
end
if \rxFileExist(ZipFile)
then if rxFileExist(Imp.!ItlZipDir'\'ZipFile)
then ZipFile = Imp.!ItlZipDir'\'ZipFile
else do
call ItlErr 'File' ZipFile 'does not exist.'
return 0
end
if TempDir <> ''
then do /* Unpack to staged copy via COUCOPY */
call ItlSay 'Unzipping' ZipFile '('FileList') to' TargetDir 'via',
TempDir '('ZipArgs')...'
Res = Itl!!RunCmd('PKUNZIP2' ZipArgs ZipFile TempDir FileList)
/**** PTR 107 start ****/
call ITL!CoreInstUnzipErrCheck Res
/**** PTR 107 end ****/
TempDir = strip(TempDir, 'T', '\')
do while FileList <> ''
parse var FileList File FileList
if abbrev(File, '"')
then do
parse var FileList FileRest '"' FileList
File = File||FileRest
end
/**** PTR 10215 start ****/
FileName = filespec('NAME', File)
File = TempDir'\'FileName
Res = rxCouCopy(File, TargetDir'\'FileName)
/**** PTR 10215 end *****/
if abbrev(Res, 'ERROR:')
then call ItlErr 'Error' Res 'from COUCOPY.'
call rxDelete File
end
end
else do /* Direct unpack */
call ItlSay 'Unzipping' ZipFile '('FileList') to' TargetDir,
'('ZipArgs')...'
Res = Itl!!RunCmd('PKUNZIP2' ZipArgs ZipFile TargetDir FileList)
/**** PTR 107 start ****/
call ITL!CoreInstUnzipErrCheck Res
/**** PTR 107 end ****/
end
return 0
/**** PTR 107 start ****/
ITL!COREINSTUNZIPERRCHECK: procedure expose(Globals)
parse arg Res
If Res = ''
then call ItlErr 'Output from PKUNZIP2 vanished!'
else do
ErrSum = ''
E11 = 0
W10 = 0
Temp = Res
do while Temp <> ''
parse var Temp '(E' ECode ')' Temp
if ECode <> '' & verify(ECode, '0123456789') = 0
then if ECode = 11
then E11 = 1
else ErrSum = ErrSum 'E'ECode
end
Temp = Res
do while Temp <> ''
parse var Temp '(W' WCode ')' Temp
if WCode <> '' & verify(WCode, '0123456789') = 0
then if WCode = 10
then W10 = 1
else ErrSum = ErrSum 'W'WCode
end
if ErrSum <> ''
then call ItlErr 'An error occurred unpacking files ('strip(ErrSum)')'
else if E11
then if W10
then call ITL!CoreInstMsgBox 'Install Warning', 'Some files could',
'not be unpacked because the target files are in use.'
else call ItlErr 'Expected file(s) were not found.'
end
return
/**** PTR 107 end ****/
ITL!COREINSTCREATEALIAS: procedure expose (Globals)
parse arg Server, AliasName, PhysPath, Comment, WhenShare, NoRetry
NoRetry = (NoRetry = 1)
if Server = '' | AliasName = '' | PhysPath = '' | Comment = ''
then call ITLErr 'Bad CreateAlias arguments.'
if WhenShare = ''
then WhenShare = 'STARTUP'
call ItlSay 'Creating \\'Server'\'AliasName '=' PhysPath '('Comment')...'
PreQ = queued()
call Itl!!RunCmd 'NET ALIAS' AliasName '/DELETE'
Res = Itl!!RunCmd('NET ALIAS' AliasName '\\'Server PhysPath '/W:'WhenShare,
'/R:"'Comment'" /UN')
/**** PTR 10241 start ****/
if pos('SYS0005', Res) > 0
then call ItlErr 'Access denied modifying access control. The',
'userid and password being may not have administrator',
'authority on the domain controller.'
/**** PTR 10241 end ****/
if pos('NET2788', Res) > 0
then do
call ItlSay 'An alias for' PhysPath 'already exists. Locating...'
OldALias = ''
PreQ = queued()
Aliases = ''
'NET ALIAS 2>NUL | RXQUEUE /LIFO'
do while queued() > PreQ
pull Name Type .
if Type = 'FILES'
then Aliases = Aliases Name
end
do while Aliases <> '' & OldAlias = ''
parse var Aliases Name Aliases
'NET ALIAS' Name '2>NUL | RXQUEUE /LIFO'
I. = ''
do while queued() > PreQ
pull Tag ':' I.Tag
end
if I.PATH = PhysPath
then OldAlias = I.ALIAS
end
if OldAlias = ''
then call ItlErr 'An alias for' PhysPath 'already exists, but could',
'not be identified.'
else if NoRetry
then call ItlErr 'Alias' OldAlias 'already exists for' PhysPath',',
'but could not be removed.'
else do
call Itl!!RunCmd 'NET ALIAS' OldAlias '/DELETE'
call ITL!COREINSTCREATEALIAS Server, AliasName, PhysPath, Comment,,
WhenShare, 1
end
end
return 0
ITL!COREINSTCREATEACP: procedure expose (Globals)
parse upper arg PhysPaths, Names, Permissions
if PhysPaths = '' | Names = '' | Permissions = ''
then call ItlErr 'Bad CreateACP arguments.'
call ItlSay 'Giving' Permissions 'access to' PhysPaths 'for' Names'...'
do I = 1 to words(PhysPaths)
PhysPath = word(PhysPaths, I)
if pos(':', PhysPath) = 0
then do
Temp = left(PhysPath, 1)':'
do J = 2 to length(PhysPath)
Temp = Temp substr(PhysPath, J, 1)':'
end
return (ITL!COREINSTCREATEACP(Temp, Names, Permissions))
end
else do
if length(PhysPath) = 1
then PhysPath = PhysPath':'
do J = 1 to words(Names)
Name = word(Names, J)
/**** PTR 10241 start ****/
Res = Itl!!RunCmd('NET ACCESS' PhysPath '/ADD' Name':'Permissions)
if pos('SYS0005', Res) > 0
then call ItlErr 'Access denied modifying access control. The',
'userid and password being may not have administrator',
'authority on the domain controller.'
if pos('NET3502', Res) > 0
then call ItlErr 'Unexpected OS/2 error modifying access control.'
if pos('NET2225', Res) > 0
then if pos('NET3739', Itl!!RunCmd('NET ACCESS' PhysPath '/GRANT',
Name':'Permissions)) > 0
then call Itl!!RunCmd 'NET ACCESS' PhysPath '/CHANGE',
Name':'Permissions
/**** PTR 10241 end ****/
end J
end
end I
return 0
ITL!COREINSTDELETEACP: procedure expose (Globals)
parse upper arg PhysPath, DelTree
if PhysPath = ''
then call ItlErr 'Bad DeleteACP arguments.'
DelTree = (DelTree = 'TREE')
if DelTree
then call ItlSay 'Deleting ACP for' PhysPath 'and subtree...'
else call ItlSay 'Deleting ACP for' PhysPath'...'
Res = Itl!!RunCmd('NET ACCESS' PhysPath '/DELETE')
/**** PTR 10241 start ****/
if pos('SYS0005', Res) > 0
then call ItlErr 'Access denied modifying access control. The',
'userid and password being may not have administrator',
'authority on the domain controller.'
/**** PTR 10241 end ****/
if DelTree
then do
PreQ = queued()
'NET ACCESS' PhysPath '/TREE 2>&1 | RXQUEUE /FIFO'
do while queued() > PreQ
pull Line '('
if abbrev(Line, PhysPath)
then call Itl!!RunCmd 'NET ACCESS' strip(Line) '/DELETE'
end
end
return 0
ITL!COREINSTMSGBOX: procedure expose (Globals)
parse arg Title, Msg
App = 'CREQINST'
NoInt = value('COU.NOINT',,'OS2ENVIRONMENT') <> ''
VState = Imp.0Verbose
Imp.0Verbose = \(NoInt)
call ItlSay '[' Title ']'
call ItlSay Msg
Imp.0Verbose = VState
if \NoInt
then do
call rxOS2Ini 'USER', App, 'CMD', 'MSGBOX|INFO|'Title'|'Msg||d2c(0)
say '[*CMD*]'
do until Done
call rxsleep 1
Done = (IniGet('USER', App, 'CMD') = '')
end
end
return 0
ITL!!RUNCMD: procedure expose (Globals)
parse arg Cmd
call ItlSay 'Executing "'Cmd'"...'
PreQ = queued()
Res = ''
Cmd '2>&1 | RXQUEUE /FIFO'
if queued() > PreQ
then do
do PreQ /* Shuffle previously queued lines to bottom */
parse pull Line
queue Line
end
do while queued() > PreQ
parse pull Line
Res = Res||Line||'0'x
call ItlSay '>' Line
end
end
call ItlSay '> RC('rc')'
return Res
/*****************************************************************************
* LookUp *
*****************************************************************************/
LookUp: procedure expose (Globals)
/* trace value imp.0trval */
parse arg Str
TStr = translate(Str)
if Imp.0StrRep & verify(TStr, Imp.0RepStart, 'MATCH') <> 0
then do I = 1 to Imp.0Org.0
if pos(Imp.0Org.I, translate(Str)) <> 0
then do
Temp = Imp.0Org.I
Str = ChangeStr(Str, Imp.0Org.I, value('IMP.0REP.TEMP'), 'ALL', 'LEFT')
end
end
FuncList = 'VAL ENV RESULT INIVAL GETLINE COUINFO'
ScanStart = 1
AmpPos = pos('&', Str)
do while AmpPos <> 0
P1 = left(Str, AmpPos - 1)
P2 = substr(Str, AmpPos + 1)
parse upper var P2 Func '('
if Func = '' | left(Func, 1) = ' ' | right(Func, 1) = ' ' |,
wordpos(Func, FuncList) = 0
then do
ScanStart = AmpPos + 1
AmpPos = pos('&', Str, ScanStart)
iterate
end
if pos(')', P2) = 0
then call ITLErr 'Closing parenthesis not found.'
parse var P2 '(' FuncArg ')' P2
select
when Func = 'VAL'
then do
FuncArg = translate(FuncArg)
if symbol('IMP.0REP.FUNCARG') = 'VAR'
then FuncArg = Imp.0Rep.FuncArg
else call ITLErr 'VAL:' FuncArg 'has not been defined.'
end
when Func = 'ENV'
then do
if pos('<', FuncArg) = 0
then NullEnv = Imp.0NullEnv
else parse var FuncArg FuncArg '<' NullEnv '>'
FuncRes = value(FuncArg,,'OS2ENVIRONMENT')
if FuncRes = ''
then if NullEnv
then call ITLSay "ENV: Variable" FuncArg "resolved to ''."
else do
call ITLErr 'ENV: Variable' FuncArg 'not defined.'
FuncRes = FuncArg
end
FuncArg = FuncRes
end
when Func = 'RESULT'
then if translate(FuncArg) = 'ERROR'
then FuncArg = Imp.0Error
else FuncArg = Imp.0ItlResult
when Func = 'GETLINE'
then FuncArg = GetLine(FuncArg)
when Func = 'INIVAL'
then do
parse var FuncArg File '/' App '/' Key
FuncArg = strip(rxOs2Ini(File, App, Key),,d2c(0))
if abbrev(FuncArg, '$RXERROR')
then FuncArg = ''
end
when Func = 'COUINFO'
then FuncArg = GetCouInfo(FuncArg)
otherwise call ITLErr 'Unknown ITL function:' Func'.'
end
Str = P1||FuncArg||P2
AmpPos = pos('&', Str, ScanStart)
end
return Str
GetCouInfo: procedure expose (Globals)
signal on syntax name GetCouInfo2
Res = rxCouInfo('GET', arg(1))
return Res
GetCouInfo2:
call ItlErr 'Bad COUINFO parameter "'arg(1)'".'
return ''
/*****************************************************************************
* ITLSAY msg *
*****************************************************************************/
ITLSay: procedure expose (Globals)
parse arg Msg.1, Force
Msg.1 = translate(Msg.1, ' ', '0'x)
if Imp.0Verbose | (Force = 'FORCE')
then say Msg.1
if Imp.0ITLLog <> ''
then do
Msg.0 = 1
Msg.1 = Imp.0PC':'Msg.1
RetC = rxWrite(Imp.0ITLLog, 'MSG.',,,'A')
if RetC <> 0
then call ITLErr 'Error' RetC 'writing to' Imp.0ITLLog'.'
end
return 0
/*****************************************************************************
* ITLERR emsg *
*****************************************************************************/
ITLErr: procedure expose (Globals)
parse arg Msg.1
signal off novalue
Msg = Msg.1
Msg.1 = '(line' Imp.0PC')' Msg.1
if Imp.0ITLLog <> ''
then do
Msg.0 = 1
RetC = rxWrite(Imp.0ITLLog, 'MSG.',,,'A')
if RetC <> 0
then say 'Error' RetC 'writing to' Imp.0ITLLog' - Logging disabled.'
end
if Imp.0ErrorMode <> 'QUIET'
then say Msg.1
if Imp.0ErrorMode = 'RESULT'
then Imp.0Error = Msg
if Imp.0ErrorMode = 'HALT'
then call ImpError ''
return 0
/*****************************************************************************
* ERROR HANDLERS *
*****************************************************************************/
Halt:
Where = SigL
/**
call off halt
if abbrev(stream('STDIN:', 'C', 'CLOSE'), 'READY')
then Response = AskUser('Halt detected. Do you want to abort?',,
'NO YES', 1, 0)
else do
Response = 'NO'
say 'Could not close stdin. Unconditional abort.'
end
if Response = 'NO'
then call on halt
else do
**/
say 'Execution halted by user at line' Where'.'
exit 255
/**
end
**/
return
ITLSyntax:
Syntax:
signal off error; signal off failure; signal off halt
signal off novalue; signal off notready; signal off syntax
if arg(1) = d2c(0)
then Where = arg(2)
else Where = SigL
/**
call BugInit
**/
select
when Syntax.Ref = 'NOCOUENV'
then Msg999 = '>> COUENV.DLL not found.'
otherwise
Msg999 = '>> Syntax error' rc '('errortext(rc)') raised in line' Where
end
signal DebugExit
Novalue:
Where = SigL
signal off error; signal off failure; signal off halt
signal off novalue; signal off notready; signal off syntax
Msg999 = '>> Novalue error' condition('D') 'raised in line' Where
signal DebugExit
DebugExit:
if Imp.!ItlActive = 1
then do
Imp.0ErrorMode = 'CONTINUE'
call ItlErr Msg999
end
else say Msg999
Line = sourceline(Where)
say 'Line reads: "'Line'"'
if wordpos('EXPR', translate(Line)) > 0
then say 'Expr =' Expr
say
say 'Please notify the developers! Press <Enter> to exit.'
if translate(linein('STDIN:')) = '/D'
then do
trace ?i
nop
end
exit 255
/*
* Change History:
* (Previous history in \COREUTIL\IMPIT.HST)
* 30 Sep 91 - 2.20 - Remove CMD file tokenization
* - bug fix - multiple ITL files mangled string lookup table.
* - bug fix - standalone & in boolean seen as function start.
* 15 Oct 91 - 2.21 - bug: ITL CMD not inserting unique lines.
* - SAY not being added to log file.
* - bug: DELFILE syntax error
* - change default setting for 0NullEnv to 1.
* - Force INSLINE value to be inside file range.
* - SOURCE.DIR not correct path to ITL file.
* 16 Oct 91 - 2.22 - Add &INIVAL() function.
* - Add support for wild cards to REPLACEFILE.
* - bug: force INSLINE value to be at least 1.
* - bug: adding line at EOF added it at line EOF-1.
* - changed EVAL to handle calls which don't return a value.
* - Give better error message for no closing parenthesis.
* - Pause before exiting on ITL errors.
* 13 Nov 91 - 2.23 - Add OPTIONS EXITPAUSE.
* 2 Jan 92 - Fix COMPUTERNAME for OS/2 2.0.
* 27 Jan 92 - 2.24 - Add {BOOT.DRIVE} replace string.
* 3 Feb 92 - 2.25 - Correct BOOT.DRIVE for down-level systems.
* 3 Mar 92 - 2.26 - bug: FINDIT could die if lines were deleted in FindNext loop.
* 6 Mar 92 - 2.27 - bug: REPFILE would not create files in root directory.
* 10 Mar 92 - 2.28 - Add /NOPAUSE option to force no pause on exit.
* - Add error checking in ADDINI.
* 19 Mar 92 - 2.29 - bug: CHANGEPATH w/ target could cause syntax error.
* - bug: WRITEFILE n kept n+1 backup copies.
* - Make informed guess if 2.0 boot drive can't be determined.
* 26 Mar 92 - 2.30 - Add {OS2VER} Replace String.
* 3 Apr 92 - ADDINI was not uppercasing file name before checking.
* 6 Apr 92 - 2.31 - Add DELP/DELPROGRAM to delete program entry.
* - Add FORCE option to CP to delete and readd entry.
* 22 Apr 92 - 2.32 - bug: DelPath died if dir entry was first in path.
* - Mark current line in ECHOFILE display.
* - bug: Targets on INSUNIQUE were getting ignored.
* 25 Apr 92 - Strip trailing backslash, if needed, from CP insertions.
* 8 May 92 - Add RXCADD initialization, if available.
* 18 May 92 - 2.33 - bug: REMLINE would add REM even if it already existed.
* - EOF before ENDIF did not raise an error condition.
* 20 May 92 - Remove all hardcoded C: occurances.
* 21 May 92 2.34 - Add more RXCADD support.
* - Add INIGET and INISET IMP functions.
* - Add ADDLOCAL and DELLOCAL ITL functions.
* - Add DIR= option to ITL DELFILE function.
* - Add REMOVE option to ITL ENVVAR function.
* - Add NOCONF parameter to ASK.
* 23 Jun 92 - Add workaround for NOVALUE error in REXX20 2.01.
* 7 Jul 92 - Reworked InsUnique prefix processing to handle RUN=
* and CALL= properly.
* 14 Jul 92 - Make comments generated by our code look nicer.
* 15 Jul 92 - bug: 14 Jul mod broke InsUnique.
* - Allow ".." delimitters to arguments to enclose leading/
* trailing spaces.
* - Translate nulls to spaces in ITLSAY.
* 28 Jul 92 - bug: {SOURCE.DIR} repstr not always set properly.
* - bug: REPFILE (ITL) did not report all errors returned by
* REPLACEFILE (IMP).
* 5 Jul 92 - Add DPATH searching for ITL file.
* - bug: Incorrect interpreter error when ADDP nested in IF stmt.
* 11 Aug 92 - Display IMP version at startup.
* 13 Aug 92 - Added LOWER (5th) parameter to ASK.
* 26 Aug 92 - 2.35 - bug: INSPATH "AFTER target" placed entry incorrectly if target
* did not exist.
* - Add multiple targets to INSPATH.
* - Add REPLACEONLY and NEWONLY options to IMP InsUnique and ITL
* COMMAND.
* 17 Sep 92 - Ignore double quotes in ITL MD directory specification.
* 1 Oct 92 - READFILE returned too early if file empty.
* 5 Oct 92 - 2.36 - AddObject added for OS/2 2.0 systems.
* - AddProgram calls converted to ADDOBJ calls on 2.0 systems.
* - bug: Recursive call to CP would not find traget line.
* 19 Oct 92 - 2.37 - Allows ITL commands to be run from the REXX queue.
* - Adds (undocumented) DELETE option to REMALL.
* 29 Oct 92 - Add SYNCH nop for later implementation.
* 10 Dec 92 - 2.38 - Remove RXCADD knowlegde. Direct ITL calls not supported from
* COREADD.
* 18 Dec 92 - 2.39 - bug: WF before RF would cause novalue error.
* - bug: CMD at TOP would break REXX execs
* - TOP now goes to 1st non-comment line. Use 1 for line 1.
* - bug: ImpError novalue error under some conditions.
* 4 Jan 93 - bug: NOVALUE error when ITL embedded in a CMD file.
* 18 Jan 93 - bug: WF would fail if file had attributes of R, S, or H.
* - WF now preserves attributes of file.
* - WF preserves EAs of original object.
* - bug: COREDATA used wrong default for CORE.INI location.
* 1 Feb 93 - 2.40 - Extend AddLocal to take one filename.
* 5 Mar 93 - bug: FORCE on CP had to be in exact case.
* - bug: REMALL could set mod flag when no mod occurred.
* - bug: InsString always inserted at end.
* 7 Mar 93 - 2.41 - Add AddLocalFiles and DelLocalFiles routines.
* 15 Mar 93 - Add PATH & DPATH support to InsPath, DelPath for BATCH types.
* 18 Mar 93 - REMALL was returning wrong return code.
* 19 Mar 93 - Add NAME=xxx backup type.
* 1 Apr 93 - ImpError now writes to ITL log if ITL is active.
* - Readd undocumented DELETE option to REMALL.
* 20 Apr 93 - Allow trailing semicolon on CP dir spec.
* 27 Apr 93 - 2.42 - Add COREINST private routines.
* - Add &COUINFO function.
* - RF and READFILE were incorrectly handling empty files.
* 10 May 93 - bug: empty paths not handled correctly by InsPath.
* - bug: DelPath mishandled missing semicolon.
* 21 May 93 - 2.43 - bug: InsUnique was not handling similar prefixes.
* 1 Jun 93 - use RXCOUENV to obtain CORE information.
* 4 Jun 93 - 2.44 - Update CopyFile to support RXCOUCOPY.
* 28 Jun 93 - bug: RemAll/RemLine would rem REMs.
* 7 Jul 93 - 2.45 - disable saving of EAs under OS/2 2.x.
* 5 Aug 93 - bug: NUMCHECK died if param missing from file.
* 17 Aug 93 - bug: Lowercase call to CP DELETE would fail.
* 18 Mar 94 - bug: Changing SET HELP would modify HELPINDEX if it came
* first in the file.
* 31 May 94 - 2.46 - bug: PATH xxx (without equals sign) not handled properly
* in AUTOEXEC.BAT file.
*/