diff --git a/mystic/install.pas b/mystic/install.pas
new file mode 100644
index 0000000..bd2898e
--- /dev/null
+++ b/mystic/install.pas
@@ -0,0 +1,691 @@
+// ====================================================================
+// Mystic BBS Software Copyright 1997-2012 By James Coyle
+// ====================================================================
+//
+// This file is part of Mystic BBS.
+//
+// Mystic BBS is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Mystic BBS is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Mystic BBS. If not, see .
+//
+// ====================================================================
+
+Program Install;
+
+{$I M_OPS.PAS}
+
+Uses
+ m_Strings,
+ m_Input,
+ m_Output,
+ m_DateTime,
+ DOS,
+ Install_Arc;
+
+Var
+ Screen : TOutput;
+ Keys : TInput;
+
+{$I RECORDS.PAS}
+{$I INSTALL_ANSI.PAS}
+
+Procedure Clear_Screen;
+Var
+ A : Byte;
+ B : Byte;
+Begin
+ A := 1;
+ B := 25;
+ Repeat
+ If A > 1 Then Begin
+ Screen.WriteXY (1, A-1, 0, strRep(' ', 80));
+ Screen.WriteXY (1, B+1, 0, strRep(' ', 80));
+ End;
+ Screen.WriteXY (1, A, 8, 'ú-' + strRep('Ä', 75) + '--ú');
+ Screen.WriteXY (1, B, 8, 'ú-' + strRep('Ä', 75) + '--ú');
+ WaitMS(15);
+ Inc (A);
+ Dec (B);
+ Until A = 14;
+
+ A := 76;
+ Repeat
+ Dec (A, 2);
+ Screen.WriteXY (1, 13, 8, strPadC('ú-' + strRep('Ä', A) + '--ú', 80, ' '));
+ WaitMS(7);
+ Until A = 0;
+
+ Screen.TextAttr := 7;
+ Screen.ClearScreen;
+End;
+
+Procedure ClearDisplay;
+Var
+ Count : Byte;
+Begin
+ For Count := 13 to 24 Do Begin
+ Screen.CursorXY (1, Count);
+ Screen.WriteStr (strRep(' ', 79));
+ End;
+End;
+
+Procedure ShowError (Str : String);
+Begin
+ ClearDisplay;
+
+ Screen.WriteXY (11, 15, 12, strPadC('ERROR: ' + Str, 60, ' '));
+ Screen.WriteXY (19, 19, 7, 'An error has occured. Press any key to exit');
+
+ Keys.ReadKey;
+ Clear_Screen;
+
+ Screen.Free;
+ Keys.Free;
+
+ Halt;
+End;
+
+Function Path (Str: String) : String;
+Begin
+ If Str[Length(Str)] <> PathChar Then Str := Str + PathChar;
+ Path := Str;
+End;
+
+Function IsDIR (Dir: String) : Boolean;
+Var
+ fHandle : File;
+ wAttr : Word;
+Begin
+ While Dir[Length(Dir)] = PathChar Do Dec(Dir[0]);
+ Dir := Dir + PathChar + '.';
+ Assign (fHandle, Dir);
+ GetFAttr (fHandle, wAttr);
+
+ IsDir := ((wAttr And Directory) = Directory);
+End;
+
+Procedure MakeDir (Str: String);
+Var
+ A : Byte;
+ CurDIR : String;
+ Prefix : String;
+Begin
+ Prefix := '';
+
+ A := Pos(PathChar, Str);
+
+ While (A > 0) Do Begin
+ CurDIR := Copy(Str, 1, A);
+
+ Delete (Str, 1, A);
+
+ Prefix := Prefix + CurDIR;
+
+ If Not IsDir(Prefix) Then Begin
+ {$I-} MkDIR (Prefix); {$I+}
+ If IoResult <> 0 Then Begin
+ ShowError('Unable to create: ' + Prefix);
+ End;
+ End;
+
+ A := Pos(PathChar, Str);
+ End;
+End;
+
+Var
+ Code : Char;
+
+Function Input (X, Y, FieldLen: Byte; MaxLen: Byte; Default: String) : String;
+Var
+ Res : String;
+ CursorPos : Integer;
+ Done : Boolean;
+ Ch : Char;
+Begin
+ Res := Default;
+ Done := False;
+ CursorPos := Length(Res) + 1;
+ Code := #0;
+ Repeat
+ Screen.WriteXY (X, Y, 63, strRep(' ', FieldLen));
+ Screen.WriteXY (X, Y, 63, Copy(Res, CursorPos-FieldLen+1, FieldLen));
+
+ If CursorPos > FieldLen Then
+ Screen.CursorXY (X + FieldLen - 1, Y)
+ Else
+ Screen.CursorXY (X + CursorPos - 1, Y);
+
+ Ch := Keys.ReadKey;
+ Case Ch of
+ #0 : Case Keys.ReadKey of
+ #60 : Begin
+ Code := #60;
+ Done := True;
+ End;
+ #71 : CursorPos := 1;
+ #72 : Begin
+ Code := #72;
+ Done := True;
+ End;
+ #73 : Begin
+ Code := #73;
+ Done := True;
+ End;
+ #75 : If CursorPos > 1 Then Dec(CursorPos);
+ #77 : If CursorPos < Succ(Length(Res)) Then Inc(CursorPos);
+ #79 : CursorPos := Succ(Length(Res));
+ #80 : Begin
+ Code := #80;
+ Done := True;
+ End;
+ #81 : Begin
+ Code := #81;
+ Done := True;
+ End;
+ #83 : Delete(Res, CursorPos, 1);
+ End;
+ #8 : If CursorPos > 1 Then Begin
+ Dec(CursorPos);
+ Delete(Res, CursorPos, 1);
+ End;
+ #13 : Begin
+ Code := #80;
+ Done := True;
+ End;
+ #19 : Begin
+ Code := #19;
+ Done := True;
+ End;
+ #27 : Begin
+ Code := #27;
+ Done := True;
+ End;
+ Else
+ If Length(Res) < MaxLen Then Begin
+ Insert(Ch, Res, CursorPos);
+ Inc(CursorPos);
+ End;
+ End;
+ Until Done;
+
+ Input := Res;
+End;
+
+Type
+ CharRec = Record
+ Ch : Char;
+ A : Byte;
+ End;
+
+ LineRec = Array[1..80] of CharRec;
+ TxtRec = String[79];
+
+Var
+ Txt : Array[1..5000] of ^TxtRec;
+ Config : RecConfig;
+ Lang : LangRec;
+
+Procedure ViewTextFile (FN : String);
+Const
+ WinSize = 12;
+Var
+ T : Text;
+ Count : Word;
+ A : Word;
+ Line : Integer;
+ Per : LongInt;
+ Per10 : Byte;
+ BarPos : Byte;
+Begin
+ Assign (T, FN);
+ {$I-} Reset(T); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ Count := 0;
+
+ While Not Eof(T) Do Begin
+ Inc (Count);
+ New (Txt[Count]);
+ ReadLn (T, Txt[Count]^);
+ End;
+
+ Close(T);
+
+ DrawMainMenu;
+
+ Screen.WriteXY (1, 25, 8, strRep('Ü', 79));
+ Screen.WriteXY (2, 25, 7, ' ' + FN + ' ');
+
+ Line := 1;
+
+ Repeat
+ If Line > Count - WinSize Then Line := Count - WinSize;
+ If Line < 1 Then Line := 1;
+
+ Per := Round(Line / (Count - WinSize) * 100);
+ Per10 := Per DIV 10;
+
+ Screen.WriteXY (53, 25, 8, ' [' + strPadL(strI2S(Per), 3, ' ') + '%] ');
+
+ If Per10 <> BarPos Then Begin
+ Screen.WriteXY (64, 25, 8, ' [°°°°°°°°°°] ');
+
+ BarPos := 0;
+
+ While BarPos < Per10 Do Begin
+ Inc (BarPos);
+
+ Case BarPos of
+ 1 : Screen.WriteXY (66, 25, 1, '²');
+ 2 : Screen.WriteXY (67, 25, 25, '°');
+ 3 : Screen.WriteXY (68, 25, 25, '±');
+ 4 : Screen.WriteXY (69, 25, 25, '²');
+ 5 : Screen.WriteXY (70, 25, 25, 'Û');
+ 6 : Screen.WriteXY (71, 25, 27, '°');
+ 7 : Screen.WriteXY (72, 25, 27, '±');
+ 8 : Screen.WriteXY (73, 25, 27, '²');
+ 9 : Screen.WriteXY (74, 25, 11, 'Û');
+ 10: Screen.WriteXY (75, 25, 15, 'Û');
+ End;
+ End;
+
+ BarPos := Per10;
+ End;
+
+ For A := 0 to WinSize Do
+ Screen.WriteXY (1, A + 11, 7, strPadR(Txt[Line + A]^, 80, ' '));
+
+ Case Keys.ReadKey of
+ #00 : Case Keys.ReadKey of
+ #71 : Line := 1;
+ #72 : Dec (Line);
+ #73,
+ #75 : Dec (Line, WinSize);
+ #79 : Line := Count - WinSize;
+ #80 : Inc (Line);
+ #77,
+ #81 : Inc (Line, WinSize);
+ End;
+ #27 : Break;
+ End;
+ Until False;
+
+ For A := 1 to Count Do
+ Dispose (Txt[A]);
+End;
+
+Procedure CompileLanguageFile;
+Type
+ PromptRec = String[255];
+Var
+ InFile : Text;
+ PromptFile : File of PromptRec;
+ Prompt : PromptRec;
+ Str : String;
+ Count : Integer;
+Begin
+ Assign (InFile, Config.SystemPath + 'default.txt');
+ Reset (InFile);
+
+ Assign (PromptFile, Config.DataPath + 'default.lng');
+ ReWrite (PromptFile);
+
+ While Not Eof(InFile) Do Begin
+ ReadLn (InFile, Str);
+
+ If Copy(Str, 1, 3) = '000' Then Count := 0 Else
+ If strS2I(Copy(Str, 1, 3)) > 0 Then Count := strS2I(Copy(Str, 1, 3)) Else
+ Count := -1;
+
+ If Count <> -1 Then Begin
+ Seek (PromptFile, Count);
+ Prompt := Copy(Str, 5, Length(Str));
+ Write (PromptFile, Prompt);
+ End;
+ End;
+
+ Close (PromptFile);
+ Close (InFile);
+End;
+
+Procedure CreateDirectories;
+Begin
+ Screen.WriteXYPipe (23, 13, 7, 45, '|08[|15û|08] |07Creating directories|08...');
+
+ MakeDir (Config.SystemPath);
+ MakeDir (Config.DataPath);
+ MakeDir (Lang.TextPath);
+ MakeDir (Lang.MenuPath);
+ MakeDir (Config.LogsPath);
+ MakeDir (Config.MsgsPath);
+ MakeDir (Config.SemaPath);
+ MakeDir (Config.ScriptPath);
+ MakeDir (Config.AttachPath);
+ MakeDir (Config.QwkPath);
+ MakeDir (Config.SystemPath + 'files');
+ MakeDir (Config.SystemPath + 'files' + PathChar + 'uploads');
+End;
+
+Procedure ExtractFile (Y : Byte; Desc, FN, EID, DestPath : String);
+Begin
+ Screen.WriteXYPipe (23, Y, 7, 45, Desc);
+
+ If Not maOpenExtract (FN, EID, DestPath) Then
+ ShowError('Unable to find ' + FN + '.mys');
+
+ While maNextFile Do
+ If Not maExtractFile Then
+ ShowError ('Unable to extract file (disk full?)');
+
+ maCloseFile;
+End;
+
+Procedure UpdateDataFiles;
+Var
+ CfgFile : File of RecConfig;
+ MBaseFile : File of MBaseRec;
+ FBaseFile : File of FBaseRec;
+ LangFile : File of LangRec;
+ Cfg : RecConfig;
+ MBase : MBaseRec;
+ FBase : FBaseRec;
+ TLang : LangRec;
+ TF : Text;
+Begin
+ Screen.WriteXYPipe (23, 19, 7, 45, '|08[|15û|08] |07Updating data files|08...');
+
+ Assign (CfgFile, Config.SystemPath + 'mystic.dat');
+ Reset (CfgFile);
+ Read (CfgFile, Cfg);
+
+ Cfg.SystemPath := Config.SystemPath;
+ Cfg.AttachPath := Config.AttachPath;
+ Cfg.DataPath := Config.DataPath;
+ Cfg.MsgsPath := Config.MsgsPath;
+ Cfg.SemaPath := Config.SemaPath;
+ Cfg.QwkPath := Config.QwkPath;
+ Cfg.ScriptPath := Config.ScriptPath;
+ Cfg.LogsPath := Config.LogsPath;
+ Cfg.UserIdxPos := 0;
+ Cfg.SystemCalls := 0;
+
+ Reset (CfgFile);
+ Write (CfgFile, Cfg);
+ Close (CfgFile);
+
+ Assign (MBaseFile, Config.DataPath + 'mbases.dat');
+ Reset (MBaseFile);
+
+ While Not Eof(MBaseFile) Do Begin
+ Read (MBaseFile, MBase);
+
+ MBase.Path := Config.MsgsPath;
+
+ Seek (MBaseFile, FilePos(MBaseFile) - 1);
+ Write (MBaseFile, MBase);
+ End;
+
+ Close (MBaseFile);
+
+ Assign (FBaseFile, Config.DataPath + 'fbases.dat');
+ Reset (FBaseFile);
+
+ While Not Eof(FBaseFile) Do Begin
+ Read (FBaseFile, FBase);
+
+ FBase.Path := Config.SystemPath + 'files' + PathChar + FBase.FileName + PathChar;
+
+ Seek (FBaseFile, FilePos(FBaseFile) - 1);
+ Write (FBaseFile, FBase);
+ End;
+ Close (FBaseFile);
+
+ Assign (LangFile, Config.DataPath + 'language.dat');
+ Reset (LangFile);
+
+ While Not Eof(LangFile) Do Begin
+ Read (LangFile, TLang);
+
+ TLang.FileName := 'default';
+ TLang.TextPath := Lang.TextPath;
+ TLang.MenuPath := Lang.MenuPath;
+
+ Seek (LangFile, FilePos(LangFile) - 1);
+ Write (LangFile, TLang);
+ End;
+
+ Close (LangFile);
+
+ CompileLanguageFile;
+End;
+
+Procedure DoInstall;
+Begin
+ ClearDisplay;
+ CreateDirectories;
+
+ ExtractFile (14, '|08[|15û|08] |07Installing root files|08...', 'install_data', 'ROOT', Config.SystemPath);
+ ExtractFile (15, '|08[|15û|08] |07Installing display files|08...', 'install_data', 'TEXT', Lang.TextPath);
+ ExtractFile (16, '|08[|15û|08] |07Installing menu files|08...', 'install_data', 'MENUS', Lang.MenuPath);
+ ExtractFile (17, '|08[|15û|08] |07Installing script files|08...', 'install_data', 'SCRIPT', Config.ScriptPath);
+ ExtractFile (18, '|08[|15û|08] |07Installing data files|08...', 'install_data', 'DATA', Config.DataPath);
+
+ UpdateDataFiles;
+
+ Screen.WriteXY (23, 21, 11, 'Installation completed. Press any key.');
+ Keys.ReadKey;
+
+ Clear_Screen;
+ Screen.WriteLine ('Switch to the Mystic directory (' + Config.SystemPath + ') and then:');
+ Screen.WriteLine('');
+ {$IFDEF WINDOWS}
+ Screen.WriteLine ('Type "MYSTIC -L" to run Mystic in local mode');
+ Screen.WriteLine ('Type "MCFG" to run the external configuration utility');
+ Screen.WriteLine ('Type "MYSTIC -CFG" to run the internal configuration utility');
+ Screen.WriteLine('');
+ Screen.WriteLine ('As always, read the documentation!');
+ {$ENDIF}
+ {$IFDEF LINUX}
+ Screen.WriteLine ('Please read linux.install.doc for installation instructions');
+ Screen.WriteLine ('and notes on using Mystic under Linux');
+ Screen.WriteLine('');
+ Screen.WriteLine ('Set your terminal to 80x25 lines with an IBM characterset font!');
+ Screen.WriteLine('');
+ Screen.WriteLine ('Type "./mystic" from the installed directory to login locally');
+ Screen.WriteLine ('Type "./mcfg" to run the external configuration utility');
+ Screen.WriteLine ('Type "./mystic -cfg" to run the internal configuration utility');
+ {$ENDIF}
+ {$IFDEF DARWIN}
+ Screen.WriteLine ('Please read osx.install.doc for installation instructions');
+ Screen.WriteLine ('and notes on using Mystic under OSX');
+ Screen.WriteLine('');
+ Screen.WriteLine ('Set your terminal to 80x25 lines with an IBM characterset font!');
+ Screen.WriteLine ('See documentation for more terminal suggestions!');
+ Screen.WriteLine('');
+ Screen.WriteLine ('Type "./mystic" from the installed directory to login locally');
+ Screen.WriteLine ('Type "./mcfg" to run the external configuration utility');
+ Screen.WriteLine ('Type "./mystic -cfg" to run the internal configuration utility');
+ {$ENDIF}
+
+ Screen.WriteLine('');
+ Screen.WriteStr('Press any key to close');
+
+ Keys.ReadKey;
+
+ ChDIR(Copy(Config.SystemPath, 1, Length(Config.SystemPath) - 1));
+
+ Screen.Free;
+ Keys.Free;
+ Halt;
+End;
+
+Function GetPaths : Boolean;
+Var
+ Str : String;
+
+ Function Change (NewStr : String) : String;
+ Var
+ A : Byte;
+ Begin
+ A := Pos(Config.SystemPath, NewStr);
+ If A > 0 Then Begin
+ Delete (NewStr, A, Length(Config.SystemPath));
+ Insert (Str, NewStr, A);
+ End;
+ Change := NewStr;
+ End;
+
+Var
+ Pos : Byte;
+Begin
+ ClearDisplay;
+
+ Screen.WriteXY (13, 13, 7, 'System Directory');
+ Screen.WriteXY (15, 14, 7, 'Data Directory');
+ Screen.WriteXY (15, 15, 7, 'Text Directory');
+ Screen.WriteXY (15, 16, 7, 'Menu Directory');
+ Screen.WriteXY (11, 17, 7, 'Msg Base Directory');
+ Screen.WriteXY (10, 18, 7, 'Semaphore Directory');
+ Screen.WriteXY (13, 19, 7, 'Script Directory');
+ Screen.WriteXY (13, 20, 7, 'Attach Directory');
+ Screen.WriteXY (15, 21, 7, 'Logs Directory');
+
+ Screen.WriteXYPipe (19, 23, 7, 64, 'Press |08[|15F2|08] |07to begin install or |08[|15ESC|08] |07to Quit');
+
+ Pos := 1;
+
+ {$IFDEF UNIX}
+ Config.SystemPath := '/mystic/';
+ {$ELSE}
+ Config.SystemPath := 'c:\mystic\';
+ {$ENDIF}
+ Config.DataPath := Config.SystemPath + 'data' + PathChar;
+ Lang.TextPath := Config.SystemPath + 'text' + PathChar;
+ Lang.MenuPath := Config.SystemPath + 'menus' + PathChar;
+ Config.MsgsPath := Config.SystemPath + 'msgs' + PathChar;
+ Config.SemaPath := Config.SystemPath + 'semaphore' + PathChar;
+ Config.ScriptPath := Config.SystemPath + 'scripts' + PathChar;
+ Config.AttachPath := Config.SystemPath + 'attach' + PathChar;
+ Config.LogsPath := Config.SystemPath + 'logs' + PathChar;
+
+ Repeat
+ Screen.WriteXY (30, 13, 15, strPadR(Config.SystemPath, 40, ' '));
+ Screen.WriteXY (30, 14, 15, strPadR(Config.DataPath, 40, ' '));
+ Screen.WriteXY (30, 15, 15, strPadR(Lang.TextPath, 40, ' '));
+ Screen.WriteXY (30, 16, 15, strPadR(Lang.MenuPath, 40, ' '));
+ Screen.WriteXY (30, 17, 15, strPadR(Config.MsgsPath, 40, ' '));
+ Screen.WriteXY (30, 18, 15, strPadR(Config.SemaPath, 40, ' '));
+ Screen.WriteXY (30, 19, 15, strPadR(Config.ScriptPath, 40, ' '));
+ Screen.WriteXY (30, 20, 15, strPadR(Config.AttachPath, 40, ' '));
+ Screen.WriteXY (30, 21, 15, strPadR(Config.LogsPath, 40, ' '));
+
+ Case Pos of
+ 1 : Begin
+ Str := Path(Input(30, 13, 40, 40, Config.SystemPath));
+ If Str <> Config.SystemPath Then Begin
+ Config.DataPath := Change(Config.DataPath);
+ Lang.TextPath := Change(Lang.TextPath);
+ Lang.MenuPath := Change(Lang.MenuPath);
+ Config.MsgsPath := Change(Config.MsgsPath);
+ Config.SemaPath := Change(Config.SemaPath);
+ Config.ScriptPath := Change(Config.ScriptPath);
+ Config.AttachPath := Change(Config.AttachPath);
+ Config.LogsPath := Change(Config.LogsPath);
+ Config.SystemPath := Str;
+ End;
+ End;
+ 2 : Config.DataPath := Path(Input(30, 14, 40, 40, Config.DataPath));
+ 3 : Lang.TextPath := Path(Input(30, 15, 40, 40, Lang.TextPath));
+ 4 : Lang.MenuPath := Path(Input(30, 16, 40, 40, Lang.MenuPath));
+ 5 : Config.MsgsPath := Path(Input(30, 17, 40, 40, Config.MsgsPath));
+ 6 : Config.SemaPath := Path(Input(30, 18, 40, 40, Config.SemaPath));
+ 7 : Config.ScriptPath := Path(Input(30, 19, 40, 40, Config.ScriptPath));
+ 8 : Config.AttachPath := Path(Input(30, 20, 40, 40, Config.AttachPath));
+ 9 : Config.LogsPath := Path(Input(30, 21, 40, 40, Config.LogsPath));
+ End;
+
+ Case Code of
+ #19 : Begin
+ GetPaths := True;
+ Break;
+ End;
+ #27 : Begin
+ GetPaths := False;
+ Break;
+ End;
+ #60 : Begin
+ GetPaths := True;
+ Break;
+ End;
+ #72 : If Pos > 1 Then Dec(Pos) Else Pos := 9;
+ #80 : If Pos < 9 Then Inc(Pos) Else Pos := 1;
+ End;
+ Until False;
+
+ { update paths not on the list }
+
+ Config.QwkPath := Config.SystemPath + 'localqwk' + PathChar;
+End;
+
+Const
+ Items : Array[1..3] of String[32] = (
+ ' % INSTALL MYSTIC BBS ',
+ ' % READ WHATS NEW ',
+ ' % ABORT INSTALLATION '
+ );
+
+Var
+ Pos : Byte;
+ A : Byte;
+Begin
+ Screen := TOutput.Create(True);
+ Keys := TInput.Create;
+
+ DrawMainMenu;
+
+ Pos := 2;
+
+ Repeat
+ For A := 1 to 3 Do
+ If A = Pos Then
+ Screen.WriteXY (25, 16 + A, 15 + 3 * 16, Items[A])
+ Else
+ Screen.WriteXY (25, 16 + A, 7, Items[A]);
+
+ Case Keys.ReadKey of
+ #00 : Case Keys.ReadKey of
+ #72 : If Pos > 1 Then Dec(Pos);
+ #80 : If Pos < 3 THen Inc(Pos);
+ End;
+ #13 : Case Pos of
+ 1 : Begin
+ If GetPaths Then
+ DoInstall
+ Else
+ DrawMainMenu;
+ End;
+ 2 : Begin
+ ViewTextFile('whatsnew.txt');
+ DrawMainMenu;
+ End;
+ 3 : Break;
+ End;
+
+ #27 : Break;
+ End;
+ Until False;
+
+ Clear_Screen;
+
+ Keys.Free;
+ Screen.Free;
+End.
diff --git a/mystic/install_ansi.pas b/mystic/install_ansi.pas
new file mode 100644
index 0000000..e20b3a3
--- /dev/null
+++ b/mystic/install_ansi.pas
@@ -0,0 +1,65 @@
+Procedure DrawMainMenu;
+const
+ IMAGEDATA_WIDTH=80;
+ IMAGEDATA_DEPTH=25;
+ IMAGEDATA_LENGTH=903;
+ IMAGEDATA : array [1..903] of Char = (
+ #15,#16,#25,'<',#14,'²',#24, #3,'Ü','Ü',#25,#10, #8,'Ü','Ü',#25, #3,
+ #7,'°', #0,#23,'²',#16,#25,#23,#11,#26, #4,'Ü',#25, #9,#14,'±','Û',
+ '±', #7,'°', #0,#23,'²',#16,#25, #8, #7,'°', #0,#23,'²', #8,#16,'g',
+ 'j','!',#24,' ',#11,#19,'Þ','Û','Ü', #3,#16,'Ü',#25, #4, #8,'þ',' ',
+ 'ß',' ',' ','Ý',' ', #3,'°', #0,#19,'²',#11,#16,'°',#19,'Þ',#15,'Û',
+ 'Û',#11,'Û','Ý',#16,#25, #5, #8,'Ý',#25, #5,#15,#23,'Ü',#11,#16,#26,
+ #3,'Ü', #3,'Ü',#11,'Ü','Û',#15,#23,'Û','Û',#11,#19,'Û',#15,#23,'Û',
+ #11,#16,#26, #3,'Ü',#14,'ß',' ','ß','ß','Û',#15,'Û','Û',#14,'Û','Û',
+ 'Û','²','ß','ß', #3,'Ü',#11,#26, #4,'Ü',#19,'Ü',#16,'Û','Û',#19,'Ü',
+ #3,#16,'Ü',#24,' ',#11,'°',#19,'Û',#15,'Û','Û',#11,'Ü', #3,#16,'Ü',
+ #25, #5, #8,'Ü','ß', #3,'Ü',#11,#19,'Ü','Û','Û','Û','Þ','Û','Û','Û',
+ 'Ý',#16,' ', #8,#23,'²',#16,'ß','ß',' ',' ','ß',' ',' ', #3,'Ü',#11,
+ #19,'Ü','Û','Û','Û',#16,'Û','Û',#19,'Û',#16,'²','°',#19,'ß',#26, #4,
+ 'Û',#26, #3,'ß',#16,#25, #3,#14,'Ü',#26, #3,'Û','²','Ü', #3,'ß',#11,
+ #19,'Û','Û',#15,#23,'Û','Û',#11,#19,'Û',#15,#23,'Û',#11,#19,#26, #4,
+ 'Û',#16,'±', #8,'þ',#24,#15,#23,'ß',#16,' ',#11,'²',#19,#26, #3,'Û',
+ 'Ü', #3,#16,'Ü', #8,'ß','Û',#23,'²',#16,'ß', #3,'Ü',#11,#19,'Ü','Û',
+ #15,#23,'Û',#11,#19,'Û','Û',#16,'²',#19,'Þ','Û','Û','Û','Ý',#16,' ',
+ #8,#19,'²',#16,' ',#11,#19,'Þ','Û','Û','Û',#16,'²','±','²',#19,'Û',
+ 'Û','Û','Ü', #3,#16,'Ü',' ',' ', #8,'Ü','Ü',' ',#11,'²',#19,'Û','Û',
+ 'Û',#16,'²',' ', #8,'Ü',' ',#11,'Ü','Ü','Ü',' ',#14,'ß','ß',#11,#26,
+ #4,'Ü',#14,'ß','ß', #3,'Þ',#11,#19,'Û','²',#16,' ', #8,'Ü','Ü',' ',
+ #3,'Ü',#11,#19,'Û','Û','Û', #3,#16,'Ý', #8,'Þ',#24,#23,'²',#16,' ',
+ #11,'±',#19,'²','²','²','Û',#16,'ß',#19,'ß',#16,'Û','Ü','Ü','Û',#19,
+ 'ß',#16,'ß',#19,'Û','²','²','²',#16,'±', #3,'Þ',#11,'²',#19,'²','²',
+ '²', #3,#16,'Ü',' ',' ',#11,#19,'Þ','²','²',#16,'²','±',' ', #3,'ß',
+ #11,#19,'ß','Û','Û','²','²','±','°', #3,#16,'Ü', #8,'ß',' ',#11,#19,
+ '°','²','²','²',#16,'±',' ', #8,#19,'²',#16,' ',#11,#19,'²','²','Ü',
+ '±','°',#16,' ',#15,#23,'Û','Û',#11,#19,'Û','Û',#16,'²','°','²',#19,
+ '²','²','±',#16,' ', #8,'²',' ', #3,'Þ',#11,'²',#19,'²','²','°',#16,
+ ' ', #8,#23,'²',#24,#16,'ß',' ', #3,'Û',#11,#19,'°','°','°', #3,#16,
+ 'Û',' ',' ','ß',#11,#19,'ß','ß', #3,#16,'ß',' ',' ','Û',#11,#19,'°',
+ '°','°', #3,#16,'Û',' ','ß',#11,#19,#26, #3,'°', #3,#16,'Û','Ü','Û',
+ #11,#19,'°','°','°', #3,#16,'Û',' ', #8,'ß',' ',' ', #3,'ß','ß',#11,
+ #19,#26, #3,'°', #3,#16,'Û',' ','Û',#11,#19,'°','°','°', #3,#16,'Û',
+ 'Ý', #8,'±',' ',#11,#19,#26, #3,'°', #3,#16,'Û','°',#11,#19,#26, #3,
+ '²',#16,'²', #3,'Û',#11,'±',#19,'°','°','°', #3,#16,'Ý', #8,'ß',' ',
+ #11,#19,'°','°','°', #3,#16,'Û',#11,'°',' ', #8,#19,'²',#24, #3,#16,
+ '°', #0,#19,'²', #3,#16,'²','Û','Û',#19,' ',#16,'Û',' ', #8,#19,'²',
+ #16,#26, #3,'Ü','²',' ', #3,#26, #4,'Û',' ', #8,'±','Ü',' ', #3,#26,
+ #3,'ß',#26,#14,'Û', #0,#19,'°','±',#16,' ', #3,'ß',#26, #3,'Û','Ü',
+ 'Ü',#26, #4,'Û',#11,'±',#19,#26, #4,'°',#16,' ', #3,'ß',#26, #3,'Û',
+ #26, #4,'Ü',' ', #8,'Ü','Ü','Û',#24,'Ü','Ü','þ',' ', #3,'ß','ß','²',
+ ' ', #8,'±',' ',' ','°','°','²',#26, #6,'Ü','²',#26, #4,'ß',' ', #3,
+ '²','Û','Û','Û','Ý','²', #0,#19,'°', #3,#16,'²','Û','Û','Û','²',#26,
+ #3,'ß',' ', #8,'Þ','Ü','Ü',' ', #3,#26, #7,'ß',' ',' ',#26, #4,'ß',
+ #25, #3,#26, #6,'ß',' ', #8,'Ý','°','°',#24,#25, #7,'°',#25,#11,'Ý',
+ #25, #5, #3,'°', #0,#19,'²',#16,#25,#10, #8,'þ',#25, #3,'Þ',#26,#12,
+ 'ß',' ','ß',#25,#13,'ß','Ü',#24,#25,#20,'ß','Ü','Ü',#25,#17,'ß',' ',
+ 'Ü','Ü','ß',#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#25,#17,
+ #7,'V','i','s','i','t',' ',#15,'w','w','w','.','m','y','s','t','i',
+ 'c','b','b','s','.','c','o','m',' ', #7,'f','o','r',' ','l','a','t',
+ 'e','s','t',' ','u','p','d','a','t','e','s','!',#24,#24, #8,#26,'N',
+ 'Ä',#24);
+Begin
+ Screen.LoadScreenImage(ImageData, ImageData_Length, ImageData_Width, 1, 1);
+ Screen.WriteXY (1, 13, 7, strPadC('Mystic BBS Installation Utility Version ' + mysVersion, 79, ' '));
+ Screen.WriteXY (1, 14, 7, strPadC('Copyright (C) 1997-2011 By James Coyle. All Rights Reserved.', 79, ' '));
+End;
diff --git a/mystic/install_arc.pas b/mystic/install_arc.pas
new file mode 100644
index 0000000..e23a094
--- /dev/null
+++ b/mystic/install_arc.pas
@@ -0,0 +1,249 @@
+Unit Install_Arc;
+
+{ MYS archive procedures }
+
+Interface
+
+Const
+ maVersion = 3;
+ maHeader = 'MYS' + #26;
+
+Type
+ maHeaderRec = Record
+ Header : String[4];
+ Version : Word;
+ Files : LongInt;
+ End;
+
+ maFileHdrRec = Record
+ Header : String[4];
+ FileName : String[80];
+ FileSize : LongInt;
+ Execute : Boolean;
+ EID : String[6];
+ End;
+
+Var
+ maHdr : maHeaderRec;
+ maFileHdr : maFileHdrRec;
+
+Function maOpenExtract (FN : String; EID: String; ExtractDIR : String) : Boolean;
+Function maOpenCreate (FN : String; Add: Boolean) : Boolean;
+Function maAddFile (Path, EID, FN : String) : Boolean;
+Function maNextFile : Boolean;
+Function maExtractFile : Boolean;
+Procedure maCloseFile;
+
+Implementation
+
+{$IFDEF UNIX}
+ Uses
+ BaseUnix,
+ Unix;
+{$ENDIF}
+
+Function LoCase (C: Char): Char;
+Begin
+ If (C in ['A'..'Z']) Then
+ LoCase := Chr(Ord(C) + 32)
+ Else
+ LoCase := C;
+End;
+
+Function Lower (Str : String) : String;
+Var
+ A : Byte;
+Begin
+ For A := 1 to Length(Str) Do Str[A] := LoCase(Str[A]);
+ Lower := Str;
+End;
+
+Const
+ OpMode : Byte = 0; { 0 = not opened, 1 = add, 2 = extract }
+
+Var
+ OutFile : File;
+ InFile : File;
+ ExtDIR : String;
+ CurEID : String;
+
+Function maOpenExtract (FN : String; EID: String; ExtractDIR : String) : Boolean;
+Begin
+ maOpenExtract := False;
+ ExtDIR := ExtractDIR;
+ CurEID := EID;
+
+ Assign (InFile, FN + '.mys');
+ {$I-} Reset(InFile, 1); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ BlockRead (InFile, maHdr, SizeOf(maHdr));
+
+ If (maHdr.Version <> maVersion) or (maHdr.Header <> maHeader) Then Begin
+ Close (InFile);
+ Exit;
+ End;
+
+ OpMode := 2;
+ maOpenExtract := True;
+End;
+
+Function maOpenCreate (FN : String; Add: Boolean) : Boolean;
+Var
+ BRead : Word;
+ Create : Boolean;
+Begin
+ maOpenCreate := False;
+ Create := True;
+
+ Assign (OutFile, FN + '.mys');
+
+ If Add Then Begin
+ {$I-} Reset(OutFile, 1); {$I+}
+ If IoResult = 0 Then Begin
+ BlockRead (OutFile, maHdr, SizeOf(maHdr), BRead);
+
+ If (maHdr.Header <> maHeader) or (maHdr.Version <> maVersion) Then Begin
+ Close (OutFile);
+ Exit;
+ End;
+
+ Seek (OutFile, FileSize(OutFile));
+
+ Create := False;
+ End;
+ End;
+
+ If Create Then Begin
+ {$I-} ReWrite(OutFile, 1); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ maHdr.Header := maHeader;
+ maHdr.Version := maVersion;
+ maHdr.Files := 0;
+
+ BlockWrite (OutFile, maHdr, SizeOf(maHdr));
+ End;
+
+ OpMode := 1;
+ maOpenCreate := True;
+End;
+
+Function maNextFile : Boolean;
+Var
+ BRead : Word;
+Begin
+ maNextFile := False;
+
+ Repeat
+ BlockRead (InFile, maFileHdr, SizeOf(maFileHdr), BRead);
+
+ If BRead <> SizeOf(maFileHdr) Then Exit;
+ If maFileHdr.Header <> maHeader Then Exit;
+
+ If maFileHdr.EID <> CurEID Then Begin
+ {$I+} Seek (InFile, FilePos(InFile) + maFileHdr.FileSize); {$I-}
+ If IoResult <> 0 Then Exit;
+ End Else
+ Break;
+ Until False;
+
+ maNextFile := True;
+End;
+
+Procedure maCloseFile;
+Begin
+ Case OpMode of
+ 1 : Begin
+ Seek (OutFile, 0);
+ BlockWrite (OutFile, maHdr, SizeOf(maHdr));
+ Close (OutFile);
+ End;
+ 2 : Close(InFile);
+ End;
+
+ OpMode := 0;
+End;
+
+Function maAddFile (Path, EID, FN : String) : Boolean;
+Var
+ F : File;
+ Buf : Array[1..8096] of Byte;
+ BRead : Word;
+ BWrite : Word;
+Begin
+ maAddFile := False;
+
+ Assign (F, Path + FN);
+ {$I-} Reset(F, 1); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ Inc (maHdr.Files);
+
+ maFileHdr.FileName := Lower(FN);
+ maFileHdr.FileSize := FileSize(F);
+ maFileHdr.EID := EID;
+ maFileHdr.Header := maHeader;
+ {$IFDEF UNIX}
+ maFileHdr.Execute := fpAccess(Path + FN, X_OK) = 0;
+ {$ELSE}
+ maFileHdr.Execute := False;
+ {$ENDIF}
+
+ BlockWrite (OutFile, maFileHdr, SizeOf(maFileHdr));
+
+ Repeat
+ BlockRead (F, Buf, SizeOf(Buf), BRead);
+ BlockWrite (OutFile, Buf, BRead, BWrite);
+ Until (BRead = 0) or (BRead <> BWrite);
+
+ Close (F);
+
+ maAddFile := True;
+End;
+
+Function maExtractFile : Boolean;
+Var
+ F : File;
+ Buf : Array[1..8096] of Byte;
+ Done : Boolean;
+ ReadSize : Word;
+ BRead : Word;
+Begin
+ maExtractFile := False;
+ Done := False;
+
+ Assign (F, ExtDIR + maFileHdr.FileName);
+ {$I-} ReWrite(F, 1); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ Repeat
+ If maFileHdr.FileSize < SizeOf(Buf) Then Begin
+ ReadSize := maFileHdr.FileSize;
+ Done := True;
+ End Else
+ ReadSize := SizeOf(Buf);
+
+ BlockRead (InFile, Buf, ReadSize, BRead);
+
+ If BRead <> ReadSize Then Begin
+ Close (F);
+ Exit;
+ End;
+
+ BlockWrite (F, Buf, ReadSize);
+
+ Dec (maFileHdr.FileSize, ReadSize);
+ Until Done;
+
+ Close (F);
+
+ {$IFDEF UNIX}
+ If maFileHdr.Execute Then
+ fpChMod (ExtDIR + maFileHdr.FileName, &777);
+ {$ENDIF}
+
+ maExtractFile := True;
+End;
+
+End.
diff --git a/mystic/install_make.pas b/mystic/install_make.pas
new file mode 100644
index 0000000..641c172
--- /dev/null
+++ b/mystic/install_make.pas
@@ -0,0 +1,49 @@
+Program install_make;
+
+Uses
+ DOS,
+ m_FileIO,
+ Install_Arc;
+
+Var
+ oName : String;
+ oMask : String;
+ oEID : String;
+ Dir : SearchRec;
+Begin
+ WriteLn;
+ WriteLn('Install Make utility for .MYS files');
+ WriteLn;
+
+ If ParamCount <> 3 Then Begin
+ WriteLn('Received: ', ParamCount, ' parameters.');
+ WriteLn('PS: ', ParamStr(1) + ' ' + ParamStr(2) + ' ' + ParamStr(3));
+ WriteLn;
+ WriteLn('Syntax: install_make [NAME of MYS FILE] [FILEMASK] [EID]');
+ Halt(1);
+ End;
+
+ oName := ParamStr(1);
+ oMask := ParamStr(2);
+ oEID := ParamStr(3);
+
+ If Not maOpenCreate(oName, True) Then Begin
+ WriteLn('Unable to create: ' + oName + '.mys');
+ Halt(1);
+ End;
+
+ FindFirst(oMask, Archive, Dir);
+
+ While DosError = 0 Do Begin
+ If Not maAddFile(JustPath(oMask), oEID, Dir.Name) Then Begin
+ WriteLn('Unable to add file: ' + Dir.Name);
+ Halt(1);
+ End Else
+ WriteLn(' - Added: ' + Dir.Name);
+
+ FindNext(Dir);
+ End;
+
+ FindClose(Dir);
+ maCloseFile;
+End.
diff --git a/mystic/makelang.pas b/mystic/makelang.pas
new file mode 100644
index 0000000..fa569d6
--- /dev/null
+++ b/mystic/makelang.pas
@@ -0,0 +1,135 @@
+// ====================================================================
+// Mystic BBS Software Copyright 1997-2012 By James Coyle
+// ====================================================================
+//
+// This file is part of Mystic BBS.
+//
+// Mystic BBS is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Mystic BBS is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Mystic BBS. If not, see .
+//
+// ====================================================================
+
+Program MakeLang;
+
+{$I M_OPS.PAS}
+
+Uses
+ DOS,
+ m_Strings;
+
+{$I RECORDS.PAS}
+
+Var
+ ConfigFile : File of RecConfig;
+ PromptFile : File of PromptRec;
+ Config : RecConfig;
+ Prompt : PromptRec;
+ Done : Array[0..mysMaxLanguageStr] of Boolean;
+ tFile : Text;
+ A : Integer;
+ Temp : String;
+ FName : NameStr;
+ FExt : ExtStr;
+ FDir : DirStr;
+
+Begin
+ WriteLn;
+ WriteLn ('MAKELANG (' + OSID + ') - Mystic Language Compiler v', mysVersion);
+ WriteLn ('Copyright (C) 1997-2011 By James Coyle. All Rights Reserved.');
+ WriteLn;
+
+ Assign (ConfigFile, 'mystic.dat');
+ {$I-}Reset (ConfigFile);{$I+}
+ If IoResult <> 0 Then Begin
+ WriteLn ('ERROR: MYSTIC.DAT not found. Run from main BBS directory.');
+ Halt(1);
+ End;
+ Read (ConfigFile, Config);
+ Close (ConfigFile);
+
+ If Config.DataChanged <> mysDataChanged Then Begin
+ WriteLn('ERROR: Data files are not current and must be upgraded.');
+ Halt(1);
+ End;
+
+
+ If ParamCount <> 1 Then Begin
+ WriteLn ('Usage: MAKELANG [language_file]');
+ Halt(1);
+ End;
+
+ FSplit (ParamStr(1), FDir, FName, FExt);
+
+ Assign (tFile, FName + FExt);
+ {$I-} Reset (tFile); {$I+}
+ If IoResult <> 0 Then Begin
+ WriteLn ('ERROR: Language file (' + FName + FExt + ') not found.');
+ Halt(1);
+ End;
+
+ Write ('Compiling language file: ');
+
+ Assign (PromptFile, Config.DataPath + FName + '.lng');
+ {$I-} ReWrite (PromptFile); {$I+}
+
+ If IoResult <> 0 Then Begin
+ WriteLn;
+ WriteLn;
+ WriteLn (^G'ERROR: Cannot run while Mystic is loaded.');
+ Halt(1);
+ End;
+
+ Prompt := '';
+ For A := 0 to mysMaxLanguageStr Do Begin
+ Done[A] := False;
+ Write (PromptFile, Prompt);
+ End;
+ Reset (PromptFile);
+
+ While Not Eof(tFile) Do Begin
+ ReadLn (tFile, Temp);
+
+ If Copy(Temp, 1, 3) = '000' Then A := 0 Else
+ If strS2I(Copy(Temp, 1, 3)) > 0 Then A := strS2I(Copy(Temp, 1, 3)) Else
+ A := -1;
+
+ If A <> -1 Then Begin
+ If A > mysMaxLanguageStr Then Begin
+ WriteLn;
+ WriteLn;
+ WriteLn (^G'ERROR: String #', A, ' was not expected. Language file not created.');
+ Close (PromptFile);
+ Erase (PromptFile);
+ Halt(1);
+ End;
+
+ Done[A] := True;
+ Seek (PromptFile, A);
+ Prompt := Copy(Temp, 5, Length(Temp));
+ Write (PromptFile, Prompt);
+ End;
+ End;
+
+ Close (tFile);
+ Close (PromptFile);
+
+ WriteLn ('Done.');
+
+ For A := 0 to mysMaxLanguageStr Do Begin
+ If Not Done[A] Then Begin
+ WriteLn;
+ WriteLn (^G'ERROR: String #', A, ' was not found. Language file not created.');
+ Erase (PromptFile);
+ End;
+ End;
+End.
diff --git a/mystic/mbbsutil.pas b/mystic/mbbsutil.pas
new file mode 100644
index 0000000..50d2a02
--- /dev/null
+++ b/mystic/mbbsutil.pas
@@ -0,0 +1,972 @@
+// ====================================================================
+// Mystic BBS Software Copyright 1997-2012 By James Coyle
+// ====================================================================
+//
+// This file is part of Mystic BBS.
+//
+// Mystic BBS is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Mystic BBS is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Mystic BBS. If not, see .
+//
+// ====================================================================
+
+Program MBBSUTIL;
+
+// post a text file to msg base?
+// auto mass upload
+// import AREAS.BBS?
+// .TIC stuff?
+
+{$I M_OPS.PAS}
+
+Uses
+ CRT,
+ Dos,
+ m_DateTime,
+ m_Strings,
+ m_QuickSort,
+ bbs_MsgBase_ABS,
+ bbs_MsgBase_JAM,
+ bbs_MsgBase_Squish;
+
+{$I RECORDS.PAS}
+
+Type
+ JamLastType = Record
+ NameCrc : LongInt;
+ UserNum : LongInt;
+ LastRead : LongInt;
+ HighRead : LongInt;
+ End;
+
+ SquLastType = LongInt;
+
+Function Rename_File (OldFN, NewFN: String) : Boolean;
+Var
+ OldF : File;
+Begin
+ Assign (OldF, NewFN);
+ {$I-} Erase (OldF); {$I+}
+ If IoResult = 0 Then;
+
+ Assign (OldF, OldFN);
+ {$I-} ReName (OldF, NewFN); {$I+}
+ Rename_File := (IoResult = 0);
+End;
+
+Function Exist (Str : String) : Boolean;
+Begin
+ Exist := FSearch(Str, '') <> '';
+End;
+
+(***************************************************************************)
+(***************************************************************************)
+(***************************************************************************)
+
+Const
+ FilePack : Boolean = False;
+ FileSort : Boolean = False;
+ FileCheck : Boolean = False;
+ BBSPack : Boolean = False;
+ BBSSort : Boolean = False;
+ BBSKill : Boolean = False;
+ UserKill : Boolean = False;
+ UserPack : Boolean = False;
+ MsgTrash : Boolean = False;
+
+ UserKillDays : Integer = 0;
+ BBSSortID : String[8] = '';
+ BBSSortType : Byte = 0;
+ BBSKillID : String[8] = '';
+ BBSKillDays : Integer = 0;
+ TrashFile : String = '';
+
+Var
+ ConfigFile : File of RecConfig;
+ Config : RecConfig;
+
+Procedure Update_Status (Str: String);
+Begin
+ GotoXY (44, WhereY);
+ Write (strPadR(Str, 35, ' '));
+End;
+
+Procedure Update_Bar (Cur, Total: Integer);
+Var
+ Percent : Byte;
+Begin
+ Percent := Round(Cur / Total * 100 / 10);
+ GotoXY (24, WhereY);
+ Write (strRep(#178, Percent));
+ Write (strRep(#176, 10 - Percent));
+ Write (strPadL(strI2S(Percent * 10) + '%', 5, ' '));
+End;
+
+Procedure Show_Help;
+Begin
+ WriteLn ('Usage: MBBSUTIL.EXE ');
+ WriteLn;
+ WriteLn ('The following command line options are available:');
+ WriteLn;
+ WriteLn ('-BKILL Delete BBSes which haven''t been verified in ');
+ WriteLn ('-BPACK Pack all BBS lists');
+ WriteLn ('-BSORT Sorts and packs BBS list by ');
+ WriteLn ('-FCHECK Checks file entries for correct size and status');
+ WriteLn ('-FPACK Pack file bases');
+ WriteLn ('-FSORT Sort file base entries by filename');
+ WriteLn ('-UKILL Delete users who have not called in ');
+ WriteLn ('-UPACK Pack user database');
+ WriteLn ('-MTRASH Delete messages to/from users listed in ');
+End;
+
+Procedure Sort_File_Bases;
+Var
+ SortList : TQuickSort;
+ FBaseFile : File of FBaseRec;
+ FBase : FBaseRec;
+ FDirFile : File of FDirRec;
+ TFDirFile : File of FDirRec;
+ FDir : FDirRec;
+ A : Word;
+Begin
+ Write ('Sorting File Bases : ');
+
+ Assign (FBaseFile, Config.DataPath + 'fbases.dat');
+ {$I-} Reset (FBaseFile); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ While Not Eof(FBaseFile) Do Begin
+ Read (FBaseFile, FBase);
+
+ Update_Bar (FilePos(FBaseFile), FileSize(FBaseFile));
+ Update_Status (strStripMCI(FBase.Name));
+
+ If ReName_File (Config.DataPath + FBase.FileName + '.dir', Config.DataPath + FBase.FileName + '.dib') Then Begin
+ Assign (FDirFile, Config.DataPath + FBase.FileName + '.dib');
+ Reset (FDirFile);
+
+ Assign (TFDirFile, Config.DataPath + FBase.FileName + '.dir');
+ ReWrite (TFDirFile);
+
+ SortList := TQuickSort.Create;
+
+ While Not Eof(FDirFile) Do Begin
+ Read (FDirFile, FDir);
+ If (FDir.Flags AND FDirDeleted = 0) Then
+ {$IFDEF FS_SENSITIVE}
+ SortList.Add(FDir.FileName, FilePos(FDirFile) - 1);
+ {$ELSE}
+ SortList.Add(strUpper(FDir.FileName), FilePos(FDirFile) - 1);
+ {$ENDIF}
+ End;
+
+ SortList.Sort(1, SortList.Total, qDescending);
+
+ For A := 1 to SortList.Total Do Begin
+ Seek (FDirFile, SortList.Data[A]^.Ptr);
+ Read (FDirFile, FDir);
+ Write (TFDirFile, FDir);
+ End;
+
+ SortList.Free;
+
+ Close (FDirFile);
+ Erase (FDirFile);
+ Close (TFDirFile);
+ End;
+ End;
+ Close (FBaseFile);
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Pack_File_Bases;
+Var
+ A : Byte;
+ Temp : String[50];
+ FDirFile : File of FDirRec;
+ TFDirFile : File of FDirRec;
+ FDir : FDirRec;
+ DataFile : File;
+ TDataFile : File;
+ FBaseFile : File of FBaseRec;
+ FBase : FBaseRec;
+
+Begin
+ Write ('Packing File Bases : ');
+
+ Assign (FBaseFile, Config.DataPath + 'fbases.dat');
+ {$I-} Reset (FBaseFile); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ While Not Eof(FBaseFile) Do Begin
+ Read (FBaseFile, FBase);
+
+ Update_Bar (FilePos(FBaseFile), FileSize(FBaseFile));
+ Update_Status (strStripMCI(FBase.Name));
+
+ If ReName_File (Config.DataPath + FBase.FileName + '.dir', Config.DataPath + FBase.FileName + '.dib') Then Begin
+ Assign (FDirFile, Config.DataPath + FBase.FileName + '.dib');
+ Reset (FDirFile);
+ Assign (TFDirFile, Config.DataPath + FBase.FileName + '.dir');
+ ReWrite (TFDirFile);
+
+ If ReName_File (Config.DataPath + FBase.FileName + '.des', Config.DataPath + FBase.FileName + '.deb') Then Begin
+
+ Assign (TDataFile, Config.DataPath + FBase.FileName + '.deb');
+ Reset (TDataFile, 1);
+
+ Assign (DataFile, Config.DataPath + FBase.FileName + '.des');
+ ReWrite (DataFile, 1);
+
+ While Not Eof(FDirFile) Do Begin
+ Read (FDirFile, FDir);
+ If FDir.Flags AND FDirDeleted = 0 Then Begin
+ Seek (TDataFile, FDir.Pointer);
+
+ FDir.Pointer := FilePos(DataFile);
+
+ For A := 1 to FDir.Lines Do Begin
+ BlockRead (TDataFile, Temp[0], 1);
+ BlockRead (TDataFile, Temp[1], Ord(Temp[0]));
+
+ BlockWrite (DataFile, Temp[0], 1);
+ BlockWrite (DataFile, Temp[1], Ord(Temp[0]));
+ End;
+
+ Write (TFDirFile, FDir);
+ End;
+
+ End;
+ Close (TDataFile);
+ Erase (TDataFile); {delete backup file}
+ Close (DataFile);
+ End;
+ Close (FDirFile);
+ Erase (FDirFile); {delete backup file}
+ Close (TFDirFile);
+ End;
+ End;
+ Close (FBaseFile);
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Check_File_Bases;
+Var
+ FBaseFile : File of FBaseRec;
+ FBase : FBaseRec;
+ FDirFile : File of FDirRec;
+ FDir : FDirRec;
+ TFDirFile : File of FDirRec;
+ DF : File of Byte;
+Begin
+ Write ('Checking File Bases : ');
+
+ Assign (FBaseFile, Config.DataPath + 'fbases.dat');
+ {$I-} Reset (FBaseFile); {$I+}
+ If IoResult <> 0 Then Exit;
+
+ While Not Eof(FBaseFile) Do Begin
+ Read (FBaseFile, FBase);
+
+ Update_Bar (FilePos(FBaseFile), FileSize(FBaseFile));
+ Update_Status (strStripMCI(FBase.Name));
+
+ If ReName_File (Config.DataPath + FBase.FileName + '.dir', Config.DataPath + FBase.FileName + '.dib') Then Begin
+ Assign (FDirFile, Config.DataPath + FBase.FileName + '.dib');
+ Reset (FDirFile);
+ Assign (TFDirFile, Config.DataPath + FBase.FileName + '.dir');
+ ReWrite (TFDirFile);
+
+ While Not Eof(FDirFile) Do Begin
+ Read (FDirFile, FDir);
+ If FDir.Flags And FDirDeleted = 0 Then Begin
+ Assign (DF, FBase.Path + FDir.FileName);
+ {$I-} Reset (DF); {$I+}
+ If IoResult <> 0 Then
+ FDir.Flags := FDir.Flags AND FDirOffline
+ Else Begin
+ FDir.Size := FileSize(DF);
+
+ If FDir.Size = 0 Then
+ FDir.Flags := FDir.Flags OR FDirOffline
+ Else
+ FDir.Flags := FDir.Flags AND NOT FDirOffline;
+
+ Close (DF);
+ End;
+ Write (TFDirFile, FDir);
+ End;
+ End;
+ Close (FDirFile); {delete backup file}
+ Erase (FDirFile);
+ Close (TFDirFile);
+ End;
+ End;
+ Close (FBaseFile);
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Pack_BBS_List;
+Var
+ TBBSFile : File of BBSListRec;
+ BBSFile : File of BBSListRec;
+ BBSList : BBSListRec;
+ Dir : SearchRec;
+ D : DirStr;
+ N : NameStr;
+ E : ExtStr;
+Begin
+ Write ('Packing BBS File :');
+
+ FindFirst (Config.DataPath + '*.bbi', AnyFile - Directory, Dir);
+ While DosError = 0 Do Begin
+
+ FSplit (Dir.Name, D, N, E);
+
+ If ReName_File (Config.DataPath + Dir.Name, Config.DataPath + N + '.bbz') Then Begin
+
+ Assign (TBBSFile, Config.DataPath + N + '.bbz');
+ Reset (TBBSFile);
+
+ Assign (BBSFile, Config.DataPath + Dir.Name);
+ ReWrite (BBSFile);
+
+ While Not Eof(TBBSFile) Do Begin
+ Read (TBBSFile, BBSList);
+
+ If Not BBSList.Deleted Then Write (BBSFile, BBSList);
+
+ Update_Bar (FilePos(TBBSFile), FileSize(TBBSFile));
+ Update_Status (BBSList.BBSName);
+ End;
+
+ Close (TBBSFile);
+ Erase (TBBSFile);
+ Close (BBSFile);
+ End;
+
+ FindNext(Dir);
+ End;
+
+ {$IFNDEF MSDOS}
+ FindClose(Dir);
+ {$ENDIF}
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Sort_BBS_List;
+
+ Procedure SortList;
+ Var
+ TBBSFile,
+ BBSFile : File of BBSListRec;
+ BBS : BBSListRec;
+ SortList : TQuickSort;
+ Str : String;
+ A : Word;
+ Begin
+ If ReName_File (Config.DataPath + BBSSortID + '.bbi', Config.DataPath + BBSSortID + '.bbz') Then Begin
+
+ Update_Status (BBSSortID);
+
+ Assign (TBBSFile, Config.DataPath + BBSSortID + '.bbz');
+ Reset (TBBSFile);
+
+ Assign (BBSFile, Config.DataPath + BBSSortID + '.bbi');
+ ReWrite (BBSFile);
+
+ SortList := TQuickSort.Create;
+
+ While Not Eof(TBBSFile) Do Begin
+ Read (TBBSFile, BBS);
+
+ Update_Bar (FilePos(TBBSFile), FileSize(TBBSFile));
+
+ If Not BBS.Deleted Then Begin
+ Case BBSSortType of
+ 0 : Str := strUpper(BBS.Phone);
+ 1 : Str := strUpper(BBS.Telnet);
+ 2 : Str := strUpper(BBS.BBSName);
+ 3 : Str := strUpper(BBS.Location);
+ End;
+
+ SortList.Add(Str, FilePos(TBBSFile) - 1);
+ End;
+ End;
+
+ SortList.Sort(1, SortList.Total, qDescending);
+
+ For A := 1 to SortList.Total Do Begin
+ Seek (TBBSFile, SortList.Data[A]^.Ptr);
+ Read (TBBSFile, BBS);
+ Write (BBSFile, BBS);
+ End;
+
+ SortList.Free;
+
+ Close (TBBSFile);
+ Erase (TBBSFile);
+ Close (BBSFile);
+ End;
+ End;
+
+Var
+ D : DirStr;
+ N : NameStr;
+ E : ExtStr;
+ Dir : SearchRec;
+Begin
+ Write ('Sorting BBS File :');
+
+ If strUpper(BBSSortID) = 'ALL' Then Begin
+ FindFirst (Config.DataPath + '*.bbi', AnyFile - Directory, Dir);
+ While DosError = 0 Do Begin
+ FSplit (Dir.Name, D, N, E);
+ BBSSortID := N;
+ SortList;
+ FindNext(Dir);
+ End;
+
+ {$IFNDEF MSDOS}
+ FindClose(Dir);
+ {$ENDIF}
+ End Else
+ SortList;
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Kill_BBS_List;
+
+ Procedure PackFile;
+ Var
+ TBBSFile : File of BBSListRec;
+ BBSFile : File of BBSListRec;
+ BBS : BBSListRec;
+ Begin
+ If ReName_File (Config.DataPath + BBSKillID + '.bbi', Config.DataPath + BBSKillID + '.bbb') Then Begin
+
+ Assign (TBBSFile, Config.DataPath + BBSKillID + '.bbb');
+ Reset (TBBSFile);
+
+ Assign (BBSFile, Config.DataPath + BBSKillID + '.bbi');
+ ReWrite (BBSFile);
+
+ While Not Eof(TBBSFile) Do Begin
+ Read (TBBSFile, BBS);
+
+ Update_Bar (FilePos(TBBSFile), FileSize(TBBSFile));
+
+ If DaysAgo(BBS.Verified) >= BBSKillDays Then Begin
+ BBS.Deleted := True;
+ BBSPack := True;
+ Update_Status ('Killing ' + BBS.BBSName);
+ End;
+
+ Write (BBSFile, BBS);
+ End;
+
+ Close (BBSFile);
+ Close (TBBSFile);
+ Erase (TBBSFile);
+ End;
+ End;
+
+Var
+ D : DirStr;
+ N : NameStr;
+ E : ExtStr;
+ Dir : SearchRec;
+Begin
+ Write ('Killing BBS List :');
+
+ If strUpper(BBSKillID) = 'ALL' Then Begin
+ FindFirst (Config.DataPath + '*.bbi', AnyFile - Directory, Dir);
+ While DosError = 0 Do Begin
+ FSplit (Dir.Name, D, N, E);
+ BBSKillID := N;
+ PackFile;
+ FindNext(Dir);
+ End;
+
+ {$IFNDEF MSDOS}
+ FindClose(Dir);
+ {$ENDIF}
+ End Else
+ PackFile;
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Kill_User_File;
+Var
+ tUserFile,
+ UserFile : File of RecUser;
+ User : RecUser;
+Begin
+ Write ('Killing User File :');
+
+ If ReName_File (Config.DataPath + 'users.dat', Config.DataPath + 'users.dab') Then Begin
+
+ Assign (TUserFile, Config.DataPath + 'users.dab');
+ Reset (TUserFile);
+
+ Assign (UserFile, Config.DataPath + 'users.dat');
+ ReWrite (UserFile);
+
+ While Not Eof(TUserFile) Do Begin
+ Read (TUserFile, User);
+
+ Update_Bar (FilePos(TUserFile), FileSize(TUserFile));
+
+ If (DaysAgo(User.LastOn) >= UserKillDays) And (User.Flags AND UserNoKill = 0) Then Begin
+ User.Flags := User.Flags OR UserDeleted;
+ Update_Status ('Killing ' + User.Handle);
+ UserPack := True;
+ End;
+
+ Write (UserFile, User);
+ End;
+ Close (UserFile);
+ Close (tUserFile);
+ Erase (tUserFile);
+ End;
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure Pack_User_File;
+Var
+ SquLRFile : File of SquLastType;
+ SquLR : SquLastType;
+ UserFile : File of RecUser;
+ TUserFile : File of RecUser;
+ User : RecUser;
+ MBaseFile : File of MBaseRec;
+ MBase : MBaseRec;
+ MScanFile : File of MScanRec;
+ MScan : MScanRec;
+ FBaseFile : File of FBaseRec;
+ FBase : FBaseRec;
+ FScanFile : File of FScanRec;
+ FScan : FScanRec;
+ JamLRFile : File of JamLastType;
+ TJamLRFile : File of JamLastType;
+ JamLR : JamLastType;
+ Deleted : LongInt;
+ Count : LongInt;
+ MsgBase : PMsgBaseABS;
+Begin
+ Write ('Packing User File :');
+
+ If ReName_File (Config.DataPath + 'users.dat', Config.DataPath + 'users.dab') Then Begin
+
+ Assign (TUserFile, Config.DataPath + 'users.dab');
+ Reset (TUserFile);
+
+ Assign (UserFile, Config.DataPath + 'users.dat');
+ ReWrite (UserFile);
+
+ Deleted := 0;
+
+ While Not Eof(TUserFile) Do Begin
+ Read (TUserFile, User);
+
+ Update_Bar (FilePos(TUserFile), FileSize(TUserFile));
+
+ If (User.Flags AND UserDeleted <> 0) And (User.Flags AND UserNoKill = 0) Then Begin
+
+ Update_Status ('Deleted ' + User.Handle);
+
+ { DELETE MESSAGES FROM ANY PRIVATE MSG BASE }
+
+ Assign (MBaseFile, Config.DataPath + 'mbases.dat');
+ {$I-} Reset (MBaseFile); {$I+}
+ If IoResult = 0 Then Begin
+ While Not Eof(MBaseFile) Do Begin
+ Read (MBaseFile, MBase);
+
+ If MBase.PostType <> 1 Then Continue;
+
+ Case MBase.BaseType of
+ 0 : MsgBase := New(PMsgBaseJAM, Init);
+ 1 : MsgBase := New(PMsgBaseSquish, Init);
+ End;
+
+ MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
+
+ If Not MsgBase^.OpenMsgBase Then Begin
+ Dispose (MsgBase, Done);
+ Continue;
+ End;
+
+ MsgBase^.SeekFirst(1);
+
+ While MsgBase^.SeekFound Do Begin
+ MsgBase^.MsgStartUp;
+
+ If (strUpper(MsgBase^.GetFrom) = strUpper(User.RealName)) or
+ (strUpper(MsgBase^.GetFrom) = strUpper(User.Handle)) or
+ (strUpper(MsgBase^.GetTo) = strUpper(User.RealName)) or
+ (strUpper(MsgBase^.GetTo) = strUpper(User.Handle)) Then
+ MsgBase^.DeleteMsg;
+
+ MsgBase^.SeekNext;
+ End;
+
+ MsgBase^.CloseMsgBase;
+
+ Dispose(MsgBase, Done);
+ End;
+
+ Close (MBaseFile);
+ End;
+
+ { DELETE LASTREAD AND SCAN SETTINGS FOR MESSAGE BASES }
+
+ Assign (MBaseFile, Config.DataPath + 'mbases.dat');
+ {$I-} Reset (MBaseFile); {$I+}
+ If IoResult = 0 Then Begin
+ While Not Eof(MBaseFile) Do Begin
+ Read (MBaseFile, MBase);
+
+ Case MBase.BaseType of
+ 0 : Begin
+ { DELETE JAM LASTREAD RECORDS }
+
+ If ReName_File (MBase.Path + MBase.FileName + '.jlr', MBase.Path + MBase.FileName + '.jlb') Then Begin
+ Assign (TJamLRFile, MBase.Path + MBase.FileName + '.jlb');
+ Reset (TJamLRFile);
+
+ Assign (JamLRFile, MBase.Path + MBase.FileName + '.jlr');
+ ReWrite (JamLRFile);
+
+ Count := FilePos(TUserFile);
+
+ While Not Eof(TJamLRFile) Do Begin
+ Read (TJamLRFile, JamLR);
+
+ If JamLR.UserNum = Count - Deleted Then Continue;
+ If JamLR.UserNum > Count - Deleted Then Dec(JamLR.UserNum);
+
+ Write (JamLRFile, JamLR);
+ End;
+
+ Close (TJamLRFile);
+ Erase (TJamLRFile);
+ Close (JamLRFile);
+ End;
+ End;
+ 1 : Begin
+ { DELETE SQUISH LASTREAD RECORDS }
+
+ Assign (SquLRFile, Config.MsgsPath + MBase.FileName + '.sql');
+ {$I-} Reset (SquLRFile); {$I+}
+ If IoResult = 0 Then Begin
+ If FilePos(TUserFile) - 1 <= FileSize(SquLRFile) Then Begin
+ For Count := FilePos(TUserFile) - 1 to FileSize(SquLRFile) - 2 Do Begin
+ Seek (SquLRFile, Count + 1);
+ Read (SquLRFile, SquLR);
+ Seek (SquLRFile, Count);
+ Write (SquLRFile, SquLR);
+ End;
+ Seek (SquLRFile, FileSize(SquLRFile) - 1);
+ Truncate (SquLRFile);
+ End;
+ Close (SquLRFile);
+ End;
+ End;
+ End;
+
+ { DELETE MSCAN RECORDS }
+
+ Assign (MScanFile, Config.MsgsPath + MBase.FileName + '.scn');
+ {$I-} Reset (MScanFile); {$I+}
+ If IoResult = 0 Then Begin
+ If FilePos(TUserFile) - 1 - Deleted <{=} FileSize(MScanFile) Then Begin
+ For Count := FilePos(TUserFile) - 1 - Deleted to FileSize(MScanFile) - 2 Do Begin
+ Seek (MScanFile, Count + 1);
+ Read (MScanFile, MScan);
+ Seek (MScanFile, Count);
+ Write (MScanFile, MScan);
+ End;
+ Seek (MScanFile, FileSize(MScanFile) - 1);
+ Truncate (MScanFile);
+ End;
+ Close (MScanFile);
+ End;
+ End;
+ Close (MBaseFile);
+ End;
+
+ { DELETE FSCAN RECORDS }
+
+ Assign (FBaseFile, Config.DataPath + 'fbases.dat');
+ {$I-} Reset (FBaseFile); {$I+}
+ If IoResult = 0 Then Begin
+ While Not Eof(FBaseFile) Do Begin
+ Read (FBaseFile, FBase);
+ Assign (FScanFile, Config.DataPath + FBase.FileName + '.scn');
+ {$I-} Reset (FScanFile); {$I+}
+ If IoResult = 0 Then Begin
+ If FilePos(TUserFile) - 1 - Deleted <{=} FileSize(FScanFile) Then Begin
+ For Count := FilePos(TUserFile) - 1 - Deleted to FileSize(FScanFile) - 2 Do Begin
+ Seek (FScanFile, Count + 1);
+ Read (FScanFile, FScan);
+ Seek (FScanFile, Count);
+ Write (FScanFile, FScan);
+ End;
+ Seek (FScanFile, FileSize(FScanFile) - 1);
+ Truncate (FScanFile);
+ End;
+ Close (FScanFile);
+ End;
+ End;
+ Close (FBaseFile);
+ End;
+
+ Inc (Deleted);
+ End Else
+ Write (UserFile, User);
+ End;
+ Close (TUserFile);
+ Erase (TUserFile);
+ Close (UserFile);
+ End;
+
+ Update_Status ('Completed');
+ WriteLn;
+End;
+
+Procedure MsgBase_Trash;
+Var
+ TF : Text;
+ BadName : String;
+ MBaseFile : File of MBaseRec;
+ MBase : MBaseRec;
+ MsgBase : PMsgBaseABS;
+Begin
+ Write ('Trashing Messages :');
+
+ Assign (TF, TrashFile);
+ {$I-} Reset(TF); {$I+}
+ If IoResult = 0 Then Begin
+ While Not Eof(TF) Do Begin
+ ReadLn(TF, BadName);
+
+ BadName := strUpper(strStripB(BadName, ' '));
+
+ If BadName = '' Then Continue;
+
+ Update_Status(BadName);
+
+ Assign (MBaseFile, Config.DataPath + 'mbases.dat');
+ {$I-} Reset(MBaseFile); {$I+}
+ If IoResult <> 0 Then Continue;
+ Read (MBaseFile, MBase);
+
+ While Not Eof(MBaseFile) Do Begin
+ Read (MBaseFile, MBase);
+
+ Update_Bar(FilePos(MBaseFile), FileSize(MBaseFile));
+
+ Case MBase.BaseType of
+ 0 : MsgBase := New(PMsgBaseJAM, Init);
+ 1 : MsgBase := New(PMsgBaseSquish, Init);
+ End;
+
+ MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
+
+ If Not MsgBase^.OpenMsgBase Then Begin
+ Dispose (MsgBase, Done);
+ Continue;
+ End;
+
+ MsgBase^.SeekFirst(1);
+
+ While MsgBase^.SeekFound Do Begin
+ MsgBase^.MsgStartUp;
+
+ If (strUpper(MsgBase^.GetFrom) = BadName) or
+ (strUpper(MsgBase^.GetTo) = BadName) Then
+ MsgBase^.DeleteMsg;
+
+ MsgBase^.SeekNext;
+ End;
+
+ MsgBase^.CloseMsgBase;
+
+ Dispose(MsgBase, Done);
+ End;
+
+ Close (MBaseFile);
+ End;
+
+ Close (TF);
+ End;
+
+ Update_Bar(100, 100);
+ Update_Status('Completed');
+ WriteLn;
+End;
+
+Var
+ A : Byte;
+ Temp : String;
+ ChatFile : File of ChatRec;
+ Chat : ChatRec;
+Begin
+ TextAttr := 7;
+ WriteLn;
+ WriteLn ('MBBSUTIL: ', mysSoftwareID, ' BBS Utilities Version ', mysVersion, ' (', OSID, ')');
+ WriteLn ('Copyright (C) 1997-2011 By James Coyle. All Rights Reserved.');
+ WriteLn;
+
+ FileMode := 66;
+
+ Assign (ConfigFile, 'mystic.dat');
+ {$I-} Reset(ConfigFile); {$I+}
+ If IoResult <> 0 Then Begin
+ WriteLn ('Error reading MYSTIC.DAT. Run MBBSUTIL from the main BBS directory.');
+ Halt(1);
+ End;
+ Read (ConfigFile, Config);
+ Close (ConfigFile);
+
+ If Config.DataChanged <> mysDataChanged Then Begin
+ WriteLn('ERROR: Data files are not current and must be upgraded.');
+ Halt(1);
+ End;
+
+ If ParamCount = 0 Then Begin
+ Show_Help;
+ Exit;
+ End;
+
+ A := 1;
+
+ While (A <= ParamCount) Do Begin
+ Temp := strUpper(ParamStr(A));
+ If Temp = '-BKILL' Then Begin
+ BBSKillID := ParamStr(A+1);
+ BBSKillDays := strS2I(ParamStr(A+2));
+ Inc(A, 2);
+ If (strUpper(BBSKillID) <> 'ALL') And Not Exist(Config.DataPath + BBSKillID + '.bbi') Then Begin
+ WriteLn ('ERROR: -BKILL: List ID (' + BBSKillID + ') does not exist.');
+ Halt(1);
+ End Else
+ If BBSKillDays < 1 Then Begin
+ WriteLn ('ERROR: -BKILL days must be set to a LEAST 1.');
+ Halt(1);
+ End Else
+ BBSKill := True;
+ End;
+ If Temp = '-BPACK' Then BBSPack := True;
+ If Temp = '-BSORT' Then Begin
+ BBSSortID := ParamStr(A+1);
+ Temp := strUpper(ParamStr(A+2));
+
+ Inc (A, 2);
+
+ If Temp = 'PHONE' Then
+ BBSSortType := 0
+ Else
+ If Temp = 'TELNET' Then
+ BBSSortType := 1
+ Else
+ If Temp = 'BBSNAME' Then
+ BBSSortType := 2
+ Else
+ If Temp = 'LOCATION' Then
+ BBSSortType := 3
+ Else Begin
+ WriteLn ('ERROR: -BSORT: Invalid sort type.');
+ Halt(1);
+ End;
+
+ If (strUpper(BBSSortID) <> 'ALL') And Not Exist(Config.DataPath + BBSSortID + '.bbi') Then Begin
+ WriteLn ('ERROR: -BSORT: List ID (' + BBSSortID + ') does not exist.');
+ Halt(1);
+ End Else
+ BBSSort := True;
+ End;
+ If Temp = '-FCHECK' Then FileCheck := True;
+ If Temp = '-FPACK' Then FilePack := True;
+ If Temp = '-FSORT' Then FileSort := True;
+ If Temp = '-UKILL' Then Begin
+ UserKill := True;
+ Inc(A);
+ UserKillDays := strS2I(ParamStr(A));
+ If UserKillDays < 5 Then Begin
+ WriteLn ('ERROR: -UKILL days must be set to at LEAST 5.');
+ Halt(1);
+ End;
+ End;
+ If Temp = '-MTRASH' Then Begin
+ Inc(A);
+
+ MsgTrash := True;
+ TrashFile := strStripB(ParamStr(A), ' ');
+
+ If (TrashFile <> '') And Not Exist(TrashFile) Then Begin
+ WriteLn('ERROR: Trash file does not exist.');
+ Halt(1);
+ End;
+
+ If TrashFile = '' Then TrashFile := Config.DataPath + 'trashcan.dat';
+ End;
+ If Temp = '-UPACK' Then UserPack := True;
+
+ Inc (A);
+ End;
+
+ For A := 1 to Config.INetTNMax Do Begin
+ Assign (ChatFile, Config.DataPath + 'chat' + strI2S(A) + '.dat');
+ {$I-} Reset (ChatFile); {$I+}
+ If IoResult = 0 Then Begin
+ Read (ChatFile, Chat);
+ If Chat.Active Then Begin
+ WriteLn ('ERROR: MBBSUTIL has detected that a user is online at this time.');
+ WriteLn (' In order to prevent corruption of the system data files,');
+ WriteLn (' this program should only be ran when there are NO users');
+ WriteLn (' logged in to the BBS system.');
+ WriteLn ('');
+ WriteLn ('Create a system event to log off all users before running this program.');
+ WriteLn ('If there are NO users online and MBBSUTIL detects that there are, try');
+ WriteLn ('changing to the data directory, typing "DEL CHAT*.DAT" then re-run');
+ WriteLn ('MBBSUTIL');
+ Halt(1);
+ End;
+ End;
+ End;
+
+ If FileSort Then Sort_File_Bases;
+ If FileCheck Then Check_File_Bases;
+ If FilePack Then Pack_File_Bases;
+ If BBSKill Then Kill_BBS_List;
+ If BBSPack Then Pack_BBS_List;
+ If BBSSort Then Sort_BBS_List;
+ If UserKill Then Kill_User_File;
+ If UserPack Then Pack_User_File;
+ If MsgTrash Then MsgBase_Trash;
+End.