OS/2 Shareware BBS: 18 REXX/18-REXX.zip/checkurl.zip/CHECKURL.CMD

OS/2 REXX Batch file | 2002-02-22 | 73KB | 3,079 lines

/**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+
* Generator   : PPWIZARD version 02.038
*             : FREE tool for Windows, OS/2, DOS and UNIX by Dennis Bareis ([e-mail])
*             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
* Time        : Saturday, 23 Feb 2002 3:13:44pm
* Input File  : C:\DBAREIS\PROJECTS\MultiOs\checkurl\checkurl.x
* Output File : C:\DBAREIS\PROJECTS\MultiOs\checkurl\out\checkurl.rex
*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*/

if arg(1)="!CheckSyntax!" then exit(21924)

/*
*$Header:C:/DBAREIS/Projects.PVCS/MultiOs/checkurl/checkurl.x.pvcs 1.3 23 Feb 2002 15:13:34 USER "Dennis" $
*/
UserRequest=strip(arg(1))
if translate(UserRequest)="DEBUG" then
exit(0)
trace off
PgmVersion='02.054'
LastLineWasBlank='Y'
PragmaSrcUrl=";PRAGMA(URL_SOURCE)="
ProcessingThisUrl=''
DebugFileName=''
IniFileName=''
CopyrightDisplayed='N'
Beep=d2c(7)
Dying='N'
CrLf='0D0A'x
Cr='0D'x
Lf='0A'x
call SetupMovedText ""
call SetupMovedText "Site Has Moved"
call SetupMovedText "Document Has Moved"
call SetupMovedText "Page Has Moved"
call SetupMovedText "Page Now At"
call SetupMovedText "Update all Links"
call SetupMovedText "Update your Links"
call SetupMovedText "We can't find your page"
call SetupMovedText "Page no longer exists"
/*
*ADDCOMMA.XH Version 01.001 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm
*[e-mail]
*/
signal AddComma_1

AddCommasToDecimalNumber:
parse arg a_PassedValue,a_MinDigits
a_PassedValue=strip(a_PassedValue)
if a_MinDigits='' then
a_MinDigits=4
parse var a_PassedValue a_Number 1 a_Integer . '.' +0 a_Fraction .
if 0<>verify(strip(a_Number),'0123456789-+.') | ^Datatype(a_Number,'Number')then
return(a_PassedValue)
a_MaskCondensed='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX'
a_MaskSpread='abc,def,ghi,jkl,mno,pqr,stu,vwx,yzA,BCD,EFG,HIJ,KLM,NOP,QRS,TUV,WX'
a_MaxDigits=length(a_MaskCondensed)
a_Initial=substr(a_Integer,verify(a_Integer,'-+'),1)
parse var a_Integer a_Sign (a_Initial) +0 a_Integer
if length(a_Integer)<a_MinDigits then
return(a_PassedValue)
if length(a_Integer)>a_MaxDigits then
return(a_PassedValue)
return(a_Sign||strip(reverse(translate(a_MaskSpread,reverse(a_Integer),a_MaskCondensed, ',')), 'L', ',')||a_Fraction)

