home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 2 BBS / 02-BBS.zip / control.zip / control.cmd < prev    next >
OS/2 REXX Batch file  |  1993-12-28  |  96KB  |  3,353 lines
  1. /* Control*/
  2. /* Author (C) Dave Sloan - July 1993*/
  3. /* Dedicated to all NEC's*/
  4. /* Written to completely control inbound and outbound files and mail*/
  5. /* Will dynamically change all message and file cfg*/
  6. /* Displays a window of activitys for each line*/
  7. /* These include squish.cfg - sqafix.cfg*/ 
  8. /* Post changes for easy inserting into msgarea.ctl - tic.cfg*/
  9. /* Adds file descriptions from uplinks for message bases*/
  10. /* Updates nodelist entries as they are received*/
  11. /* Will cross check message base areas and automatically add and*/
  12. /* delete areas as they become available or empty in squish.cfg*/
  13. /* It checks for duplicate files and maintains free space as specified*/
  14. /* on the hard drive - deletes outdated files and large files as needed*/
  15. /* Completely Net Aware*/
  16. /* See 'Special Attaches' for sending files without tick*/
  17. /* Copy Fidonet.na to the CmdPath (Bink) subdirectory as N348.LST*/
  18. /* The descriptions will be placed in the sqafix control file*/
  19. /* and create the M348.LST file which will ultimately place the descriptions*/
  20. /* into the msgarea.ctl file*/
  21. /* Copy descriptions from File.lst into filearea.ctl - not net aware*/
  22. /* Added section to replace nulls with blanks during initial run*/
  23. /* This is due to the fact that Rexx does not recognize tabs*/
  24. /* Class is associated with Net - In the squish.cfg file a few comment lines*/
  25. /* may be added - before the definition of each net address add the network*/
  26. /* description and class as follows:*/
  27. /* Any CDRom files.bbs must be in a path with CDRom in the name*/
  28. /* This is so that the program will ignore these during placement*/
  29. /* All message areas must be under the same subdirectory*/
  30. /* All file areas must be under the same subdirectory*/
  31. /* Acknowlegements*/
  32. /* SRI - Max MSGAPI.dll - Rexx message interface (C) Colin Adams */
  33. /* SQAFIXP - (C) Pete Kvitek of JV Dialogue 1st BBS, 2:5020/6 */
  34. /* Max BBS + Squish - (C) Scott Dudley*/
  35. /* Tick - TICK v2.10 (C) Barry Geller*/
  36. /* The above products can be used in a non-comercial environment without
  37.    a licence*/
  38. /* Fastlstp by Alberto Pasquale */
  39. /*
  40. ;Origin Fido F F
  41. Address 1:348/105
  42. Address 1:348/107
  43. Address 1:348/60
  44. ;Origin IMEX X X
  45. Address 89:720/106
  46. Address 89:720/111
  47. */
  48. /* To determine the class for sqafix requests preceed the msgarea statements*/
  49. /* with the following*/
  50. /*
  51. ;Start F
  52. EchoArea  12_STEPS       C:\MSG\12_STEPS  -$ -$m250 -$d7 -P1:348/105     1:348/501
  53. ...
  54. EchoArea  {COMMO}        C:\MSG\{COMMO}   -$ -$m250 -$d7 -P1:348/105     1:348/501
  55. ;Start S   Secured sysop echo that must be manually turned on
  56. EchoArea  CELLBLK17      C:\Msg\CELLBLK1  -$ -$m450 -$d7 -P1:348/105    1:348/702 402
  57. ;Start F
  58. */
  59. /* Use 'echo command line | rxqueue cntl' to activate the following*/
  60. /* command*/
  61. /*TOSS Crash poll a node */
  62. /*NODE     Crash poll a node */
  63. /*FILE     Get a file from a node*/
  64. /*NODELST  Create latest and greatest nodelst*/
  65. /*DAILY    Nightly Cleanup*/
  66. /*STATS    Weekly Statistics Report*/
  67. /*COMPRESS Compress Message Bases*/
  68. /*FILEBBS  Sort Files BBS*/
  69. /*SQMAXUP  Create Max Msg Entries*/
  70. /*TKMAXUP  Create Max File Entries*/
  71. /*MAXMDESC Add Max Message Descriptions*/
  72. /*MAXFDESC Add Max File Descriptions*/
  73. /*SQUISHUP Create Squish.cfg Entries*/
  74. /*SQUAFUP  Create Sqafix.cfg Entries*/
  75. /*POSTMSG  Post Msg Activity Information*/
  76. /*TICIN    Examine Ticks coming in*/
  77. /*POSTFAN  Post File Activity Information*/
  78. /* line 1 - n - see bink1 and bink2 for examples*/
  79.  
  80. /* This is a Sample Rexx program and as such is only guaranteed to */
  81. /* take up space on your disk*/
  82.  
  83. /* Record error and get back to work*/
  84. Call on failure name recscreen
  85. Call on halt name recscreen
  86. signal on syntax name recscreen
  87.  
  88. /* Setup variables and Paths - Change to suite System*/
  89. Call SetVar
  90.  
  91. /* Setup all nets according to Squish.cfg*/
  92. Call SetSys
  93. /*test routines here
  94. node = 1
  95. Call CompressMsgs
  96. signal EXIT*/
  97.  
  98.  
  99. /* All commands come in through cntl queue*/
  100. Call SetQueue
  101.  
  102. /* This Rexx is taking control!*/
  103. if CntlQueue = "Cntl" then
  104.   /* Clear all flags and get that mail outa here*/
  105.   Call SetMail
  106. else
  107.   /* We're already out there*/
  108.   signal end
  109.  
  110. /* Monitor Queue******************************************/
  111. say '*******Control Ready and Waiting to Receive Queue Data....'
  112. say '       Go to another partition and type "echo toss 1 | rxqueue cntl"'
  113. say '       to test if queue is receiving data.....'
  114. say '       Ensure that Control.cmd, Control.cfg and win.cmd are in the'
  115. say '       same subdirectory. Always start it from that subdirectory'
  116. say '       otherwise another control program in the path may load.'
  117. Do Forever
  118.   command = ''
  119.   do until command <> ''
  120.     if QUEUED() > 0 then
  121.       PULL command node port rest
  122.     else
  123.       Call syssleep 6
  124.   end
  125.   /* Select the command*/
  126.   select
  127.     when command = 'TOSS'        then Call toss
  128.     when command = 'NODE'        then Call PollCrash
  129.     when command = 'FILE'        then Call PollFile
  130.     when command = 'NODELST'     then Call Nodelst
  131.     when command = 'DAILY'       then Call Daily
  132.     when command = 'STATS'       then Call Stats
  133.     when command = 'COMPRESS'    then Call CompressMsgs
  134.     when command = 'FILEBBS'     then Call PrettyFl
  135.     when command = 'SQMAXUP'     then Call SqMaxUp
  136.     when command = 'TKMAXUP'     then Call TkMaxUp
  137.     when command = 'MAXMDESC'    then Call AddMaxMDsc
  138.     when command = 'MAXFDESC'    then Call AddMaxFDsc
  139.     when command = 'SQUISHUP'    then Call SqUpdate
  140.     when command = 'SQUAFUP'     then Call SqaUpdate
  141.     when command = 'POSTMSG'     then Call PostMsg
  142.     when command = 'TICIN'       then Call Mirtle
  143.     when command = 'POSTFAN'     then Call PostFan
  144.     when command = 'HELLO'       then do
  145.       xx = RXQueue("Set",node)
  146.       /* Send back that I am here - can ya dig it*/
  147.       QUEUE 'OK'
  148.       xx = RXQUEUE("Set",CntlQueue)
  149.     end
  150.     when command = 'X'           then
  151.       signal exit
  152.     otherwise NOP
  153.   end /* select command*/
  154. end /* Do Forever*/
  155.  
  156. EXIT:
  157.  
  158. if debug then say 'Exit ------>'
  159.   xx = RXQUEUE('Set',CntlQueue)
  160.   xx = RXQUEUE('Delete',CntlQueue)
  161.   do ii = 1 to wincnt
  162.     xx = RXQUEUE('Set',winqueue.ii)
  163.     queue 'SHUTDOWN'
  164.   end
  165. END:
  166.  
  167. if debug then say 'End ------>'
  168.   xx = RXQUEUE("Set",oq)
  169. exit
  170.  
  171. /* Isthere - tests for the existance of a file*/
  172. isthere: ARG wxy
  173.  
  174. if debug then say 'isthere ------>'
  175.   isthere = LINES(wxy)
  176.   zxy = STREAM(wxy, c, close)
  177. return isthere
  178.  
  179. /* Check for Inbound Mail and Process it***************************/
  180. Toss:
  181.  
  182. if debug then say 'Toss ------>'
  183. LineMsg = TIME('N')'  'command
  184. Call DispLine node
  185. /* Check for Inbound*/
  186. Call SysFileTree Mail'\'InMail'\*.*', 'List', 'SFO'
  187. /* Files exist - Process them*/
  188. if List.0 > 0 then do
  189.   Drive
  190.   'CD\'CmdPath
  191.   /* What files came in?*/
  192.   /* Go until we find the first of a type*/
  193.   tossready  = No
  194.   tickready  = No
  195.   /* Assume that no lists are present*/
  196.   do ii = 1 to filetrap
  197.     filetrap.ii = ''
  198.   end
  199.   do i = 1 to List.0
  200.     /* Put into temp storage*/
  201.     infile.i = List.i
  202.   end
  203.   /* Space required to move Messages to drive*/
  204.   ReqMsgSpace = 0
  205.   do i = 1 to List.0
  206.     /* Check for tics coming in*/
  207.     infile = TRANSLATE(infile.i)
  208.  
  209.     /* Get uppercase extent*/
  210.     dotp = LASTPOS('.',infile)
  211.     if dotp > 0 then
  212.       extent = SUBSTR(infile, dotp+1)
  213.     else
  214.       extent = ''
  215.     /* Call only once - tick will process all*/
  216.     if extent = 'TIC' then do
  217.       LineMsg = TIME('N')' Ticking - 'infile
  218.       Call DispLine node
  219.       tickready = Yes
  220.     end
  221.     else do
  222.       /* Extract the file name*/
  223.       filename = FILESPEC('NAME', infile)
  224.       dotp = POS('.',filename)
  225.       if dotp > 0 then
  226.         filename = DELSTR(filename,dotp)
  227.       /* Check for mail coming in*/
  228.       /* Check for a Hex Site ID*/
  229.       if DATATYPE(filename,'X') then do
  230.         /* Don't look at bad boys*/
  231.         if extent <> 'BAD' then do
  232.           LineMsg = TIME('N')' Processing - 'infile
  233.           Call DispLine node
  234.           tossready = Yes
  235.           SrchFile = Mail'\'InMail'\'FileName
  236.           /* See if we got the file*/
  237.           DiskSpace = 0
  238.           Call SysFileTree infile, 'isthere.', 'F'
  239.           if isthere.0 > 0 then do
  240.             /* Let Squish Handle the move after we check Disk space*/
  241.             ReqMsgSpace = ReqMsgSpace + (WORD(isthere.1, 3) * 2) /* Compression 2 to 1*/
  242.           end
  243.           Drop(isthere.)
  244.         end
  245.       end
  246.       /* Check for special files*/
  247.       do j = 1 to filetrap
  248.         /* Check for a trap file*/
  249.         if filename = trapfile.j then do
  250.           LineMsg = TIME('N')' NodeList - 'filename
  251.           Call DispLine node
  252.           /* Is there more then one data file present*/
  253.           if filetrap.j <> '' then do
  254.             /* Use the override file*/
  255.             if POS('99',extent) > 0 then do
  256.               'erase 'filetrap.j' /n'
  257.               filetrap.j = infile.i
  258.             end
  259.           end
  260.           else do
  261.             /* pull the latest and greatest name*/
  262.             filetrap.j = infile.i
  263.           end
  264.         end
  265.       end
  266.       /* Check for freq files*/
  267.       /* Are there files to be freq'd*/
  268.       if isthere(FreqFile) then do
  269.         do until LINES(FreqFile) = 0
  270.           line = LINEIN(FreqFile)
  271.           trapfile = WORD(line, 1)
  272.           if trapfile = filename then do
  273.             'copy 'infile.i' 'Files'\'FilePath'\'FreqPath
  274.             if RC = 0 then do
  275.               'erase 'infile.i' /n'
  276.               LineMsg = TIME('N')' Freq File - 'filename
  277.               Call DispLine node
  278.             end
  279.           end
  280.           /* Not found - do not delete it from the list*/
  281.           else
  282.             file = LINEOUT(FreqTemp, line)
  283.         end
  284.         file = STREAM(FreqTemp, c, close)
  285.         'copy 'FreqTemp' 'FreqFile
  286.         file = STREAM(FreqFile, c, close)
  287.       end 
  288.     end
  289.   end 
  290.   Drop(List.)
  291.   Drop(infile.) /* End checking files in the inbound*/
  292.   if tickready then do
  293.     Call Tick
  294.   end
  295.   if tossready then do
  296.     tempfree  = FreeSpace
  297.     tempdel   = deletesize
  298.     /* This is the free space needed basis messages coming in*/
  299.     FreeSpace = ReqMsgSpace + TossSpace
  300.     /* This is the size of the large files to delete if we need space*/
  301.     deletesize = TossDelsz
  302.     Call ChkFree
  303.     if FreeLeft >= FreeSpace then do
  304.       /* Files exist - Process them*/
  305.       Drive
  306.       'cd\'SqPath
  307.       'squishp in out squash link'
  308.       Drive
  309.       'cd\'SqPath
  310.       'sqafixp scan'
  311.     end
  312.     FreeSpace = tempfree
  313.     deletesize = tempdel
  314.   end
  315.  
  316.   /* Act on the unticked files*/
  317.   dofastlst = No
  318.   do i = 1 to filetrap
  319.     if filetrap.i <> '' then do
  320.       LineMsg = trapfile.i' List - 'filetrap.i' used...'
  321.       Call DispLine node
  322.  
  323.       /* Update with the new file*/
  324.       filename = FILESPEC('NAME',filetrap.i)
  325.       NodeList
  326.       'cd\'Nodelistpath
  327.       xx = Files'\'Filepath'\other\xmit'
  328.       if isthere(xx'\files.bbs') then do
  329.         'copy 'filetrap.i' 'xx
  330.  
  331.         /* Send out to users*/
  332.         if RC = 0 then do
  333.           /* Special Attaches for this file*/
  334.           select
  335.             when i = 1 then do
  336.               /* 'squishp send 'filename' to 1:xxx/yyy'*/
  337.             end
  338.             otherwise
  339.           end
  340.  
  341.           /* If action to be performed then do it from nodelist*/
  342.           if trapactn <> '' then do
  343.             'copy 'filetrap.i
  344.             /* Unpack File*/
  345.             trapactn.i' 'filename
  346.             if RC = 0 then do
  347.               'erase 'filename' /n'
  348.               dofastlst = Yes
  349.             end
  350.           end
  351.           erase filetrap.i' /n'
  352.         end
  353.       end
  354.     end
  355.   end
  356.   /* Build new nodelist*/
  357.   if dofastlst then do
  358.     NodeList
  359.     'cd\'Nodelistpath
  360.     nodeprocessor
  361.   end
  362. end
  363. return
  364.  
  365. /* Processing scheduled by bink for each day at a non mailing time*/
  366. /* This may use a few CPU cycles so don't run this section along*/
  367. /* with high speed transfers unless the processor has lots of poop*/
  368.  
  369. Daily:
  370.  
  371. if debug then say 'Daily ------>'
  372. LineMsg = TIME('N')'  'command
  373. Call DispLine node
  374. /* Keep the old logs one day*/
  375. LineMsg = ' - Deleting Logs - '
  376. Call DispLine node
  377.  
  378. Log
  379. 'CD \'Logpath
  380. if isthere('squish.log') then do
  381.   'copy squish.log sq.log'
  382.   'erase squish.log /n'
  383. end
  384.  
  385. /* IBM list comes in sometimes twice every day*/
  386. Call SysFileTree Files'\'Filepath'\ibmgen\ibm*.*', 'List', 'FO'
  387. if List.0 > 0 then do
  388.   Drive
  389.   'cd\'Filepath'\ibmgen'
  390.   'erase ibm*.* /n'
  391. end
  392. Drop(List.)
  393.  
  394. Call SysFileTree Mail'\'InMail'\ibm*.*', 'List', 'FO'
  395. if List.0 > 0 then do
  396.   Mail
  397.   'cd\'InMail
  398.   'erase ibm*.* /n'
  399. end
  400. Drop(List.)
  401.  
  402. /* Pack the Message Bases*/
  403. LineMsg = ' - Packing Message Bases - '
  404. Call DispLine node
  405.  
  406. Call SysFileTree Drive'\'SqPath'\*.bad', 'List', 'FO'
  407. if List.0 > 0 then do
  408.   Drive
  409.   'cd\'SqPath
  410.   'erase *.bad /n'
  411. end
  412. Drop(List.)
  413.  
  414. Drive
  415. 'cd\'SqPath
  416. 'sqpackp 'Messages'\'Messpath'\*.sqd > 'SqPackFile
  417.   /* Quick and dirty get rid of the message base*/
  418.   /* Will change to read and recreate the messages up to the point of corruption*/
  419. do until LINES(SqPackFile) = 0
  420.   line = LINEIN(SqPackFile)
  421.   if POS('Err!', line) > 0 then do
  422.     xx = WORD(line, 2)
  423.     'erase "'xx'.*" /n'
  424.     LineMsg = 'Killed - 'xx' - Corrupt message base.'
  425.     Call DispLine node
  426.   end
  427. end
  428. file = STREAM(SqPackFile, c, close)
  429.  
  430. /* Check for Duplicate Files*/
  431. Call CheckDupes
  432.  
  433. /* Update the BBS files list*/
  434. if dofilepost then do
  435.   /* Format the Files.bbs Lists*/
  436.   LineMsg = ' - Formatting/Sorting files.bbs - '
  437.   Call DispLine node
  438.  
  439.   Call Prettyfl
  440.   LineMsg = ' - Creating Files List - '
  441.   Call DispLine node
  442.   Drive
  443.   'cd\'MaxPath
  444.   'fbp'
  445.   if isthere(Avail'.zip') then
  446.     'erase 'Avail'.zip /n'
  447.   'zip 'Avail' 'FBPReq
  448. end
  449. /* See how much space is left on the drive*/
  450. Call ChkFree
  451. /* Compress HPFS Message Bases*/
  452. Call CompressMsgs
  453. /* End of Compress*/
  454. /* Clear out Non Connect Flags*/
  455. Call SysFileTree Mail'\*.$$0', 'List', 'SFO'
  456. /* Files exist - Process them*/
  457. if List.0 > 0 then do
  458.   do i = 1 to List.0
  459.     'erase 'List.i' /n'
  460.   end
  461. end
  462. DROP(List.)
  463.  
  464. /* Check to see if there is unprocessed mail*/
  465. Call SysFileTree Drive'\'SqPath'\*.pkt', 'List', 'SFO'
  466. /* Files exist - Process them*/
  467. if List.0 > 0 then do
  468.   Drive
  469.   'cd\'SqPath
  470.   'squishp in out squash link' 
  471.   DROP(List.)
  472. end
  473. /* Check for new message areas*/
  474. else do
  475.   DROP(List.)
  476.   Call SysFileTree BadArea'\*.Msg', 'List', 'FO'
  477.   /* Files exist - Process them*/
  478.   /*If BadMessages then create squish entries*/
  479.   if List.0 > 0 then do
  480.     DROP(List.)
  481.     /* Update Squish.Cfg file*/
  482.     Call SqUpdate
  483.     Drive
  484.     'cd\'SqPath
  485.     'squishp in out squash link'
  486.     /* If they are still there then they are dups*/
  487.     Call SysFileTree BadArea'\*.Msg', 'List', 'FO'
  488.     if List.0 > 0 then do
  489.       FILESPEC('DRIVE', BadArea)
  490.       'cd\'SUBSTR(BadArea, POS(':', BadArea) + 1)
  491.       'erase *.msg /n'
  492.     end
  493.     DROP(List.)
  494.   end
  495.   /* Put up new Msg areas on the Desktop for the Sysop to update*/
  496.   Call SqMaxUp
  497.   /* Look for descriptions from the feed*/
  498.   Call AddMaxMDsc
  499. end
  500. /* Put up new File areas on the Desktop for the Sysop to update*/
  501. Call TkMaxUp
  502.  
  503. Return
  504.  
  505. /* Check that enough free space is available to process*/
  506. ChkFree:
  507.  
  508. if debug then say 'ChkFree ------>'
  509.   /* Clear out .bad files*/
  510.   Call SysFileTree Drive'\'SqPath'\*.bad', 'List', 'FO'
  511.   if List.0 > 0 then do
  512.     Drive
  513.     'cd\'SqPath
  514.     'erase *.bad /n'
  515.   end
  516.   DROP(List.)
  517.  
  518.   /* See how much space is left on the drive for toss*/
  519.   SysInfo = SysDriveInfo(Drive)
  520.   Parse VAR SysInfo Drive  FreeLeft  Usedspace  DriveName
  521.   /* Clear out some space for tossing*/
  522.   if FreeLeft < FreeSpace then do
  523.     biguns   = TrimLike
  524.     /* Check for Large Files*/
  525.     /* Delete files if we need space for messages*/
  526.     if Drive = Files then
  527.       Call CheckBiguns
  528.     /* Still not enough space*/
  529.     SysInfo = SysDriveInfo(Drive)
  530.     Parse VAR SysInfo Drive  FreeLeft  Usedspace  DriveName
  531.     if FreeLeft < FreeSpace then do
  532.       olduns   = TrimLike
  533.       /* If space can be made for messages by deleteing files then go do it*/
  534.       if Drive = Files then
  535.         Call CheckOlduns
  536.     end
  537.   end
  538. return
  539.  
  540. /* Update the Nodelist*/
  541. NodeLst:
  542.  
  543. if debug then say 'NodeLst ------>'
  544. /* Clear out the work file area*/
  545. Drive
  546. 'cd\'TempPath
  547. 'erase *.* /n'
  548.  
  549. Nodelist
  550. 'cd\'Nodelistpath
  551. /* This is the nodelist processor that I us*/
  552. NodeProcessor
  553. return
  554.  
  555.  
  556. Tick:
  557.  
  558. if debug then say 'Tick ------>'
  559. /* Process Tick File*/
  560. /* Set the string of areas to update to null*/
  561. UpdateFB = ''
  562. /* Then scan ticks and make sure that all the areas are in the .cfg file*/
  563. Call mirtle
  564. /* First check that there is enough space on the Drive*/
  565. tempfree = FreeSpace
  566. FreeSpace = ReqTicSpace
  567. Call ChkFree
  568. FreeSpace = tempfree
  569. /*Tick the files to the area if space is available*/
  570. /* Then create an anounce*/
  571. if FreeLeft >= ReqTicSpace then do
  572.   Drive
  573.   'cd\'TickPath
  574.   'tickp'
  575.   dofilepost = Yes
  576.   /* Now post what we did into a message base*/
  577.   Call postfan
  578.   /* Update the indexes for those areas that have changed*/
  579.   if UpdateFB <> '' then do
  580.     Drive
  581.     'cd\'MaxPath
  582.     'FBP AREA.DAT'UpdateFB
  583.   end
  584. end
  585. return
  586.  
  587. Mirtle:
  588.  
  589. if debug then say 'Mirtle ------>'
  590. /* Check to see if there are .MIR or .TIC files*/
  591. Call CheckMirTic
  592. /* Files exist - Process them*/
  593. if Files.0 > 0 then do
  594.  
  595.   /* Log Date and Time since log entries exist*/
  596.   linemsg = DATE()' 'TIME()
  597.  
  598.   /* Space required to move into Tic Area*/
  599.   ReqTicSpace = 0
  600.  
  601.   /* Get Areas Defined in Tic.cfg*/
  602.   Call GetTickAreas
  603.   if List.0 > 0 then do
  604.     do ii = 1 to List.0
  605.       Tick.ii = List.ii
  606.     end
  607.     Tick.0 = List.0
  608.   end
  609.   else do
  610.     say 'No Tic.cfg files found.'
  611.     say ' Correct path to Drive - TickPath.'
  612.     say 'Currently - 'Drive'\'TickPath'\Tic.cfg'
  613.     return
  614.   end
  615.   DROP(List.)
  616.   /* Get Max Areas for FBP*/
  617.   Call GetMaxFAreas
  618.   if List.0 > 0 then do
  619.     wordptr = 1
  620.     Call SortList
  621.     do ii = 0 to List.0
  622.       max.ii = SUBWORD(List.ii, 1, 2)
  623.     end
  624.   end
  625.   else do
  626.     say 'No filearea.ctl files found.'
  627.     say 'Correct path to Drive - MaxPath.'
  628.     say 'Currently - 'Drive'\'MaxPath'\filearea.ctl'
  629.     return
  630.   end
  631.   DROP(List.)
  632.   do ii = 1 to Files.0
  633.  
  634.     /* Default for Tic*/
  635.     Function = 'ADD'
  636.  
  637.     /* Scan Command File for instructions*/
  638.     Call GetFileInfo
  639.  
  640.     /* Process the file according to the info*/
  641.     select
  642.     when Function = 'ADD' then do
  643.  
  644.       /* Log Function*/
  645.       linemsg = 'ADD - 'FileName' to 'AREA' for File - 'Files.ii
  646.       Call postfile
  647.       /* Find the Tick Area in Config File*/
  648.       Call FindTic
  649.       /* If the index has not gone past the end of the array - it's there*/
  650.       if inx > 0 then do
  651.  
  652.         /* Check if the file is in the area*/
  653.         Call CheckFileThere
  654.         if isthere.0 > 0 then do
  655.  
  656.           /* Does an old file exist*/
  657.           SrchFile = subdir'\'FileName
  658.           Call SysFileTree SrchFile, 'isthere.', 'F'
  659.           /* Remove old file */
  660.           if isthere.0 > 0 then do
  661.             'erase 'WORD(isthere.1, 5)' /n'
  662.           end
  663.  
  664.           if DiskSpace > 0 then do
  665.             linemsg = 'File Name - 'FileName' of size 'DiskSpace' will be copied to 'subdir' by Tick'
  666.             /* If the target drive is not the destination drive then*/
  667.             /* add up the disk space*/
  668.             if SUBSTR(subdir, 1, 1) <> TRANSLATE(SUBSTR(FILES.ii, 1, 1)) then
  669.               ReqTicSpace = ReqTicSpace + DiskSpace
  670.           end
  671.         end
  672.         /* File for .Mir or .Tic is not in the inbound*/
  673.         else do
  674.           Call FileNotFound
  675.         end
  676.         Drop(isthere.)
  677.       end 
  678.       /* Tick not found in the config area*/
  679.       else do
  680.         /* Put it on the desktop to be added in*/
  681.         Call TicNotThere
  682.       end
  683.     end
  684.  
  685.     when Function = 'DELETE' then do
  686.  
  687.       linemsg = 'DELETE - 'FileName' from 'AREA' for File -'Files.ii
  688.       file = LINEOUT(FanTmp, linemsg)
  689.       file = LINEOUT(FanTmp, ' ')
  690.       file = STREAM(FanTmp, c, close)
  691.  
  692.       /* Find the Tick Area in Config File*/
  693.       Call FindTic
  694.  
  695.       /* If the index has not gone past the end of the array - it's there*/
  696.       if (inx <= Tick.0) & (inx > 0) then do
  697.  
  698.         subdir = WORD(Tick.inx, 1)
  699.         /* Delete the file if it is there*/
  700.         if isthere(subdir'\'FileName) then
  701.           'erase 'subdir'\'FileName' /n'
  702.         /* And get rid of the Tic Command File*/
  703.       end
  704.       /* And get rid of the Tic Command File*/
  705.       'erase 'Files.ii' /n'
  706.     end
  707.  
  708.     when Function = 'REPLACE' then do
  709.  
  710.       linemsg = 'REPLACE - 'FileName' in 'AREA' for File -'Files.ii
  711.       Call postfile
  712.  
  713.       /* Find the Tick Area in Config File*/
  714.       Call FindTic
  715.       /* If the index has not gone past the end of the array - it's there*/
  716.       if inx > 0 then do
  717.  
  718.         /* Check the file is in the Area*/
  719.         Call CheckFileThere
  720.  
  721.         /* File for MIR is not found*/
  722.         if isthere.0 = 0 then do
  723.           Call FileNotFound
  724.         end
  725.       end
  726.       else do
  727.         /* Put it on the desktop to be added in*/
  728.         Call TicNotThere
  729.       end
  730.     end
  731.     otherwise
  732.     end
  733.   end
  734. end
  735.  
  736. Drop(Tick.)
  737. return
  738.  
  739. CheckMirTic:
  740.  
  741. if debug then say 'CheckMirTic ------>'
  742. /* Check to see if there are .MIR or .TIC files*/
  743. SrchFile = Mail'\'InMail'\*.TIC'
  744. /* Does the File Exist*/
  745. Call SysFileTree SrchFile, 'Files.', 'FO'
  746. SrchFile = Mail'\'InMail'\*.MIR'
  747. /* Does the File Exist*/
  748. Call SysFileTree SrchFile, 'Mir.', 'FO'
  749. if Mir.0 > 0 then do
  750.   filecnt = Files.0
  751.   do ii = 1 to Mir.0
  752.     filecnt = filecnt + 1
  753.     Files.filecnt = Mir.ii
  754.   end
  755.   Drop(Mir.)
  756.   Files.0 = filecnt
  757. end
  758. return
  759.  
  760. GetFileInfo:
  761.  
  762. if debug then say 'GetFileInfo ------>'
  763.   /* Scan Command File for instructions*/
  764.   Desc = ''
  765.   Area = ''
  766.   Origin = ''
  767.   Fromnm = ''
  768.   FileName = ''
  769.   Function = 'ADD'
  770.   Desc = ''
  771.   Password = ''
  772.   seenby.0 = 0
  773.   TicCmd = TicWork'\'FILESPEC('NAME', Files.ii)
  774.   WriteOut = Yes
  775.   do until LINES(Files.ii) = 0
  776.     line = LINEIN(Files.ii)
  777.     /* Avoid blank lines and Pw with no password*/
  778.     if LENGTH(line) > 2 then do
  779.       keyword = TRANSLATE(WORD(line, 1))
  780.       select
  781.         when keyword = 'AREA' then
  782.           Area = TRANSLATE(WORD(line, 2))
  783.         when keyword = 'ORIGIN' then
  784.           Origin = WORD(line, 2)
  785.         when keyword = 'FROM' then
  786.           Fromnm = WORD(line, 2)
  787.         when keyword = 'FILE' then
  788.           FileName = TRANSLATE(WORD(line, 2))
  789.         when keyword = 'STATUS' then
  790.           Function = WORD(line, 2)
  791.         when keyword = 'DESC' then
  792.           Desc = Desc' 'SUBWORD(line, 2, 30)
  793.         when keyword = 'REPLACES' then
  794.           Function = 'REPLACE'
  795.         when keyword = 'SEENBY' then do
  796.           inx = seenby.0 + 1
  797.           Seenby = SUBWORD(line, 2, 30)
  798.           Seenby.inx = Seenby
  799.           Seenby.0 = inx
  800.         end
  801.         when keyword = 'PW' then do
  802.           Password = WORD(line, 2)
  803.           if Password = '' then
  804.             WriteOut = No
  805.         end
  806.         otherwise
  807.       end /* select*/
  808.       /* Do not write out a password line with a null password*/
  809.       if WriteOut then
  810.         file = LINEOUT(TicCmd, line)
  811.       WriteOut = Yes
  812.     end /*if*/
  813.   end/* do*/
  814.   DROP(seenby.)/* do not need these yet*/
  815.   /* Close .tic or .mir file*/
  816.   file = STREAM(Files.ii, c, close)
  817.   /* But first check if there is a password - if not add one*/
  818.   if Password = '' then do
  819.     file = LINEOUT(TicCmd, 'PW x')
  820.     file = STREAM(TicCmd, c, close)
  821.     'copy 'TicCmd' 'Mail'\'InMail
  822.   end
  823.   else
  824.     file = STREAM(TicCmd, c, close)
  825.   'erase 'TicCmd' /n'
  826.  
  827. return
  828.  
  829. FindTic:
  830.  
  831. if debug then say 'FindTic------>'
  832.   /* Find the Tick Area in Config File*/
  833.   inx = 0
  834.   do j = 1 to Tick.0
  835.     if POS(Area, Tick.j) > 0 then do
  836.       inx = j
  837.       /* Get the subdirectory*/
  838.       subdir = TRANSLATE(WORD(Tick.inx, 1))
  839.       /* Do we add area to the fbp command*/
  840.       do jj = 1 to max.0
  841.         /* If this is the subdirectory in max*/
  842.         if subdir = WORD(max.jj, 1) then do
  843.           /* If we do not have the area listed for reindexing then add it*/
  844.           maxarea = WORD(max.jj, 2)
  845.           if WORDPOS(maxarea, UpdateFB) = 0 then
  846.             UpdateFB = UpdateFB' 'maxarea
  847.           leave
  848.         end
  849.       end
  850.       leave
  851.     end
  852.   end
  853.   if inx = 0 & Area.0 > 0 then do
  854.     do j = 1 to Area.0
  855.       /* Found Area - a bunch are coming in*/
  856.       if Area.j = Area then do
  857.         inx = -1
  858.         leave
  859.       end
  860.     end
  861.   end
  862. return
  863.  
  864. CheckFileThere:
  865.  
  866. if debug then say 'CheckFileThere ------>'
  867.   /* Put the file into the Area*/
  868.   SrchFile = Mail'\'InMail'\'FileName
  869.   /* See if we got the file*/
  870.   DiskSpace = 0
  871.   Call SysFileTree SrchFile, 'isthere.', 'F'
  872.   if isthere.0 > 0 then
  873.     /* Let Tick Handle the move after we check Disk space*/
  874.     DiskSpace = WORD(isthere.1, 3)
  875. /* isthere.0 is tested by the calling routine*/
  876. return
  877.  
  878. FileNotFound:
  879.  
  880. if debug then say 'FileNotFound ------>'FileName
  881.   linemsg = 'File Name - 'FileName' was missing from inbound.'
  882.   /* Save it to examine*/
  883.   'copy 'Files.ii' 'TicWork
  884.   'erase 'Files.ii' /n'
  885. return
  886.  
  887. /* The tic area is not there - put it on the desktop for the operator to add in*/
  888. TicNotThere:
  889.  
  890. if debug then say 'TicNotThere ------>'Area
  891.   if Files.ii = '' then
  892.     return
  893.   linemsg = '*****AREA NOT FOUND*****'
  894.   /* Save the info until the operator creates the subdirs and adds to tic.cfg*/
  895.   'COPY 'Files.ii' 'TicWork
  896.   'ERASE 'Files.ii' /n'
  897.   'COPY 'Mail'\'InMail'\'FileName' 'TicWork
  898.   'ERASE 'Mail'\'InMail'\'FileName' /n'
  899.   /* Only record it once*/
  900.   if inx = 0 then do
  901.     file = LINEOUT(TempTic, 'AREA 'Files'\'FilePath'\'Area' 'Area)
  902.     file = LINEOUT(TempTic, '        'Fromnm' 'Password' *&')
  903.     file = STREAM(TempTic, c, close)
  904.     Area.0 = Area.0 + 1
  905.     xxx = Area.0
  906.     Area.xxx = Area
  907.   end
  908. return
  909.  
  910. /* Put out a message file*/
  911. PostFile:
  912.  
  913. if debug then say 'PostFile ------>'
  914. /* The sum is picked up and posted by postfan*/
  915. file = LINEOUT(FanTmp, linemsg)
  916. file = LINEOUT(FanTmp, 'From - 'Fromnm)
  917. file = LINEOUT(FanTmp, 'Desc - 'Desc)
  918. file = LINEOUT(FanTmp, ' ')
  919. file = STREAM(FanTmp, c, close)
  920. return
  921.  
  922. /* Do statistics here*/
  923. Stats:
  924.  
  925. if debug then say 'Stats ------>'
  926. LineMsg = TIME('N')'  'command
  927. Call DispLine node
  928. return
  929.  
  930. CheckDupes:
  931.  
  932. if debug then say 'CheckDupes ------>'
  933. Call DispLine node
  934.  
  935. /* Check to see if there are duplicate files under this root*/
  936. Dupes = 0
  937. Likes = 0
  938. Call SysFileTree Files'\'Filepath'\*.*', 'List', 'SFT'
  939. /* Files exist - Process them*/
  940. if List.0 > 0 then do
  941.   inx = 0
  942.   /* Remove all Files. lines*/
  943.   do i = 1 to List.0
  944.     FileName = TRANSLATE(FILESPEC('NAME',WORD(List.i,4)))
  945.     if POS('FILES',FileName) = 0 then do
  946.       /* Keep the Name with the Date and Time*/
  947.       inx = inx + 1
  948.       List.inx = TRANSLATE(LEFT(FileName,13))' 'DELWORD(List.i,3,1)
  949.     end
  950.   end
  951.  
  952.   List.0 = inx
  953.   if inx > 1 then do
  954.     wordptr = 1
  955.     Call SortList
  956.     if isthere(TrimLike) then
  957.       'erase 'TrimLike' /n'
  958.     /* Compare files for dupes*/
  959.     do i = 2 to List.0
  960.       j = i - 1
  961.       oldname = WORD(List.j,1)
  962.       newname = WORD(List.i,1)
  963.       if oldname = newname then do
  964.         file = LINEOUT(TrimLike,List.j)
  965.         file = LINEOUT(TrimLike,List.i)
  966.         file = STREAM(TrimLike, c, close)
  967.         /* Delete the Oldest Date*/
  968.         if WORD(List.j, 2) < Word(List.i, 2) then
  969.           'erase 'WORD(List.j, 4)' /n'
  970.         else
  971.           'erase 'WORD(List.i, 4)' /n'
  972.         Dupes = Dupes + 1
  973.       end
  974.       if clen > 0 then do
  975.         /* The Names are close*/
  976.         if substr(oldname,1,clen) = substr(newname,1,clen) then do
  977.           oldpos = POS('.',oldname)
  978.           newpos = POS('.',newname)
  979.           /* Check the char before the decimal for numeric*/
  980.           if oldpos > 1 then
  981.             oldrev = substr(oldname,oldpos - 1,1)
  982.           else
  983.             oldrev = substr(oldname,LENGTH(oldname),1)
  984.           if newpos > 1 then
  985.             newrev = substr(newname,newpos - 1,1)
  986.           else
  987.             newrev = substr(newname,LENGTH(newname),1)
  988.           if DATATYPE(oldrev) = 'NUM' & DATATYPE(newrev) = 'NUM' then do
  989.             if oldrev <> newrev then do
  990.               /* If dates are different*/
  991.               if SUBSTR(WORD(List.j,2),1,8) <> SUBSTR(WORD(List.i,2),1,8) then do
  992.                 file = LINEOUT(TrimLike,List.j)
  993.                 file = LINEOUT(TrimLike,List.i)
  994.                 file = STREAM(TrimLike, c, close)
  995.                 Likes = Likes + 1
  996.               end
  997.             end
  998.           end
  999.         end
  1000.       end
  1001.     end
  1002.   end
  1003.  
  1004.   /* Set back to the control queue*/
  1005.   if Dupes > 0 then do
  1006.     LineMsg = ' - There were 'Dupes' Duplicate Files -'
  1007.     Call DispLine node
  1008.   end
  1009.   if Likes > 0 then do
  1010.     LineMsg = ' - There were 'Likes' Similar Files - Check ->'TrimLike
  1011.     Call DispLine node
  1012.   end
  1013. end
  1014. Drop(List.)
  1015. /* End of the Duplicate Files Check*/
  1016. Return
  1017.  
  1018. CheckBiguns:
  1019.  
  1020. if debug then say 'CheckBiguns ------>'
  1021. /* Now Check for Large files that users could not download anyway*/
  1022.   LineMsg = Files' has 'FreeLeft' bytes left!'
  1023.   Call DispLine node
  1024.   LineMsg = ' - Trimming Files Larger then 'deletesize' bytes'
  1025.   Call DispLine node
  1026.   filecnt = 0
  1027.   SrchFile = Files'\'Filepath'\*.*'
  1028.   /* Look for all Files*/
  1029.   Call SysFileTree SrchFile, 'List', 'SFT'
  1030.   if List.0 > 0 then do
  1031.     LineMsg = List.0' Files Found to Examine.'
  1032.     Call DispLine node
  1033.     wordptr = 2
  1034.     Call SortList
  1035.     do i = List.0 to 1 by -1
  1036.       FileDesc = WORD(List.i ,4)
  1037.       FileName = FILESPEC('NAME', FileDesc)
  1038.       FileType = TRANSLATE(RIGHT(FileName, LENGTH(FileName) - LASTPOS('.',FileName)))
  1039.       if POS(FileType, keepfiles) = 0 then do
  1040.         FileSize = WORD(List.i, 2)
  1041.         if FileSize > deletesize then do
  1042.           FreeLeft = FreeLeft + FileSize
  1043.           file = LINEOUT(biguns,List.i)
  1044.           file = STREAM(biguns, c, close)
  1045.           'erase 'FileDesc' /n'
  1046.           linemsg = 'DELETING - 'FileName' for lack of space on drive...'
  1047.           file = LINEOUT(FanTmp, linemsg)
  1048.           linemsg = 'Reason - File is too Large - 'FileSize' bytes'
  1049.           file = LINEOUT(FanTmp, linemsg)
  1050.           file = LINEOUT(FanTmp, ' ')
  1051.           file = STREAM(FanTmp, c, close)
  1052.           filecnt = filecnt + 1
  1053.         end
  1054.         if FreeLeft > FreeSpace then leave
  1055.         if FileSize < deletesize then leave
  1056.       end
  1057.     end
  1058.   end
  1059.   Drop(List.)
  1060.  
  1061.   if filecnt > 0 then do
  1062.     LineMsg = filecnt' Large Files Deleted.'
  1063.     Call DispLine node
  1064.   end
  1065.   /* End of the Big Ones*/
  1066. Return
  1067.  
  1068. CheckOlduns:
  1069.  
  1070. if debug then say 'CheckOlduns ------>'
  1071.   /* Look for all Files and sort Old to Newest*/
  1072.   Call SysFileTree SrchFile, 'List', 'SFT'
  1073.   LineMsg = ' - Trimming Outdated Files...'
  1074.   Call DispLine node
  1075.   filecnt = 0
  1076.   if List.0 > 0 then do
  1077.     /* Look for Old files*/
  1078.     wordptr = 1
  1079.     Call SortList
  1080.     today = DATE('O')
  1081.     thismonth = LEFT(today, 5)
  1082.     do i = 1 to List.0
  1083.       FileDesc = WORD(List.i ,4)
  1084.       FileName = FILESPEC('NAME', FileDesc)
  1085.       FileType = RIGHT(FileName, LENGTH(FileName) - LASTPOS('.',FileName))
  1086.       if POS(FileType, keepfiles) = 0 then do
  1087.         FileDate = WORD(List.i, 1)
  1088.         if thismonth = LEFT(FileDate, 5) then leave
  1089.         FileSize = WORD(List.i, 2)
  1090.         FreeLeft = FreeLeft + FileSize
  1091.         file = LINEOUT(olduns,List.i)
  1092.         file = STREAM(olduns, c, close)
  1093.         'erase 'FileDesc' /n'
  1094.         linemsg = 'DELETING - 'FileName' for lack of space on drive...'
  1095.         file = LINEOUT(FanTmp, linemsg)
  1096.         linemsg = 'Reason - File is too Old - 'FileDate
  1097.         file = LINEOUT(FanTmp, linemsg)
  1098.         file = LINEOUT(FanTmp, ' ')
  1099.         file = STREAM(FanTmp, c, close)
  1100.         if FreeLeft > FreeSpace then leave
  1101.       end
  1102.     end
  1103.   end
  1104.   Drop(List.)
  1105.  
  1106.   if filecnt > 0 then do
  1107.     LineMsg = filecnt' Old Files Deleted.'
  1108.     Call DispLine node
  1109.   end
  1110. Return
  1111.  
  1112. CompressMsgs:
  1113.  
  1114. if debug then say 'CompressMsgs ------>'
  1115. Call SysFileTree Messages'\'Messpath'\*.SQI','List','F'
  1116. wordptr = 5
  1117. Call SortList
  1118. LineMsg = 'Compressing 'List.0' Message areas...'
  1119. Call DispLine node
  1120. filedel.0 = 0
  1121.  
  1122. Drive
  1123. 'cd\'SqPath
  1124. /* Read in the Message Aging File*/
  1125. FileChk.0 = 0
  1126. if isthere(MsgWait) then do
  1127.   i = 0
  1128.   do until LINES(MsgWait) = 0
  1129.     line = LINEIN(MsgWait)
  1130.     i = i + 1
  1131.     FileChk.i = line
  1132.   end
  1133.   FileChk.0 = i
  1134. end
  1135.  
  1136. Drive
  1137. 'cd\'Messpath
  1138.  
  1139. do i = 1 to List.0
  1140.   FileName = FILESPEC('NAME',WORD(List.i, 5))
  1141.   dotp = POS('.', FileName)
  1142.   if dotp > 0 then
  1143.     FileName = DELSTR(FileName, dotp)
  1144.   size = WORD(List.i, 3)
  1145.   if size > 0 then do
  1146.     'copy "'FileName'.sqb" temp.$$$ > NUL'
  1147.     if RC = 0 then do
  1148.       'erase "'FileName'.sqb" /n'
  1149.       'ren temp.$$$ "'FileName'.sqb"'
  1150.       filedata = FileName'.sqd'
  1151.       if isthere(filedata) then do
  1152.         'copy "'filedata'" temp.$$$ > NUL'
  1153.         if RC = 0 then do
  1154.           'erase "'filedata'" /n'
  1155.           'rename temp.$$$ "'filedata'"'
  1156.         end
  1157.       end
  1158.     end
  1159.     /* else say file' Being used -> not processed'*/
  1160.   end
  1161.   else do
  1162.     MsgAge = 0
  1163.     MsgInx = 0
  1164.     if FileChk.0 > 0 then do
  1165.       do ii = 1 to FileChk.0
  1166.         if WORD(FileChk.ii, 1) = FileName then do
  1167.           MsgAge = WORD(FileChk.ii, 2)
  1168.           MsgInx = ii
  1169.           leave
  1170.         end
  1171.       end
  1172.     end
  1173.     /* Zero Messages for too long - delete the file*/
  1174.     if MsgAge > AgeMsg then do
  1175.       FileChk = FileName'.sqi'
  1176.       if isthere(FileChk) then
  1177.         'erase "'FileChk'" /n'
  1178.       FileChk = FileName'.sql'
  1179.       if isthere(FileChk) then
  1180.         'erase "'FileChk'" /n'
  1181.       FileChk = FileName'.sqb'
  1182.       if isthere(FileChk) then
  1183.         'erase "'FileChk'" /n'
  1184.       FileChk = FileName'.sqd'
  1185.       if isthere(FileChk) then
  1186.         'erase "'FileChk'" /n'
  1187.       filedel = filedel.0 + 1
  1188.       filedel.filedel = FileName
  1189.       filedel.0 = filedel    
  1190.       LineMsg = FileName' Message Base Unused.'
  1191.       Call DispLine node
  1192.       do ii = MsgInx to FileChk.0 - 1
  1193.         jj = ii + 1
  1194.         FileChk.ii = FileChk.jj
  1195.       end
  1196.       FileChk.0 = FileChk.0 - 1
  1197.     end
  1198.     else do
  1199.       /* Add new Msg to list or Update age*/
  1200.       if MsgInx = 0 then
  1201.         FileChk = FileChk.0 + 1
  1202.       else
  1203.         FileChk = MsgInx
  1204.       MsgAge = MsgAge + 1
  1205.       FileChk.FileChk = FileName' 'MsgAge
  1206.       if MsgInx = 0 then
  1207.         FileChk.0 = FileChk
  1208.     end
  1209.   end
  1210. end
  1211. Drop(List.)
  1212.  
  1213. /* Write back the aging file*/
  1214. Drive
  1215. 'cd\'SqPath
  1216. if isthere(MsgWait) then
  1217.   'erase 'MsgWait' /n'
  1218. if FileChk.0 > 0 then do
  1219.   do i = 1 to FileChk.0
  1220.     file = LINEOUT(MsgWait, FileChk.i)
  1221.   end
  1222. end
  1223.  
  1224. if filedel.0 > 0 then do
  1225.   LineMsg = filedel.0' Empty Message Bases Deleted.'
  1226.   Call DispLine node
  1227.   do filedel = 1 to filedel.0
  1228.     FileName = filedel.filedel
  1229.     Call SqDelete
  1230.     linemsg = 'Echo Area - 'FileName' deleted on 'Date()' 'Time()
  1231.     file = LINEOUT(MsgTmp, linemsg)
  1232.     file = LINEOUT(MsgTmp, 'for lack of messages')
  1233.     file = LINEOUT(MsgTmp, ' ')
  1234.     file = STREAM(MsgTmp, c, close)
  1235.   end
  1236.   /* Update the sqafix.cfg*/
  1237.   Call SqaUpdate
  1238.   /* Post Message Announce on Desktop and Message Base*/
  1239.   Call postmsg
  1240. end
  1241. Drop(filedel.)
  1242. Return
  1243.  
  1244.  
  1245. /* Open the message base interface for read*/
  1246. MapiOpn:
  1247. /* Needs RXMSGAPI.DLL - SRI.ZIP*/
  1248.  
  1249. 'RXSUBCOM Register MSGAPI RXMSGAPI RXMSGAPI'
  1250. 'RXSUBCOM Load MSGAPI RXMSGAPI'
  1251. signal on halt name CLEANUP
  1252. signal on syntax name CLEANUP
  1253. /* Lets look at the bad messages area*/
  1254. address MSGAPI 'OPEN_API 1'
  1255. if RC <> 0 then
  1256.   signal CLOSEO
  1257. address MSGAPI 'OPEN_AREA' 'SAREAQ 'msg_base' 'basedef' 'basetype
  1258. return
  1259.  
  1260. /* Set the message base interface for read*/
  1261. MapiSetRead:
  1262. address MSGAPI 'OPEN_MSG' 'HANDLE' 'SAREAQ' 'MOPEN_READ' '1'
  1263. if RC <> 0 then
  1264.   signal CLOSEA
  1265. return
  1266.  
  1267. /* Set the message base interface for Write*/
  1268. MapiSetWrite:
  1269. address MSGAPI 'OPEN_MSG' 'HANDLE' 'SAREAQ' 'MOPEN_CREATE' '0'
  1270. if RC <> 0 then
  1271.   signal CLOSEA
  1272. return
  1273.  
  1274. /* Read the first message from the message base*/
  1275. MapiRdMsg:
  1276.   address MSGAPI 'READ_MSG' 'HANDLE' 'XMSG.' '0' '1000' 'MESSAGE' '100' 'CONTROL'
  1277. return
  1278.  
  1279. /* Write the first message to the message base*/
  1280. MapiWtMsg:
  1281. if Text <> '' then
  1282.   address MSGAPI 'WRITE_MSG' 'HANDLE' '0' 'XMSG.' 'TEXT' TEXTLEN TOTLEN CONTRLEN 'CONTRVAR'
  1283. else
  1284.   address MSGAPI 'WRITE_MSG' 'HANDLE' '0' 'XMSG.' 'NULL' TEXTLEN TOTLEN CONTRLEN 'CONTRVAR'
  1285. return
  1286.  
  1287. /* Read the next message*/
  1288. MapiNRdMsg:
  1289. /* Get the next message*/
  1290. address MSGAPI 'CLOSE_MSG' HANDLE
  1291. address MSGAPI 'GET_CURRENT_MSG' 'SAREAQ' 'MSGNUM'
  1292. address MSGAPI 'CLOSE_MSG' HANDLE
  1293. address MSGAPI 'KILL_MSG' 'SAREAQ' 'MSGNUM'
  1294. address MSGAPI 'OPEN_MSG' 'HANDLE' 'SAREAQ' 'MOPEN_READ' 'MSGNUM_NEXT'
  1295. return
  1296.       
  1297. MapiCls:
  1298. /* Needs RXMSGAPI.DLL*/
  1299.  
  1300. CleanUp:
  1301.  
  1302. if debug then say 'CleanUp ------>'
  1303. /* If we got out of this cleanly*/
  1304. if RC = 0 then
  1305.   address MSGAPI 'CLOSE_MSG' HANDLE
  1306. CLOSEA:
  1307. address MSGAPI 'CLOSE_AREA' 'SAREAQ'
  1308. CLOSEO:
  1309. address CMD 'RXSUBCOM drop MSGAPI'
  1310. Call on halt name recscreen
  1311. signal on syntax name recscreen
  1312.  
  1313. return
  1314.  
  1315. /* Post File Announce in the message base*/
  1316. PostFan:
  1317.  
  1318. if debug then say 'PostFan ------>'
  1319. msg_base = TRANSLATE(Messages'\'Messpath'\'FanBase)
  1320. if isthere(FanTmp) then do
  1321.   PostTmp = FanTmp
  1322.   if FanArea <> 'FANAREA' then do
  1323.     PostArea = FanArea
  1324.     Call post
  1325.   end
  1326. end
  1327. return
  1328.  
  1329. /* Post Message Announce in the message base*/
  1330. PostMsg:
  1331.  
  1332. if debug then say 'PostMsg ------>'
  1333. msg_base = TRANSLATE(Messages'\'Messpath'\'MsgBase)
  1334. if isthere(MsgTmp) then do
  1335.   PostTmp = MsgTmp
  1336.   if MsgArea <> 'MSGAREA' then do
  1337.     PostArea = MsgArea
  1338.     Call post
  1339.   end
  1340. end
  1341. return
  1342.  
  1343. /* Send out the Posted Message*/
  1344. Post:
  1345.  
  1346. if debug then say 'Post ------>'
  1347. basedef  = 'MSGAREA_CRIFNEC'
  1348. basetype = 'SQUISH'
  1349. /* Open and set to write*/
  1350. Call MapiOpn
  1351. /* attr from to subj orig dest date_written ... MUST NOT BE USED AS VARIABLES*/
  1352. XMSG.attr = 256
  1353. XMSG.from = 'Sysop'
  1354. XMSG.to = 'All'
  1355. XMSG.subj = 'Announcement'
  1356. XMSG.orig = '1:'SUBSTR(net.1, 3)'.0'
  1357. XMSG.dest = XMSG.orig
  1358. Name = ' * Origin: 'BBSName' ('SUBSTR(net.1, 3)')'
  1359. DATE = DATE('O')
  1360. TIME = TIME('N')
  1361. /* Correction to msgapi change 9 in 9x of year to 7x*/
  1362. XMSG.date_written ='7'SUBSTR(DATE, 2)':'TIME
  1363. XMSG.date_arrived = XMSG.date_written
  1364. XMSG.utc_ofs = 0
  1365. XMSG.replyto = 0
  1366. XMSG.replies = 0
  1367. do ii = 1 to 10
  1368.   XMSG.replies.ii = 0
  1369. end
  1370. DATE = DATE('N')
  1371. XMSG.ftsc_date = DELSTR(DATE, 7)' 'SUBSTR(DATE, 10)'  'TIME
  1372. totlen = 0
  1373. contrvar = SOH||NULL
  1374. contrlen = LENGTH(contrvar)
  1375. Text = '    The following Files were Received on - 'DATE('O')' 'TIME()||LF
  1376. Textlen = 0
  1377. do while LINES(PostTmp) > 0
  1378.   line = LINEIN(PostTmp)
  1379.   file = LINEOUT(PostArea, line)
  1380.   Text = Text||line||LF
  1381. end
  1382. Text = Text'--- Control 2.1'LF
  1383. Text = Text||Name
  1384. Textlen = LENGTH(Text)
  1385. totlen = Textlen + 8
  1386. /* Write out the message*/
  1387. Call MapiSetWrite
  1388. Call MapiWtMsg
  1389. Call MapiCls
  1390. file = STREAM(PostTmp, c, close)
  1391. file = STREAM(PostArea, c, close)
  1392. 'erase 'PostTmp' /n'
  1393. return
  1394.  
  1395. /* Look for netmail requests*/
  1396. ReqChange:
  1397.  
  1398. if debug then say 'ReqChange ------>'
  1399. /* Needs RXMSGAPI.DLL*/
  1400.  
  1401. msg_base = BadArea
  1402. basedef  = 'MSGAREA_NORMAL'
  1403. basetype = 'SDM'
  1404.  
  1405. /* Open and set to read*/
  1406. Call MapiOpn
  1407. Call MapiSetRead
  1408. do while RC = 0
  1409.   Call MapiRdMsg
  1410.  
  1411.   Call MapiNRdMsg
  1412. end
  1413. return
  1414.  
  1415. /* Delete Squish message bases*/
  1416. SqDelete:
  1417.  
  1418. if debug then say 'SqDelete ------>'
  1419. 'copy 'squishcfg' 'SquishTmp
  1420. if isthere(SquishWrk) then
  1421.   'erase 'SquishWrk' /n'
  1422.  
  1423. /* Look for the FileName message base*/
  1424. FileName = TRANSLATE(FileName)
  1425. line = LINEIN(SquishTmp)
  1426. do while LINES(SquishTmp) > 0
  1427.   if (TRANSLATE(WORD(line, 1)) = 'ECHOAREA') & (FileName = TRANSLATE(FILESPEC('NAME',WORD(line, 3)))) then do
  1428.     LineMsg = 'Deleting Echoarea 'FileName
  1429.     Call DispLine node
  1430.   end
  1431.   else
  1432.     file = LINEOUT(SquishWrk, line)
  1433.   line = LINEIN(SquishTmp)
  1434. end
  1435. file = LINEOUT(SquishWrk, line)
  1436. file = LINEOUT(SquishTmp)
  1437. file = LINEOUT(SquishWrk)
  1438. 'copy 'SquishWrk' 'squishcfg
  1439. 'erase 'SquishTmp' /n'
  1440. 'erase 'SquishWrk' /n'
  1441.  
  1442. return
  1443.  
  1444. /* Look for new messages in the Bad message area and add to squish.cfg*/
  1445. SqUpdate:
  1446.  
  1447. if debug then say 'SqUpdate ------>'
  1448. /* Needs RXMSGAPI.DLL*/
  1449.  
  1450. msg_base = BadArea
  1451. basedef  = 'MSGAREA_NORMAL'
  1452. basetype = 'SDM'
  1453.  
  1454. /* Open and set to read*/
  1455. Call MapiOpn
  1456. Call MapiSetRead
  1457.  
  1458. /* Count new areas found in the bad messages*/
  1459. NewAreas.0 = 0
  1460.  
  1461. /* Until all messages have been scanned*/
  1462. LineMsg = 'Looking for New Message Bases...'
  1463. Call DispLine node
  1464. filecnt = 0
  1465.  
  1466. do while RC = 0
  1467.   Call MapiRdMsg
  1468.  
  1469.   /* Pull Area name out of control info*/
  1470.   AreaStart = POS('AREA:',CONTROL)
  1471.   if AreaStart > 0 then do
  1472.     AreaEnd = POS('',CONTROL,AreaStart)
  1473.     if AreaEnd > 0 then do
  1474.       AreaStart = AreaStart + 5
  1475.       AreaEnd = AreaEnd - 7
  1476.       /* And put in Area*/
  1477.       Area = SUBSTR(CONTROL, AreaStart, AreaEnd)
  1478.  
  1479.       /* Which zone did this message come from - strip :-> from right*/
  1480.       semip = POS(semicolon, XMSG.orig)
  1481.       if semip > 0 then
  1482.         netid = DELSTR(XMSG.orig, semip + 1)
  1483.       else
  1484.         netid = zonedef':'
  1485.       /* Make sure that we got this one from the same net*/
  1486.       AreaId = Area' 'netid
  1487.  
  1488.       /* OK did we run across this one before*/
  1489.       found = 0
  1490.       if NewAreas.0 > 0 then do
  1491.         do x = 1 to NewAreas.0
  1492.           if NewAreas.x = AreaId then do
  1493.             found = x
  1494.             leave
  1495.           end
  1496.         end
  1497.         if found = 0 then do
  1498.           NewAreas = NewAreas.0 + 1
  1499.           NewAreas.NewAreas = AreaId
  1500.           NewAreas.0 = NewAreas
  1501.           filecnt = filecnt + 1
  1502.         end
  1503.       end
  1504.       else do
  1505.         NewAreas.1 = AreaId
  1506.         NewAreas.0 = 1
  1507.         /* Oh boy - a new area - copy .cfg to work area*/
  1508.         'copy 'squishcfg' 'SquishTmp
  1509.         if isthere(SquishWrk) then
  1510.           'erase 'SquishWrk' /n'
  1511.         filecnt = 1
  1512.       end
  1513.  
  1514.       /* Look to see if we are in that net*/
  1515.       if found = 0 then do
  1516.         netno = 0
  1517.         do y = 1 to net
  1518.           if POS(netid, net.y) > 0 then do
  1519.             netno = y
  1520.             leave
  1521.           end
  1522.         end
  1523.  
  1524.         /* Found net so set up line for squish.cfg*/
  1525.         if netno > 0 then do
  1526.           /* Post for announcement*/
  1527.           origin = origin.netno
  1528.           linemsg = 'Echo Area - 'area' added on 'Date()' 'Time()
  1529.           file = LINEOUT(MsgTmp, linemsg)
  1530.           dotp = POS('.', XMSG.orig)
  1531.           if dotp > 0 then
  1532.             XMSG.orig = DELSTR(XMSG.orig, dotp)
  1533.           linemsg = 'Origin System = 'XMSG.orig' of 'WORD(origin, WORDS(origin) - 1)
  1534.           file = LINEOUT(MsgTmp, linemsg)
  1535.           file = LINEOUT(MsgTmp, ' ')
  1536.           file = STREAM(MsgTmp, c, close)
  1537.  
  1538.           Area = LEFT(STRIP(Area),14)
  1539.           SquishCln = 'EchoArea  'area' 'Messages'\'Messpath'\'LEFT(TRANSLATE(SUBSTR(Area, 1, 8),'-----','&\/%@'),9)' -$ -$m250 -$d7 'net.netno'     'XMSG.orig
  1540.  
  1541.           /* And put it in the squish.cfg temp file*/
  1542.           do while LINES(SquishTmp) > 0
  1543.             line = LINEIN(SquishTmp)
  1544.             if TRANSLATE(WORD(line, 1)) = 'ECHOAREA' then
  1545.               if POS(net.netno, TRANSLATE(line)) > 0 then
  1546.                 leave
  1547.             file = LINEOUT(SquishWrk, line)
  1548.           end
  1549.           do while LINES(SquishTmp) > 0
  1550.             xline = TRANSLATE(line)
  1551.             if POS(net.netno, xline) = 0 then do
  1552.               file = LINEOUT(SquishWrk, SquishCln)
  1553.               leave
  1554.             end
  1555.             SqArea = WORD(line, 2)
  1556.             /* Safeguard against dupes in Bad Messages*/
  1557.             if SqArea = Area then do
  1558.               NewAreas = NewAreas.0 - 1
  1559.               leave
  1560.             end
  1561.             if SqArea > Area then do
  1562.               file = LINEOUT(SquishWrk, SquishCln)
  1563.               leave
  1564.             end
  1565.             file = LINEOUT(SquishWrk, line)
  1566.             line = LINEIN(SquishTmp)
  1567.           end
  1568.           do while LINES(SquishTmp) > 0
  1569.             file = LINEOUT(SquishWrk, line)
  1570.             line = LINEIN(SquishTmp)            
  1571.           end
  1572.           file = LINEOUT(SquishWrk, line)
  1573.           /* Close files*/
  1574.           file = STREAM(SquishTmp, c, close)
  1575.           file = STREAM(SquishWrk, c, close)
  1576.           'erase 'SquishTmp' /n'
  1577.           'rename 'SquishWrk' 'FILESPEC('NAME',SquishTmp)
  1578.         end
  1579.       end
  1580.     end
  1581.   end
  1582.   Call MapiNRdMsg
  1583.   Drop(xmsg.)
  1584. end
  1585. /* Update squish config file*/
  1586. if NewAreas.0 > 0 then do
  1587.   'copy 'SquishTmp' 'squishcfg
  1588.   'erase 'SquishTmp' /n'
  1589. end
  1590.  
  1591. Call MapiCls
  1592.  
  1593. if filecnt > 0 then do
  1594.   LineMsg = filecnt' New Message Bases Found and Created.'
  1595.   Call DispLine node
  1596.   /* Update sqafix.cfg with new areas*/
  1597.   Call SqaUpdate
  1598.   /* Post Message Announce on Desktop and Message Base*/
  1599.   Call postmsg
  1600. end
  1601. Return
  1602.  
  1603. /* Update the Maximus File area filearea.ctl*/
  1604. /* This will get displayed as a separate desktop item for manual merging*/
  1605.  
  1606. TkMaxUp:
  1607.  
  1608. if debug then say 'TkMaxUp ------>'
  1609. if isthere(TempMaxF) then
  1610.   'erase "'TempMaxF'" /n'
  1611.  
  1612. /* Get Areas Defined in Tic.cfg as Path Area into tick.*/
  1613. Call GetTickAreas
  1614. if List.0 > 0 then do
  1615.   /* Sort Tick areas then setup for compare*/
  1616.   wordptr = 1
  1617.   Call SortList
  1618.   prearea = ''
  1619.   /* Skip dup areas - these are OK*/
  1620.   ii = 0
  1621.   do i = 1 to List.0
  1622.     /* Check for duplicate areas*/
  1623.     farea = WORD(List.i, 1)
  1624.     if farea <> prearea then do
  1625.       ii = ii + 1
  1626.       Tick.ii = List.i
  1627.       prearea = farea
  1628.     end
  1629.   end
  1630.   Tick.0 = ii
  1631.   Drop(List.)
  1632.   Call GetMaxFAreas
  1633.   if List.0 > 0 then do
  1634.     wordptr = 1
  1635.     Call SortList
  1636.     prearea = ''
  1637.     ii = 0
  1638.     do i = 1 to List.0
  1639.       /* Check for duplicate areas*/
  1640.       marea = WORD(List.i, 1)
  1641.       if marea <> prearea then do
  1642.         ii = ii + 1
  1643.         max.ii = WORD(List.i, 1)
  1644.         List.ii = WORD(List.i, 2)
  1645.         prearea = marea
  1646.       end
  1647.       /* This Area is duplicated*/
  1648.       else do
  1649.         file = LINEOUT(TempMaxF, ';****File area - 'prearea' Duplicated in filearea.ctl - fix it***')
  1650.         file = STREAM(TempMaxF, c, close)
  1651.       end
  1652.     end
  1653.     max.0 = ii
  1654.     List.0 = ii
  1655.     /* Sort newnames list*/
  1656.     wordptr = 1
  1657.     Call SortList
  1658.     do i = 1 to List.0
  1659.       newname.i = List.i
  1660.     end
  1661.     newname.0 = List.0
  1662.   end
  1663.   else do
  1664.     say 'No filearea.ctl files found.'
  1665.     say 'Correct path to Drive - MaxPath.'
  1666.     say 'Currently - 'Drive'\'MaxPath'\filearea.ctl'
  1667.     return
  1668.   end
  1669.   Drop(List.)
  1670.  
  1671. end
  1672. else do
  1673.   say 'No Tic.cfg files found.'
  1674.   say ' Correct path to Drive - TickPath.'
  1675.   say 'Currently - 'Drive'\'TickPath'\Tic.cfg'
  1676.   return
  1677. end
  1678. /* Get Files.bbs that Do Exist*/
  1679. Call GetBBSAreas
  1680. if List.0 > 0 then do
  1681.   /* Sort BBS areas that exist*/
  1682.   wordptr = 1
  1683.   Call SortList
  1684.   do i = 1 to List.0
  1685.     path = WORD(List.i, 1)
  1686.     perp = LASTPOS('\', path)
  1687.     if perp > 0 then
  1688.       bbs.i = DELSTR(path, perp)
  1689.     else
  1690.       bbs.i = path
  1691.   end
  1692.   bbs.0 = List.0
  1693. end
  1694. else do
  1695.   say 'No Files.bbs files found.'
  1696.   say ' Correct path to Files - FilePath.'
  1697.   say 'Currently - 'Files'\'FilePath'\Files.bbs /s'
  1698.   return
  1699. end
  1700. Drop(List.)
  1701. say 'Processing Files....'
  1702. say 'Cross checking 'tick.0' tick areas. 'max.0' max areas. 'bbs.0 'bbs areas.'
  1703. /* Now compare files to find the missing entries*/
  1704. mi = 1 /* Max*/
  1705. ti = 1 /* Tick*/
  1706. bi = 1 /* BBS*/
  1707. do until bi > bbs.0 | ti > tick.0 | mi > max.0
  1708.   tarea = WORD(tick.ti, 1)
  1709.   marea = WORD(max.mi, 1)
  1710.   barea = TRANSLATE(bbs.bi)
  1711.   say 't='tarea' m='marea' b='barea
  1712.   /* Tick area matches Max Area*/
  1713.   if tarea = marea then do
  1714.     ti = ti + 1
  1715.     mi = mi + 1
  1716.     /* And the .BBS are present*/
  1717.     if tarea = barea then
  1718.       bi = bi + 1
  1719.     else
  1720.       /* But there appears to be a Tick area that was missed*/
  1721.       if tarea > barea then do
  1722.         ti = ti - 1
  1723.         mi = mi - 1
  1724.         bi = bi + 1
  1725.       end
  1726.   end
  1727.   else do
  1728.     /* Tick area but no Max Area*/
  1729.     if tarea > marea then do
  1730.       /* In the max ctl but no Tick entry*/
  1731.       msgout = 'Max  path - 'marea'->Tick'
  1732.       mi = mi + 1
  1733.       if tarea = barea then do
  1734.         file = LINEOUT(TempMaxF, ';****File area - 'marea' S/B removed - not in Tic***')
  1735.       end
  1736.       else do
  1737.         /* We really missed! A file area was also missed in tick*/
  1738.         file = LINEOUT(TempMaxF, ';****File area - 'marea' missed by tick - check***')
  1739.         if tarea > barea then do
  1740.           /* get rid of the file base - it will get recreated*/
  1741.           Drive
  1742.           file = LINEOUT(TempMaxF, ';****Also delete Files***')
  1743.           bi = bi + 1
  1744.         end
  1745.       end
  1746.     end
  1747.     else do
  1748.       /* Max area needs to be created*/
  1749.       TickArea = WORD(tick.ti, 2)
  1750.       msgout = 'Tick path - 'tarea' Area - 'TickArea'->Max Area '
  1751.       if tarea = barea then do
  1752.         Call MaxFileCreate
  1753.         ti = ti + 1
  1754.         bi = bi + 1
  1755.       end
  1756.       else do
  1757.         if tarea > barea then do
  1758.           file = LINEOUT(TempMaxF, ';****Tick File Area missing for - 'barea'.')
  1759.           bi = bi + 1
  1760.         end
  1761.         else do
  1762.           Call MaxFileCreate
  1763.           ti = ti + 1
  1764.         end
  1765.       end
  1766.     end
  1767.   end
  1768. end
  1769. file = STREAM(TempMaxF, c, close)
  1770. Drop(tick.)
  1771. Drop(bbs.)
  1772. Drop(max.)
  1773. Drop(newname.)
  1774. return
  1775.  
  1776. /* Update the Maximus Message area msgarea.ctl*/
  1777. /* This will get displayed as a separate desktop item for manual merging*/
  1778. SqMaxUp:
  1779.  
  1780. if debug then say 'SqMaxUp ------>'
  1781. if isthere(TempMaxM) then
  1782.   'erase "'TempMaxM'" /n'
  1783.  
  1784. /* Get Areas Defined in Squish.cfg*/
  1785. Call GetSquishAreas
  1786. if List.0 > 0 then do
  1787.   /* Sort squish areas then setup for compare*/
  1788.   wordptr = 1
  1789.   Call SortList
  1790.   prearea = ''
  1791.   ii = 0
  1792.   do i = 1 to List.0
  1793.     tarea = WORD(List.i, 1)
  1794.     if tarea <> prearea then do
  1795.       ii = ii + 1
  1796.       squish.ii = List.i
  1797.       prearea = tarea
  1798.     end
  1799.     /* This Area is duplicated*/
  1800.     else
  1801.       file = LINEOUT(TempMaxM, ';****Message area - 'prearea' Duplicated in Squish.cfg - fix it***')
  1802.   end
  1803.  
  1804.   squish.0 = ii
  1805.  
  1806.   Drop(List.)
  1807.  
  1808.  
  1809.   /* Now get Max Message Areas*/
  1810.   Call GetMaxMAreas
  1811.   if List.0 > 0 then do
  1812.     wordptr = 1
  1813.     Call SortList
  1814.     prearea = ''
  1815.     ii = 0
  1816.     do i = 1 to List.0
  1817.       /* Check for duplicate areas*/
  1818.       marea = WORD(List.i, 1)
  1819.       if marea <> prearea then do
  1820.         ii = ii + 1
  1821.         max.ii = List.i
  1822.         List.ii = WORD(List.i, 2)
  1823.         prearea = marea
  1824.       end
  1825.       /* This Area is duplicated*/
  1826.       else do
  1827.         file = LINEOUT(TempMaxM, ';****Message area - 'prearea' Duplicated in Msgarea.ctl - fix it***')
  1828.         file = STREAM(TempMaxM, c, close)
  1829.       end
  1830.     end
  1831.     max.0 = ii
  1832.     List.0 = ii
  1833.     /* Sort newnames list*/
  1834.     wordptr = 1
  1835.     Call SortList
  1836.     do i = 1 to List.0
  1837.       newname.i = List.i
  1838.     end
  1839.     newname.0 = List.0
  1840.   end
  1841.   else do
  1842.     say 'No MsgArea.ctl files found.'
  1843.     say ' Correct path to Drive - MaxPath.'
  1844.     say 'Currently - 'Drive'\'MaxPath'\MsgArea.ctl'
  1845.     return
  1846.   end
  1847.   Drop(List.)
  1848.  
  1849. end
  1850. else do
  1851.   say 'No Squish.cfg files found.'
  1852.   say ' Correct path to Drive - SqPath.'
  1853.   say 'Currently - 'Drive'\'SqPath'\Squish.cfg'
  1854.   return
  1855. end
  1856.  
  1857. /* Get Message Areas that Do Exist*/
  1858. Call GetMsgAreas
  1859. if List.0 > 0 then do
  1860.   /* Sort msg areas that exist*/
  1861.   wordptr = 5
  1862.   Call SortList
  1863.   j = 0
  1864.   do i = 1 to List.0
  1865.     /* If there are no messages then it aint there*/
  1866.     size = WORD(List.i, 3)
  1867.     if size > 0 then do
  1868.       file = FILESPEC('NAME',WORD(List.i, 5))
  1869.       dotp = POS('.', file)
  1870.       if dotp = 0 then
  1871.         dotp = LENGTH(file) + 1
  1872.       j = j + 1
  1873.       msg.j = Messages'\'MessPath'\'DELSTR(file, dotp)
  1874.     end
  1875.   end
  1876.   msg.0 = j
  1877. end
  1878. else do
  1879.   say 'No Message files found.'
  1880.   say ' Correct path to Mail - MessPath.'
  1881.   say 'Currently - 'Mail'\'MessPath'\*.sqi'
  1882.   return
  1883. end
  1884. Drop(List.)
  1885.  
  1886.  
  1887. say 'Processing Messages....'
  1888. say 'Cross checking 'squish.0' squish areas. 'max.0' max areas. 'msg.0 'msg areas.'
  1889. /* Now compare files to find the missing entries*/
  1890. mi = 1 /* Max*/
  1891. si = 1 /* Squish*/
  1892. fi = 1 /* Message*/
  1893. do until si > squish.0 | fi > msg.0 | mi > max.0
  1894.   sarea = WORD(squish.si, 1)
  1895.   marea = WORD(max.mi, 1)
  1896.   farea = TRANSLATE(msg.fi)
  1897.   say 's='sarea' m='marea' f='farea
  1898.   /* Squish area matches Max Area*/
  1899.   if sarea = marea then do
  1900.     si = si + 1
  1901.     mi = mi + 1
  1902.     /* And the messages are present*/
  1903.     if sarea = farea then
  1904.       fi = fi + 1
  1905.     else
  1906.       /* But there appears to be a Message area that was missed*/
  1907.       if sarea > farea then do
  1908.         si = si - 1
  1909.         mi = mi - 1
  1910.         fi = fi + 1
  1911.       end
  1912.   end
  1913.   else do
  1914.     /* Squish area but no Max Area*/
  1915.     if sarea > marea then do
  1916.       /* In the max ctl but no Squish entry - Probably deleted by compress*/
  1917.       msgout = 'Max  path - 'marea'->Squish'
  1918.       mi = mi + 1
  1919.       if sarea = farea then do
  1920.         file = LINEOUT(TempMaxM, ';****Message area - 'marea' S/B removed - not in Squish***')
  1921.       end
  1922.       else do
  1923.         /* We really missed! A message area was also missed in Squish*/
  1924.         file = LINEOUT(TempMaxM, ';****Message area - 'marea' missed by squish - check***')
  1925.         if sarea > farea then do
  1926.           /* get rid of the message base - it will get recreated*/
  1927.           Drive
  1928.           file = LINEOUT(TempMaxM, ';****Also delete Messages***')
  1929.           fi = fi + 1
  1930.         end
  1931.       end
  1932.     end
  1933.     else do
  1934.       /* Max area needs to be created*/
  1935.       SquishArea = WORD(squish.si, 2)
  1936.       msgout = 'Squish path - 'sarea' Area - 'SquishArea'->Max Area '
  1937.       if sarea = farea then do
  1938.         Call MaxMsgCreate
  1939.         si = si + 1
  1940.         fi = fi + 1
  1941.       end
  1942.       else do
  1943.         if sarea > farea then do
  1944.           file = LINEOUT(TempMaxM, ';****Squish Message Area missing for - 'farea'.')
  1945.           file = LINEOUT(TempMaxM, ';*****If this is a local area then mark it as local in msgarea.ctl...')
  1946.           fi = fi + 1
  1947.         end
  1948.         else do
  1949.           Call MaxMsgCreate
  1950.           si = si + 1
  1951.         end
  1952.       end
  1953.     end
  1954.   end
  1955. end
  1956. file = STREAM(TempMaxM, c, close)
  1957. Drop(squish.)
  1958. Drop(msg.)
  1959. Drop(max.)
  1960. Drop(newname.)
  1961.  
  1962. return
  1963.  
  1964. /* Add a new max file area*/
  1965. MaxFileCreate:
  1966.  
  1967. if debug then say 'MaxFileCreate ------>'
  1968.   /* Create Max area as Files are Present*/
  1969.   Area      = 'A'DELSTR(TickArea, 2)||SUBSTR(TickArea, LENGTH(TickArea) - 1)
  1970.   Call ChkName
  1971.   Area = 'Area 'Area
  1972.   FileAccess = indent'FileAccess      Normal'
  1973.   FileInfo   = indent'FileInfo        'TickArea
  1974.   DownLoad  = indent'Download        'WORD(tick.ti, 1)
  1975.   UpLoad    = indent'Upload          'Uload
  1976.   file = LINEOUT(TempMaxF, Area)
  1977.   file = LINEOUT(TempMaxF, FileAccess)
  1978.   file = LINEOUT(TempMaxF, FileInfo)
  1979.   file = LINEOUT(TempMaxF, DownLoad)
  1980.   file = LINEOUT(TempMaxF, UpLoad)
  1981.   file = LINEOUT(TempMaxF, EndArea)
  1982.   file = STREAM(TempMaxF, c, close)
  1983. return
  1984.  
  1985. /* Add a new max message area*/
  1986. MaxMsgCreate:
  1987.  
  1988. if debug then say 'MaxMsgCreate ------>'
  1989.   /* Create Max area as Messages are Present*/
  1990.   Origin    = indent||SUBWORD(squish.si, 4, 3)' 'bbsName
  1991.   Area      = WORD(squish.si, 7)||SUBSTR(SquishArea, POS('.', SquishArea) + 1, 3)
  1992.   Call ChkName
  1993.   Area = 'Area 'Area
  1994.   MsgAccess = indent'MsgAccess       'SUBWORD(squish.si, 3, 1)
  1995.   MsgInfo   = indent'MsgInfo         'WORD(squish.si ,6)' 'SquishArea
  1996.   EchoMail  = indent'EchoMail        'sarea
  1997.   file = LINEOUT(TempMaxM, Area)
  1998.   file = LINEOUT(TempMaxM, MsgAccess)
  1999.   file = LINEOUT(TempMaxM, Type)
  2000.   file = LINEOUT(TempMaxM, MsgInfo)
  2001.   file = LINEOUT(TempMaxM, EchoMail)
  2002.   file = LINEOUT(TempMaxM, Public)
  2003.   file = LINEOUT(TempMaxM, Origin)
  2004.   file = LINEOUT(TempMaxM, EndArea)
  2005.   file = STREAM(TempMaxM, c, close)
  2006. return
  2007.  
  2008. /* Check for a unique name in file or message area*/
  2009. ChkName:
  2010.  
  2011. if debug then say 'ChkName ------>'
  2012.   jp = newname.0
  2013.   if Area < newname.jp then do
  2014.     jp = 1
  2015.     do while Area >= newname.jp
  2016.       if Area = newname.jp then do
  2017.         tail = LENGTH(Area)
  2018.         tailchr = SUBSTR(Area, tail)
  2019.         /* use next character*/
  2020.         Area = DELSTR(Area, tail)||SUBSTR(maxchrs, POS(tailchr, maxchrs) + 1, 1)
  2021.         jp = 1
  2022.       end
  2023.       jp = jp + 1
  2024.     end
  2025.     /* Insert the new name*/
  2026.     do jj = newname.0 to jp by -1
  2027.       jn = jj + 1
  2028.       newname.jn = newname.jj
  2029.     end
  2030.     newname.jp = Area
  2031.     say 'Adding ='Area
  2032.     newname.0 = newname.0 + 1
  2033.   end
  2034.   else do
  2035.     if newname.jj = Area then do
  2036.       tail = LENGTH(Area)
  2037.       tailchr = SUBSTR(Area, tail)
  2038.       /* use next character*/
  2039.       Area = DELSTR(Area, tail)||SUBSTR(maxchrs, POS(tailchr, maxchrs) + 1, 1)
  2040.     end
  2041.     jj = jj + 1
  2042.     newname.jj = Area
  2043.     newname.0 = jj
  2044.   end
  2045. return
  2046.  
  2047. GetTickAreas:
  2048.  
  2049. if debug then say 'GetTickAreas ------>'
  2050.   /* Scan for Tick File Areas*/
  2051.   tick = 0
  2052.   if isthere(tickcfg) then do
  2053.     do until LINES(tickcfg) = 0
  2054.       line = TRANSLATE(LINEIN(tickcfg))
  2055.       if WORD(line, 1) = 'AREA' then do
  2056.         tick = tick + 1
  2057.         List.tick = SUBWORD(line, 2)
  2058.       end
  2059.     end
  2060.     List.0 = tick
  2061.     file = STREAM(tickcfg, c, close)
  2062.   end
  2063.   else
  2064.     List.0 = 0
  2065. return
  2066.  
  2067. /* Get File Areas from filearea.ctl*/
  2068. GetFileAreas:
  2069.  
  2070. if debug then say 'GetFileAreas ------>'
  2071. /* Read in the filesarea.ctl file until all file areas are found*/
  2072. /* Files.bbs count*/
  2073. Finx = 0
  2074. /* CDRom .bbs count*/
  2075. Cinx = 0
  2076. do until LINES(filesbbs) = 0
  2077.   line = LINEIN(filesbbs)
  2078.  
  2079.   /* Find Area Definition*/
  2080.   if TRANSLATE(WORD(line, 1)) = 'AREA' then do
  2081.     /* Assume Hard Drive*/
  2082.     Finx = Finx + 1
  2083.     Ftype = 'HD'
  2084.     fdesc = ''
  2085.     fdown = Drive
  2086.  
  2087.     /* Get information about area from the ctl file*/
  2088.     do until TRANSLATE(WORD(line, 1)) = 'END'
  2089.       line = TRANSLATE(LINEIN(filesbbs))
  2090.       Directive = WORD(line, 1)
  2091.       select
  2092.         when Directive = 'FILEINFO' then
  2093.           fdesc = SUBWORD(line, 2)
  2094.         when Directive = 'DOWNLOAD' then
  2095.           fdown = WORD(line, 2)
  2096.         when Directive = 'FILELIST' then do
  2097.           /* If CDROM in path then it is CDROM*/
  2098.           if POS('CDROM', WORD(line, 2)) > 0 then do 
  2099.             fcd = SUBWORD(line, 2)
  2100.             Ftype = 'CD'
  2101.             Finx = Finx - 1
  2102.             Cinx = Cinx + 1
  2103.           end
  2104.         end
  2105.         otherwise
  2106.       end
  2107.     end
  2108.  
  2109.     /* A Harddrive File*/
  2110.     if Ftype = 'HD' then do
  2111.       List.Finx = fdown'\files.bbs'
  2112.       Fdesc.Finx = fdesc
  2113.     end
  2114.  
  2115.     /* A CD File*/
  2116.     else do
  2117.       CD.Cinx    = fcd
  2118.       Cdesc.Cinx = fdesc
  2119.     end
  2120.   end
  2121. end
  2122.  
  2123. /* Get the Number of Dynamic file areas - ie - not on CDRom*/
  2124. List.0 = Finx
  2125. return
  2126.  
  2127. GetSquishAreas:
  2128.  
  2129. if debug then say 'GetSquishAreas ------>'
  2130.   /* Scan for Squish File Areas*/
  2131.   if isthere(squishcfg) then do
  2132.     j = 0
  2133.     do until LINES(squishcfg) = 0
  2134.       line = TRANSLATE(LINEIN(squishcfg))
  2135.       if WORD(line, 1) = 'ECHOAREA' then do
  2136.         access = ''
  2137.         origin = ''
  2138.         do k = 1 to net
  2139.           if POS(net.k, line) > 0 then do
  2140.             origin = origin.k
  2141.             access = access.k
  2142.             leave
  2143.           end
  2144.         end
  2145.         j = j + 1
  2146.         /*       path           name           access  description*/
  2147.         List.j = WORD(line,3)' 'WORD(line,2)' 'access' 'origin
  2148.       end   
  2149.     end
  2150.     file = STREAM(squishcfg, c, close)
  2151.     List.0 = j
  2152.   end
  2153.   else
  2154.     List.0 = 0
  2155. return
  2156.  
  2157. /* Find all max msgarea.ctl areas and check for missing config lines*/
  2158. GetMaxFAreas:
  2159.  
  2160. if debug then say 'GetMaxFAreas ------>'
  2161.   /* Get the Max Ctl File Name*/
  2162.   maxctl = Drive'\'MaxPath'\filearea.ctl'
  2163.   /* Scan for File Areas in Filearea.ctl*/
  2164.   if isthere(maxctl) then do
  2165.     j = 0
  2166.     do until LINES(maxctl) = 0
  2167.       line = TRANSLATE(LINEIN(maxctl))
  2168.       if WORD(line, 1) = 'AREA' then do
  2169.         Area = WORD(line, 2)
  2170.         FileInfo  = ''
  2171.         Download = ''
  2172.         Upload = ''
  2173.         /* We ignore any cdrom paths*/
  2174.         FileList = ''
  2175.         FileAccess = ''
  2176.         do until Directive = 'END'
  2177.           line = TRANSLATE(LINEIN(maxctl))
  2178.           Directive = WORD(line, 1)
  2179.           select
  2180.             when Directive = 'FILEACCESS' then do
  2181.               FileAccess = WORD(line, 2)
  2182.               perp = POS('/', FileAccess)
  2183.               /* Strip off class*/
  2184.               if perp > 0 then
  2185.                 FileAccess = DELSTR(FileAccess, perp)
  2186.             end
  2187.             when Directive = 'FILEINFO' then
  2188.               FileInfo = SUBWORD(line, 2)
  2189.             when Directive = 'DOWNLOAD' then
  2190.               DownLoad =  WORD(line, 2)
  2191.             when Directive = 'UPLOAD' then
  2192.               UpLoad =  WORD(line, 2)
  2193.             when Directive = 'FILELIST' then
  2194.               FileList =  WORD(line, 2)
  2195.             otherwise 
  2196.           end
  2197.         end
  2198.         /* If this is not a Cdrom then process it*/
  2199.         if POS('CDROM', FileList) = 0 then do
  2200.           msgout = ''
  2201.           /* Only flag first error*/
  2202.           select
  2203.             when FileAccess = '' then
  2204.               msgout = ';*****File Access'
  2205.             when FileInfo = '' then
  2206.               msgout = ';*****File Description' 
  2207.             when DownLoad = '' then
  2208.               msgout = ';*****Download Section' 
  2209.             when Upload = '' then
  2210.               msgout = ';*****UpLoad Section' 
  2211.             /* Add to Max Message Areas*/
  2212.             otherwise do
  2213.               j = j + 1
  2214.               List.j = DownLoad' 'Area' 'FileAccess' 'FileInfo
  2215.             end
  2216.           end
  2217.           if msgout <> '' then
  2218.             file = LINEOUT(TempMaxF, ' Missing for FileArea='DownLoad' Area='Area' FileAccess='FileAccess' FileInfo='FileInfo)
  2219.         end
  2220.       end   
  2221.     end
  2222.     file = STREAM(maxctl, c, close)
  2223.     List.0 = j
  2224.   end
  2225.   else
  2226.     List.0 = 0
  2227. return
  2228.  
  2229. GetMaxMAreas:
  2230.  
  2231. if debug then say 'GetMaxMAreas ------>'
  2232.   /* Get the Max Ctl File Name*/
  2233.   maxctl = Drive'\'MaxPath'\msgarea.ctl'
  2234.   /* Scan for Max Areas in Msgarea.ctl*/
  2235.   if isthere(maxctl) then do
  2236.     j = 0
  2237.     do until LINES(maxctl) = 0
  2238.       line = TRANSLATE(LINEIN(maxctl))
  2239.       if WORD(line, 1) = 'AREA' then do
  2240.         Area = WORD(line, 2)
  2241.         MsgInfo  = ''
  2242.         EchoMail = ''
  2243.         MsgAccess = ''
  2244.         do until Directive = 'END'
  2245.           line = TRANSLATE(LINEIN(maxctl))
  2246.           Directive = WORD(line, 1)
  2247.           select
  2248.             when Directive = 'MSGINFO' then
  2249.               MsgInfo = SUBWORD(line, 2)
  2250.             when Directive = 'ECHOMAIL' then
  2251.               EchoMail = WORD(line, 2)
  2252.             /* Not Echomail - ignore - This S/B in another subdirectory*/
  2253.             when Directive = 'LOCAL' then
  2254.               EchoMail = 'NO'
  2255.             when Directive = 'MATRIX' then
  2256.               EchoMail = 'NO'
  2257.             when Directive = 'MSGACCESS' then do
  2258.               /* Gets MsgAccess Normal/F */
  2259.               perp = POS('/', line)
  2260.               if perp > 0 then
  2261.                 MsgAccess = SUBSTR(line, perp + 1, 1)
  2262.               else
  2263.                 MsgAccess = 'W' /* Sysop can only turn this on*/
  2264.             end
  2265.             otherwise 
  2266.           end
  2267.         end
  2268.         /* If this isnt echomail then do not bother*/
  2269.         if EchoMail <> 'NO' then do
  2270.           msgout = ''
  2271.           select
  2272.             when EchoMail = '' then
  2273.               msgout = ';*****EchoMail'
  2274.             when Area = '' then
  2275.               msgout = ';*****Area' 
  2276.             when MsgAccess = '' then
  2277.               msgout = ';*****Message Access' 
  2278.             when MsgInfo = '' then
  2279.               msgout = ';*****Message Description' 
  2280.             /* Add to Max Message Areas*/
  2281.             otherwise do
  2282.               j = j + 1
  2283.               List.j = EchoMail' 'Area' 'MsgAccess' 'MsgInfo
  2284.             end
  2285.           end
  2286.           if msgout <> '' then
  2287.             file = LINEOUT(TempMaxM, ' Missing for EchoMail='Echomail' Area='Area' MsgAccess='MsgAccess' MsgInfo='MsgInfo)
  2288.         end
  2289.       end   
  2290.     end
  2291.     file = STREAM(maxctl, c, close)
  2292.     List.0 = j
  2293.   end
  2294.   else
  2295.     List.0 = 0
  2296. return
  2297.  
  2298. GetBBSAreas:
  2299.  
  2300. if debug then say 'GetBBSAreas ------>'
  2301.   /* Get the File Areas*/
  2302.   fls = Files'\'FilePath'\*.BBS'
  2303.   /* Scan for .BBS File Areas*/
  2304.   Call SysFileTree fls,'List.','FSO'
  2305.   /* Make all uppercase for comparison*/
  2306.   do i = 1 to List.0
  2307.     List.i = TRANSLATE(List.i)
  2308.   end
  2309. return
  2310.  
  2311. GetMsgAreas:
  2312.  
  2313. if debug then say 'GetMsgAreas ------>'
  2314.   /* Get the Msg Areas*/
  2315.   msg = Messages'\'MessPath'\*.SQI'
  2316.   /* Scan for Squish File Areas*/
  2317.   Call SysFileTree msg,'List.','F'
  2318.   /* Make all uppercase for comparison*/
  2319.   do i = 1 to List.0
  2320.     List.i = TRANSLATE(List.i)
  2321.   end
  2322. return
  2323.  
  2324. AddMaxMDsc:
  2325.  
  2326. if debug then say 'AddMaxMDsc ------>'
  2327. /* If descriptions are available from feed then add to Max*/
  2328. /* If msgarea.ctl isn't there then look at the desktop file*/
  2329. if isthere(TempMaxM) then do
  2330.   'copy "'TempMaxM'" "'TempMaxW'"'
  2331.   'erase "'TempMaxM'" /n'
  2332.   maxctl = TempMaxW
  2333. end
  2334. /* Otherwise add descriptions to the regular msgarea.ctl file*/
  2335. /* And put it on the desktop*/
  2336. else
  2337.   maxctl = Drive'\'MaxPath'\msgarea.ctl'
  2338. /* Scan for Message Areas in the control file*/
  2339. if isthere(maxctl) then do
  2340.   /* Get Net Addresses from -p1:348/105 to 348*/
  2341.   do i = 1 to net
  2342.     netaddr = net.i
  2343.     semip = POS(':', netaddr)
  2344.     if semip > 0 then
  2345.       netaddr = SUBSTR(netaddr, semip + 1)
  2346.     perp = POS('/', netaddr)
  2347.     if perp > 0 then
  2348.       netaddr.i = DELSTR(netaddr, perp)
  2349.     else
  2350.       netaddr.i = netdef
  2351.   end
  2352.   /* Now look for feed Description File as c:\bink\M348.Lst*/
  2353.   do i = 1 to net
  2354.     descfile = Drive'\'CmdPath'\M'netaddr.i'.LST'
  2355.     if isthere(descfile) then
  2356.       descfile.i = descfile
  2357.     else
  2358.       descfile.i = ''
  2359.   end
  2360.   Drop(netaddr.)
  2361.   do until LINES(maxctl) = 0
  2362.     line = LINEIN(maxctl)
  2363.     if TRANSLATE(WORD(line, 1)) = 'AREA' then do
  2364.       origin = 0
  2365.       EchoMail = 'NO'
  2366.       /*put it on the stack for processing*/
  2367.       lines = 1
  2368.       do until Directive = 'END' | LINES(maxctl) = 0
  2369.         /* Store all the message statements in line.lines*/
  2370.         line.lines = line
  2371.         lines = lines + 1
  2372.         line = LINEIN(maxctl)
  2373.         Directive = TRANSLATE(WORD(line, 1))
  2374.         select
  2375.           when Directive = 'ORIGIN' then
  2376.             /* Pick out the net*/
  2377.             origin = WORD(line, 2) + 1
  2378.           /* Not Echomail - ignore*/
  2379.           when Directive = 'LOCAL' then
  2380.             EchoMail = 'NO'
  2381.           when Directive = 'MATRIX' then
  2382.             EchoMail = 'NO'
  2383.           when Directive = 'ECHOMAIL' then
  2384.             EchoMail = WORD(line, 2)
  2385.           otherwise
  2386.         end
  2387.       end
  2388.       line.lines = line
  2389.       do i = 1 to lines
  2390.         line = line.i
  2391.         /* If this is echomail then get the description if available*/
  2392.         if EchoMail <> 'NO' then do
  2393.           Directive = TRANSLATE(WORD(line, 1))
  2394.           if Directive = 'MSGINFO' then do
  2395.             /* Subdirectory and name in upper case*/
  2396.             EchoMail = TRANSLATE(EchoMail)
  2397.             /* Match the description with the echo*/
  2398.             if origin > 0 & descfile.origin <> '' then do
  2399.               /* Find the Description*/
  2400.               descfile = descfile.origin
  2401.               do until Lines(descfile) = 0
  2402.                 dline = linein(descfile)
  2403.                 if TRANSLATE(WORD(dline, 1)) = EchoMail then do
  2404.                   /* Get the description*/
  2405.                   descline = SUBWORD(dline, 2)
  2406. say EchoMail'----'descline
  2407.                   line = '        MsgInfo         'descline
  2408.                   leave
  2409.                 end
  2410.               end
  2411.               file = STREAM(descfile, c, close)
  2412.             end
  2413.           end
  2414.         end
  2415.         file = LINEOUT(TempMaxM, line)
  2416.       end
  2417.     end
  2418.     /* Not a file control statement*/
  2419.     else
  2420.       file = LINEOUT(TempMaxM, line)
  2421.   end
  2422. end
  2423. Drop(Line.)
  2424.  
  2425. file = STREAM(TempMaxM, c, close)
  2426. file = STREAM(maxctl, c, close)
  2427. return
  2428.  
  2429. AddMaxFDsc:
  2430.  
  2431. if debug then say 'AddMaxFDsc ------>'
  2432. /* If descriptions are available from feed then add to Max*/
  2433. /* If filearea.ctl isn't there then look at the desktop file*/
  2434. if isthere(TempMaxF) then do
  2435.   'copy "'TempMaxF'" "'TempMaxW'"'
  2436.   'erase "'TempMaxF'" /n'
  2437.   maxctl = TempMaxW
  2438. end
  2439. /* Otherwise add descriptions to the regular filearea.ctl file*/
  2440. /* And put it on the desktop*/
  2441. else
  2442.   maxctl = Drive'\'MaxPath'\filearea.ctl'
  2443. /* Scan for File Areas in control file*/
  2444. if isthere(maxctl) then do
  2445.   /* Now look for feed Description File as c:\bink\File.Lst*/
  2446.   descfile = Drive'\'CmdPath'\File.Lst'
  2447.   if isthere(descfile) then do
  2448.     /* Get Areas Defined in Tic.cfg as Path Area into tick.*/
  2449.     Call GetTickAreas
  2450.     do until LINES(maxctl) = 0
  2451.       line = LINEIN(maxctl)
  2452.       if TRANSLATE(WORD(line, 1)) = 'AREA' then do
  2453.         origin = 0
  2454.         /* We don't update CD Areas*/
  2455.         FileArea = 'HD'
  2456.         /*put it on the stack for processing*/
  2457.         lines = 1
  2458.         /* Blank lines separate each Area*/
  2459.         do until Directive = 'END' | LINES(maxctl) = 0
  2460.           /* Store all the message statements in line.lines*/
  2461.           line.lines = line
  2462.           lines = lines + 1
  2463.           line = LINEIN(maxctl)
  2464.           Directive = TRANSLATE(WORD(line, 1))
  2465.           if (Directive = 'DOWNLOAD') & (FileArea = 'HD') then
  2466.             /* Get the path for the search*/
  2467.             FileArea = TRANSLATE(WORD(line, 2))
  2468.           else
  2469.             /* Skip CD Areas*/
  2470.             if (Directive = 'FILELIST') & (POS('CDROM', TRANSLATE(line)) > 0) then
  2471.               FileArea = 'CD'
  2472.         end
  2473.         line.lines = line
  2474.         do i = 1 to lines
  2475.           line = line.i
  2476.           /* If this is dynamic then get the description if available*/
  2477.           if FileArea <> 'CD' then do
  2478.             Directive = TRANSLATE(WORD(line, 1))
  2479.             if Directive = 'FILEINFO' then do
  2480.               /* Subdirectory and name in upper case*/
  2481.               FileArea = TRANSLATE(FileArea)
  2482.               /* Match the Path with the Tic description*/
  2483.               FileID = ''
  2484.               do ii = 1 to List.0
  2485.                 if FileArea = WORD(List.ii, 1) then do
  2486.                   FileID = WORD(List.ii, 2)
  2487.                   leave
  2488.                 end
  2489.               end
  2490.               if FileID <> '' then do
  2491.                 do until LINES(descfile) = 0
  2492.                   dline = linein(descfile)
  2493.                   if TRANSLATE(WORD(dline, 1)) = FileID then do
  2494.                     /* Get the description*/
  2495.                     descline = SUBWORD(dline, 2)
  2496. say FileID'----'descline
  2497.                     line = '        FileInfo         'descline
  2498.                     leave
  2499.                   end
  2500.                 end
  2501.                 file = STREAM(descfile, c, close)
  2502.               end
  2503.             end
  2504.           end
  2505.           file = LINEOUT(TempMaxF, line)
  2506.         end
  2507.       end
  2508.       /* Not a file control statement*/
  2509.       else
  2510.         file = LINEOUT(TempMaxF, line)
  2511.     end
  2512.     Drop(File.)
  2513.   end
  2514. end
  2515. Drop(Line.)
  2516.  
  2517. file = STREAM(TempMaxF, c, close)
  2518. file = STREAM(maxctl, c, close)
  2519. return
  2520.  
  2521. /* Update Sqafix.cfg*/
  2522. SqaUpdate:
  2523.  
  2524. if debug then say 'SqaUpdate ------>'
  2525. /* Get the squish areas to match the path List.0 */
  2526. /* EchoMail   name   access  description*/
  2527. if isthere(sqafixwrk) then
  2528.   'erase 'sqafixwrk' /n'
  2529. class = 'F'
  2530. if isthere(squishcfg) then do
  2531.   j = 0
  2532.   /* Set previous description file to blank*/
  2533.   descfile = ' '
  2534.   found = 0
  2535.   do until LINES(squishcfg) = 0
  2536.     descline = ''
  2537.     line = TRANSLATE(LINEIN(squishcfg))
  2538.     /* Found an echo area - process it*/
  2539.     if WORD(line, 1) = 'ECHOAREA' then do
  2540.       /* Get the name of the echo*/
  2541.       EchoName = WORD(line, 2)
  2542.       EchoPath = TRANSLATE(WORD(line, 3))
  2543.       /* Look for a network address*/
  2544.       line = SUBWORD(line, 4)
  2545.       netpos = POS('-P', line)
  2546.       if netpos > 0 then do
  2547.         netaddr = SUBSTR(line, netpos)
  2548.         semip = POS(':', netaddr)
  2549.         if semip > 0 then
  2550.           netaddr = SUBSTR(netaddr, semip + 1)
  2551.         perp = POS('/', netaddr)
  2552.         if perp > 0 then
  2553.           netaddr = DELSTR(netaddr, perp)
  2554.         else do
  2555.           perp = POS(' ', netaddr)
  2556.           if perp > 0 then
  2557.             netaddr = DELSTR(netaddr, perp)
  2558.         end
  2559.         if POS(netaddr, descfile) = 0 then do
  2560.           descfile = Drive'\'CmdPath'\N'netaddr'.LST'
  2561.           found = isthere(descfile)
  2562.           if found then
  2563.             maxdfile = Drive'\'CmdPath'\M'netaddr'.LST'
  2564.         end
  2565.         if found then do
  2566.           do until LINES(descfile) = 0
  2567.             dline = linein(descfile)
  2568.             if TRANSLATE(WORD(dline, 1)) = EchoName then do
  2569.               /* Get the description*/
  2570.               descline = TRANSLATE(SUBWORD(dline, 2), "'", '"')
  2571.               /* Create file for MsgArea.ctl descriptions*/
  2572.               file = LINEOUT(maxdfile, LEFT(EchoPath, 24)' 'descline)
  2573.               file = STREAM(maxdfile, c, close)
  2574.               leave
  2575.             end
  2576.           end
  2577.           file = STREAM(descfile, c, close)
  2578.         end
  2579.       end
  2580.       if descline = '' then
  2581.         descline = EchoName
  2582.       file = LINEOUT(sqafixwrk, 'EchoArea 'LEFT(EchoName, 16)' 'class'   "'descline'"')
  2583. say EchoName'---'descline
  2584.     end
  2585.     else
  2586.     /* Change class*/
  2587.     if WORD(line, 1) = ';START' then
  2588.       class = WORD(line, 2)
  2589.   end
  2590.   file = STREAM(squishcfg, c, close)
  2591. end
  2592. sqacfg = Drive'\'SqPath'\'SqFixFile
  2593. do until LINES(sqacfg) = 0
  2594.   line = linein(sqacfg)
  2595.   /* Ignore previous definitions*/
  2596.   if TRANSLATE(WORD(line, 1)) <> 'ECHOAREA' then
  2597.     file = LINEOUT(sqafixwrk, line)
  2598. end
  2599. file = STREAM(sqacfg, c, close)
  2600. file = STREAM(sqafixwrk, c, close)
  2601. perp = LASTPOS('\', sqacfg)
  2602. if perp > 0 then
  2603.   'copy 'sqafixwrk' 'DELSTR(sqacfg, perp)
  2604. else
  2605.   'copy 'sqafixwrk' 'sqacfg
  2606. 'erase 'sqafixwrk' /n'
  2607. return
  2608.  
  2609. Prettyfl:
  2610.  
  2611. if debug then say 'Prettyfl ------>'
  2612. /* Use the filearea.ctl from max to determine the file areas available*/
  2613. Files.0 = 0
  2614. Call GetFileAreas
  2615.  
  2616. /* Files exist - Sort Them*/
  2617. if List.0 > 0 then do
  2618.   wordptr = 2
  2619.   Call SortList
  2620.   do i = 0 to List.0
  2621.     Files.i = List.i
  2622.   end
  2623.   Drop(List.)
  2624.   /* Process each Files.bbs file area*/  
  2625.   do i = 1 to Files.0
  2626.     if isthere(Files.i) then do
  2627.       List.0 = 0
  2628.       inx = 0
  2629.       filesbbs = Files.i
  2630.       line = LINEIN(filesbbs)
  2631.       headercnt = 0
  2632.  
  2633.       /* Get all files listed into an array*/
  2634.       do until LINES(filesbbs) = 0
  2635.         /* Remove Tabs*/
  2636.         tabpos = POS(tab, line)
  2637.         do while tabpos > 0
  2638.           line = OVERLAY(' ', line, tabpos)
  2639.           tabpos = POS(tab, line)
  2640.         end
  2641.         firstword = WORD(line, 1)
  2642.         /* Is this line a File Line*/
  2643.         if firstword  <> '*' & POS('.',firstword) > 0 & POS(firstword, line) = 1 then do
  2644.           inx = inx + 1
  2645.           List.inx = firstword
  2646.         end
  2647.         else
  2648.           if inx = 0 then
  2649.             /* Remember the header*/
  2650.             headercnt = headercnt + 1
  2651.         line = LINEIN(filesbbs)
  2652.       end
  2653.       List.0 = inx
  2654.       /* Sort Names of Files.bbs*/
  2655.       if List.0 > 0 then do
  2656.         wordptr = 1
  2657.         Call SortList
  2658.         do j = 0 to List.0
  2659.           FileName.j = List.j
  2660.         end
  2661.         Drop(List.)
  2662.         /* We should be sorted - Now Build new Files.bbs*/
  2663.         /* Get rid of the temporary work file*/
  2664.         if isthere(workbbs) then
  2665.           'ERASE 'workbbs' /n'
  2666.         /* Starting with the Header*/
  2667.         if headercnt > 0 then do
  2668.           do j = 1 to headercnt
  2669.             line = LINEIN(filesbbs)
  2670.             file = LINEOUT(workbbs)
  2671.           end
  2672.         end
  2673.         firstname = ''
  2674.         do j = 1 to FileName.0
  2675.           line = LINEIN(filesbbs)
  2676.           file = LINEOUT(filesbbs)
  2677.           if firstname <> FileName.j then do
  2678.             firstname = FileName.j
  2679.             line = LINEIN(filesbbs)
  2680.             do while POS(firstname, line) <> 1 & LINES(filesbbs) <> 0
  2681.               /* Find the file description lines*/
  2682.               line = LINEIN(filesbbs)
  2683.             end
  2684.             descnt = 0
  2685.             if LINES(filesbbs) <> 0 then
  2686.               descnt = WORDS(line) - 1
  2687.             /* Description is available*/
  2688.             if descnt > 0 then do
  2689.               descline = SUBWORD(line, 2, descnt)
  2690.               /* If the length is this then merge last word*/
  2691.               catlen = 61
  2692.               newfile = 0
  2693.               do until LINES(filesbbs) = 0 | newfile = 1
  2694.                 /* Is this line a File Line*/
  2695.                 /* Build Description String*/
  2696.                 lenstr = LENGTH(line)
  2697.                 line = LINEIN(filesbbs)
  2698.                 if LINES(filesbbs) <> 0 then do
  2699.                   firstword = WORD(line, 1)
  2700.                   if POS('.',firstword) = 0 | POS(firstword, line) <> 1 then do
  2701.                     /* Get how many words in the description*/
  2702.                     descnt = WORDS(line)
  2703.                     if lenstr >= catlen then
  2704.                       descline = descline||STRIP(TRANSLATE(SUBWORD(line, 1, descnt),' ','    '))
  2705.                     else
  2706.                       descline = descline' 'STRIP(TRANSLATE(SUBWORD(line, 1, descnt),' ','    '))
  2707.                     catlen = 84
  2708.                   end
  2709.                   else
  2710.                     newfile = 1
  2711.                 end
  2712.               end
  2713.             end
  2714.             else
  2715.               descline = 'No Description...'
  2716.             file = LINEOUT(filesbbs)
  2717.             /* Now for the files lines*/
  2718.             if LENGTH(descline) > 46 then do
  2719.               xline = LEFT(FileName.j, 12)
  2720.               inx = 1
  2721.               wordtext = STRIP(WORD(descline, inx))
  2722.               lentext = 60
  2723.               /* Strip off the words until no more left*/
  2724.               do while wordtext <> ''
  2725.                 wordlen = LENGTH(wordtext) + 1
  2726.                 if LENGTH(xline) + wordlen > lentext then do
  2727.                   file = LINEOUT(workbbs, xline)
  2728.                   lentext = 78
  2729.                   xline = LEFT(' ',20)
  2730.                 end
  2731.                 xline = xline' 'wordtext
  2732.                 inx = inx + 1
  2733.                 wordtext = STRIP(WORD(descline, inx))
  2734.               end
  2735.               if LENGTH(xline) > 12 then
  2736.                 file = LINEOUT(workbbs, xline)
  2737.             end
  2738.             else do
  2739.               file = LINEOUT(workbbs, LEFT(FileName.j, 13)||descline)
  2740.             end
  2741.           end
  2742.           line = LINEIN(filesbbs)
  2743.         end
  2744.         Drop(FileName.)
  2745.       end
  2746.       subdir = FILESPEC('DRIVE',filesbbs)||FILESPEC('PATH',filesbbs)
  2747.       if isthere(subdir'files.bak') then
  2748.         'ERASE 'subdir'files.bak /n'
  2749.       file = LINEOUT(filesbbs)
  2750.       'RENAME 'subdir'files.bbs files.bak'
  2751.       line = LINEOUT(workbbs)
  2752.       'COPY 'workbbs' 'subdir'files.bbs'
  2753.       'ERASE 'workbbs' /n'
  2754.     end
  2755.   end
  2756.   Drop(Files.)
  2757. end
  2758. Drop(List.)
  2759. return
  2760. SortList:
  2761. inx = List.0
  2762. split = TRUNC(inx / 2)
  2763. do while split > 0
  2764.   a = inx - split
  2765.   b = 1
  2766.   do while a >= b
  2767.     lptr = b
  2768.     do while lptr > 0
  2769.       hptr = lptr + split
  2770.       if WORD(List.lptr,wordptr) > WORD(List.hptr,wordptr) then do
  2771.         /* use xx as this variable is near top of stack (push pull too messy)*/
  2772.         xx = List.lptr
  2773.         List.lptr = List.hptr
  2774.         List.hptr = xx
  2775.         lptr = lptr - split
  2776.       end
  2777.       else
  2778.         lptr = 0
  2779.     end
  2780.     b = b + 1
  2781.   end
  2782.   split = TRUNC(split / 2)
  2783. end
  2784. List.0 = inx
  2785. return
  2786.  
  2787. /* Check that a node is not crashed then set to crash*/
  2788. POLLCRASH:
  2789.  
  2790. /* extract zone:net/sysid*/
  2791. xx = POS(':', node)
  2792. if xx > 0 then
  2793.   zone  = DELSTR(node, xx)
  2794. else
  2795.   zone = zonedef
  2796. yy    = POS('/', node)
  2797. if yy > 0 then do
  2798.   netid = SUBSTR(DELSTR(node, yy), xx + 1)
  2799.   sysid = SUBSTR(node, yy + 1)
  2800. end
  2801. else do
  2802.   netid = netdef
  2803.   sysid = node
  2804. end
  2805. outbound = ''
  2806. do i = 1 to net
  2807.   if zone = zone.i then do
  2808.     /* outbound for 40:6496/0 would be D:\IBMNET.028*/
  2809.     outbound = outbound.i'.'D2X(zone,3)
  2810.   end
  2811. end
  2812. if outbound = '' then do
  2813.   say 'Zone 'zone' is not in Squish.cfg'
  2814.   signal EXIT
  2815. end
  2816. /* Bink packets are 19600000.xLO*/
  2817. pollid = D2X(netid, 4)||D2X(sysid, 4)
  2818.  
  2819. LineMsg = TIME('N')' - node - 'node' -> Set to Crash...'
  2820. Call DispLine port
  2821.  
  2822. /* Check if a file is there to go out*/
  2823. /* Change to the directory*/
  2824. FILESPEC('DRIVE', outbound)
  2825. perp = POS('\',outbound)
  2826. if perp = 0 then do
  2827.   outbound = '\'outbound
  2828.   perp = 1
  2829. end
  2830. 'cd'SUBSTR(outbound, perp)
  2831. /* See if any files are ready to go out*/
  2832. 'dir /f 'pollid'.h* > poll.txt'
  2833. if isthere('poll.txt') then do
  2834.   /* Setup for transmission*/
  2835.   'rename 'pollid'.h* 'pollid'.c*'
  2836.   'erase poll.txt /n'
  2837. end
  2838. else do
  2839.   Drive
  2840.   'cd\'SqPath
  2841.   'squishp poll 'node' crash'
  2842. end
  2843. return
  2844.  
  2845. /* Poll a file from a node */
  2846. PollFile:
  2847.  
  2848. if debug then say 'PollFile ------>'
  2849. LineMsg = TIME('N')'Getting file 'rest' from node - 'node'...'
  2850. Call DispLine port
  2851.  
  2852. Drive
  2853. 'cd\'SqPath
  2854. 'squishp get 'rest' from 'node' crash'
  2855. return
  2856.  
  2857.  
  2858. /* Select Window of line to be displayed*/
  2859. DispLine:
  2860.   linex = ARG(1)
  2861.  
  2862. /* If this is the first time the line is used then create the window*/
  2863. if win.linex = 'WIN.'linex then
  2864.   Call createwindow
  2865. xx = RXQUEUE("Set", win.linex)
  2866. queue LineMsg
  2867. xx = RXQUEUE("Set", xx)
  2868. file = LINEOUT(logfile, LineMsg)
  2869. file = LINEOUT(logfile)
  2870. return
  2871.  
  2872. createwindow:
  2873.  
  2874.   win.linex = 'WIN'linex
  2875.   w = RXQUEUE('Create',win.linex)
  2876.   /* if queue is there then ignore*/
  2877.   if w <> win.linex then
  2878.     w = RXQUEUE("Delete",w)
  2879.   Drive
  2880.   'cd\'CmdPath
  2881.   /* Our new command file will be created - linex = 1 - z*/
  2882.   comwin = Drive'\'CmdPath'\win'linex'.cmd'
  2883.   if isthere(comwin) then
  2884.     'erase 'comwin' /n'
  2885.   /* Now get the standard file and create a command file*/
  2886.   do until LINES(window) = 0
  2887.     xx = LINEIN(window)
  2888.     yy = POS(' winx ', xx)
  2889.     if yy > 0 then
  2890.       xx = OVERLAY(' win'linex, xx, yy, 5)
  2891.     file = LINEOUT(comwin, xx)
  2892.   end
  2893.   file = STREAM(comwin, c, close)
  2894.   file = STREAM(window, c, close)
  2895.  
  2896.   /* And start up the command file that was created*/
  2897.   /* It will suck in the queue lines and display them*/
  2898.   'start /win win'linex'.cmd'
  2899.   Call syssleep 5
  2900.   wincnt = wincnt + 1
  2901.   winqueue.wincnt = win.linex
  2902.   xx = RXQUEUE("Set", win.linex)
  2903.   queue 'Date - 'DATE()'  Time - 'TIME()
  2904.   xx = RXQUEUE("Set", xx)
  2905. return
  2906.  
  2907. /* Setup Variables*/
  2908. SetVar:
  2909. /* Setup Log Windows*/
  2910. /* The count wil increase as lines are added*/
  2911. /* This is the standard window command file which is used*/
  2912. /* Queues are created as needed from win1 - winz (4 length only)*/
  2913. /* If you have more then 128 lines then your outa luck*/
  2914. wincnt = 0
  2915.  
  2916. /* Temporary storage fast access variable(top of variable stack)*/
  2917. xx  = 0
  2918. No  = 0
  2919. Yes = 1
  2920. c = 'C'
  2921. close = 'CLOSE'
  2922.  
  2923. /* Files received without tic*/
  2924. filetrap = 0
  2925. actntrap = 0
  2926. AliasMsg = 0
  2927. IgnoreMsg = 0
  2928. NodeMsg = 0
  2929. AliasFle = 0
  2930. IgnoreFle = 0
  2931. NodeFle = 0
  2932. /* Set for unknown file areas*/
  2933. Area.0 = 0
  2934.  
  2935.  
  2936. /* Flag to run FBP*/
  2937. dofilepost = No
  2938. errorcnt    = 10 /* Ten and goodbye olay!*/
  2939. maxchrs = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0'
  2940. debug = 0
  2941.  
  2942. /* Environment Definition*/
  2943. defile = 'control.cfg'
  2944.  
  2945. /* Default Values*/
  2946. zonedef    =  1
  2947. netdef     =  999
  2948. Drive      =  'C:'
  2949. Mail       =  'C:'
  2950. Files      =  'C:'
  2951. Messages   =  'C:'
  2952. Log        =  'C:'
  2953. Nodelist   =  'C:'
  2954.  
  2955. SquishFile =  'squish.cfg'
  2956. FreqFile   =  'freq.req'
  2957. SqFixFile  =  'sqafix.cfg'
  2958.  
  2959. keepfiles  = '.DAT.BBS.DMP.IDX' 
  2960. deletesize = 7000000
  2961. FreeSpace  = 1
  2962. TossSpace  = 600000
  2963. TossDelsz  = 300000
  2964. AgeMsg     = 7
  2965.  
  2966. do until LINES(defile) = 0
  2967.   line = LINEIN(defile)
  2968.   var = WORD(line, 1)
  2969.   if LENGTH(var) > 1 then do
  2970.     var = TRANSLATE(var)
  2971.     value = TRANSLATE(WORD(line, 2))
  2972.     select
  2973.     when var = 'DRIVE'    then Drive    = value
  2974.     when var = 'MAIL'     then Mail     = value
  2975.     when var = 'FILES'    then Files    = value
  2976.     when var = 'MESSAGES' then Messages = value
  2977.     when var = 'LOG'      then Log      = value
  2978.     when var = 'NODELIST' then Nodelist = value
  2979.     when var = 'INMAIL'   then InMail   = value
  2980.     when var = 'SQPATH'   then SqPath   = value
  2981.     when var = 'CMDPATH'  then CmdPath  = value
  2982.     when var = 'FILEPATH' then Filepath = value
  2983.     when var = 'ULOADPATH' then UloadPath = value
  2984.     when var = 'FREQPATH' then FreqPath = value
  2985.     when var = 'MESSPATH' then Messpath = value
  2986.     when var = 'LOGPATH'  then Logpath  = value
  2987.     when var = 'MAXPATH'  then MaxPath  = value
  2988.     when var = 'DESKPATH' then DeskPath = value
  2989.     when var = 'TEMPPATH' then TempPath = value
  2990.     when var = 'NODELISTPATH' then Nodelistpath = value
  2991.     when var = 'TICKPATH'   then TickPath   = value
  2992.     when var = 'AGEMSG'     then AgeMsg     = value
  2993.     when var = 'MSGWAIT'    then MsgWait    = value
  2994.     when var = 'SQUISHFILE' then SquishFile = value
  2995.     when var = 'FREQFILE'   then FreqFile   = value
  2996.     when var = 'SQFIXFILE'  then SqFixFile  = value
  2997.     when var = 'TRIMLIKE'   then TrimLike   = value
  2998.     when var = 'SQPACKFILE' then SqPackFile = value
  2999.     when var = 'SQUISHWRK'  then SquishWrk  = value
  3000.     when var = 'TEMPMAXM'   then TempMaxM   = value
  3001.     when var = 'TEMPMAXF'   then TempMaxF   = value
  3002.     when var = 'TEMPTIC'    then TempTic    = value
  3003.     when var = 'FANAREA'    then FanArea    = value
  3004.     when var = 'MSGAREA'    then MsgArea    = value
  3005.     when var = 'REQAREA'    then ReqArea    = value
  3006.     when var = 'FANTMP'     then FanTmp     = value
  3007.     when var = 'MSGTMP'     then MsgTmp     = value
  3008.     when var = 'REQTMP'     then ReqTmp     = value
  3009.     when var = 'FANBASE'    then FanBase    = value
  3010.     when var = 'MSGBASE'    then MsgBase    = value
  3011.     when var = 'AVAIL'      then Avail      = value
  3012.     when var = 'FBPREQ'     then FBPReq     = value
  3013.     when var = 'ERRORFILE'  then errorfile  = value
  3014.     when var = 'LOGFILE'    then logfile   = value
  3015.     when var = 'NODEPROCESSOR' then nodeprocessor = value
  3016.     when var = 'KEEPFILES'  then keepfiles  = value
  3017.     when var = 'DELETESIZE' then deletesize = value
  3018.     when var = 'FREESPACE'  then FreeSpace  = value
  3019.     when var = 'TOSSSPACE'  then TossSpace  = value
  3020.     when var = 'TOSSDELSZ'  then TossDelsz  = value
  3021.     when var = 'ZONEDEF'    then zonedef    = value
  3022.     when var = 'NETDEF'     then netdef     = value
  3023.     when var = 'BBSNAME'    then bbsName    = SUBWORD(line, 2)
  3024.     when var = 'INDENT'     then indent     = STRIP(SUBWORD(line, 2),, "'")
  3025.     when var = 'TYPE'       then Type       = STRIP(SUBWORD(line, 2),, "'")
  3026.     when var = 'PUBLIC'     then Public     = STRIP(SUBWORD(line, 2),, "'")
  3027.     when var = 'ENDAREA'    then EndArea    = SUBWORD(line, 2)
  3028.     when var = 'OUTBOUND'   then Outbound   = value
  3029.  
  3030.     when var = 'MSGALIAS'   then do
  3031.       AliasMsg = AliasMsg + 1
  3032.       MsgAlias.AliasMsg = value
  3033.     end
  3034.  
  3035.     when var = 'MSGIGNORE'   then do
  3036.       IgnoreMsg = IgnoreMsg + 1
  3037.       MsgIgnore.IgnoreMsg = value
  3038.     end
  3039.  
  3040.     when var = 'MSGNODE'   then do
  3041.       NodeMsg = NodeMsg + 1
  3042.       MsgNode.NodeMsg = value
  3043.       MsgPass.NodeMsg = WORD(line, 3)
  3044.       MsgClas.NodeMsg = WORD(line, 4)
  3045.     end
  3046.  
  3047.     when var = 'FLEALIAS'   then do
  3048.       AliasFle = AliasFle + 1
  3049.       FleAlias.AliasFle = value
  3050.     end
  3051.  
  3052.     when var = 'FLEIGNORE'   then do
  3053.       IgnoreFle = IgnoreFle + 1
  3054.       FleIgnore.IgnoreFle = value
  3055.     end
  3056.  
  3057.     when var = 'FLENODE'   then do
  3058.       NodeFle = NodeFle + 1
  3059.       FleNode.NodeFle = value
  3060.       FlePass.NodeFle = WORD(line, 3)
  3061.       FleClas.NodeFle = WORD(line, 4)
  3062.     end
  3063.  
  3064.     when var = 'TRAPFILE'   then do
  3065.       filetrap = filetrap + 1
  3066.       trapfile.filetrap = value
  3067.       trapactn.filetrap = ''
  3068.     end
  3069.     when var = 'TRAPACTN'   then do
  3070.       actntrap = actntrap + 1
  3071.       trapactn.actntrap = SUBWORD(line, 2)
  3072.     end
  3073.     otherwise
  3074.     end
  3075.   end
  3076. end
  3077. file = STREAM(defile, c, close)
  3078.  
  3079. SquishTmp   =  Drive'\'TempPath'\'SquishFile
  3080. sqafixwrk   =  Drive'\'TempPath'\'SqFixFile
  3081. FreqFile    = Drive'\'SqPath'\'FreqFile
  3082. SquishWrk   = Drive'\'TempPath'\'SquishWrk
  3083. FreqWork    = Drive'\'TempPath'\'FreqFile
  3084. FanTmp      = Drive'\'TempPath'\'FanTmp
  3085. MsgTmp      = Drive'\'TempPath'\'MsgTmp
  3086. TempMaxW    = Drive'\'TempPath'\'TempMaxM
  3087. TempMaxM    = Drive'\'DeskPath'\'TempMaxM
  3088. TempMaxF    = Drive'\'DeskPath'\'TempMaxF
  3089. TempTic     = Drive'\'DeskPath'\'TempTic
  3090. FanArea     = Drive'\'DeskPath'\'FanArea
  3091. MsgArea     = Drive'\'DeskPath'\'MsgArea
  3092. Uload       = Files'\'FilePath'\'Uloadpath
  3093. TicWork     = Drive'\'TempPath
  3094. filesbbs    = Drive'\'MaxPath'\filearea.ctl'
  3095. workbbs     = Drive'\'TempPath'\files.bbs'
  3096. logfile     = Log'\'Logpath'\'logfile
  3097. /* Where the squish.cfg file is located*/
  3098. squishcfg   = Drive'\'SqPath'\'SquishFile
  3099. /* Get the Tick Config File Name*/
  3100. tickcfg = Drive'\'TickPath'\tic.cfg'
  3101.  
  3102.  
  3103. /* Error Recording*/
  3104. errorfile   = Drive'\'DeskPath'\'errorfile
  3105.  
  3106. clen = 4 /* To check Revs make this 3 or 4 - it just lists without deleteing*/
  3107. window = Drive'\'CmdPath'\win.cmd'
  3108.  
  3109. /* Character to divide zone for net determination*/
  3110. semicolon = ':'
  3111.  
  3112. /* Setup system functions*/
  3113. Call RxFuncAdd 'SysSleep','RexxUtil','SysSleep'
  3114. Call RxFuncAdd 'SysFileTree','RexxUtil','SysFileTree'
  3115. Call RxFuncAdd 'SysFileSearch','RexxUtil','SysFileSearch'
  3116. Call RxFuncAdd 'SysDriveInfo','RexxUtil','SysDriveInfo'
  3117. Outbound = Mail'\'Outbound
  3118.  
  3119. /* A list of nets that this Mailer belongs*/
  3120. net = 0
  3121.  
  3122. LF   = X2C('0D')
  3123. SOH  = X2C('01')
  3124. NULL = X2C('00')
  3125. line = ''
  3126. keyorig  = ';ORIGIN' /* Precedes Address for each net as [Fido F F] to Max access level*/
  3127. keyaddr  = 'ADDRESS'
  3128. keybad   = 'BADAREA'
  3129. origdesc = 'Origin'
  3130. accessde = 'Normal'
  3131. if isthere(logfile) = 0 then do
  3132.   say "First time use - removing Tab's from .cfg, .ctl, .bbs files"
  3133.   say 'as rexx does not like these little puppies in the lines...'
  3134.   say 'Press enter to continue ->'
  3135.   pull xxx
  3136.   tab = '    '
  3137.   if isthere(SquishTmp) then
  3138.     'erase 'SquishTmp' /n'
  3139.   do i = 1 to 5
  3140.     select
  3141.       when i = 1 then
  3142.         tabfile = filesbbs /* filearea.ctl*/
  3143.       when i = 2 then
  3144.         tabfile = Drive'\'MaxPath'\msgarea.ctl'
  3145.       when i = 3 then
  3146.         tabfile = tickcfg
  3147.       when i = 4 then
  3148.         tabfile = squishcfg
  3149.       when i = 5 then
  3150.         tabfile = Drive'\'SqPath'\'sqafix.cfg
  3151.       otherwise
  3152.     end
  3153.     if isthere(tabfile) then do
  3154.       say 'Removing tabs from 'tabfile' file...'
  3155.       do until LINES(tabfile) = 0
  3156.         line = LINEIN(tabfile)
  3157.         tabpos = POS(tab, line)
  3158.         do while tabpos > 0
  3159.           line = OVERLAY(' ', line, tabpos)
  3160.           tabpos = POS(tab, line)
  3161.         end
  3162.         file = LINEOUT(SquishTmp, line)
  3163.       end
  3164.       file = LINEOUT(SquishTmp)
  3165.       file = LINEOUT(tabfile)
  3166.       FileName = FILESPEC('NAME', tabfile)
  3167.       FileBack = Drive'\'TempPath'\'DELSTR(FileName, POS('.', FileName))'.bak'
  3168.       'copy 'tabfile' 'FileBack
  3169.       'copy 'SquishTmp' 'tabfile
  3170.       'erase 'SquishTmp' /n'
  3171.     end
  3172.     else do
  3173.       say 'Missing or Bad path to 'tabfile
  3174.       signal exit
  3175.     end
  3176.   end
  3177. end
  3178.  
  3179. return
  3180.  
  3181. /* Set up net variables*/
  3182. SetSys:
  3183. do until LINES(squishcfg) = 0
  3184.   preline = line
  3185.   line = LINEIN(squishcfg)
  3186.   name = TRANSLATE(WORD(line, 1))
  3187.   /* Look for the Address keyword*/
  3188.   if name = keyaddr && POS(keyaddr, line) = 1 then do
  3189.     /* format [line] Address [Address]*/
  3190.     address = WORD(line, 2)
  3191.     if net = 0 then do
  3192.       net = net + 1
  3193.       net.net  = '-P'address
  3194.       semip = POS(':',address)
  3195.       if semip > 0 then
  3196.         zone.net = DELSTR(address, semip)
  3197.       else
  3198.         zone.net = zonedef
  3199.       /* Add origin and access*/
  3200.       NewZone = Yes
  3201.     end
  3202.     else do
  3203.       /* Check if we have this zone covered*/
  3204.       NewZone = Yes
  3205.       semip = POS(':',address)
  3206.       if semip > 0 then
  3207.         zone = DELSTR(address, semip)
  3208.       else
  3209.         zone.net = zonedef
  3210.       do j = 1 to net
  3211.         if zone.j = zone then
  3212.           NewZone = No
  3213.       end
  3214.       /* Add in the new zone*/
  3215.       if NewZone then do
  3216.         net = net + 1
  3217.         net.net  = '-P'address
  3218.         zone.net = zone
  3219.       end
  3220.     end
  3221.     if NewZone then do
  3222.       if TRANSLATE(WORD(preline, 1)) = keyorig then do
  3223.         origin.net = origdesc'  'net-1'     'SUBWORD(preline, 2, 2)
  3224.         access.net = accessde'/'WORD(preline, 4)
  3225.       end
  3226.       else do
  3227.         /* Default if the comment line [;Origin Fido F F ] does not exist*/
  3228.         origin.net = origdesc'  'net-1'     Fido F'
  3229.         access.net = accessde'/F'
  3230.       end
  3231.     end
  3232.   end
  3233.   else do
  3234.     /* Look for Bad Message Area*/
  3235.     if name = keybad && POS(keybad, line) = 1 then do
  3236.       BadArea = TRANSLATE(WORD(line, 3))
  3237.       say 'Bad Areas for new message bases = 'BadArea
  3238.     end
  3239.   end
  3240. end
  3241. file = STREAM(squishcfg, c, close)
  3242. /* Find the Outbound Areas*/
  3243. Call SysFileSearch 'Outbound', squishcfg, 'List.', 'N'
  3244.  
  3245. /* The first outbound is always declared*/
  3246. outbound.1 = WORD(List.1, 3)
  3247. if net > 1 then do
  3248.   do i = 2 to List.0
  3249.     zone = WORD(List.i, 4)
  3250.  
  3251.     /* Match zones*/
  3252.     do j = 2 to net until zone.j = zone
  3253.       if zone.j = zone then
  3254.         /* Extract the outbound directory*/
  3255.         outbound.j = WORD(List.i, 3)
  3256.     end
  3257.   end
  3258. end
  3259. Drop(List.)
  3260. do i = 1 to net
  3261.   say 'Zone   = 'zone.i' ID = 'net.i' Outbound = 'outbound.i
  3262.   say 'Origin = 'origin.i' Access = 'access.i
  3263. end
  3264.  
  3265. /* We now have net - net.net for our address as -pxx:yyy/z - zone.net - outbound.net*/
  3266. return
  3267.  
  3268. /* Queue setup*/
  3269. SetQueue:
  3270. /* Go reclaim Host Queue*/
  3271. CntlQueue = 'Cntl'
  3272. CntlQueue = RXQUEUE("Create",CntlQueue)
  3273.  
  3274. /* REXX will name queue to another name - otherwise it exists*/
  3275. if CntlQueue <> 'Cntl' then do
  3276.   /* Queue already exists - send restart command*/
  3277.   /* Point to live queue */
  3278.   oq = RXQUEUE('Set', 'Cntl')
  3279.  
  3280.   /* Check that it is still alive*/
  3281.   QUEUE 'HELLO 'CntlQueue
  3282.  
  3283.   /* and pull acknowledgement*/
  3284.   xx = RXQUEUE('Set',CntlQueue)
  3285.   ACK = ''
  3286.  
  3287.   /* Wait for an hour to ack*/
  3288.   do i = 1 to 12 until ACK <> ''
  3289.     if QUEUED() > 0 then
  3290.       PULL ACK
  3291.     Call syssleep 3
  3292.   end
  3293.  
  3294.   if ACK = 'OK' then do
  3295.     signal END
  3296.   end
  3297.   else do
  3298.     CntlQueue = 'Cntl'
  3299.     oq = RXQUEUE('Set',CntlQueue)
  3300.   end
  3301. end
  3302.  
  3303. return
  3304.  
  3305. /* Cleanup Flags and Mail*/
  3306. SetMail:
  3307.   Call SysFileTree Mail'\*.bsy', 'List', 'SFO'
  3308.   /* Files exist - Process them*/
  3309.   Do i = 1 to List.0
  3310.     'erase 'List.i' /n'
  3311.   end
  3312.   Drop(List.)
  3313.  
  3314.   /* Check for unfinished mail*/
  3315.   Call SysFileTree Drive'\'SqPath'\*.pkt', 'List', 'SFO'
  3316.   /* Files exist - Process them*/
  3317.   if List.0 > 0 then do
  3318.   /*Rem If Mail Toss It.*/
  3319.     /* But first check if there is free space*/
  3320.     tempfree = FreeSpace
  3321.     FreeSpace = TossSpace
  3322.     Call ChkFree
  3323.     if FreeLeft >= FreeSpace then do
  3324.       Drive
  3325.       'cd\'SqPath
  3326.       'squishp in out squash link'
  3327.     end
  3328.     FreeSpace = tempfree
  3329.   end
  3330.   Drop(List.)
  3331. return
  3332.  
  3333. /* Called when a cmd function does not complete successfully*/
  3334. RECSCREEN:
  3335.  
  3336. /* Ten changes to get it right then we are outa here*/
  3337. errorcnt = errorcnt - 1
  3338. if errorcnt <= 0 then
  3339.   signal exit
  3340. /* Read the screen with the error on it*/
  3341.  
  3342. Call RxFuncAdd 'SysTextScreenRead','RexxUtil','SysTextScreenRead'
  3343. do iii = 1 to 24 /* Change for a larger screen*/
  3344.   line = SysTextScreenRead(iii,0,80)
  3345.   file = LINEOUT(errorfile, line)
  3346. end
  3347. /* The close*/
  3348. file = STREAM(errorfile, c, close)
  3349. Call RxFuncDrop 'SysTextScreenRead'
  3350. say 'This cat has 'errorcnt' lives!'
  3351. /* next time we will catch it*/
  3352. return
  3353.