home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / ppwcurl.zip / ppwcurl.cmd
OS/2 REXX Batch file  |  1999-11-25  |  58KB  |  2,464 lines
  1. /*
  2.  * Generator   : PPWIZARD version 99.325
  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        : Thursday, 25 Nov 1999 6:04:13pm
  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.11 25 Nov 1999 17:57:28 Dennis_Bareis $
  14. */
  15. UserRequest=strip(arg(1))
  16. if translate(UserRequest)="DEBUG" then
  17. exit(0)
  18. PgmVersion='99.325'
  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.255 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 value Strip(dv_RexxExp, 'L')with 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 99.275 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. Stderr2:
  577. if RexSystemOpSys="DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  578. return('')
  579. else
  580. return(' 2>' ||arg(1))
  581.  
  582. AddressCmd:
  583. SysCmd2Exec=arg(1)
  584. if RexWhich='STANDARD_OS/2' then
  585. SysCmd2Exec='@' ||SysCmd2Exec
  586. call DebugAddressCmdBefore SysCmd2Exec
  587. SysCmd2Exec
  588. SysCmdRc=Rc
  589. FileIndex=2
  590. SysCmdFile=arg(FileIndex)
  591. do while SysCmdFile<> ''
  592. call DebugAddressCmdOutput SysCmdFile, 'H1'
  593. call DebugAddressCmdOutput copies('~', length(SysCmdFile)), 'H2'
  594. if stream(SysCmdFile, 'c', 'query exists') = '' then
  595. call DebugAddressCmdOutput '*File does not exist*',     '!'
  596. else
  597. do
  598. SysCmdLine=0
  599. CloseRc=stream(SysCmdFile, 'c', 'close')
  600. do while lines(SysCmdFile)<>0
  601. SysCmdLine=SysCmdLine+1
  602. call DebugAddressCmdOutput linein(SysCmdFile),SysCmdLine
  603. end
  604. CloseRc=stream(SysCmdFile, 'c', 'close')
  605. end
  606. FileIndex=FileIndex+1
  607. SysCmdFile=arg(FileIndex)
  608. end
  609. call DebugAddressCmdAfter SysCmdRc
  610. Rc=SysCmdRc
  611. return(SysCmdRc)
  612.  
  613. _filespec:
  614. fsCmd=translate(arg(1))
  615. select
  616. when fsCmd='D' | fsCmd = 'DRIVE' then
  617. do
  618. if RexSystemOpSys="UNIX" then
  619. return('')
  620. fsPos=pos(':',arg(2))
  621. if fsPos=0 then
  622. return('')
  623. else
  624. return(left(arg(2),fsPos))
  625. end
  626. when fsCmd='P' | fsCmd = 'PATH' then
  627. do
  628. fsStartWith=substr(arg(2),length(_filespec('D',arg(2)))+1)
  629. fsPos=lastpos(RexDirChar,fsStartWith)
  630. if fsPos=0 then
  631. return('')
  632. else
  633. return(left(fsStartWith,fsPos))
  634. end
  635. when fsCmd='N' | fsCmd = 'NAME' then
  636. do
  637. return(substr(arg(2),length(_filespec('L',arg(2)))+1))
  638. end
  639. when fsCmd='L' | fsCmd = 'LOCATION' then
  640. do
  641. return(_filespec('D', arg(2)) || _filespec('P',arg(2)))
  642. end
  643. when fsCmd='E' | fsCmd = 'EXTN' then
  644. do
  645. fsDotPos=lastpos('.',arg(2))
  646. if fsDotPos=0 then
  647. return('')
  648. else
  649. return(substr(arg(2),fsDotPos+1))
  650. end
  651. when fsCmd='W' | fsCmd = 'WITHOUTEXTN' then
  652. do
  653. fsDotPos=lastpos('.',arg(2))
  654. if fsDotPos=0 then
  655. return(arg(2))
  656. else
  657. return(left(arg(2),fsDotPos-1))
  658. end
  659. otherwise
  660. end
  661. return
  662.  
  663. _SysFileTree:
  664. if RexWhich='STANDARD_OS/2' then
  665. return(SysFileTree(arg(1),arg(2),arg(3),arg(4),arg(5)))
  666. if pos('D',arg(3))<>0 then
  667. stfType='D'
  668. else
  669. stfType='F'
  670. TmpDirFile=RexGetTmpFileName()
  671. if RexSystemOpSys<> "UNIX" then
  672. do
  673. DirCmd='dir /B '
  674. if pos('S',arg(3))<>0 then
  675. DirCmd=DirCmd|| "/S "
  676. if stfType='F' then
  677. DirCmd=DirCmd|| "/A-D "
  678. else
  679. DirCmd=DirCmd|| "/AD "
  680. DirCmd=DirCmd||arg(1)|| ' > ' || TmpDirFile || Stderr2('&1')
  681. end
  682. else
  683. do
  684. DirCmd='find ' || _filespec('L', arg(1)) || ' -noleaf '
  685. if pos('S',arg(3))=0 then
  686. DirCmd=DirCmd|| '-maxdepth 1 '
  687. if stfType='F' then
  688. DirCmd=DirCmd|| "-type f "
  689. else
  690. DirCmd=DirCmd|| "-type d "
  691. stfSName=_filespec('N',arg(1))
  692. if stfSName<> '' then
  693. DirCmd=DirCmd|| '-name "' || stfSName || '"'
  694. DirCmd=DirCmd|| ' >& ' ||TmpDirFile
  695. end
  696. Rc=AddressCmd(DirCmd,TmpDirFile)
  697. LastSlash=lastpos(RexDirChar,arg(1))
  698. CloseRc=stream(TmpDirFile, 'c', 'close')
  699. TmpLine=0
  700. do while lines(TmpDirFile)<>0
  701. AFile=linein(TmpDirFile)
  702. if AFile='' | AFile = '.' | AFile = '..' then
  703. iterate
  704. if RexSystemOpSys="UNIX" & stfType = 'D' then
  705. do
  706. if AFile=_filespec('L',arg(1))then
  707. iterate
  708. end
  709. if LastSlash<>0 then
  710. do
  711. if pos(RexDirChar,AFile)==0 then
  712. AFile=left(arg(1),LastSlash)||AFile
  713. end
  714. if stfType='F' then
  715. do
  716. AFile=stream(AFile, 'c', 'query exists')
  717. if AFile='' then
  718. iterate
  719. end
  720. else
  721. do
  722. if pos(' ',AFile)<>0 then
  723. iterate
  724. end
  725. TmpLine=TmpLine+1
  726. call _valueS arg(2)|| '.' ||TmpLine,strip(AFile)
  727. end
  728. CloseRc=stream(TmpDirFile, 'c', 'close')
  729. DeleteRc=_SysFileDelete(TmpDirFile)
  730. call _valueS arg(2)|| '.0',TmpLine
  731. return(0)
  732.  
  733. _SysFileDelete:
  734. if RexWhich='STANDARD_OS/2' then
  735. return(SysFileDelete(arg(1)))
  736. if RexSystemOpSys="DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  737. return(AddressCmd('if exist ' || arg(1) || ' del ' || arg(1) || ' >nul'))
  738. else
  739. do
  740. if RexSystemOpSys="UNIX" then
  741. return(AddressCmd('rm -f '  || arg(1) || ' >& /dev/null'))
  742. else
  743. return(AddressCmd('del ' || arg(1) || ' >nul' || Stderr2('&1')))
  744. end
  745.  
  746. RexGetTmpFileName:
  747. if arg(1)<> '' then
  748. TmpFileM=arg(1)
  749. else
  750. do
  751. if RexSystemOpSys<> "UNIX" then
  752. TmpFileM='RSTM????.TMP'
  753. else
  754. do
  755. TmpFileM=GetEnv('USER')
  756. if TmpFileM='' then
  757. TmpFileM=GetEnv('user')
  758. if TmpFileM='' then
  759. TmpFileM='?????.rstm'
  760. else
  761. TmpFileM=TmpFileM|| '_?????.rstm'
  762. end
  763. end
  764. TmpFileM=RexGetNameOfTmpDir()||RexDirChar||TmpFileM
  765. if RexWhich='STANDARD_OS/2' then
  766. do
  767. TmpFileF=SysTempFileName(TmpFileM)
  768. if TmpFileF='' then
  769. do
  770. RexTmpFileCntr=RexTmpFileCntr+1
  771. TmpFileF='C_' || right(RexTmpFileCntr, 6, '0') || '.TMP'
  772. end
  773. return(TmpFileF)
  774. end
  775. TmpRandom=right(time('S'),3)||random(99999)
  776. TmpRandomAdd=0
  777. do until stream(TmpFileA, 'c', 'query exists') = ''
  778. TmpRandomS=d2x(TmpRandom+TmpRandomAdd)
  779. TmpFileA=changestr("?????", TmpFileM, right(TmpRandom, 5, '_'))
  780. TmpFileA=changestr("????",  TmpFileA, right(TmpRandom, 4, '_'))
  781. TmpFileA=changestr("???",   TmpFileA, right(TmpRandom, 3, '_'))
  782. TmpFileA=changestr("??",    TmpFileA, right(TmpRandom, 2, '_'))
  783. TmpFileA=changestr("?",     TmpFileA, right(TmpRandom, 1, '_'))
  784. TmpRandomAdd=TmpRandomAdd+1
  785. end
  786. return(TmpFileA)
  787.  
  788. GetEnv:
  789. return(value(arg(1),,RexEnvVarPool))
  790.  
  791. _valueS:
  792. if RexWhich='STANDARD_OS/2' then
  793. return(value(arg(1),arg(2)))
  794. return(value(translate(arg(1)),arg(2)))
  795.  
  796. _valueG:
  797. if RexWhich='STANDARD_OS/2' then
  798. return(value(arg(1)))
  799. return(value(arg(1)))
  800.  
  801. REXSYSTM_2:
  802. DebugFileName=ReplaceAnyFileNameSymbols(GetEnv('PPWCURL_DEBUG'))
  803. if left(DebugFileName,1)='+' then
  804. DebugFileName=substr(DebugFileName,2)
  805. else
  806. do
  807. if DebugFileName<> '' then
  808. DosDelRc=CloseAndDeleteFile(DebugFileName)
  809. end
  810. call DebugLine ''
  811. call DebugLine ''
  812. call DebugLine copies('=',79)
  813. call DebugLine '        Time: ' ||date()
  814. call DebugLine 'Command Line: ' ||UserRequest
  815. call DebugLine '   Op System: ' ||RexSystemOpSys
  816. call DebugLine ' Interpreter: ' ||RexVersionInfo
  817. call DebugLine copies('=',79)
  818. call DebugLine ''
  819. signal PPWCURLX_3;
  820.  
  821. CheckUrlsInHtml:
  822. PgmRc=GetFilesMatchingMasks()
  823. if PgmRc<> '' then
  824. return(PgmRc)
  825. Dangerous='"' || "'" ||d2c(9)||d2c(27)
  826. UrlCount=0
  827. do Index=1 to NumberFiles
  828. UrlSourceFile=FileList.Index
  829. LineNumber=0
  830. Urls=0
  831. CloseRc=stream(UrlSourceFile, 'c', 'close')
  832. do while lines(UrlSourceFile)<>0
  833. CurrentLine=linein(UrlSourceFile)
  834. LineNumber=LineNumber+1
  835. CurrentLine=translate(CurrentLine, '', Dangerous, ' ')
  836. do WordIndex=1 to words(CurrentLine)
  837. MaybeUrl=word(CurrentLine,WordIndex)
  838. if abbrev(MaybeUrl, 'http://') | abbrev(MaybeUrl, 'ftp://')then
  839. do
  840. UrlCount=UrlCount+1
  841. Url.UrlCount=MaybeUrl
  842. UrlSrc.UrlCount=UrlSourceFile|| '(' || LineNumber || ')'
  843. end
  844. end
  845. end
  846. CloseRc=stream(UrlSourceFile, 'c', 'close')
  847. end
  848. Url.0=UrlCount
  849. UrlSrc.0=UrlCount
  850. call ProcessUrlArray
  851. return(PgmRc)
  852.  
  853. PPWCURLX_3:
  854. /*
  855. *BASEDATE.XH Version 99.034 by Dennis Bareis
  856. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  857. */
  858. signal EndBASEDATEXh
  859.  
  860. BaseDate:procedure
  861. TheDate=translate(arg(1), ' ', '/-')
  862. if TheDate='' then
  863. TheDate=date('Sorted')
  864. parse var TheDate Year MM DD
  865. if length(Year)>=8 then
  866. do
  867. DD=substr(Year,7,2)
  868. MM=substr(Year,5,2)
  869. Year=left(Year,4)
  870. end
  871. DaysInMonth='31  28  31  30  31  30  31  31  30  31  30  31'
  872. if datatype(Year, 'WholeNumber')<>1 then
  873. return(-10)
  874. if datatype(MM, 'WholeNumber')<>1 then
  875. return(-20)
  876. if datatype(DD, 'WholeNumber')<>1 then
  877. return(-30)
  878. if MM<0|MM>12 then
  879. return(-21)
  880. DaysThisMonth=word(DaysInMonth,MM)
  881. if MM=2 then
  882. DaysThisMonth=DaysThisMonth+1
  883. if DD<0|DD>DaysThisMonth then
  884. return(-31)
  885. if length(strip(Year))=2 then
  886. do
  887. if Year>=80 then
  888. Year='19' ||Year
  889. else
  890. Year='20' ||Year
  891. end
  892. y=Year-0001
  893. b=y*365
  894. b=b+y%4
  895. b=b-y%100
  896. b=b+y%400
  897. m=mm-01
  898. do i=1 to m
  899. b=b+word(DaysInMonth,i)
  900. end
  901. if mm>2 then
  902. do
  903. if 0=Year//4 then
  904. do
  905. if 0=Year//100 then
  906. do
  907. if 0=Year//400 then
  908. b=b+1
  909. end
  910. else
  911. b=b+1
  912. end
  913. end
  914. d=dd-01
  915. b=b+d
  916. return(b)
  917.  
  918. EndBASEDATEXh:
  919. /*
  920. *FASTINI.XH Version 98.147 by Dennis Bareis
  921. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  922. */
  923. _FiOpenCount=0
  924. call RxFuncAdd 'FastIniStart',   'FastIni',  'FastIniStart'
  925. call RxFuncAdd 'FastIniEnd',     'FastIni',  'FastIniEnd'
  926. call RxFuncAdd 'FastIniVersion', 'FastIni',  'FastIniVersion'
  927. _fiAvailable=_FastIniOk()
  928. signal EndFASTINIXh
  929.  
  930. FastIniIsFast:
  931. return(_fiAvailable)
  932.  
  933. FastIniOpenIni:
  934. _fiFile=arg(1)
  935. _fiHandleVar=arg(2)
  936. if _fiAvailable='N' then
  937. do
  938. interpret _fiHandleVar|| ' = 0'
  939. return('OK')
  940. end
  941. interpret _fiHandleVar|| ' = ""'
  942. _fiFastRc=FastIniStart(_fiFile,_fiHandleVar)
  943. interpret '_FiHandle = ' ||_fiHandleVar
  944. if _FiHandle<> '' then
  945. do
  946. _FiOpenCount=_FiOpenCount+1
  947. _FiOpenedList._FiOpenCount=_FiHandle
  948. end
  949. return(_fiFastRc)
  950.  
  951. FastIniCloseIni:
  952. if _fiAvailable='N' then
  953. return('OK')
  954. return(FastIniEnd(arg(1)))
  955.  
  956. FastIniGetVersion:
  957. if _fiAvailable='Y' then
  958. return(FastIniVersion(arg(1)))
  959. else
  960. do
  961. interpret arg(1)|| ' = "00.000 http://www.labyrinth.net.au/~dbareis/index.htm db0@anz.com Dennis Bareis"'
  962. return('OK')
  963. end
  964.  
  965. FastIniCleanup:
  966. if _fiAvailable='N' then
  967. return('OK')
  968. do _fi=1 to _FiOpenCount
  969. call FastIniEnd(_FiOpenedList._fi)
  970. _FiOpenedList._fi=0
  971. end
  972. _FiOpenCount=0
  973. return('OK')
  974.  
  975. _FastIniOk:
  976. signal on SYNTAX name _FastIniNotOk
  977. interpret "_fiRc = FastIniVersion('_fiVersion')"
  978. return('Y')
  979.  
  980. _FastIniNotOk:
  981. return('N')
  982.  
  983. EndFASTINIXh:
  984. TryQuotes='"' || "'" ||xrange(d2c(127),d2c(255))||xrange(d2c(1),d2c(31))
  985. UrlCount=0
  986. UrlInfoNeedsWriting='N'
  987. MemoryBackupLevel=3
  988. StartIndex=1
  989. OkIndex=1
  990. Step=1000
  991. do forever
  992. do Index=StartIndex to 10000 by Step
  993. if symbol(copies('A', Index)) = 'BAD' then
  994. leave
  995. else
  996. OkIndex=Index
  997. end
  998. if Step=1 then
  999. leave
  1000. else
  1001. do
  1002. StartIndex=OkIndex
  1003. Step=Step%10
  1004. if Step=0 then
  1005. Step=1
  1006. end
  1007. end
  1008. TrunUrlCodeTo=OkIndex-10
  1009. call DebugLine 'Longest Rexx symbol is ' || OkIndex || ' byte(s) minimum'
  1010. signal PPWCURLI_4;
  1011.  
  1012. GetQuotedText:
  1013. parse arg TheString,RestVarName
  1014. TheString=strip(TheString, 'L')
  1015. if TheString='' then
  1016. return('')
  1017. QuoteChar=left(TheString,1)
  1018. do
  1019. SecondQuotePosn=pos(QuoteChar,TheString,2)
  1020. if SecondQuotePosn=0 then
  1021. return('')
  1022. QuotedString=substr(TheString,2,SecondQuotePosn-2)
  1023. TheRest=substr(TheString,SecondQuotePosn+1)
  1024. end
  1025. TheRest=strip(TheRest, 'L')
  1026. if RestVarName<> '' then
  1027. call _valueS RestVarName,TheRest
  1028. return(QuotedString)
  1029.  
  1030. CreateUrl2IndexMapping:
  1031. parse arg MapIndex,MapUrl
  1032. UrlCode=c2x(MapUrl)
  1033. SavedWhere='!F' ||UrlCode
  1034. if symbol(SavedWhere)<> 'BAD' then
  1035. call _valueS SavedWhere,MapIndex
  1036. else
  1037. do
  1038. SavedWhere='!P' || left(UrlCode, TrunUrlCodeTo) || '.'
  1039. SavedWhere0=SavedWhere|| '0'
  1040. if symbol(SavedWhere0)<> 'VAR' then
  1041. do
  1042. call _valueS SavedWhere0,1
  1043. call _valueS SavedWhere|| '1', MapIndex || ',' ||MapUrl
  1044. end
  1045. else
  1046. do
  1047. DupCount=_valueG(SavedWhere0)+1
  1048. call _valueS SavedWhere0,DupCount
  1049. call _valueS SavedWhere||DupCount,MapIndex|| ',' ||MapUrl
  1050. end
  1051. end
  1052. return
  1053.  
  1054. GetInfoIndex4Url:
  1055. giUrl=arg(1)
  1056. giAdding=arg(2)
  1057. UrlCode=c2x(giUrl)
  1058. SavedWhere='!F' ||UrlCode
  1059. UrlSymbol=symbol(SavedWhere)
  1060. if UrlSymbol<> 'BAD' then
  1061. do
  1062. if UrlSymbol='VAR' then
  1063. giIndex=_valueG(SavedWhere)
  1064. else
  1065. giIndex=0
  1066. end
  1067. else
  1068. do
  1069. SavedWhere='!P' || left(UrlCode, TrunUrlCodeTo) || '.'
  1070. SavedWhere0=SavedWhere|| '0'
  1071. if symbol(SavedWhere0)<> 'VAR' then
  1072. giIndex=0
  1073. else
  1074. do
  1075. giIndex=0
  1076. do LookIndex=1 to _valueG(SavedWhere0)
  1077. parse value _valueG(SavedWhere||LookIndex)with giIndexT ',' giUrlT
  1078. if giUrlT=giUrl then
  1079. do
  1080. giIndex=giIndexT
  1081. leave
  1082. end
  1083. end
  1084. end
  1085. end
  1086. if giIndex=0 then
  1087. do
  1088. if giAdding='Y' then
  1089. do
  1090. UrlIniCount=UrlIniCount+1
  1091. giIndex=UrlIniCount
  1092. call CreateUrl2IndexMapping giIndex,giUrl
  1093. end
  1094. end
  1095. return(giIndex)
  1096.  
  1097. MemoryOpen:
  1098. UrlIniCount=0
  1099. UrlInfoNeedsWriting='N'
  1100. if IniFileName='' then
  1101. return
  1102. CloseRc=stream(IniFileName, 'c', 'close')
  1103. do while lines(IniFileName)<>0
  1104. CurrentLine=strip(linein(IniFileName))
  1105. if CurrentLine='' | left(CurrentLine,1) = ';' then
  1106. iterate
  1107. UrlIniCount=UrlIniCount+1
  1108. if left(CurrentLine,1)='+' then
  1109. StatusOk='Y'
  1110. else
  1111. StatusOk='N'
  1112. URL=GetQuotedText(substr(CurrentLine,2), "Rest")
  1113. !URL.UrlIniCount.!UrlStatusOk=StatusOk
  1114. !URL.UrlIniCount.!Url=URL
  1115. !URL.UrlIniCount.!LastChecked=GetQuotedText(Rest, "Rest")
  1116. if StatusOk='Y' then
  1117. !URL.UrlIniCount.!LastModified=GetQuotedText(Rest, "Rest")
  1118. else
  1119. !URL.UrlIniCount.!Reason=GetQuotedText(Rest, "Rest")
  1120. !URL.UrlIniCount.!Updated='N'
  1121. call CreateUrl2IndexMapping UrlIniCount,Url
  1122. end
  1123. CloseRc=stream(IniFileName, 'c', 'close')
  1124. return
  1125.  
  1126. QuoteIt:
  1127. Quote4=arg(1)
  1128. TryQuoteLng=length(TryQuotes)
  1129. do QuoteIndex=1 to TryQuoteLng
  1130. PossibleQuote=substr(TryQuotes,QuoteIndex,1)
  1131. if pos(PossibleQuote,Quote4)=0 then
  1132. leave
  1133. end
  1134. return(PossibleQuote||arg(1)||PossibleQuote)
  1135.  
  1136. MemoryNeedsUpdating:
  1137. if IniFileName='' then
  1138. return('N')
  1139. else
  1140. do
  1141. if UrlInfoNeedsWriting='N' then
  1142. return('N')
  1143. else
  1144. return('Y')
  1145. end
  1146.  
  1147. _MemoryCloseWrite:
  1148. WriteWhatIndex=arg(1)
  1149. if !URL.WriteWhatIndex.!UrlStatusOk='Y' then
  1150. do
  1151. OkCount=OkCount+1
  1152. if OkCount=1 then
  1153. do
  1154. call _lineout IniFileName, ';-----------------------------'
  1155. call _lineout IniFileName, ';--- URLS without problems ---'
  1156. call _lineout IniFileName, ';-----------------------------'
  1157. call _lineout IniFileName, ''
  1158. end
  1159. Output='+  '  || QuoteIT(!URL.WriteWhatIndex.!Url)          || '  '
  1160. Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastChecked)|| '  '
  1161. Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastModified)
  1162. end
  1163. else
  1164. do
  1165. ErrCount=ErrCount+1
  1166. if ErrCount=1 then
  1167. do
  1168. call _lineout IniFileName, ';--------------------------'
  1169. call _lineout IniFileName, ';--- URLS with problems ---'
  1170. call _lineout IniFileName, ';--------------------------'
  1171. call _lineout IniFileName, ''
  1172. end
  1173. Output='-  '  || QuoteIT(!URL.WriteWhatIndex.!Url)          || '  '
  1174. Output=Output||QuoteIT(!URL.WriteWhatIndex.!LastChecked)|| '  '
  1175. Output=Output||QuoteIT(!URL.WriteWhatIndex.!Reason)
  1176. end
  1177. call _lineout IniFileName,Output
  1178. return
  1179.  
  1180. WantToForgetUrl:
  1181. wfuIndex=arg(1)
  1182. DateChecked=!URL.wfuIndex.!LastChecked
  1183. if datatype(DateChecked, 'W')=0 then
  1184. return('Y')
  1185. if(BaseDate()-DateChecked)>ForgetDays then
  1186. return('Y')
  1187. else
  1188. return('N')
  1189.  
  1190. MemoryClose:
  1191. if MemoryNeedsUpdating()='N' then
  1192. return
  1193. if stream(IniFileName, 'c', 'query exists') <> '' &MemoryBackupLevel<>0 then
  1194. do
  1195. BaseLess1=_filespec('name',IniFileName)
  1196. BaseLess1=left(BaseLess1,length(BaseLess1)-1)
  1197. WholeLess1=left(IniFileName,length(IniFileName)-1)
  1198. OldestFile=WholeLess1||MemoryBackupLevel
  1199. call CloseAndDeleteFile OldestFile
  1200. do BackupIndex=0 to MemoryBackupLevel-1
  1201. ToChar=MemoryBackupLevel-BackupIndex
  1202. FromChar=ToChar-1
  1203. if FromChar=0 then
  1204. FromChar=right(IniFileName,1)
  1205. call AddressCmd 'ren ' || WholeLess1 || FromChar || ' ' || BaseLess1 || ToChar || ' >nul ' || Stderr2('&1')
  1206. end
  1207. MemoryBackupLevel=0
  1208. end
  1209. call CloseAndDeleteFile IniFileName
  1210. OkCount=0
  1211. ErrCount=0
  1212. do Index=1 to UrlIniCount
  1213. if !URL.Index.!UrlStatusOk='Y' & !URL.Index.!Updated = 'Y' then
  1214. call _MemoryCloseWrite Index
  1215. end
  1216. do Index=1 to UrlIniCount
  1217. if !URL.Index.!UrlStatusOk='Y' & !URL.Index.!Updated = 'N' & WantToForgetUrl(Index) = 'N' then
  1218. call _MemoryCloseWrite Index
  1219. end
  1220. if OkCount<>0 then
  1221. do
  1222. call _lineout IniFileName, ';  ' || OkCount || ' Url(s) are OK'
  1223. call _lineout IniFileName, ''
  1224. call _lineout IniFileName, ''
  1225. end
  1226. do index=1 to UrlIniCount
  1227. if !URL.Index.!UrlStatusOk='N' & !URL.Index.!Updated = 'Y' then
  1228. call _MemoryCloseWrite Index
  1229. end
  1230. do index=1 to UrlIniCount
  1231. if !URL.Index.!UrlStatusOk='N' & !URL.Index.!Updated = 'N'  & WantToForgetUrl(Index) = 'N' then
  1232. call _MemoryCloseWrite Index
  1233. end
  1234. if ErrCount<>0 then
  1235. call _lineout IniFileName, ';  ' || ErrCount || ' Url(s) have problems'
  1236. if OkCount=0&ErrCount=0 then
  1237. call _lineout IniFileName, ';--- NO URLS ---'
  1238. UrlInfoNeedsWriting='N'
  1239. return
  1240.  
  1241. NeedToReTestUrl:
  1242. if IniFileName='' then
  1243. return('Y')
  1244. TestUrl=arg(1)
  1245. UrlIndex=GetInfoIndex4Url(TestUrl)
  1246. if UrlIndex=0 then
  1247. do
  1248. call DebugLine 'This is a new URL (not known): ' ||TestUrl
  1249. return('Y')
  1250. end
  1251. if !URL.UrlIndex.!UrlStatusOk='N' then
  1252. do
  1253. call DebugLine 'This URL failed on last test : ' ||TestUrl
  1254. call DebugLine '     REASON : ' ||!URL.UrlIndex.!Reason
  1255. return('Y')
  1256. end
  1257. if CheckDays='' then
  1258. return('Y')
  1259. BaseDateNow=BaseDate()
  1260. BaseDateOk=!URL.UrlIndex.!LastChecked
  1261. CheckDaysThisUrl=random(CheckDaysMin,CheckDaysMax)
  1262. PeriodSinceLastCheck=BaseDateNow-BaseDateOk
  1263. call DebugLine 'URL: ' || TestUrl || ' last checked ' || PeriodSinceLastCheck || ' days ago (CheckDays[Random]=' || CheckDaysThisUrl || ').'
  1264. if PeriodSinceLastCheck<0|PeriodSinceLastCheck>CheckDaysThisUrl then
  1265. do
  1266. return('Y')
  1267. end
  1268. else
  1269. do
  1270. return('N')
  1271. end
  1272.  
  1273. SaveUrlOkInformation:
  1274. if IniFileName='' then
  1275. return
  1276. SaveUrl=arg(1)
  1277. UrlIndex=GetInfoIndex4Url(SaveUrl, 'Y')
  1278. !URL.UrlIndex.!UrlStatusOk='Y'
  1279. !URL.UrlIndex.!Url=SaveUrl
  1280. !URL.UrlIndex.!LastChecked=BaseDate()
  1281. !URL.UrlIndex.!LastModified=!CheckUrl.!LastModified
  1282. !URL.UrlIndex.!Updated='Y'
  1283. UrlInfoNeedsWriting='Y'
  1284. return
  1285.  
  1286. SaveUrlFailedInformation:
  1287. if IniFileName='' then
  1288. return
  1289. parse arg FailedUrl,Reason
  1290. UrlIndex=GetInfoIndex4Url(FailedUrl, 'Y')
  1291. !URL.UrlIndex.!UrlStatusOk='N'
  1292. !URL.UrlIndex.!Url=FailedUrl
  1293. !URL.UrlIndex.!LastChecked=BaseDate()
  1294. !URL.UrlIndex.!Reason=Reason
  1295. !URL.UrlIndex.!Updated='Y'
  1296. UrlInfoNeedsWriting='Y'
  1297. return
  1298.  
  1299. PPWCURLI_4:
  1300. parse source . . RexxSrcName
  1301. ShortRexxSrcName=_filespec('name',RexxSrcName)
  1302. DotPos=lastpos('.',ShortRexxSrcName)
  1303. if DotPos=0 then
  1304. ShortRexxSrcNameNoExtn=ShortRexxSrcName
  1305. else
  1306. ShortRexxSrcNameNoExtn=left(ShortRexxSrcName,DotPos-1)
  1307. MaxLineDump=10
  1308. if DebugFileName<> '' then
  1309. MaxLineDump=MaxLineDump*2
  1310. OptionsCmdLine=strip(arg(1))
  1311. OptionsEnvironment=GetEnv('PPWCURL_OPTIONS')
  1312. UserRequest=OptionsEnvironment|| ' ' ||OptionsCmdLine
  1313. ErrorFileName=''
  1314. CheckDays=''
  1315. ForgetDays=''
  1316. ReadTimeout=''
  1317. ReadTimeout2=''
  1318. OnlineTestUrl='http://www.labyrinth.net.au/~dbareis/index.htm'
  1319. UseHead='N'
  1320. FtpEmailAddress=''
  1321. DoHttpUrls='Y'
  1322. DoFtpUrls='Y'
  1323. AskAboutMovedUrls='Y'
  1324. if DebugFileName='' then
  1325. SocketReadLength=512
  1326. else
  1327. SocketReadLength=(512*8)
  1328. ParmCount=0
  1329. TheCmdLine=UserRequest
  1330. do while TheCmdLine<> ''
  1331. TheCmdLine=strip(TheCmdLine)
  1332. if left(TheCmdLine,1)='"' then
  1333. do
  1334. BeforeParse=TheCmdLine
  1335. parse value substr(TheCmdLine,2)with ThisParm'"'TheCmdLine
  1336. if TheCmdLine<> '' then
  1337. do
  1338. if left(TheCmdLine,1)\==' ' then
  1339. CryAndDie('Invalid quoted parameter at ==> ' ||BeforeParse)
  1340. end
  1341. end
  1342. else
  1343. do
  1344. parse var TheCmdLine ThisParm TheCmdLine
  1345. end
  1346. call DebugLine 'Option: "' || ThisParm || '"'
  1347. if left(ThisParm,1)<>RexOptionChar then
  1348. do
  1349. ParmCount=ParmCount+1
  1350. Parm.ParmCount=ThisParm
  1351. iterate
  1352. end
  1353. parse var ThisParm ThisCmd':'ThisCmdOptions
  1354. ThisCmd=translate(substr(ThisCmd,2))
  1355. select
  1356. when ThisCmd='ERRORFILE' then
  1357. do
  1358. if ThisCmdOptions='' then
  1359. ErrorFileName=''
  1360. else
  1361. do
  1362. ErrorFileName=ReplaceAnyFileNameSymbols(ThisCmdOptions)
  1363. if left(ErrorFileName,1)='+' then
  1364. ErrorFileName=substr(ErrorFileName,2)
  1365. else
  1366. do
  1367. if ErrorFileName<> '' then
  1368. DosDelRc=CloseAndDeleteFile(ErrorFileName)
  1369. end
  1370. end
  1371. end
  1372. when ThisCmd='MEMORYFILE' then
  1373. do
  1374. if ThisCmdOptions='' then
  1375. IniFileName=''
  1376. else
  1377. IniFileName=ReplaceAnyFileNameSymbols(ThisCmdOptions)
  1378. end
  1379. when ThisCmd='GETENV' then
  1380. do
  1381. MoreOptions=GetEnv(ThisCmdOptions)
  1382. if MoreOptions='' then
  1383. UserSyntaxError('The environment variable "' || ThisCmdOptions || '" is unknown')
  1384. TheCmdLine=MoreOptions|| ' ' ||TheCmdLine
  1385. end
  1386. when ThisCmd='CHECKDAYS' then
  1387. do
  1388. CheckDays=ThisCmdOptions
  1389. if CheckDays<> '' then
  1390. do
  1391. parse var CheckDays CheckDaysMin '-' CheckDaysMax
  1392. if CheckDaysMax='' then
  1393. do
  1394. if CheckDaysMin=1 then
  1395. CheckDaysMax=1
  1396. else
  1397. do
  1398. if CheckDaysMin<6 then
  1399. CheckDaysMax=CheckDaysMin+1
  1400. else
  1401. CheckDaysMax=CheckDaysMin+((CheckDaysMin%3)+1)
  1402. end
  1403. end
  1404. call DebugLine 'INI Check Days = ' || CheckDaysMin || ' to ' ||CheckDaysMax
  1405. end
  1406. end
  1407. when ThisCmd='READTIMEOUT' then
  1408. do
  1409. if ThisCmdOptions='' then
  1410. ReadTimeout=''
  1411. else
  1412. do
  1413. Value=GetInteger(ThisCmd,ThisCmdOptions)
  1414. if Value>=1 then
  1415. ReadTimeout=Value
  1416. end
  1417. end
  1418. when ThisCmd='TIMEOUTRETRY' then
  1419. do
  1420. if ThisCmdOptions='' then
  1421. ReadTimeout2=''
  1422. else
  1423. do
  1424. ReadTimeout2=GetInteger(ThisCmd,ThisCmdOptions)
  1425. if ReadTimeout2<0 then
  1426. ReadTimeout2=0
  1427. end
  1428. end
  1429. when ThisCmd='MEMORYBACKUPLEVEL' then
  1430. do
  1431. if ThisCmdOptions='' then
  1432. MemoryBackupLevel=3
  1433. else
  1434. do
  1435. MemoryBackupLevel=GetInteger(ThisCmd,ThisCmdOptions)
  1436. if MemoryBackupLevel>9 then
  1437. MemoryBackupLevel=9
  1438. end
  1439. end
  1440. when ThisCmd='FORGETDAYS' then
  1441. do
  1442. if ThisCmdOptions='' then
  1443. ForgetDays=''
  1444. else
  1445. do
  1446. Value=GetInteger(ThisCmd,ThisCmdOptions)
  1447. if Value<50 then
  1448. Value=50
  1449. ForgetDays=Value
  1450. end
  1451. end
  1452. when ThisCmd='SOCKETREADLENGTH' then
  1453. do
  1454. SocketReadLength=GetInteger(ThisCmd,ThisCmdOptions)
  1455. end
  1456. when ThisCmd='MAXLINEDUMP' then
  1457. do
  1458. MaxLineDump=GetInteger(ThisCmd,ThisCmdOptions)
  1459. end
  1460. when ThisCmd='TESTURL' then
  1461. do
  1462. OnlineTestUrl=ThisCmdOptions
  1463. end
  1464. when ThisCmd='FTPEMAIL' then
  1465. do
  1466. FtpEmailAddress=ThisCmdOptions
  1467. end
  1468. when ThisCmd='ASKIFMOVEOK' then
  1469. do
  1470. AskAboutMovedUrls=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  1471. end
  1472. when ThisCmd='USEHEADREQUEST' then
  1473. do
  1474. UseHead=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  1475. if UseHead='Y' then
  1476. do
  1477. call SayAndDebugLine ''
  1478. call SayAndDebugLine '***'
  1479. call SayAndDebugLine "*** Note some servers don't seem to correctly handle"
  1480. call SayAndDebugLine '*** the HEAD request!  According to RFC 1945 the format'
  1481. call SayAndDebugLine '*** of the head request is the same as that for the GET'
  1482. call SayAndDebugLine '*** request which always seems to be correctly handled!'
  1483. call SayAndDebugLine '***'
  1484. call SayAndDebugLine '*** If you get a 404 this could be a server malfunction!'
  1485. call SayAndDebugLine '***'
  1486. call SayAndDebugLine ''
  1487. end
  1488. end
  1489. otherwise
  1490. UserSyntaxError('Unknown switch of "' || RexOptionChar || ThisCmd || '" specified')
  1491. end
  1492. end
  1493. if MaxLineDump>99 then
  1494. MaxLineDump=99
  1495. if ReadTimeout='' then
  1496. ReadTimeout=15
  1497. if ReadTimeout2='' then
  1498. do
  1499. if ReadTimeout<60 then
  1500. ReadTimeout2=60
  1501. else
  1502. ReadTimeout2=ReadTimeout+30
  1503. end
  1504. if IniFileName<> '' then
  1505. do
  1506. if ForgetDays='' then
  1507. ForgetDays=365
  1508. if CheckDays='' then
  1509. call DebugLine 'INI will be updated, all URLs will be processed reguardless of age'
  1510. end
  1511. else
  1512. do
  1513. if CheckDays<> '' then
  1514. call SayAndDebugLine 'Option "' || RexOptionChar || 'CheckIni:' || CheckDays || '" ignored.'
  1515. if ForgetDays<> '' then
  1516. call SayAndDebugLine 'Option "' || RexOptionChar || 'ForgetDays:' || ForgetDays || '" ignored.'
  1517. end
  1518. HaveSockets=InitializeSocketSupport()
  1519. HaveFtp=InitializeFtpSupport()
  1520. if ParmCount=0 then
  1521. UserSyntaxError('No parameters supplied!')
  1522. TheCmd=translate(Parm.1)
  1523. select
  1524. when TheCmd="VERSION?" then
  1525. PgmRc=ShortRexxSrcName|| ' ' ||PgmVersion
  1526. when TheCmd="SOCKETVERSION?" then
  1527. do
  1528. if HaveSockets<> '' then
  1529. PgmRc=HaveSockets
  1530. else
  1531. do
  1532. if RexWhich='STANDARD_OS/2' then
  1533. PgmRc='RxSock.DLL ' || SockVersion()   || ' - OS/2'
  1534. else
  1535. PgmRc='RxSock.DLL ' || RxSockVersion() || ' - Regina'
  1536. end
  1537. end
  1538. when TheCmd="FTPVERSION?" then
  1539. do
  1540. if HaveFtp<> '' then
  1541. PgmRc=HaveFtp
  1542. else
  1543. do
  1544. call FtpVersion 'Version'
  1545. PgmRc='RxFtp.DLL ' ||Version
  1546. end
  1547. end
  1548. when TheCmd="SOCKETREADY?" then
  1549. do
  1550. if HaveSockets<> '' then
  1551. PgmRc=HaveSockets
  1552. else
  1553. PgmRc='OK'
  1554. end
  1555. when TheCmd="FTPREADY?" then
  1556. do
  1557. if HaveFtp<> '' then
  1558. PgmRc=HaveFtp
  1559. else
  1560. PgmRc='OK'
  1561. end
  1562. when TheCmd="CHECK1URL" then
  1563. do
  1564. MaxLineDump=0
  1565. if ParmCount<>2 then
  1566. UserSyntaxError('Incorrect Number of parameters!')
  1567. PgmRc=CheckUrl(Parm.2)
  1568. end
  1569. when TheCmd="CHECKURLSINHTML" then
  1570. do
  1571. if HaveSockets<> '' then
  1572. do
  1573. PgmRc=HaveSockets
  1574. call SayAndDebugLine PgmRc
  1575. leave
  1576. end
  1577. PgmRc=CheckUrlsInHtml(Parm.2)
  1578. end
  1579. when TheCmd="CHECKLISTEDURLS" then
  1580. do forever
  1581. if HaveSockets<> '' then
  1582. do
  1583. PgmRc=HaveSockets
  1584. call SayAndDebugLine PgmRc
  1585. leave
  1586. end
  1587. PgmRc=GetFilesMatchingMasks()
  1588. if PgmRc<> '' then
  1589. leave
  1590. UrlCount=0
  1591. do Index=1 to NumberFiles
  1592. ThisFile=FileList.Index
  1593. UrlSrcFile=ThisFile
  1594. call DebugLine 'PROCESSING URL LIST: "' || ThisFile || '"'
  1595. CloseRc=stream(ThisFile, 'c', 'close')
  1596. OpenRc=stream(ThisFile, 'c', 'open read')
  1597. ThisLineNumber=0
  1598. do while lines(ThisFile)<>0
  1599. OneUrl=strip(linein(ThisFile))
  1600. ThisLineNumber=ThisLineNumber+1
  1601. if OneUrl='' then
  1602. iterate
  1603. call DebugLine '#' || ThisLineNumber || ' ' ||OneUrl
  1604. if left(OneUrl,1)=';' then
  1605. do
  1606. if left(OneUrl,length(PragmaSrcUrl))=PragmaSrcUrl then
  1607. do
  1608. UrlSrcFile=substr(OneUrl,length(PragmaSrcUrl)+1)
  1609. end
  1610. iterate
  1611. end
  1612. UrlCount=UrlCount+1
  1613. Url.UrlCount=OneUrl
  1614. UrlSrc.UrlCount=UrlSrcFile
  1615. end
  1616. CloseRc=stream(ThisFile, 'c', 'close')
  1617. end
  1618. Url.0=UrlCount
  1619. UrlSrc.0=UrlCount
  1620. call ProcessUrlArray
  1621. leave
  1622. end
  1623. otherwise
  1624. PgmRc='Unknown command of "' || TheCmd || '"!'
  1625. end
  1626. call LoggedExit(PgmRc)
  1627.  
  1628. GetFilesMatchingMasks:
  1629. NumberOfMasks=0
  1630. NumberFiles=0
  1631. do ParmIndex=2 to ParmCount
  1632. NumberOfMasks=NumberOfMasks+1
  1633. ThisMask=Parm.ParmIndex
  1634. if left(ThisMask,1)<> '+' then
  1635. SubDirFlag=''
  1636. else
  1637. do
  1638. SubDirFlag='S'
  1639. ThisMask=substr(ThisMask,2)
  1640. end
  1641. ThisList.0=0
  1642. call _SysFileTree ThisMask, 'ThisList', 'FO' ||SubDirFlag
  1643. do Index=1 to ThisList.0
  1644. NumberFiles=NumberFiles+1
  1645. FileList.NumberFiles=ThisList.Index
  1646. end
  1647. end
  1648. if NumberOfMasks=0 then
  1649. return('No file masks for URL lists were supplied!')
  1650. if NumberFiles=0 then
  1651. return('No files matched any of the URL list masks!')
  1652. return('')
  1653.  
  1654. ProcessUrlArray:
  1655. if UrlCount>1 then
  1656. do
  1657. call SayAndDebugLine 'Sorting ' || AddCommasToDecimalNumber(UrlCount) || ' URLs...'
  1658. SrtM=1
  1659. SrtCount=URL.0
  1660. do while(9*SrtM+4)<SrtCount
  1661. SrtM=SrtM*3+1
  1662. end
  1663. do while SrtM>0
  1664. SrtK=SrtCount-SrtM
  1665. do SrtJ=1 to SrtK
  1666. SrtIndex1=SrtJ
  1667. do while SrtIndex1>0
  1668. SrtIndex2=SrtIndex1+SrtM
  1669. SrtGreater=URL.SrtIndex1>URL.SrtIndex2
  1670. if SrtGreater then
  1671. do
  1672. SrtTemp=URL.SrtIndex1;URL.SrtIndex1=URL.SrtIndex2;URL.SrtIndex2=SrtTemp;SrtTemp=URLSRC.SrtIndex1;URLSRC.SrtIndex1=URLSRC.SrtIndex2;URLSRC.SrtIndex2=SrtTemp
  1673. end
  1674. else
  1675. leave
  1676. SrtIndex1=SrtIndex1-SrtM
  1677. end
  1678. end
  1679. SrtM=SrtM%3
  1680. end
  1681. end
  1682. UrlUniqueCount=0
  1683. LastUrl=''
  1684. do Index=1 to UrlCount
  1685. OneUrl=Url.Index
  1686. if OneUrl=LastUrl then
  1687. iterate
  1688. LastUrl=OneUrl
  1689. UrlUniqueCount=UrlUniqueCount+1
  1690. end
  1691. call SayAndDebugLine 'Have ' || AddCommasToDecimalNumber(UrlUniqueCount) || ' unique URLs...'
  1692. call SayAndDebugLine ''
  1693. call MemoryOpen
  1694. PgmRc=0
  1695. LastUrl=''
  1696. LastUrlRc='OK'
  1697. UrlNumber=0
  1698. UrlMovedCount=0
  1699. UrlTimedOutCount=0
  1700. do Index=1 to UrlCount
  1701. OneUrl=Url.Index
  1702. if OneUrl=LastUrl then
  1703. do
  1704. if LastUrlRc<> 'OK' then
  1705. do
  1706. ThisSrc=UrlSrc.Index
  1707. SameSrc='N'
  1708. do CheckIndex=ErrorUrlIndex to Index-1
  1709. if UrlSrc.CheckIndex=ThisSrc then
  1710. do
  1711. SameSrc='Y'
  1712. leave
  1713. end
  1714. end
  1715. if SameSrc='N' then
  1716. do
  1717. call SayAndDebugLine '     Src: ' ||ThisSrc
  1718. call Line2ErrorFile ';      URL from ' ||ThisSrc
  1719. end
  1720. end
  1721. iterate
  1722. end
  1723. LastUrl=OneUrl
  1724. if NeedToReTestUrl(OneUrl)='N' then
  1725. do
  1726. LastUrlRc='OK'
  1727. iterate
  1728. end
  1729. UrlNumber=UrlNumber+1
  1730. if UrlNumber=1 then
  1731. do
  1732. if OnlineTestUrl<> '' then
  1733. do
  1734. call SayAndDebugLine ''
  1735. call SayAndDebugLine 'Oneline? - Testing "' || OnlineTestUrl || '"'
  1736. TestUrlRc=CheckUrl(OnlineTestUrl)
  1737. if TestUrlRc='OK' then
  1738. call SayAndDebugLine '   * We seem to be online!'
  1739. else
  1740. do
  1741. call SayAndDebugLine '   * Failed: ' ||TestUrlRc
  1742. call SayAndDebugLine '   * Assuming not online'
  1743. PgmRc=9999
  1744. leave
  1745. end
  1746. end
  1747. end
  1748. call SayAndDebugLine ''
  1749. call SayAndDebugLine 'Checking: #' || UrlNumber || ' "' || OneUrl || '"'
  1750. UrlRc=CheckUrl(OneUrl)
  1751. call SayAndDebugLine '      Rc: ' ||UrlRc
  1752. if UrlRc='OK' then
  1753. do
  1754. call SaveUrlOkInformation OneUrl
  1755. end
  1756. else
  1757. do
  1758. PgmRc=PgmRc+1
  1759. ErrorUrlIndex=Index
  1760. call SaveUrlFailedInformation OneUrl,UrlRc
  1761. call Line2ErrorFile ''
  1762. call Line2ErrorFile PragmaSrcUrl||UrlSrc.Index
  1763. call Line2ErrorFile OneUrl
  1764. call Line2ErrorFile ';      ' ||UrlRc
  1765. call Line2ErrorFile ';      URL from ' ||UrlSrc.Index
  1766. call SayAndDebugLine '     Src: ' ||UrlSrc.Index
  1767. if AskAboutMovedUrls='Y' & !CheckUrl.!UrlMovedTo <> '' then
  1768. do
  1769. UrlMovedCount=UrlMovedCount+1
  1770. !MovedUrl.UrlMovedCount.!URL=OneUrl
  1771. !MovedUrl.UrlMovedCount.!UrlMovedTo=!CheckUrl.!UrlMovedTo
  1772. end
  1773. if ReadTimeout2<>0&!CheckUrl.!ErrorType='TIMEOUT' then
  1774. do
  1775. UrlTimedOutCount=UrlTimedOutCount+1
  1776. !UrlTimedOut.UrlTimedOutCount.!URL=OneUrl
  1777. end
  1778. end
  1779. LastUrlRc=UrlRc
  1780. end
  1781. if UrlTimedOutCount<>0 then
  1782. do
  1783. call MemoryClose
  1784. ReadTimeout=ReadTimeout2
  1785. do TimedOutIndex=1 to UrlTimedOutCount
  1786. OneUrl=!UrlTimedOut.TimedOutIndex.!URL
  1787. call SayAndDebugLine ''
  1788. call SayAndDebugLine 'ReTesting: "' || OneUrl || '"'
  1789. UrlRc=CheckUrl(OneUrl)
  1790. call SayAndDebugLine '       Rc: ' ||UrlRc
  1791. if UrlRc='OK' then
  1792. do
  1793. PgmRc=PgmRc-1
  1794. call SaveUrlOkInformation OneUrl
  1795. end
  1796. else
  1797. do
  1798. call SaveUrlFailedInformation OneUrl,UrlRc
  1799. end
  1800. end
  1801. end
  1802. if UrlMovedCount<>0 then
  1803. do
  1804. call MemoryClose
  1805. Question='OK?     : '
  1806. do MovedIndex=1 to UrlMovedCount
  1807. OneUrl=!MovedUrl.MovedIndex.!URL
  1808. call SayAndDebugLine ''
  1809. call SayAndDebugLine 'URL     : ' ||OneUrl
  1810. call SayAndDebugLine 'Moved To: ' ||!MovedUrl.MovedIndex.!UrlMovedTo
  1811. call charout,Question
  1812. Answer=translate(strip(linein()))
  1813. if left(Answer,1)='Y' then
  1814. Answer='YES'
  1815. else
  1816. Answer='NO'
  1817. call DebugLine 'SAID: ' ||Question||Answer
  1818. if Answer='YES' then
  1819. do
  1820. PgmRc=PgmRc-1
  1821. !CheckUrl.!LastModified='Moved to ' ||!MovedUrl.MovedIndex.!UrlMovedTo
  1822. call SaveUrlOkInformation OneUrl
  1823. end
  1824. end
  1825. end
  1826. if PgmRc<>9999 then
  1827. do
  1828. call SayAndDebugLine ''
  1829. call SayAndDebugLine ''
  1830. if PgmRc<>0 then
  1831. call SayAndDebugLine PgmRc|| ' failures out of ' ||UrlNumber
  1832. else
  1833. do
  1834. if UrlNumber=0 then
  1835. call SayAndDebugLine 'No URLs needed checking.'
  1836. else
  1837. call SayAndDebugLine 'No failures (' || UrlNumber || ' urls checked)'
  1838. end
  1839. end
  1840. call MemoryClose
  1841. return
  1842.  
  1843. GetInteger:
  1844. if datatype(arg(2), 'W')=0 then
  1845. CryAndDie(RexOptionChar||arg(1)|| ' given an invalid value of "' || arg(2) || '"')
  1846. return(strip(arg(2)))
  1847.  
  1848. SwitchOptionsValidateAgainstList:
  1849. TheCmd=arg(1)
  1850. TheOption=translate(arg(2))
  1851. ValidList=',' || translate(arg(3)) || ','
  1852. if pos(',' || TheOption || ',',ValidList)<>0 then
  1853. return(TheOption)
  1854. UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || RexOptionChar || TheCmd || '" switch!')
  1855.  
  1856. SwitchWantsYesOrNo:
  1857. TheCmd=arg(1)
  1858. TheOption=translate(arg(2))
  1859. Default=arg(3)
  1860. if TheOption='' then
  1861. return(Default)
  1862. else
  1863. return(left(SwitchOptionsValidateAgainstList(TheCmd,TheOption, "Y,N,YES,NO"),1))
  1864.  
  1865. Line2ErrorFile:
  1866. if ErrorFileName<> '' then
  1867. do
  1868. call _lineout ErrorFileName,arg(1)
  1869. call stream ErrorFileName, 'c', 'close'
  1870. end
  1871. return
  1872.  
  1873. SayAndDebugLine:
  1874. if arg(1)<> '' then
  1875. LastLineWasBlank='N'
  1876. else
  1877. do
  1878. if LastLineWasBlank='Y' then
  1879. return
  1880. else
  1881. LastLineWasBlank='Y'
  1882. end
  1883. say arg(1)
  1884. call DebugLine 'SAID: ' ||arg(1)
  1885. return
  1886.  
  1887. DebugLine:
  1888. call DebugLineNoTime time()|| ': ' ||arg(1)
  1889. return
  1890.  
  1891. DebugLineNoTime:
  1892. if DebugFileName<> '' then
  1893. do
  1894. call _lineout DebugFileName,arg(1)
  1895. call stream DebugFileName, 'c', 'close'
  1896. end
  1897. return
  1898.  
  1899. DebugChars:
  1900. if DebugFileName<> '' then
  1901. do
  1902. call charout DebugFileName,arg(1)
  1903. call stream DebugFileName, 'c', 'close'
  1904. end
  1905. return
  1906.  
  1907. ValidIpByte:
  1908. IpByte=arg(1)
  1909. if datatype(IpByte, 'W')=0 then
  1910. return('N')
  1911. if IpByte<0|IpByte>255 then
  1912. return('N')
  1913. return('Y')
  1914.  
  1915. CheckUrl:
  1916. !CheckUrl.!LastModified=''
  1917. !CheckUrl.!ErrorType=''
  1918. !CheckUrl.!UrlMovedTo=''
  1919. ProcessingThisUrl=arg(1)
  1920. if abbrev(ProcessingThisUrl, 'ftp://')then
  1921. do
  1922. if HaveFtp<> '' then
  1923. CurlRc=HaveFtp
  1924. else
  1925. CurlRc=CheckUrlFtp(ProcessingThisUrl)
  1926. end
  1927. else
  1928. do
  1929. if HaveSockets<> '' then
  1930. CurlRc=HaveSockets
  1931. else
  1932. CurlRc=CheckUrlHttp(ProcessingThisUrl)
  1933. end
  1934. ProcessingThisUrl=''
  1935. return(CurlRc)
  1936.  
  1937. CheckUrlFtp:
  1938. FullUrl=arg(1)
  1939. parse var FullUrl 'ftp://' FtpServer '/' FullFileName
  1940. SlashPos=lastpos('/',FullFileName)
  1941. if SlashPos=0 then
  1942. do
  1943. FileDir='/'
  1944. FileShort=FullFileName
  1945. end
  1946. do
  1947. FileDir='/' ||left(FullFileName,SlashPos)
  1948. FileShort=substr(FullFileName,SlashPos+1)
  1949. end
  1950. if FtpEmailAddress<> '' then
  1951. EmailAddress=FtpEmailAddress
  1952. else
  1953. EmailAddress=ShortRexxSrcName|| '@email.address.not.known'
  1954. FtpRc=FtpSetUser(FtpServer, 'Anonymous',EmailAddress)
  1955. if FtpRc=0 then
  1956. return('Could not set up the user info (email address etc)')
  1957. FtpRc=ftpchdir(FileDir)
  1958. if FtpRc<>0 then
  1959. FtpExit='Could not change to "' || FileDir || '" (' || GetFtpError() || ')'
  1960. else
  1961. do
  1962. if FileShort='' then
  1963. FtpExit='OK'
  1964. else
  1965. do
  1966. FtpFile.0=0
  1967. call FTPLs FileShort, "FtpFile."
  1968. if FtpRc<>0 then
  1969. FtpExit='Could not find "' || FileShort || '" (' || GetFtpError() || ')'
  1970. else
  1971. do
  1972. if FtpFile.0=1 then
  1973. FtpExit='OK'
  1974. else
  1975. do
  1976. FtpRc=ftpchdir('/' ||FullFileName)
  1977. if FtpRc<>0 then
  1978. FtpExit='Could not find "' || FileShort || '" in directory ' ||FileDir
  1979. else
  1980. FtpExit='OK'
  1981. end
  1982. end
  1983. end
  1984. end
  1985. call FtpLogoff
  1986. return(FtpExit)
  1987.  
  1988. CheckUrlHttp:
  1989. FullUrl=arg(1)
  1990. parse var FullUrl HttpPrefix '://' httpServer '/' HttpPageAddr
  1991. parse var httpServer httpServer ':' HttpPort
  1992. if HttpPort='' then
  1993. HttpPort=80
  1994. parse var HttpPageAddr HttpPageAddr '#'
  1995. parse var httpServer Byte1 '.' Byte2 '.' Byte3 '.' Byte4
  1996. if ValidIpByte(Byte1)='Y' & ValidIpByte(Byte2) = 'Y' & ValidIpByte(Byte3) = 'Y' & ValidIpByte(Byte4) = 'Y' then
  1997. httpServerDotted=httpServer
  1998. else
  1999. do
  2000. SocketRc=SockGetHostByName(httpServer, 'httpServer_')
  2001. if SocketRc=0 then
  2002. do
  2003. call DebugLine 'SockGetHostByName(' || httpServer || ') failed - ' || GetSockError() || ', DNS unavailable?'
  2004. return('Server name "' || httpServer || '" unknown')
  2005. end
  2006. httpServerDotted=httpServer_addr
  2007. end
  2008. if DebugFileName<> '' then
  2009. do
  2010. call DebugLine ''
  2011. call DebugLine copies('=',79)
  2012. call DebugLine ''
  2013. call DebugLine 'Details'
  2014. call DebugLine '~~~~~~~'
  2015. call DebugLine 'Full URL    :' ||FullUrl
  2016. call DebugLine 'Server Name :' ||httpServer
  2017. call DebugLine 'Server IP   :' ||httpServerDotted
  2018. call DebugLine 'Port        :' ||httpPort
  2019. call DebugLine 'Page        :' ||HttpPageAddr
  2020. call DebugLine ''
  2021. end
  2022. SocketHandle=SockSocket('AF_INET', 'SOCK_STREAM', 'IPPROTO_TCP')
  2023. SvrAddr.!family='AF_INET'
  2024. SvrAddr.!port=HttpPort
  2025. SvrAddr.!addr=httpServerDotted
  2026. SocketRc=SockConnect(SocketHandle, 'SvrAddr.!')
  2027. if SocketRc=-1 then
  2028. do
  2029. SocketRc=SockClose(SocketHandle)
  2030. return('Could not open socket for "' || httpServer || '"')
  2031. end
  2032. Eol='0D0A'x
  2033. if UseHead='Y' then
  2034. do
  2035. RequestMsg='HEAD /' || HttpPageAddr || ' HTTP/1.0' ||Eol||,
  2036. 'User-Agent: ' || ShortRexxSrcNameNoExtn || ' - ' || PgmVersion || ' - ' ||RexSystemOpSys||Eol||,
  2037. 'Host: ' || httpServer || ':' ||HttpPort||Eol||,
  2038. 'Accept: */*' ||Eol||,
  2039. Eol
  2040. end
  2041. else
  2042. do
  2043. RequestMsg='GET /' || HttpPageAddr || ' HTTP/1.0' ||Eol||,
  2044. 'User-Agent: ' || ShortRexxSrcNameNoExtn || '/' ||PgmVersion||Eol||,
  2045. 'Host: ' || httpServer || ':' ||HttpPort||Eol||,
  2046. 'Accept: */*' ||Eol||,
  2047. Eol
  2048. end
  2049. SocketRc=SockSend(SocketHandle,RequestMsg)
  2050. if(SocketRc=-1)then
  2051. do
  2052. SocketRc=SockClose(SocketHandle)
  2053. return('Error sending page request to "' || httpServer || '" (' || GetSockError() || ')')
  2054. end
  2055. call Time('R')
  2056. if DebugFileName<> '' then
  2057. do
  2058. call DebugLine 'Sent'
  2059. call DebugLine '~~~~'
  2060. call DebugLine RequestMsg
  2061. call DebugLine ''
  2062. end
  2063. WaitRead.0=1
  2064. WaitRead.1=SocketHandle
  2065. if SockSelect( "WaitRead.", "", "",ReadTimeout)=0 then
  2066. do
  2067. SocketRc=SockClose(SocketHandle)
  2068. !CheckUrl.!ErrorType='TIMEOUT'
  2069. return('Timed out (waited ' || ReadTimeout || ' seconds).')
  2070. end
  2071. SocketRc=SockRecv(SocketHandle, 'ServersResponse',SocketReadLength)
  2072. ReadTook=GetElapsedTime()
  2073. SocketRc=SockClose(SocketHandle)
  2074. if(SocketRc=-1)then
  2075. return('Error reading response from "' || httpServer || '" (' || GetSockError() || ')')
  2076. if DebugFileName<> '' then
  2077. do
  2078. ServersResponseLng=length(ServersResponse)
  2079. MsgTxt='Received ' || AddCommasToDecimalNumber(ServersResponseLng) || ' bytes, Took ' || ReadTook || ' seconds'
  2080. call DebugLine MsgTxt
  2081. call DebugLine copies('~',length(MsgTxt))
  2082. call DebugChars ServersResponse||Eol
  2083. call DebugLine ''
  2084. end
  2085. EolPos=EolPos(ServersResponse)
  2086. if EolPos=0 then
  2087. ServersResponse1stLine=ServersResponse
  2088. else
  2089. ServersResponse1stLine=left(ServersResponse,EolPos-1)
  2090. ServerRc=word(ServersResponse1stLine,2)
  2091. AddCode='Y'
  2092. select
  2093. when ServerRc='400' then
  2094. UrlRcText='BAD REQUEST'
  2095. when ServerRc='403' then
  2096. do
  2097. UrlRcText='ACCESS DENIED'
  2098. if translate(HttpPrefix)='HTTPS' then
  2099. do
  2100. AddCode='N'
  2101. UrlRcText='OK'
  2102. end
  2103. end
  2104. when ServerRc='404' then
  2105. UrlRcText='URL NOT FOUND'
  2106. when ServerRc='503' then
  2107. UrlRcText='SERVICE UNAVAILABLE'
  2108. when ServerRc='200' then
  2109. do
  2110. AddCode='N'
  2111. UrlRcText='OK'
  2112. LookFor="Last-Modified:"
  2113. LastModPos=pos(LookFor,ServersResponse)
  2114. if LastModPos=0 then
  2115. do
  2116. call DebugLine 'Could not find "' || LookFor || '"'
  2117. !CheckUrl.!LastModified=''
  2118. end
  2119. else
  2120. do
  2121. StartPos=LastModPos+length(LookFor)
  2122. EolPos=EolPos(ServersResponse,StartPos)
  2123. if EolPos=0 then
  2124. !CheckUrl.!LastModified=substr(ServersResponse,StartPos)
  2125. else
  2126. !CheckUrl.!LastModified=substr(ServersResponse,StartPos,EolPos-StartPos)
  2127. !CheckUrl.!LastModified=strip(!CheckUrl.!LastModified)
  2128. call DebugLine 'Page last modified "' || !CheckUrl.!LastModified || '"'
  2129. end
  2130. end
  2131. when ServerRc='301' | ServerRc='302' then
  2132. do
  2133. if ServerRc='301' then
  2134. UrlRcText='PERMANENT'
  2135. else
  2136. UrlRcText='TEMPORARY'
  2137. parse var ServersResponse . 'Location: ' Rest
  2138. CrPos=pos('0D'x,Rest)
  2139. NlPos=pos('0A'x,Rest)
  2140. if CrPos<>0 then
  2141. EndPos=CrPos
  2142. else
  2143. EndPos=NlPos
  2144. if EndPos=0 then
  2145. NewLocation='?'
  2146. else
  2147. NewLocation=left(Rest,EndPos-1)
  2148. if NewLocation=FullUrl|| '/' then
  2149. UrlRcText='Add terminating "/" for performance'
  2150. else
  2151. do
  2152. MsgFormatted='N'
  2153. if pos('?',FullUrl)<>0 then
  2154. do
  2155. parse var FullUrl BeforeQm '?' AfterQm
  2156. TestUrl=BeforeQm|| '/?' ||AfterQm
  2157. if NewLocation=TestUrl then
  2158. do
  2159. UrlRcText='Add "/" before "?" for performance'
  2160. MsgFormatted='Y'
  2161. end
  2162. end
  2163. if MsgFormatted='N' then
  2164. do
  2165. UrlRcText=UrlRcText|| ' move to ' ||NewLocation
  2166. !CheckUrl.!UrlMovedTo=NewLocation
  2167. end
  2168. end
  2169. end
  2170. otherwise
  2171. do
  2172. if translate(left(ServersResponse1stLine,5))='HTTP/' & datatype(ServerRc, 'W')=1 then
  2173. do
  2174. UrlRcText=subword(ServersResponse1stLine,3)
  2175. end
  2176. else
  2177. do
  2178. if MaxLineDump<>0 then
  2179. do
  2180. LineCounter=0
  2181. StartPos=1
  2182. say ' ------- UNKNOWN RESPONSE DUMP - START -------'
  2183. do until EolPos=0|LineCounter>MaxLineDump
  2184. EolPos=EolPos(ServersResponse,StartPos)
  2185. if EolPos=0 then
  2186. LineTxt=substr(ServersResponse,StartPos)
  2187. else
  2188. do
  2189. LineTxt=substr(ServersResponse,StartPos,EolPos-StartPos)
  2190. StartPos=EolPos+1
  2191. do while EolPos(ServersResponse,StartPos)=StartPos
  2192. StartPos=StartPos+1
  2193. end
  2194. end
  2195. if LineTxt<> '' then
  2196. do
  2197. LineCounter=LineCounter+1
  2198. call SayAndDebugLine right(LineCounter,2, '0') || ': ' ||LineTxt
  2199. end
  2200. end
  2201. say ' ------- UNKNOWN RESPONSE DUMP - END ---------'
  2202. end
  2203. AddCode='N'
  2204. UrlRcText='Problem unknown ==>' ||ServersResponse1stLine
  2205. end
  2206. end
  2207. end
  2208. if AddCode='Y' then
  2209. HttpRc='#' || ServerRc || ' - ' ||UrlRcText
  2210. else
  2211. HttpRc=UrlRcText
  2212. return(HttpRc)
  2213.  
  2214. GetSockError:
  2215. if RexWhich='STANDARD_OS/2' then
  2216. SockRc=errno|| '/' ||h_errno
  2217. else
  2218. SockRc=SockSock_Errno()
  2219. return(SockRc)
  2220.  
  2221. GetFtpError:
  2222. select
  2223. when FTPERRNO="FTPHOST"       then return("unknown host")
  2224. when FTPERRNO="FTPCONNECT"    then return("unable to connect to server")
  2225. when FTPERRNO="FTPLOGIN"      then return("login failed")
  2226. when FTPERRNO="FTPPROXYTHIRD" then return("proxy server does not support 3rd party transfers")
  2227. when FTPERRNO="FTPNOPRIMARY"  then return("no primary connection for proxy transfer")
  2228. otherwise return(FTPERRNO)
  2229. end
  2230.  
  2231. EolPos:
  2232. _StartPos=arg(2)
  2233. if _StartPos='' then
  2234. _StartPos=1
  2235. _CrPos=pos('0D'x,arg(1),_StartPos)
  2236. _LfPos=pos('0A'x,arg(1),_StartPos)
  2237. if _CrPos=0|_LfPos=0 then
  2238. return(max(_CrPos,_LfPos))
  2239. else
  2240. return(min(_CrPos,_LfPos))
  2241.  
  2242. GetElapsedTime:
  2243. signal on SYNTAX name ElapsedTimeBugWorkaround
  2244. getTime=time('E')
  2245. return(trunc(getTime,2))
  2246.  
  2247. ElapsedTimeBugWorkaround:
  2248. return('?')
  2249.  
  2250. InitializeSocketSupport:
  2251. call RxFuncAdd "SockLoadFuncs", "RxSock.DLL", "SockLoadFuncs"
  2252. signal on SYNTAX name RxSockDllMissing
  2253. if RexWhich='STANDARD_OS/2' then
  2254. call SockLoadFuncs "NoCopyrightDisplayEtc"
  2255. else
  2256. call SockLoadFuncs
  2257. return('')
  2258.  
  2259. RxSockDllMissing:
  2260. return("Can't locate RxSock.DLL")
  2261.  
  2262. InitializeFtpSupport:
  2263. call RxFuncAdd "FtpLoadFuncs", "RxFtp.DLL", "FtpLoadFuncs"
  2264. signal on SYNTAX name RxFtpDllMissing
  2265. call FtpLoadFuncs "NoCopyrightDisplayEtc"
  2266. return('')
  2267.  
  2268. RxFtpDllMissing:
  2269. return("Can't locate RxFtp.DLL")
  2270.  
  2271. ReplaceAnyFileNameSymbols:
  2272. parse value time('N') with Hours ':' Minutes ':' Seconds
  2273. CurrentTime=Hours||Minutes||Seconds
  2274. CurrentDate=date('S')
  2275. NewText=ReplaceString(arg(1), "{Time}",CurrentTime)
  2276. NewText=ReplaceString(NewText, "{Date}",CurrentDate)
  2277. return(NewText)
  2278.  
  2279. AddCommasToDecimalNumber:procedure
  2280. NoComma=strip(arg(1))
  2281. if pos(',',NoComma)<>0 then
  2282. return(NoComma)
  2283. DotPos=pos('.',NoComma)
  2284. if DotPos=0 then
  2285. AfterDecimal=''
  2286. else
  2287. do
  2288. if DotPos=1 then
  2289. return("0" ||NoComma)
  2290. AfterDecimal=substr(NoComma,DotPos+1)
  2291. NoComma=left(NoComma,DotPos-1)
  2292. end
  2293. NoComma=reverse(NoComma)
  2294. ResultWithCommas=""
  2295. do while length(NoComma)>3
  2296. ResultWithCommas=ResultWithCommas||left(NoComma,3)|| ','
  2297. NoComma=substr(NoComma,4)
  2298. end
  2299. ResultWithCommas=ResultWithCommas||NoComma
  2300. ResultWithCommas=reverse(ResultWithCommas)
  2301. if AfterDecimal<> '' then
  2302. ResultWithCommas=ResultWithCommas|| '.' ||AfterDecimal
  2303. return(ResultWithCommas)
  2304.  
  2305. ReplaceString:
  2306. TheString=arg(1)
  2307. ChangeFrom=arg(2)
  2308. ChangeTo=arg(3)
  2309. ChangeFromLength=length(ChangeFrom)
  2310. ChangeToLength=length(ChangeTo)
  2311. FoundPosn=pos(ChangeFrom,TheString)
  2312. do while FoundPosn<>0
  2313. TheString=left(TheString,FoundPosn-1)||ChangeTo||substr(TheString,FoundPosn+ChangeFromLength)
  2314. FoundPosn=pos(ChangeFrom,TheString,FoundPosn+ChangeToLength)
  2315. end
  2316. return(TheString)
  2317.  
  2318. CloseAndDeleteFile:
  2319. dfFile=arg(1)
  2320. CloseRc=stream(dfFile, 'c', 'close')
  2321. DosDelRc=_SysFileDelete(dfFile)
  2322. return(DosDelRc)
  2323.  
  2324. DebugAddressCmdBefore:
  2325. call DebugLine 'Executing: ' ||arg(1)
  2326. return
  2327.  
  2328. DebugAddressCmdOutput:
  2329. DbgLineNumber=arg(2)
  2330. if datatype(DbgLineNumber, 'W')=0 then
  2331. call DebugLine '  > ' ||arg(1)
  2332. else
  2333. do
  2334. if DbgLineNumber<999 then
  2335. DbgLineNumber=right(DbgLineNumber,3, '0')
  2336. call DebugLine '  > ' || DbgLineNumber || ': ' ||arg(1)
  2337. end
  2338. return
  2339.  
  2340. DebugAddressCmdAfter:
  2341. call DebugLine '  Rc = ' ||arg(1)
  2342. return
  2343.  
  2344. _Lineout:
  2345. loFileName=arg(1)
  2346. loTheLine=arg(2)
  2347. if 0<>lineout(loFileName,loTheLine)then
  2348. do
  2349. if Dying='N' then
  2350. do
  2351. FileState=stream(loFileName, 'Description')
  2352. CryAndDie('Failed writing line to "' || loFileName || '" - ' ||FileState)
  2353. end
  2354. end
  2355. return
  2356.  
  2357. CryAndDie:
  2358. signal off HALT
  2359. call on HALT name RexxCtrlCIgnore
  2360. ExitRc=SIGL
  2361. Dying='Y'
  2362. call SayAndDebugLine "ERROR: " ||arg(1)
  2363. if MemoryNeedsUpdating()='Y' then
  2364. do
  2365. call MemoryClose
  2366. end
  2367. call LoggedExit(ExitRc)
  2368.  
  2369. LoggedExit:
  2370. PgmRc=arg(1)
  2371. OrigPgmRc=PgmRc
  2372. if RexWhich='REGINA' then
  2373. do
  2374. if PgmRc='OK' then
  2375. PgmRc=0
  2376. else
  2377. PgmRc=1000+length(PgmRc)
  2378. end
  2379. call DebugLine ''
  2380. call DebugLine 'Return code'
  2381. call DebugLine '~~~~~~~~~~~'
  2382. if OrigPgmRc=PgmRc then
  2383. call DebugLine PgmRc
  2384. else
  2385. call DebugLine PgmRc|| ' , translated from => ' ||OrigPgmRc
  2386. call DebugLine ''
  2387. exit(PgmRc)
  2388.  
  2389. MyLineNumber:
  2390. return(SIGL)
  2391.  
  2392. DisplayCopyright:
  2393. if CopyrightDisplayed='N' then
  2394. do
  2395. say '[]-------------------------------------------------------------------------[]'
  2396. say '| PPWCURL.CMD: Version ' || PgmVersion || ' (C)opyright Dennis Bareis 1999                |'
  2397. say '| http://www.labyrinth.net.au/~dbareis/index.htm (dbareis@labyrinth.net.au) |'
  2398. say '[]-------------------------------------------------------------------------[]'
  2399. CopyrightDisplayed='Y'
  2400. end
  2401. return
  2402.  
  2403. UserSyntaxError:
  2404. call DisplayCopyright
  2405. say "SYNTAX ERROR"
  2406. say "~~~~~~~~~~~~"
  2407. say '    ' ||arg(1)
  2408. say ''
  2409. say 'CORRECT SYNTAX'
  2410. say '~~~~~~~~~~~~~~'
  2411. say '    PPWCURL[.CMD] Command [Parm1 ...] [Option1 ...]'
  2412. say ''
  2413. say 'SOME OPTIONS'
  2414. say '~~~~~~~~~~~~'
  2415. say RexOptionChar|| 'ErrorFile[:[+]FileName] = Generate list of error URLs'
  2416. say RexOptionChar|| 'MemoryFile[:FileName]   = Long term memory of results'
  2417. say RexOptionChar|| 'CheckDays[:Period]      = Controls how long term memory used'
  2418. say RexOptionChar|| 'TestUrl[:Url]           = Define known URL which exists'
  2419. say RexOptionChar|| 'ReadTimeout:Seconds     = Define read timeout'
  2420. say RexOptionChar|| 'GetEnv:NameOfVariable   = Specify source of more options'
  2421. say ''
  2422. say 'Please see "PPWIZARD.INF" for more details (and more options).' ||Beep||Beep
  2423. LoggedExit(MyLineNumber())
  2424.  
  2425. RexxTrapAddInfo:
  2426. if symbol('ProcessingThisUrl') = 'VAR' then
  2427. do
  2428. if ProcessingThisUrl<> '' then
  2429. call SayAndDebugLine left('URL', 16) || ': ' ||ProcessingThisUrl
  2430. end
  2431. return
  2432.  
  2433. RexxTrapDying:
  2434. call charout,Beep||Beep
  2435. call LoggedExit arg(1)
  2436.  
  2437. RexxCtrlC:
  2438. IgnoredCount=0
  2439. LineCtrlC=SIGL
  2440. signal off HALT
  2441. call on HALT name RexxCtrlCIgnore
  2442. call SayAndDebugLine ''
  2443. call SayAndDebugLine copies('=+',39)
  2444. call SayAndDebugLine "Come on, you pressed Ctrl+C or Break didn't you!"
  2445. call SayAndDebugLine copies('=+',39)
  2446. if MemoryNeedsUpdating()='Y' then
  2447. do
  2448. say ''
  2449. say 'Please wait while INI is updated....'
  2450. call MemoryClose
  2451. say ''
  2452. say 'Phew... Lucky Phil, INI file update completed!'
  2453. end
  2454. exit(LineCtrlC)
  2455.  
  2456. RexxCtrlCIgnore:
  2457. IgnoredCount=IgnoredCount+1
  2458. call off HALT
  2459. call on HALT name RexxCtrlCIgnore
  2460. if IgnoredCount<>1 then
  2461. say "Some people just don't listen!"
  2462. say 'WARNING: Please wait while INI is updated....'
  2463. re
  2464.