AddComma_1:
/*
*REXXTRAP.XH Version 99.287 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
signal on NOVALUE name _RexxTrapUninitializedVariable
signal on SYNTAX name _RexxTrapSyntaxError
/*
*DUMPVAR.XH Version 02.036 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
/*
*BIN2REXP.XH Version 99.134 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
b2rNewSingleQuote="' || " || '"' || "'" || '" || ' || "'"
b2rAllHexCodes=''
b2rAllAsciiCodes=''
do b2rCharCode=0 to 31
b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
end
do b2rCharCode=32 to 126
b2rAllAsciiCodes=b2rAllAsciiCodes||d2c(b2rCharCode)
end
do b2rCharCode=127 to 255
b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
end
signal EndBIN2REXPXh

_QuoteAscii:
b2rAscii2Quote=arg(1)
if pos("'",b2rAscii2Quote)=0 then
return("'" || b2rAscii2Quote || "'")
else
do
if pos('"',b2rAscii2Quote)=0 then
return('"' || b2rAscii2Quote || '"')
else
do
return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
end
end

_FormatHex:
b2rHexString=arg(1)
b2rLengthHex=length(b2rHexString)
b2rFormattedHex="'"
if b2rLengthHex>7 then
do
b2rLeft1=left(b2rHexString,1)
b2rLeft1Pos=verify(b2rHexString,b2rLeft1)
if b2rLeft1Pos=0 then
return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
else
do
if b2rLeft1Pos>7 then
do
b2rFormattedHex="copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
b2rHexString=substr(b2rHexString,b2rLeft1Pos)
b2rLengthHex=b2rLengthHex-(b2rLeft1Pos-1)
end
end
end
do b2rCharPosn=1 to b2rLengthHex
if(b2rCharPosn//8)=1 then
do
if b2rCharPosn<>1 then
b2rFormattedHex=b2rFormattedHex|| ' '
end
b2rFormattedHex=b2rFormattedHex||c2x(substr(b2rHexString,b2rCharPosn,1))
end
b2rFormattedHex=b2rFormattedHex|| "'x"
return(b2rFormattedHex)

_QuoteAsciiBreakIfRequired:
qabAscii=arg(1)
qabLength=length(qabAscii)
qabReturn=''
do while qabLength>256
qabLeft=left(qabAscii,256)
qabAscii=substr(qabAscii,256+1)
qabLength=qabLength-256
if qabReturn='' then
qabReturn=_QuoteAscii(qabLeft)
else
qabReturn=qabReturn|| " || " ||_QuoteAscii(qabLeft)
end
if qabLength=0 then
return(qabReturn)
else
do
if qabReturn='' then
return(_QuoteAscii(qabAscii))
else
return(qabReturn|| " || " ||_QuoteAscii(qabAscii))
end

_FormatHexBreakIfRequired:
fhbHex=arg(1)
fhbLength=length(fhbHex)
fhbReturn=''
do while fhbLength>80
fhbLeft=left(fhbHex,80)
fhbHex=substr(fhbHex,80+1)
fhbLength=fhbLength-80
if fhbReturn='' then
fhbReturn=_FormatHex(fhbLeft)
else
fhbReturn=fhbReturn|| " || " ||_FormatHex(fhbLeft)
end
if fhbLength=0 then
return(fhbReturn)
else
do
if fhbReturn='' then
return(_FormatHex(fhbHex))
else
return(fhbReturn|| " || " ||_FormatHex(fhbHex))
end

BIN2REXP:
call BIN2REXP_START
b2rValue=arg(1)
b2rValueLength=length(b2rValue)
if b2rValueLength=0 then
call BIN2REXP_ONEBIT '""'
else
do
do while b2rValue\==''
b2rEndAsciiPos=verify(b2rValue,b2rAllAsciiCodes)
if b2rEndAsciiPos=0 then
do
call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
b2rValue=''
end
else
do
if b2rEndAsciiPos<>1 then
do
call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue,b2rEndAsciiPos-1))
b2rValue=substr(b2rValue,b2rEndAsciiPos)
end
else
do
b2rEndBinaryPos=verify(b2rValue,b2rAllHexCodes)
if b2rEndBinaryPos=0 then
do
call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
b2rValue=''
end
else
do
call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue,b2rEndBinaryPos-1))
b2rValue=substr(b2rValue,b2rEndBinaryPos)
end
end
end
end
end
call BIN2REXP_END
return

EndBIN2REXPXh:
signal EndDUMPVARXh

DumpVarsInExpression:
dv_RexxExp=arg(1)
dv_Stem=translate(arg(2))
dv_VarHeading=arg(3)
dv_LineRoutine=arg(4)
if dv_Stem<> '' then
do
dv_AutoDump='N'
dv_StemDot=dv_Stem|| '.'
if symbol(dv_StemDot|| '0') = 'VAR' then
dv_VarCount=value(dv_StemDot|| '0')
else
do
call _DumpVarsLineOutput 'DumpVar: Could not find "' || dv_StemDot || '0' || '"'
return(0)
end
end
else
do
dv_AutoDump='Y'
dv_Stem='DV_VARLIST'
dv_StemDot=dv_Stem|| '.'
dv_VarCount=0
end
if dv_VarCount=0 then
dv_MaxVarLng=0
do while dv_RexxExp<> ''
parse value strip(dv_RexxExp, 'L')with dv_1stChar+1 dv_RexxExp
select
when datatype(dv_1stChar, 'S')then
do
dv_OneVar=dv_1stChar
do while dv_RexxExp<> ''
parse var dv_RexxExp dv_1stChar+1 dv_RexxExp
if datatype(dv_1stChar, 'S')then
dv_OneVar=dv_OneVar||dv_1stChar
else
do
dv_RexxExp=dv_1stChar||dv_RexxExp
leave
end
end
call _RememberDumpedVar dv_OneVar
if pos('.',dv_OneVar)<>0 then
do
do while dv_OneVar<> ''
parse var dv_OneVar dv_ThisBit '.' dv_OneVar
call _RememberDumpedVar dv_ThisBit
end
end
end
when dv_1stChar='"' | dv_1stChar = "'" then
do
dv_EndQuotePos=pos(dv_1stChar,dv_RexxExp)
if dv_EndQuotePos=0 then
dv_RexxExp=''
else
dv_RexxExp=substr(dv_RexxExp,dv_EndQuotePos+1)
end
otherwise
nop
end
end
call value dv_StemDot|| '0',dv_VarCount
if dv_AutoDump='Y' then
call DumpVarsInExpressionNow dv_Stem,dv_VarHeading,dv_LineRoutine
return(dv_VarCount)

DumpVarsInExpressionNow:
dv_StemDot=arg(1)|| '.'
dv_VarHeading=arg(2)
dv_LineRoutine=arg(3)
if symbol(dv_StemDot|| '0') = 'VAR' then
dv_VarCount=value(dv_StemDot|| '0')
else
do
call _DumpVarsLineOutput 'DumpVar: could not find "' || dv_StemDot || '0' || '"'
return(0)
end
if dv_VarCount<>0&dv_VarHeading<> '' then
do
call _DumpVarsLineOutput ''
call _DumpVarsLineOutput dv_VarHeading
call _DumpVarsLineOutput copies('~',length(dv_VarHeading))
end
dv_ShowVarLng=dv_MaxVarLng
if dv_MaxVarLng>30 then
dv_ShowVarLng=30
do dv_Index=1 to dv_VarCount
dv_OneVar=value(dv_StemDot||dv_Index)
if length(dv_OneVar)>=dv_ShowVarLng then
ShowVar=dv_OneVar
else
ShowVar=right(dv_OneVar,dv_ShowVarLng)
dv_OneVarValue=value(translate(dv_OneVar))
if datatype(dv_OneVarValue, 'N')=0 then
do
call BIN2REXP dv_OneVarValue
dv_OneVarValue=dv_Value
end
call _DumpVarsLineOutput ShowVar|| ' = ' ||dv_OneVarValue
end
return

_RememberDumpedVar:
dv_ThisVar=arg(1)
if symbol(dv_ThisVar)='VAR' then
do
dv_AlreadyHave='N'
dv_ThisVarUpper=translate(dv_ThisVar)
do dv_Index=1 to dv_VarCount
if dv_ThisVarUpper=translate(value(dv_StemDot||dv_Index))then
do
dv_AlreadyHave='Y'
leave
end
end
if dv_AlreadyHave='N' then
do
dv_VarCount=dv_VarCount+1
call value dv_StemDot||dv_VarCount,dv_ThisVar
if length(dv_ThisVar)>dv_MaxVarLng then
dv_MaxVarLng=length(dv_ThisVar)
end
end
return

_DumpVarsLineOutput:
if dv_LineRoutine='' then
say arg(1)
else
interpret 'call ' || dv_LineRoutine || ' arg(1)'
return

BIN2REXP_START:
dv_Value=''
return

BIN2REXP_ONEBIT:
if dv_Value<> '' then
dv_Value=dv_Value|| ' || '
dv_Value=dv_Value||arg(1)
return

BIN2REXP_END:
return

EndDUMPVARXh:
signal RexxTrap_2

_FindLastLabel:
FailedOnLine=arg(1)
TryLine=FailedOnLine
do while TryLine>1
TryLine=TryLine-1
TheLine=sourceline(TryLine)
ColonPos=pos(':',TheLine)
if ColonPos<>0 then
do
MaybeLabel=strip(left(TheLine,ColonPos-1))
if symbol(MaybeLabel)<> 'BAD' then
do
FoundLabelOnLine=TryLine
return(MaybeLabel|| ':  (line #' || AddCommasToDecimalNumber(TryLine) || ')')
end
end
end
FoundLabelOnLine=0
return('')

TrapHeadingColonData:
if arg(1)='' then
TrapMiddle='  '
else
TrapMiddle=': '
call SayAndDebugLine left(arg(1),16)||TrapMiddle||arg(2), '$S'
return

_CommonTrapHandler:
FailingLine=arg(1)
TrapHeading='BUG: ' ||arg(2)
TextDescription=arg(3)
Text=arg(4)
FailingLineText=AddCommasToDecimalNumber(FailingLine)
call SayAndDebugLine copies('=+', 39), '$+'
parse source . . SourceFileName
call SayAndDebugLine TrapHeading, '$S'
call SayAndDebugLine copies('~', length(TrapHeading)), '$S'
call TrapHeadingColonData TextDescription,Text
BettaOnRegina=condition('D')
if BettaOnRegina<> '' &BettaOnRegina<>Text then
call TrapHeadingColonData '',BettaOnRegina
call RexxTrapAddInfo FailingLine
parse version TheRexVer
parse source TheOpSys .
call TrapHeadingColonData "Environment", TheOpSys || ' using ' ||TheRexVer
if pos('REGINA',translate(TheRexVer))<>0 then
do
call TrapHeadingColonData '',uname()
end
call TrapHeadingColonData "Failing Module",SourceFileName
call TrapHeadingColonData "Failing Line #",FailingLineText
InRoutine=_FindLastLabel(FailingLine)
StartAt=(FailingLine-5)+1
if FoundLabelOnLine<>0 then
do
if FoundLabelOnLine>StartAt then
StartAt=FoundLabelOnLine
else
do
if FoundLabelOnLine<>0 then
do
if(FailingLine-FoundLabelOnLine)<10 then
StartAt=FoundLabelOnLine
else
call TrapHeadingColonData "After label",InRoutine
end
end
end
if StartAt<1 then
StartAt=1
call SayAndDebugLine '',       '$SH'
call SayAndDebugLine 'SOURCE', '$SH'
call SayAndDebugLine '~~~~~~', '$SH'
vlist.0=0
do ShowLine=StartAt to FailingLine
FailingSrcLineTxt=strip(SourceLine(ShowLine))
call SayAndDebugLine left(AddCommasToDecimalNumber(ShowLine),length(FailingLineText))|| ' : ' || FailingSrcLineTxt, '$SC'
call DumpVarsInExpression FailingSrcLineTxt, 'vlist'
end
call DumpVarsInExpressionNow 'vlist', 'VARIABLE LIST', 'SayAndDebugLine'
call SayAndDebugLine copies('=+', 39), '$+'
call RexxTrapDying FailingLine

_RexxTrapSyntaxError:
ReginaBug=SIGL
call _CommonTrapHandler ReginaBug, 'SYNTAX ERROR!', 'Reason',errortext(Rc)

_RexxTrapUninitializedVariable:
ReginaBug=SIGL
call _CommonTrapHandler ReginaBug, 'UNKNOWN VARIABLE!', 'Unknown Variable', condition('D')

RexxTrap_2:
signal on HALT name RexxCtrlC
call DisplayCopyright
/*
*REXSYSTM.XH Version 02.034 By Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
trace off
RexSystmRexxPgmName='?'
if '1' == 'F1'x then
RexIsAscii='N'
else
RexIsAscii='Y'
parse version RexVersionInfo
if pos('REGINA',translate(RexVersionInfo))<>0 then
do
RexWhich='REGINA'
parse value translate(RexVersionInfo)with . 'REGINA_' RexVerRegina ' '
RexVerRegina=translate(RexVerRegina, '.', '_')
end
else
do
RexVerRegina=''
if pos('REXX370',translate(RexVersionInfo))<>0 then
do
RexWhich='REXX370'
end
else
do
RexWhich='STANDARD_OS/2'
end
end
parse source RexSystemOpSys .
RexSystemOpSysREAL=RexSystemOpSys
if RexWhich='REGINA' then
do
if RexSystemOpSys="WIN32" then
parse value uname()with RexSystemOpSysREAL .
if RexSystemOpSys="UNIX" then
parse value uname()with RexSystemOpSysREAL .
end
if RexSystemOpSys="BEOS" then
RexSystemOpSys="UNIX"
if RexSystemOpSys="TSO" then
do
call syscalls 'ON'
RexSystemOpSys="UNIX"
end
RexSystmRexxPgmName=RexGetFullSourceName()
if RexIsAscii='N' then
do
RexEOL='15'x
end
else
do
if RexSystemOpSys="UNIX" then
RexEOL='0A'x
else
RexEOL='0D0A'x
end
if translate(strip(arg(1)))='DEBUG' then
do
call RexDumpSystemInfo
exit(0)
end
if RexWhich='STANDARD_OS/2' then
do
call RxFuncAdd 'SysSleep',        'RexxUtil', 'SysSleep'
call RxFuncAdd 'SysFileDelete',   'RexxUtil', 'SysFileDelete'
call RxFuncAdd 'SysSearchPath',   'RexxUtil', 'SysSearchPath'
call RxFuncAdd 'SysFileTree',     'RexxUtil', 'SysFileTree'
call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
call SetLocal
RexEnvVarPool='OS2ENVIRONMENT'
RexStdoutStream='STDOUT'
RexStderrStream='STDERR'
RexTmpFileCntr=random(90000)
end
else
do
OPTIONS 'NOEXT_COMMANDS_AS_FUNCS'
numeric digits 11
RexEnvVarPool='SYSTEM'
RexStdoutStream='<stdout>'
RexStderrStream='<stderr>'
end
if RexSystemOpSys<> "UNIX" then
do
RexDirChar='\'
RexOptionChar='/'
end
else
do
RexDirChar='/'
RexOptionChar='-'
end
signal REXSYSTM_3

RexDumpSystemInfo:
say 'Program Name  : ' ||RexSystmRexxPgmName
say 'Op System     : ' ||RexSystemOpSys
say 'Rexx Ver      : ' ||RexVersionInfo
say 'Which System  : ' ||RexWhich
if RexWhich='REGINA' then
say 'regina uname(): ' ||uname()
return

RexNeedReginaWorkAround:
if RexWhich='STANDARD_OS/2' then
return('N')
else
return('Y')

RexGetFullSourceName:
parse source . . TmpRexxSrc
if RexWhich='REGINA' then
TmpRexxSrc=FileQueryExists(strip(TmpRexxSrc))
if RexSystemOpSysREAL="TSO" then
do
TmpRexxSrc=word(TmpRexxSrc,1)
TmpRexxSrc=FileQueryExists(TmpRexxSrc)
end
return(TmpRexxSrc)

RexGetNameOfTmpDir:
TmpDir=strip(GetEnv('TMP'))
if TmpDir='' then
TmpDir=strip(GetEnv('TEMP'))
if TmpDir='' then
do
if RexSystemOpSys="UNIX" then
TmpDir='/tmp'
end
if right(TmpDir,1)==RexDirChar then
TmpDir=left(TmpDir,length(TmpDir)-1)
if RexWhich='REXX370' then
do
if TmpDir="SYSTEM" then
TmpDir="TMP"
end
return(TmpDir)

RedirectStdOutAndErr2:
if RexSystemOpSys="DOS" | RexSystemOpSysREAL = "WIN95" | RexSystemOpSysREAL = "WIN98" | RexSystemOpSysREAL = "WINME" then
do
return(' >' ||arg(1))
end
else
do
return(' > "' || arg(1) || '" 2>&1')
end

NameOfNulDevice:
if RexSystemOpSys="UNIX" then
return('/dev/null')
else
return('nul')

AllCmdOutput2Nul:
return(RedirectStdOutAndErr2(NameOfNulDevice()))

AddressCmd:
SysCmd2Exec=arg(1)
if RexWhich='STANDARD_OS/2' then
SysCmd2Exec='@' ||SysCmd2Exec
call DebugAddressCmdBefore SysCmd2Exec
SysCmd2Exec
SysCmdRc=Rc
FileIndex=2
SysCmdFile=arg(FileIndex)
do while SysCmdFile<> ''
call DebugAddressCmdOutput SysCmdFile, 'H1'
call DebugAddressCmdOutput copies('~', length(SysCmdFile)), 'H2'
if FileQueryExists(SysCmdFile)='' then
call DebugAddressCmdOutput '*File does not exist*',     '!'
else
do
SysCmdLine=0
call FileClose SysCmdFile
do while lines(SysCmdFile)<>0
SysCmdLine=SysCmdLine+1
call DebugAddressCmdOutput linein(SysCmdFile),SysCmdLine
end
call FileClose SysCmdFile
end
FileIndex=FileIndex+1
SysCmdFile=arg(FileIndex)
end
call DebugAddressCmdAfter SysCmdRc
Rc=SysCmdRc
return(SysCmdRc)

_filespec:
fsCmd=translate(arg(1))
select
when fsCmd='D' | fsCmd = 'DRIVE' then
do
if RexSystemOpSys="UNIX" then
return('')
fsPos=pos(':',arg(2))
if fsPos=0 then
return('')
else
return(left(arg(2),fsPos))
end
when fsCmd='P' | fsCmd = 'PATH' then
do
fsStartWith=substr(arg(2),length(_filespec('D',arg(2)))+1)
fsPos=lastpos(RexDirChar,fsStartWith)
if fsPos=0 then
return('')
else
return(left(fsStartWith,fsPos))
end
when fsCmd='N' | fsCmd = 'NAME' then
do
return(substr(arg(2),length(_filespec('L',arg(2)))+1))
end
when fsCmd='L' | fsCmd = 'LOCATION' then
do
return(_filespec('D', arg(2)) || _filespec('P',arg(2)))
end
when fsCmd='E' | fsCmd = 'EXTN' then
do
fsDotPos=lastpos('.',arg(2))
if fsDotPos=0 then
return('')
else
return(substr(arg(2),fsDotPos+1))
end
when fsCmd='W' | fsCmd = 'WITHOUTEXTN' then
do
fsDotPos=lastpos('.',arg(2))
if fsDotPos=0 then
return(arg(2))
else
return(left(arg(2),fsDotPos-1))
end
when fsCmd='B' | fsCmd = 'BASENAME' then
do
return(_filespec('W', _filespec('N',arg(2))))
end
otherwise
end
return

_SysFileTree:
b_Mask=arg(1)
b_Stem=arg(2)
if pos('D',arg(3))<>0 then
b_Type='D'
else
b_Type='F'
if RexWhich='STANDARD_OS/2' then
do
b_P3=b_Type|| 'O'
if pos('S',arg(3))<>0 then
b_P3=b_P3|| 'S'
return(SysFileTree(b_Mask,b_Stem,b_P3))
end
b_TmpFile=RexGetTmpFileName()
if RexSystemOpSys<> "UNIX" then
do
b_Cmd='dir /B '
if pos('S',arg(3))<>0 then
b_Cmd=b_Cmd|| "/S "
if b_Type='F' then
b_Cmd=b_Cmd|| "/A-D "
else
b_Cmd=b_Cmd|| "/AD "
if RexSystemOpSys="DOS" then
b_CmdMask=b_Mask
else
b_CmdMask='"' || b_Mask || '"'
b_Cmd=b_Cmd||b_CmdMask||RedirectStdOutAndErr2(b_TmpFile)
end
else
do
b_Cmd='find ' || _filespec('L', b_Mask) || ' '
if RexSystemOpSysREAL<> "FREEBSD" & RexSystemOpSysREAL <> "Darwin" & RexSystemOpSysREAL <> "TSO" then
b_Cmd=b_Cmd|| '-noleaf '
if pos('S',arg(3))=0 then
do
if RexSystemOpSysREAL<> "FREEBSD" & RexSystemOpSysREAL <> "Darwin" & RexSystemOpSysREAL <> "TSO" then
b_Cmd=b_Cmd|| '-maxdepth 1 '
else
b_Cmd=b_Cmd|| '-prune '
end
if b_Type='F' then
b_Cmd=b_Cmd|| "-type f "
else
b_Cmd=b_Cmd|| "-type d "
stfSName=_filespec('N',b_Mask)
if stfSName<> '' then
b_Cmd=b_Cmd|| '-name "' || stfSName || '"'
b_Cmd=b_Cmd||RedirectStdOutAndErr2(b_TmpFile)
end
Rc=AddressCmd(b_Cmd,b_TmpFile)
LastSlash=lastpos(RexDirChar,b_Mask)
call FileClose b_TmpFile
b_FileCnt=0
do while lines(b_TmpFile)<>0
b_AFile=linein(b_TmpFile)
if b_AFile='' | b_AFile = '.' | b_AFile = '..' then
iterate
if RexSystemOpSys="UNIX" & b_Type = 'D' then
do
if b_AFile=_filespec('L',b_Mask)then
iterate
end
if LastSlash<>0 then
do
if pos(RexDirChar,b_AFile)==0 then
b_AFile=left(b_Mask,LastSlash)||b_AFile
end
if b_Type='F' then
do
b_AFile=FileQueryExists(b_AFile)
if b_AFile='' then
iterate
end
else
do
if RexWhich='REGINA' then
do
if DirQueryExists(b_AFile)='' then
iterate
end
else
do
if pos(' ',b_AFile)<>0 then
iterate
end
end
b_FileCnt=b_FileCnt+1
call _valueS b_Stem|| '.' ||b_FileCnt,strip(b_AFile)
end
call FileClose b_TmpFile
DeleteRc=_SysFileDelete(b_TmpFile)
call _valueS b_Stem|| '.0',b_FileCnt
return(0)

_SysFileDelete:
if RexWhich='STANDARD_OS/2' then
return(SysFileDelete(arg(1)))
c_F=arg(1)
if RexSystemOpSys<> "DOS" then
c_F='"' || c_F || '"'
if RexSystemOpSys="DOS" | RexSystemOpSysREAL = "WIN95" | RexSystemOpSysREAL = "WIN98" | RexSystemOpSysREAL = "WINME" then
return(AddressCmd('if exist ' || c_F || ' del ' ||c_F||AllCmdOutput2Nul()))
else
do
if RexSystemOpSys="UNIX" then
return(AddressCmd('rm -f ' ||c_F||AllCmdOutput2Nul()))
else
return(AddressCmd('del ' ||c_F||AllCmdOutput2Nul()))
end

RexGetTmpFileName:
if arg(1)<> '' then
TmpFileM=arg(1)
else
do
if RexSystemOpSys<> "UNIX" then
TmpFileM='RSTM????.TMP'
else
do
TmpFileM=GetEnv('USER')
if TmpFileM='' then
TmpFileM=GetEnv('user')
if TmpFileM='' then
TmpFileM='?????.rstm'
else
TmpFileM=TmpFileM|| '_?????.rstm'
end
end
TmpFileM=RexGetNameOfTmpDir()||RexDirChar||TmpFileM
if RexWhich='STANDARD_OS/2' then
do
TmpFileF=SysTempFileName(TmpFileM)
if TmpFileF='' then
do
RexTmpFileCntr=RexTmpFileCntr+1
TmpFileF='C_' || right(RexTmpFileCntr, 6, '0') || '.TMP'
end
return(TmpFileF)
end
TmpRandom=right(time('S'),3)||random(99999)
TmpRandomAdd=0
do until FileQueryExists(TmpFileA)=''
TmpRandomS=reverse(d2x(TmpRandom+TmpRandomAdd))
TmpRandomAdd=TmpRandomAdd+1
TmpFileA=TmpFileM
TmpWhich=1
QmPos=pos('?',TmpFileA)
do while QmPos<>0
TmpReplace=substr(TmpRandomS,TmpWhich,1)
TmpWhich=TmpWhich+1
if TmpReplace='' then
TmpWhich=1
else
do
TmpFileA=overlay(TmpReplace,TmpFileA,QmPos)
QmPos=pos('?',TmpFileA)
end
end
end
return(TmpFileA)

GetEnv:
if RexWhich<> 'REXX370' then
rsGetEnv=value(arg(1),,RexEnvVarPool)
else
do
rsGetEnv=''
end
return(rsGetEnv)

_valueS:
if RexWhich='STANDARD_OS/2' then
return(value(arg(1),arg(2)))
return(value(translate(arg(1)),arg(2)))

_valueG:
if RexWhich='STANDARD_OS/2' then
return(value(arg(1)))
return(value(arg(1)))
/*
 * DB$STUBS - Keep indent (not so easy for comments)
 *            for this bit until finished!
 */

