-NOCHECK function and -FUPLOAD now imports FILE_ID.DIZ

This commit is contained in:
mysticbbs 2012-02-24 09:05:05 -05:00
parent d1ef461e43
commit de55cd9a03
1 changed files with 257 additions and 102 deletions

View File

@ -23,7 +23,8 @@ Program MBBSUTIL;
// post a text file to msg base?
// auto mass upload
// import AREAS.BBS?
// export AREAS.BBS?
// import FIDONET.NA
// .TIC stuff?
{$I M_OPS.PAS}
@ -41,38 +42,6 @@ Uses
{$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;
@ -84,18 +53,101 @@ Const
UserKill : Boolean = False;
UserPack : Boolean = False;
MsgTrash : Boolean = False;
NodeCheck : Boolean = True;
UserKillDays : Integer = 0;
BBSSortID : String[8] = '';
BBSSortID : String = '';
BBSSortType : Byte = 0;
BBSKillID : String[8] = '';
BBSKillID : String = '';
BBSKillDays : Integer = 0;
TrashFile : String = '';
TempPath : String = '';
Var
ConfigFile : File of RecConfig;
Config : RecConfig;
Type
JamLastType = Record
NameCrc : LongInt;
UserNum : LongInt;
LastRead : LongInt;
HighRead : LongInt;
End;
SquLastType = LongInt;
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
Begin
If ExecPath <> '' Then DirChange(ExecPath);
{$IFDEF UNIX}
Result := Shell (Command);
{$ENDIF}
{$IFDEF WINDOWS}
If Command <> '' Then Command := '/C' + Command;
Exec (GetEnv('COMSPEC'), Command);
Result := DosExitCode;
{$ENDIF}
DirChange(Config.SystemPath);
End;
Procedure ExecuteArchive (FName: String; Temp: String; Mask: String; Mode: Byte);
{mode: 1 = pack, 2 = unpack}
Var
A : Byte;
Temp2 : String[60];
ArcFile : File of RecArchive;
Arc : RecArchive;
Begin
Temp := JustFileExt(FName);
Reset (ArcFile);
Repeat
If Eof(ArcFile) Then Begin
Close (ArcFile);
Exit;
End;
Read (ArcFile, Arc);
If (Not Arc.Active) or (Arc.OSType <> OSType) Then Continue;
If Arc.Ext = Temp Then Break;
Until False;
Close (ArcFile);
Case Mode of
1 : Temp2 := Arc.Pack;
2 : Temp2 := Arc.Unpack;
End;
If Temp2 = '' Then Exit;
Temp := '';
A := 1;
While A <= Length(Temp2) Do Begin
If Temp2[A] = '%' Then Begin
Inc(A);
If Temp2[A] = '1' Then Temp := Temp + FName Else
If Temp2[A] = '2' Then Temp := Temp + Mask Else
If Temp2[A] = '3' Then Temp := Temp + TempPath;
End Else
Temp := Temp + Temp2[A];
Inc(A);
End;
ShellDOS ('', Temp);
End;
Procedure Update_Status (Str: String);
Begin
GotoXY (44, WhereY);
@ -107,6 +159,7 @@ Var
Percent : Byte;
Begin
Percent := Round(Cur / Total * 100 / 10);
GotoXY (24, WhereY);
Write (strRep(#178, Percent));
Write (strRep(#176, 10 - Percent));
@ -115,7 +168,7 @@ End;
Procedure Show_Help;
Begin
WriteLn ('Usage: MBBSUTIL.EXE <Options>');
WriteLn ('Usage: MBBSUTIL <Options>');
WriteLn;
WriteLn ('The following command line options are available:');
WriteLn;
@ -125,11 +178,17 @@ Begin
WriteLn ('-FCHECK Checks file entries for correct size and status');
WriteLn ('-FPACK Pack file bases');
WriteLn ('-FSORT Sort file base entries by filename');
WriteLn ('-FUPLOAD Mass upload all files into filebases');
WriteLn ('-MTRASH <File> Delete messages to/from users listed in <File>');
WriteLn ('-NOCHECK Bypass online user check at startup');
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;
@ -152,7 +211,7 @@ Begin
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
If FileRename (Config.DataPath + FBase.FileName + '.dir', Config.DataPath + FBase.FileName + '.dib') Then Begin
Assign (FDirFile, Config.DataPath + FBase.FileName + '.dib');
Reset (FDirFile);
@ -186,9 +245,11 @@ Begin
Close (TFDirFile);
End;
End;
Close (FBaseFile);
Update_Status ('Completed');
WriteLn;
End;
@ -203,27 +264,27 @@ Var
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));
Update_Status (strStripPipe(FBase.Name));
If ReName_File (Config.DataPath + FBase.FileName + '.dir', Config.DataPath + FBase.FileName + '.dib') Then Begin
If FileRename (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
If FileRename (Config.DataPath + FBase.FileName + '.des', Config.DataPath + FBase.FileName + '.deb') Then Begin
Assign (TDataFile, Config.DataPath + FBase.FileName + '.deb');
Reset (TDataFile, 1);
@ -250,18 +311,22 @@ Begin
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;
@ -278,15 +343,16 @@ Begin
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));
Update_Status (strStripPipe(FBase.Name));
If ReName_File (Config.DataPath + FBase.FileName + '.dir', Config.DataPath + FBase.FileName + '.dib') Then Begin
If FileRename (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');
@ -294,6 +360,7 @@ Begin
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+}
@ -309,17 +376,21 @@ Begin
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;
@ -336,11 +407,12 @@ 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
If FileRename (Config.DataPath + Dir.Name, Config.DataPath + N + '.bbz') Then Begin
Assign (TBBSFile, Config.DataPath + N + '.bbz');
Reset (TBBSFile);
@ -383,7 +455,7 @@ Procedure Sort_BBS_List;
Str : String;
A : Word;
Begin
If ReName_File (Config.DataPath + BBSSortID + '.bbi', Config.DataPath + BBSSortID + '.bbz') Then Begin
If FileRename (Config.DataPath + BBSSortID + '.bbi', Config.DataPath + BBSSortID + '.bbz') Then Begin
Update_Status (BBSSortID);
@ -438,6 +510,7 @@ Begin
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;
@ -450,6 +523,7 @@ Begin
SortList;
Update_Status ('Completed');
WriteLn;
End;
@ -461,7 +535,7 @@ Procedure Kill_BBS_List;
BBSFile : File of BBSListRec;
BBS : BBSListRec;
Begin
If ReName_File (Config.DataPath + BBSKillID + '.bbi', Config.DataPath + BBSKillID + '.bbb') Then Begin
If FileRename (Config.DataPath + BBSKillID + '.bbi', Config.DataPath + BBSKillID + '.bbb') Then Begin
Assign (TBBSFile, Config.DataPath + BBSKillID + '.bbb');
Reset (TBBSFile);
@ -477,6 +551,7 @@ Procedure Kill_BBS_List;
If DaysAgo(BBS.Verified) >= BBSKillDays Then Begin
BBS.Deleted := True;
BBSPack := True;
Update_Status ('Killing ' + BBS.BBSName);
End;
@ -499,10 +574,12 @@ Begin
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;
@ -511,6 +588,7 @@ Begin
PackFile;
Update_Status ('Completed');
WriteLn;
End;
@ -522,7 +600,7 @@ Var
Begin
Write ('Killing User File :');
If ReName_File (Config.DataPath + 'users.dat', Config.DataPath + 'users.dab') Then Begin
If FileRename (Config.DataPath + 'users.dat', Config.DataPath + 'users.dab') Then Begin
Assign (TUserFile, Config.DataPath + 'users.dab');
Reset (TUserFile);
@ -543,12 +621,14 @@ Begin
Write (UserFile, User);
End;
Close (UserFile);
Close (tUserFile);
Erase (tUserFile);
End;
Update_Status ('Completed');
WriteLn;
End;
@ -576,7 +656,7 @@ Var
Begin
Write ('Packing User File :');
If ReName_File (Config.DataPath + 'users.dat', Config.DataPath + 'users.dab') Then Begin
If FileRename (Config.DataPath + 'users.dat', Config.DataPath + 'users.dab') Then Begin
Assign (TUserFile, Config.DataPath + 'users.dab');
Reset (TUserFile);
@ -651,7 +731,7 @@ Begin
0 : Begin
{ DELETE JAM LASTREAD RECORDS }
If ReName_File (MBase.Path + MBase.FileName + '.jlr', MBase.Path + MBase.FileName + '.jlb') Then Begin
If FileRename (MBase.Path + MBase.FileName + '.jlr', MBase.Path + MBase.FileName + '.jlb') Then Begin
Assign (TJamLRFile, MBase.Path + MBase.FileName + '.jlb');
Reset (TJamLRFile);
@ -690,6 +770,7 @@ Begin
Seek (SquLRFile, FileSize(SquLRFile) - 1);
Truncate (SquLRFile);
End;
Close (SquLRFile);
End;
End;
@ -710,9 +791,11 @@ Begin
Seek (MScanFile, FileSize(MScanFile) - 1);
Truncate (MScanFile);
End;
Close (MScanFile);
End;
End;
Close (MBaseFile);
End;
@ -725,6 +808,7 @@ 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
@ -733,12 +817,15 @@ Begin
Seek (FScanFile, Count);
Write (FScanFile, FScan);
End;
Seek (FScanFile, FileSize(FScanFile) - 1);
Truncate (FScanFile);
End;
Close (FScanFile);
End;
End;
Close (FBaseFile);
End;
@ -752,6 +839,7 @@ Begin
End;
Update_Status ('Completed');
WriteLn;
End;
@ -824,6 +912,7 @@ Begin
Update_Bar(100, 100);
Update_Status('Completed');
WriteLn;
End;
@ -834,12 +923,26 @@ Var
BaseFile : File of FBaseRec;
ListFile : File of RecFileList;
DescFile : File;
DizFile : Text;
Base : FBaseRec;
List : RecFileList;
DirInfo : SearchRec;
Found : Boolean;
Desc : Array[1..99] of String[50];
Count : Integer;
Procedure RemoveDesc (Num: Byte);
Var
A : Byte;
Begin
For A := Num To List.DescLines - 1 Do
Desc[A] := Desc[A + 1];
Desc[List.DescLines] := '';
Dec (List.DescLines);
End;
Begin
Write ('Mass Upload Files :');
@ -898,10 +1001,38 @@ Begin
List.Downloads := 0;
List.Rating := 0;
// IMPORT FILE_ID.DIZ here if not found then
ExecuteArchive (Base.Path + List.FileName, '', 'file_id.diz', 2);
Assign (DizFile, TempPath + 'file_id.diz');
{$I-} Reset (DizFile); {$I+}
If IoResult = 0 Then Begin
List.DescLines := 0;
While Not Eof(DizFile) Do Begin
Inc (List.DescLines);
ReadLn (DizFile, Desc[List.DescLines]);
Desc[List.DescLines] := strStripLOW(Desc[List.DescLines]);
If Length(Desc[List.DescLines]) > mysMaxFileDescLen Then Desc[List.DescLines][0] := Chr(mysMaxFileDescLen);
If List.DescLines = Config.MaxFileDesc Then Break;
End;
Close (DizFile);
While (Desc[1] = '') and (List.DescLines > 0) Do
RemoveDesc(1);
While (Desc[List.DescLines] = '') And (List.DescLines > 0) Do
Dec (List.DescLines);
End Else Begin
List.DescLines := 1;
Desc[1] := NoDescStr;
End;
FileErase (TempPath + 'file_id.diz');
Assign (DescFile, Config.DataPath + Base.FileName + '.des');
@ -946,6 +1077,7 @@ Var
Chat : ChatRec;
Begin
TextAttr := 7;
WriteLn;
WriteLn ('MBBSUTIL: ', mysSoftwareID, ' BBS Utilities Version ', mysVersion, ' (', OSID, ')');
WriteLn ('Copyright (C) 1997-2012 By James Coyle. All Rights Reserved.');
@ -955,10 +1087,12 @@ Begin
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);
@ -976,11 +1110,12 @@ Begin
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
If (strUpper(BBSKillID) <> 'ALL') And Not FileExist(Config.DataPath + BBSKillID + '.bbi') Then Begin
WriteLn ('ERROR: -BKILL: List ID (' + BBSKillID + ') does not exist.');
Halt(1);
End Else
@ -990,6 +1125,7 @@ Begin
End Else
BBSKill := True;
End;
If Temp = '-BPACK' Then BBSPack := True;
If Temp = '-BSORT' Then Begin
BBSSortID := ParamStr(A+1);
@ -1013,7 +1149,7 @@ Begin
Halt(1);
End;
If (strUpper(BBSSortID) <> 'ALL') And Not Exist(Config.DataPath + BBSSortID + '.bbi') Then Begin
If (strUpper(BBSSortID) <> 'ALL') And Not FileExist(Config.DataPath + BBSSortID + '.bbi') Then Begin
WriteLn ('ERROR: -BSORT: List ID (' + BBSSortID + ') does not exist.');
Halt(1);
End Else
@ -1025,8 +1161,11 @@ Begin
If Temp = '-FUPLOAD' Then FileUpload := 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);
@ -1038,7 +1177,7 @@ Begin
MsgTrash := True;
TrashFile := strStripB(ParamStr(A), ' ');
If (TrashFile <> '') And Not Exist(TrashFile) Then Begin
If (TrashFile <> '') And Not FileExist(TrashFile) Then Begin
WriteLn('ERROR: Trash file does not exist.');
Halt(1);
End;
@ -1050,11 +1189,14 @@ Begin
Inc (A);
End;
If NodeCheck Then
For A := 1 to Config.INetTNNodes 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,');
@ -1062,14 +1204,27 @@ Begin
WriteLn (' logged in to the BBS system.');
WriteLn ('');
WriteLn ('Create a system event to log off all users before running this program.');
WriteLn;
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 ('changing to the data directory and deleting "chat*.dat" then re-run');
WriteLn ('MBBSUTIL');
WriteLn;
WriteLn ('Using the -NOCHECK option will bypass this check');
Halt(1);
End;
End;
End;
{$I-}
MkDir (Config.SystemPath + 'temp0');
If IoResult <> 0 Then;
{$I+}
TempPath := Config.SystemPath + 'temp0' + PathChar;
DirClean (TempPath, '');
If FileUpload Then Upload_File_Bases;
If FileSort Then Sort_File_Bases;
If FileCheck Then Check_File_Bases;