Initial import
This commit is contained in:
mysticbbs
parent
e98cf71497
commit
c03a34bbed
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
//
|
||||
// ====================================================================
|
||||
|
||||
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.
|
||||
|
|
@ -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;
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
//
|
||||
// ====================================================================
|
||||
|
||||
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.
|
||||
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
//
|
||||
// ====================================================================
|
||||
|
||||
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 <Options>');
|
||||
WriteLn;
|
||||
WriteLn ('The following command line options are available:');
|
||||
WriteLn;
|
||||
WriteLn ('-BKILL <ID> <Days> Delete BBSes which haven''t been verified in <DAYS>');
|
||||
WriteLn ('-BPACK Pack all BBS lists');
|
||||
WriteLn ('-BSORT <ID> <Type> Sorts and packs BBS list by <type>');
|
||||
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 <Days> Delete users who have not called in <DAYS>');
|
||||
WriteLn ('-UPACK Pack user database');
|
||||
WriteLn ('-MTRASH <File> Delete messages to/from users listed in <File>');
|
||||
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.
|
||||
Loading…
Reference in New Issue