DirGetCurrent:
   return( directory() )

DirQueryExists:
   if  arg(1) = '' then
       return('')
   select
       when RexWhich =  'REGINA' then
       do
           return( stream(arg(1) || '\.', 'c', 'query exists') )
       end
       when RexWhich =  'STANDARD_OS/2' then
       do
           d_CDir = directory()
           d_NewDir = directory(arg(1))
           call directory d_CDir
           return(d_NewDir)
       end
       when RexWhich =  'REXX370' then
       do
           /* DB$390 - return passed name (BAD! - ppwizard might fail in parts)
            */
           return(arg(1))
       end
       otherwise
       do
           return(arg(1))
       end
   end

FileQueryExists:
   if  arg(1) = '' then
       return('')
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'query exists') )
   else
   do
       /* DB$390 - return passed name (BAD! - ppwizard might fail in parts)
       */
       return(arg(1))
   end

FileQueryDateTime:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'query datetime') )
   else
   do
       /* DB$390 - Return valid but fixed value
       */
       return('01-01-01 12:00:00')
   end

FileQuerySize:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'query size') )
   else
   do
       /* DB$390 - Return valid but fixed value
       */
       return('219')
   end

FileOpenReadOnly:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'open read') )
   else
   do
       /* DB$390 - For now do nothing (so file opens read/write - so what)
       */
       return('')
   end

FileClose:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'close') )
   else
   do
       /* DB$390 - Worth a try
       */
       call lineout arg(1)
       return('')
   end

FileState:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'State') )
   else
   do
       /* DB$390 - Stream Description
       */
       return('')
   end

FileDescription:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'Description') )
   else
   do
       /* DB$390 - Stream Description
       */
       return('')
   end
/*
   REXSYSTM.XH - a few stream there (need to move stubs there)
   DirMake
   FileCharin    ?
   FileCharout   ?
   FileLinein    ?
   FileLineOut   ?
*/

