home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / Pete Johnson / Mehit 3.0.b15<source> Folder / Backup.p < prev    next >
Encoding:
Text File  |  1991-08-01  |  61.8 KB  |  2,030 lines  |  [TEXT/PJMM]
  1. unit Backup;
  2.  
  3. interface
  4.  
  5. uses
  6.     Globals, HelloTabby, mehitFile, Centerer, FileAndStuffIt, LogUtils, UserLog, TextFiles, Debug;
  7.  
  8. var
  9.     Separator: STR255;
  10.     DEBUG: boolean;     {<-------------- CHECK THIS!!!!}
  11.  
  12. procedure BackupMessages;
  13.  
  14. procedure ReadSTRs;
  15.  
  16. procedure TimeAt;
  17.  
  18. function MyGetString (Number: integer; var aString: str255): boolean;
  19.  
  20. implementation
  21.  
  22. var
  23.     WhenRcvdString: packed array[1..6] of char;
  24.  
  25. {-----------------------------------------------------------------    }
  26.  
  27. function MyGetString; {(Number: integer; var aString:str255 ): boolean}
  28.  
  29.     begin
  30.         if GetString(Number) <> nil then
  31.             begin
  32.                 aString := GetString(Number)^^;
  33.                 MyGetString := true
  34.             end
  35.         else
  36.             begin
  37.                 aString := '';
  38.                 MyGetString := false
  39.             end
  40.     end;
  41.  
  42. {    ----------------------------------    }
  43.  
  44. procedure ReadSTRs;
  45.  
  46.     var
  47.         Counter: integer;
  48.         Options, LimitString, AgeString, BackString, ReportErrs: STR255;
  49.         UserDefaults, NewDefaults, tempString: str255;
  50.  
  51. {    ----------------------------------    }
  52.  
  53.     function DecodeBulletValues (var DefaultString: str255): longint;
  54.  
  55.         var
  56.             Marker: integer;
  57.             tempString: STR255;
  58.             Value: longint;
  59.  
  60.         begin
  61.             Marker := pos(BULLET, DefaultString);
  62.             if Marker = 0 then
  63.                 tempString := copy(DefaultString, 1, 255)
  64.             else
  65.                 tempString := copy(DefaultString, 1, Marker - 1);
  66.             StringToNum(tempString, Value);
  67.             if Marker <> 0 then
  68.                 DefaultString := copy(DefaultString, Marker + 1, 255)
  69.             else
  70.                 DefaultString := '';
  71.             DecodeBulletValues := Value
  72.         end;
  73.  
  74. {    ----------------------------------    }
  75.  
  76.         var
  77.             SettingsError: boolean;
  78.  
  79.     begin
  80.         DefaultsPtr := DefaultStuffPtr(NewPtr(SizeOf(DefaultStuff)));
  81.         with DefaultsPtr^ do
  82.             begin
  83.                 DNextLaunch := 'Second Sight';
  84.                 DBackupPath := ':';
  85.                 DTextPath := ':';
  86.                 BUTextPath := ':';
  87.                 MaxBUSize := '100';
  88.                 TextType := 'QED1';
  89.             end;
  90.         BigLogName := 'mehit big report';
  91.         BriefLogName := 'mehit brief report';
  92.         MsgErrLogName := 'message error log';
  93.         OrphanLogName := 'message orphans';
  94.         Separator := '';
  95.         if not newExternalFile then
  96.             begin
  97.                 with DefaultsPtr^ do
  98.                     begin
  99.                         if myGetString(500, tempString) then
  100.                             DNextLaunch := tempString;
  101.                         if myGetString(501, tempString) then
  102.                             DBackupPath := tempString;
  103.                         if myGetString(502, tempString) then
  104.                             DTextPath := tempString;
  105.                         if myGetString(504, tempString) then
  106.                             BUTextPath := tempString;
  107.                         if myGetString(505, tempString) then
  108.                             MaxBUSize := tempString;
  109.                         if myGetString(515, tempString) then
  110.                             TextType := tempString;
  111.                     end;
  112.                 if myGetString(510, tempString) then
  113.                     BigLogName := tempString;
  114.                 if myGetString(511, tempString) then
  115.                     BriefLogName := tempString;
  116.                 if myGetString(512, tempString) then
  117.                     MsgErrLogName := tempString;
  118.                 if myGetString(513, tempString) then
  119.                     OrphanLogName := tempString;
  120.                 if myGetString(514, tempString) then
  121.                     Separator := tempString;
  122.             end;
  123.  
  124. {    Format for Defaults string is 'XXXXXX', where positions are as follows:    }
  125.  
  126. {        1:    Write to Tabby Log? (Y/N)                        }
  127. {        2:    Full mehit Log? (Y/N)                            }
  128. {        3:    Brief mehit Log? (Y/N)                            }
  129. {        4:    Backup: Normal, Kill after, Purge, Stuff (B/K/P/0..5)    }
  130. {        5:    Log message errors? (Y/N)                        }
  131. {        6:    Undelete Public Messages? (Y/N)                    }
  132. {        7:    Renumber? (Y/N)                                }
  133.  
  134.         if (not newExternalFile) & (GetString(503) <> nil) then
  135.             Defaults := GetString(503)^^
  136.         else
  137.             Defaults := 'YYY3YYY';
  138.         while length(Defaults) < 7 do
  139.             Defaults := concat(Defaults, 'Y');
  140.         UprString(Defaults, false);
  141.  
  142.         with DefaultsPtr^ do
  143.             begin
  144.                 if Defaults[1] = 'Y' then
  145.                     WriteToTabby := true
  146.                 else
  147.                     WriteToTabby := false;
  148.  
  149.                 if Defaults[2] = 'Y' then
  150.                     FullLog := true
  151.                 else
  152.                     FullLog := false;
  153.  
  154.                 if Defaults[3] = 'Y' then
  155.                     BriefLog := true
  156.                 else
  157.                     BriefLog := false;
  158.  
  159.                 case Defaults[4] of
  160.                     'B': 
  161.                         DBackupMode := Normal;
  162.                     'K': 
  163.                         DBackupMode := Kill;
  164.                     'P': 
  165.                         DBackupMode := Purge;
  166.                     '1'..'6': 
  167.                         DBackupMode := BackOpts(ord(Defaults[4]) - ord('0') + 2)
  168.                 end;
  169.  
  170.                 if Defaults[4] in ['1'..'6'] then
  171.                     StuffItMode := ord(Defaults[4]) - ord('0')
  172.                 else
  173.                     StuffItMode := 3;
  174.  
  175.                 if Defaults[5] = 'Y' then
  176.                     LogErrors := true
  177.                 else
  178.                     LogErrors := false;
  179.  
  180.                 if Defaults[6] = 'Y' then
  181.                     Undelete := true
  182.                 else
  183.                     Undelete := false;
  184.  
  185.                 if Defaults[7] = 'Y' then
  186.                     Renumber := true
  187.                 else
  188.                     Renumber := false;
  189.             end;
  190.  
  191. {    Format for User Defaults STR 516 is as follows:                }
  192.  
  193. {        1:    Process UserLog? (Y/N)                            }
  194. {        2:    Delete level? (Y/N)                                }
  195. {        3:    Sort UserLog? (Y/N)                                }
  196. {        4:    Skip deletes? (Y/N)                                }
  197. {        5:    Zero user minutes? (Y/N)                            }
  198. {        6:    Change level? (Y/N)                                }
  199. {        7:    Kill inactive? (Y/N)                            }
  200. {        8:    Log deletes? (Y/N)                                }
  201. {        9:    One-call limit? (Y/N)                            }
  202. {        10:    Use veteran flag? (Y/N)                            }
  203. {        11:    Set (or clear)? (Y/N)                            }
  204. {        after these 11 bytes, remainder of string consists of 9    }
  205. {        numeric values with the folowing separators:                }
  206. {        YYYYYYYYYYY•0•0•0•0•0•0•0•0•0                            }
  207. {                  1 2 3 4 5 6 7 8 9                            }
  208. {        1:    Delete level                                    }
  209. {        2:    Check level                                    }
  210. {        3:    Change level                                    }
  211. {        4:    Change to level                                }
  212. {        5:    Change to minutes                                }
  213. {        6:    Inactive days                                    }
  214. {        7:    One-call days                                    }
  215. {        8;    Veteran calls                                    }
  216. {        9:    Flag to set/clear                                }
  217.  
  218.         if (not newExternalFile) & (GetString(516) <> nil) then
  219.             UserDefaults := GetString(516)^^
  220.         else
  221.             UserDefaults := 'YYYYYYYYYYY•0•10•9•10•25•91•31•20•13';
  222.         UprString(UserDefaults, false);
  223.  
  224.         with DefaultsPtr^ do
  225.             begin
  226.                 if UserDefaults[1] = 'Y' then
  227.                     ProcessUL := true
  228.                 else
  229.                     ProcessUL := false;
  230.                 if UserDefaults[2] = 'Y' then
  231.                     DeleteByLevel := true
  232.                 else
  233.                     DeleteByLevel := false;
  234.                 if UserDefaults[3] = 'Y' then
  235.                     SortUserLog := true
  236.                 else
  237.                     SortUserLog := false;
  238.                 if UserDefaults[4] = 'Y' then
  239.                     SkipDeletes := true
  240.                 else
  241.                     SkipDeletes := false;
  242.                 if UserDefaults[5] = 'Y' then
  243.                     ZeroMin := true
  244.                 else
  245.                     ZeroMin := false;
  246.                 if UserDefaults[6] = 'Y' then
  247.                     DoChangeLevel := true
  248.                 else
  249.                     DoChangeLevel := false;
  250.                 if UserDefaults[7] = 'Y' then
  251.                     KillOld := true
  252.                 else
  253.                     KillOld := false;
  254.                 if UserDefaults[8] = 'Y' then
  255.                     LogDeletes := true
  256.                 else
  257.                     LogDeletes := false;
  258.                 if UserDefaults[9] = 'Y' then
  259.                     KillOldOneCalls := true
  260.                 else
  261.                     KillOldOneCalls := false;
  262.                 if UserDefaults[10] = 'Y' then
  263.                     UseVetFlag := true
  264.                 else
  265.                     UseVetFlag := false;
  266.                 if UserDefaults[11] = 'Y' then
  267.                     SetVetFlag := true
  268.                 else
  269.                     SetVetFlag := false;
  270.  
  271.                 UserDefaults := copy(UserDefaults, pos(BULLET, UserDefaults) + 1, 255);
  272.  
  273.                 DeleteLevel := DecodeBulletValues(UserDefaults);
  274.                 CheckLevel := DecodeBulletValues(UserDefaults);
  275.                 ChangeLevel := DecodeBulletValues(UserDefaults);
  276.                 ChangeToLevel := DecodeBulletValues(UserDefaults);
  277.                 ChangeToMin := DecodeBulletValues(UserDefaults);
  278.                 InactiveDays := DecodeBulletValues(UserDefaults);
  279.                 OneCallDays := DecodeBulletValues(UserDefaults);
  280.                 VetCalls := DecodeBulletValues(UserDefaults);
  281.                 VetFlag := DecodeBulletValues(UserDefaults)
  282.             end;
  283.  
  284. {    Format for Text Defaults STR 517 is as follows:                }
  285.  
  286. {        1:    Reset CallerLog? (Y/N)                            }
  287. {        2:    Keep CallerLog for Days/Month? (D/M)                }
  288. {        3:    Stuff CallerLog? (N, 1..5)                        }
  289. {        4:    Reset Tabby Log? (Y/N)                            }
  290. {        5:    Keep Tabby Log for Days/Month? (D/M)                }
  291. {        6:    Stuff Tabby Log? (N, 1..5)                        }
  292. {        after these 6 bytes, remainder of string consists of 4        }
  293. {        numeric values with the folowing separators:                }
  294. {        YY3YY3•1•10•1•10                                    }
  295. {              1  2 3  4                                    }
  296. {        1:    CL days                                        }
  297. {        2:    CLA days                                        }
  298. {        3:    TL days                                        }
  299. {        4:    TLA days                                        }
  300.  
  301.         if (not newExternalFile) & (GetString(517) <> nil) then
  302.             TextDefaults := GetString(517)^^
  303.         else
  304.             TextDefaults := 'YM2YM2•2•3•2•3';
  305.         UprString(TextDefaults, false);
  306.  
  307.         with DefaultsPtr^ do
  308.             begin
  309.                 if TextDefaults[1] = 'Y' then
  310.                     ResetCL := true
  311.                 else
  312.                     ResetCL := false;
  313.                 if TextDefaults[2] = 'D' then
  314.                     DoCLADays := true
  315.                 else
  316.                     DoCLADays := false;
  317.                 if TextDefaults[3] in ['1'..'6'] then
  318.                     DoCLAStuff := StuffOpts(ord(TextDefaults[3]) - ord('0'))
  319.                 else
  320.                     DoCLAStuff := NoStuff;
  321.                 if TextDefaults[4] = 'Y' then
  322.                     ResetTL := true
  323.                 else
  324.                     ResetTL := false;
  325.                 if TextDefaults[5] = 'D' then
  326.                     DoTLADays := true
  327.                 else
  328.                     DoTLADays := false;
  329.                 if TextDefaults[6] in ['1'..'6'] then
  330.                     DoTLAStuff := StuffOpts(ord(TextDefaults[6]) - ord('0'))
  331.                 else
  332.                     DoTLAStuff := NoStuff;
  333.  
  334.                 TextDefaults := copy(TextDefaults, pos(BULLET, TextDefaults) + 1, 255);
  335.  
  336.                 CLDays := DecodeBulletValues(TextDefaults);
  337.                 CLADays := DecodeBulletValues(TextDefaults);
  338.                 TLDays := DecodeBulletValues(TextDefaults);
  339.                 TLADays := DecodeBulletValues(TextDefaults)
  340.             end;        {    with DefaultsPtr^ do    }
  341.  
  342.         if (not newExternalFile) & (GetString(518) <> nil) then
  343.             NewDefaults := GetString(518)^^
  344.         else
  345.             NewDefaults := '100•61•N';
  346.         with DefaultsPtr^ do
  347.             begin
  348.                 SettingsError := false;
  349.                 newLimit := DecodeBulletValues(NewDefaults);
  350.                 if (newLimit < -1) then
  351.                     SettingsError := true;
  352.                 newAge := DecodeBulletValues(NewDefaults);
  353.                 if (newAge < 0) then
  354.                     SettingsError := true;
  355.                 if EqualString(NewDefaults, 'Y', false, false) then
  356.                     newBU := true
  357.                 else if EqualString(NewDefaults, 'N', false, false) then
  358.                     newBU := false
  359.                 else
  360.                     SettingsError := true;
  361.                 if SettingsError then
  362.                     begin
  363.                         newLimit := 100;
  364.                         newAge := 61;
  365.                         newBU := false
  366.                     end;
  367.             end;
  368.  
  369.         for Counter := 1 to SectionCount do
  370.             if (not newExternalFile) & (GetString(1000 + Sections[Counter]^^.Number) <> nil) then
  371.                 begin
  372.                     Options := GetString(1000 + Sections[Counter]^^.Number)^^;
  373.                     LimitString := copy(Options, 1, pos('&', Options) - 1);
  374.                     StringToNum(LimitString, Sections[Counter]^^.Limit);
  375.                     Options := copy(Options, pos('&', Options) + 1, 255);
  376.                     AgeString := copy(Options, 1, pos('&&', Options) - 1);
  377.                     StringToNum(AgeString, Sections[Counter]^^.Age);
  378.                     BackString := copy(Options, pos('&&', Options) + 2, 1);
  379.                     UprString(BackString, false);
  380.                     if BackString = 'Y' then
  381.                         Sections[Counter]^^.Backup := true
  382.                     else
  383.                         Sections[Counter]^^.Backup := false
  384.                 end
  385.             else        {    GetString(1000 + Sections[Counter]^^.Number) = nil    }
  386.                 with DefaultsPtr^ do
  387.                     begin
  388.                         Sections[Counter]^^.Limit := newLimit;
  389.                         Sections[Counter]^^.Age := newAge;
  390.                         Sections[Counter]^^.Backup := newBU
  391.                     end
  392.     end;        {    Procedure ReadSTRs    }
  393.  
  394. {-----------------------------------------------------------------}
  395.  
  396. procedure TimeAt;
  397.  
  398. {    Inserts the word 'at' in the middle of TimeStamp output    }
  399.  
  400.     var
  401.         SpaceLoc: integer;
  402.         Part1, Part2: STR255;
  403.  
  404.     begin
  405.         TimeStamp;
  406.         SpaceLoc := pos(' ', DateString);
  407.         Part1 := copy(DateString, 1, SpaceLoc - 1);
  408.         Part2 := copy(DateString, SpaceLoc + 1, 255);
  409.         DateString := concat(Part1, ' at ', Part2);
  410.     end;
  411.  
  412. {-----------------------------------------------------------------}
  413.  
  414. function MakeTime (Index: integer; Separator: char): string;
  415.  
  416. { Function changes three chars of DateTimeRecord to formatted time or date string    }
  417.  
  418.     var
  419.         MakeTimeString, LocalTemp: STR255;
  420.  
  421.     begin
  422.         LocalTemp := '';
  423.         NumToString(ord(WhenRcvdString[Index + 1]), LocalTemp);
  424.         if length(LocalTemp) = 1 then
  425.             LocalTemp := concat('0', LocalTemp);
  426.         MakeTimeString := concat(LocalTemp, Separator);
  427.         NumToString(ord(WhenRcvdString[Index + 2]), LocalTemp);
  428.         if length(LocalTemp) = 1 then
  429.             LocalTemp := concat('0', LocalTemp);
  430.         MakeTimeString := concat(MakeTimeString, LocalTemp, Separator);
  431.         NumToString(ord(WhenRcvdString[Index + 3]), LocalTemp);
  432.         if length(LocalTemp) = 1 then
  433.             LocalTemp := concat('0', LocalTemp);
  434.         MakeTime := concat(MakeTimeString, LocalTemp)
  435.     end;
  436.  
  437. {-----------------------------------------------------------------}
  438.  
  439. procedure OpenEnd (TheFile: STR255; var FRefNum: integer; var FileEnd: longint; var Err: OSErr);
  440.  
  441.     begin
  442.         Err := FSOpen(TheFile, DefaultVol, FRefNum);
  443.         if Err = NoErr then
  444.             Err := GetEOF(FRefNum, FileEnd);
  445.         if Err = NoErr then
  446.             Err := SetFPos(FRefNum, fsFromStart, 0);
  447.     end;
  448.  
  449. {-----------------------------------------------------------------}
  450.  
  451. procedure AddCommas (var TempString: STR255);
  452.  
  453.     begin
  454.         case length(TempString) of
  455.             4, 5, 6: 
  456.                 insert(',', TempString, length(TempString) - 2);
  457.  
  458.             7, 8, 9: 
  459.                 begin
  460.                     insert(',', TempString, length(TempString) - 2);
  461.                     insert(',', TempString, length(TempString) - 6);
  462.                 end;
  463.  
  464.             10, 11, 12: 
  465.                 begin
  466.                     insert(',', TempString, length(TempString) - 2);
  467.                     insert(',', TempString, length(TempString) - 6);
  468.                     insert(',', TempString, length(TempString) - 10);
  469.                 end;
  470.  
  471.             otherwise
  472.                 ;
  473.         end;        {    case statement    }
  474.     end;
  475.  
  476. {-----------------------------------------------------------------}
  477.  
  478. procedure ResetFile (TheFile: STR255; MCreator, MType: OSType; var FRefNum: integer; var FSErr: OSErr);
  479.  
  480.     begin
  481.         FSErr := FSDelete(TheFile, DefaultVol);
  482.         FSErr := Create(TheFile, DefaultVol, MType, MCreator);
  483.         if FSErr = NoErr then
  484.             FSErr := FSOpen(TheFile, DefaultVol, FRefNum);
  485.         if FSErr = NoErr then
  486.             FSErr := SetFPos(FRefNum, fsFromStart, 0);
  487.     end;
  488.  
  489. {-----------------------------------------------------------------}
  490.  
  491. {$S Backup}
  492.  
  493. procedure BackupMessages;
  494.  
  495.     const
  496.         Status = 1;
  497.         Section = 7;
  498.         WhenRcvd = 9;
  499.         Active = 1;
  500.         Reply = 2;                    {    Reply flag in Status                }
  501.         MaxTextLength = 30000;        {    Max allowed text size for a message    }
  502.         MsgsSize = 9242;
  503.         HdrSize = 206;
  504.         HdrBufSize = 225;            {    ~45K                        }
  505.         Min = 32000;                {    The following values are used    }
  506.         Med = 64000;                {    to set the size of TBufSize    }
  507.         Max = 96000;
  508.         ManyDashes = '-------------------------------------------------------------------';
  509.  
  510.     type
  511.         MsgsBuf = packed array[1..MsgsSize] of byte;
  512.         MsgsBufPtr = ^MsgsBuf;
  513.         MsgsBufHdl = ^MsgsBufPtr;
  514.         Header = packed record
  515.                 Status: packed array[1..2] of Byte;    {    Use Status[1] only        }
  516.                 MsgNo: longint;
  517.                 Section: packed array[1..2] of Byte;    {    Use Section[1] only        }
  518.                 TimeRcvd: packed array[1..6] of char;
  519.                 MsgFrom: string[31];
  520.                 MsgTo: string[31];
  521.                 MsgSubject: string[41];
  522.                 Destination: string[67];
  523.                 BeginText: longint;
  524.                 LengthText: longint;
  525.                 ReplyTo: longint;
  526.                 TimeSent: packed array[1..6] of char
  527.             end;
  528.         HdrBuf = packed array[1..HdrBufSize] of Header;
  529.         HdrBufPtr = ^HdrBuf;
  530.         HdrBufHdl = ^HdrBufPtr;
  531.  
  532.         SectStat = record
  533.                 limit: integer;
  534.                 age: integer;
  535.                 backup: boolean;
  536.                 count: integer;
  537.                 adjust: integer;
  538.                 deletes: integer;
  539.                 newcount: integer;
  540.             end;
  541.         ThreeLong = packed array[1..3] of longint;
  542.  
  543.     var
  544.         MESSAGES, MSGHDR, MSGTXT, MESSAGESBAK, MSGHDRBAK, MSGTXTBAK: STR255;
  545.         TempString, MsgSeparator: STR255;
  546.         HdrRef, TxtRef, HdrBakRef, TxtBakRef, MsgsRef, MsgsBakRef, TextArcCount: integer;
  547.         BuffCount, DateCounter, Index, TheSection, MsgErrs, Undeletes: integer;
  548.         MsgCount, OldActiveCount, NewActiveCount: integer;
  549.         HBufIn, HBufOut, TFileIn, TFileOut, TBufSize: longint;
  550.         HdrFileEnd, TxtFileEnd, MLoc: longint;
  551.         Counter, HdrRecCount, TxtRecCount, Xfer, TempLong: longint;
  552.         ElapsedTime, NowSecs, NowDays, TempSecs: longint;
  553.         HFileIn, HFileOut, HeaderCount: longint;
  554.         TBufIn, TBufOut, TxLen, TxOffset, BULimit: longint;
  555.         LoMsgNo, HiMsgNo, LastMsgNo, TempDays: longint;
  556.         HdrHdl: HdrBufHdl;
  557.         TxtHdl: Handle;
  558.         MsgsHdl: MsgsBufHdl;
  559.         theDialog, debugDialog: DialogPtr;
  560.         OneByte: byte;
  561.         SectStats: array[1..255] of SectStat;
  562.         Deleted, HeaderErr: boolean;
  563.         DateTime: packed array[1..6] of Byte;
  564.         NowTime, TempTime: DateTimeRec;
  565.         OneHeader: Header;
  566.         ThreeLongs: ThreeLong;
  567.         SpareMem, TestMem: Handle;
  568.         item: handle;
  569.         itemtype: integer;
  570.         box, ProgressBox, StatusBox: rect;
  571.         StatusLength, LineLength, ValidCount: integer;
  572.         Orphans, Valid: boolean;
  573.         OrphanSect: array[1..255] of boolean;
  574.         OrphanTotal: integer;
  575.         MsgFndrInfo: FInfo;
  576.         MsgType, MsgCreator, HdrType, HdrCreator, TxtType, TxtCreator: OSType;
  577.         DisplayCount: integer;
  578.         DLimit, DAge, DBU, DErr: array[1..255] of integer;
  579.  
  580. {-----------------------------------------------------------------    }
  581.  
  582.     procedure NoMem;
  583.  
  584.         var
  585.             MemDialog: DialogPtr;
  586.             MemItem: integer;
  587.  
  588.         begin
  589.             if SpareMem <> nil then
  590.                 DisposHandle(SpareMem);
  591.             MemDialog := GetNewDialog(1003, nil, Pointer(-1));
  592.             SetPort(MemDialog);
  593.             FrameDItem(MemDialog, Ok);
  594.             DrawDialog(MemDialog);
  595.             ModalDialog(nil, MemItem);
  596.             repeat
  597.             until MemItem = 1;
  598.             DisposDialog(MemDialog);
  599.             ExitToShell;
  600.         end;
  601.  
  602. {------------------------------}
  603.  
  604.     procedure FillTxtBuff;
  605.  
  606.         begin
  607.             Err := SetFPos(TxtRef, fsFromStart, TFileIn);
  608.             Xfer := TBufSize;
  609.             Err := FSRead(TxtRef, Xfer, Ptr(TxtHdl^));
  610.             TFileIn := TFileIn + Xfer;
  611.         end;
  612.  
  613. {-----------------------------------------------------------------    }
  614.  
  615.     procedure TransferText;
  616.  
  617.         begin
  618.             if (TBufSize >= (TBufIn + TxLen)) & (TBufSize >= (TBufOut + TxLen)) then
  619.                 begin
  620.                     if TBufIn <> TBufOut then
  621.                         begin
  622.                             MoveHHi(Handle(TxtHdl));
  623.                             HLock(Handle(TxtHdl));
  624.                             MLoc := ord(TxtHdl^);
  625.                             BlockMove(Ptr(MLoc + TBufIn), Ptr(MLoc + TBufOut), Size(TxLen));
  626.                             HUnLock(Handle(TxtHdl));
  627.                         end;    {    if TBufIn <> TBufOut    }
  628.                     TBufOut := TBufOut + TxLen;
  629.                 end
  630.             else    {    (TBufSize < (TBufIn + TxLen)) or (TBufSize < (TBufOut + TxLen))    }
  631.                 begin
  632.                     MoveHHi(Handle(TxtHdl));
  633.                     HLock(Handle(TxtHdl));
  634.                     Xfer := TBufOut;
  635.                     Err := SetFPos(TxtRef, FSFromStart, TFileOut);
  636.                     Err := FSWrite(TxtRef, Xfer, Ptr(TxtHdl^));
  637.                     HUnlock(Handle(TxtHdl));
  638.                     TFileOut := TFileOut + Xfer;
  639.                     TFileIn := OneHeader.BeginText;
  640.                     FillTxtBuff;
  641.                     TxOffset := TFileIn - Xfer;
  642.                     TBufOut := TxLen;
  643.                 end;        {    (TBufSize < (TBufIn + TxLen)) or (TBufSize >= (TBufIn + TxLen))    }
  644.         end;
  645.  
  646. {-----------------------------------------------------------------    }
  647.  
  648.     procedure MsgToText (ThisHeader: Header; TheTxtRef: integer);
  649.  
  650.         var
  651.             ThisSection, ArcFile, NameCount, Count1: integer;
  652.             MBuffSize, TBuffSize: longint;
  653.             Temp1, Temp2, ThisSectName, ThisArchive, MsgTxtString: STR255;
  654.             MSGTXTPos: longint;
  655.             ArcTxtLoc, ArcBuffStart, ArcMLoc, ArcMBuffStart: longint;
  656.             ArcTxtPtr, ArcMBuffPtr: Ptr;
  657.             LengthByte: Byte;
  658.  
  659.         begin
  660.             if MultiFinder then
  661.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  662.             MBuffSize := ThisHeader.LengthText;
  663.  
  664.             ArcMBuffPtr := NewPtr(MBuffSize);
  665.             Err := MemError;
  666.             if Err <> NoErr then
  667.                 NoMem;
  668.             ArcMBuffStart := ord(ArcMBuffPtr);
  669.             ArcMLoc := 0;
  670.  
  671.             TBuffSize := MBuffSize + 270;        {    Extra room for header, tear line    }
  672.  
  673.             ArcTxtPtr := NewPtr(TBuffSize);
  674.             Err := MemError;
  675.             if Err <> NoErr then
  676.                 NoMem;
  677.             ArcBuffStart := ord(ArcTxtPtr);
  678.             ArcTxtLoc := 0;
  679.  
  680.             with ThisHeader do
  681.                 begin
  682.                     ThisSection := Section[1];        {    use 'good' byte    }
  683.                     ThisSectName := '';
  684.                     for NameCount := 1 to SectionCount do
  685.                         if Sections[NameCount]^^.Number = ThisSection then
  686.                             ThisSectName := Sections[NameCount]^^.Name;
  687.                     if ThisSectName <> '' then
  688.                         begin
  689.                             if MultiFinder then
  690.                                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  691.                             ThisArchive := concat(DefaultsPtr^.BUTextPath, ThisSectName, '.txt');
  692.                             MakeTextFile(ThisArchive);
  693.                             Err := FSOpen(ThisArchive, DefaultVol, ArcFile);
  694.                             Err := SetFPos(ArcFile, fsFromLEOF, 0);
  695.                             TempString := concat('Msg. #', stringof(MsgNo : 1), ' in *', ThisSectName, '* ');
  696.                             WhenRcvdString := TimeSent;
  697.                             TempString := concat(TempString, 'Posted on ', MakeTime(0, '/'), ' at ', MakeTime(3, ':'), ENDLINE);
  698.                             LineLength := length(TempString);
  699.                             BlockMove(Ptr(ord(@TempString) + 1), Ptr(ArcBuffStart + ArcTxtLoc), Size(LineLength));
  700.                             ArcTxtLoc := ArcTxtLoc + LineLength;
  701.  
  702.                             TempString := concat('To: ', MsgTo, '   ', 'From: ', MsgFrom, ENDLINE);
  703.                             LineLength := length(TempString);
  704.                             BlockMove(Ptr(ord(@TempString) + 1), Ptr(ArcBuffStart + ArcTxtLoc), Size(LineLength));
  705.                             ArcTxtLoc := ArcTxtLoc + LineLength;
  706.  
  707.                             TempString := concat('Subject: ', MsgSubject, ENDLINE, '    ', ENDLINE);
  708.                             LineLength := length(TempString);
  709.                             BlockMove(Ptr(ord(@TempString) + 1), Ptr(ArcBuffStart + ArcTxtLoc), Size(LineLength));
  710.                             ArcTxtLoc := ArcTxtLoc + LineLength;
  711.  
  712.                             Err := SetFPos(TheTxtRef, fsFromStart, BeginText);
  713.  
  714.                             Err := FSRead(TheTxtRef, MBuffSize, ArcMBuffPtr);
  715.                             ArcMLoc := 0;
  716.  
  717.                             Count1 := 0;
  718.                             while Count1 < LengthText do
  719.                                 begin
  720.                                     if MultiFinder then
  721.                                         IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  722.                                     LengthByte := 0;                    {    make sure *both* bytes are 0    }
  723.                                     BlockMove(Ptr(ArcMBuffStart + ArcMLoc), Ptr(ord(@LengthByte) + 1), 1);
  724.                                     BlockMove(Ptr(ArcMBuffStart + ArcMLoc), Ptr(@MsgTxtString), LengthByte + 1);
  725.                                     ArcMLoc := ArcMLoc + LengthByte + 1;
  726.  
  727.                                     MsgTxtString := concat(MsgTxtString, ENDLINE);
  728.                                     LineLength := length(MsgTxtString);
  729.  
  730.                 {    Next test ignores lines which are too long or which begin with ^A    }
  731.  
  732.                                     if (LineLength < 91) & (MsgTxtString[1] <> chr(1)) then
  733.                                         begin
  734.                                             BlockMove(Ptr(ord(@MsgTxtString) + 1), Ptr(ArcBuffStart + ArcTxtLoc), Size(LineLength));
  735.                                             ArcTxtLoc := ArcTxtLoc + LineLength;
  736.                                         end;
  737.  
  738.                                     Count1 := Count1 + LineLength + 1;
  739.  
  740.                                 end;        {    while Count1 < LengthText    }
  741.  
  742.                             MsgTxtString := concat(MsgSeparator, Separator, ENDLINE, ENDLINE);
  743.                             LineLength := length(MsgTxtString);
  744.                             BlockMove(Ptr(ord(@MsgTxtString) + 1), Ptr(ArcBuffStart + ArcTxtLoc), Size(LineLength));
  745.                             ArcTxtLoc := ArcTxtLoc + LineLength;
  746.                             Err := FSWrite(ArcFile, ArcTxtLoc, ArcTxtPtr);
  747.                             Err := FSClose(ArcFile);
  748.                         end;    {    if ThisSectName <> ''        }
  749.                 end;        {    with ThisHeader do    }
  750.             DisposPtr(ArcMBuffPtr);
  751.             DisposPtr(ArcTxtPtr);
  752.             if MultiFinder then
  753.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  754.         end;            {    procedure MsgToText        }
  755.  
  756. {-----------------------------------------------------------------    }
  757.  
  758.     function MakeReportLn (Str1: STR255; TheNumber: longint; FieldLength: integer; Commas: Boolean): STR255;
  759.  
  760.         var
  761.             Str2: STR255;
  762.  
  763.         begin
  764.             NumToString(TheNumber, Str2);
  765.             if Commas then
  766.                 AddCommas(Str2);
  767.             Str2 := StringOf(Str2 : FieldLength);
  768.             MakeReportLn := concat(Str1, Str2);
  769.         end;
  770.  
  771. {-----------------------------------------------------------------    }
  772.  
  773.     procedure AddALine (AString: STR255);
  774.  
  775.         begin
  776.             LineLength := length(AString);
  777.             BlockMove(Ptr(ord(@AString) + 1), Ptr(MLoc + TFileIn), Size(LineLength));
  778.             TFileIn := TFileIn + LineLength;
  779.         end;
  780.  
  781. {-----------------------------------------------------------------    }
  782.  
  783.     procedure WriteBigReport;
  784.  
  785.         var
  786.             MLogRef, MCount, OldActiveCount, TotalLimits: integer;
  787.             ReportLine: STR255;
  788.             FreeBytes: longint;
  789.             ElapsedMin, ElapsedSec: integer;
  790.  
  791.         begin
  792.             if MultiFinder then
  793.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  794.             HUnLock(Handle(TxtHdl));
  795.             MoveHHi(Handle(TxtHdl));
  796.             HLock(Handle(TxtHdl));
  797.             MLoc := ord(TxtHdl^);
  798.             TFileIn := 0;
  799.             OldActiveCount := 0;
  800.             TotalLimits := 0;
  801.             TimeAt;
  802.             TempString := concat(DefaultsPtr^.DTextPath, BigLogName);
  803.             Err := FSDelete(TempString, DefaultVol);
  804.             MakeTextFile(TempString);
  805.             Err := FSOpen(TempString, DefaultVol, MLogRef);
  806.  
  807.             TempString := concat('                    mehitabel report for ', DateString, ENDLINE, ENDLINE);
  808.             AddALine(TempString);
  809.  
  810.             TempString := concat('                           before  |-------deleted by-------| after    txt', ENDLINE);
  811.             TempString := concat(TempString, '                           active  delete  limit   age    err active   b/u', ENDLINE, ENDLINE);
  812.             AddALine(TempString);
  813.  
  814.             for MCount := 1 to SectionCount do
  815.                 begin
  816.                     if MultiFinder then
  817.                         IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  818.                     ReportLine := Sections[MCount]^^.Name;
  819.                     while length(ReportLine) < 25 do
  820.                         ReportLine := concat(ReportLine, '.');
  821.  
  822.                     OldActiveCount := OldActiveCount + SectStats[Sections[MCount]^^.Number].Count;
  823.                     NumToString(SectStats[Sections[MCount]^^.Number].Count, TempString);
  824.                     while length(TempString) < 7 do
  825.                         TempString := concat('.', TempString);
  826.                     ReportLine := concat(ReportLine, TempString);
  827.  
  828.                     NumToString(SectStats[Sections[MCount]^^.Number].deletes, TempString);
  829.                     TempString := StringOf(TempString : 7);
  830.                     ReportLine := concat(ReportLine, TempString);
  831.  
  832.                     NumToString(DLimit[Sections[MCount]^^.Number], TempString);
  833.                     TempString := StringOf(TempString : 7);
  834.                     ReportLine := concat(ReportLine, TempString);
  835.  
  836.                     NumToString(DAge[Sections[MCount]^^.Number], TempString);
  837.                     TempString := StringOf(TempString : 7);
  838.                     ReportLine := concat(ReportLine, TempString);
  839.  
  840.                     NumToString(DErr[Sections[MCount]^^.Number], TempString);
  841.                     TempString := StringOf(TempString : 7);
  842.                     ReportLine := concat(ReportLine, TempString);
  843.  
  844.                     NumToString(SectStats[Sections[MCount]^^.Number].NewCount, TempString);
  845.                     TempString := StringOf(TempString : 7);
  846.                     ReportLine := concat(ReportLine, TempString);
  847.  
  848.                     NumToString(DBU[Sections[MCount]^^.Number], TempString);
  849.                     TempString := StringOf(TempString : 7);
  850.                     ReportLine := concat(ReportLine, TempString);
  851.  
  852.                     AddALine(concat(ReportLine, ENDLINE));
  853.  
  854.  
  855.                 end;    {    for MCount := 1 to SectionCount    }
  856.  
  857.             ReportLine := MakeReportLn('totals', OldActiveCount, 26, true);
  858.             ReportLine := MakeReportLn(ReportLine, DeleteTotal, 7, true);
  859.             ReportLine := MakeReportLn(ReportLine, SurplusTotal, 7, true);
  860.             ReportLine := MakeReportLn(ReportLine, TooOldTotal, 7, true);
  861.             ReportLine := MakeReportLn(ReportLine, MsgErrs, 7, true);
  862.             ReportLine := MakeReportLn(ReportLine, NewActiveCount, 7, true);
  863.             ReportLine := MakeReportLn(ReportLine, TextArcCount, 7, true);
  864.  
  865.             AddALine(concat(ENDLINE, ReportLine, ENDLINE, ENDLINE));
  866.  
  867.             ReportLine := MakeReportLn('delete total', DeleteTotal + SurplusTotal + TooOldTotal + MsgErrs, 20, true);
  868.             AddALine(concat(ReportLine, ENDLINE));
  869.  
  870.             ReportLine := MakeReportLn('undeleted', Undeletes, 23, true);
  871.             AddALine(concat(ReportLine, ENDLINE));
  872.  
  873.             ReportLine := MakeReportLn('orphan total', OrphanTotal, 20, true);
  874.             AddALine(concat(ReportLine, ENDLINE, ENDLINE));
  875.  
  876.             ReportLine := MakeReportLn('low message #', LoMsgNo, 19, false);
  877.             AddALine(concat(ReportLine, ENDLINE));
  878.  
  879.             ReportLine := MakeReportLn('high message #', HiMsgNo, 18, false);
  880.             AddALine(concat(ReportLine, ENDLINE));
  881.  
  882.             ReportLine := MakeReportLn('message space used', HFileOut + TFileOut + MsgsSize, 14, true);
  883.             AddALine(concat(ReportLine, ' bytes', ENDLINE));
  884.  
  885.             Err := GetVInfo(0, StringPtr(@gVolName), DefaultVol, FreeBytes);
  886.             ReportLine := MakeReportLn('disk space free', FreeBytes, 17, true);
  887.             AddALine(concat(ReportLine, ' bytes', ENDLINE));
  888.  
  889.             ElapsedMin := ElapsedTime div 60;
  890.             ElapsedSec := ElapsedTime mod 60;
  891.             NumToString(ElapsedSec, TempString);
  892.             if length(TempString) = 1 then
  893.                 TempString := concat('0', TempString);
  894.             TempString := StringOf(ElapsedMin : 1, ':', TempString);
  895.             TempString := StringOf(TempString : 20);
  896.             ReportLine := concat('elapsed time', TempString);
  897.             AddALine(concat(ReportLine, ENDLINE));
  898.  
  899.             Err := FSWrite(MLogRef, TFileIn, Ptr(TxtHdl^));
  900.  
  901.             Err := FSClose(MLogRef);
  902.             if MultiFinder then
  903.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  904.         end;
  905.  
  906. {------------------------------}
  907.  
  908.     procedure WriteBriefReport;
  909.  
  910.         var
  911.             MLogRef, MCount: integer;
  912.             ReportLine: STR255;
  913.  
  914.         begin
  915.             if MultiFinder then
  916.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  917.             HUnLock(Handle(TxtHdl));
  918.             MoveHHi(Handle(TxtHdl));
  919.             HLock(Handle(TxtHdl));
  920.             MLoc := ord(TxtHdl^);
  921.             TFileIn := 0;
  922.             TimeAt;
  923.             TempString := concat(DefaultsPtr^.DTextPath, BriefLogName);
  924.             Err := FSDelete(TempString, DefaultVol);
  925.             MakeTextFile(TempString);
  926.             Err := FSOpen(TempString, DefaultVol, MLogRef);
  927.             TempString := concat('BBS Report for ', DateString, ENDLINE, ENDLINE);
  928.             AddALine(TempString);
  929.             for MCount := 1 to SectionCount do
  930.                 begin
  931.                     if MultiFinder then
  932.                         IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  933.                     ReportLine := Sections[MCount]^^.Name;
  934.                     while length(ReportLine) < 25 do
  935.                         ReportLine := concat(ReportLine, '.');
  936.                     NumToString(SectStats[Sections[MCount]^^.Number].NewCount, TempString);
  937.                     while length(TempString) < 7 do
  938.                         TempString := concat('.', TempString);
  939.                     ReportLine := concat(ReportLine, TempString);
  940.                     TempString := concat(ReportLine, ENDLINE);
  941.                     AddALine(TempString);
  942.                 end;        {    for MCount := 1 to SectionCount    }
  943.             ReportLine := 'total';
  944.             NumToString(NewActiveCount, TempString);
  945.             AddCommas(TempString);
  946.             TempString := StringOf(TempString : 27);
  947.             ReportLine := concat(ReportLine, TempString);
  948.             TempString := concat(ENDLINE, ReportLine, ENDLINE);
  949.             AddALine(TempString);
  950.  
  951.             Err := FSWrite(MLogRef, TFileIn, Ptr(TxtHdl^));
  952.  
  953.             Err := FSClose(MLogRef);
  954.             if MultiFinder then
  955.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  956.         end;
  957.  
  958. {------------------------------}
  959.  
  960.     procedure OrphanReport;
  961.  
  962.         var
  963.             OrphanNum, OrphanCount: integer;
  964.             OrphanLog: STR255;
  965.  
  966.         begin
  967.             if MultiFinder then
  968.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  969.             OrphanLog := concat(DefaultsPtr^.DTextPath, OrphanLogName);
  970.             Err := FSDelete(OrphanLog, DefaultVol);
  971.             MakeTextFile(OrphanLog);
  972.             Err := FSOpen(OrphanLog, DefaultVol, OrphanNum);
  973.             Err := SetFPos(OrphanNum, fsFromStart, 0);
  974.             TimeAt;
  975.             TempString := concat('mehitabel orphan report for ', DateString, ENDLINE, ENDLINE);
  976.             TempString := concat(TempString, 'the following undefined message sections contain messages:', ENDLINE);
  977.             Err := WrLn(OrphanNum, TempString);
  978.             for OrphanCount := 1 to 255 do
  979.                 if OrphanSect[OrphanCount] = true then
  980.                     Err := WrLn(OrphanNum, StringOf(OrphanCount : 1));
  981.             Err := FSClose(OrphanNum);
  982.         end;
  983.  
  984. {------------------------------}
  985.  
  986.     procedure LogMsgErrors;
  987.  
  988.         var
  989.             MsgErrLog: STR255;
  990.             MsgErrNum: integer;
  991.  
  992.         begin
  993.             if MultiFinder then
  994.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  995.             MsgErrLog := concat(DefaultsPtr^.DTextPath, MsgErrLogName);
  996.             MakeTextFile(MsgErrLog);
  997.             Err := FSOpen(MsgErrLog, DefaultVol, MsgErrNum);
  998.             Err := SetFPos(MsgErrNum, fsFromLEOF, 0);
  999.             TimeStamp;
  1000.             if (TheSection < 1) | (TheSection > 255) then
  1001.                 begin
  1002.                     TempString := concat(DateString, ' sectiom range error for msg #', stringOf(OneHeader.MsgNo : 1));
  1003.                     TempString := concat(TempString, ' in section ', stringOf(OneHeader.Section[1] : 1));
  1004.                 end
  1005.             else if (OneHeader.MsgNo <= LoMsgNo) | (OneHeader.MsgNo <= HiMsgNo) then
  1006.                 begin
  1007.                     TempString := concat(DateString, ' number error for msg #', stringOf(OneHeader.MsgNo : 1));
  1008.                     TempString := concat(TempString, ' in section ', stringOf(OneHeader.Section[1] : 1));
  1009.                 end
  1010.             else if ((OneHeader.BeginText + OneHeader.LengthText) > TxtFileEnd) then
  1011.                 begin
  1012.                     TempString := concat(DateString, ' location error for msg #', stringOf(OneHeader.MsgNo : 1));
  1013.                     TempString := concat(TempString, ' in section ', stringOf(OneHeader.Section[1] : 1));
  1014.                 end
  1015.             else if (OneHeader.LengthText > MaxTextLength) | (OneHeader.LengthText < 0) then
  1016.                 begin
  1017.                     TempString := concat(DateString, ' text length error for msg #', stringOf(OneHeader.MsgNo : 1));
  1018.                     TempString := concat(TempString, ' in section ', stringOf(OneHeader.Section[1] : 1));
  1019.                 end;
  1020.             Err := WrLn(MsgErrNum, TempString);
  1021.             Err := FSClose(MsgErrNum);
  1022.         end;    {    procedure LogMsgErrors    }
  1023.  
  1024. {------------------------------}
  1025.  
  1026.     procedure TrimTextFiles;
  1027.  
  1028.         var
  1029.             Count1, Count2, Count3, MsgErrNum: integer;
  1030.             FileEnd, InPosition, OutPosition: longint;
  1031.             ThisArchive: STR255;
  1032.             FileError: OSErr;
  1033.  
  1034.         begin
  1035.             if MultiFinder then
  1036.                 IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1037.             TextFont(0);
  1038.             TextSize(12);
  1039.             ForeColor(BlueColor);
  1040.             TempString := 'mehitabel: trimming text…';
  1041.             EraseRect(StatusRect);
  1042.             TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
  1043.             for Count1 := 1 to 255 do
  1044.                 if SectStats[Count1].backup = true then
  1045.                     for Count2 := 1 to SectionCount do
  1046.                         if Sections[Count2]^^.Number = Count1 then
  1047.                             begin
  1048.                                 FileError := NoErr;
  1049.                                 ThisArchive := concat(DefaultsPtr^.BUTextPath, Sections[Count2]^^.Name, '.txt');
  1050.                                 Err := FSOpen(ThisArchive, DefaultVol, TxtRef);
  1051.                                 if Err = NoErr then        {    if there's an error, file doesn't exist    }
  1052.                                     begin
  1053.                                         Err := GetEOF(TxtRef, FileEnd);
  1054.                                         if (FileEnd > BULimit) & (Err = NoErr) then
  1055.                                             begin
  1056.                                                 Count3 := 0;
  1057.                                                 Err := SetFPos(TxtRef, fsFromStart, FileEnd - BULimit);
  1058.                     {    next section skips to end of current message    }
  1059.                                                 repeat
  1060.                                                     if MultiFinder then
  1061.                                                         IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1062.                                                     FileError := ReadLine(TxtRef, TempString);
  1063.                                                     if FileError = NoErr then
  1064.                                                         FileError := GetFPos(TxtRef, InPosition);
  1065.                                                     Count3 := succ(Count3);    {    Limit the number of lines we trash to 400    }
  1066.                                                 until (pos(MsgSeparator, TempString) > 0) | (InPosition >= FileEnd) | (Count3 > 400) | (FileError <> NoErr);
  1067.                                                 if (InPosition < FileEnd) & (FileError = NoErr) & (Err = NoErr) then
  1068.                                                     begin
  1069.                                                         TFileIn := InPosition + 1;
  1070.                                                         OutPosition := 0;
  1071.                                                         while TFileIn < FileEnd do
  1072.                                                             begin
  1073.                                                                 if MultiFinder then
  1074.                                                                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1075.                                                                 FillTxtBuff;        {    FillTxtBuff adjusts TFileIn        }
  1076.                                                                 Err := SetFPos(TxtRef, fsFromStart, OutPosition);
  1077.                                                                 Err := FSWrite(TxtRef, Xfer, Ptr(TxtHdl^));
  1078.                                                                 OutPosition := OutPosition + Xfer;
  1079.                                                             end;        {    while TFileIn < FileEnd    }
  1080.                                                         Err := SetEOF(TxtRef, OutPosition);
  1081.                                                     end;        {    if (InPosition < FileEnd) & (FileError <> NoErr)    }
  1082.                                             end;        {    if FileEnd > BULimit    }
  1083.                                         Err := FSClose(TxtRef);
  1084.                                         if FileEnd = 0 then
  1085.                                             Err := FSDelete(ThisArchive, DefaultVol);
  1086.                                         if DefaultsPtr^.LogErrors & (FileError <> NoErr) then
  1087.                                             begin
  1088.                                                 if MultiFinder then
  1089.                                                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1090.                                                 MakeTextFile(concat(DefaultsPtr^.DTextPath, MsgErrLogName));
  1091.                                                 Err := FSOpen(concat(DefaultsPtr^.DTextPath, MsgErrLogName), DefaultVol, MsgErrNum);
  1092.                                                 Err := SetFPos(MsgErrNum, fsFromLEOF, 0);
  1093.                                                 TimeStamp;
  1094.                                                 TempString := concat(DateString, ' file error in ', DefaultsPtr^.BUTextPath, Sections[Count2]^^.Name, '.txt');
  1095.                                                 Err := WrLn(MsgErrNum, TempString);
  1096.                                                 Err := FSClose(MsgErrNum);
  1097.                                             end;
  1098.                                     end;        {    if no error on open file    }
  1099.                             end;        {    if Sections[Count2]^^.Number = Count1    }
  1100.         end;    {    procedure TrimTextFiles    }
  1101.  
  1102. {------------------------------}
  1103.  
  1104.     function IsActive (var AHeader: Header; LocalPrivSect, NetPrivSect: integer): boolean;
  1105.  
  1106.         const
  1107.             Public = 2;
  1108.  
  1109.         var
  1110.             IsPublic, Undelete: boolean;
  1111.             TempSubject: str255;
  1112.             TempLong: longint;
  1113.  
  1114.         begin
  1115.             IsActive := false;
  1116.             with AHeader do
  1117.                 begin
  1118.                     if (BitAnd(Status[1], Active) = 0) then
  1119.                         IsActive := true
  1120.                     else
  1121.                         begin
  1122.                             if (Section[1] <> LocalPrivSect) & (Section[1] <> NetPrivSect) then
  1123.                                 IsPublic := true
  1124.                             else
  1125.                                 IsPublic := false;
  1126.                             if DefaultsPtr^.Undelete then
  1127.                                 Undelete := true
  1128.                             else
  1129.                                 Undelete := false;
  1130.                             TempSubject := MsgSubject;
  1131.                             uprString(TempSubject, false);
  1132.                             if (Undelete & IsPublic & (pos('DELETE', TempSubject) <> 1)) then
  1133.                                 begin
  1134.                                     Undeletes := succ(Undeletes);
  1135.                                     IsActive := true;
  1136.                                     TempLong := ord(Status[1]);
  1137.                                     BCLR(TempLong, 0);
  1138.                                     Status[1] := ord(TempLong)
  1139.                                 end
  1140.                         end
  1141.                 end
  1142.         end;
  1143.  
  1144. {-----------------------------------------------------------------    }
  1145.  
  1146.     procedure ReadMESSAGES (MESSAGES: str255; var LocalPrivSect, NetPrivSect: integer);
  1147.  
  1148. { Reads MESSAGES file and returns local private and net private section numbers    }
  1149.  
  1150.         const
  1151.             LOCALPRIV = 1;
  1152.             NETPRIV = 3;
  1153.  
  1154.         var
  1155.             MSGRefNum, MSCount, Counter: integer;
  1156.             CharsToSend: longint;
  1157.             MsgByte: byte;
  1158.  
  1159.         begin
  1160.             Counter := 0;
  1161.             Err := FSOpen(MESSAGESPath, DefaultVol, MSGRefNum);
  1162.  
  1163.             for MSCount := 1 to 255 do
  1164.                 begin
  1165.                     if MultiFinder & ((MSCount mod 25) = 0) then
  1166.                         IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1167.                     Err := SetFPos(MSGRefNum, fsFromStart, (97 + (MSCount - 1) * 36));
  1168.                     MsgByte := 0;
  1169.                     CharsToSend := 1;
  1170.                     Err := FSRead(MSGRefNum, CharsToSend, @MsgByte);
  1171.  
  1172.                     MsgByte := MsgByte div 256;
  1173.  
  1174.                     case MsgByte of
  1175.  
  1176.                         NETPRIV: 
  1177.                             NetPrivSect := MSCount;
  1178.  
  1179.                         LOCALPRIV: 
  1180.                             LocalPrivSect := LOCALPRIV;
  1181.  
  1182.                         otherwise
  1183.                             ;
  1184.  
  1185.                     end;    {    case statement    }
  1186.  
  1187.                 end;        {    for MSCount := 1 to 255 do    }
  1188.  
  1189.             Err := FSClose(MSGRefNum);
  1190.         end;
  1191.  
  1192. {-----------------------------------------------------------------    }
  1193.  
  1194.         var
  1195.             LocalPrivSect, NetPrivSect: integer;
  1196.             CurrentNum, ReplyCounter: longint;
  1197.  
  1198.     begin
  1199.         TxtHdl := nil;
  1200.         if FileExists(concat(gDefaultPath, 'mehit debug')) then
  1201.             DEBUG := true
  1202.         else
  1203.             DEBUG := false;
  1204.         theDialog := GetNewDialog(1008, nil, Pointer(-1));
  1205.         setport(theDialog);
  1206.         CenterDLOG(theDialog);
  1207.         if DEBUG then
  1208.             SetupDebug;
  1209.         debugStr1 := 'Beginning';
  1210.         if DEBUG then
  1211.             IncrementDebug;
  1212.         ForeColor(BlueColor);
  1213.         ShowWindow(theDialog);
  1214.         DrawDialog(theDialog);
  1215.         GetDItem(theDialog, 2, ItemType, Item, ProgressBox);    {    UserItem guide for thermometer    }
  1216.         FrameRect(ProgressBox);
  1217.         GetDItem(theDialog, 4, ItemType, Item, StatusRect);    {    UserItem guide for status messages    }
  1218.         TempString := 'mehitabel: backing up…';
  1219.         TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
  1220.         GetDItem(theDialog, 5, ItemType, Item, MsgNoRect);        {    UserItem guide for message numbers    }
  1221.         GetDItem(theDialog, 3, ItemType, Item, Box);            {    Version string box                }
  1222.         TextFont(Geneva);
  1223.         TextSize(9);
  1224.         ForeColor(RedColor);
  1225.         TempString := concat('version ', mehitVersion);
  1226.         TextBox(Pointer(ord(@TempString) + 1), length(TempString), Box, teJustLeft);
  1227.         TextFont(0);
  1228.         TextSize(12);
  1229.         ForeColor(BlueColor);
  1230.  
  1231.         ElapsedTime := TickCount;
  1232.  
  1233.         MsgSeparator := concat(chr(0), chr(0));
  1234.  
  1235.         debugStr1 := 'Hello Tabby';
  1236.         if DEBUG then
  1237.             IncrementDebug;
  1238.  
  1239.         HelloTabby;
  1240.         UnloadSeg(@HelloTabby);
  1241.  
  1242.         if DefaultsPtr <> nil then
  1243.             DefaultsPtr^.DNextLaunch := NextLaunch;
  1244.  
  1245.         SpareMem := NewHandle(10000);    {    Safety net -- this is disposed in error msg    }
  1246.         Err := MemError;
  1247.         if Err <> NoErr then
  1248.             NoMem;
  1249.  
  1250.         debugStr1 := 'Safety net';
  1251.         if DEBUG then
  1252.             IncrementDebug;
  1253.  
  1254.         GetDateTime(NowSecs);
  1255.  
  1256.         if DefaultsPtr^.WriteToTabby then
  1257.             begin
  1258.                 TimeStamp;
  1259.                 Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), DefaultVol, TLogRef);
  1260.                 if Err <> noErr then
  1261.                     begin
  1262.                         Err := Create(concat(gDefaultPath, 'Tabby:Tabby Log'), DefaultVol, DefaultsPtr^.TEXTType, 'TEXT');
  1263.                         Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), DefaultVol, TLogRef);
  1264.                     end;
  1265.                 Err := SetFPos(TLogRef, fsFromLEOF, 0);
  1266.                 Err := WrLn(TLogRef, concat(DateString, ' mehitabel - program starting v.', mehitVersion));
  1267.                 Err := FSClose(TLogRef);
  1268.                 if MultiFinder then
  1269.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1270.             end;
  1271.  
  1272.         debugStr1 := 'Initializing Sect Stats';
  1273.         if DEBUG then
  1274.             IncrementDebug;
  1275.  
  1276.         for Counter := 1 to 255 do
  1277.             begin
  1278.                 SectStats[Counter].limit := 0;
  1279.                 SectStats[Counter].age := 0;
  1280.                 SectStats[Counter].backup := false;
  1281.                 SectStats[Counter].count := 0;
  1282.                 SectStats[Counter].adjust := 0;
  1283.                 SectStats[Counter].deletes := 0;
  1284.                 OrphanSect[Counter] := false;
  1285.                 DLimit[Counter] := 0;
  1286.                 DAge[Counter] := 0;
  1287.                 DBU[Counter] := 0;
  1288.                 DErr[Counter] := 0;
  1289.             end;
  1290.  
  1291.         if MultiFinder then
  1292.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1293.  
  1294.         for Counter := 1 to SectionCount do
  1295.             with Sections[Counter]^^ do
  1296.                 begin
  1297.                     SectStats[Number].Limit := Limit;
  1298.                     SectStats[Number].Age := Age;
  1299.                     SectStats[Number].backup := Backup;
  1300.                 end;
  1301.  
  1302.         if MultiFinder then
  1303.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1304.  
  1305.         debugStr1 := 'Stuffing messages';
  1306.         if DEBUG then
  1307.             IncrementDebug;
  1308.  
  1309.         with DefaultsPtr^ do
  1310.             begin
  1311.                 case DBackupMode of
  1312.                     StuffNone: 
  1313.                         ModeString := 'none';
  1314.                     StuffFaster: 
  1315.                         ModeString := 'faster';
  1316.                     StuffFast: 
  1317.                         ModeString := 'fast';
  1318.                     StuffOptimal: 
  1319.                         ModeString := 'optimal';
  1320.                     StuffBestGuess: 
  1321.                         ModeString := 'best guess';
  1322.                     StuffBetter: 
  1323.                         ModeString := 'better';
  1324.                 end;
  1325.  
  1326.                 if DefaultsPtr^.DBackupMode in [StuffNone..StuffBetter] then
  1327.                     TempString := concat('stuffing [', ModeString, ']')
  1328.                 else
  1329.                     tempString := '';
  1330.                 EraseRect(MsgNoRect);
  1331.                 TextFont(Geneva);
  1332.                 TextSize(9);
  1333.                 ForeColor(RedColor);
  1334.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
  1335.                 TextFont(0);
  1336.                 TextSize(12);
  1337.                 ForeColor(BlueColor);
  1338.                 StuffMessages;
  1339.             end;
  1340.         UnloadSeg(@StuffMessages);
  1341.  
  1342.         debugStr1 := 'Setting Message paths';
  1343.         if DEBUG then
  1344.             IncrementDebug;
  1345.  
  1346.         MESSAGES := MESSAGESPath;
  1347.         MSGHDR := concat(MsgPath, 'MSGHDR');
  1348.         MSGTXT := concat(MsgPath, 'MSGTXT');
  1349.  
  1350.         with DefaultsPtr^ do
  1351.             begin
  1352.                 if DBackupPath <> '' then
  1353.                     begin
  1354.                         if DBackupPath[length(DBackupPath)] <> ':' then
  1355.                             DBackupPath := concat(DBackupPath, ':');
  1356.                         MESSAGESBAK := concat(DBackupPath, 'MESSAGES.Bak');
  1357.                         MSGHDRBAK := concat(DBackupPath, 'MSGHDR.Bak');
  1358.                         MSGTXTBAK := concat(DBackupPath, 'MSGTXT.Bak');
  1359.                     end
  1360.                 else
  1361.                     begin
  1362.                         MESSAGESBAK := concat(MESSAGESPath, '.Bak');
  1363.                         MSGHDRBAK := concat(MsgPath, 'MSGHDR.Bak');
  1364.                         MSGTXTBAK := concat(MsgPath, 'MSGTXT.Bak');
  1365.                     end;
  1366.             end;
  1367.  
  1368.         if MultiFinder then
  1369.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1370.  
  1371.         debugStr1 := 'Reading MESSAGES';
  1372.         if DEBUG then
  1373.             IncrementDebug;
  1374.  
  1375.         ReadMESSAGES(MESSAGES, LocalPrivSect, NetPrivSect);
  1376.  
  1377.         if MultiFinder then
  1378.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1379.  
  1380.         if not (Defaults[4] in ['P', '0'..'5']) then
  1381.             begin
  1382.                 TempString := 'messages';
  1383.                 TextFont(Geneva);
  1384.                 TextSize(9);
  1385.                 ForeColor(RedColor);
  1386.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
  1387.                 ForeColor(BlueColor);
  1388.                 MsgsHdl := MsgsBufHdl(NewHandle(sizeOf(MsgsBuf)));
  1389.                 Err := MemError;
  1390.                 if Err <> NoErr then
  1391.                     NoMem;
  1392.                 Err := GetFInfo(MESSAGES, DefaultVol, MsgFndrInfo);
  1393.                 MsgType := MsgFndrInfo.fdType;
  1394.                 MsgCreator := MsgFndrInfo.fdCreator;
  1395.  
  1396.                 OpenEnd(MESSAGES, MsgsRef, TempLong, Err);
  1397.                 ResetFile(MESSAGESBAK, MsgType, MsgCreator, MsgsBakRef, Err);
  1398.                 Xfer := MsgsSize;
  1399.                 Err := FSRead(MsgsRef, Xfer, Ptr(MsgsHdl^));
  1400.                 Err := FSWrite(MsgsBakRef, Xfer, Ptr(MsgsHdl^));
  1401.                 Err := FSClose(MsgsRef);
  1402.                 Err := FSClose(MsgsBakRef);
  1403.                 if (MsgsHdl <> nil) then
  1404.                     begin
  1405.                         DisposHandle(Handle(MsgsHdl));
  1406.                         MsgsHdl := nil
  1407.                     end;
  1408.                 if MultiFinder then
  1409.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1410.             end;    {    if not (Defaults[4] in ['P', '0'..'5'])    }
  1411.  
  1412.         StatusBox := ProgressBox;
  1413.         InsetRect(StatusBox, 1, 1);
  1414.         StatusLength := StatusBox.right - StatusBox.left;
  1415.         StatusBox.right := (StatusBox.left + StatusLength div 20);
  1416.         FillRect(StatusBox, Gray);
  1417.  
  1418.         OpenEnd(MSGHDR, HdrRef, HdrFileEnd, Err);
  1419.         if not (Defaults[4] in ['P', '0'..'5']) then
  1420.             begin
  1421.                 TempString := 'msghdr';
  1422.                 EraseRect(MsgNoRect);
  1423.                 ForeColor(RedColor);
  1424.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
  1425.                 ForeColor(BlueColor);
  1426.                 Err := GetFInfo(MSGHDR, DefaultVol, MsgFndrInfo);
  1427.                 HdrType := MsgFndrInfo.fdType;
  1428.                 HdrCreator := MsgFndrInfo.fdCreator;
  1429.                 ResetFile(MSGHDRBAK, HdrType, HdrCreator, HdrBakRef, Err);
  1430.                 if MultiFinder then
  1431.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1432.             end;
  1433.  
  1434.         OpenEnd(MSGTXT, TxtRef, TxtFileEnd, Err);
  1435.  
  1436.         BeginTotal := HdrFileEnd div HdrSize;
  1437.         HdrRecCount := HdrFileEnd div sizeof(HdrBuf);
  1438.  
  1439.         HdrHdl := HdrBufHdl(NewHandle(sizeOf(HdrBuf)));
  1440.         Err := MemError;
  1441.         if Err <> NoErr then
  1442.             NoMem;
  1443.         MoveHHi(Handle(HdrHdl));
  1444.         HLock(Handle(HdrHdl));
  1445.  
  1446.         TestMem := nil;
  1447.         if Err <> NoErr then
  1448.             TestMem := NewHandle(Max);
  1449.         Err := MemError;
  1450.         if Err <> NoErr then
  1451.             begin
  1452.                 if (TestMem <> nil) then
  1453.                     DisposHandle(TestMem);
  1454.                 TestMem := NewHandle(Med);
  1455.                 Err := MemError;
  1456.                 if Err <> NoErr then
  1457.                     begin
  1458.                         if (TestMem <> nil) then
  1459.                             DisposHandle(TestMem);
  1460.                         TestMem := NewHandle(Min);
  1461.                         Err := MemError;
  1462.                         if Err <> NoErr then
  1463.                             NoMem
  1464.                         else
  1465.                             TBufSize := Min
  1466.                     end
  1467.                 else
  1468.                     TBufSize := Med
  1469.             end
  1470.         else
  1471.             TBufSize := Max;
  1472.         if (TestMem <> nil) then
  1473.             DisposHandle(TestMem);
  1474.  
  1475.         if MultiFinder then
  1476.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1477.  
  1478.         debugStr1 := 'Got memory';
  1479.         if DEBUG then
  1480.             IncrementDebug;
  1481.  
  1482.         TxtHdl := NewHandle(TBufSize);
  1483.         Err := MemError;
  1484.         if Err <> NoErr then
  1485.             NoMem;
  1486.  
  1487.         MoveHHi(Handle(TxtHdl));
  1488.         HLock(Handle(TxtHdl));
  1489.  
  1490.         debugStr1 := 'Got buffer';
  1491.         if DEBUG then
  1492.             IncrementDebug;
  1493.  
  1494. {    Next section reads HdrRecCount + 1 records -- the + 1 makes sure it        }
  1495. {    grabs the last part of the file, since Xfer is automatically        }
  1496. {    adjusted by FSRead to reflect actual numbers of characters read.        }
  1497.  
  1498.         for Counter := 1 to HdrRecCount + 1 do
  1499.             begin
  1500.                 if MultiFinder then
  1501.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1502.                 Xfer := sizeof(HdrBuf);
  1503.                 Err := FSRead(HdrRef, Xfer, Ptr(HdrHdl^));
  1504.                 if not (Defaults[4] in ['P', '0'..'5']) then
  1505.                     Err := FSWrite(HdrBakRef, Xfer, Ptr(HdrHdl^));
  1506.                 HeaderCount := Xfer div HdrSize;
  1507.                 for BuffCount := 1 to HeaderCount do
  1508.                     begin
  1509.                         if MultiFinder then
  1510.                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1511.                         OneHeader := HdrHdl^^[BuffCount];
  1512.                         TheSection := OneHeader.Section[1];
  1513.                         if IsActive(OneHeader, LocalPrivSect, NetPrivSect) then
  1514.                             SectStats[TheSection].count := succ(SectStats[TheSection].count);
  1515.                     end;        {    for BuffCount := 1 to (Xfer div HdrSize)    }
  1516.             end;        {    for Counter := 1 to HdrRecCount + 1                }
  1517.         if not (Defaults[4] in ['P', '0'..'5']) then
  1518.             Err := FSClose(HdrBakRef);
  1519.  
  1520.         if DEBUG then
  1521.             IncrementDebug;
  1522.  
  1523.         StatusBox.right := (StatusBox.left + StatusLength div 5);
  1524.         FillRect(StatusBox, gray);
  1525.  
  1526.         if not (Defaults[4] in ['P', '0'..'5']) then
  1527.             begin
  1528.                 if MultiFinder then
  1529.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1530.                 TempString := 'msgtxt';
  1531.                 EraseRect(MsgNoRect);
  1532.                 ForeColor(RedColor);
  1533.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
  1534.                 ForeColor(BlueColor);
  1535.                 TFileIn := 0;
  1536.                 TFileOut := 0;
  1537.                 Err := GetFInfo(MSGTXT, DefaultVol, MsgFndrInfo);
  1538.                 TxtType := MsgFndrInfo.fdType;
  1539.                 TxtCreator := MsgFndrInfo.fdCreator;
  1540.                 ResetFile(MSGTXTBAK, TxtType, TxtCreator, TxtBakRef, Err);
  1541.                 TxtRecCount := TxtFileEnd div TBufSize;
  1542.                 if TxtRecCount > 0 then
  1543.                     begin
  1544.                         for Counter := 1 to TxtRecCount + 1 do
  1545.                             begin
  1546.                                 if MultiFinder then
  1547.                                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1548.                                 FillTxtBuff;
  1549.                                 Err := SetFPos(TxtBakRef, FSFromStart, TFileOut);
  1550.                                 Err := FSWrite(TxtBakRef, Xfer, Ptr(TxtHdl^));
  1551.                                 TFileOut := TFileOut + Xfer;
  1552.                                 StatusBox.right := (StatusBox.left + StatusLength div 5 + ((StatusLength * 8 * Counter) div (10 * TxtRecCount)));
  1553.                                 if StatusBox.right > StatusBox.left + StatusLength then
  1554.                                     StatusBox.right := StatusBox.left + StatusLength;
  1555.                                 FillRect(StatusBox, gray);
  1556.                             end;        {    for Counter := 1 to TxtRecCount + 1    }
  1557.                     end;            {    if TxtRecCount > 0    }
  1558.                 Err := FSClose(TxtBakRef);
  1559.             end;        {    if not (Defaults[4] in ['P', '0'..'5'])    }
  1560.  
  1561.         if DEBUG then
  1562.             IncrementDebug;
  1563.  
  1564.         StatusBox.right := StatusBox.left + StatusLength;
  1565.         FillRect(StatusBox, gray);
  1566.  
  1567.         HUnLock(Handle(TxtHdl));
  1568.  
  1569.         for Counter := 1 to 255 do
  1570.             begin
  1571.                 if MultiFinder & ((Counter mod 25) = 0) then
  1572.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1573.                 SectStats[Counter].newcount := SectStats[Counter].count;
  1574.                 if SectStats[Counter].Limit = 0 then
  1575.                     SectStats[Counter].Adjust := 0
  1576.                 else if SectStats[Counter].Limit = -1 then
  1577.                     SectStats[Counter].Adjust := 30000            {    Big number deletes all    }
  1578.                 else if SectStats[Counter].Count > SectStats[Counter].Limit then
  1579.                     SectStats[Counter].Adjust := SectStats[Counter].Count - SectStats[Counter].Limit
  1580.                 else
  1581.                     SectStats[Counter].Adjust := 0
  1582.             end;
  1583.  
  1584.         if MultiFinder then
  1585.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1586.  
  1587.         if DEBUG then
  1588.             IncrementDebug;
  1589.  
  1590.         DrawDialog(theDialog);
  1591.         TextFont(Geneva);
  1592.         TextSize(9);
  1593.         ForeColor(RedColor);
  1594.         TempString := concat('version ', mehitVersion);
  1595.         TextBox(Pointer(ord(@TempString) + 1), length(TempString), Box, teJustLeft);
  1596.         ForeColor(BlueColor);
  1597.         GetDItem(theDialog, 2, ItemType, Item, ProgressBox);    {    UserItem guide for thermometer    }
  1598.         FrameRect(ProgressBox);
  1599.  
  1600.         TextFont(0);
  1601.         TextSize(12);
  1602.         TempString := 'mehitabel: cleaning…';
  1603.         EraseRect(StatusRect);
  1604.         TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
  1605.         TextFont(Monaco);
  1606.         TextSize(9);
  1607.         ForeColor(RedColor);
  1608.         HFileIn := 0;
  1609.         HFileOut := 0;
  1610.         HBufOut := 0;
  1611.         TFileIn := 0;
  1612.         TFileOut := 0;
  1613.         TBufOut := 0;
  1614.         SurplusTotal := 0;
  1615.         TooOldTotal := 0;
  1616.         DeleteTotal := 0;
  1617.         LoMsgNo := 0;
  1618.         HiMsgNo := 0;
  1619.         MsgErrs := 0;
  1620.         TextArcCount := 0;
  1621.         Orphans := false;
  1622.         OrphanTotal := 0;
  1623.         DisplayCount := 10;
  1624.         OneHeader.MsgNo := 0;        {    display garbage preventer if there are no active headers    }
  1625.         Undeletes := 0;
  1626.         CurrentNum := 1;
  1627.         FillTxtBuff;
  1628.         TxOffset := 0;        {    Use to track buffer to text in file    }
  1629.  
  1630.         if DefaultsPtr^.Renumber then
  1631.             myMNAHdl := MNAHdl(newHandle(SizeOf(MNA) + (SizeOf(OldNum) * (HdrRecCount - 1))));
  1632.         Err := MemError;
  1633.         if Err <> NoErr then
  1634.             NoMem;
  1635.  
  1636.         debugStr1 := 'Doing headers';
  1637.         if DEBUG then
  1638.             IncrementDebug;
  1639.  
  1640.         for Counter := 1 to HdrRecCount + 1 do
  1641.             begin
  1642.                 if MultiFinder then
  1643.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1644.                 Xfer := sizeof(HdrBuf);
  1645.                 StatusBox.right := (StatusBox.left + ((StatusLength * Counter) div (HdrRecCount + 2)));
  1646.                 if StatusBox.right > StatusBox.left + StatusLength then
  1647.                     StatusBox.right := StatusBox.left + StatusLength;
  1648.                 ForeColor(BlueColor);
  1649.                 FillRect(StatusBox, black);
  1650.                 ForeColor(RedColor);
  1651.                 Err := SetFPos(HdrRef, FSFromStart, HFileIn);
  1652.                 Err := FSRead(HdrRef, Xfer, Ptr(HdrHdl^));
  1653.                 HFileIn := HFileIn + Xfer;
  1654.                 HeaderCount := Xfer div HdrSize;
  1655.                 HBufOut := 0;
  1656.                 HBufIn := 0;
  1657.                 for BuffCount := 1 to HeaderCount do
  1658.                     begin
  1659.                         if MultiFinder then
  1660.                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1661.                         OneHeader := HdrHdl^^[BuffCount];
  1662.                         if OneHeader.Section[1] < 1 then
  1663.                             OneHeader.Section[1] := 255;
  1664.                         TheSection := OneHeader.Section[1];
  1665.  
  1666.                         if DisplayCount = 10 then
  1667.                             begin
  1668.                                 TempString := StringOf(OneHeader.MsgNo : 1);
  1669.                                 EraseRect(MsgNoRect);
  1670.                                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
  1671.                                 DisplayCount := 1;
  1672.                             end
  1673.                         else
  1674.                             DisplayCount := succ(DisplayCount);
  1675.  
  1676.                         Deleted := false;
  1677.                         HeaderErr := false;
  1678.                         Valid := false;
  1679.  
  1680.                         for ValidCount := 1 to SectionCount do
  1681.                             if Sections[ValidCount]^^.Number = TheSection then
  1682.                                 begin
  1683.                                     Valid := true;
  1684.                                     Leave
  1685.                                 end;
  1686.  
  1687.                         if MultiFinder then
  1688.                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1689.  
  1690.                         if not Valid then
  1691.                             begin
  1692.                                 Orphans := true;
  1693.                                 OrphanSect[TheSection] := true;
  1694.                                 OrphanTotal := succ(OrphanTotal);
  1695.                             end;
  1696.  
  1697.                         if (OneHeader.MsgNo < LoMsgNo) | (OneHeader.MsgNo > HiMsg) then
  1698.                             HeaderErr := true
  1699.                         else if (OneHeader.BeginText + OneHeader.LengthText) > TxtFileEnd then
  1700.                             HeaderErr := true
  1701.                         else if OneHeader.LengthText > MaxTextLength then
  1702.                             HeaderErr := true
  1703.                         else if (OneHeader.BeginText < 0) | (OneHeader.LengthText < 0) then
  1704.                             HeaderErr := true;
  1705.  
  1706.                         if HeaderErr = true then
  1707.                             begin
  1708.                                 Deleted := true;
  1709.                                 MsgErrs := succ(MsgErrs);
  1710.                                 DErr[TheSection] := succ(DErr[TheSection]);
  1711.                                 if SectStats[TheSection].Adjust > 0 then
  1712.                                     SectStats[TheSection].Adjust := pred(SectStats[TheSection].Adjust);
  1713.                                 SectStats[TheSection].NewCount := pred(SectStats[TheSection].NewCount);
  1714.                                 if DefaultsPtr^.LogErrors then
  1715.                                     LogMsgErrors;
  1716.                             end;
  1717.                         if Valid & (HeaderErr = false) then
  1718.                             begin
  1719.             {*** altered 6/18/90 to not delete last message w/ (OneHeader.MsgNo < HiMsg) ***}
  1720.             {*** altered 2/10/91 to undelete public messages on request ***}
  1721.                                 if (not IsActive(OneHeader, LocalPrivSect, NetPrivSect)) & (OneHeader.MsgNo < HiMsg) then
  1722.                                     begin        {don't clip last message -- leave for next time!}
  1723.                                         Deleted := true;
  1724.                                         DeleteTotal := succ(DeleteTotal);
  1725.                                         SectStats[TheSection].Deletes := succ(SectStats[TheSection].Deletes);
  1726.                                     end
  1727.                                 else if SectStats[TheSection].Adjust > 0 then    {    adjust limit    }
  1728.                                     begin
  1729.                                         Deleted := true;
  1730.                                         DLimit[TheSection] := succ(DLimit[TheSection]);
  1731.                                         SectStats[TheSection].Adjust := pred(SectStats[TheSection].Adjust);
  1732.                                         SectStats[TheSection].NewCount := pred(SectStats[TheSection].NewCount);
  1733.                                         SurplusTotal := succ(SurplusTotal);
  1734.                                     end
  1735.                                 else if SectStats[TheSection].Age > 0 then    {    check age    }
  1736.                                     begin
  1737.                                         with TempTime do
  1738.                                             begin
  1739.                                                 month := ord(OneHeader.TimeRcvd[1]);
  1740.                                                 day := ord(OneHeader.TimeRcvd[2]);
  1741.                                                 year := ord(OneHeader.TimeRcvd[3]) + 1900;
  1742.                                                 hour := ord(OneHeader.TimeRcvd[4]);
  1743.                                                 minute := ord(OneHeader.TimeRcvd[5]);
  1744.                                                 second := ord(OneHeader.TimeRcvd[6]);
  1745.                                                 dayOfWeek := 1;
  1746.                                             end;        {    with TempTime    }
  1747.                                         Date2Secs(TempTime, TempSecs);
  1748.  
  1749.                                         if ((NowSecs - TempSecs) div DAYSECS) > SectStats[TheSection].Age then
  1750.                                             begin
  1751.                                                 Deleted := true;
  1752.                                                 DAge[TheSection] := succ(DAge[TheSection]);
  1753.                                                 if SectStats[TheSection].Adjust > 0 then
  1754.                                                     SectStats[TheSection].Adjust := pred(SectStats[TheSection].Adjust);
  1755.                                                 SectStats[TheSection].NewCount := pred(SectStats[TheSection].NewCount);
  1756.                                                 TooOldTotal := succ(TooOldTotal)
  1757.                                             end
  1758.                                     end    {    check age    }
  1759.                             end;    {    if Valid & (HeaderErr = false)    }
  1760.  
  1761.                         if MultiFinder then
  1762.                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1763.  
  1764.                         if not Deleted then
  1765.                             begin
  1766.                                 if DefaultsPtr^.Renumber then
  1767.                                     begin
  1768.                                         if MultiFinder then
  1769.                                             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1770.                                         SetHandleSize(Handle(myMNAHdl), (SizeOf(MNA) + (SizeOf(OldNum) * (CurrentNum - 1))));
  1771.                                         MoveHHi(Handle(myMNAHdl));
  1772.                                         HLock(Handle(myMNAHdl));
  1773.                                         myMNAHdl^^.OldNumbers[CurrentNum] := OneHeader.MsgNo;
  1774.                                         myMNAHdl^^.HowMany := CurrentNum;
  1775.                                         OneHeader.MsgNo := CurrentNum;
  1776.                                         CurrentNum := succ(CurrentNum);
  1777.                                         if (BitAnd(OneHeader.Status[1], Reply) = Reply) then        {    message is a reply                }
  1778.                                             begin
  1779.                                                 ReplyCounter := 0;
  1780.                                                 repeat
  1781.                                                     ReplyCounter := succ(ReplyCounter);
  1782.                                                 until (OneHeader.ReplyTo = myMNAHdl^^.OldNumbers[ReplyCounter]) | (ReplyCounter = CurrentNum);        {    old number in first array        }
  1783.                                                 if (OneHeader.ReplyTo = myMNAHdl^^.OldNumbers[ReplyCounter]) then
  1784.                                                     OneHeader.ReplyTo := ReplyCounter
  1785.                                                 else
  1786.                                                     OneHeader.Status[1] := BitAnd(OneHeader.Status[1], BitNot(Reply))
  1787.                                             end;        {    if (BitAnd(OneHeader.Status[1], Reply) = Reply)    }
  1788.                                         HUnlock(Handle(myMNAHdl));
  1789.                                         with HdrHdl^^[BuffCount] do
  1790.                                             begin
  1791.                                                 MsgNo := OneHeader.MsgNo;
  1792.                                                 ReplyTo := OneHeader.ReplyTo
  1793.                                             end;
  1794.                                     end;
  1795.                                 if LoMsgNo = 0 then
  1796.                                     LoMsgNo := OneHeader.MsgNo;
  1797.                                 HiMsgNo := OneHeader.MsgNo;
  1798.                                 TBufIn := OneHeader.BeginText - TxOffset;
  1799.                                 TxLen := OneHeader.LengthText;
  1800.                                 with HdrHdl^^[BuffCount] do
  1801.                                     begin
  1802.                                         BeginText := TFileOut + TBufOut;
  1803.                                         Status := OneHeader.Status;
  1804.                                     end;
  1805.  
  1806.                                 TransferText;
  1807.  
  1808.                                 if HBufOut <> HBufIn then
  1809.                                     begin
  1810.                                         MLoc := ord(HdrHdl^);
  1811.                                         BlockMove(Ptr(MLoc + HBufIn), Ptr(MLoc + HBufOut), Size(HdrSize));
  1812.                                     end;    {    if HBufOut < HBufIn        }
  1813.                                 HBufOut := HBufOut + HdrSize;
  1814.                             end    {    if not deleted    }
  1815.                         else if (SectStats[TheSection].Backup = true) & (HeaderErr = false) then
  1816.                             begin
  1817.                                 MsgToText(OneHeader, TxtRef);
  1818.                                 TextArcCount := succ(TextArcCount);
  1819.                                 DBU[TheSection] := succ(DBU[TheSection]);
  1820.                             end;
  1821.                         HBufIn := HBufIn + HdrSize;
  1822.  
  1823.                     end;    {    for BuffCount := 1 to (Xfer div HdrSize)    }
  1824.  
  1825.                 Err := SetFPos(HdrRef, FSFromStart, HFileOut);
  1826.                 Err := FSWrite(HdrRef, HBufOut, Ptr(HdrHdl^));
  1827.                 HFileOut := HFileOut + HBufOut;
  1828.             end;        {    for Counter := 1 to HdrRecCount + 1    }
  1829.  
  1830.         debugStr1 := 'Done with headers';
  1831.         if DEBUG then
  1832.             IncrementDebug;
  1833.  
  1834.         Xfer := TBufOut;
  1835.         Err := SetFPos(TxtRef, FSFromStart, TFileOut);
  1836.         MoveHHi(Handle(TxtHdl));
  1837.         HLock(Handle(TxtHdl));
  1838.         Err := FSWrite(TxtRef, Xfer, Ptr(TxtHdl^));
  1839.         TFileOut := TFileOut + Xfer;
  1840.  
  1841.         Err := SetEOF(HdrRef, HFileOut);
  1842.         Err := SetEOF(TxtRef, TFileOut);
  1843.  
  1844.         Err := FSClose(HdrRef);
  1845.         Err := FSClose(TxtRef);
  1846.  
  1847.         if MultiFinder then
  1848.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1849.  
  1850.         NewActiveCount := 0;
  1851.         for MsgCount := 1 to SectionCount do
  1852.             NewActiveCount := NewActiveCount + SectStats[Sections[MsgCount]^^.Number].NewCount;
  1853.         NewActiveCount := NewActiveCount + OrphanTotal;
  1854.  
  1855.         {    Update message counter with last message number    }
  1856.         TempString := StringOf(OneHeader.MsgNo : 1);
  1857.         EraseRect(MsgNoRect);
  1858.         TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
  1859.  
  1860.         if (HdrHdl <> nil) then
  1861.             begin
  1862.                 HUnlock(Handle(HdrHdl));
  1863.                 DisposHandle(Handle(HdrHdl));
  1864.             end;
  1865.  
  1866.         if NewActiveCount = 0 then
  1867.             begin                            {    if there are no active messages, Host    }
  1868.                 LoMsgNo := $00FFFFFF;                {    expects the low number to be 00FFFFFF    }
  1869.                 HiMsgNo := 0;
  1870.             end;
  1871.  
  1872.         if MultiFinder then
  1873.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1874.  
  1875.         debugStr1 := 'Updating message counts';
  1876.         if DEBUG then
  1877.             IncrementDebug;
  1878.  
  1879.         Err := FSOpen(MESSAGES, DefaultVol, MsgsRef);
  1880.         Err := SetFPos(MsgsRef, fsFromStart, 50);
  1881.         ThreeLongs[1] := LoMsgNo;
  1882.         ThreeLongs[2] := HiMsgNo;
  1883.         ThreeLongs[3] := TFileOut;
  1884.         Xfer := 12;
  1885.         Err := FSWrite(MsgsRef, Xfer, @ThreeLongs);
  1886.         Err := FSClose(MsgsRef);
  1887.  
  1888.         if LoMsgNo = $00FFFFFF then            {    restore zero value for reports        }
  1889.             LoMsgNo := 0;
  1890.  
  1891.         if Defaults[4] = 'K' then
  1892.             begin
  1893.                 Err := FSDelete(MESSAGESBAK, DefaultVol);
  1894.                 Err := FSDelete(MSGHDRBAK, DefaultVol);
  1895.                 Err := FSDelete(MSGTXTBAK, DefaultVol);
  1896.             end;
  1897.  
  1898.         StringToNum(DefaultsPtr^.MaxBUSize, BULimit);
  1899.         if BULimit > 0 then
  1900.             begin
  1901.                 BULimit := 1024 * BULimit;
  1902.                 TrimTextFiles;
  1903.             end;
  1904.  
  1905.         SetPort(theDialog);
  1906.         StatusBox.right := StatusBox.left + StatusLength;
  1907.         ForeColor(BlueColor);
  1908.         FillRect(StatusBox, black);
  1909.  
  1910.         debugStr1 := 'Writing reports';
  1911.         if DEBUG then
  1912.             IncrementDebug;
  1913.  
  1914.         if Orphans = true then
  1915.             OrphanReport;
  1916.  
  1917.         ElapsedTime := (TickCount - ElapsedTime) div 60;
  1918.  
  1919.         if DEBUG then
  1920.             IncrementDebug;
  1921.  
  1922.         TextFont(0);
  1923.         TextSize(12);
  1924.         if DefaultsPtr^.FullLog then
  1925.             begin
  1926.                 TempString := 'mehitabel: writing report…';
  1927.                 EraseRect(StatusRect);
  1928.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
  1929.                 WriteBigReport;
  1930.             end;
  1931.  
  1932.         if MultiFinder then
  1933.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1934.  
  1935.         if DEBUG then
  1936.             IncrementDebug;
  1937.  
  1938.         if DefaultsPtr^.BriefLog then
  1939.             begin
  1940.                 if MultiFinder then
  1941.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1942.                 TempString := 'mehitabel: writing report…';
  1943.                 EraseRect(StatusRect);
  1944.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
  1945.                 WriteBriefReport;
  1946.             end;
  1947.  
  1948.         if DEBUG then
  1949.             IncrementDebug;
  1950.  
  1951.         if DefaultsPtr^.WriteToTabby then
  1952.             begin
  1953.                 if MultiFinder then
  1954.                     IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
  1955.                 TempString := 'mehitabel: writing log…';
  1956.                 EraseRect(StatusRect);
  1957.                 TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
  1958.                 OldActiveCount := 0;
  1959.                 for MsgCount := 1 to SectionCount do
  1960.                     OldActiveCount := OldActiveCount + SectStats[Sections[MsgCount]^^.Number].Count;
  1961.                 TimeStamp;
  1962.  
  1963.                 HUnLock(Handle(TxtHdl));
  1964.                 MoveHHi(Handle(TxtHdl));
  1965.                 HLock(Handle(TxtHdl));
  1966.                 MLoc := ord(TxtHdl^);
  1967.                 TFileIn := 0;
  1968.  
  1969.                 TempString := concat(DateString, ' mehitabel - ', StringOf(OldActiveCount + DeleteTotal : 1), ' messages processed', ENDLINE);
  1970.                 LineLength := length(TempString);
  1971.                 BlockMove(Ptr(ord(@TempString) + 1), Ptr(MLoc + TFileIn), Size(LineLength));
  1972.                 TFileIn := TFileIn + LineLength;
  1973.  
  1974.                 TempString := concat(DateString, ' mehitabel - ', StringOf(DeleteTotal + SurplusTotal + TooOldTotal + MsgErrs : 1), ' messages purged', ENDLINE);
  1975.                 LineLength := length(TempString);
  1976.                 BlockMove(Ptr(ord(@TempString) + 1), Ptr(MLoc + TFileIn), Size(LineLength));
  1977.                 TFileIn := TFileIn + LineLength;
  1978.  
  1979.                 TempString := concat(DateString, ' mehitabel - ', StringOf(NewActiveCount : 1), ' messages active', ENDLINE);
  1980.                 LineLength := length(TempString);
  1981.                 BlockMove(Ptr(ord(@TempString) + 1), Ptr(MLoc + TFileIn), Size(LineLength));
  1982.                 TFileIn := TFileIn + LineLength;
  1983.  
  1984.                 Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), DefaultVol, TLogRef);
  1985.                 Err := SetFPos(TLogRef, fsFromLEOF, 0);
  1986.                 Err := FSWrite(TLogRef, TFileIn, Ptr(TxtHdl^));
  1987.                 Err := FSClose(TLogRef);
  1988.             end;
  1989.  
  1990.         if (TxtHdl <> nil) then
  1991.             begin
  1992.                 HUnlock(TxtHdl);
  1993.                 DisposHandle(TxtHdl);
  1994.             end;
  1995.  
  1996.         debugStr1 := 'Doing users';
  1997.         if DEBUG then
  1998.             IncrementDebug;
  1999.  
  2000.         if DefaultsPtr^.ProcessUL then
  2001.             ProcessUserLog;
  2002.         UnloadSeg(@ProcessUserLog);
  2003.  
  2004.         debugStr1 := 'Doing text files';
  2005.         if DEBUG then
  2006.             IncrementDebug;
  2007.  
  2008.         if (DefaultsPtr^.ResetCL | DefaultsPtr^.ResetTL) then
  2009.             ProcessTextFiles;
  2010.         UnloadSeg(@ProcessTextFiles);
  2011.  
  2012.         if DefaultsPtr^.WriteToTabby then
  2013.             begin
  2014.                 TimeStamp;
  2015.                 Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), DefaultVol, TLogRef);
  2016.                 Err := SetFPos(TLogRef, fsFromLEOF, 0);
  2017.                 Err := WrLn(TLogRef, concat(DateString, ' mehitabel - program ending'));
  2018.                 Err := FSClose(TLogRef);
  2019.             end;
  2020.  
  2021.         DisposDialog(theDialog);
  2022.  
  2023.         if DEBUG then
  2024.             CloseDebug;
  2025.  
  2026.         if MultiFinder then
  2027.             IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
  2028.  
  2029.     end;    {    Backup Procedure    }
  2030. end.        {    Backup Unit        }