home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / bbs / mfix430.zip / MAILFIX.BAS < prev    next >
BASIC Source File  |  1994-01-24  |  58KB  |  1,463 lines
  1. ' MAILFIX.BAS
  2.  
  3. ' ***************************************************
  4. ' *  MESSAGE REPAIR/PURGE UTILITY FOR MAIL MANAGER  *
  5. ' *  Copyright (C) 1991-94 Makai Software           *
  6. ' ***************************************************
  7. '
  8. ' -----------------------------------------------------------------------
  9. ' LICENSE AGREEMENT:
  10. '
  11. ' You are free to modify, recompile, and run this code for your own use.
  12. ' If you use portions of it for a utility of your own design, you may do
  13. ' so, provided that your program is distributed free of charge, and that
  14. ' credit is given in your documentation for the portions of our code you
  15. ' have used.
  16. '
  17. ' To use portions of this code "for profit" requires that you contact
  18. ' us for further arrangements.  We can be reached at:
  19. '
  20. '                           Makai Software
  21. '                           870 Golden Drive
  22. '                           Newark, OH 43055
  23. '
  24. ' Submissions to re-release MailFix with your modifications installed
  25. ' are MORE THAN WELCOME.  We will continue to release updates to MailFix
  26. ' as a free program, and will be more than happy to give you credit for
  27. ' your enhancements if your changes make it into a future MailFix release.
  28. ' -----------------------------------------------------------------------
  29. '
  30. ' Major rewrite to accomodate fixed-length message bases - 101a   9/24/91
  31. '                                         Version # only - 101b   9/29/91
  32. '                   Accomodate OverMail'ed message bases - 101c  10/02/91
  33. '                                         Version # only - 102a  10/05/91
  34. '                                         Version # only - 104   10/15/91
  35. '                                         Version # only - 110   11/19/91
  36. '                                         Version # only - 200    8/04/92
  37. '                                         Version # only - 300    1/02/93
  38. '            Slight modifications for distributed source - 301    2/14/93
  39. '                     Block read/write of message bodies - 301a   2/28/93
  40. ' Major rewrite: uses i/o buffer blocks, renumbers msgs,
  41. '                             sets user message pointers - 301b   3/04/93
  42. '                                 Misc bug fixes - 301c thru h    4/20/93
  43. '                                 Cleaned up for release - 400    4/28/93
  44. '       Extended from 999 to up to 2000 message capacity - 400a   6/21/93
  45. '   Added error checking to prevent lockup at msg # 2001 - 400b   6/22/93
  46. '                                            Released as - 401    7/14/93
  47. '                         Increased msg capacity to 5000 - 401a   8/04/93
  48. '                                          Minor bug fix - 401b   8/16/93
  49. '                                            Released as - 402    8/18/93
  50. '   Added /P command line to purge received private msgs - 410   12/04/93
  51. '                                            Released as - 430    1/24/94
  52. '-------------------------------------------------------------------------
  53. ' NOTE:
  54. '
  55. ' This program is written to use Crescent Software's PDQ library, and
  56. ' Microsoft's QuickBASIC v4.50 compiler.  Extensive recoding would be
  57. ' necessary to use this code in stock QuickBASIC.
  58. '
  59. ' PDQDECL.BAS is PDQ's function and subprogram declaration file.  PDQ on
  60. ' the link command line is PDQ.LIB.  The "_*.obj" files on the link command
  61. ' line are the PDQ stub files used when creating the executable.
  62. '
  63. ' Command lines used to compile/link:
  64. '
  65. ' bc mailfix /o;
  66. ' link mailfix+_noval+_noread+_noerror+_nofield+_str$/nod/noe,,nul,pdq
  67. '
  68. '-------------------------------------------------------------------------
  69.  
  70.  
  71. ' $INCLUDE: 'PDQDECL.BAS'
  72. '
  73. ' OutFile$ = "*.FIX"        (fixed *M.DEF after the mailfix run)
  74. ' Z$ = Original "*.DEF"     (the original *M.DEF file being read)
  75.  
  76. DECLARE FUNCTION PadOut$ (In1$, In2$)
  77. DECLARE SUB Rotate ()
  78. DECLARE SUB EndFix ()
  79. DECLARE SUB GETT (filenum%, a$, endfile%)  ' input buffer routine
  80. DECLARE SUB PUTT (filenum%, a$)            ' output buffer routine
  81. DECLARE SUB PRINTT (a$)                    ' use pdq direct screen print
  82. DECLARE SUB PRINTLF (a$)                   ' pdq direct screen print + crlf
  83. DECLARE SUB Scroll ()                      ' scroll screen
  84. DECLARE SUB skip ()                        ' skip blank screen line
  85. DECLARE SUB Finish ()
  86.  
  87. TYPE CheckPoint                            ' Messages file checkpoint record.
  88.   LastMess AS STRING * 8                   ' Highest message in this file.
  89.   AutoAdd AS INTEGER                       ' Security to auto-add conf user.
  90.   CallerNum AS STRING * 10                 ' Caller number.
  91.   Reserved1 AS STRING * 36                 ' 36 bytes of wasteland.
  92.   UsersUsed AS STRING * 5                  ' User records taken in user file.
  93.   Reserved2 AS STRING * 6                  ' 6 bytes of wasteland.
  94.   RecStart AS STRING * 7                   ' Record # of beginning of msgs.
  95.   NextAvail AS STRING * 7                  ' Next available message record #.
  96.   LastRec AS STRING * 7                    ' Last record # (physically).
  97.   MaxMess AS STRING * 7                    ' Max number of messages.
  98.   Reserved3 AS STRING * 31                 ' 31 more bytes of wasteland.
  99.   MaxCopies AS STRING * 2                  ' Total number of RBBS Nodes.
  100. END TYPE
  101.  
  102. TYPE NodeRec                            ' Messages file node record.
  103.   LastUser AS STRING * 31                  ' Last user on this copy of RBBS.
  104.   SysAvail AS INTEGER                      ' Sysop availability toggle.
  105.   SysAnnoy AS INTEGER                      ' Sysop annoy toggle.
  106.   SysNext AS INTEGER                       ' Sysop wants system next toggle.
  107.   LinePrint AS INTEGER                     ' Activity is being printed toggle.
  108.   DoorAvail AS INTEGER                     ' Are doors available?
  109.   EightBit AS INTEGER                      ' Possibly a flag for N,8,1?
  110.   Baud AS STRING * 2                       ' User's baudrate (packed)
  111.   Upper AS INTEGER                         ' Does user want all upper case?
  112.   NumBytes AS LONG                         ' Number of bytes downloaded.
  113.   BatchXfer AS STRING * 1                  ' Was last file Xfer a batch?
  114.   Graphics AS INTEGER                      ' User's graphics preference.
  115.   Sysop AS INTEGER                         ' Is user the sysop? (I think)
  116.   Active AS STRING * 1                     ' Is this node active or waiting?
  117.   Snoop AS INTEGER                         ' Sysop Snoop toggle.
  118.   BaudLock AS STRING * 5                   ' Is the baud rate locked?
  119.   TimeIn AS STRING * 3                     ' I don't know...
  120.   Reserved1 AS STRING * 4                  ' 4 bytes of wasteland.
  121.   PrivateDoor AS INTEGER                   ' Toggle for 'private door'
  122.   External AS STRING * 1                   ' Was last Xfer via external proto?
  123.   XferLetter AS STRING * 1                 ' Last Xfer protocal letter.
  124.   Reserved2 AS STRING * 1                  ' a single byte of nothing.
  125.   PackDate AS STRING * 2                   ' Packed date of logon.
  126.   Reserved3 AS STRING * 7                  ' 7 bytes of space.
  127.   LastDOS AS STRING * 5                    ' Last time dropped to dos.
  128.   Reliable AS INTEGER                      ' MNP flag.
  129.   City AS STRING * 24                      ' City/State of user.
  130.   SubIndex AS STRING * 2                   ' Dunno...
  131.   ProtoDate AS STRING * 6                  ' Dunno...
  132.   ProtoTime AS STRING * 4                  ' Dunno...
  133. END TYPE
  134.  
  135. TYPE MessHeader                          ' Individual message header.
  136.   Private AS STRING * 1                     ' * if private message.
  137.   MessNum AS STRING * 4                     ' Message number.       (Key field)
  138.   MessFrom AS STRING * 31                   ' Who's it from?
  139.   MessTo AS STRING * 22                     ' Who's it to?
  140.   TimeSent AS STRING * 8                    ' What time was it sent (Key field)
  141.   NumHeaders AS STRING * 1                  ' Number of msg headers
  142.   DateSent AS STRING * 8                    ' What date was it sent (Key field)
  143.   Subject AS STRING * 25                    ' Subject of message.
  144.   Password AS STRING * 15                   ' Message password (if any)
  145.   Killed AS STRING * 1                      ' Killed or active (226 or 225).
  146.   NumRecs AS STRING * 4                     ' Number of msg recs (incl Header).
  147.   SecLev AS INTEGER                         ' Security level of message itself.
  148.   LastDate AS STRING * 3                    ' Date msg last received (packed)
  149.   LastTime AS STRING * 3                    ' Time msg last received (packed)
  150. END TYPE
  151.  
  152. TYPE MessBody                            ' Main body of an RBBS message.
  153.   Text AS STRING * 128                      ' Pretty self-explanitory.
  154. END TYPE
  155.  
  156. TYPE RBBSUser                            ' User record in RBBS user file
  157.   Dummy1 AS STRING * 50
  158.   LastRead AS INTEGER
  159.   Dummy2 AS STRING * 76
  160. END TYPE
  161.  
  162.  
  163. ' ********************
  164. ' * SHARED TYPE VARS *
  165. ' ********************
  166.  
  167. COMMON SHARED CheckPoint AS CheckPoint, _
  168.               Node AS NodeRec, _
  169.               Header AS MessHeader, _
  170.               Body AS MessBody, _
  171.               User AS RBBSUser             ' User file record
  172.  
  173. COMMON SHARED ExitErr, _                   ' Dos Errorlevel on exit
  174.               Version$, _
  175.               Copyright$
  176.  
  177. DIM SHARED Registers AS RegType            ' Type for PDQ interrupt handling
  178.  
  179. DEFINT A-Z
  180.  
  181. TimeStart& = PDQTimer                      ' Save clock ticks to compute run
  182.                                            ' time
  183.  
  184. Version$ = "v4.30"                         ' Current version number.
  185. Copyright$ = "Copyright (C) 1991-94 Makai Software.  All rights reserved."
  186.  
  187. MsgLim = 1000                              ' Default value for size of message
  188.                                            ' base to handle (no. of msgs.)
  189.                                            ' 401b
  190.  
  191. IF RTRIM$(COMMAND$) = "" THEN EndFix  ' If nothing on command line, show usage.
  192.  
  193. Z$ = UCASE$(COMMAND$)                ' PDQ doesn't capitalize COMMAND$
  194.  
  195. '*********************************
  196. '* PARSE COMMANDLINE FOR OPTIONS *
  197. '*********************************
  198.  
  199.                                       'Check for Dos screen writes first so
  200.                                       'any messages will be sent via
  201.                                       'correct method
  202.  
  203. DosPrint = INSTR(Z$, "/D")                                   ' Check for /D
  204. IF DosPrint THEN                                             '  If found,
  205.                                                              '  adjust cmd line
  206.    Z$ = LTRIM$(LEFT$(Z$, DosPrint - 1) + MID$(Z$, DosPrint + 2))
  207.  
  208. END IF
  209.  
  210. CLS                                                          ' Show status info
  211. PRINTLF "MailFIX " + Version$ + " - " + Copyright$
  212. PRINTLF STRING$(79, 205)
  213. PRINTLF "Run date " + DATE$ + "  Run time " + TIME$
  214. PRINTLF "Command line options: " + COMMAND$
  215. skip
  216.  
  217. ViewFlag = INSTR(Z$, "/V")                                   ' Check for /V
  218. IF ViewFlag THEN
  219.    Z$ = LTRIM$(LEFT$(Z$, ViewFlag - 1) + MID$(Z$, ViewFlag + 2))
  220.    ViewFlag = -1
  221. END IF
  222.  
  223. RBBSFlag = INSTR(Z$, "/R")                                   ' Check for /R
  224. IF RBBSFlag THEN
  225.    Z$ = LTRIM$(LEFT$(Z$, RBBSFlag - 1) + MID$(Z$, RBBSFlag + 2))
  226.    RBBSFlag = -1
  227. END IF
  228.  
  229. OverMail = INSTR(Z$, "/O")                                   ' Check for /O
  230. IF OverMail THEN
  231.    IF RBBSFlag THEN
  232.       PRINTLF "Command line switches /R and /O cannot be used together."
  233.       ExitErr = 1
  234.       Finish
  235.    END IF
  236.    RBBSFlag = -1
  237.    Z$ = LTRIM$(LEFT$(Z$, OverMail - 1) + MID$(Z$, OverMail + 2))
  238. END IF
  239.  
  240. FixedLen = INSTR(Z$, "/F")                                   ' Check for /F
  241. IF FixedLen THEN
  242.    Z$ = LTRIM$(LEFT$(Z$, FixedLen - 1) + MID$(Z$, FixedLen + 2))
  243.    FixedLen = -1
  244. END IF
  245.  
  246. '     ------- /P command line added v4.10 ------
  247.  
  248. PurgePriv = INSTR(Z$, "/P")                                  ' Check for /P
  249. IF PurgePriv THEN
  250.    Z$ = LTRIM$(LEFT$(Z$, PurgePriv - 1) + MID$(Z$, PurgePriv + 2))
  251.    PurgePriv = -1
  252. END IF
  253.  
  254. '         ------- End v4.10 addition -------
  255.  
  256. SlashK = INSTR(Z$, "/K")                                     ' Is "/k" there?
  257. IF SlashK THEN
  258.    IF ViewFlag THEN
  259.       PRINTLF "Command line switches /V and /Knnn cannot be used together."
  260.       skip
  261.       ExitErr = 1: Finish
  262.    END IF
  263.  
  264.    ZZ$ = MID$(Z$, SlashK + 2)                  ' split cmd line after  /K
  265.    Z$ = LEFT$(Z$, SlashK - 1)                  ' split cmd line before /K
  266.  
  267.    Blank = INSTR(ZZ$, " ")
  268.    IF Blank THEN
  269.      keep = PDQValI(LEFT$(ZZ$, Blank - 1))
  270.      ZZ$ = MID$(ZZ$, Blank)
  271.    ELSE
  272.      keep = PDQValI(ZZ$)
  273.      ZZ$ = ""
  274.    END IF
  275.  
  276.    IF keep < 1 THEN
  277.      PRINTLF "Invalid number specified with /K option."
  278.      ExitErr = 1: Finish
  279.    END IF
  280.  
  281.    SlashK = -1
  282.    Z$ = LTRIM$(Z$ + ZZ$)
  283.    ZZ$ = ""
  284. END IF
  285.  
  286. Renum = INSTR(Z$, "/N")                                      ' Check for /N
  287. IF Renum THEN
  288.    IF ViewFlag THEN
  289.       PRINTLF "Command line switches /V and /N cannot be used together."
  290.       skip
  291.       ExitErr = 1: Finish
  292.    END IF
  293.    ZZ$ = MID$(Z$, Renum + 2)                    ' split cmd line following /N
  294.    Z$ = LEFT$(Z$, Renum - 1)                    ' split cmd line before /N
  295.  
  296.    IF MidChar(ZZ$, 1) <> 32 THEN                ' if first char after /N
  297.                                                 ' isn't a space, then a
  298.                                                 ' user file was specified
  299.  
  300.      Blank = INSTR(ZZ$, " ")                    ' find first blank
  301.      IF Blank THEN                              ' if there IS a blank
  302.        UserFile$ = LEFT$(ZZ$, Blank - 1)        '   split out user file name
  303.        ZZ$ = MID$(ZZ$, Blank)                   '   remove filename from ZZ$
  304.      ELSE                                       ' if no blank, end of cmd line
  305.        UserFile$ = ZZ$                          '   save as filename
  306.        ZZ$ = ""
  307.      END IF
  308.  
  309.      IF LEN(UserFile$) THEN UpdtU = -1          ' if a userfile, set flag
  310.  
  311.    END IF
  312.    Z$ = Z$ + ZZ$: ZZ$ = ""                      ' recombine adjusted cmd line
  313.    Renum = -1
  314. END IF
  315.  
  316. IF UpdtU THEN                                   ' If asked to update user file
  317.   IF NOT PDQExist(UserFile$) THEN               '   make sure we can find it
  318.      PRINTLF "Cannot find user file " + UserFile$ + "."
  319.      skip
  320.      ExitErr = 1: Finish
  321.   END IF
  322. END IF
  323.  
  324. Siz = INSTR(Z$, "/S")                                      ' Check for /S
  325. IF Siz THEN
  326.    ZZ$ = MID$(Z$, Siz + 2)                    ' split cmd line following /S
  327.    Z$ = LEFT$(Z$, Siz - 1)                    ' split cmd line before /S
  328.  
  329.    Blank = INSTR(ZZ$, " ")
  330.    IF Blank THEN
  331.      Siz = PDQValI(LEFT$(ZZ$, Blank - 1))
  332.      ZZ$ = MID$(ZZ$, Blank)
  333.    ELSE
  334.      Siz = PDQValI(ZZ$)
  335.      ZZ$ = ""
  336.    END IF
  337. END IF
  338.  
  339. Z$ = Z$ + ZZ$
  340.  
  341. IF Siz > 0 then MsgLim = Siz               ' MsgLim preset to default value
  342.                                            ' at beginning of program.  Reset
  343.                                            ' if have new value.  401b
  344.  
  345. REDIM SeekIndex&(MsgLim)                   ' Array for storing msg location
  346.                                            ' in .FIX file   400b
  347.  
  348.  
  349. '-------------- End of command line parsing ------------------------------
  350.  
  351. Z$ = LTRIM$(RTRIM$(Z$))                     ' At this point Z$ should be
  352.                                             ' just the message filename.
  353.  
  354. IF Z$ = "" THEN EndFix                      ' If no file name, show usage.
  355.  
  356. IF PDQExist(Z$) THEN                        ' If file exists
  357.   OPEN Z$ FOR BINARY SHARED AS #1           '   Open it
  358. ELSE                                        ' If couldn't open, exit.
  359.   PRINTLF "Couldn't find " + Z$
  360.   ExitErr = 1: Finish
  361. END IF
  362.  
  363. Z = INSTR(Z$, ".")                                  ' Find period in filename.
  364.  
  365. IF Z > 0 THEN                                       ' Set output file name.
  366.    OutFile$ = LEFT$(Z$, Z) + "FIX"                  ' (Always *.FIX).
  367. ELSE
  368.    OutFile$ = Z$ + ".FIX"
  369. END IF
  370.  
  371. Colon$ = ":"                                        ' 2nd separator in time fld
  372. IF RBBSFlag THEN Colon$ = "."                       ' period for RBBSMail
  373. IF OverMail THEN Colon$ = ";"                       ' semicolon for OverMail
  374. ColonFix$ = Colon$ + "00"                           ' For repair work only.
  375.  
  376. IF NOT ViewFlag THEN                                ' If we're not viewing,
  377.   IF PDQExist(OutFile$) THEN KILL OutFile$
  378.   OPEN OutFile$ FOR BINARY AS #2                    ' Open the output file.
  379.   IF ERR THEN PRINTLF "Error opening " + OutFile$: ExitErr = 1: Finish
  380. END IF
  381.  
  382. maxmem = 128 * 128                       ' Desired memory for input buffer
  383.                                          '    (64 recs @ 128 bytes each)
  384. IF maxmem > FRE(a$) - 10240 THEN _
  385.   maxmem = (FRE(a$) - 10240) \ 128 * 128 '   reduce to leave 10k memory
  386.  
  387. IF LOF(1) < maxmem THEN maxmem = LOF(1)  ' If input file shorter than buffer
  388.                                          ' then adjust buffer size
  389.  
  390. bufrecs = maxmem \ 128                   ' buffer length in 128-byte records
  391.  
  392. GettBlock$ = SPACE$(maxmem)              ' Define multi-record buffer block
  393. GET #1, , GettBlock$                     ' Input initial block
  394. GLoc = 1                                 ' Start at beginning of block
  395.  
  396. Block$ = SPACE$(128)                     ' Define block for checkpoint
  397. GETT 1, Block$, FileErr                  ' Get checkpoint record from buffer
  398. RecsRead& = 1&                           ' Update read counter
  399.  
  400.  
  401. LastSave$ = RTRIM$(MID$(Block$, 1, 8))       ' Save initial info for
  402. RecStart$ = RTRIM$(MID$(Block$, 68, 7))      ' later display.
  403. NextAvail$ = RTRIM$(MID$(Block$, 75, 7))
  404. LastRec$ = RTRIM$(MID$(Block$, 82, 7))
  405. MaxMess$ = RTRIM$(MID$(Block$, 89, 7))
  406. MaxCopies$ = RTRIM$(MID$(Block$, 127, 2))
  407.  
  408. MaxCopies = PDQValI(MaxCopies$)
  409.  
  410. IF FixedLen THEN                               ' If fixed-length,
  411.    TopMessage = PDQValI(LastSave$)             ' Save last message #,
  412.    MaxRecs& = PDQValL(LastRec$)                 ' and total # of records.
  413. END IF
  414.  
  415. IF NOT ViewFlag THEN                     ' If not "just lookin'"
  416.    PUTT 2, Block$                        '   write it to output buffer
  417.    RecsWrote& = 1&                       '   update counter of recs written
  418. END IF
  419.  
  420. PRINTLF "Press [Esc] to abort..."
  421. skip
  422.  
  423. Block$ = ""
  424. Block$ = SPACE$(128 * MaxCopies)         ' Redefine block for node records
  425. GETT 1, Block$, FileErr                  ' Read in as single block
  426. RecsRead& = RecsRead& + MaxCopies
  427.  
  428. IF NOT ViewFlag THEN
  429.    PUTT 2, Block$
  430.    RecsWrote& = RecsWrote& + MaxCopies
  431. END IF
  432.  
  433. ' ***********************************
  434. ' *  INDIVIDUAL MESSAGE PROCESSING  *
  435. ' ***********************************
  436. ' ----------------------------------------------------------------------------
  437.  
  438. MsgCount = 0
  439. MessNum$ = SPACE$(4)
  440.  
  441.  
  442. NextMess:                                               ' Branch here to keep
  443.                                                         ' stepping through msg
  444.                                                         ' file.
  445.   Headr$ = ""
  446.   Headr$ = SPACE$(128)                               'Define for header record
  447.  
  448.   GETT 1, Headr$, FileErr                               ' get msg header
  449.  
  450.   IF INKEY$ = CHR$(27) THEN                             ' Allow [Esc] to break
  451.      PRINTLF "Aborted.": ExitErr = 1: Finish            ' out of loop.
  452.   END IF
  453.  
  454.   IF FileErr THEN                                       ' If error reading msg
  455.      skip                                               ' header, we're at EOF.
  456.  
  457.      PRINTLF "End of messages at record #" + STR$(RecsRead&) + "."
  458.  
  459.      IF NOT ViewFlag THEN                               ' If we're not viewing,
  460.         PRINTT "Updating checkpoint record..."          ' update Checkpoint
  461.  
  462.         IF LEN(PuttBlock$) THEN PUT #2, , PuttBlock$    ' flush output buffer
  463.         PuttBlock$ = ""
  464.  
  465.         GET #2, 1, CheckPoint                           ' read in checkpoint
  466.  
  467.         CheckPoint.LastRec = STR$(RecsWrote&)            ' update variables
  468.         CheckPoint.NextAvail = STR$(RecsWrote& + 1&)
  469.         CheckPoint.LastMess = LastMess$
  470.  
  471.         PUT #2, 1, CheckPoint                           ' write updated
  472.                                                         ' checkpoint to file
  473.      ELSE
  474.  
  475.         GET #1, 1, CheckPoint
  476.  
  477.      END IF
  478.  
  479.      CLOSE
  480.      IF NOT ViewFlag THEN PRINTLF "done."                 ' Updated Checkpoint.
  481.      skip
  482.  
  483.      Line1$ = PadOut$(LastSave$, RTRIM$(CheckPoint.LastMess))    ' Prepare
  484.      Line2$ = PadOut$(RecStart$, RTRIM$(CheckPoint.RecStart))    ' for clean
  485.      Line3$ = PadOut$(NextAvail$, RTRIM$(CheckPoint.NextAvail))  ' display
  486.      Line4$ = PadOut$(LastRec$, RTRIM$(CheckPoint.LastRec))      ' below...
  487.      Line5$ = PadOut$(MaxCopies$, RTRIM$(CheckPoint.MaxCopies))  ' ...
  488.      Line6$ = PadOut$(MaxMess$, RTRIM$(CheckPoint.MaxMess))      ' ...
  489.      Line7$ = PadOut$(STR$(MsgsWritten), STR$(MsgsWritten))      ' ...
  490.  
  491.      PRINTLF "                       Original   MailFix"
  492.      PRINTLF "                       --------   -------"
  493.      PRINTLF " Last message number : " + Line1$
  494.      PRINTLF "Msg Record starts at : " + Line2$
  495.      PRINTLF "      Next available : " + Line3$
  496.      PRINTLF "         Last Record : " + Line4$
  497.      PRINTLF "        Node records : " + Line5$
  498.      PRINTLF "    Maximum messages : " + Line6$
  499.      PRINTLF "   Total active msgs : " + Line7$
  500.  
  501.      skip
  502.  
  503.      PRINTT STR$(RecsRead&) + " records read, "         ' Update display
  504.      PRINTLF STR$(RecsWrote&) + " records written."
  505.      IF SlashK OR Renum THEN GOTO KeepFixed
  506.      Finish                                                ' and we're done.
  507.  
  508.   END IF
  509.  
  510.  
  511.   '*************************************************************
  512.   '* Above IF-END IF block executed only if errror encountered *
  513.   '* when reading in message header.  Normally this will occur *
  514.   '* when end of file is reached.                              *
  515.   '*                                                           *
  516.   '*If message header reads in ok, continue below...           *
  517.   '*************************************************************
  518.  
  519.   RecsRead& = RecsRead& + 1&                            ' Update # of recs read
  520.  
  521. ' Check for what constitutes an invalid message header.  Current checks are:
  522. '
  523. ' Message number = 0
  524. ' Killed flag not set
  525. ' Number of message records < 1
  526. '
  527. ' Other useful variables:
  528. '
  529. ' MaxRecs& = Total number of message records (fixed length only)
  530. ' TopMessage = Highest message number in this base (fixed length only)
  531. '
  532.  
  533.   MessNum = PDQValI(MID$(Headr$, 2, 4))                ' Determine msg #
  534.  
  535.   IF FixedLen AND MessNum = 0 AND PDQValI(MessNum$) >= TopMessage THEN                        ' and last msg was hi,
  536.                                                        ' time to pre-format.
  537.  
  538.      skip
  539.      PRINTLF "End of messages."
  540.  
  541.      IF NOT ViewFlag THEN                             ' If not just lookin'..
  542.  
  543.        PRINTT "Preformatting " + STR$(MaxRecs& - (RecsWrote& + 1)) + " records :  "
  544.        StartFormat = RecsWrote& + 1&                   ' Begin after last msg
  545.        Block$ = SPACE$(128)                            ' Define empty record
  546.        FOR i = StartFormat TO MaxRecs&                 ' For all remaining recs
  547.           PUTT 2, Block$                               '   Write blank rec
  548.           RecsWrote& = RecsWrote& + 1&
  549.           Rotate
  550.        NEXT
  551.        LOCATE CSRLIN, POS(0) - 1
  552.        PRINTLF "Done."
  553.      END IF
  554.  
  555.      skip
  556.  
  557.  
  558.      IF NOT ViewFlag THEN                               ' If we're not viewing,
  559.         PRINTT "Updating checkpoint record..."          ' update Checkpoint
  560.  
  561.         IF LEN(PuttBlock$) THEN PUT 2, , PuttBlock$     ' flush output buffer
  562.         PuttBlock$ = ""                                 ' if necessary
  563.  
  564.         IF MaxRecs& <> RecsWrote& THEN
  565.            PRINTLF STRING$(80, "-")
  566.            PRINTLF "** ERROR! **           Total records : " + STR$(RecsWrote&)
  567.            PRINTLF "        Last record SHOULD have been : " + STR$(MaxRecs&)
  568.            skip
  569.            PRINTLF "Do *NOT* use " + OutFile$ + "!"
  570.            ExitErr = 1
  571.            Finish
  572.         END IF
  573.  
  574.         GET #2, 1, CheckPoint                           ' Recall checkpoint.
  575.         CheckPoint.LastRec = STR$(RecsWrote&)            ' Update info
  576.         CheckPoint.NextAvail = STR$(StartFormat)        '
  577.         CheckPoint.LastMess = MessNum$                  '
  578.         PUT #2, 1, CheckPoint                           ' Put back in file.
  579.         PRINTLF "done."
  580.      END IF
  581.  
  582.      CLOSE
  583.      skip
  584.  
  585.      Line1$ = PadOut$(LastSave$, RTRIM$(CheckPoint.LastMess))    ' Prepare
  586.      Line2$ = PadOut$(RecStart$, RTRIM$(CheckPoint.RecStart))    ' for clean
  587.      Line3$ = PadOut$(NextAvail$, RTRIM$(CheckPoint.NextAvail))  ' display
  588.      Line4$ = PadOut$(LastRec$, RTRIM$(CheckPoint.LastRec))      ' below...
  589.      Line5$ = PadOut$(MaxCopies$, RTRIM$(CheckPoint.MaxCopies))  ' ...
  590.      Line6$ = PadOut$(MaxMess$, RTRIM$(CheckPoint.MaxMess))      ' ...
  591.      Line7$ = PadOut$(STR$(MsgsWritten), STR$(MsgsWritten))      ' ...
  592.  
  593.      PRINTLF "                       Original   MailFix"
  594.      PRINTLF "                       --------   -------"
  595.      PRINTLF " Last message number : " + Line1$
  596.      PRINTLF "Msg Record starts at : " + Line2$
  597.      PRINTLF "      Next available : " + Line3$
  598.      PRINTLF "         Last Record : " + Line4$
  599.      PRINTLF "        Node records : " + Line5$
  600.      PRINTLF "    Maximum messages : " + Line6$
  601.      PRINTLF "   Total active msgs : " + Line7$
  602.  
  603.      skip
  604.  
  605.      PRINTT STR$(RecsRead&) + " records read, "         ' Update display
  606.      PRINTLF STR$(RecsWrote&) + " records written."        ' ...
  607.      IF SlashK OR Renum THEN GOTO KeepFixed
  608.  
  609.      Finish                                               ' and we're done.
  610.  
  611.   END IF                                                ' End fixed-len check
  612.  
  613.   MessNum = PDQValI(MID$(Headr$, 2, 4))
  614.   Killed$ = MID$(Headr$, 116, 1)
  615.   NumRecs = PDQValI(MID$(Headr$, 117, 4))
  616.  
  617.   PrivRec = 0                                ' 410
  618.   IF MID$(Headr$, 1, 1) = "*" THEN           ' 410
  619.      MessR = ASC(MID$(Headr$, 123, 1))       ' 410
  620.      IF (MessR <> 0) AND (MessR <> 32) THEN  ' 410
  621.         PrivRec = -1                         ' 410   (Private, and received)
  622.      END IF                                  ' 410
  623.   END IF                                     ' 410
  624.  
  625.   IF MessNum = 0 OR INSTR("ßΓ", Killed$) < 1 OR NumRecs < 1 THEN   ' or no message records,
  626.      PRINTT "Skipping record #" + STR$(RecsRead&)      ' this isn't a message
  627.      PRINTLF " - invalid Msg Header."                  ' header. Skip it by
  628.      GOTO NextMess                                     ' branching back.
  629.  
  630.   END IF
  631.  
  632.   LSET MessNum$ = STR$(MessNum)                        ' At this point, we
  633.                                                        ' must have a valid
  634.                                                        ' header, so save the
  635.                                                        ' msg number for
  636.                                                        ' possible use later
  637.                                                        ' in updating CheckPoint
  638.                                                        ' record in output file.
  639.  
  640.   PRINTT LEFT$(Headr$, 1) + MessNum$ + "  "            ' Print progress to
  641.   PRINTT MID$(Headr$, 6, 15) + "  "                    ' screen.
  642.   PRINTT MID$(Headr$, 76, 25) + "  "
  643.   PRINTT MID$(Headr$, 101, 15)
  644.  
  645.  
  646.   FixedIt = 0                                          ' We haven't fixed this
  647.                                                        ' message yet.
  648.  
  649. ' ***************************************************
  650. ' * UPDATE KEY FIELDS IN DATE & TIME STAMP TO ALLOW *
  651. ' * PROPER MESSAGE PROCESSING.                      *
  652. ' ***************************************************
  653.  
  654.   TimeSent$ = MID$(Headr$, 59, 8)
  655.   DateSent$ = MID$(Headr$, 68, 8)
  656.                                                       ' If date/time separators
  657.                                                       ' aren't "stock" ..
  658.  
  659.   IF (MID$(TimeSent$, 3, 1) <> ":") _
  660.      OR (MID$(TimeSent$, 6, 1) <> Colon$) _
  661.      OR (MID$(DateSent$, 3, 1) <> "-")  _
  662.      OR (MID$(DateSent$, 6, 1) <> "-") THEN
  663.  
  664.         IF RBBSFlag THEN                              ' Maybe it's RBBSMail?
  665.  
  666.            IF (INSTR("ßΓ", Killed$) > 0) _
  667.               AND (MID$(TimeSent$, 3, 1) = ":") _
  668.               AND (MID$(TimeSent$, 6, 1) = ":") _
  669.               AND MID$(DateSent$, 3, 1) = "-" _
  670.               AND MID$(TimeSent$, 6, 1) = "-" THEN    ' all is fine, so...
  671.  
  672.               FixedIt = 0                             ' we didn't fix it.
  673.               GOTO FinishFix                          ' Branch off to keep
  674.            END IF                                     ' processing.
  675.  
  676.         ELSE                                          ' It's not RBBSMail, so..
  677.  
  678.            FixedIt = -1                               ' We're gonna fix 'er.
  679.  
  680.         END IF                                        ' End of "/r" test.
  681.  
  682.      IF NOT ViewFlag THEN                         ' If we're not just
  683.                                                   ' viewing (/v), and
  684.  
  685.         IF FixedIt THEN                           ' If we need to fix it
  686.             MidChars Headr$, 61, 58               '  : for first time delimiter
  687.             MID$(Headr$, 64, 3) = ColonFix$       '  :00 for second time delim.
  688.             MidChars Headr$, 70, 45               '  - first date delimiter
  689.             MidChars Headr$, 73, 45               '  - second date delimiter
  690.         END IF
  691.  
  692.      ELSE                                             ' We're just viewing
  693.  
  694.          Disp$ = "  <" + Killed$ + MID$(TimeSent$, 3, 1) + _
  695.            MID$(TimeSent$, 6, 1) + MID$(DateSent$, 3, 1) + _
  696.            MID$(DateSent$, 6, 1) + ">"
  697.  
  698.      END IF
  699.  
  700.   END IF                                              ' END OF MAIN "IF" TEST.
  701.  
  702. ' *********************************************************************
  703. ' *  PREPARE TO WRITE THE MESSAGE (AND/OR FINISH UPDATING DISPLAY)    *
  704. ' *  DoWhat variable is 1, 2, or 3, depending on action to be taken.  *
  705. ' *  1 = Purge                                                        *
  706. ' *  2 = Fix                                                          *
  707. ' *  3 = Copy                                                         *
  708. ' *********************************************************************
  709. ' ----------------------------------------------------------------------------
  710.  
  711. FinishFix:   ' Branch here for RBBSMail/OverMail if msg not been processed yet.
  712.  
  713. IF PurgePriv THEN          ' 410  If /P command line,
  714.    IF PrivRec THEN         ' 410  and message is both private and received,
  715.       Killed$ = "Γ"        ' 410  set killed flag for purge.
  716.    END IF                  ' 410
  717. END IF                     ' 410
  718.  
  719. IF Killed$ = "Γ" THEN                         ' If message is killed,
  720.  
  721.    IF ViewFlag THEN                             ' Maybe we're just viewing?
  722.  
  723.       IF NOT FixedIt THEN                           ' If we haven't fixed it,
  724.          Report$ = "  [purged]"                     ' inform that it would
  725.                                                     ' be a purge.
  726.       ELSE                                          ' Else, it was a fix, so..
  727.          Report$ = Disp$                            ' inform of 5 key fields.
  728.       END IF
  729.  
  730.       DoWhat = 1                                    ' Set marker
  731.  
  732.    ELSE                                         ' We're not just viewing.
  733.  
  734.       Report$ = "  [purged]"                        ' Inform that it's a purge,
  735.       DoWhat = 1                                    ' and set flag accordingly.
  736.  
  737.    END IF                                       ' END OF VIEW TEST
  738.  
  739. ELSE                                          ' Message wasn't killed.
  740.  
  741.    IF FixedIt THEN                              ' Did we fix it?
  742.  
  743.       IF NOT ViewFlag THEN                          ' If we're not viewing,
  744.          Report$ = "  <fixed>"                      ' say that we fixed it,
  745.       ELSE                                          ' Otherwise...
  746.          Report$ = Disp$                            ' Prepare to display the
  747.                                                     ' 5 key fields.
  748.       END IF                                    ' END OF VIEW TEST
  749.  
  750.       DoWhat = 2                                ' Set marker
  751.  
  752.    ELSE                                         ' We didn't fix it, so
  753.  
  754.       Report$ = " ..copied.."                       ' we're just copying the
  755.       DoWhat = 3                                    ' message to the output
  756.                                                     ' file.
  757.    END IF                                       ' END OF FIX TEST
  758.  
  759.    LastMess$ = MessNum$
  760. END IF                                        ' END OF KILLED TEST
  761.  
  762. ' *******************************************************************
  763. ' *  PRELIMINARY WORK ALL DONE, TIME TO ACTUALLY WRITE THE MESSAGE  *
  764. ' *******************************************************************
  765. ' ----------------------------------------------------------------------------
  766.  
  767. IF INKEY$ = CHR$(27) THEN PRINTLF "Aborted.": ExitErr = 1: Finish                      ' Allow [Esc] to abort.
  768.  
  769. SELECT CASE DoWhat                                  ' What are we doing?
  770.                                                     ' -----------------------
  771.   CASE 1                                            ' PURGE <<<<<<<<<<<<<<<<<
  772.     BodyRecs = NumRecs - 1                          ' how many more recs?
  773.     DO
  774.       Recs = BodyRecs
  775.       IF Recs > 32 THEN Recs = 32
  776.       Block$ = ""
  777.       Block$ = SPACE$(128 * Recs)                   ' define input block
  778.       GETT 1, Block$, FileErr                       ' input it
  779.       RecsRead& = RecsRead& + Recs                  ' update recs read
  780.       BodyRecs = BodyRecs - Recs
  781.     LOOP WHILE BodyRecs
  782.  
  783.                                                     ' -----------------------
  784.   CASE 2, 3                                         ' FIX, COPY <<<<<<<<<<<<<
  785.     IF NOT ViewFlag THEN
  786.        MsgCount = MsgCount + 1
  787.  
  788.        IF MsgCount > MsgLim then
  789.           skip
  790.           PRINTLF "Aborted! - More than " + STR$(MsgLim) + " messages!"
  791.           ExitErr = 1
  792.           Finish
  793.        END IF
  794.  
  795.  
  796.        SeekIndex&(MsgCount) = _                     ' Remember location in .FIX
  797.          SEEK(2) + LEN(PuttBlock$)                  ' file of start of msg
  798.  
  799.        PUTT 2, Headr$                               ' Write header to output.
  800.        RecsWrote& = RecsWrote& + 1&                 ' Update # of recs written.
  801.     END IF
  802.  
  803.     BodyRecs = NumRecs - 1                          ' How long msg body?
  804.  
  805.     DO
  806.       Block$ = ""                                   ' Read in msg body, up to
  807.       Recs = BodyRecs                               '  32 records at a time.
  808.       IF Recs > 32 THEN Recs = 32
  809.       Block$ = SPACE$(Recs * 128)
  810.       GETT 1, Block$, FileErr                       ' Read in whole body
  811.       RecsRead& = RecsRead& + Recs                  ' Update # recs read
  812.       IF NOT ViewFlag THEN                          ' If not "just lookin'"
  813.         PUTT 2, Block$                              '   Write to output buffer
  814.         RecsWrote& = RecsWrote& + Recs              '   Update # recs written.
  815.       END IF
  816.       BodyRecs = BodyRecs - Recs                    ' Update count remaining
  817.                                                     ' records in msg body
  818.  
  819.     LOOP WHILE BodyRecs                             ' Loop until whole body
  820.                                                     ' processed.
  821.  
  822.     MsgsWritten = MsgsWritten + 1                   ' We just wrote a message.
  823.  
  824.   CASE ELSE                                         ' Shouldn't be possible.
  825.  
  826. END SELECT                                          ' END OF MESSAGE.
  827.  
  828. PRINTLF Report$                                     ' Report what we did,
  829.  
  830. GOTO NextMess                                       ' ... and get next msg.
  831.  
  832.  
  833.  
  834. '============================================================================
  835.  
  836. '**************************************************************
  837. '* REWRITE FILE, CUTTING BACK TO SPECIFIED NUMBER OF MESSAGES *
  838. '**************************************************************
  839. '
  840. ' ----------------------------------
  841. ' BRANCH HERE IF SlashK and/or Renum
  842. ' ----------------------------------
  843.  
  844. KeepFixed:
  845.                                                   'Housekeeping:
  846. IF LEN(PuttBlock$) THEN PUT 2, , PuttBlock$       '  save output buffer
  847. PuttBlock$ = ""                                   '  kill buffers
  848. GettBlock$ = ""
  849.  
  850. TotalMsgs$ = STR$(MsgsWritten)
  851. NewMsgs$ = TotalMsgs$
  852. CLOSE
  853.  
  854. OPEN OutFile$ FOR INPUT SHARED AS #1
  855. IF LOF(1) < 129 THEN
  856.    PRINTLF "Message file is invalid!"
  857.    CLOSE
  858.    ExitErr = 1
  859.    Finish
  860. END IF
  861.  
  862. skip
  863.                                       'Reminder: Z$ is message file name
  864.                                       '(command line after option switches
  865.                                       'removed).
  866.  
  867. IF (MsgsWritten <= keep) AND (Renum = 0) THEN
  868.    PRINTT "You want to keep " + STR$(keep) + " messages, but only "
  869.    PRINTLF STR$(MsgsWritten) + " were found."
  870.    PRINTT "Moving " + OutFile$ + " to " + Z$ + " as is ..."
  871.    CLOSE
  872.    IF PDQExist(Z$) AND PDQExist(OutFile$) THEN
  873.       KILL Z$
  874.       NAME OutFile$ AS Z$
  875.       PRINTLF "done."
  876.    ELSE
  877.       PRINTLF "unable to do it!"
  878.       PRINTLF "Original message base unchanged."
  879.    END IF
  880.    ExitErr = 1
  881.    Finish
  882. END IF
  883.  
  884.  
  885. IF MsgsWritten <= keep THEN keep = MsgsWritten
  886. IF keep = 0 THEN keep = MsgsWritten
  887.  
  888. PRINTT "Found " + STR$(MsgsWritten) + " msgs.  "
  889.  
  890. IF SlashK THEN PRINTT "Keeping"
  891. IF Renum AND SlashK THEN PRINTT "/"
  892. IF Renum THEN PRINTT "Renumbering"
  893.  
  894. PRINTT " the last " + STR$(keep) + ":  "
  895.  
  896. CLOSE
  897.  
  898. OPEN OutFile$ FOR BINARY SHARED AS #1     ' Input from *.FIX file
  899. IF PDQExist(Z$) THEN KILL Z$              ' Delete orig msg file
  900. OPEN Z$ FOR BINARY AS #2                  ' Output to msg file
  901.  
  902. MsgsToSkip = MsgsWritten - keep           ' How many msgs do we dump?
  903. RecsRead& = 0&
  904. RecsWrote& = 0&
  905.  
  906. Block$ = ""
  907. Block$ = SPACE$((MaxCopies + 1) * 128)          ' Block = Chkpoint + node recs
  908.  
  909. GET #1, , Block$                                ' Read block directly
  910. PUTT 2, Block$                                  ' Write block via buffer
  911.  
  912. RecsWrote& = MaxCopies + 1&                     ' Update # recs written.
  913.  
  914. LastSave$ = RTRIM$(MID$(Block$, 1, 8))          ' Save checkpoint data for
  915. RecStart$ = RTRIM$(MID$(Block$, 68, 7))         ' later display
  916. NextAvail$ = RTRIM$(MID$(Block$, 75, 7))
  917. LastRec$ = RTRIM$(MID$(Block$, 82, 7))
  918. MaxMess$ = RTRIM$(MID$(Block$, 89, 7))
  919.  
  920. REDIM OldNum(keep)                              ' Array of orig msg #s
  921.  
  922. Headr$ = ""
  923. Headr$ = SPACE$(128)
  924. MessNum$ = SPACE$(4)
  925.  
  926. SEEK #1, SeekIndex&(MsgsToSkip + 1)                      ' Move input file
  927.                                                          ' to beginning of
  928.                                                          ' first msg to keep
  929.  
  930. maxmem = 128 * 128                                       ' initialize input
  931. IF maxmem + 10240 > FRE(a$) THEN maxmem = (FRE(a$) - 10240) \ 128 * 128
  932.  
  933. L& = LOF(1) - SEEK(1) + 1&                 ' How long is rest of file?
  934. IF L& < maxmem THEN maxmem = L&            ' adjust buffer length if necessary
  935. L& = 0
  936. GettBlock$ = SPACE$(maxmem)
  937.  
  938. RecsRead& = SEEK(1) \ 128&                               ' account for skipped
  939.                                                          ' records
  940.  
  941. GET #1, , GettBlock$                        ' Grab initial input block.
  942. GLoc = 1                                    ' Set buffer pointer to beginning
  943.                                             '   of buffer block.
  944.  
  945. ERASE SeekIndex&                            ' Done with array.  Reclaim memory
  946.  
  947. FOR Z = 1 TO keep                                   'Now save "Keep" msgs
  948.  
  949.     Rotate
  950.  
  951.     Headr$ = ""
  952.     Headr$ = SPACE$(128)
  953.     GETT 1, Headr$, FileErr                         'input header
  954.     IF FileErr THEN EXIT FOR
  955.  
  956.     MessNum = PDQValI(MID$(Headr$, 2, 4))           'determine msg #
  957.     OldNum(Z) = MessNum                             'save orig msg # in array
  958.     NewNum = MessNum
  959.  
  960.     NumRecs = PDQValI(MID$(Headr$, 117, 4))         'how many records in msg?
  961.  
  962.     IF Renum THEN                                   'if renumbering
  963.       NewNum = Z
  964.       LSET MessNum$ = STR$(Z)                       ' put new number
  965.       MID$(Headr$, 2, 4) = MessNum$                 ' into header
  966.     END IF
  967.  
  968.     PUTT 2, Headr$                                  'save header to file
  969.     RecsRead& = RecsRead& + 1&                         'update counter
  970.     RecsWrote& = RecsWrote& + 1&                       'update counter
  971.  
  972.     NumHeaders = MidChar(Headr$, 67)                'any cc headers?
  973.  
  974.     IF Renum THEN                          'if renumbering ..
  975.                                                'check first records to see
  976.                                                'if they are cc multi-headers
  977.                                                'whose msg numbers must be
  978.                                                'updated.
  979.  
  980.                             ' Note:
  981.  
  982.                             ' RBBS before 17.4 would put a space in
  983.                             ' byte 67 of message headers.  This
  984.                             ' results in MailFIX interpreting as 32 
  985.                             ' message headers when there really
  986.                             ' would only be 1.  So we must make sure
  987.                             ' multiple headers really exist before
  988.                             ' changing the date in them.
  989.  
  990.       Block$ = ""
  991.       Block$ = SPACE$(128)
  992.  
  993.       HeadersChecked = 1
  994.  
  995.       FOR i = 2 TO NumHeaders                        'loop thru any cc headers
  996.  
  997.         GETT 1, Block$, FileErr
  998.  
  999.         GoodHeader = 0                               'initialize flag
  1000.         HeadersChecked = HeadersChecked + 1
  1001.  
  1002.         IF INSTR("ßΓ", MID$(Block$, 116, 1)) > 0 THEN    'Pass 1st test
  1003.  
  1004.           TimeSent$ = MID$(Block$, 59, 8)
  1005.           IF MID$(TimeSent$, 3, 1) = ":" THEN              'Pass 2nd test
  1006.  
  1007.             IF (MID$(TimeSent$, 6, 1) = ":") _
  1008.               OR (MID$(TimeSent$, 6, 1) = Colon$) THEN     'Pass 3rd test
  1009.  
  1010.               DateSent$ = MID$(Block$, 68, 8)
  1011.               IF MID$(DateSent$, 3, 1) = "-" THEN          'Pass 4th test
  1012.  
  1013.                 IF MID$(DateSent$, 6, 1) = "-" THEN        'Pass 5th test
  1014.  
  1015.                   MID$(Block$, 2, 4) = MessNum$   'put new msg # into header
  1016.                   GoodHeader = -1                   'Set flag
  1017.  
  1018.                 END IF
  1019.               END IF
  1020.             END IF
  1021.           END IF
  1022.         END IF
  1023.  
  1024.         PUTT 2, Block$                             ' Write to output whether
  1025.                                                    ' a header or not
  1026.         RecsWrote& = RecsWrote& + 1&
  1027.  
  1028.         IF NOT GoodHeader THEN EXIT FOR            ' If not header, quit
  1029.                                                    ' checking headers
  1030.  
  1031.       NEXT
  1032.  
  1033.       BodyRecs = NumRecs - HeadersChecked          ' adjust count of recs in
  1034.                                                    ' rest of message
  1035.     ELSE
  1036.  
  1037.       BodyRecs = NumRecs - 1
  1038.  
  1039.     END IF
  1040.  
  1041.     DO                                             ' loop thru rest of msg
  1042.  
  1043.       Recs = BodyRecs
  1044.  
  1045.       IF Recs > 32 THEN Recs = 32                  ' take records 32 at a time
  1046.       Block$ = ""
  1047.       Block$ = SPACE$(Recs * 128)
  1048.       GETT 1, Block$, FileErr                      ' read from input buffer
  1049.  
  1050.       PUTT 2, Block$                               ' write to output buffer
  1051.  
  1052.       Block$ = ""
  1053.       BodyRecs = BodyRecs - Recs                   ' how many msg records left?
  1054.       RecsWrote& = RecsWrote& + Recs                 ' update count recs written
  1055.       RecsRead& = RecsRead& + Recs                   ' update count recs read
  1056.  
  1057.     LOOP WHILE BodyRecs                            ' loop til no more recs
  1058.  
  1059. NEXT                                               ' go back for next msg
  1060.  
  1061. LOCATE CSRLIN, POS(0) - 1
  1062.  
  1063. PRINTLF "Done."
  1064.  
  1065. IF NOT FixedLen THEN
  1066.    PRINTLF "End of messages at record #" + STR$(RecsRead&) + "."
  1067. ELSE
  1068.    StartFormat& = RecsWrote& + 1&                  ' pre-format balance of
  1069.    PRINTT "Preformatting "                         ' file for fixed base.
  1070.    PRINTT STR$(MaxRecs& - StartFormat&)
  1071.    PRINTT " empty records for fixed length base:  "
  1072.    Block$ = ""
  1073.    Block$ = SPACE$(128)
  1074.    FOR i = StartFormat& TO MaxRecs&
  1075.      Rotate
  1076.      PUTT 2, Block$
  1077.      RecsWrote& = RecsWrote& + 1&
  1078.    NEXT
  1079.    LOCATE CSRLIN, POS(0) - 1
  1080.    PRINTLF "Done."
  1081. END IF
  1082.  
  1083. IF LEN(PuttBlock$) THEN _                       ' clear output buffer
  1084.   PUT #2, , PuttBlock$:   PuttBlock$ = ""
  1085.  
  1086. PRINTT "Updating checkpoint record..."          ' Update Checkpoint
  1087. GET #2, 1, CheckPoint                           ' record in output with
  1088. IF FixedLen THEN                                ' info based on what
  1089.    CheckPoint.NextAvail = STR$(StartFormat)     ' we've read from the
  1090. ELSE                                            ' message file.
  1091.    CheckPoint.LastRec = STR$(RecsWrote&)
  1092.    CheckPoint.NextAvail = STR$(RecsWrote& + 1&)
  1093. END IF
  1094.  
  1095. IF Renum THEN LSET CheckPoint.LastMess = STR$(NewNum) '   set to new high msg #
  1096.  
  1097. PUT #2, 1, CheckPoint                           ' Write updated Checkpoint
  1098.                                                 ' directly to file.
  1099.  
  1100. CLOSE
  1101. PRINTLF "done."
  1102.  
  1103. Block$ = ""                                     ' reclaim string memory
  1104. Headr$ = ""
  1105. GettBlock$ = ""
  1106.  
  1107. skip
  1108.  
  1109. Line1$ = PadOut$(LastSave$, RTRIM$(CheckPoint.LastMess))    ' Prepare
  1110. Line2$ = PadOut$(RecStart$, RTRIM$(CheckPoint.RecStart))    ' for clean
  1111. Line3$ = PadOut$(NextAvail$, RTRIM$(CheckPoint.NextAvail))  ' display
  1112. Line4$ = PadOut$(LastRec$, RTRIM$(CheckPoint.LastRec))      ' below...
  1113. Line5$ = PadOut$(MaxCopies$, RTRIM$(CheckPoint.MaxCopies))  ' ...
  1114. Line6$ = PadOut$(MaxMess$, RTRIM$(CheckPoint.MaxMess))      ' ...
  1115. Line7$ = PadOut$(TotalMsgs$, STR$(keep))                    ' ...
  1116.  
  1117. PRINTLF "                        Mailfix     /K" + STR$(keep)
  1118. PRINTLF "                       --------   -------"
  1119. PRINTLF " Last message number : " + Line1$
  1120. PRINTLF "Msg record starts at : " + Line2$
  1121. PRINTLF "      Next available : " + Line3$
  1122. PRINTLF "         Last record : " + Line4$
  1123. PRINTLF "        Node records : " + Line5$
  1124. PRINTLF "    Maximum messages : " + Line6$
  1125. PRINTLF "     Active messages : " + Line7$
  1126.  
  1127. skip
  1128.  
  1129. PRINTT STR$(RecsRead& - 1&) + " records read, "      ' Update display
  1130. PRINTLF STR$(RecsWrote&) + " records written."        ' ...
  1131.  
  1132. IF PDQExist(OutFile$) THEN KILL OutFile$
  1133.  
  1134.  
  1135. '===========================================================================
  1136.  
  1137. '******************************************
  1138. '* Update last read pointers in user file *
  1139. '******************************************
  1140.  
  1141. IF UpdtU THEN                                      'If we're to update user
  1142.                                                    'pointers
  1143.  
  1144.   PRINTT "Updating user message pointers ... "
  1145.  
  1146.   OPEN UserFile$ FOR BINARY AS #1                  'Open file
  1147.  
  1148.   Block$ = SPACE$(128 * 128)                       'block size 128 recs
  1149.  
  1150.                              'Note:  User file is manipulated in place,
  1151.                              '       so we will not use the GETT and PUTT
  1152.                              '       buffered read and write functions,
  1153.                              '       but will buffer with code here.
  1154.   users = 0
  1155.   totusers = 0
  1156.  
  1157.   DO
  1158.     IF SEEK(1) > LOF(1) THEN EXIT DO               'If EOF, done
  1159.     Rotate
  1160.  
  1161.     IF (LOF(1) - SEEK(1) + 1) < LEN(Block$) THEN   'If < full block left
  1162.       Block$ = ""
  1163.       Block$ = SPACE$(LOF(1) - SEEK(1) + 1)        '  resize block
  1164.     END IF
  1165.  
  1166.     GET #1, , Block$                               'Read block
  1167.  
  1168.     NPos = 1                                       'Pointer to name
  1169.     PPos = 51                                      'Pointer to last msg #
  1170.  
  1171.     DO
  1172.  
  1173.       UName$ = RTRIM$(MID$(Block$, NPos, 31))      'Read user name
  1174.  
  1175.       IF NOT (UName$ = "" OR UName$ = "NEWUSER" OR _  'Make sure valid name
  1176.         UName$ = " deleted user") THEN
  1177.  
  1178.         Pointer = CVI(MID$(Block$, PPos, 2))       'determine val pointer
  1179.  
  1180.         totusers = totusers + 1                    'Increment user count
  1181.  
  1182.         IF Pointer THEN                                'if ptr 0, leave alone
  1183.  
  1184.           FOR i = keep TO 0 STEP -1                    'loop thru old msg #s
  1185.             IF Pointer >= OldNum(i) THEN               '  when find old pointer
  1186.               MID$(Block$, PPos, 2) = MKI$(i)          '  change to new pointer val
  1187.               users = users + 1                        '  add to update count
  1188.               EXIT FOR                                 '  exit msg # loop
  1189.             END IF
  1190.           NEXT
  1191.         END IF
  1192.       END IF
  1193.  
  1194.       NPos = NPos + 128                            'reset pointers for next rec
  1195.       PPos = PPos + 128
  1196.  
  1197.     LOOP UNTIL PPos > LEN(Block$)               'If still in block, loop again
  1198.  
  1199.     PUT #1, SEEK(1) - LEN(Block$), Block$       'Done with block, save it
  1200.   LOOP                                          'Go back for next block
  1201.  
  1202.   CLOSE
  1203.  
  1204.   LOCATE CSRLIN, POS(0) - 1
  1205.  
  1206.   PRINTLF "Done - " + STR$(users) + " of " _    'Report user stats
  1207.     + STR$(totusers) + "  active users updated"
  1208.  
  1209. END IF
  1210.  
  1211. Finish                                                ' and we're done.
  1212.  
  1213. END
  1214.  
  1215. '---------------------------------------------------------------------------
  1216. '                     SUBS AND FUNCTIONS
  1217. '---------------------------------------------------------------------------
  1218.  
  1219.  
  1220. SUB EndFix  'Help/syntax screen display
  1221.  
  1222.    CLS
  1223.    PRINTLF "MailFIX " + Version$ + " - " + Copyright$
  1224.    PRINTLF STRING$(79, 205)
  1225.    PRINTLF "Usage:  MAILFIX [options] D:\PATH\MESSAGES.DEF"
  1226.    skip
  1227.    PRINTLF "Available options:"
  1228.    skip                             ' 410
  1229.    PRINTLF "   /D = Use dos screen writes (slower but redirectable) instead of direct."
  1230.    PRINTLF "   /F = Tell MAILFIX this is a fixed-length message base."
  1231.    PRINTLF "   /Kn = Keep only the last 'n' messages in the conference."
  1232.    PRINTLF "           ***  This option *WILL* overwrite your old message base! ***"
  1233.    PRINTLF "   /N = Renumber the message base, starting at message #1."
  1234.    PRINTLF "        Enter path\filename of conference user file directly after the /N"
  1235.    PRINTLF "        (no intervening space) to tell MAILFIX to update the user file"
  1236.    PRINTLF "        message pointers for this base after renumbering base."
  1237.    PRINTLF "           ***  This option *WILL* overwrite your old message base! ***"
  1238.    PRINTLF "   /O = Tell MAILFIX this is an OverMail'ed message base."
  1239.    PRINTLF "   /P = Purge private messages that have been received."      ' 410
  1240.    PRINTLF "   /R = Tell MAILFIX this is an RBBSMail/MsgToss message base."  ' 402
  1241.    PRINTLF "   /Sn = Set max size of input RBBS msg file to n msgs (default is 1000)."
  1242.    PRINTLF "   /V = Only View the message base - make no changes."
  1243.    skip
  1244.    PRINTLF "   Unless the /Knnn, /N, or /V options are used, MAILFIX will create"
  1245.    PRINTLF "   a new message file with the extension '.FIX'."    ' 410
  1246.    CLOSE
  1247.    ExitErr = 1
  1248.    END
  1249.  
  1250. END SUB    'ENDFIX
  1251.  
  1252. '---------------------------------------------------------------------------
  1253.  
  1254. SUB Finish    ' Display run time
  1255.  
  1256.   SHARED TimeStart&, ExitErr
  1257.  
  1258.   CLOSE
  1259.  
  1260.   PRINTT "MAILFIX run time: "
  1261.   Elapsed& = (PDQTimer + 1573085 - TimeStart&) MOD 1573085
  1262.   PRINTLF Dollar$(100000 * (Elapsed&) \ 18207) + " seconds."
  1263.   skip
  1264.   EndLevel ExitErr
  1265.   END
  1266.  
  1267. END SUB   'FINISH
  1268.  
  1269. '---------------------------------------------------------------------------
  1270.  
  1271. SUB GETT (filenum, strvar$, endfile)             'Retrieve a string variable
  1272.                                                  'from a input buffer block
  1273.  
  1274.   SHARED GettBlock$                            ' Pre-defined input buffer block
  1275.   SHARED GLoc                                  ' Current position in buffer block
  1276.  
  1277.  
  1278.   varlen = LEN(strvar$)                        ' How long is the variable being
  1279.                                                ' requested?
  1280.   IF varlen MOD 128 THEN
  1281.     PRINTLF "IN GETT: requested var len not multiple of 128! " + STR$(varlen)
  1282.     ExitErr = 1
  1283.     Finish
  1284.   END IF
  1285.  
  1286.   endfile = 0
  1287.                                                            'How far does strvar$
  1288.                                                            'request go beyond
  1289.                                                            'end of buffer block?
  1290.  
  1291.     shortfall = CLNG(GLoc - 1) + LEN(strvar$) - LEN(GettBlock$)
  1292.  
  1293.     IF shortfall > 0 THEN                                  'If beyond end of
  1294.                                                            ' block ..
  1295.  
  1296.       Part1$ = ""
  1297.       strvar$ = ""
  1298.  
  1299.       Part1$ = MID$(GettBlock$, GLoc)                      ' grab what we can
  1300.                                                            ' as first part of
  1301.                                                            ' string block
  1302.  
  1303.                                                            ' If another full
  1304.                                                            ' block would go
  1305.                                                            ' past end of file
  1306.  
  1307.       IF (SEEK(filenum) - 1& + LEN(GettBlock$)) > LOF(filenum) THEN _
  1308.         GettBlock$ = "": _                                     'adjust size
  1309.         GettBlock$ = SPACE$(LOF(filenum) - SEEK(filenum) + 1&) 'of block
  1310.  
  1311.  
  1312.       IF LEN(GettBlock$) < 1 THEN endfile = -1: EXIT SUB   ' block len should
  1313.                                                            ' be zero at eof
  1314.  
  1315.       GET #filenum, , GettBlock$                           ' read in next block
  1316.  
  1317.       strvar$ = Part1$ + LEFT$(GettBlock$, shortfall)      ' get rest of string
  1318.       Part1$ = ""
  1319.  
  1320.       GLoc = shortfall + 1                                 ' save position of
  1321.                                                            ' next char in block
  1322.  
  1323.  
  1324.     ELSE                                                   'Else, strvar$ all
  1325.                                                            'contained in current
  1326.                                                            'block ..
  1327.       strvar$ = ""
  1328.       strvar$ = MID$(GettBlock$, GLoc, varlen)             '  grab strvar$
  1329.  
  1330.       GLoc = GLoc + varlen                                 '  update block pointer
  1331.  
  1332.     END IF
  1333.  
  1334. END SUB  'GETT
  1335.  
  1336. '---------------------------------------------------------------------------
  1337.  
  1338. FUNCTION PadOut$ (In1$, In2$) STATIC    'String functions must be STATIC
  1339.                                         'under PDQ (ver 3.10)
  1340.   PadOut$ = ""
  1341.   Test1$ = SPACE$(8)
  1342.   Test2$ = SPACE$(10)
  1343.   RSET Test1$ = In1$
  1344.   RSET Test2$ = In2$
  1345.  
  1346.   PadOut$ = Test1$ + Test2$
  1347.  
  1348. END FUNCTION  'PadOut$
  1349.  
  1350. '---------------------------------------------------------------------------
  1351.  
  1352. SUB PRINTLF (a$)                                'Equivalent to QB PRINT a$
  1353.  
  1354.    SHARED DosPrint
  1355.  
  1356.    IF DosPrint THEN
  1357.      PRINT a$
  1358.    ELSE
  1359.      PDQPrint a$, CSRLIN, POS(0), 7
  1360.      LOCATE CSRLIN + 1, 1
  1361.      Scroll
  1362.    END IF
  1363.  
  1364. END SUB     'PRINTLF
  1365.  
  1366. '---------------------------------------------------------------------------
  1367.  
  1368. SUB PRINTT (a$)                                 'Equivalent to QB PRINT a$;
  1369.  
  1370.    SHARED DosPrint
  1371.  
  1372.    IF DosPrint THEN
  1373.      PRINT a$;
  1374.    ELSE
  1375.      PDQPrint a$, CSRLIN, POS(0), 7
  1376.      LOCATE CSRLIN, POS(0) + LEN(a$)
  1377.    END IF
  1378.  
  1379. END SUB   'PRINTT
  1380.  
  1381. '---------------------------------------------------------------------------
  1382.  
  1383. SUB PUTT (filenum, strvar$)                 ' Print to output buffer
  1384.  
  1385.    SHARED PuttBlock$                             ' Predefined output buffer
  1386.  
  1387.                                                  ' If adding strvar$ to buffer
  1388.                                                  ' would leave < 500 bytes in
  1389.                                                  ' in string space,
  1390.  
  1391.    IF (LEN(strvar$) + LEN(PuttBlock$)) > (FRE(a$) - 500) THEN
  1392.  
  1393.       PUT filenum, , PuttBlock$                  '   write buffer to disk, and
  1394.       PuttBlock$ = ""
  1395.       PuttBlock$ = strvar$                       '   start new buffer w strvar$
  1396.  
  1397.    ELSE
  1398.  
  1399.       PuttBlock$ = PuttBlock$ + strvar$          ' ..if not just add to buffer
  1400.  
  1401.    END IF
  1402.  
  1403. END SUB   'PUTT
  1404.  
  1405. '---------------------------------------------------------------------------
  1406.  
  1407. SUB Rotate STATIC                   ' Print a twiddle to show program is
  1408.                                     ' still working
  1409.  
  1410.   RotChar = RotChar + 1
  1411.   IF RotChar > 4 THEN RotChar = 1
  1412.  
  1413.   SELECT CASE RotChar
  1414.     CASE 1:
  1415.       a$ = "-"
  1416.     CASE 2, 4:
  1417.       a$ = "+"
  1418.     CASE 3:
  1419.       a$ = "*"
  1420.     CASE ELSE:
  1421.   END SELECT
  1422.  
  1423.   LOCATE CSRLIN, POS(0) - 1
  1424.   PRINTT a$
  1425.  
  1426. END SUB  'ROTATE
  1427.  
  1428. '---------------------------------------------------------------------------
  1429.  
  1430. SUB Scroll                                      'Scroll screen vertically
  1431.  
  1432.   SHARED DosPrint
  1433.  
  1434.   IF CSRLIN < 25 THEN EXIT SUB
  1435.  
  1436.   IF DosPrint THEN
  1437.     PRINT
  1438.   ELSE
  1439.     Registers.AX = &H601
  1440.     Registers.BX = (7 * 256) + 0
  1441.     Registers.CX = 0
  1442.     Registers.DX = (256 * 25) + 79
  1443.     CALL INTERRUPT(&H10, Registers)
  1444.     LOCATE 24, POS(0)
  1445.   END IF
  1446.  
  1447. END SUB      'SCROLL
  1448.  
  1449. '---------------------------------------------------------------------------
  1450.  
  1451. SUB skip                                        'Equivalent to QB PRINT ""
  1452.  
  1453.   SHARED DosPrint
  1454.  
  1455.   IF DosPrint THEN
  1456.     PRINT
  1457.   ELSE
  1458.     LOCATE CSRLIN + 1, 1
  1459.     Scroll
  1460.   END IF
  1461.  
  1462. END SUB     'SKIP
  1463.