REXSYSTM_3:
/*
*KEYEDVAR.XH Version 00.085 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
RxKvMaxCheck=20000
RxKvStartIndex=1
RxKvOkIndex=1
RxKvStep=10000
do forever
do RxKvIndex=RxKvStartIndex to RxKvMaxCheck by RxKvStep
if symbol(copies('A', RxKvIndex)) = 'BAD' then
leave
else
RxKvOkIndex=RxKvIndex
end
if RxKvStep=1 then
leave
else
do
RxKvStartIndex=RxKvOkIndex
RxKvStep=RxKvStep%10
if RxKvStep=0 then
RxKvStep=1
end
end
RxKvTrunc2=RxKvOkIndex-10
signal EndKeyedVarXH

KeySaveInfo:
RxKvKeyVar='KV_' || c2x(arg(1)) || '?' ||c2x(arg(2))
if length(RxKvKeyVar)<=RxKvOkIndex then
call value RxKvKeyVar,arg(3)
else
do
RxKvStem='T' || left(RxKvKeyVar, RxKvTrunc2)    || '.'
RxKvRest=substr(RxKvKeyVar,RxKvTrunc2+1)
RxKv0V=RxKvStem|| '0'
if symbol(RxKv0V)<> 'VAR' then
do
call value RxKv0V,1
call value RxKvStem|| '1.0R',RxKvRest
call value RxKvStem|| '1.0D',arg(3)
end
else
do
RxKv0=value(RxKv0V)
RxKvFnd='N'
do RxKvIndex=1 to RxKv0
if value(RxKvStem||RxKvIndex|| '.0R')==RxKvRest then
do
RxKvFnd='Y'
RxKv0=RxKvIndex
end
end
if RxKvFnd='N' then
do
RxKv0=RxKv0+1
call value RxKv0V,RxKv0
call value RxKvStem||RxKv0|| '.0R',RxKvRest
end
call value RxKvStem||RxKv0|| '.0D',arg(3)
end
end
return("")

KeyGetInfo:
RxKvKeyVar='KV_' || c2x(arg(1)) || '?' ||c2x(arg(2))
if length(RxKvKeyVar)<=RxKvOkIndex then
do
if symbol(RxKvKeyVar)<> 'VAR' then
return("<KeyedVarUnknown>")
else
return(value(RxKvKeyVar))
end
else
do
RxKvStem='T' || left(RxKvKeyVar, RxKvTrunc2)    || '.'
RxKvRest=substr(RxKvKeyVar,RxKvTrunc2+1)
RxKv0V=RxKvStem|| '0'
if symbol(RxKv0V)<> 'VAR' then
return("<KeyedVarUnknown>")
else
do
RxKv0=value(RxKv0V)
do RxKvIndex=1 to RxKv0
if value(RxKvStem||RxKvIndex|| '.0R')==RxKvRest then
do
return(value(RxKvStem||RxKvIndex|| '.0D'))
end
end
return("<KeyedVarUnknown>")
end
end

EndKeyedVarXH:
DebugFileName=ReplaceAnyFileNameSymbols(GetEnv('CHECKURL_DEBUG'))
if left(DebugFileName,1)='+' then
DebugFileName=substr(DebugFileName,2)
else
do
if DebugFileName<> '' then
DosDelRc=CloseAndDeleteFile(DebugFileName)
end
call DebugLine ''
call DebugLine ''
call DebugLine copies('=',79)
call DebugLine '        Time: ' ||date()
call DebugLine 'Command Line: ' ||UserRequest
call DebugLine '   Op System: ' ||RexSystemOpSys
call DebugLine ' Interpreter: ' ||RexVersionInfo
call DebugLine copies('=',79)
call DebugLine ''
signal URLINHTM_4

CheckUrlsInHtml:
PgmRc=GetInputFilesMatchingMasks()
if PgmRc<> '' then
return(PgmRc)
Dangerous='"' || "'" ||d2c(9)||d2c(27)
UrlCount=0
do Index=1 to NumberFiles
UrlSourceFile=FileList.Index
LineNumber=0
Urls=0
CloseRc=stream(UrlSourceFile, 'c', 'close')
do while lines(UrlSourceFile)<>0
CurrentLine=linein(UrlSourceFile)
LineNumber=LineNumber+1
CurrentLine=translate(CurrentLine, '', Dangerous, ' ')
do WordIndex=1 to words(CurrentLine)
MaybeUrl=word(CurrentLine,WordIndex)
if abbrev(MaybeUrl, 'http://') | abbrev(MaybeUrl, 'ftp://')then
do
UrlCount=UrlCount+1
Url.UrlCount=MaybeUrl
UrlSrc.UrlCount=UrlSourceFile|| '(' || LineNumber || ')'
end
end
end
CloseRc=stream(UrlSourceFile, 'c', 'close')
end
Url.0=UrlCount
UrlSrc.0=UrlCount
call ProcessUrlArray
return(PgmRc)

URLINHTM_4:
/*
*BASEDATE.XH Version 01.081 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
signal EndBASEDATEXh

FileBaseDate:procedure
FileName=arg(1)
FileTime=stream(FileName, 'c', 'query datetime')
if FileTime='' then
return(-1)
FileTime=space(FileTime)
parse var FileTime Month'-'Day'-'Year' 'Rest
if Year<80 then
Year=100+Year
Year=1900+Year
return(BaseDate(Year||Month||Day))

BaseDate:procedure
TheDate=translate(arg(1), ' ', '/-')
if TheDate='' then
TheDate=date('Sorted')
parse var TheDate Year MM DD
if length(Year)>=8 then
do
DD=substr(Year,7,2)
MM=substr(Year,5,2)
Year=left(Year,4)
end
DaysInMonth='31  28  31  30  31  30  31  31  30  31  30  31'
if datatype(Year, 'WholeNumber')<>1 then
return(-10)
if datatype(MM, 'WholeNumber')<>1 then
return(-20)
if datatype(DD, 'WholeNumber')<>1 then
return(-30)
if MM<0|MM>12 then
return(-21)
DaysThisMonth=word(DaysInMonth,MM)
if MM=2 then
DaysThisMonth=DaysThisMonth+1
if DD<0|DD>DaysThisMonth then
return(-31)
if length(strip(Year))=2 then
do
if Year>=80 then
Year='19' ||Year
else
Year='20' ||Year
end
y=Year;m=MM;d=DD
z=y+(m-14)%12
f=word('306 337 0 31 61 92 122 153 184 214 245 275',m)
b=d+f+365*z+z%4-z%100+z%400-307
return(b)

BD2DATE:procedure
parse arg rd,Format,Delimiter
z=rd+307
h=100*z-25
a=h%3652425
b=a-a%4
year=(100*b+h)%36525
c=b+z-365*year-year%4
month=(5*c+456)%153
day=c-word('0 31 61 92 122 153 184 214 245 275 306 337',month-2)
if month>12 then
do
year=year+1
month=month-12
end
yyyy=right(year,4, '0')
mm=right(month,2, '0')
dd=right(day,2, '0')
return(yyyy||Delimiter||mm||Delimiter||dd)

EndBASEDATEXh:
/*
*FASTINI.XH Version 98.147 by Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
_FiOpenCount=0
call RxFuncAdd 'FastIniStart',   'FastIni',  'FastIniStart'
call RxFuncAdd 'FastIniEnd',     'FastIni',  'FastIniEnd'
call RxFuncAdd 'FastIniVersion', 'FastIni',  'FastIniVersion'
_fiAvailable=_FastIniOk()
signal EndFASTINIXh

FastIniIsFast:
return(_fiAvailable)

FastIniOpenIni:
_fiFile=arg(1)
_fiHandleVar=arg(2)
if _fiAvailable='N' then
do
interpret _fiHandleVar|| ' = 0'
return('OK')
end
interpret _fiHandleVar|| ' = ""'
_fiFastRc=FastIniStart(_fiFile,_fiHandleVar)
interpret '_FiHandle = ' ||_fiHandleVar
if _FiHandle<> '' then
do
_FiOpenCount=_FiOpenCount+1
_FiOpenedList._FiOpenCount=_FiHandle
end
return(_fiFastRc)

FastIniCloseIni:
if _fiAvailable='N' then
return('OK')
return(FastIniEnd(arg(1)))

FastIniGetVersion:
if _fiAvailable='Y' then
return(FastIniVersion(arg(1)))
else
do
interpret arg(1)|| ' = "00.000 http://www.labyrinth.net.au/~dbareis/index.htm [e-mail] Dennis Bareis"'
return('OK')
end

FastIniCleanup:
if _fiAvailable='N' then
return('OK')
do _fi=1 to _FiOpenCount
call FastIniEnd(_FiOpenedList._fi)
_FiOpenedList._fi=0
end
_FiOpenCount=0
return('OK')

_FastIniOk:
signal on SYNTAX name _FastIniNotOk
interpret "_fiRc = FastIniVersion('_fiVersion')"
return('Y')

_FastIniNotOk:
return('N')

EndFASTINIXh:
TryQuotes='"' || "'" ||xrange(d2c(127),d2c(255))||xrange(d2c(1),d2c(31))
UrlCount=0
UrlInfoNeedsWriting='N'
MemoryBackupLevel=3
signal MEMORY_5

GetQuotedText:
parse arg TheString,RestVarName
TheString=strip(TheString, 'L')
if TheString='' then
return('')
QuoteChar=left(TheString,1)
do
SecondQuotePosn=pos(QuoteChar,TheString,2)
if SecondQuotePosn=0 then
return('')
QuotedString=substr(TheString,2,SecondQuotePosn-2)
TheRest=substr(TheString,SecondQuotePosn+1)
end
TheRest=strip(TheRest, 'L')
if RestVarName<> '' then
call _valueS RestVarName,TheRest
return(QuotedString)

CreateUrl2IndexMapping:
call KeySaveInfo "U2I",arg(2),arg(1)
return

GetInfoIndex4Url:
giUrl=arg(1)
giAdding=arg(2)
giIndex=KeyGetInfo("U2I",giUrl)
if giIndex=="<KeyedVarUnknown>" then
do
if giAdding<> 'Y' then
giIndex=0
else
do
UrlIniCount=UrlIniCount+1
giIndex=UrlIniCount
call CreateUrl2IndexMapping giIndex,giUrl
end
end
return(giIndex)

MemoryOpen:
UrlIniCount=0
UrlInfoNeedsWriting='N'
if IniFileName='' then
return
CloseRc=stream(IniFileName, 'c', 'close')
do while lines(IniFileName)<>0
CurrentLine=strip(linein(IniFileName))
if CurrentLine='' | left(CurrentLine,1) = ';' then
iterate
UrlIniCount=UrlIniCount+1
if left(CurrentLine,1)='+' then
StatusOk='Y'
else
StatusOk='N'
URL=GetQuotedText(substr(CurrentLine,2), "Rest")
!URL.UrlIniCount.!UrlStatusOk=StatusOk
!URL.UrlIniCount.!Url=URL
!URL.UrlIniCount.!LastChecked=GetQuotedText(Rest, "Rest")
if StatusOk='Y' then
!URL.UrlIniCount.!LastModified=GetQuotedText(Rest, "Rest")
else
!URL.UrlIniCount.!Reason=GetQuotedText(Rest, "Rest")
!URL.UrlIniCount.!Updated='N'
call CreateUrl2IndexMapping UrlIniCount,Url
end
CloseRc=stream(IniFileName, 'c', 'close')
return

QuoteIt:
Quote4=arg(1)
TryQuoteLng=length(TryQuotes)
do QuoteIndex=1 to TryQuoteLng
PossibleQuote=substr(TryQuotes,QuoteIndex,1)
if pos(PossibleQuote,Quote4)=0 then
leave
end
return(PossibleQuote||arg(1)||PossibleQuote)

MemoryNeedsUpdating:
if IniFileName='' then
return('N')
else
do
if UrlInfoNeedsWriting='N' then
return('N')
else
return('Y')
end

_MemoryCloseWrite:
WriteWhatIndex=arg(1)
if !URL.WriteWhatIndex.!UrlStatusOk='Y' then
do
OkCount=OkCount+1
if OkCount=1 then
do
call _lineout IniFileName, ';-----------------------------'
call _lineout IniFileName, ';--- URLS without problems ---'
call _lineout IniFileName, ';-----------------------------'
call _lineout IniFileName, ''
end
Output='+  '  || QuoteIT(!URL.WriteWhatIndex.!Url)          || '  '
Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastChecked)|| '  '
Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastModified)
end
else
do
ErrCount=ErrCount+1
if ErrCount=1 then
do
call _lineout IniFileName, ';--------------------------'
call _lineout IniFileName, ';--- URLS with problems ---'
call _lineout IniFileName, ';--------------------------'
call _lineout IniFileName, ''
end
Output='-  '  || QuoteIT(!URL.WriteWhatIndex.!Url)          || '  '
Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastChecked)|| '  '
Output=Output||QuoteIT(!URL.WriteWhatIndex.!Reason)
end
call _lineout IniFileName,Output
return

WantToForgetUrl:
wfuIndex=arg(1)
DateChecked=!URL.wfuIndex.!LastChecked
if datatype(DateChecked, 'W')=0 then
return('Y')
if(BaseDate()-DateChecked)>ForgetDays then
return('Y')
else
return('N')

MemoryClose:
if MemoryNeedsUpdating()='N' then
return
if MemoryBackupLevel=0|stream(IniFileName, 'c', 'query exists') = '' then
BackupMem='N'
else
do
if BaseDate()=FileBaseDate(IniFileName)then
BackupMem='N'
else
BackupMem='Y'
end
if BackupMem='Y' then
do
BaseLess1=_filespec('name',IniFileName)
BaseLess1=left(BaseLess1,length(BaseLess1)-1)
WholeLess1=left(IniFileName,length(IniFileName)-1)
OldestFile=WholeLess1||MemoryBackupLevel
call CloseAndDeleteFile OldestFile
do BackupIndex=0 to MemoryBackupLevel-1
ToChar=MemoryBackupLevel-BackupIndex
FromChar=ToChar-1
if FromChar=0 then
FromChar=right(IniFileName,1)
call AddressCmd 'ren ' || WholeLess1 || FromChar || ' ' ||BaseLess1||ToChar||AllCmdOutput2Nul()
end
MemoryBackupLevel=0
end
call CloseAndDeleteFile IniFileName
OkCount=0
ErrCount=0
do CloseIndex=1 to UrlIniCount
if !URL.CloseIndex.!UrlStatusOk='Y' & !URL.CloseIndex.!Updated = 'Y' then
call _MemoryCloseWrite CloseIndex
end
do CloseIndex=1 to UrlIniCount
if !URL.CloseIndex.!UrlStatusOk='Y' & !URL.CloseIndex.!Updated = 'N' & WantToForgetUrl(CloseIndex) = 'N' then
call _MemoryCloseWrite CloseIndex
end
if OkCount<>0 then
do
call _lineout IniFileName, ';  ' || OkCount || ' Url(s) are OK'
call _lineout IniFileName, ''
call _lineout IniFileName, ''
end
do CloseIndex=1 to UrlIniCount
if !URL.CloseIndex.!UrlStatusOk='N' & !URL.CloseIndex.!Updated = 'Y' then
call _MemoryCloseWrite CloseIndex
end
do CloseIndex=1 to UrlIniCount
if !URL.CloseIndex.!UrlStatusOk='N' & !URL.CloseIndex.!Updated = 'N'  & WantToForgetUrl(CloseIndex) = 'N' then
call _MemoryCloseWrite CloseIndex
end
if ErrCount<>0 then
call _lineout IniFileName, ';  ' || ErrCount || ' Url(s) have problems'
if OkCount=0&ErrCount=0 then
call _lineout IniFileName, ';--- NO URLS ---'
UrlInfoNeedsWriting='N'
return

NeedToReTestUrl:
if IniFileName='' then
return('NO MEMORY FILE BEING USED')
TestUrl=arg(1)
UrlIndex=GetInfoIndex4Url(TestUrl)
if UrlIndex=0 then
do
call DebugLine 'This is a new URL (not known): ' ||TestUrl
return('NEW URL')
end
if !URL.UrlIndex.!UrlStatusOk='N' then
do
call DebugLine 'This URL failed on last test : ' ||TestUrl
call DebugLine '     REASON : ' ||!URL.UrlIndex.!Reason
return('FAILED')
end
if CheckDays='' then
return('WANT TO DO ALL')
BaseDateNow=BaseDate()
BaseDateOk=!URL.UrlIndex.!LastChecked
CheckDaysThisUrl=random(CheckDaysMin,CheckDaysMax)
PeriodSinceLastCheck=BaseDateNow-BaseDateOk
call DebugLine 'URL: ' || TestUrl || ' last checked ' || PeriodSinceLastCheck || ' days ago (CheckDays[Random]=' || CheckDaysThisUrl || ').'
if PeriodSinceLastCheck<0|PeriodSinceLastCheck>CheckDaysThisUrl then
do
return('NEED TO RETEST')
end
else
do
return('')
end

SaveUrlOkInformation:
if IniFileName='' then
return
SaveUrl=arg(1)
UrlIndex=GetInfoIndex4Url(SaveUrl, 'Y')
!URL.UrlIndex.!UrlStatusOk='Y'
!URL.UrlIndex.!Url=SaveUrl
!URL.UrlIndex.!LastChecked=BaseDate()
!URL.UrlIndex.!LastModified=!CheckUrl.!LastModified
!URL.UrlIndex.!Updated='Y'
UrlInfoNeedsWriting='Y'
return

SaveUrlFailedInformation:
if IniFileName='' then
return
parse arg FailedUrl,Reason
UrlIndex=GetInfoIndex4Url(FailedUrl, 'Y')
!URL.UrlIndex.!UrlStatusOk='N'
!URL.UrlIndex.!Url=FailedUrl
!URL.UrlIndex.!LastChecked=BaseDate()
!URL.UrlIndex.!Reason=Reason
!URL.UrlIndex.!Updated='Y'
UrlInfoNeedsWriting='Y'
return

MEMORY_5:
parse source . . RexxSrcName
ShortRexxSrcName=_filespec('name',RexxSrcName)
DotPos=lastpos('.',ShortRexxSrcName)
if DotPos=0 then
ShortRexxSrcNameNoExtn=ShortRexxSrcName
else
ShortRexxSrcNameNoExtn=left(ShortRexxSrcName,DotPos-1)
MaxLineDump=10
if DebugFileName<> '' then
MaxLineDump=MaxLineDump*2
OptionsCmdLine=strip(arg(1))
OptionsEnvironment=GetEnv('CHECKURL_OPTIONS')
UserRequest=OptionsEnvironment|| ' ' ||OptionsCmdLine
ErrorFileName=''
CheckDays=''
ForgetDays=''
ReadTimeout=''
ReadTimeout2=''
OnlineTestUrl='http://www.labyrinth.net.au/~dbareis/index.htm'
UseHead='N'
FtpEmailAddress=''
DoHttpUrls='Y'
DoFtpUrls='Y'
CheckPointFrequency=20
MaxBytesInPage=3000
IgnoreFor=0
ErrorTypeCnt=0
ParmCount=0
TheCmdLine=UserRequest
HttpUserAgent=''
do while TheCmdLine<> ''
TheCmdLine=strip(TheCmdLine)
if left(TheCmdLine,1)='"' then
do
BeforeParse=TheCmdLine
parse value substr(TheCmdLine,2)with ThisParm'"'TheCmdLine
if TheCmdLine<> '' then
do
if left(TheCmdLine,1)\==' ' then
CryAndDie('Invalid quoted parameter at ==> ' ||BeforeParse)
end
end
else
do
parse var TheCmdLine ThisParm TheCmdLine
end
call DebugLine 'Option: "' || ThisParm || '"'
if left(ThisParm,1)<>RexOptionChar then
do
ParmCount=ParmCount+1
Parm.ParmCount=ThisParm
iterate
end
parse var ThisParm ThisCmd':'ThisCmdOptions
ThisCmd=translate(substr(ThisCmd,2))
ThisCmdOptions=ReplaceCommandLineCodes(ThisCmdOptions)
select
when ThisCmd='OKRESPONSES' then
do
ExceptionFile=ThisCmdOptions
if stream(ExceptionFile, 'c', 'query exists') = '' then
CryAndDie('The file "' || ExceptionFile || '" does not exist!')
call DebugLine ''
call DebugLine 'Have list of OK server responses'
CloseRc=stream(ExceptionFile, 'c', 'close')
OpenRc=stream(ExceptionFile, 'c', 'open read')
do while lines(ExceptionFile)<>0
UrlLine=strip(linein(ExceptionFile))
if UrlLine='' then
iterate
if left(UrlLine,1)=';' then
iterate
call DebugLine '   | ' ||UrlLine
parse var UrlLine OkReturnCode Url e_Rest
if translate(OkReturnCode)<> 'IGNORE' then
do
call KeySaveInfo "OK" || c2x(translate(OkReturnCode)), strip(Url, 'L'),e_Rest
end
else
do
parse var e_Rest e_ResumeDate e_ReasonText
e_ResumeBd=BaseDate(e_ResumeDate)
if e_ResumeBd<0 then
CryAndDie('Invalid date of "' || e_ResumeDate || '" specified, expected YYYY/MM/DD!')
e_ToGo=e_ResumeBd-BaseDate()
if e_ToGo<0 then
do
call SayAndDebugLine 'EXPIRED "IGNORE COMMAND" for : ' ||Url
end
else
do
call SayAndDebugLine 'Ignoring (for ' || abs(e_ToGo)+1 || ' more days) : ' ||Url
call KeySaveInfo "IGNORE", strip(Url, 'L'),e_ReasonText
end
end
end
CloseRc=stream(ExceptionFile, 'c', 'close')
end
when ThisCmd='ERRORFILE' then
do
if ThisCmdOptions='' then
ErrorFileName=''
else
do
ErrorFileName=ReplaceAnyFileNameSymbols(ThisCmdOptions)
if left(ErrorFileName,1)='+' then
ErrorFileName=substr(ErrorFileName,2)
else
do
if ErrorFileName<> '' then
DosDelRc=CloseAndDeleteFile(ErrorFileName)
end
end
end
when ThisCmd='MEMORYFILE' then
do
if ThisCmdOptions='' then
IniFileName=''
else
IniFileName=ReplaceAnyFileNameSymbols(ThisCmdOptions)
end
when ThisCmd='GETENV' then
do
MoreOptions=GetEnv(ThisCmdOptions)
if MoreOptions='' then
UserSyntaxError('The environment variable "' || ThisCmdOptions || '" is unknown')
TheCmdLine=MoreOptions|| ' ' ||TheCmdLine
end
when ThisCmd='PAGEMOVED' then
do
if ThisCmdOptions='' then
UserSyntaxError('No page moved text supplied')
call SetupMovedText ThisCmdOptions
end
when ThisCmd='IGNOREFOR' then
do
if ThisCmdOptions='' then
UserSyntaxError('No ignore for period (in days) supplied')
IgnoreFor=GetInteger(ThisCmd,ThisCmdOptions)
end
when ThisCmd='MAXPAGELNG' then
do
if ThisCmdOptions='' then
MaxBytesInPage=3000
else
do
MaxBytesInPage=GetInteger(ThisCmd,ThisCmdOptions)
if MaxBytesInPage<800 then
MaxBytesInPage=800
end
end
when ThisCmd='CHECKPOINT' then
do
if ThisCmdOptions='' then
CheckPointFrequency=20
else
CheckPointFrequency=GetInteger(ThisCmd,ThisCmdOptions)
end
when ThisCmd='CHECKDAYS' then
do
CheckDays=ThisCmdOptions
if CheckDays<> '' then
do
parse var CheckDays CheckDaysMin '-' CheckDaysMax
if CheckDaysMax='' then
do
if CheckDaysMin=1 then
CheckDaysMax=1
else
do
if CheckDaysMin<6 then
CheckDaysMax=CheckDaysMin+1
else
CheckDaysMax=CheckDaysMin+((CheckDaysMin%3)+1)
end
end
call DebugLine 'INI Check Days = ' || CheckDaysMin || ' to ' ||CheckDaysMax
end
end
when ThisCmd='READTIMEOUT' then
do
if ThisCmdOptions='' then
ReadTimeout=''
else
do
Value=GetInteger(ThisCmd,ThisCmdOptions)
if Value>=1 then
ReadTimeout=Value
end
end
when ThisCmd='TIMEOUTRETRY' then
do
if ThisCmdOptions='' then
ReadTimeout2=''
else
do
ReadTimeout2=GetInteger(ThisCmd,ThisCmdOptions)
if ReadTimeout2<0 then
ReadTimeout2=0
end
end
when ThisCmd='MEMORYBACKUPLEVEL' then
do
if ThisCmdOptions='' then
MemoryBackupLevel=3
else
do
MemoryBackupLevel=GetInteger(ThisCmd,ThisCmdOptions)
if MemoryBackupLevel>9 then
MemoryBackupLevel=9
end
end
when ThisCmd='FORGETDAYS' then
do
if ThisCmdOptions='' then
ForgetDays=''
else
do
Value=GetInteger(ThisCmd,ThisCmdOptions)
if Value<50 then
Value=50
ForgetDays=Value
end
end
when ThisCmd='MAXLINEDUMP' then
do
MaxLineDump=GetInteger(ThisCmd,ThisCmdOptions)
end
when ThisCmd='TESTURL' then
OnlineTestUrl=ThisCmdOptions
when ThisCmd='HTTPUSERAGENT' then
HttpUserAgent=ThisCmdOptions
when ThisCmd='FTPEMAIL' then
do
FtpEmailAddress=ThisCmdOptions
end
when ThisCmd='USEHEADREQUEST' then
do
UseHead=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
if UseHead='Y' then
do
call SayAndDebugLine ''
call SayAndDebugLine '***'
call SayAndDebugLine "*** Note some servers don't seem to correctly handle"
call SayAndDebugLine '*** the HEAD request!  According to RFC 1945 the format'
call SayAndDebugLine '*** of the head request is the same as that for the GET'
call SayAndDebugLine '*** request which always seems to be correctly handled!'
call SayAndDebugLine '***'
call SayAndDebugLine '*** If you get a 404 this could be a server malfunction!'
call SayAndDebugLine '***'
call SayAndDebugLine ''
end
end
when ThisCmd='EXCLUDE' then
do
ThisMask=ThisCmdOptions
if left(ThisMask,1)<> '+' then
SubDirFlag=''
else
do
SubDirFlag='S'
ThisMask=substr(ThisMask,2)
end
ThisList.0=0
call _SysFileTree ThisMask, 'ThisList', 'F' ||SubDirFlag
call DebugLine 'Excluding the ' || ThisList.0 || ' file(s) that matched: ' ||ThisCmdOptions
do Index=1 to ThisList.0
call KeySaveInfo "EXFILE", ThisList.Index, ''
call DebugLine '  * ' ||ThisList.Index
end
end
otherwise
UserSyntaxError('Unknown switch of "' || RexOptionChar || ThisCmd || '" specified')
end
end
if HttpUserAgent='' then
HttpUserAgent="Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0)"
if MaxLineDump>99 then
MaxLineDump=99
if ReadTimeout='' then
ReadTimeout=15
if ReadTimeout2='' then
do
if ReadTimeout<60 then
ReadTimeout2=60
else
ReadTimeout2=ReadTimeout+30
end
if IniFileName<> '' then
do
if ForgetDays='' then
ForgetDays=365
if CheckDays='' then
call DebugLine 'INI will be updated, all URLs will be processed reguardless of age'
end
else
do
if CheckDays<> '' then
call SayAndDebugLine 'Option "' || RexOptionChar || 'CheckIni:' || CheckDays || '" ignored.'
if ForgetDays<> '' then
call SayAndDebugLine 'Option "' || RexOptionChar || 'ForgetDays:' || ForgetDays || '" ignored.'
end
HaveSockets=InitializeSocketSupport()
HaveFtp=InitializeFtpSupport()
if ParmCount=0 then
UserSyntaxError('No parameters supplied!')
TheCmd=translate(Parm.1)
select
when TheCmd="VERSION?" then
PgmRc=ShortRexxSrcName|| ' ' ||PgmVersion
when TheCmd="SOCKETVERSION?" then
do
if HaveSockets<> '' then
PgmRc=HaveSockets
else
do
if RexWhich='STANDARD_OS/2' then
PgmRc='RxSock.DLL ' || SockVersion()   || ' - OS/2'
else
PgmRc='RxSock.DLL ' || RxSockVersion() || ' - Regina'
end
end
when TheCmd="FTPVERSION?" then
do
if HaveFtp<> '' then
PgmRc=HaveFtp
else
do
call FtpVersion 'Version'
PgmRc='RxFtp.DLL ' ||Version
end
end
when TheCmd="SOCKETREADY?" then
do
if HaveSockets<> '' then
PgmRc=HaveSockets
else
PgmRc='OK'
end
when TheCmd="FTPREADY?" then
do
if HaveFtp<> '' then
PgmRc=HaveFtp
else
PgmRc='OK'
end
when TheCmd="CHECK1URL" then
do
MaxLineDump=0
if ParmCount<>2 then
UserSyntaxError('Incorrect Number of parameters!')
PgmRc=CheckUrl(Parm.2)
end
when TheCmd="CHECKURLSINHTML" then
do
if HaveSockets='' then
PgmRc=CheckUrlsInHtml(Parm.2)
else
do
PgmRc=HaveSockets
call SayAndDebugLine PgmRc
end
end
when TheCmd="CHECKLISTEDURLS" then
do forever
if HaveSockets<> '' then
do
PgmRc=HaveSockets
call SayAndDebugLine PgmRc
leave
end
PgmRc=GetInputFilesMatchingMasks()
if PgmRc<> '' then
leave
UrlCount=0
do Index=1 to NumberFiles
ThisFile=FileList.Index
UrlSrcFile=ThisFile
call DebugLine 'PROCESSING URL LIST: "' || ThisFile || '"'
CloseRc=stream(ThisFile, 'c', 'close')
OpenRc=stream(ThisFile, 'c', 'open read')
IeUrlObject='N'
ThisLineNumber=0
do while lines(ThisFile)<>0
OneUrl=strip(linein(ThisFile))
ThisLineNumber=ThisLineNumber+1
if ThisLineNumber=1 then
do
if right(translate(ThisFile),4)='.URL' & left(strip(OneUrl), 1) = '[' then
do
UrlSrcFile='IE SHORTCUT: ' ||left(UrlSrcFile,length(UrlSrcFile)-4)
IeUrlObject='Y'
end
end
if OneUrl='' then
iterate
call DebugLine '#' || ThisLineNumber || ' ' ||OneUrl
if left(OneUrl,1)=';' then
do
if left(OneUrl,length(PragmaSrcUrl))=PragmaSrcUrl then
do
UrlSrcFile=substr(OneUrl,length(PragmaSrcUrl)+1)
end
iterate
end
if IeUrlObject='N' then
do
UrlCount=UrlCount+1
Url.UrlCount=OneUrl
UrlSrc.UrlCount=UrlSrcFile
end
else
do
OneUrl=strip(OneUrl)
OneUrlU=translate(OneUrl)
if left(OneUrlU,4)='URL=' then
do
OneUrl=substr(OneUrl,5)
UrlCount=UrlCount+1
Url.UrlCount=OneUrl
UrlSrc.UrlCount=UrlSrcFile
leave
end
end
end
CloseRc=stream(ThisFile, 'c', 'close')
end
Url.0=UrlCount
UrlSrc.0=UrlCount
call ProcessUrlArray
leave
end
otherwise
PgmRc='Unknown command of "' || TheCmd || '"!'
end
call LoggedExit(PgmRc)

GetInputFilesMatchingMasks:
NumberOfMasks=0
NumberFiles=0
do ParmIndex=2 to ParmCount
NumberOfMasks=NumberOfMasks+1
ThisMask=Parm.ParmIndex
if left(ThisMask,1)<> '+' then
SubDirFlag=''
else
do
SubDirFlag='S'
ThisMask=substr(ThisMask,2)
end
ThisList.0=0
call _SysFileTree ThisMask, 'ThisList', 'F' ||SubDirFlag
do Index=1 to ThisList.0
ThisInFile=ThisList.Index
if KeyGetInfo("EXFILE", ThisInFile) == "<KeyedVarUnknown>" then
do
NumberFiles=NumberFiles+1
FileList.NumberFiles=ThisInFile
end
end
end
if NumberOfMasks=0 then
return('No file masks for URL lists were supplied!')
if NumberFiles=0 then
return('No files matched any of the URL list masks!')
return('')

ProcessUrlArray:
if UrlCount>1 then
do
call SayAndDebugLine 'Sorting ' || AddCommasToDecimalNumber(UrlCount) || ' URLs...'
SrtM=1
SrtCount=URL.0
do while(9*SrtM+4)<SrtCount
SrtM=SrtM*3+1
end
do while SrtM>0
SrtK=SrtCount-SrtM
do SrtJ=1 to SrtK
SrtIndex1=SrtJ
do while SrtIndex1>0
SrtIndex2=SrtIndex1+SrtM
SrtGreater=URL.SrtIndex1>URL.SrtIndex2
if SrtGreater then
do
SrtTemp=URL.SrtIndex1;URL.SrtIndex1=URL.SrtIndex2;URL.SrtIndex2=SrtTemp;SrtTemp=URLSRC.SrtIndex1;URLSRC.SrtIndex1=URLSRC.SrtIndex2;URLSRC.SrtIndex2=SrtTemp
end
else
leave
SrtIndex1=SrtIndex1-SrtM
end
end
SrtM=SrtM%3
end
end
UrlUniqueCount=0
LastUrl=''
do Index=1 to UrlCount
OneUrl=Url.Index
if OneUrl=LastUrl then
iterate
LastUrl=OneUrl
UrlUniqueCount=UrlUniqueCount+1
end
call SayAndDebugLine 'Have ' || AddCommasToDecimalNumber(UrlUniqueCount) || ' unique URLs...'
call SayAndDebugLine ''
call MemoryOpen
PgmRc=0
LastUrl=''
LastUrlRc='OK'
UrlNumber=0
UrlTimedOutCount=0
ErrorsInRow=0
NumbSinceCheckpoint=0
do Index=1 to UrlCount
OneUrl=Url.Index
if OneUrl=LastUrl then
do
if LastUrlRc<> 'OK' then
do
ThisSrc=UrlSrc.Index
SameSrc='N'
do CheckIndex=ErrorUrlIndex to Index-1
if UrlSrc.CheckIndex=ThisSrc then
do
SameSrc='Y'
leave
end
end
if SameSrc='N' then
do
call SayAndDebugLine '     Src: ' ||ThisSrc
call Line2ErrorFile ';      URL from ' ||ThisSrc
end
end
iterate
end
LastUrl=OneUrl
if NeedToReTestUrl(OneUrl)='' then
do
LastUrlRc='OK'
iterate
end
IgnoreThis=KeyGetInfo("IGNORE",OneUrl)
if IgnoreThis<> "<KeyedVarUnknown>" then
do
LastUrlRc='OK'
iterate
end
UrlNumber=UrlNumber+1
if ErrorsInRow>=5|UrlNumber=1 then
do
ErrorsInRow=0
if OnlineTestUrl<> '' then
do
if UrlNumber<>1 then
do
call MemoryClose
end
call SayAndDebugLine ''
call SayAndDebugLine 'Oneline? - Testing "' || OnlineTestUrl || '"'
TestUrlRc=CheckUrl(OnlineTestUrl)
if TestUrlRc='OK' then
call SayAndDebugLine '   * We seem to be online!'
else
do
call SayAndDebugLine '   * Failed: ' ||TestUrlRc
call SayAndDebugLine '   * Assuming not online'
PgmRc=9999
leave
end
end
end
call SayAndDebugLine ''
call SayAndDebugLine 'Checking: #' || UrlNumber || ' "' || OneUrl || '"'
UrlRc=CheckUrl(OneUrl)
call SayAndDebugLine '      Rc: ' ||UrlRc
call DebugLine ''
call DebugLine ''
if UrlRc='OK' then
do
call SaveUrlOkInformation OneUrl
ErrorsInRow=0
end
else
do
PgmRc=PgmRc+1
ErrorUrlIndex=Index
ErrorsInRow=ErrorsInRow+1
call SaveUrlFailedInformation OneUrl,UrlRc
call Line2ErrorFile ''
call Line2ErrorFile PragmaSrcUrl||UrlSrc.Index
call Line2ErrorFile OneUrl
call Line2ErrorFile ';      ' ||UrlRc
call Line2ErrorFile ';      URL from ' ||UrlSrc.Index
call SayAndDebugLine '     Src: ' ||UrlSrc.Index
ErrType=!CheckUrl.!ErrorType
if !CheckUrl.!ErrorType='Timeout' then
do
UrlTimedOutCount=UrlTimedOutCount+1
!UrlTimedOut.UrlTimedOutCount.!URL=OneUrl
end
else
do
if !CheckUrl.!CanOverride='Y' then
do
OrErrType=ReplaceString(ErrType, " ", "_")
Override=';      /OKRESPONSES: ' || OrErrType || '  ' ||OneUrl
if !CheckUrl.!UrlMovedTo<> '' then
do
Override=Override|| '  ' ||!CheckUrl.!UrlMovedTo
end
call Line2ErrorFile Override
end
end
if IgnoreFor<>0 then
do
IgYYYYMMDD=bd2date(basedate()+IgnoreFor)
parse var IgYYYYMMDD IgYYYY+4 IgMM+2 IgDD
IgDate=IgYYYY|| '/' || IgMM || '/' ||IgDD
ForCusPaste=';      IGNORE ' || OneUrl || '   ' || IgDate || '  ' ||UrlRc
call Line2ErrorFile ForCusPaste
end
do
if ErrType='' then
ErrType="UNKNOWN!"
if !CheckUrl.!UrlMovedTo<> '' then
ErrType="Url Moved"
ErrTypeDesc=GetServerErrorDescription(ErrType)
if ErrTypeDesc<> '' then
ErrType=ErrType|| ' (' || ErrTypeDesc || ')'
ErrKey='EK_' ||c2x(ErrType)
if symbol(ErrKey)<> 'VAR' then
do
call value ErrKey, "0"
ErrorTypeCnt=ErrorTypeCnt+1
!ErrorTypeLst.ErrorTypeCnt=ErrType
end
NewValue=value(ErrKey)+1
call value ErrKey,NewValue
end
end
LastUrlRc=UrlRc
NumbSinceCheckpoint=NumbSinceCheckpoint+1
if NumbSinceCheckpoint>=CheckPointFrequency then
do
NumbSinceCheckpoint=0
call DebugLine ''
call DebugLine 'Checkpointing again for safety!'
call MemoryClose
end
end
if UrlTimedOutCount<>0&ReadTimeout2<>0 then
do
call MemoryClose
ToTestCnt=UrlTimedOutCount
ReadTimeout=ReadTimeout2
do TimedOutIndex=1 to ToTestCnt
OneUrl=!UrlTimedOut.TimedOutIndex.!URL
call SayAndDebugLine ''
call SayAndDebugLine 'ReTesting: "' || OneUrl || '"'
UrlRc=CheckUrl(OneUrl)
call SayAndDebugLine '       Rc: ' ||UrlRc
if UrlRc='OK' then
do
PgmRc=PgmRc-1
UrlTimedOutCount=UrlTimedOutCount-1
call SaveUrlOkInformation OneUrl
end
else
do
call SaveUrlFailedInformation OneUrl,UrlRc
end
end
end
if PgmRc<>9999 then
do
call SayAndDebugLine ''
call SayAndDebugLine ''
if PgmRc<>0 then
do
if ErrorTypeCnt<>0 then
do
call SayAndDebugLine ""
call SayAndDebugLine ""
Title=PgmRc|| ' Failures out of ' || UrlNumber || ' URLs tested'
call SayAndDebugLine Title
call SayAndDebugLine copies('~',length(Title))
NumberWidth=length(ErrorTypeCnt)
do ErrIndex=1 to ErrorTypeCnt
ErrType=!ErrorTypeLst.ErrIndex
ErrKey='EK_' ||c2x(ErrType)
ErrNum=value(ErrKey)
call SayAndDebugLine right(ErrNum,NumberWidth)|| ' x ' ||ErrType
end
end
end
else
do
if UrlNumber=0 then
call SayAndDebugLine 'No URLs needed checking.'
else
call SayAndDebugLine 'No failures (' || UrlNumber || ' urls checked)'
end
end
call MemoryClose
return

GetInteger:
if datatype(arg(2), 'W')=0 then
CryAndDie(RexOptionChar||arg(1)|| ' given an invalid value of "' || arg(2) || '"')
return(strip(arg(2)))

SwitchOptionsValidateAgainstList:
TheCmd=arg(1)
TheOption=translate(arg(2))
ValidList=',' || translate(arg(3)) || ','
if pos(',' || TheOption || ',',ValidList)<>0 then
return(TheOption)
UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || RexOptionChar || TheCmd || '" switch!')

SwitchWantsYesOrNo:
TheCmd=arg(1)
TheOption=translate(arg(2))
Default=arg(3)
if TheOption='' then
return(Default)
else
return(left(SwitchOptionsValidateAgainstList(TheCmd,TheOption, "Y,N,YES,NO"),1))

Line2ErrorFile:
if ErrorFileName<> '' then
do
call _lineout ErrorFileName,arg(1)
call stream ErrorFileName, 'c', 'close'
end
return

SayAndDebugLine:
if arg(1)<> '' then
LastLineWasBlank='N'
else
do
if LastLineWasBlank='Y' then
return
else
LastLineWasBlank='Y'
end
say arg(1)
call DebugLine 'SAID: ' ||arg(1)
return

DebugLine:
call DebugLineNoTime time()|| ': ' ||arg(1)
return

DebugLineNoTime:
if DebugFileName<> '' then
do
call _lineout DebugFileName,arg(1)
call stream DebugFileName, 'c', 'close'
end
return

DebugChars:
if DebugFileName<> '' then
do
call charout DebugFileName,arg(1)
call stream DebugFileName, 'c', 'close'
end
return

ValidIpByte:
IpByte=arg(1)
if datatype(IpByte, 'W')=0 then
return('N')
if IpByte<0|IpByte>255 then
return('N')
return('Y')

CheckUrl:
!CheckUrl.!LastModified=''
!CheckUrl.!ErrorType=''
!CheckUrl.!CanOverride='N'
!CheckUrl.!UrlMovedTo=''
ProcessingThisUrl=arg(1)
if abbrev(ProcessingThisUrl, 'ftp://')then
do
if left(RexSystemOpSys,3)="WIN" then
do
call DebugLine "Can't check FTP urls under windows yet - flagging as OK"
return("OK")
end
if HaveFtp<> '' then
CurlRc=HaveFtp
else
CurlRc=CheckUrlFtp(ProcessingThisUrl)
end
else
do
if HaveSockets<> '' then
CurlRc=HaveSockets
else
CurlRc=CheckUrlHttp(ProcessingThisUrl)
end
ProcessingThisUrl=''
return(CurlRc)

CheckUrlFtp:
FullUrl=arg(1)
parse var FullUrl 'ftp://' FtpServer '/' FullFileName
SlashPos=lastpos('/',FullFileName)
if SlashPos=0 then
do
FileDir='/'
FileShort=FullFileName
end
do
FileDir='/' ||left(FullFileName,SlashPos)
FileShort=substr(FullFileName,SlashPos+1)
end
if FtpEmailAddress<> '' then
EmailAddress=FtpEmailAddress
else
EmailAddress=ShortRexxSrcName|| '@email.address.not.known'
FtpRc=FtpSetUser(FtpServer, 'Anonymous',EmailAddress)
if FtpRc=0 then
return('Could not set up the user info (email address etc)')
FtpRc=ftpchdir(FileDir)
if FtpRc<>0 then
FtpExit='Could not change to "' || FileDir || '" (' || GetFtpError() || ')'
else
do
if FileShort='' then
FtpExit='OK'
else
do
FtpFile.0=0
call FTPLs FileShort, "FtpFile."
if FtpRc<>0 then
FtpExit='Could not find "' || FileShort || '" (' || GetFtpError() || ')'
else
do
if FtpFile.0=1 then
FtpExit='OK'
else
do
FtpRc=ftpchdir('/' ||FullFileName)
if FtpRc<>0 then
FtpExit='Could not find "' || FileShort || '" in directory ' ||FileDir
else
FtpExit='OK'
end
end
end
end
call FtpLogoff
return(FtpExit)

CheckUrlHttp:
FullUrl=arg(1)
parse var FullUrl HttpPrefix '://' httpServer '/' HttpPageAddr
parse var httpServer httpServer ':' HttpPort
if HttpPort='' then
HttpPort=80
parse var HttpPageAddr HttpPageAddr '#'
parse var httpServer Byte1 '.' Byte2 '.' Byte3 '.' Byte4
if ValidIpByte(Byte1)='Y' & ValidIpByte(Byte2) = 'Y' & ValidIpByte(Byte3) = 'Y' & ValidIpByte(Byte4) = 'Y' then
httpServerDotted=httpServer
else
do
SocketRc=SockGetHostByName(httpServer, 'httpServer_')
if SocketRc=0 then
do
call DebugLine 'SockGetHostByName(' || httpServer || ') failed - ' || GetSockError() || ', DNS unavailable?'
!CheckUrl.!ErrorType="Server Name Unknown"
return('Server name "' || httpServer || '" unknown')
end
httpServerDotted=httpServer_addr
end
if DebugFileName<> '' then
do
call DebugLine ''
call DebugLine copies('=',79)
call DebugLine ''
call DebugLine 'Details'
call DebugLine '~~~~~~~'
call DebugLine 'Full URL    :' ||FullUrl
call DebugLine 'Server Name :' ||httpServer
call DebugLine 'Server IP   :' ||httpServerDotted
call DebugLine 'Port        :' ||httpPort
call DebugLine 'Page        :' ||HttpPageAddr
call DebugLine ''
end
SocketHandle=SockSocket('AF_INET', 'SOCK_STREAM', 'IPPROTO_TCP')
SvrAddr.!family='AF_INET'
SvrAddr.!port=HttpPort
SvrAddr.!addr=httpServerDotted
SocketRc=SockConnect(SocketHandle, 'SvrAddr.!')
if SocketRc=-1 then
do
SocketRc=SockClose(SocketHandle)
!CheckUrl.!ErrorType="Could Not Open Socket"
return('Could not open socket for "' || httpServer || '"')
end
if UseHead='Y' then
do
RequestMsg='HEAD /' || HttpPageAddr || ' HTTP/1.0' ||CrLf||,
'User-Agent: ' ||HttpUserAgent||CrLf||,
'Host: ' || httpServer || ':' ||HttpPort||CrLf||,
'Accept: */*' ||CrLf||,
CrLf
end
else
do
RequestMsg='GET /' || HttpPageAddr || ' HTTP/1.0' ||CrLf||,
'User-Agent: ' ||HttpUserAgent||CrLf||,
'Host: ' || httpServer || ':' ||HttpPort||CrLf||,
'Accept: */*' ||CrLf||,
CrLf
end
SocketRc=SockSend(SocketHandle,RequestMsg)
if(SocketRc=-1)then
do
SocketRc=SockClose(SocketHandle)
!CheckUrl.!ErrorType="Error Sending Page Request"
return('Error sending page request to "' || httpServer || '" (' || GetSockError() || ')')
end
call Time('R')
if DebugFileName<> '' then
do
call DebugLine 'Sent'
call DebugLine '~~~~'
call DebugLine RequestMsg
call DebugLine ''
end
ServersResponse=''
WaitFor=ReadTimeout
do until ThisBit==''
if length(ServersResponse)>=MaxBytesInPage then
do
ServersResponse=ServersResponse|| '<=Truncated here, page too long!'
leave
end
WaitRead.0=1
WaitRead.1=SocketHandle
SocketRc=SockSelect( "WaitRead.", "", "",WaitFor)
if SocketRc=0 then
do
if WaitFor=1 then
leave
SocketRc=SockClose(SocketHandle)
!CheckUrl.!ErrorType='Timeout'
return('Timed out (waited ' || ReadTimeout || ' seconds).')
end
WaitFor=1
ThisBit=''
SocketRc=SockRecv(SocketHandle, 'ThisBit',1024)
ServersResponse=ServersResponse||ThisBit
end
ReadTook=GetElapsedTime()
SocketRc=SockClose(SocketHandle)
if(SocketRc=-1)then
do
!CheckUrl.!ErrorType="Error Reading Server Response"
return('Error reading response from "' || httpServer || '" (' || GetSockError() || ')')
end
ServersResponseLng=length(ServersResponse)
ServersResponse=ReplaceString(ServersResponse,Cr, '')
if DebugFileName<> '' then
do
MsgTxt='Received ' || AddCommasToDecimalNumber(ServersResponseLng) || ' bytes, Took ' || ReadTook || ' seconds'
call DebugLine MsgTxt
call DebugLine copies('~',length(MsgTxt))
call DebugChars ReplaceString(ServersResponse,Lf,CrLf)||CrLf
call DebugLine ''
end
EolPos=EolPos(ServersResponse)
if EolPos=0 then
ServersResponse1stLine=ServersResponse
else
ServersResponse1stLine=left(ServersResponse,EolPos-1)
ServerRc=word(ServersResponse1stLine,2)
AddCode='Y'
if ServerRc='200' then
do
ServersResponseU=translate(ServersResponse)
do TxtIndex=1 to MovedTxt.0
if pos(MovedTxtU.TxtIndex,ServersResponseU)<>0 then
do
!CheckUrl.!UrlMovedTo='?'
ServerRc='MOVED?'
UrlRcText=ServerRc|| ' - Page contained "' || MovedTxt.TxtIndex || '"'
leave
end
end
Look4=translate('http-equiv="Refresh"')
Look4Pos=pos(Look4,ServersResponseU)
if Look4Pos<>0 then
do
EndMetaTagPos=pos('>',ServersResponseU,Look4Pos)
if EndMetaTagPos<>0 then
do
LeftBit=left(ServersResponseU,EndMetaTagPos)
MetaTagPos=lastpos('<',LeftBit)
if MetaTagPos<>0 then
do
MetaTag=substr(ServersResponse,MetaTagPos,(EndMetaTagPos-MetaTagPos)+1)
MetaTagU=substr(ServersResponseU,MetaTagPos,(EndMetaTagPos-MetaTagPos)+1)
ContPos=pos('CONTENT=',MetaTagU)
if ContPos<>0 then
do
ContPos=ContPos+7
SearchIn=substr(MetaTag,ContPos)
parse var SearchIn '="' ContentValue ';' . '=' MetaNewUrl '"' MetaRest
if MetaRest<> '' then
do
if datatype(ContentValue, 'W')then
do
if ContentValue<=10 then
do
!CheckUrl.!UrlMovedTo=MetaNewUrl
ServerRc='MOVED?'
UrlRcText=ServerRc|| ' - Meta tag = ' ||MetaTag
end
end
end
end
end
end
end
end
select
when ServerRc='200' then
do
AddCode='N'
UrlRcText='OK'
call GetLastModifiedTimeFromOkResponse
end
when ServerRc='MOVED?' then
do
AddCode='N'
end
when ServerRc='400' then
UrlRcText='BAD REQUEST'
when ServerRc='403' then
do
UrlRcText='ACCESS DENIED'
if translate(HttpPrefix)='HTTPS' then
do
AddCode='N'
UrlRcText='OK'
end
end
when ServerRc='404' then
UrlRcText='URL NOT FOUND'
when ServerRc='503' then
UrlRcText='SERVICE UNAVAILABLE'
when ServerRc='301' | ServerRc='302' then
do
if ServerRc='301' then
UrlRcText='PERMANENT'
else
UrlRcText='TEMPORARY'
parse var ServersResponse . 'Location: ' Rest
CrPos=pos('0D'x,Rest)
NlPos=pos('0A'x,Rest)
if CrPos<>0 then
EndPos=CrPos
else
EndPos=NlPos
if EndPos=0 then
NewLocation='?'
else
NewLocation=left(Rest,EndPos-1)
if left(NewLocation,1)='/' then
do
NewLocation=HttpPrefix|| '://' ||httpServer
end
if NewLocation=FullUrl|| '/' then
UrlRcText='Add terminating "/" for performance'
else
do
if NewLocation=FullUrl then
do
call DebugLine 'Stupid Site returned #' || ServerRc || ', but returned same address!'
AddCode='N'
UrlRcText='OK'
call GetLastModifiedTimeFromOkResponse
end
else
do
MsgFormatted='N'
if pos('?',FullUrl)<>0 then
do
parse var FullUrl BeforeQm '?' AfterQm
TestUrl=BeforeQm|| '/?' ||AfterQm
if NewLocation=TestUrl then
do
UrlRcText='Add "/" before "?" for performance'
MsgFormatted='Y'
end
end
if MsgFormatted='N' then
do
if NewLocation|| '/' =FullUrl then
do
call DebugLine 'Stupid Site returned #' || ServerRc || ', but returned same address minus terminating slash!'
AddCode='N'
UrlRcText='OK'
MsgFormatted='Y'
call GetLastModifiedTimeFromOkResponse
end
end
if MsgFormatted='N' then
do
UrlRcText=UrlRcText|| ' move to ' ||NewLocation
!CheckUrl.!UrlMovedTo=NewLocation
end
end
end
end
otherwise
do
if translate(left(ServersResponse1stLine,5))='HTTP/' & datatype(ServerRc, 'W')=1 then
do
UrlRcText=subword(ServersResponse1stLine,3)
end
else
do
if MaxLineDump<>0 then
do
LineCounter=0
StartPos=1
say ' ------- UNKNOWN RESPONSE DUMP - START -------'
do until EolPos=0|LineCounter>MaxLineDump
EolPos=EolPos(ServersResponse,StartPos)
if EolPos=0 then
LineTxt=substr(ServersResponse,StartPos)
else
do
LineTxt=substr(ServersResponse,StartPos,EolPos-StartPos)
StartPos=EolPos+1
do while EolPos(ServersResponse,StartPos)=StartPos
StartPos=StartPos+1
end
end
if LineTxt<> '' then
do
LineCounter=LineCounter+1
call SayAndDebugLine right(LineCounter,2, '0') || ': ' ||LineTxt
end
end
say ' ------- UNKNOWN RESPONSE DUMP - END ---------'
end
AddCode='N'
UrlRcText='Problem unknown ==>' ||ServersResponse1stLine
end
end
end
if ServerRc<> '200' then
do
!CheckUrl.!CanOverride='Y'
ReallyOk=KeyGetInfo("OK" ||c2x(translate(ServerRc)),FullUrl)
if ReallyOk<> "<KeyedVarUnknown>" then
do
if ServerRc<> '301' & ServerRc <> '302' & ServerRc <> 'MOVED?' then
ServerRc='200'
else
do
if ReallyOk='' |ReallyOk=!CheckUrl.!UrlMovedTo then
ServerRc='200'
end
if ServerRc='200' then
do
call DebugLine "Ignoring server's response of " || ServerRc || ' (in OK list)'
AddCode='N'
UrlRcText='OK'
!CheckUrl.!UrlMovedTo=''
call GetLastModifiedTimeFromOkResponse
end
end
end
!CheckUrl.!ErrorType=ServerRc
if AddCode='Y' then
HttpRc='#' || ServerRc || ' - ' ||UrlRcText
else
HttpRc=UrlRcText
return(HttpRc)

