home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / ppwizard.zip / ppwcurl.cmd < prev    next >
OS/2 REXX Batch file  |  2000-02-23  |  59KB  |  2,493 lines
  1. /*
  2.  * Generator   : PPWIZARD version 2K.050
  3.  *             : FREE tool for OS/2, Windows, DOS and UNIX by Dennis Bareis (dbareis@labyrinth.net.au)
  4.  *             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
  5.  * Time        : Wednesday, 23 Feb 2000 6:34:37pm
  6.  * Input File  : E:\DB\PROJECTS\OS2\ppwizard\PPWCURL.X
  7.  * Output File : .\OUT\ppwcurl.cmd
  8.  */
  9.  
  10. if arg(1)="!CheckSyntax!" then exit(21924)
  11.  
  12. /*
  13. *$Header:E:/DB/PVCS.IT/OS2/PPWIZARD/PPWCURL.X_V 1.12 23 Feb 2000 18:30:08 Dennis_Bareis $
  14. */
  15. UserRequest=strip(arg(1))
  16. if translate(UserRequest)="DEBUG" then
  17. exit(0)
  18. PgmVersion='2K.050'
  19. LastLineWasBlank='Y'
  20. PragmaSrcUrl=";PRAGMA(URL_SOURCE)="
  21. ProcessingThisUrl=''
  22. DebugFileName=''
  23. IniFileName=''
  24. CopyrightDisplayed='N'
  25. Beep=d2c(7)
  26. Dying='N'
  27. /*
  28. *ADDCOMMA.XH Version 98.090 by Dennis Bareis
  29. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  30. */
  31. signal EndOfADDCOMMACode
  32.  
  33. AddCommasToDecimalNumber:procedure
  34. NoComma=strip(arg(1))
  35. if pos(',',NoComma)<>0 then
  36. return(NoComma)
  37. DotPos=pos('.',NoComma)
  38. if DotPos=0 then
  39. AfterDecimal=''
  40. else
  41. do
  42. if DotPos=1 then
  43. return("0" ||NoComma)
  44. AfterDecimal=substr(NoComma,DotPos+1)
  45. NoComma=left(NoComma,DotPos-1)
  46. end
  47. NoComma=reverse(NoComma)
  48. ResultWithCommas=""
  49. do while length(NoComma)>3
  50. ResultWithCommas=ResultWithCommas||left(NoComma,3)|| ','
  51. NoComma=substr(NoComma,4)
  52. end
  53. ResultWithCommas=ResultWithCommas||NoComma
  54. ResultWithCommas=reverse(ResultWithCommas)
  55. if AfterDecimal<> '' then
  56. ResultWithCommas=ResultWithCommas|| '.' ||AfterDecimal
  57. return(ResultWithCommas)
  58.  
  59. EndOfADDCOMMACode:
  60. /*
  61. *REXXTRAP.XH Version 99.287 by Dennis Bareis
  62. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  63. */
  64. signal on NOVALUE name _RexxTrapUninitializedVariable
  65. signal on SYNTAX name _RexxTrapSyntaxError
  66. /*
  67. *DUMPVAR.XH Version 99.339 by Dennis Bareis
  68. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  69. */
  70. /*
  71. *BIN2REXP.XH Version 99.134 by Dennis Bareis
  72. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  73. */
  74. b2rNewSingleQuote="' || " || '"' || "'" || '" || ' || "'"
  75. b2rAllHexCodes=''
  76. b2rAllAsciiCodes=''
  77. do b2rCharCode=0 to 31
  78. b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
  79. end
  80. do b2rCharCode=32 to 126
  81. b2rAllAsciiCodes=b2rAllAsciiCodes||d2c(b2rCharCode)
  82. end
  83. do b2rCharCode=127 to 255
  84. b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
  85. end
  86. signal EndBIN2REXPXh
  87.  
  88. _QuoteAscii:
  89. b2rAscii2Quote=arg(1)
  90. if pos("'",b2rAscii2Quote)=0 then
  91. return("'" || b2rAscii2Quote || "'")
  92. else
  93. do
  94. if pos('"',b2rAscii2Quote)=0 then
  95. return('"' || b2rAscii2Quote || '"')
  96. else
  97. do
  98. return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
  99. end
  100. end
  101.  
  102. _FormatHex:
  103. b2rHexString=arg(1)
  104. b2rLengthHex=length(b2rHexString)
  105. b2rFormattedHex="'"
  106. if b2rLengthHex>7 then
  107. do
  108. b2rLeft1=left(b2rHexString,1)
  109. b2rLeft1Pos=verify(b2rHexString,b2rLeft1)
  110. if b2rLeft1Pos=0 then
  111. return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
  112. else
  113. do
  114. if b2rLeft1Pos>7 then
  115. do
  116. b2rFormattedHex="copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
  117. b2rHexString=substr(b2rHexString,b2rLeft1Pos)
  118. b2rLengthHex=b2rLengthHex-(b2rLeft1Pos-1)
  119. end
  120. end
  121. end
  122. do b2rCharPosn=1 to b2rLengthHex
  123. if(b2rCharPosn//8)=1 then
  124. do
  125. if b2rCharPosn<>1 then
  126. b2rFormattedHex=b2rFormattedHex|| ' '
  127. end
  128. b2rFormattedHex=b2rFormattedHex||c2x(substr(b2rHexString,b2rCharPosn,1))
  129. end
  130. b2rFormattedHex=b2rFormattedHex|| "'x"
  131. return(b2rFormattedHex)
  132.  
  133. _QuoteAsciiBreakIfRequired:
  134. qabAscii=arg(1)
  135. qabLength=length(qabAscii)
  136. qabReturn=''
  137. do while qabLength>256
  138. qabLeft=left(qabAscii,256)
  139. qabAscii=substr(qabAscii,256+1)
  140. qabLength=qabLength-256
  141. if qabReturn='' then
  142. qabReturn=_QuoteAscii(qabLeft)
  143. else
  144. qabReturn=qabReturn|| " || " ||_QuoteAscii(qabLeft)
  145. end
  146. if qabLength=0 then
  147. return(qabReturn)
  148. else
  149. do
  150. if qabReturn='' then
  151. return(_QuoteAscii(qabAscii))
  152. else
  153. return(qabReturn|| " || " ||_QuoteAscii(qabAscii))
  154. end
  155.  
  156. _FormatHexBreakIfRequired:
  157. fhbHex=arg(1)
  158. fhbLength=length(fhbHex)
  159. fhbReturn=''
  160. do while fhbLength>80
  161. fhbLeft=left(fhbHex,80)
  162. fhbHex=substr(fhbHex,80+1)
  163. fhbLength=fhbLength-80
  164. if fhbReturn='' then
  165. fhbReturn=_FormatHex(fhbLeft)
  166. else
  167. fhbReturn=fhbReturn|| " || " ||_FormatHex(fhbLeft)
  168. end
  169. if fhbLength=0 then
  170. return(fhbReturn)
  171. else
  172. do
  173. if fhbReturn='' then
  174. return(_FormatHex(fhbHex))
  175. else
  176. return(fhbReturn|| " || " ||_FormatHex(fhbHex))
  177. end
  178.  
  179. BIN2REXP:
  180. call BIN2REXP_START
  181. b2rValue=arg(1)
  182. b2rValueLength=length(b2rValue)
  183. if b2rValueLength=0 then
  184. call BIN2REXP_ONEBIT '""'
  185. else
  186. do
  187. do while b2rValue\==''
  188. b2rEndAsciiPos=verify(b2rValue,b2rAllAsciiCodes)
  189. if b2rEndAsciiPos=0 then
  190. do
  191. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
  192. b2rValue=''
  193. end
  194. else
  195. do
  196. if b2rEndAsciiPos<>1 then
  197. do
  198. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue,b2rEndAsciiPos-1))
  199. b2rValue=substr(b2rValue,b2rEndAsciiPos)
  200. end
  201. else
  202. do
  203. b2rEndBinaryPos=verify(b2rValue,b2rAllHexCodes)
  204. if b2rEndBinaryPos=0 then
  205. do
  206. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
  207. b2rValue=''
  208. end
  209. else
  210. do
  211. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue,b2rEndBinaryPos-1))
  212. b2rValue=substr(b2rValue,b2rEndBinaryPos)
  213. end
  214. end
  215. end
  216. end
  217. end
  218. call BIN2REXP_END
  219. return
  220.  
  221. EndBIN2REXPXh:
  222. signal EndDUMPVARXh
  223.  
  224. DumpVarsInExpression:
  225. dv_RexxExp=arg(1)
  226. dv_Stem=translate(arg(2))
  227. dv_VarHeading=arg(3)
  228. dv_LineRoutine=arg(4)
  229. if dv_Stem<> '' then
  230. do
  231. dv_AutoDump='N'
  232. dv_StemDot=dv_Stem|| '.'
  233. if symbol(dv_StemDot|| '0') = 'VAR' then
  234. dv_VarCount=value(dv_StemDot|| '0')
  235. else
  236. do
  237. call _DumpVarsLineOutput 'DumpVar: Could not find "' || dv_StemDot || '0' || '"'
  238. return(0)
  239. end
  240. end
  241. else
  242. do
  243. dv_AutoDump='Y'
  244. dv_Stem='DV_VARLIST'
  245. dv_StemDot=dv_Stem|| '.'
  246. dv_VarCount=0
  247. end
  248. if dv_VarCount=0 then
  249. dv_MaxVarLng=0
  250. do while dv_RexxExp<> ''
  251. parse value strip(dv_RexxExp, 'L')with dv_1stChar+1 dv_RexxExp
  252. select
  253. when datatype(dv_1stChar, 'S')then
  254. do
  255. dv_OneVar=dv_1stChar
  256. do while dv_RexxExp<> ''
  257. parse var dv_RexxExp dv_1stChar+1 dv_RexxExp
  258. if datatype(dv_1stChar, 'S')then
  259. dv_OneVar=dv_OneVar||dv_1stChar
  260. else
  261. do
  262. dv_RexxExp=dv_1stChar||dv_RexxExp
  263. leave
  264. end
  265. end
  266. call _RememberDumpedVar dv_OneVar
  267. if pos('.',dv_OneVar)<>0 then
  268. do
  269. do while dv_OneVar<> ''
  270. parse var dv_OneVar dv_ThisBit '.' dv_OneVar
  271. call _RememberDumpedVar dv_ThisBit
  272. end
  273. end
  274. end
  275. when dv_1stChar='"' | dv_1stChar = "'" then
  276. do
  277. dv_EndQuotePos=pos(dv_1stChar,dv_RexxExp)
  278. if dv_EndQuotePos=0 then
  279. dv_RexxExp=''
  280. else
  281. dv_RexxExp=substr(dv_RexxExp,dv_EndQuotePos+1)
  282. end
  283. otherwise
  284. nop
  285. end
  286. end
  287. call value dv_StemDot|| '0',dv_VarCount
  288. if dv_AutoDump='Y' then
  289. call DumpVarsInExpressionNow dv_Stem,dv_VarHeading,dv_LineRoutine
  290. return(dv_VarCount)
  291.  
  292. DumpVarsInExpressionNow:
  293. dv_StemDot=arg(1)|| '.'
  294. dv_VarHeading=arg(2)
  295. dv_LineRoutine=arg(3)
  296. if symbol(dv_StemDot|| '0') = 'VAR' then
  297. dv_VarCount=value(dv_StemDot|| '0')
  298. else
  299. do
  300. call _DumpVarsLineOutput 'DumpVar: could not find "' || dv_StemDot || '0' || '"'
  301. return(0)
  302. end
  303. if dv_VarCount<>0&dv_VarHeading<> '' then
  304. do
  305. call _DumpVarsLineOutput ''
  306. call _DumpVarsLineOutput dv_VarHeading
  307. call _DumpVarsLineOutput copies('~',length(dv_VarHeading))
  308. end
  309. dv_ShowVarLng=dv_MaxVarLng
  310. if dv_MaxVarLng>30 then
  311. dv_ShowVarLng=30
  312. do dv_Index=1 to dv_VarCount
  313. dv_OneVar=value(dv_StemDot||dv_Index)
  314. if length(dv_OneVar)>=dv_ShowVarLng then
  315. ShowVar=dv_OneVar
  316. else
  317. ShowVar=right(dv_OneVar,dv_ShowVarLng)
  318. dv_OneVarValue=value(translate(dv_OneVar))
  319. if datatype(dv_OneVarValue, 'N')=0 then
  320. do
  321. call BIN2REXP dv_OneVarValue
  322. dv_OneVarValue=dv_Value
  323. end
  324. call _DumpVarsLineOutput ShowVar|| ' = ' ||dv_OneVarValue
  325. end
  326. return
  327.  
  328. _RememberDumpedVar:
  329. dv_ThisVar=arg(1)
  330. if symbol(dv_ThisVar)='VAR' then
  331. do
  332. dv_AlreadyHave='N'
  333. dv_ThisVarUpper=translate(dv_ThisVar)
  334. do dv_Index=1 to dv_VarCount
  335. if dv_ThisVarUpper=translate(value(dv_StemDot||dv_Index))then
  336. do
  337. dv_AlreadyHave='Y'
  338. leave
  339. end
  340. end
  341. if dv_AlreadyHave='N' then
  342. do
  343. dv_VarCount=dv_VarCount+1
  344. call value dv_StemDot||dv_VarCount,dv_ThisVar
  345. if length(dv_ThisVar)>dv_MaxVarLng then
  346. dv_MaxVarLng=length(dv_ThisVar)
  347. end
  348. end
  349. return
  350.  
  351. _DumpVarsLineOutput:
  352. if dv_LineRoutine='' then
  353. say arg(1)
  354. else
  355. interpret 'call ' || dv_LineRoutine || ' arg(1)'
  356. return
  357.  
  358. BIN2REXP_START:
  359. dv_Value=''
  360. return
  361.  
  362. BIN2REXP_ONEBIT:
  363. if dv_Value<> '' then
  364. dv_Value=dv_Value|| ' || '
  365. dv_Value=dv_Value||arg(1)
  366. return
  367.  
  368. BIN2REXP_END:
  369. return
  370.  
  371. EndDUMPVARXh:
  372. signal RexxTrap_1
  373.  
  374. _FindLastLabel:
  375. FailedOnLine=arg(1)
  376. TryLine=FailedOnLine
  377. do while TryLine>1
  378. TryLine=TryLine-1
  379. TheLine=sourceline(TryLine)
  380. ColonPos=pos(':',TheLine)
  381. if ColonPos<>0 then
  382. do
  383. MaybeLabel=strip(left(TheLine,ColonPos-1))
  384. if symbol(MaybeLabel)<> 'BAD' then
  385. do
  386. FoundLabelOnLine=TryLine
  387. return(MaybeLabel|| ':  (line #' || AddCommasToDecimalNumber(TryLine) || ')')
  388. end
  389. end
  390. end
  391. FoundLabelOnLine=0
  392. return('')
  393.  
  394. TrapHeadingColonData:
  395. if arg(1)='' then
  396. TrapMiddle='  '
  397. else
  398. TrapMiddle=': '
  399. call SayAndDebugLine left(arg(1),16)||TrapMiddle||arg(2), '$S'
  400. return
  401.  
  402. _CommonTrapHandler:
  403. FailingLine=arg(1)
  404. TrapHeading='BUG: ' ||arg(2)
  405. TextDescription=arg(3)
  406. Text=arg(4)
  407. FailingLineText=AddCommasToDecimalNumber(FailingLine)
  408. call SayAndDebugLine copies('=+', 39), '$+'
  409. parse source . . SourceFileName
  410. call SayAndDebugLine TrapHeading, '$S'
  411. call SayAndDebugLine copies('~', length(TrapHeading)), '$S'
  412. call TrapHeadingColonData TextDescription,Text
  413. BettaOnRegina=condition('D')
  414. if BettaOnRegina<> '' &BettaOnRegina<>Text then
  415. call TrapHeadingColonData '',BettaOnRegina
  416. call RexxTrapAddInfo FailingLine
  417. parse version TheRexVer
  418. parse source TheOpSys .
  419. call TrapHeadingColonData "Environment", TheOpSys || ' using ' ||TheRexVer
  420. if pos('REGINA',translate(TheRexVer))<>0 then
  421. do
  422. call TrapHeadingColonData '',uname()
  423. end
  424. call TrapHeadingColonData "Failing Module",SourceFileName
  425. call TrapHeadingColonData "Failing Line #",FailingLineText
  426. InRoutine=_FindLastLabel(FailingLine)
  427. StartAt=(FailingLine-5)+1
  428. if FoundLabelOnLine<>0 then
  429. do
  430. if FoundLabelOnLine>StartAt then
  431. StartAt=FoundLabelOnLine
  432. else
  433. do
  434. if FoundLabelOnLine<>0 then
  435. do
  436. if(FailingLine-FoundLabelOnLine)<10 then
  437. StartAt=FoundLabelOnLine
  438. else
  439. call TrapHeadingColonData "After label",InRoutine
  440. end
  441. end
  442. end
  443. if StartAt<1 then
  444. StartAt=1
  445. call SayAndDebugLine '',       '$SH'
  446. call SayAndDebugLine 'SOURCE', '$SH'
  447. call SayAndDebugLine '~~~~~~', '$SH'
  448. vlist.0=0
  449. do ShowLine=StartAt to FailingLine
  450. FailingSrcLineTxt=strip(SourceLine(ShowLine))
  451. call SayAndDebugLine left(AddCommasToDecimalNumber(ShowLine),length(FailingLineText))|| ' : ' || FailingSrcLineTxt, '$SC'
  452. call DumpVarsInExpression FailingSrcLineTxt, 'vlist'
  453. end
  454. call DumpVarsInExpressionNow 'vlist', 'VARIABLE LIST', 'SayAndDebugLine'
  455. call SayAndDebugLine copies('=+', 39), '$+'
  456. call RexxTrapDying FailingLine
  457.  
  458. _RexxTrapSyntaxError:
  459. ReginaBug=SIGL
  460. call _CommonTrapHandler ReginaBug, 'SYNTAX ERROR!', 'Reason',errortext(Rc)
  461.  
  462. _RexxTrapUninitializedVariable:
  463. ReginaBug=SIGL
  464. call _CommonTrapHandler ReginaBug, 'UNKNOWN VARIABLE!', 'Unknown Variable', condition('D')
  465.  
  466. RexxTrap_1:
  467. signal on HALT name RexxCtrlC
  468. call DisplayCopyright
  469. /*
  470. *REXSYSTM.XH Version 00.048 By Dennis Bareis
  471. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  472. */
  473. parse version RexVersionInfo
  474. if pos('REGINA',translate(RexVersionInfo))<>0 then
  475. do
  476. RexWhich='REGINA'
  477. parse value translate(RexVersionInfo)with . 'REGINA_' RexVerRegina ' '
  478. RexVerRegina=translate(RexVerRegina, '.', '_')
  479. end
  480. else
  481. do
  482. RexVerRegina=''
  483. RexWhich='STANDARD_OS/2'
  484. end
  485. parse source RexSystemOpSys .
  486. if RexSystemOpSys="WIN32" then
  487. do
  488. parse value uname()with RexSystemOpSys .
  489. if RexSystemOpSys<> "WIN95" & RexSystemOpSys <> "WIN98" & RexSystemOpSys <> "WINNT" then
  490. do
  491. call RexDumpSystemInfo
  492. say ''
  493. say 'WARNING: Not sure if WIN95, WIN98, WINNT, assuming WIN95...'
  494. RexSystemOpSys="WIN95"
  495. end
  496. end
  497. RexSystmRexxPgmName='?';RexSystmRexxPgmName=RexGetFullSourceName()
  498. if translate(strip(arg(1)))='DEBUG' then
  499. do
  500. call RexDumpSystemInfo
  501. exit(0)
  502. end
  503. if RexWhich='STANDARD_OS/2' then
  504. do
  505. call RxFuncAdd 'SysSleep',        'RexxUtil', 'SysSleep'
  506. call RxFuncAdd 'SysFileDelete',   'RexxUtil', 'SysFileDelete'
  507. call RxFuncAdd 'SysSearchPath',   'RexxUtil', 'SysSearchPath'
  508. call RxFuncAdd 'SysFileTree',     'RexxUtil', 'SysFileTree'
  509. call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
  510. call SetLocal
  511. RexEnvVarPool='OS2ENVIRONMENT'
  512. RexStdoutStream='STDOUT'
  513. RexStderrStream='STDERR'
  514. RexTmpFileCntr=random(90000)
  515. end
  516. else
  517. do
  518. OPTIONS 'NOEXT_COMMANDS_AS_FUNCS'
  519. numeric digits 11
  520. RexEnvVarPool='SYSTEM'
  521. RexStdoutStream='<stdout>'
  522. RexStderrStream='<stderr>'
  523. end
  524. if RexSystemOpSys<> "UNIX" then
  525. do
  526. RexDirChar='\'
  527. RexOptionChar='/'
  528. end
  529. else
  530. do
  531. RexDirChar='/'
  532. RexOptionChar='-'
  533. end
  534. signal REXSYSTM_2
  535.  
  536. RexDumpSystemInfo:
  537. say 'Program Name  : ' ||RexSystmRexxPgmName
  538. say 'Op System     : ' ||RexSystemOpSys
  539. say 'Rexx Ver      : ' ||RexVersionInfo
  540. say 'Which System  : ' ||RexWhich
  541. if RexWhich='REGINA' then
  542. say 'regina uname(): ' ||uname()
  543. return
  544.  
  545. RexNeedReginaWorkAround:
  546. if RexWhich='STANDARD_OS/2' then
  547. return('N')
  548. else
  549. return('Y')
  550.  
  551. RexGetFullSourceName:
  552. parse source . . TmpRexxSrc
  553. if RexWhich='REGINA' then
  554. TmpRexxSrc=stream(strip(TmpRexxSrc), 'c', 'query exists')
  555. return(TmpRexxSrc)
  556.  
  557. RexQueryExists:
  558. if arg(1)='' then
  559. return('')
  560. else
  561. return(stream(arg(1), 'c', 'query exists'))
  562.  
  563. RexGetNameOfTmpDir:
  564. TmpDir=strip(GetEnv('TMP'))
  565. if TmpDir='' then
  566. TmpDir=strip(GetEnv('TEMP'))
  567. if TmpDir='' then
  568. do
  569. if RexSystemOpSys="UNIX" then
  570. TmpDir='/tmp'
  571. end
  572. if right(TmpDir,1)==RexDirChar then
  573. TmpDir=left(TmpDir,length(TmpDir)-1)
  574. return(TmpDir)
  575.  
  576. RedirectStdOutAndErr2:
  577. if RexSystemOpSys="DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  578. do
  579. return(' >' ||arg(1))
  580. end
  581. else
  582. do
  583. return(' >' || arg(1) || ' 2>&1')
  584. end
  585.  
  586. NameOfNulDevice:
  587. if RexSystemOpSys="UNIX" then
  588. return('/dev/null')
  589. else
  590. return('nul')
  591.  
  592. AllCmdOutput2Nul:
  593. return(RedirectStdOutAndErr2(NameOfNulDevice()))
  594.  
  595. AddressCmd:
  596. SysCmd2Exec=arg(1)
  597. if RexWhich='STANDARD_OS/2' then
  598. SysCmd2Exec='@' ||SysCmd2Exec
  599. call DebugAddressCmdBefore SysCmd2Exec
  600. SysCmd2Exec
  601. SysCmdRc=Rc
  602. FileIndex=2
  603. SysCmdFile=arg(FileIndex)
  604. do while SysCmdFile<> ''
  605. call DebugAddressCmdOutput SysCmdFile, 'H1'
  606. call DebugAddressCmdOutput copies('~', length(SysCmdFile)), 'H2'
  607. if stream(SysCmdFile, 'c', 'query exists') = '' then
  608. call DebugAddressCmdOutput '*File does not exist*',     '!'
  609. else
  610. do
  611. SysCmdLine=0
  612. CloseRc=stream(SysCmdFile, 'c', 'close')
  613. do while lines(SysCmdFile)<>0
  614. SysCmdLine=SysCmdLine+1
  615. call DebugAddressCmdOutput linein(SysCmdFile),SysCmdLine
  616. end
  617. CloseRc=stream(SysCmdFile, 'c', 'close')
  618. end
  619. FileIndex=FileIndex+1
  620. SysCmdFile=arg(FileIndex)
  621. end
  622. call DebugAddressCmdAfter SysCmdRc
  623. Rc=SysCmdRc
  624. return(SysCmdRc)
  625.  
  626. _filespec:
  627. fsCmd=translate(arg(1))
  628. select
  629. when fsCmd='D' | fsCmd = 'DRIVE' then
  630. do
  631. if RexSystemOpSys="UNIX" then
  632. return('')
  633. fsPos=pos(':',arg(2))
  634. if fsPos=0 then
  635. return('')
  636. else
  637. return(left(arg(2),fsPos))
  638. end
  639. when fsCmd='P' | fsCmd = 'PATH' then
  640. do
  641. fsStartWith=substr(arg(2),length(_filespec('D',arg(2)))+1)
  642. fsPos=lastpos(RexDirChar,fsStartWith)
  643. if fsPos=0 then
  644. return('')
  645. else
  646. return(left(fsStartWith,fsPos))
  647. end
  648. when fsCmd='N' | fsCmd = 'NAME' then
  649. do
  650. return(substr(arg(2),length(_filespec('L',arg(2)))+1))
  651. end
  652. when fsCmd='L' | fsCmd = 'LOCATION' then
  653. do
  654. return(_filespec('D', arg(2)) || _filespec('P',arg(2)))
  655. end
  656. when fsCmd='E' | fsCmd = 'EXTN' then
  657. do
  658. fsDotPos=lastpos('.',arg(2))
  659. if fsDotPos=0 then
  660. return('')
  661. else
  662. return(substr(arg(2),fsDotPos+1))
  663. end
  664. when fsCmd='W' | fsCmd = 'WITHOUTEXTN' then
  665. do
  666. fsDotPos=lastpos('.',arg(2))
  667. if fsDotPos=0 then
  668. return(arg(2))
  669. else
  670. return(left(arg(2),fsDotPos-1))
  671. end
  672. otherwise
  673. end
  674. return
  675.  
  676. _SysFileTree:
  677. if RexWhich='STANDARD_OS/2' then
  678. return(SysFileTree(arg(1),arg(2),arg(3),arg(4),arg(5)))
  679. if pos('D',arg(3))<>0 then
  680. stfType='D'
  681. else
  682. stfType='F'
  683. TmpDirFile=RexGetTmpFileName()
  684. if RexSystemOpSys<> "UNIX" then
  685. do
  686. DirCmd='dir /B '
  687. if pos('S',arg(3))<>0 then
  688. DirCmd=DirCmd|| "/S "
  689. if stfType='F' then
  690. DirCmd=DirCmd|| "/A-D "
  691. else
  692. DirCmd=DirCmd|| "/AD "
  693. DirCmd=DirCmd||arg(1)||RedirectStdOutAndErr2(TmpDirFile)
  694. end
  695. else
  696. do
  697. DirCmd='find ' || _filespec('L', arg(1)) || ' '
  698. if pos('FREEBSD',translate(uname()))=0 then
  699. DirCmd=DirCmd|| '-noleaf '
  700. if pos('S',arg(3))=0 then
  701. do
  702. if pos('FREEBSD',translate(uname()))=0 then
  703. DirCmd=DirCmd|| '-maxdepth 1 '
  704. else
  705. DirCmd=DirCmd|| '-prune '
  706. end
  707. if stfType='F' then
  708. DirCmd=DirCmd|| "-type f "
  709. else
  710. DirCmd=DirCmd|| "-type d "
  711. stfSName=_filespec('N',arg(1))
  712. if stfSName<> '' then
  713. DirCmd=DirCmd|| '-name "' || stfSName || '"'
  714. DirCmd=DirCmd||RedirectStdOutAndErr2(TmpDirFile)
  715. end
  716. Rc=AddressCmd(DirCmd,TmpDirFile)
  717. LastSlash=lastpos(RexDirChar,arg(1))
  718. CloseRc=stream(TmpDirFile, 'c', 'close')
  719. TmpLine=0
  720. do while lines(TmpDirFile)<>0
  721. AFile=linein(TmpDirFile)
  722. if AFile='' | AFile = '.' | AFile = '..' then
  723. iterate
  724. if RexSystemOpSys="UNIX" & stfType = 'D' then
  725. do
  726. if AFile=_filespec('L',arg(1))then
  727. iterate
  728. end
  729. if LastSlash<>0 then
  730. do
  731. if pos(RexDirChar,AFile)==0 then
  732. AFile=left(arg(1),LastSlash)||AFile
  733. end
  734. if stfType='F' then
  735. do
  736. AFile=stream(AFile, 'c', 'query exists')
  737. if AFile='' then
  738. iterate
  739. end
  740. else
  741. do
  742. if pos(' ',AFile)<>0 then
  743. iterate
  744. end
  745. TmpLine=TmpLine+1
  746. call _valueS arg(2)|| '.' ||TmpLine,strip(AFile)
  747. end
  748. CloseRc=stream(TmpDirFile, 'c', 'close')
  749. DeleteRc=_SysFileDelete(TmpDirFile)
  750. call _valueS arg(2)|| '.0',TmpLine
  751. return(0)
  752.  
  753. _SysFileDelete:
  754. if RexWhich='STANDARD_OS/2' then
  755. return(SysFileDelete(arg(1)))
  756. if RexSystemOpSys="DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  757. return(AddressCmd('if exist ' || arg(1) || ' del ' ||arg(1)||AllCmdOutput2Nul()))
  758. else
  759. do
  760. if RexSystemOpSys="UNIX" then
  761. return(AddressCmd('rm -f ' ||arg(1)||AllCmdOutput2Nul()))
  762. else
  763. return(AddressCmd('del ' ||arg(1)||AllCmdOutput2Nul()))
  764. end
  765.  
  766. RexGetTmpFileName:
  767. if arg(1)<> '' then
  768. TmpFileM=arg(1)
  769. else
  770. do
  771. if RexSystemOpSys<> "UNIX" then
  772. TmpFileM='RSTM????.TMP'
  773. else
  774. do
  775. TmpFileM=GetEnv('USER')
  776. if TmpFileM='' then
  777. TmpFileM=GetEnv('user')
  778. if TmpFileM='' then
  779. TmpFileM='?????.rstm'
  780. else
  781. TmpFileM=TmpFileM|| '_?????.rstm'
  782. end
  783. end
  784. TmpFileM=RexGetNameOfTmpDir()||RexDirChar||TmpFileM
  785. if RexWhich='STANDARD_OS/2' then
  786. do
  787. TmpFileF=SysTempFileName(TmpFileM)
  788. if TmpFileF='' then
  789. do
  790. RexTmpFileCntr=RexTmpFileCntr+1
  791. TmpFileF='C_' || right(RexTmpFileCntr, 6, '0') || '.TMP'
  792. end
  793. return(TmpFileF)
  794. end
  795. TmpRandom=right(time('S'),3)||random(99999)
  796. TmpRandomAdd=0
  797. do until stream(TmpFileA, 'c', 'query exists') = ''
  798. TmpRandomS=reverse(d2x(TmpRandom+TmpRandomAdd))
  799. TmpRandomAdd=TmpRandomAdd+1
  800. TmpFileA=TmpFileM
  801. TmpWhich=1
  802. QmPos=pos('?',TmpFileA)
  803. do while QmPos<>0
  804. TmpReplace=substr(TmpRandomS,TmpWhich,1)
  805. TmpWhich=TmpWhich+1
  806. if TmpReplace='' then
  807. TmpWhich=1
  808. else
  809. do
  810. TmpFileA=overlay(TmpReplace,TmpFileA,QmPos)
  811. QmPos=pos('?',TmpFileA)
  812. end
  813. end
  814. end
  815. return(TmpFileA)
  816.  
  817. GetEnv:
  818. return(value(arg(1),,RexEnvVarPool))
  819.  
  820. _valueS:
  821. if RexWhich='STANDARD_OS/2' then
  822. return(value(arg(1),arg(2)))
  823. return(value(translate(arg(1)),arg(2)))
  824.  
  825. _valueG:
  826. if RexWhich='STANDARD_OS/2' then
  827. return(value(arg(1)))
  828. return(value(arg(1)))
  829.  
  830. REXSYSTM_2:
  831. DebugFileName=ReplaceAnyFileNameSymbols(GetEnv('PPWCURL_DEBUG'))
  832. if left(DebugFileName,1)='+' then
  833. DebugFileName=substr(DebugFileName,2)
  834. else
  835. do
  836. if DebugFileName<> '' then
  837. DosDelRc=CloseAndDeleteFile(DebugFileName)
  838. end
  839. call DebugLine ''
  840. call DebugLine ''
  841. call DebugLine copies('=',79)
  842. call DebugLine '        Time: ' ||date()
  843. call DebugLine 'Command Line: ' ||UserRequest
  844. call DebugLine '   Op System: ' ||RexSystemOpSys
  845. call DebugLine ' Interpreter: ' ||RexVersionInfo
  846. call DebugLine copies('=',79)
  847. call DebugLine ''
  848. signal PPWCURLX_3
  849.  
  850. CheckUrlsInHtml:
  851. PgmRc=GetFilesMatchingMasks()
  852. if PgmRc<> '' then
  853. return(PgmRc)
  854. Dangerous='"' || "'" ||d2c(9)||d2c(27)
  855. UrlCount=0
  856. do Index=1 to NumberFiles
  857. UrlSourceFile=FileList.Index
  858. LineNumber=0
  859. Urls=0
  860. CloseRc=stream(UrlSourceFile, 'c', 'close')
  861. do while lines(UrlSourceFile)<>0
  862. CurrentLine=linein(UrlSourceFile)
  863. LineNumber=LineNumber+1
  864. CurrentLine=translate(CurrentLine, '', Dangerous, ' ')
  865. do WordIndex=1 to words(CurrentLine)
  866. MaybeUrl=word(CurrentLine,WordIndex)
  867. if abbrev(MaybeUrl, 'http://') | abbrev(MaybeUrl, 'ftp://')then
  868. do
  869. UrlCount=UrlCount+1
  870. Url.UrlCount=MaybeUrl
  871. UrlSrc.UrlCount=UrlSourceFile|| '(' || LineNumber || ')'
  872. end
  873. end
  874. end
  875. CloseRc=stream(UrlSourceFile, 'c', 'close')
  876. end
  877. Url.0=UrlCount
  878. UrlSrc.0=UrlCount
  879. call ProcessUrlArray
  880. return(PgmRc)
  881.  
  882. PPWCURLX_3:
  883. /*
  884. *BASEDATE.XH Version 99.034 by Dennis Bareis
  885. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  886. */
  887. signal EndBASEDATEXh
  888.  
  889. BaseDate:procedure
  890. TheDate=translate(arg(1), ' ', '/-')
  891. if TheDate='' then
  892. TheDate=date('Sorted')
  893. parse var TheDate Year MM DD
  894. if length(Year)>=8 then
  895. do
  896. DD=substr(Year,7,2)
  897. MM=substr(Year,5,2)
  898. Year=left(Year,4)
  899. end
  900. DaysInMonth='31  28  31  30  31  30  31  31  30  31  30  31'
  901. if datatype(Year, 'WholeNumber')<>1 then
  902. return(-10)
  903. if datatype(MM, 'WholeNumber')<>1 then
  904. return(-20)
  905. if datatype(DD, 'WholeNumber')<>1 then
  906. return(-30)
  907. if MM<0|MM>12 then
  908. return(-21)
  909. DaysThisMonth=word(DaysInMonth,MM)
  910. if MM=2 then
  911. DaysThisMonth=DaysThisMonth+1
  912. if DD<0|DD>DaysThisMonth then
  913. return(-31)
  914. if length(strip(Year))=2 then
  915. do
  916. if Year>=80 then
  917. Year='19' ||Year
  918. else
  919. Year='20' ||Year
  920. end
  921. y=Year-0001
  922. b=y*365
  923. b=b+y%4
  924. b=b-y%100
  925. b=b+y%400
  926. m=mm-01
  927. do i=1 to m
  928. b=b+word(DaysInMonth,i)
  929. end
  930. if mm>2 then
  931. do
  932. if 0=Year//4 then
  933. do
  934. if 0=Year//100 then
  935. do
  936. if 0=Year//400 then
  937. b=b+1
  938. end
  939. else
  940. b=b+1
  941. end
  942. end
  943. d=dd-01
  944. b=b+d
  945. return(b)
  946.  
  947. EndBASEDATEXh:
  948. /*
  949. *FASTINI.XH Version 98.147 by Dennis Bareis
  950. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  951. */
  952. _FiOpenCount=0
  953. call RxFuncAdd 'FastIniStart',   'FastIni',  'FastIniStart'
  954. call RxFuncAdd 'FastIniEnd',     'FastIni',  'FastIniEnd'
  955. call RxFuncAdd 'FastIniVersion', 'FastIni',  'FastIniVersion'
  956. _fiAvailable=_FastIniOk()
  957. signal EndFASTINIXh
  958.  
  959. FastIniIsFast:
  960. return(_fiAvailable)
  961.  
  962. FastIniOpenIni:
  963. _fiFile=arg(1)
  964. _fiHandleVar=arg(2)
  965. if _fiAvailable='N' then
  966. do
  967. interpret _fiHandleVar|| ' = 0'
  968. return('OK')
  969. end
  970. interpret _fiHandleVar|| ' = ""'
  971. _fiFastRc=FastIniStart(_fiFile,_fiHandleVar)
  972. interpret '_FiHandle = ' ||_fiHandleVar
  973. if _FiHandle<> '' then
  974. do
  975. _FiOpenCount=_FiOpenCount+1
  976. _FiOpenedList._FiOpenCount=_FiHandle
  977. end
  978. return(_fiFastRc)
  979.  
  980. FastIniCloseIni:
  981. if _fiAvailable='N' then
  982. return('OK')
  983. return(FastIniEnd(arg(1)))
  984.  
  985. FastIniGetVersion:
  986. if _fiAvailable='Y' then
  987. return(FastIniVersion(arg(1)))
  988. else
  989. do
  990. interpret arg(1)|| ' = "00.000 http://www.labyrinth.net.au/~dbareis/index.htm db0@anz.com Dennis Bareis"'
  991. return('OK')
  992. end
  993.  
  994. FastIniCleanup:
  995. if _fiAvailable='N' then
  996. return('OK')
  997. do _fi=1 to _FiOpenCount
  998. call FastIniEnd(_FiOpenedList._fi)
  999. _FiOpenedList._fi=0
  1000. end
  1001. _FiOpenCount=0
  1002. return('OK')
  1003.  
  1004. _FastIniOk:
  1005. signal on SYNTAX name _FastIniNotOk
  1006. interpret "_fiRc = FastIniVersion('_fiVersion')"
  1007. return('Y')
  1008.  
  1009. _FastIniNotOk:
  1010. return('N')
  1011.  
  1012. EndFASTINIXh:
  1013. TryQuotes='"' || "'" ||xrange(d2c(127),d2c(255))||xrange(d2c(1),d2c(31))
  1014. UrlCount=0
  1015. UrlInfoNeedsWriting='N'
  1016. MemoryBackupLevel=3
  1017. StartIndex=1
  1018. OkIndex=1
  1019. Step=1000
  1020. do forever
  1021. do Index=StartIndex to 10000 by Step
  1022. if symbol(copies('A', Index)) = 'BAD' then
  1023. leave
  1024. else
  1025. OkIndex=Index
  1026. end
  1027. if Step=1 then
  1028. leave
  1029. else
  1030. do
  1031. StartIndex=OkIndex
  1032. Step=Step%10
  1033. if Step=0 then
  1034. Step=1
  1035. end
  1036. end
  1037. TrunUrlCodeTo=OkIndex-10
  1038. call DebugLine 'Longest Rexx symbol is ' || OkIndex || ' byte(s) minimum'
  1039. signal PPWCURLI_4
  1040.  
  1041. GetQuotedText:
  1042. parse arg TheString,RestVarName
  1043. TheString=strip(TheString, 'L')
  1044. if TheString='' then
  1045. return('')
  1046. QuoteChar=left(TheString,1)
  1047. do
  1048. SecondQuotePosn=pos(QuoteChar,TheString,2)
  1049. if SecondQuotePosn=0 then
  1050. return('')
  1051. QuotedString=substr(TheString,2,SecondQuotePosn-2)
  1052. TheRest=substr(TheString,SecondQuotePosn+1)
  1053. end
  1054. TheRest=strip(TheRest, 'L')
  1055. if RestVarName<> '' then
  1056. call _valueS RestVarName,TheRest
  1057. return(QuotedString)
  1058.  
  1059. CreateUrl2IndexMapping:
  1060. parse arg MapIndex,MapUrl
  1061. UrlCode=c2x(MapUrl)
  1062. SavedWhere='!F' ||UrlCode
  1063. if symbol(SavedWhere)<> 'BAD' then
  1064. call _valueS SavedWhere,MapIndex
  1065. else
  1066. do
  1067. SavedWhere='!P' || left(UrlCode, TrunUrlCodeTo) || '.'
  1068. SavedWhere0=SavedWhere|| '0'
  1069. if symbol(SavedWhere0)<> 'VAR' then
  1070. do
  1071. call _valueS SavedWhere0,1
  1072. call _valueS SavedWhere|| '1', MapIndex || ',' ||MapUrl
  1073. end
  1074. else
  1075. do
  1076. DupCount=_valueG(SavedWhere0)+1
  1077. call _valueS SavedWhere0,DupCount
  1078. call _valueS SavedWhere||DupCount,MapIndex|| ',' ||MapUrl
  1079. end
  1080. end
  1081. return
  1082.  
  1083. GetInfoIndex4Url:
  1084. giUrl=arg(1)
  1085. giAdding=arg(2)
  1086. UrlCode=c2x(giUrl)
  1087. SavedWhere='!F' ||UrlCode
  1088. UrlSymbol=symbol(SavedWhere)
  1089. if UrlSymbol<> 'BAD' then
  1090. do
  1091. if UrlSymbol='VAR' then
  1092. giIndex=_valueG(SavedWhere)
  1093. else
  1094. giIndex=0
  1095. end
  1096. else
  1097. do
  1098. SavedWhere='!P' || left(UrlCode, TrunUrlCodeTo) || '.'
  1099. SavedWhere0=SavedWhere|| '0'
  1100. if symbol(SavedWhere0)<> 'VAR' then
  1101. giIndex=0
  1102. else
  1103. do
  1104. giIndex=0
  1105. do LookIndex=1 to _valueG(SavedWhere0)
  1106. parse value _valueG(SavedWhere||LookIndex)with giIndexT ',' giUrlT
  1107. if giUrlT=giUrl then
  1108. do
  1109. giIndex=giIndexT
  1110. leave
  1111. end
  1112. end
  1113. end
  1114. end
  1115. if giIndex=0 then
  1116. do
  1117. if giAdding='Y' then
  1118. do
  1119. UrlIniCount=UrlIniCount+1
  1120. giIndex=UrlIniCount
  1121. call CreateUrl2IndexMapping giIndex,giUrl
  1122. end
  1123. end
  1124. return(giIndex)
  1125.  
  1126. MemoryOpen:
  1127. UrlIniCount=0
  1128. UrlInfoNeedsWriting='N'
  1129. if IniFileName='' then
  1130. return
  1131. CloseRc=stream(IniFileName, 'c', 'close')
  1132. do while lines(IniFileName)<>0
  1133. CurrentLine=strip(linein(IniFileName))
  1134. if CurrentLine='' | left(CurrentLine,1) = ';' then
  1135. iterate
  1136. UrlIniCount=UrlIniCount+1
  1137. if left(CurrentLine,1)='+' then
  1138. StatusOk='Y'
  1139. else
  1140. StatusOk='N'
  1141. URL=GetQuotedText(substr(CurrentLine,2), "Rest")
  1142. !URL.UrlIniCount.!UrlStatusOk=StatusOk
  1143. !URL.UrlIniCount.!Url=URL
  1144. !URL.UrlIniCount.!LastChecked=GetQuotedText(Rest, "Rest")
  1145. if StatusOk='Y' then
  1146. !URL.UrlIniCount.!LastModified=GetQuotedText(Rest, "Rest")
  1147. else
  1148. !URL.UrlIniCount.!Reason=GetQuotedText(Rest, "Rest")
  1149. !URL.UrlIniCount.!Updated='N'
  1150. call CreateUrl2IndexMapping UrlIniCount,Url
  1151. end
  1152. CloseRc=stream(IniFileName, 'c', 'close')
  1153. return
  1154.  
  1155. QuoteIt:
  1156. Quote4=arg(1)
  1157. TryQuoteLng=length(TryQuotes)
  1158. do QuoteIndex=1 to TryQuoteLng
  1159. PossibleQuote=substr(TryQuotes,QuoteIndex,1)
  1160. if pos(PossibleQuote,Quote4)=0 then
  1161. leave
  1162. end
  1163. return(PossibleQuote||arg(1)||PossibleQuote)
  1164.  
  1165. MemoryNeedsUpdating:
  1166. if IniFileName='' then
  1167. return('N')
  1168. else
  1169. do
  1170. if UrlInfoNeedsWriting='N' then
  1171. return('N')
  1172. else
  1173. return('Y')
  1174. end
  1175.  
  1176. _MemoryCloseWrite:
  1177. WriteWhatIndex=arg(1)
  1178. if !URL.WriteWhatIndex.!UrlStatusOk='Y' then
  1179. do
  1180. OkCount=OkCount+1
  1181. if OkCount=1 then
  1182. do
  1183. call _lineout IniFileName, ';-----------------------------'
  1184. call _lineout IniFileName, ';--- URLS without problems ---'
  1185. call _lineout IniFileName, ';-----------------------------'
  1186. call _lineout IniFileName, ''
  1187. end
  1188. Output='+  '  || QuoteIT(!URL.WriteWhatIndex.!Url)          || '  '
  1189. Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastChecked)|| '  '
  1190. Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastModified)
  1191. end
  1192. else
  1193. do
  1194. ErrCount=ErrCount+1
  1195. if ErrCount=1 then
  1196. do
  1197. call _lineout IniFileName, ';--------------------------'
  1198. call _lineout IniFileName, ';--- URLS with problems ---'
  1199. call _lineout IniFileName, ';--------------------------'
  1200. call _lineout IniFileName, ''
  1201. end
  1202. Output='-  '  || QuoteIT(!URL.WriteWhatIndex.!Url)          || '  '
  1203. Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastChecked)|| '  '
  1204. Output=Output||QuoteIT(!URL.WriteWhatIndex.!Reason)
  1205. end
  1206. call _lineout IniFileName,Output
  1207. return
  1208.  
  1209. WantToForgetUrl:
  1210. wfuIndex=arg(1)
  1211. DateChecked=!URL.wfuIndex.!LastChecked
  1212. if datatype(DateChecked, 'W')=0 then
  1213. return('Y')
  1214. if(BaseDate()-DateChecked)>ForgetDays then
  1215. return('Y')
  1216. else
  1217. return('N')
  1218.  
  1219. MemoryClose:
  1220. if MemoryNeedsUpdating()='N' then
  1221. return
  1222. if stream(IniFileName, 'c', 'query exists') <> '' &MemoryBackupLevel<>0 then
  1223. do
  1224. BaseLess1=_filespec('name',IniFileName)
  1225. BaseLess1=left(BaseLess1,length(BaseLess1)-1)
  1226. WholeLess1=left(IniFileName,length(IniFileName)-1)
  1227. OldestFile=WholeLess1||MemoryBackupLevel
  1228. call CloseAndDeleteFile OldestFile
  1229. do BackupIndex=0 to MemoryBackupLevel-1
  1230. ToChar=MemoryBackupLevel-BackupIndex
  1231. FromChar=ToChar-1
  1232. if FromChar=0 then
  1233. FromChar=right(IniFileName,1)
  1234. call AddressCmd 'ren ' || WholeLess1 || FromChar || ' ' ||BaseLess1||ToChar||AllCmdOutput2Nul()
  1235. end
  1236. MemoryBackupLevel=0
  1237. end
  1238. call CloseAndDeleteFile IniFileName
  1239. OkCount=0
  1240. ErrCount=0
  1241. do Index=1 to UrlIniCount
  1242. if !URL.Index.!UrlStatusOk='Y' & !URL.Index.!Updated = 'Y' then
  1243. call _MemoryCloseWrite Index
  1244. end
  1245. do Index=1 to UrlIniCount
  1246. if !URL.Index.!UrlStatusOk='Y' & !URL.Index.!Updated = 'N' & WantToForgetUrl(Index) = 'N' then
  1247. call _MemoryCloseWrite Index
  1248. end
  1249. if OkCount<>0 then
  1250. do
  1251. call _lineout IniFileName, ';  ' || OkCount || ' Url(s) are OK'
  1252. call _lineout IniFileName, ''
  1253. call _lineout IniFileName, ''
  1254. end
  1255. do index=1 to UrlIniCount
  1256. if !URL.Index.!UrlStatusOk='N' & !URL.Index.!Updated = 'Y' then
  1257. call _MemoryCloseWrite Index
  1258. end
  1259. do index=1 to UrlIniCount
  1260. if !URL.Index.!UrlStatusOk='N' & !URL.Index.!Updated = 'N'  & WantToForgetUrl(Index) = 'N' then
  1261. call _MemoryCloseWrite Index
  1262. end
  1263. if ErrCount<>0 then
  1264. call _lineout IniFileName, ';  ' || ErrCount || ' Url(s) have problems'
  1265. if OkCount=0&ErrCount=0 then
  1266. call _lineout IniFileName, ';--- NO URLS ---'
  1267. UrlInfoNeedsWriting='N'
  1268. return
  1269.  
  1270. NeedToReTestUrl:
  1271. if IniFileName='' then
  1272. return('Y')
  1273. TestUrl=arg(1)
  1274. UrlIndex=GetInfoIndex4Url(TestUrl)
  1275. if UrlIndex=0 then
  1276. do
  1277. call DebugLine 'This is a new URL (not known): ' ||TestUrl
  1278. return('Y')
  1279. end
  1280. if !URL.UrlIndex.!UrlStatusOk='N' then
  1281. do
  1282. call DebugLine 'This URL failed on last test : ' ||TestUrl
  1283. call DebugLine '     REASON : ' ||!URL.UrlIndex.!Reason
  1284. return('Y')
  1285. end
  1286. if CheckDays='' then
  1287. return('Y')
  1288. BaseDateNow=BaseDate()
  1289. BaseDateOk=!URL.UrlIndex.!LastChecked
  1290. CheckDaysThisUrl=random(CheckDaysMin,CheckDaysMax)
  1291. PeriodSinceLastCheck=BaseDateNow-BaseDateOk
  1292. call DebugLine 'URL: ' || TestUrl || ' last checked ' || PeriodSinceLastCheck || ' days ago (CheckDays[Random]=' || CheckDaysThisUrl || ').'
  1293. if PeriodSinceLastCheck<0|PeriodSinceLastCheck>CheckDaysThisUrl then
  1294. do
  1295. return('Y')
  1296. end
  1297. else
  1298. do
  1299. return('N')
  1300. end
  1301.  
  1302. SaveUrlOkInformation:
  1303. if IniFileName='' then
  1304. return
  1305. SaveUrl=arg(1)
  1306. UrlIndex=GetInfoIndex4Url(SaveUrl, 'Y')
  1307. !URL.UrlIndex.!UrlStatusOk='Y'
  1308. !URL.UrlIndex.!Url=SaveUrl
  1309. !URL.UrlIndex.!LastChecked=BaseDate()
  1310. !URL.UrlIndex.!LastModified=!CheckUrl.!LastModified
  1311. !URL.UrlIndex.!Updated='Y'
  1312. UrlInfoNeedsWriting='Y'
  1313. return
  1314.  
  1315. SaveUrlFailedInformation:
  1316. if IniFileName='' then
  1317. return
  1318. parse arg FailedUrl,Reason
  1319. UrlIndex=GetInfoIndex4Url(FailedUrl, 'Y')
  1320. !URL.UrlIndex.!UrlStatusOk='N'
  1321. !URL.UrlIndex.!Url=FailedUrl
  1322. !URL.UrlIndex.!LastChecked=BaseDate()
  1323. !URL.UrlIndex.!Reason=Reason
  1324. !URL.UrlIndex.!Updated='Y'
  1325. UrlInfoNeedsWriting='Y'
  1326. return
  1327.  
  1328. PPWCURLI_4:
  1329. parse source . . RexxSrcName
  1330. ShortRexxSrcName=_filespec('name',RexxSrcName)
  1331. DotPos=lastpos('.',ShortRexxSrcName)
  1332. if DotPos=0 then
  1333. ShortRexxSrcNameNoExtn=ShortRexxSrcName
  1334. else
  1335. ShortRexxSrcNameNoExtn=left(ShortRexxSrcName,DotPos-1)
  1336. MaxLineDump=10
  1337. if DebugFileName<> '' then
  1338. MaxLineDump=MaxLineDump*2
  1339. OptionsCmdLine=strip(arg(1))
  1340. OptionsEnvironment=GetEnv('PPWCURL_OPTIONS')
  1341. UserRequest=OptionsEnvironment|| ' ' ||OptionsCmdLine
  1342. ErrorFileName=''
  1343. CheckDays=''
  1344. ForgetDays=''
  1345. ReadTimeout=''
  1346. ReadTimeout2=''
  1347. OnlineTestUrl='http://www.labyrinth.net.au/~dbareis/index.htm'
  1348. UseHead='N'
  1349. FtpEmailAddress=''
  1350. DoHttpUrls='Y'
  1351. DoFtpUrls='Y'
  1352. AskAboutMovedUrls='Y'
  1353. if DebugFileName='' then
  1354. SocketReadLength=512
  1355. else
  1356. SocketReadLength=(512*8)
  1357. ParmCount=0
  1358. TheCmdLine=UserRequest
  1359. do while TheCmdLine<> ''
  1360. TheCmdLine=strip(TheCmdLine)
  1361. if left(TheCmdLine,1)='"' then
  1362. do
  1363. BeforeParse=TheCmdLine
  1364. parse value substr(TheCmdLine,2)with ThisParm'"'TheCmdLine
  1365. if TheCmdLine<> '' then
  1366. do
  1367. if left(TheCmdLine,1)\==' ' then
  1368. CryAndDie('Invalid quoted parameter at ==> ' ||BeforeParse)
  1369. end
  1370. end
  1371. else
  1372. do
  1373. parse var TheCmdLine ThisParm TheCmdLine
  1374. end
  1375. call DebugLine 'Option: "' || ThisParm || '"'
  1376. if left(ThisParm,1)<>RexOptionChar then
  1377. do
  1378. ParmCount=ParmCount+1
  1379. Parm.ParmCount=ThisParm
  1380. iterate
  1381. end
  1382. parse var ThisParm ThisCmd':'ThisCmdOptions
  1383. ThisCmd=translate(substr(ThisCmd,2))
  1384. select
  1385. when ThisCmd='ERRORFILE' then
  1386. do
  1387. if ThisCmdOptions='' then
  1388. ErrorFileName=''
  1389. else
  1390. do
  1391. ErrorFileName=ReplaceAnyFileNameSymbols(ThisCmdOptions)
  1392. if left(ErrorFileName,1)='+' then
  1393. ErrorFileName=substr(ErrorFileName,2)
  1394. else
  1395. do
  1396. if ErrorFileName<> '' then
  1397. DosDelRc=CloseAndDeleteFile(ErrorFileName)
  1398. end
  1399. end
  1400. end
  1401. when ThisCmd='MEMORYFILE' then
  1402. do
  1403. if ThisCmdOptions='' then
  1404. IniFileName=''
  1405. else
  1406. IniFileName=ReplaceAnyFileNameSymbols(ThisCmdOptions)
  1407. end
  1408. when ThisCmd='GETENV' then
  1409. do
  1410. MoreOptions=GetEnv(ThisCmdOptions)
  1411. if MoreOptions='' then
  1412. UserSyntaxError('The environment variable "' || ThisCmdOptions || '" is unknown')
  1413. TheCmdLine=MoreOptions|| ' ' ||TheCmdLine
  1414. end
  1415. when ThisCmd='CHECKDAYS' then
  1416. do
  1417. CheckDays=ThisCmdOptions
  1418. if CheckDays<> '' then
  1419. do
  1420. parse var CheckDays CheckDaysMin '-' CheckDaysMax
  1421. if CheckDaysMax='' then
  1422. do
  1423. if CheckDaysMin=1 then
  1424. CheckDaysMax=1
  1425. else
  1426. do
  1427. if CheckDaysMin<6 then
  1428. CheckDaysMax=CheckDaysMin+1
  1429. else
  1430. CheckDaysMax=CheckDaysMin+((CheckDaysMin%3)+1)
  1431. end
  1432. end
  1433. call DebugLine 'INI Check Days = ' || CheckDaysMin || ' to ' ||CheckDaysMax
  1434. end
  1435. end
  1436. when ThisCmd='READTIMEOUT' then
  1437. do
  1438. if ThisCmdOptions='' then
  1439. ReadTimeout=''
  1440. else
  1441. do
  1442. Value=GetInteger(ThisCmd,ThisCmdOptions)
  1443. if Value>=1 then
  1444. ReadTimeout=Value
  1445. end
  1446. end
  1447. when ThisCmd='TIMEOUTRETRY' then
  1448. do
  1449. if ThisCmdOptions='' then
  1450. ReadTimeout2=''
  1451. else
  1452. do
  1453. ReadTimeout2=GetInteger(ThisCmd,ThisCmdOptions)
  1454. if ReadTimeout2<0 then
  1455. ReadTimeout2=0
  1456. end
  1457. end
  1458. when ThisCmd='MEMORYBACKUPLEVEL' then
  1459. do
  1460. if ThisCmdOptions='' then
  1461. MemoryBackupLevel=3
  1462. else
  1463. do
  1464. MemoryBackupLevel=GetInteger(ThisCmd,ThisCmdOptions)
  1465. if MemoryBackupLevel>9 then
  1466. MemoryBackupLevel=9
  1467. end
  1468. end
  1469. when ThisCmd='FORGETDAYS' then
  1470. do
  1471. if ThisCmdOptions='' then
  1472. ForgetDays=''
  1473. else
  1474. do
  1475. Value=GetInteger(ThisCmd,ThisCmdOptions)
  1476. if Value<50 then
  1477. Value=50
  1478. ForgetDays=Value
  1479. end
  1480. end
  1481. when ThisCmd='SOCKETREADLENGTH' then
  1482. do
  1483. SocketReadLength=GetInteger(ThisCmd,ThisCmdOptions)
  1484. end
  1485. when ThisCmd='MAXLINEDUMP' then
  1486. do
  1487. MaxLineDump=GetInteger(ThisCmd,ThisCmdOptions)
  1488. end
  1489. when ThisCmd='TESTURL' then
  1490. do
  1491. OnlineTestUrl=ThisCmdOptions
  1492. end
  1493. when ThisCmd='FTPEMAIL' then
  1494. do
  1495. FtpEmailAddress=ThisCmdOptions
  1496. end
  1497. when ThisCmd='ASKIFMOVEOK' then
  1498. do
  1499. AskAboutMovedUrls=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  1500. end
  1501. when ThisCmd='USEHEADREQUEST' then
  1502. do
  1503. UseHead=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  1504. if UseHead='Y' then
  1505. do
  1506. call SayAndDebugLine ''
  1507. call SayAndDebugLine '***'
  1508. call SayAndDebugLine "*** Note some servers don't seem to correctly handle"
  1509. call SayAndDebugLine '*** the HEAD request!  According to RFC 1945 the format'
  1510. call SayAndDebugLine '*** of the head request is the same as that for the GET'
  1511. call SayAndDebugLine '*** request which always seems to be correctly handled!'
  1512. call SayAndDebugLine '***'
  1513. call SayAndDebugLine '*** If you get a 404 this could be a server malfunction!'
  1514. call SayAndDebugLine '***'
  1515. call SayAndDebugLine ''
  1516. end
  1517. end
  1518. otherwise
  1519. UserSyntaxError('Unknown switch of "' || RexOptionChar || ThisCmd || '" specified')
  1520. end
  1521. end
  1522. if MaxLineDump>99 then
  1523. MaxLineDump=99
  1524. if ReadTimeout='' then
  1525. ReadTimeout=15
  1526. if ReadTimeout2='' then
  1527. do
  1528. if ReadTimeout<60 then
  1529. ReadTimeout2=60
  1530. else
  1531. ReadTimeout2=ReadTimeout+30
  1532. end
  1533. if IniFileName<> '' then
  1534. do
  1535. if ForgetDays='' then
  1536. ForgetDays=365
  1537. if CheckDays='' then
  1538. call DebugLine 'INI will be updated, all URLs will be processed reguardless of age'
  1539. end
  1540. else
  1541. do
  1542. if CheckDays<> '' then
  1543. call SayAndDebugLine 'Option "' || RexOptionChar || 'CheckIni:' || CheckDays || '" ignored.'
  1544. if ForgetDays<> '' then
  1545. call SayAndDebugLine 'Option "' || RexOptionChar || 'ForgetDays:' || ForgetDays || '" ignored.'
  1546. end
  1547. HaveSockets=InitializeSocketSupport()
  1548. HaveFtp=InitializeFtpSupport()
  1549. if ParmCount=0 then
  1550. UserSyntaxError('No parameters supplied!')
  1551. TheCmd=translate(Parm.1)
  1552. select
  1553. when TheCmd="VERSION?" then
  1554. PgmRc=ShortRexxSrcName|| ' ' ||PgmVersion
  1555. when TheCmd="SOCKETVERSION?" then
  1556. do
  1557. if HaveSockets<> '' then
  1558. PgmRc=HaveSockets
  1559. else
  1560. do
  1561. if RexWhich='STANDARD_OS/2' then
  1562. PgmRc='RxSock.DLL ' || SockVersion()   || ' - OS/2'
  1563. else
  1564. PgmRc='RxSock.DLL ' || RxSockVersion() || ' - Regina'
  1565. end
  1566. end
  1567. when TheCmd="FTPVERSION?" then
  1568. do
  1569. if HaveFtp<> '' then
  1570. PgmRc=HaveFtp
  1571. else
  1572. do
  1573. call FtpVersion 'Version'
  1574. PgmRc='RxFtp.DLL ' ||Version
  1575. end
  1576. end
  1577. when TheCmd="SOCKETREADY?" then
  1578. do
  1579. if HaveSockets<> '' then
  1580. PgmRc=HaveSockets
  1581. else
  1582. PgmRc='OK'
  1583. end
  1584. when TheCmd="FTPREADY?" then
  1585. do
  1586. if HaveFtp<> '' then
  1587. PgmRc=HaveFtp
  1588. else
  1589. PgmRc='OK'
  1590. end
  1591. when TheCmd="CHECK1URL" then
  1592. do
  1593. MaxLineDump=0
  1594. if ParmCount<>2 then
  1595. UserSyntaxError('Incorrect Number of parameters!')
  1596. PgmRc=CheckUrl(Parm.2)
  1597. end
  1598. when TheCmd="CHECKURLSINHTML" then
  1599. do
  1600. if HaveSockets='' then
  1601. PgmRc=CheckUrlsInHtml(Parm.2)
  1602. else
  1603. do
  1604. PgmRc=HaveSockets
  1605. call SayAndDebugLine PgmRc
  1606. end
  1607. end
  1608. when TheCmd="CHECKLISTEDURLS" then
  1609. do forever
  1610. if HaveSockets<> '' then
  1611. do
  1612. PgmRc=HaveSockets
  1613. call SayAndDebugLine PgmRc
  1614. leave
  1615. end
  1616. PgmRc=GetFilesMatchingMasks()
  1617. if PgmRc<> '' then
  1618. leave
  1619. UrlCount=0
  1620. do Index=1 to NumberFiles
  1621. ThisFile=FileList.Index
  1622. UrlSrcFile=ThisFile
  1623. call DebugLine 'PROCESSING URL LIST: "' || ThisFile || '"'
  1624. CloseRc=stream(ThisFile, 'c', 'close')
  1625. OpenRc=stream(ThisFile, 'c', 'open read')
  1626. ThisLineNumber=0
  1627. do while lines(ThisFile)<>0
  1628. OneUrl=strip(linein(ThisFile))
  1629. ThisLineNumber=ThisLineNumber+1
  1630. if OneUrl='' then
  1631. iterate
  1632. call DebugLine '#' || ThisLineNumber || ' ' ||OneUrl
  1633. if left(OneUrl,1)=';' then
  1634. do
  1635. if left(OneUrl,length(PragmaSrcUrl))=PragmaSrcUrl then
  1636. do
  1637. UrlSrcFile=substr(OneUrl,length(PragmaSrcUrl)+1)
  1638. end
  1639. iterate
  1640. end
  1641. UrlCount=UrlCount+1
  1642. Url.UrlCount=OneUrl
  1643. UrlSrc.UrlCount=UrlSrcFile
  1644. end
  1645. CloseRc=stream(ThisFile, 'c', 'close')
  1646. end
  1647. Url.0=UrlCount
  1648. UrlSrc.0=UrlCount
  1649. call ProcessUrlArray
  1650. leave
  1651. end
  1652. otherwise
  1653. PgmRc='Unknown command of "' || TheCmd || '"!'
  1654. end
  1655. call LoggedExit(PgmRc)
  1656.  
  1657. GetFilesMatchingMasks:
  1658. NumberOfMasks=0
  1659. NumberFiles=0
  1660. do ParmIndex=2 to ParmCount
  1661. NumberOfMasks=NumberOfMasks+1
  1662. ThisMask=Parm.ParmIndex
  1663. if left(ThisMask,1)<> '+' then
  1664. SubDirFlag=''
  1665. else
  1666. do
  1667. SubDirFlag='S'
  1668. ThisMask=substr(ThisMask,2)
  1669. end
  1670. ThisList.0=0
  1671. call _SysFileTree ThisMask, 'ThisList', 'FO' ||SubDirFlag
  1672. do Index=1 to ThisList.0
  1673. NumberFiles=NumberFiles+1
  1674. FileList.NumberFiles=ThisList.Index
  1675. end
  1676. end
  1677. if NumberOfMasks=0 then
  1678. return('No file masks for URL lists were supplied!')
  1679. if NumberFiles=0 then
  1680. return('No files matched any of the URL list masks!')
  1681. return('')
  1682.  
  1683. ProcessUrlArray:
  1684. if UrlCount>1 then
  1685. do
  1686. call SayAndDebugLine 'Sorting ' || AddCommasToDecimalNumber(UrlCount) || ' URLs...'
  1687. SrtM=1
  1688. SrtCount=URL.0
  1689. do while(9*SrtM+4)<SrtCount
  1690. SrtM=SrtM*3+1
  1691. end
  1692. do while SrtM>0
  1693. SrtK=SrtCount-SrtM
  1694. do SrtJ=1 to SrtK
  1695. SrtIndex1=SrtJ
  1696. do while SrtIndex1>0
  1697. SrtIndex2=SrtIndex1+SrtM
  1698. SrtGreater=URL.SrtIndex1>URL.SrtIndex2
  1699. if SrtGreater then
  1700. do
  1701. SrtTemp=URL.SrtIndex1;URL.SrtIndex1=URL.SrtIndex2;URL.SrtIndex2=SrtTemp;SrtTemp=URLSRC.SrtIndex1;URLSRC.SrtIndex1=URLSRC.SrtIndex2;URLSRC.SrtIndex2=SrtTemp
  1702. end
  1703. else
  1704. leave
  1705. SrtIndex1=SrtIndex1-SrtM
  1706. end
  1707. end
  1708. SrtM=SrtM%3
  1709. end
  1710. end
  1711. UrlUniqueCount=0
  1712. LastUrl=''
  1713. do Index=1 to UrlCount
  1714. OneUrl=Url.Index
  1715. if OneUrl=LastUrl then
  1716. iterate
  1717. LastUrl=OneUrl
  1718. UrlUniqueCount=UrlUniqueCount+1
  1719. end
  1720. call SayAndDebugLine 'Have ' || AddCommasToDecimalNumber(UrlUniqueCount) || ' unique URLs...'
  1721. call SayAndDebugLine ''
  1722. call MemoryOpen
  1723. PgmRc=0
  1724. LastUrl=''
  1725. LastUrlRc='OK'
  1726. UrlNumber=0
  1727. UrlMovedCount=0
  1728. UrlTimedOutCount=0
  1729. do Index=1 to UrlCount
  1730. OneUrl=Url.Index
  1731. if OneUrl=LastUrl then
  1732. do
  1733. if LastUrlRc<> 'OK' then
  1734. do
  1735. ThisSrc=UrlSrc.Index
  1736. SameSrc='N'
  1737. do CheckIndex=ErrorUrlIndex to Index-1
  1738. if UrlSrc.CheckIndex=ThisSrc then
  1739. do
  1740. SameSrc='Y'
  1741. leave
  1742. end
  1743. end
  1744. if SameSrc='N' then
  1745. do
  1746. call SayAndDebugLine '     Src: ' ||ThisSrc
  1747. call Line2ErrorFile ';      URL from ' ||ThisSrc
  1748. end
  1749. end
  1750. iterate
  1751. end
  1752. LastUrl=OneUrl
  1753. if NeedToReTestUrl(OneUrl)='N' then
  1754. do
  1755. LastUrlRc='OK'
  1756. iterate
  1757. end
  1758. UrlNumber=UrlNumber+1
  1759. if UrlNumber=1 then
  1760. do
  1761. if OnlineTestUrl<> '' then
  1762. do
  1763. call SayAndDebugLine ''
  1764. call SayAndDebugLine 'Oneline? - Testing "' || OnlineTestUrl || '"'
  1765. TestUrlRc=CheckUrl(OnlineTestUrl)
  1766. if TestUrlRc='OK' then
  1767. call SayAndDebugLine '   * We seem to be online!'
  1768. else
  1769. do
  1770. call SayAndDebugLine '   * Failed: ' ||TestUrlRc
  1771. call SayAndDebugLine '   * Assuming not online'
  1772. PgmRc=9999
  1773. leave
  1774. end
  1775. end
  1776. end
  1777. call SayAndDebugLine ''
  1778. call SayAndDebugLine 'Checking: #' || UrlNumber || ' "' || OneUrl || '"'
  1779. UrlRc=CheckUrl(OneUrl)
  1780. call SayAndDebugLine '      Rc: ' ||UrlRc
  1781. if UrlRc='OK' then
  1782. do
  1783. call SaveUrlOkInformation OneUrl
  1784. end
  1785. else
  1786. do
  1787. PgmRc=PgmRc+1
  1788. ErrorUrlIndex=Index
  1789. call SaveUrlFailedInformation OneUrl,UrlRc
  1790. call Line2ErrorFile ''
  1791. call Line2ErrorFile PragmaSrcUrl||UrlSrc.Index
  1792. call Line2ErrorFile OneUrl
  1793. call Line2ErrorFile ';      ' ||UrlRc
  1794. call Line2ErrorFile ';      URL from ' ||UrlSrc.Index
  1795. call SayAndDebugLine '     Src: ' ||UrlSrc.Index
  1796. if AskAboutMovedUrls='Y' & !CheckUrl.!UrlMovedTo <> '' then
  1797. do
  1798. UrlMovedCount=UrlMovedCount+1
  1799. !MovedUrl.UrlMovedCount.!URL=OneUrl
  1800. !MovedUrl.UrlMovedCount.!UrlMovedTo=!CheckUrl.!UrlMovedTo
  1801. end
  1802. if ReadTimeout2<>0&!CheckUrl.!ErrorType='TIMEOUT' then
  1803. do
  1804. UrlTimedOutCount=UrlTimedOutCount+1
  1805. !UrlTimedOut.UrlTimedOutCount.!URL=OneUrl
  1806. end
  1807. end
  1808. LastUrlRc=UrlRc
  1809. end
  1810. if UrlTimedOutCount<>0 then
  1811. do
  1812. call MemoryClose
  1813. ReadTimeout=ReadTimeout2
  1814. do TimedOutIndex=1 to UrlTimedOutCount
  1815. OneUrl=!UrlTimedOut.TimedOutIndex.!URL
  1816. call SayAndDebugLine ''
  1817. call SayAndDebugLine 'ReTesting: "' || OneUrl || '"'
  1818. UrlRc=CheckUrl(OneUrl)
  1819. call SayAndDebugLine '       Rc: ' ||UrlRc
  1820. if UrlRc='OK' then
  1821. do
  1822. PgmRc=PgmRc-1
  1823. call SaveUrlOkInformation OneUrl
  1824. end
  1825. else
  1826. do
  1827. call SaveUrlFailedInformation OneUrl,UrlRc
  1828. end
  1829. end
  1830. end
  1831. if UrlMovedCount<>0 then
  1832. do
  1833. call MemoryClose
  1834. Question='OK?     : '
  1835. do MovedIndex=1 to UrlMovedCount
  1836. OneUrl=!MovedUrl.MovedIndex.!URL
  1837. call SayAndDebugLine ''
  1838. call SayAndDebugLine 'URL     : ' ||OneUrl
  1839. call SayAndDebugLine 'Moved To: ' ||!MovedUrl.MovedIndex.!UrlMovedTo
  1840. call charout,Question
  1841. Answer=translate(strip(linein()))
  1842. if left(Answer,1)='Y' then
  1843. Answer='YES'
  1844. else
  1845. Answer='NO'
  1846. call DebugLine 'SAID: ' ||Question||Answer
  1847. if Answer='YES' then
  1848. do
  1849. PgmRc=PgmRc-1
  1850. !CheckUrl.!LastModified='Moved to ' ||!MovedUrl.MovedIndex.!UrlMovedTo
  1851. call SaveUrlOkInformation OneUrl
  1852. end
  1853. end
  1854. end
  1855. if PgmRc<>9999 then
  1856. do
  1857. call SayAndDebugLine ''
  1858. call SayAndDebugLine ''
  1859. if PgmRc<>0 then
  1860. call SayAndDebugLine PgmRc|| ' failures out of ' ||UrlNumber
  1861. else
  1862. do
  1863. if UrlNumber=0 then
  1864. call SayAndDebugLine 'No URLs needed checking.'
  1865. else
  1866. call SayAndDebugLine 'No failures (' || UrlNumber || ' urls checked)'
  1867. end
  1868. end
  1869. call MemoryClose
  1870. return
  1871.  
  1872. GetInteger:
  1873. if datatype(arg(2), 'W')=0 then
  1874. CryAndDie(RexOptionChar||arg(1)|| ' given an invalid value of "' || arg(2) || '"')
  1875. return(strip(arg(2)))
  1876.  
  1877. SwitchOptionsValidateAgainstList:
  1878. TheCmd=arg(1)
  1879. TheOption=translate(arg(2))
  1880. ValidList=',' || translate(arg(3)) || ','
  1881. if pos(',' || TheOption || ',',ValidList)<>0 then
  1882. return(TheOption)
  1883. UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || RexOptionChar || TheCmd || '" switch!')
  1884.  
  1885. SwitchWantsYesOrNo:
  1886. TheCmd=arg(1)
  1887. TheOption=translate(arg(2))
  1888. Default=arg(3)
  1889. if TheOption='' then
  1890. return(Default)
  1891. else
  1892. return(left(SwitchOptionsValidateAgainstList(TheCmd,TheOption, "Y,N,YES,NO"),1))
  1893.  
  1894. Line2ErrorFile:
  1895. if ErrorFileName<> '' then
  1896. do
  1897. call _lineout ErrorFileName,arg(1)
  1898. call stream ErrorFileName, 'c', 'close'
  1899. end
  1900. return
  1901.  
  1902. SayAndDebugLine:
  1903. if arg(1)<> '' then
  1904. LastLineWasBlank='N'
  1905. else
  1906. do
  1907. if LastLineWasBlank='Y' then
  1908. return
  1909. else
  1910. LastLineWasBlank='Y'
  1911. end
  1912. say arg(1)
  1913. call DebugLine 'SAID: ' ||arg(1)
  1914. return
  1915.  
  1916. DebugLine:
  1917. call DebugLineNoTime time()|| ': ' ||arg(1)
  1918. return
  1919.  
  1920. DebugLineNoTime:
  1921. if DebugFileName<> '' then
  1922. do
  1923. call _lineout DebugFileName,arg(1)
  1924. call stream DebugFileName, 'c', 'close'
  1925. end
  1926. return
  1927.  
  1928. DebugChars:
  1929. if DebugFileName<> '' then
  1930. do
  1931. call charout DebugFileName,arg(1)
  1932. call stream DebugFileName, 'c', 'close'
  1933. end
  1934. return
  1935.  
  1936. ValidIpByte:
  1937. IpByte=arg(1)
  1938. if datatype(IpByte, 'W')=0 then
  1939. return('N')
  1940. if IpByte<0|IpByte>255 then
  1941. return('N')
  1942. return('Y')
  1943.  
  1944. CheckUrl:
  1945. !CheckUrl.!LastModified=''
  1946. !CheckUrl.!ErrorType=''
  1947. !CheckUrl.!UrlMovedTo=''
  1948. ProcessingThisUrl=arg(1)
  1949. if abbrev(ProcessingThisUrl, 'ftp://')then
  1950. do
  1951. if HaveFtp<> '' then
  1952. CurlRc=HaveFtp
  1953. else
  1954. CurlRc=CheckUrlFtp(ProcessingThisUrl)
  1955. end
  1956. else
  1957. do
  1958. if HaveSockets<> '' then
  1959. CurlRc=HaveSockets
  1960. else
  1961. CurlRc=CheckUrlHttp(ProcessingThisUrl)
  1962. end
  1963. ProcessingThisUrl=''
  1964. return(CurlRc)
  1965.  
  1966. CheckUrlFtp:
  1967. FullUrl=arg(1)
  1968. parse var FullUrl 'ftp://' FtpServer '/' FullFileName
  1969. SlashPos=lastpos('/',FullFileName)
  1970. if SlashPos=0 then
  1971. do
  1972. FileDir='/'
  1973. FileShort=FullFileName
  1974. end
  1975. do
  1976. FileDir='/' ||left(FullFileName,SlashPos)
  1977. FileShort=substr(FullFileName,SlashPos+1)
  1978. end
  1979. if FtpEmailAddress<> '' then
  1980. EmailAddress=FtpEmailAddress
  1981. else
  1982. EmailAddress=ShortRexxSrcName|| '@email.address.not.known'
  1983. FtpRc=FtpSetUser(FtpServer, 'Anonymous',EmailAddress)
  1984. if FtpRc=0 then
  1985. return('Could not set up the user info (email address etc)')
  1986. FtpRc=ftpchdir(FileDir)
  1987. if FtpRc<>0 then
  1988. FtpExit='Could not change to "' || FileDir || '" (' || GetFtpError() || ')'
  1989. else
  1990. do
  1991. if FileShort='' then
  1992. FtpExit='OK'
  1993. else
  1994. do
  1995. FtpFile.0=0
  1996. call FTPLs FileShort, "FtpFile."
  1997. if FtpRc<>0 then
  1998. FtpExit='Could not find "' || FileShort || '" (' || GetFtpError() || ')'
  1999. else
  2000. do
  2001. if FtpFile.0=1 then
  2002. FtpExit='OK'
  2003. else
  2004. do
  2005. FtpRc=ftpchdir('/' ||FullFileName)
  2006. if FtpRc<>0 then
  2007. FtpExit='Could not find "' || FileShort || '" in directory ' ||FileDir
  2008. else
  2009. FtpExit='OK'
  2010. end
  2011. end
  2012. end
  2013. end
  2014. call FtpLogoff
  2015. return(FtpExit)
  2016.  
  2017. CheckUrlHttp:
  2018. FullUrl=arg(1)
  2019. parse var FullUrl HttpPrefix '://' httpServer '/' HttpPageAddr
  2020. parse var httpServer httpServer ':' HttpPort
  2021. if HttpPort='' then
  2022. HttpPort=80
  2023. parse var HttpPageAddr HttpPageAddr '#'
  2024. parse var httpServer Byte1 '.' Byte2 '.' Byte3 '.' Byte4
  2025. if ValidIpByte(Byte1)='Y' & ValidIpByte(Byte2) = 'Y' & ValidIpByte(Byte3) = 'Y' & ValidIpByte(Byte4) = 'Y' then
  2026. httpServerDotted=httpServer
  2027. else
  2028. do
  2029. SocketRc=SockGetHostByName(httpServer, 'httpServer_')
  2030. if SocketRc=0 then
  2031. do
  2032. call DebugLine 'SockGetHostByName(' || httpServer || ') failed - ' || GetSockError() || ', DNS unavailable?'
  2033. return('Server name "' || httpServer || '" unknown')
  2034. end
  2035. httpServerDotted=httpServer_addr
  2036. end
  2037. if DebugFileName<> '' then
  2038. do
  2039. call DebugLine ''
  2040. call DebugLine copies('=',79)
  2041. call DebugLine ''
  2042. call DebugLine 'Details'
  2043. call DebugLine '~~~~~~~'
  2044. call DebugLine 'Full URL    :' ||FullUrl
  2045. call DebugLine 'Server Name :' ||httpServer
  2046. call DebugLine 'Server IP   :' ||httpServerDotted
  2047. call DebugLine 'Port        :' ||httpPort
  2048. call DebugLine 'Page        :' ||HttpPageAddr
  2049. call DebugLine ''
  2050. end
  2051. SocketHandle=SockSocket('AF_INET', 'SOCK_STREAM', 'IPPROTO_TCP')
  2052. SvrAddr.!family='AF_INET'
  2053. SvrAddr.!port=HttpPort
  2054. SvrAddr.!addr=httpServerDotted
  2055. SocketRc=SockConnect(SocketHandle, 'SvrAddr.!')
  2056. if SocketRc=-1 then
  2057. do
  2058. SocketRc=SockClose(SocketHandle)
  2059. return('Could not open socket for "' || httpServer || '"')
  2060. end
  2061. Eol='0D0A'x
  2062. if UseHead='Y' then
  2063. do
  2064. RequestMsg='HEAD /' || HttpPageAddr || ' HTTP/1.0' ||Eol||,
  2065. 'User-Agent: ' || ShortRexxSrcNameNoExtn || ' - ' || PgmVersion || ' - ' ||RexSystemOpSys||Eol||,
  2066. 'Host: ' || httpServer || ':' ||HttpPort||Eol||,
  2067. 'Accept: */*' ||Eol||,
  2068. Eol
  2069. end
  2070. else
  2071. do
  2072. RequestMsg='GET /' || HttpPageAddr || ' HTTP/1.0' ||Eol||,
  2073. 'User-Agent: ' || ShortRexxSrcNameNoExtn || '/' ||PgmVersion||Eol||,
  2074. 'Host: ' || httpServer || ':' ||HttpPort||Eol||,
  2075. 'Accept: */*' ||Eol||,
  2076. Eol
  2077. end
  2078. SocketRc=SockSend(SocketHandle,RequestMsg)
  2079. if(SocketRc=-1)then
  2080. do
  2081. SocketRc=SockClose(SocketHandle)
  2082. return('Error sending page request to "' || httpServer || '" (' || GetSockError() || ')')
  2083. end
  2084. call Time('R')
  2085. if DebugFileName<> '' then
  2086. do
  2087. call DebugLine 'Sent'
  2088. call DebugLine '~~~~'
  2089. call DebugLine RequestMsg
  2090. call DebugLine ''
  2091. end
  2092. WaitRead.0=1
  2093. WaitRead.1=SocketHandle
  2094. if SockSelect( "WaitRead.", "", "",ReadTimeout)=0 then
  2095. do
  2096. SocketRc=SockClose(SocketHandle)
  2097. !CheckUrl.!ErrorType='TIMEOUT'
  2098. return('Timed out (waited ' || ReadTimeout || ' seconds).')
  2099. end
  2100. SocketRc=SockRecv(SocketHandle, 'ServersResponse',SocketReadLength)
  2101. ReadTook=GetElapsedTime()
  2102. SocketRc=SockClose(SocketHandle)
  2103. if(SocketRc=-1)then
  2104. return('Error reading response from "' || httpServer || '" (' || GetSockError() || ')')
  2105. if DebugFileName<> '' then
  2106. do
  2107. ServersResponseLng=length(ServersResponse)
  2108. MsgTxt='Received ' || AddCommasToDecimalNumber(ServersResponseLng) || ' bytes, Took ' || ReadTook || ' seconds'
  2109. call DebugLine MsgTxt
  2110. call DebugLine copies('~',length(MsgTxt))
  2111. call DebugChars ServersResponse||Eol
  2112. call DebugLine ''
  2113. end
  2114. EolPos=EolPos(ServersResponse)
  2115. if EolPos=0 then
  2116. ServersResponse1stLine=ServersResponse
  2117. else
  2118. ServersResponse1stLine=left(ServersResponse,EolPos-1)
  2119. ServerRc=word(ServersResponse1stLine,2)
  2120. AddCode='Y'
  2121. select
  2122. when ServerRc='400' then
  2123. UrlRcText='BAD REQUEST'
  2124. when ServerRc='403' then
  2125. do
  2126. UrlRcText='ACCESS DENIED'
  2127. if translate(HttpPrefix)='HTTPS' then
  2128. do
  2129. AddCode='N'
  2130. UrlRcText='OK'
  2131. end
  2132. end
  2133. when ServerRc='404' then
  2134. UrlRcText='URL NOT FOUND'
  2135. when ServerRc='503' then
  2136. UrlRcText='SERVICE UNAVAILABLE'
  2137. when ServerRc='200' then
  2138. do
  2139. AddCode='N'
  2140. UrlRcText='OK'
  2141. LookFor="Last-Modified:"
  2142. LastModPos=pos(LookFor,ServersResponse)
  2143. if LastModPos=0 then
  2144. do
  2145. call DebugLine 'Could not find "' || LookFor || '"'
  2146. !CheckUrl.!LastModified=''
  2147. end
  2148. else
  2149. do
  2150. StartPos=LastModPos+length(LookFor)
  2151. EolPos=EolPos(ServersResponse,StartPos)
  2152. if EolPos=0 then
  2153. !CheckUrl.!LastModified=substr(ServersResponse,StartPos)
  2154. else
  2155. !CheckUrl.!LastModified=substr(ServersResponse,StartPos,EolPos-StartPos)
  2156. !CheckUrl.!LastModified=strip(!CheckUrl.!LastModified)
  2157. call DebugLine 'Page last modified "' || !CheckUrl.!LastModified || '"'
  2158. end
  2159. end
  2160. when ServerRc='301' | ServerRc='302' then
  2161. do
  2162. if ServerRc='301' then
  2163. UrlRcText='PERMANENT'
  2164. else
  2165. UrlRcText='TEMPORARY'
  2166. parse var ServersResponse . 'Location: ' Rest
  2167. CrPos=pos('0D'x,Rest)
  2168. NlPos=pos('0A'x,Rest)
  2169. if CrPos<>0 then
  2170. EndPos=CrPos
  2171. else
  2172. EndPos=NlPos
  2173. if EndPos=0 then
  2174. NewLocation='?'
  2175. else
  2176. NewLocation=left(Rest,EndPos-1)
  2177. if NewLocation=FullUrl|| '/' then
  2178. UrlRcText='Add terminating "/" for performance'
  2179. else
  2180. do
  2181. MsgFormatted='N'
  2182. if pos('?',FullUrl)<>0 then
  2183. do
  2184. parse var FullUrl BeforeQm '?' AfterQm
  2185. TestUrl=BeforeQm|| '/?' ||AfterQm
  2186. if NewLocation=TestUrl then
  2187. do
  2188. UrlRcText='Add "/" before "?" for performance'
  2189. MsgFormatted='Y'
  2190. end
  2191. end
  2192. if MsgFormatted='N' then
  2193. do
  2194. UrlRcText=UrlRcText|| ' move to ' ||NewLocation
  2195. !CheckUrl.!UrlMovedTo=NewLocation
  2196. end
  2197. end
  2198. end
  2199. otherwise
  2200. do
  2201. if translate(left(ServersResponse1stLine,5))='HTTP/' & datatype(ServerRc, 'W')=1 then
  2202. do
  2203. UrlRcText=subword(ServersResponse1stLine,3)
  2204. end
  2205. else
  2206. do
  2207. if MaxLineDump<>0 then
  2208. do
  2209. LineCounter=0
  2210. StartPos=1
  2211. say ' ------- UNKNOWN RESPONSE DUMP - START -------'
  2212. do until EolPos=0|LineCounter>MaxLineDump
  2213. EolPos=EolPos(ServersResponse,StartPos)
  2214. if EolPos=0 then
  2215. LineTxt=substr(ServersResponse,StartPos)
  2216. else
  2217. do
  2218. LineTxt=substr(ServersResponse,StartPos,EolPos-StartPos)
  2219. StartPos=EolPos+1
  2220. do while EolPos(ServersResponse,StartPos)=StartPos
  2221. StartPos=StartPos+1
  2222. end
  2223. end
  2224. if LineTxt<> '' then
  2225. do
  2226. LineCounter=LineCounter+1
  2227. call SayAndDebugLine right(LineCounter,2, '0') || ': ' ||LineTxt
  2228. end
  2229. end
  2230. say ' ------- UNKNOWN RESPONSE DUMP - END ---------'
  2231. end
  2232. AddCode='N'
  2233. UrlRcText='Problem unknown ==>' ||ServersResponse1stLine
  2234. end
  2235. end
  2236. end
  2237. if AddCode='Y' then
  2238. HttpRc='#' || ServerRc || ' - ' ||UrlRcText
  2239. else
  2240. HttpRc=UrlRcText
  2241. return(HttpRc)
  2242.  
  2243. GetSockError:
  2244. if RexWhich='STANDARD_OS/2' then
  2245. SockRc=errno|| '/' ||h_errno
  2246. else
  2247. SockRc=SockSock_Errno()
  2248. return(SockRc)
  2249.  
  2250. GetFtpError:
  2251. select
  2252. when FTPERRNO="FTPHOST"       then return("unknown host")
  2253. when FTPERRNO="FTPCONNECT"    then return("unable to connect to server")
  2254. when FTPERRNO="FTPLOGIN"      then return("login failed")
  2255. when FTPERRNO="FTPPROXYTHIRD" then return("proxy server does not support 3rd party transfers")
  2256. when FTPERRNO="FTPNOPRIMARY"  then return("no primary connection for proxy transfer")
  2257. otherwise return(FTPERRNO)
  2258. end
  2259.  
  2260. EolPos:
  2261. _StartPos=arg(2)
  2262. if _StartPos='' then
  2263. _StartPos=1
  2264. _CrPos=pos('0D'x,arg(1),_StartPos)
  2265. _LfPos=pos('0A'x,arg(1),_StartPos)
  2266. if _CrPos=0|_LfPos=0 then
  2267. return(max(_CrPos,_LfPos))
  2268. else
  2269. return(min(_CrPos,_LfPos))
  2270.  
  2271. GetElapsedTime:
  2272. signal on SYNTAX name ElapsedTimeBugWorkaround
  2273. getTime=time('E')
  2274. return(trunc(getTime,2))
  2275.  
  2276. ElapsedTimeBugWorkaround:
  2277. return('?')
  2278.  
  2279. InitializeSocketSupport:
  2280. call RxFuncAdd "SockLoadFuncs", "RxSock.DLL", "SockLoadFuncs"
  2281. signal on SYNTAX name RxSockDllMissing
  2282. if RexWhich='STANDARD_OS/2' then
  2283. call SockLoadFuncs "NoCopyrightDisplayEtc"
  2284. else
  2285. call SockLoadFuncs
  2286. return('')
  2287.  
  2288. RxSockDllMissing:
  2289. return("Can't locate RxSock.DLL")
  2290.  
  2291. InitializeFtpSupport:
  2292. call RxFuncAdd "FtpLoadFuncs", "RxFtp.DLL", "FtpLoadFuncs"
  2293. signal on SYNTAX name RxFtpDllMissing
  2294. call FtpLoadFuncs "NoCopyrightDisplayEtc"
  2295. return('')
  2296.  
  2297. RxFtpDllMissing:
  2298. return("Can't locate RxFtp.DLL")
  2299.  
  2300. ReplaceAnyFileNameSymbols:
  2301. parse value time('N') with Hours ':' Minutes ':' Seconds
  2302. CurrentTime=Hours||Minutes||Seconds
  2303. CurrentDate=date('S')
  2304. NewText=ReplaceString(arg(1), "{Time}",CurrentTime)
  2305. NewText=ReplaceString(NewText, "{Date}",CurrentDate)
  2306. return(NewText)
  2307.  
  2308. AddCommasToDecimalNumber:procedure
  2309. NoComma=strip(arg(1))
  2310. if pos(',',NoComma)<>0 then
  2311. return(NoComma)
  2312. DotPos=pos('.',NoComma)
  2313. if DotPos=0 then
  2314. AfterDecimal=''
  2315. else
  2316. do
  2317. if DotPos=1 then
  2318. return("0" ||NoComma)
  2319. AfterDecimal=substr(NoComma,DotPos+1)
  2320. NoComma=left(NoComma,DotPos-1)
  2321. end
  2322. NoComma=reverse(NoComma)
  2323. ResultWithCommas=""
  2324. do while length(NoComma)>3
  2325. ResultWithCommas=ResultWithCommas||left(NoComma,3)|| ','
  2326. NoComma=substr(NoComma,4)
  2327. end
  2328. ResultWithCommas=ResultWithCommas||NoComma
  2329. ResultWithCommas=reverse(ResultWithCommas)
  2330. if AfterDecimal<> '' then
  2331. ResultWithCommas=ResultWithCommas|| '.' ||AfterDecimal
  2332. return(ResultWithCommas)
  2333.  
  2334. ReplaceString:
  2335. TheString=arg(1)
  2336. ChangeFrom=arg(2)
  2337. ChangeTo=arg(3)
  2338. ChangeFromLength=length(ChangeFrom)
  2339. ChangeToLength=length(ChangeTo)
  2340. FoundPosn=pos(ChangeFrom,TheString)
  2341. do while FoundPosn<>0
  2342. TheString=left(TheString,FoundPosn-1)||ChangeTo||substr(TheString,FoundPosn+ChangeFromLength)
  2343. FoundPosn=pos(ChangeFrom,TheString,FoundPosn+ChangeToLength)
  2344. end
  2345. return(TheString)
  2346.  
  2347. CloseAndDeleteFile:
  2348. dfFile=arg(1)
  2349. CloseRc=stream(dfFile, 'c', 'close')
  2350. DosDelRc=_SysFileDelete(dfFile)
  2351. return(DosDelRc)
  2352.  
  2353. DebugAddressCmdBefore:
  2354. call DebugLine 'Executing: ' ||arg(1)
  2355. return
  2356.  
  2357. DebugAddressCmdOutput:
  2358. DbgLineNumber=arg(2)
  2359. if datatype(DbgLineNumber, 'W')=0 then
  2360. call DebugLine '  > ' ||arg(1)
  2361. else
  2362. do
  2363. if DbgLineNumber<999 then
  2364. DbgLineNumber=right(DbgLineNumber,3, '0')
  2365. call DebugLine '  > ' || DbgLineNumber || ': ' ||arg(1)
  2366. end
  2367. return
  2368.  
  2369. DebugAddressCmdAfter:
  2370. call DebugLine '  Rc = ' ||arg(1)
  2371. return
  2372.  
  2373. _Lineout:
  2374. loFileName=arg(1)
  2375. loTheLine=arg(2)
  2376. if 0<>lineout(loFileName,loTheLine)then
  2377. do
  2378. if Dying='N' then
  2379. do
  2380. FileState=stream(loFileName, 'Description')
  2381. CryAndDie('Failed writing line to "' || loFileName || '" - ' ||FileState)
  2382. end
  2383. end
  2384. return
  2385.  
  2386. CryAndDie:
  2387. signal off HALT
  2388. call on HALT name RexxCtrlCIgnore
  2389. ExitRc=SIGL
  2390. Dying='Y'
  2391. call SayAndDebugLine "ERROR: " ||arg(1)
  2392. if MemoryNeedsUpdating()='Y' then
  2393. do
  2394. call MemoryClose
  2395. end
  2396. call LoggedExit(ExitRc)
  2397.  
  2398. LoggedExit:
  2399. PgmRc=arg(1)
  2400. OrigPgmRc=PgmRc
  2401. if RexWhich='REGINA' then
  2402. do
  2403. if PgmRc='OK' then
  2404. PgmRc=0
  2405. else
  2406. PgmRc=1000+length(PgmRc)
  2407. end
  2408. call DebugLine ''
  2409. call DebugLine 'Return code'
  2410. call DebugLine '~~~~~~~~~~~'
  2411. if OrigPgmRc=PgmRc then
  2412. call DebugLine PgmRc
  2413. else
  2414. call DebugLine PgmRc|| ' , translated from => ' ||OrigPgmRc
  2415. call DebugLine ''
  2416. exit(PgmRc)
  2417.  
  2418. MyLineNumber:
  2419. return(SIGL)
  2420.  
  2421. DisplayCopyright:
  2422. if CopyrightDisplayed='N' then
  2423. do
  2424. say '[]-------------------------------------------------------------------------[]'
  2425. say '| PPWCURL.CMD: Version ' || PgmVersion || ' (C)opyright Dennis Bareis 1999                |'
  2426. say '| http://www.labyrinth.net.au/~dbareis/index.htm (dbareis@labyrinth.net.au) |'
  2427. say '[]-------------------------------------------------------------------------[]'
  2428. CopyrightDisplayed='Y'
  2429. end
  2430. return
  2431.  
  2432. UserSyntaxError:
  2433. call DisplayCopyright
  2434. say "SYNTAX ERROR"
  2435. say "~~~~~~~~~~~~"
  2436. say '    ' ||arg(1)
  2437. say ''
  2438. say 'CORRECT SYNTAX'
  2439. say '~~~~~~~~~~~~~~'
  2440. say '    PPWCURL[.CMD] Command [Parm1 ...] [Option1 ...]'
  2441. say ''
  2442. say 'SOME OPTIONS'
  2443. say '~~~~~~~~~~~~'
  2444. say RexOptionChar|| 'ErrorFile[:[+]FileName] = Generate list of error URLs'
  2445. say RexOptionChar|| 'MemoryFile[:FileName]   = Long term memory of results'
  2446. say RexOptionChar|| 'CheckDays[:Period]      = Controls how long term memory used'
  2447. say RexOptionChar|| 'TestUrl[:Url]           = Define known URL which exists'
  2448. say RexOptionChar|| 'ReadTimeout:Seconds     = Define read timeout'
  2449. say RexOptionChar|| 'GetEnv:NameOfVariable   = Specify source of more options'
  2450. say ''
  2451. say 'Please see "PPWIZARD.INF" for more details (and more options).' ||Beep||Beep
  2452. LoggedExit(MyLineNumber())
  2453.  
  2454. RexxTrapAddInfo:
  2455. if symbol('ProcessingThisUrl') = 'VAR' then
  2456. do
  2457. if ProcessingThisUrl<> '' then
  2458. call SayAndDebugLine left('URL', 16) || ': ' ||ProcessingThisUrl
  2459. end
  2460. return
  2461.  
  2462. RexxTrapDying:
  2463. call charout,Beep||Beep
  2464. call LoggedExit arg(1)
  2465.  
  2466. RexxCtrlC:
  2467. IgnoredCount=0
  2468. LineCtrlC=SIGL
  2469. signal off HALT
  2470. call on HALT name RexxCtrlCIgnore
  2471. call SayAndDebugLine ''
  2472. call SayAndDebugLine copies('=+',39)
  2473. call SayAndDebugLine "Come on, you pressed Ctrl+C or Break didn't you!"
  2474. call SayAndDebugLine copies('=+',39)
  2475. if MemoryNeedsUpdating()='Y' then
  2476. do
  2477. say ''
  2478. say 'Please wait while INI is updated....'
  2479. call MemoryClose
  2480. say ''
  2481. say 'Phew... Lucky Phil, INI file update completed!'
  2482. end
  2483. exit(LineCtrlC)
  2484.  
  2485. RexxCtrlCIgnore:
  2486. IgnoredCount=IgnoredCount+1
  2487. call off HALT
  2488. call on HALT name RexxCtrlCIgnore
  2489. if IgnoredCount<>1 then
  2490. say "Some people just don't listen!"
  2491. say 'WARNING: Please wait while INI is updated....'
  2492. re
  2493.