GetLastModifiedTimeFromOkResponse:
LookFor="Last-Modified:"
LastModPos=pos(LookFor,ServersResponse)
if LastModPos=0 then
do
call DebugLine 'Could not find "' || LookFor || '"'
!CheckUrl.!LastModified=''
end
else
do
StartPos=LastModPos+length(LookFor)
EolPos=EolPos(ServersResponse,StartPos)
if EolPos=0 then
!CheckUrl.!LastModified=substr(ServersResponse,StartPos)
else
!CheckUrl.!LastModified=substr(ServersResponse,StartPos,EolPos-StartPos)
!CheckUrl.!LastModified=strip(!CheckUrl.!LastModified)
call DebugLine 'Page last modified "' || !CheckUrl.!LastModified || '"'
end
return

GetSockError:
if RexWhich='STANDARD_OS/2' then
SockRc=errno|| '/' ||h_errno
else
SockRc=SockSock_Errno()
return(SockRc)

GetFtpError:
select
when FTPERRNO="FTPHOST"       then return("unknown host")
when FTPERRNO="FTPCONNECT"    then return("unable to connect to server")
when FTPERRNO="FTPLOGIN"      then return("login failed")
when FTPERRNO="FTPPROXYTHIRD" then return("proxy server does not support 3rd party transfers")
when FTPERRNO="FTPNOPRIMARY"  then return("no primary connection for proxy transfer")
otherwise return(FTPERRNO)
end

EolPos:
_StartPos=arg(2)
if _StartPos='' then
_StartPos=1
_CrPos=pos('0D'x,arg(1),_StartPos)
_LfPos=pos('0A'x,arg(1),_StartPos)
if _CrPos=0|_LfPos=0 then
return(max(_CrPos,_LfPos))
else
return(min(_CrPos,_LfPos))

GetElapsedTime:
signal on SYNTAX name ElapsedTimeBugWorkaround
getTime=time('E')
return(trunc(getTime,2))

ElapsedTimeBugWorkaround:
return('?')

InitializeSocketSupport:
call RxFuncAdd "SockLoadFuncs", "RxSock.DLL", "SockLoadFuncs"
signal on SYNTAX name RxSockDllMissing
if RexWhich='STANDARD_OS/2' then
call SockLoadFuncs "NoCopyrightDisplayEtc"
else
call SockLoadFuncs
return('')

RxSockDllMissing:
if RexWhich='STANDARD_OS/2' then
return("Can't locate RxSock.DLL")
else
return("Can't locate RxSock.DLL, Get from 'http://home.hiwaay.net/~abbott/regina/'")

InitializeFtpSupport:
call RxFuncAdd "FtpLoadFuncs", "RxFtp.DLL", "FtpLoadFuncs"
signal on SYNTAX name RxFtpDllMissing
call FtpLoadFuncs "NoCopyrightDisplayEtc"
return('')

RxFtpDllMissing:
return("Can't locate RxFtp.DLL")

ReplaceAnyFileNameSymbols:
parse value time('N') with Hours ':' Minutes ':' Seconds
CurrentTime=Hours||Minutes||Seconds
TmpDate=date('N')
parse var TmpDate TmpDD TmpMon TmpYYYY
CurrentDate=right(TmpYYYY,2)||TmpMon||TmpDD
CurrentDateNumb=date('S')
NewText=ReplaceString(arg(1), "{Time}",CurrentTime)
NewText=ReplaceString(NewText, "{DateNumbers}",CurrentDateNumb)
NewText=ReplaceString(NewText, "{Date}",CurrentDate)
return(NewText)

AddCommasToDecimalNumber:procedure
NoComma=strip(arg(1))
if pos(',',NoComma)<>0 then
return(NoComma)
DotPos=pos('.',NoComma)
if DotPos=0 then
AfterDecimal=''
else
do
if DotPos=1 then
return("0" ||NoComma)
AfterDecimal=substr(NoComma,DotPos+1)
NoComma=left(NoComma,DotPos-1)
end
NoComma=reverse(NoComma)
ResultWithCommas=""
do while length(NoComma)>3
ResultWithCommas=ResultWithCommas||left(NoComma,3)|| ','
NoComma=substr(NoComma,4)
end
ResultWithCommas=ResultWithCommas||NoComma
ResultWithCommas=reverse(ResultWithCommas)
if AfterDecimal<> '' then
ResultWithCommas=ResultWithCommas|| '.' ||AfterDecimal
return(ResultWithCommas)

ReplaceString:
TheString=arg(1)
ChangeFrom=arg(2)
ChangeTo=arg(3)
ChangeFromLength=length(ChangeFrom)
ChangeToLength=length(ChangeTo)
FoundPosn=pos(ChangeFrom,TheString)
do while FoundPosn<>0
TheString=left(TheString,FoundPosn-1)||ChangeTo||substr(TheString,FoundPosn+ChangeFromLength)
FoundPosn=pos(ChangeFrom,TheString,FoundPosn+ChangeToLength)
end
return(TheString)

CloseAndDeleteFile:
dfFile=arg(1)
CloseRc=stream(dfFile, 'c', 'close')
DosDelRc=_SysFileDelete(dfFile)
return(DosDelRc)

DebugAddressCmdBefore:
call DebugLine 'Executing: ' ||arg(1)
return

DebugAddressCmdOutput:
DbgLineNumber=arg(2)
if datatype(DbgLineNumber, 'W')=0 then
call DebugLine '  > ' ||arg(1)
else
do
if DbgLineNumber<999 then
DbgLineNumber=right(DbgLineNumber,3, '0')
call DebugLine '  > ' || DbgLineNumber || ': ' ||arg(1)
end
return

DebugAddressCmdAfter:
call DebugLine '  Rc = ' ||arg(1)
return

_Lineout:
loFileName=arg(1)
loTheLine=arg(2)
if 0<>lineout(loFileName,loTheLine)then
do
if Dying='N' then
do
FileState=stream(loFileName, 'Description')
CryAndDie('Failed writing line to "' || loFileName || '" - ' ||FileState)
end
end
return

CryAndDie:
signal off HALT
call on HALT name RexxCtrlCIgnore
ExitRc=SIGL
Dying='Y'
call SayAndDebugLine "ERROR: " ||arg(1)
if MemoryNeedsUpdating()='Y' then
do
call MemoryClose
end
call LoggedExit(ExitRc)

LoggedExit:
PgmRc=arg(1)
OrigPgmRc=PgmRc
if RexWhich='REGINA' then
do
if PgmRc='OK' then
PgmRc=0
else
PgmRc=1000+length(PgmRc)
end
call DebugLine ''
call DebugLine 'Return code'
call DebugLine '~~~~~~~~~~~'
if OrigPgmRc=PgmRc then
call DebugLine PgmRc
else
call DebugLine PgmRc|| ' , translated from => ' ||OrigPgmRc
call DebugLine ''
exit(PgmRc)

SetupMovedText:
NewMovedText=arg(1)
if NewMovedText='' then
do
call DebugLine ''
call DebugLine 'Initialised "MovedText"'
MovedTxt.0=0
end
else
do
Index=MovedTxt.0+1
MovedTxt.Index=NewMovedText
MovedTxtU.Index=translate(NewMovedText)
MovedTxt.0=Index
call DebugLine 'Added "MovedText" of "' || NewMovedText || '"'
end
return

ReplaceCommandLineCodes:
RightBit=arg(1)
LeftBit=''
StartPos=pos('{x',RightBit)
do while StartPos<>0
Codes2=substr(RightBit,StartPos+2,2)
if datatype(Codes2, 'X') <> 1 | substr(RightBit, StartPos+4, 1) <> '}' then
do
LeftBit=LeftBit||left(RightBit,StartPos+1)
RightBit=substr(RightBit,StartPos+2)
end
else
do
LeftBit=LeftBit||left(RightBit,StartPos-1)||x2c(Codes2)
RightBit=substr(RightBit,StartPos+5)
end
StartPos=pos('{x',RightBit)
end
return(LeftBit||RightBit)

GetServerErrorDescription:
f_ErrType=arg(1)
f_Rc=''
select
when f_ErrType='404' then
f_Rc='URL Not Found'
otherwise
end
return(f_Rc)

MyLineNumber:
return(SIGL)

DisplayCopyright:
if CopyrightDisplayed='N' then
do
say '[]-------------------------------------------------------------------------[]'
say '| CHECKURL.REX: Version ' || PgmVersion || ' (C)opyright Dennis Bareis 2000               |'
say '| http://www.labyrinth.net.au/~dbareis/index.htm ([e-mail]) |'
say '[]-------------------------------------------------------------------------[]'
CopyrightDisplayed='Y'
end
return

UserSyntaxError:
call DisplayCopyright
say "SYNTAX ERROR"
say "~~~~~~~~~~~~"
say '    ' ||arg(1)
say ''
say 'CORRECT SYNTAX'
say '~~~~~~~~~~~~~~'
say '    CHECKURL[.CMD] Command [Parm1 ...] [Option1 ...]'
say ''
say 'SOME OPTIONS'
say '~~~~~~~~~~~~'
say RexOptionChar|| 'ErrorFile[:[+]FileName] = Generate list of error URLs'
say RexOptionChar|| 'MemoryFile[:FileName]   = Long term memory of results'
say RexOptionChar|| 'CheckDays[:Period]      = Controls how long term memory used'
say RexOptionChar|| 'TestUrl[:Url]           = Define known URL which exists'
say RexOptionChar|| 'ReadTimeout:Seconds     = Define read timeout'
say RexOptionChar|| 'GetEnv:NameOfVariable   = Specify source of more options'
say ''
say 'Please see "CHECKURL.HTM" for more details (and more options).' ||Beep||Beep
LoggedExit(MyLineNumber())

RexxTrapAddInfo:
if symbol('ProcessingThisUrl') = 'VAR' then
do
if ProcessingThisUrl<> '' then
call SayAndDebugLine left('URL', 16) || ': ' ||ProcessingThisUrl
end
return

RexxTrapDying:
call charout,Beep||Beep
call LoggedExit arg(1)

RexxCtrlC:
IgnoredCount=0
LineCtrlC=SIGL
signal off HALT
call on HALT name RexxCtrlCIgnore
call SayAndDebugLine ''
call SayAndDebugLine copies('=+',39)
call SayAndDebugLine "Come on, you pressed Ctrl+C or Break didn't you!"
call SayAndDebugLine copies('=+',39)
if MemoryNeedsUpdating()='Y' then
do
say ''
say 'Please wait while INI is updated....'
call MemoryClose
say ''
say 'Phew... Lucky Phil, INI file update completed!'
end
exit(LineCtrlC)

RexxCtrlCIgnore:
IgnoredCount=IgnoredCount+1
call off HALT
call on HALT name RexxCtrlCIgnore
if IgnoredCount<>1 then
say "Some people just don't listen!"
say 'WARNING: Please wait while INI is updated....'
return