eric
/
Renegade-1.19
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Renegade-1.19/SOURCE/UNUSED/RGMAINT2.PAS

1584 lines
43 KiB
Plaintext
Raw Permalink Normal View History

02-04
2013-02-04 15:56:58 -08:00
{$M 35500,0,131072}
PROGRAM RGMAINT;
USES
Crt,
Dos,
TimeFunc;
{$I RECORDS.PAS}
TYPE
StorageType =
(
Disk,
CD,
Copied
);
BatchDLRecordType = RECORD
BDLFileName: STRING[52];
BDLStorage: StorageType;
BDLUserNum,
BDLSection,
BDLPoints,
BDLUploader: Integer;
BDLFSize,
BDLTime,
BDLOwnerCRC: LongInt;
BDLNoRatio: Boolean;
END;
ULFRec = { *.DIR : File records }
{$IFDEF WIN32} packed {$ENDIF} RECORD
FileName: STRING[12]; { Filename }
LDescription: STRING[60]; { File description }
Credits: Integer; { File points }
Downloaded: Word; { Number DLs }
SizeMod: Word; { # chars over last 128 byte block }
Blocks: LongInt; { # 128 byte blks }
Owner: Word; { ULer of file }
StOwner: STRING[36]; { ULer's name }
Date: STRING[10]; { Date ULed }
DateN: Word; { Numeric Date ULed }
VPointer: LongInt; { Pointer to verbose descr, -1 if none }
FileStat: FiFlagSet; { File status }
Res: ARRAY [1..10] OF Byte; { RESERVED }
END;
VotingR = { VOTING.DAT : Voting records }
{$IFDEF WIN32} packed {$ENDIF} RECORD
Description: STRING[65]; { voting question }
ACS: ACString; { ACS required to vote on this }
ChoiceNumber: Word; { number of choices }
NumVoted: Word; { number of votes on it }
MadeBy: STRING[35]; { who created it }
AddChoicesACS: ACString; { ACS required to add choices }
Choices: ARRAY [1..25] OF
{$IFDEF WIN32} packed {$ENDIF} RECORD
Description: STRING[65]; { answer description }
Description2: STRING[65]; { answer description #2 }
NumVoted: Integer; { # user's who picked this answer }
END;
END;
DirF = FILE OF ULFRec;
SF = FILE OF UserIDXRec;
CONST
DYNY: BOOLEAN = FALSE;
FUNCTION AllCaps(S: STRING): STRING;
VAR
Counter: Byte;
BEGIN
FOR Counter := 1 TO Length(S) DO
IF (S[Counter] IN ['a'..'z']) THEN
S[Counter] := Chr(Ord(S[Counter]) - Ord('a')+Ord('A'));
AllCaps := S;
END;
FUNCTION IntToStr(L: LongInt): STRING;
VAR
S: STRING[11];
BEGIN
Str(L,S);
IntToStr := s;
END;
FUNCTION SQOutSp(S: STRING): STRING;
BEGIN
WHILE (Pos(' ',S) > 0) DO
Delete(S,Pos(' ',S),1);
SQOutSp := S;
END;
FUNCTION Exist(fn: AStr): Boolean;
VAR
DirInfo: SearchRec;
BEGIN
FindFirst(SQOutSp(fn),AnyFile,DirInfo);
Exist := (DOSError = 0);
END;
FUNCTION SYN(B: BOOLEAN): STRING;
BEGIN
IF (B) THEN
SYN := 'Yes'
ELSE
SYN := 'No ';
END;
FUNCTION YN: BOOLEAN;
VAR
C: CHAR;
BEGIN
Write(SQOutSp(SYN(DYNY)));
REPEAT
C := UpCase(Char(ReadKey));
UNTIL (C IN ['Y','N',^M]);
IF (DYNY) AND (C <> 'N') THEN
C := 'Y';
IF (DYNY) AND (C = 'N') THEN
Write(#8#8#8'No ')
ELSE IF (NOT DYNY) AND (C = 'Y') THEN
Write(#8#8'Yes');
WriteLn;
YN := (C = 'Y');
DYNY := FALSE;
END;
FUNCTION PYNQ(CONST S: AStr): BOOLEAN;
BEGIN
Write(S);
PYNQ := YN;
END;
FUNCTION StrToInt(S: STRING): LongInt;
VAR
I: Integer;
L: LongInt;
BEGIN
Val(S,L,I);
IF (I > 0) THEN
BEGIN
S[0] := Chr(I - 1);
Val(S,L,I)
END;
IF (S = '') THEN
StrToInt := 0
ELSE
StrToInt := L;
END;
FUNCTION GetFileSize(FileName: AStr): LongInt;
VAR
F: FILE OF Byte;
FSize: LongInt;
BEGIN
FSize := 0;
IF (Exist(SQOutSp(FileName))) THEN
BEGIN
Assign(F,SQOutSp(FileName));
Reset(F);
FSize := FileSize(F);
Close(F);
END;
GetFileSize := FSize;
END;
PROCEDURE KillUserVotes(DataPath: STRING; VAR User: UserRecordType);
VAR
VotingFile: FILE OF VotingR;
Topic: VotingR;
Counter: Integer;
BEGIN
IF (Exist(DataPath+'VOTING.DAT')) THEN
BEGIN
Assign(VotingFile,DataPath+'VOTING.DAT');
Reset(VotingFile);
FOR Counter := 1 TO FileSize(VotingFile) DO
IF (User.Vote[Counter] > 0) THEN
BEGIN
Seek(VotingFile,(Counter - 1));
Read(VotingFile,Topic);
IF (Topic.NumVoted > 0) THEN
Dec(Topic.NumVoted);
IF (Topic.Choices[User.Vote[Counter]].NumVoted > 0) THEN
Dec(Topic.Choices[User.Vote[Counter]].NumVoted);
Seek(VotingFile,(Counter - 1));
Write(VotingFile,Topic);
User.Vote[Counter] := 0;
END;
Close(VotingFile);
END;
END;
PROCEDURE ResetVotes(DataPath: STRING);
VAR
VotingFile: FILE OF VotingR;
Topic: VotingR;
Counter,
Counter1: Integer;
BEGIN
IF (Exist(DataPath+'VOTING.DAT')) THEN
BEGIN
Assign(VotingFile,DataPath+'VOTING.DAT');
Reset(VotingFile);
FOR Counter := 1 TO FileSize(VotingFile) DO
BEGIN
Seek(VotingFile,(Counter - 1));
Read(VotingFile,Topic);
Topic.NumVoted := 0;;
FOR Counter1 := 1 TO 25 DO
Topic.Choices[Counter1].NumVoted := 0;
Seek(VotingFile,(Counter - 1));
Write(VotingFile,Topic);
END;
Close(VotingFile);
END;
END;
PROCEDURE ReScanUserVotes(DataPath: STRING; VAR User: UserRecordType);
VAR
VotingFile: FILE OF VotingR;
Topic: VotingR;
Counter: Integer;
BEGIN
IF (Exist(DataPath+'VOTING.DAT')) THEN
BEGIN
Assign(VotingFile,DataPath+'VOTING.DAT');
Reset(VotingFile);
FOR Counter := 1 TO FileSize(VotingFile) DO
IF (User.Vote[Counter] > 0) THEN
BEGIN
Seek(VotingFile,(Counter - 1));
Read(VotingFile,Topic);
Inc(Topic.NumVoted);
Inc(Topic.Choices[User.Vote[Counter]].NumVoted);
Seek(VotingFile,(Counter - 1));
Write(VotingFile,Topic);
END;
Close(VotingFile);
END;
END;
PROCEDURE KillShortMsgs(DataPath: STRING; VAR User: UserRecordType);
VAR
ShortMsgFile: FILE OF ShortMessageRecordType;
ShortMsg: ShortMessageRecordType;
Counter: Integer;
BEGIN
IF (Exist(DataPath+'SHORTMSG.DAT')) THEN
BEGIN
Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT');
Reset(ShortMsgFile);
FOR Counter := 1 TO FileSize(ShortMsgFile) DO
BEGIN
Seek(ShortMsgFile,(Counter - 1));
Read(ShortMsgFile,ShortMsg);
IF (ShortMsg.Destin = User.UserID) THEN
ShortMsg.Destin := -1;
Seek(ShortMsgFile,(Counter - 1));
Write(ShortMsgFile,ShortMsg);
END;
Close(ShortMsgFile);
END;
END;
PROCEDURE UpdateShortMsgs(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer);
VAR
ShortMsgFile: FILE OF ShortMessageRecordType;
ShortMsg: ShortMessageRecordType;
Counter: Integer;
BEGIN
IF Exist(DataPath+'SHORTMSG.DAT') THEN
BEGIN
Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT');
Reset(ShortMsgFile);
FOR Counter := 1 TO FileSize(ShortMsgFile) DO
BEGIN
Seek(ShortMsgFile,(Counter - 1));
Read(ShortMsgFile,ShortMsg);
IF (ShortMsg.Destin = User.UserID) THEN
ShortMsg.Destin := NewUserNumber;
Seek(ShortMsgFile,(Counter - 1));
Write(ShortMsgFile,ShortMsg);
END;
Close(ShortMsgFile);
END;
END;
PROCEDURE PurgingShortMsgs(DataPath: STRING);
VAR
ShortMsgFile: FILE OF ShortMessageRecordType;
ShortMsgFile1: FILE OF ShortMessageRecordType;
ShortMsg: ShortMessageRecordType;
Counter: Integer;
BEGIN
IF Exist(DataPath+'SHORTMSG.DAT') THEN
BEGIN
Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT');
Reset(ShortMsgFile);
Assign(ShortMsgFile1,DataPath+'SHORTMSG.BAK');
ReWrite(ShortMsgFile1);
FOR Counter := 1 TO FileSize(ShortMsgFile) DO
BEGIN
Seek(ShortMsgFile,(Counter - 1));
Read(ShortMsgFile,ShortMsg);
IF (ShortMsg.Destin <> -1) THEN
BEGIN
Seek(ShortMsgFile1,FileSize(ShortMsgFile1));
Write(ShortMsgFile1,ShortMsg);
END;
END;
Close(ShortMsgFile);
Erase(ShortMsgFile);
Close(ShortMsgFile1);
ReName(ShortMsgFile1,DataPath+'SHORTMSG.DAT');
END;
END;
PROCEDURE KillBatchQueue(DataPath: STRING; VAR User: UserRecordType);
VAR
BatchDLFile: FILE OF BatchDlRecordType;
BatchDL: BatchDlRecordType;
Counter: Integer;
BEGIN
IF Exist(DataPath+'BATCHDL.DAT') THEN
BEGIN
Assign(BatchDLFile,DataPath+'BATCHDL.DAT');
Reset(BatchDLFile);
FOR Counter := 1 TO FileSize(BatchDLFile) DO
BEGIN
Seek(BatchDLFile,(Counter - 1));
Read(BatchDLFile,BatchDL);
IF (BatchDL.BDLUserNum = User.UserID) THEN
BatchDL.BDLUserNum := -1;
Seek(BatchDLFile,(Counter - 1));
Write(BatchDLFile,BatchDL);
END;
Close(BatchDLFile);
END;
END;
PROCEDURE UpdateBatchQueue(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer);
VAR
BatchDLFile: FILE OF BatchDLRecordType;
BatchDL: BatchDlRecordType;
Counter: Integer;
BEGIN
IF Exist(DataPath+'BATCHDL.DAT') THEN
BEGIN
Assign(BatchDLFile,DataPath+'BATCHDL.DAT');
Reset(BatchDLFile);
FOR Counter := 1 TO FileSize(BatchDLFile) DO
BEGIN
Seek(BatchDLFile,(Counter - 1));
Read(BatchDLFile,BatchDL);
IF (BatchDL.BDLUserNum = User.UserID) THEN
BatchDL.BDLUserNum := NewUserNumber;
Seek(BatchDLFile,(Counter - 1));
Write(BatchDLFile,BatchDL);
END;
Close(BatchDLFile);
END;
END;
PROCEDURE PurgingBatchQueue(DataPath: STRING);
VAR
BatchDLFile: FILE OF BatchDLRecordType;
BatchDLFile1: FILE OF BatchDLRecordType;
BatchDL: BatchDLRecordType;
Counter: Integer;
BEGIN
IF Exist(DataPath+'BATCHDL.DAT') THEN
BEGIN
Assign(BatchDLFile,DataPath+'BATCHDL.DAT');
Reset(BatchDLFile);
Assign(BatchDLFile1,DataPath+'BATCHDL.BAK');
ReWrite(BatchDLFile1);
FOR Counter := 1 TO FileSize(BatchDLFile) DO
BEGIN
Seek(BatchDLFile,(Counter - 1));
Read(BatchDLFile,BatchDL);
IF (BatchDL.BDLUserNum <> -1) THEN
BEGIN
Seek(BatchDLFile1,FileSize(BatchDLFile1));
Write(BatchDLFile1,BatchDL);
END;
END;
Close(BatchDLFile);
Erase(BatchDLFile);
Close(BatchDLFile1);
ReName(BatchDLFile1,DataPath+'BATCHDL.DAT');
END;
END;
PROCEDURE KillUserEMail(DataPath,MsgPath: STRING; VAR User: UserRecordType);
VAR
MsgHdrF: FILE OF MHeaderRec;
MHeader: MHeaderRec;
MsgNum: Word;
BEGIN
IF (Exist(MsgPath+'EMAIL.HDR')) THEN
BEGIN
Assign(MsgHdrF,MsgPath+'EMAIL.HDR');
Reset(MsgHdrF);
FOR MsgNum := 1 TO FileSize(MsgHdrF) DO
BEGIN
Seek(MsgHdrF,(MsgNum - 1));
Read(MsgHdrF,MHeader);
IF ((MHeader.MTO.UserNum = User.UserID) OR (MHeader.From.UserNum = User.UserID)) THEN
Include(MHeader.Status,MDeleted);
IF (MHeader.MTO.UserNum = User.UserID) THEN
MHeader.MTO.UserNum := 0;
IF (MHeader.FROM.UserNum = User.UserID) THEN
MHeader.FROM.UserNum := 0;
Seek(MsgHdrF,(MsgNum - 1));
Write(MsgHdrF,MHeader);
END;
Close(MsgHdrF);
User.Waiting := 0;
END;
END;
PROCEDURE UpdateUserEMail(MsgPath: STRING; VAR User: UserRecordType; NewUserNum: Integer);
VAR
MsgHdrF: FILE OF MHeaderRec;
MHeader: MHeaderRec;
MsgNum: Word;
BEGIN
IF (Exist(MsgPath+'EMAIL.HDR')) THEN
BEGIN
Assign(MsgHdrF,MsgPath+'EMAIL.HDR');
Reset(MsgHdrF);
FOR MsgNum := 1 TO FileSize(MsgHdrF) DO
BEGIN
Seek(MsgHdrF,(MsgNum - 1));
Read(MsgHdrF,MHeader);
IF (MHeader.MTO.UserNum = User.UserID) THEN
MHeader.MTO.UserNum := NewUserNum;
IF (MHeader.From.UserNum = User.UserID) THEN
MHeader.From.UserNum := NewUserNum;
Seek(MsgHdrF,(MsgNum - 1));
Write(MsgHdrF,MHeader);
END;
Close(MsgHdrF);
END;
END;
PROCEDURE ReScanUserEMail(MsgPath: STRING; VAR User: UserRecordType; UserNum: Integer);
VAR
MsgHdrF: FILE OF MHeaderRec;
MHeader: MHeaderRec;
MsgNum: Word;
BEGIN
IF (Exist(MsgPath+'EMAIL.HDR')) THEN
BEGIN
User.Waiting := 0;
Assign(MsgHdrF,MsgPath+'EMAIL.HDR');
Reset(MsgHdrF);
FOR MsgNum := 1 TO FileSize(MsgHdrF) DO
BEGIN
Seek(MsgHdrF,(MsgNum - 1));
Read(MsgHdrF,MHeader);
IF (MHeader.MTO.UserNum = UserNum) THEN
IF (NOT (MDeleted IN MHeader.Status)) THEN
Inc(User.Waiting);
END;
Close(MsgHdrF);
END;
END;
PROCEDURE UpdateDIRFilesDeletedUsers(DataPath: STRING; User,SysOpUser: UserRecordType);
VAR
FileAreaFile: FILE OF FileAreaRecordType;
DirFile: FILE OF ULFRec;
FileArea: FileAreaRecordType;
VerbF: FILE;
F: ULFRec;
Counter,
Counter1: Integer;
BEGIN
Assign(FileAreaFile,DataPath+'FBASES.DAT');
Reset(FileAreaFile);
FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO
BEGIN
Seek(FileAreaFile,Counter);
Read(FileAreaFile,FileArea);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR')
ELSE
Assign(Dirfile,Datapath+FileArea.FileName+'.DIR');
Reset(Dirfile);
IF (IOResult = 2) THEN
ReWrite(Dirfile);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT')
ELSE
Assign(VerbF,Datapath+FileArea.FileName+'.EXT');
Reset(VerbF,1);
IF (IOResult = 2) THEN
ReWrite(VerbF,1);
FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO
BEGIN
Seek(DirFile,Counter1);
Read(DirFile,F);
IF (F.Owner = User.UserID) THEN
BEGIN
F.Owner := SysOpUser.UserID;
F.StOwner := AllCaps(SysOpUser.Name);
END;
Seek(DirFile,Counter1);
Write(DirFile,F);
END;
Close(DirFile);
Close(VerbF);
END;
Close(FileAreaFile);
END;
PROCEDURE UpdateDIRFilesExistingUsers(DataPath: STRING; User: UserRecordType; NewUserNum: Integer);
VAR
FileAreaFile: FILE OF FileAreaRecordType;
DirFile: FILE OF ULFRec;
VerbF: FILE;
FileArea: FileAreaRecordType;
F: ULFRec;
Counter,
Counter1: Integer;
BEGIN
Assign(FileAreaFile,DataPath+'FBASES.DAT');
Reset(FileAreaFile);
FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO
BEGIN
Seek(FileAreaFile,Counter);
Read(FileAreaFile,FileArea);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR')
ELSE
Assign(Dirfile,Datapath+FileArea.FileName+'.DIR');
Reset(Dirfile);
IF (IOResult = 2) THEN
ReWrite(Dirfile);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT')
ELSE
Assign(VerbF,Datapath+FileArea.FileName+'.EXT');
Reset(VerbF,1);
IF (IOResult = 2) THEN
ReWrite(VerbF,1);
FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO
BEGIN
Seek(DirFile,Counter1);
Read(DirFile,F);
IF (F.Owner = User.UserID) THEN
F.Owner := NewUserNum;
Seek(DirFile,Counter1);
Write(DirFile,F);
END;
Close(DirFile);
Close(VerbF);
END;
Close(FileAreaFile);
END;
PROCEDURE UpdateDIRFileSize(DataPath: STRING);
VAR
FileAreaFile: FILE OF FileAreaRecordType;
DirFile: FILE OF ULFRec;
FileArea: FileAreaRecordType;
VerbF: FILE;
F: ULFRec;
Counter,
Counter1: Integer;
FSize: Longint;
BEGIN
Assign(FileAreaFile,DataPath+'FBASES.DAT');
Reset(FileAreaFile);
FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO
BEGIN
Seek(FileAreaFile,Counter);
Read(FileAreaFile,FileArea);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR')
ELSE
Assign(Dirfile,Datapath+FileArea.FileName+'.DIR');
Reset(Dirfile);
IF (IOResult = 2) THEN
ReWrite(Dirfile);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT')
ELSE
Assign(VerbF,Datapath+FileArea.FileName+'.EXT');
Reset(VerbF,1);
IF (IOResult = 2) THEN
ReWrite(VerbF,1);
FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO
BEGIN
Seek(DirFile,Counter1);
Read(DirFile,F);
FSize := GetFileSize(FileArea.DLPath+F.FileName);
IF (FSize = 0) THEN
BEGIN
F.SizeMod := 0;
F.Blocks := 0;
Include(F.FileStat,FIIsRequest);
END
ELSE
BEGIN
F.Blocks := FSize DIV 128;
F.SizeMod := FSize MOD 128;
END;
Seek(DirFile,Counter1);
Write(DirFile,F);
END;
Close(DirFile);
Close(VerbF);
END;
Close(FileAreaFile);
END;
PROCEDURE UpdateFileSCNFilesExistingUsers(DataPath: STRING);
VAR
FileAreaFile: FILE OF FileAreaRecordType;
UserFile: FILE OF UserRecordType;
UserFile2: FILE OF UserRecordType;
ScnFile: FILE OF Boolean;
ScnFile1: FILE OF Boolean;
FileArea: FileAreaRecordType;
User: UserRecordType;
Path: STRING;
Counter,
Counter1,
NumUsers: Integer;
NewScanFBase: Boolean;
BEGIN
Assign(UserFile,DataPath+'USERS.DAT');
Reset(UserFile);
Assign(UserFile2,DataPath+'USERS.BAK');
Reset(UserFile2);
Assign(FileAreaFile,DataPath+'FBASES.DAT');
Reset(FileAreaFile);
FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO
BEGIN
Seek(FileAreaFile,Counter);
Read(FileAreaFile,FileArea);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Path := FileArea.Dlpath+FileArea.FileName
ELSE
Path := Datapath+FileArea.FileName;
Assign(ScnFile,Path+'.SCN');
Reset(ScnFile);
IF (IOResult = 2) THEN
ReWrite(ScnFile);
Assign(ScnFile1,Path+'.SCB');
ReWrite(ScnFile1);
NumUsers := (FileSize(UserFile) - 1);
IF (NumUsers > FileSize(ScnFile)) THEN
BEGIN
Seek(ScnFile,FileSize(ScnFile));
NewScanFBase := TRUE;
FOR Counter1 := FileSize(ScnFile) TO (NumUsers - 1) DO
Write(ScnFile,NewScanFBase);
END;
FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(ScnFile1,FileSize(ScnFile1));
NewScanFBase := TRUE;
Write(ScnFile1,NewScanFBase);
END;
FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter1);
Read(UserFile2,User);
Seek(ScnFile,(User.UserID - 1));
Read(ScnFile,NewScanFBase);
Seek(ScnFile1,(Counter1 - 1));
Write(ScnFile1,NewScanFBase);
END;
Close(ScnFile);
Erase(ScnFile);
Close(ScnFile1);
ReName(ScnFile1,Path+'.SCN');
END;
Close(FileAreaFile);
Close(UserFile);
Close(UserFile2);
END;
PROCEDURE UpdateMsgFilesDeletedUsers(DataPath,MsgPath: STRING; User: UserRecordType);
VAR
MsgAreaFile: FILE OF MessageAreaRecordType;
MsgHdrF: FILE OF MHeaderRec;
MsgTxtF: FILE;
MsgArea: MessageAreaRecordType;
MHeader: MHeaderRec;
Counter: Integer;
MsgNum: Word;
BEGIN
Assign(MsgAreaFile,DataPath+'MBASES.DAT');
Reset(MsgAreaFile);
FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO
BEGIN
Seek(MsgAreaFile,Counter);
Read(MsgAreaFile,MsgArea);
Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR');
Reset(MsgHdrF);
IF (IOResult = 2) THEN
ReWrite(MsgHdrF);
Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT');
Reset(MsgTxtF,1);
IF (IOResult = 2) THEN
ReWrite(MsgTxtF,1);
FOR MsgNum := 1 TO FileSize(MsgHdrF) DO
BEGIN
Seek(MsgHdrF,(MsgNum - 1));
Read(MsgHdrF,MHeader);
IF (MHeader.MTO.UserNum = User.UserID) THEN
MHeader.MTO.UserNum := 0;
IF (MHeader.From.UserNum = User.UserID) THEN
MHeader.From.UserNum := 0;
Seek(MsgHdrF,(MsgNum - 1));
Write(MsgHdrF,MHeader);
END;
Close(MsgHdrF);
Close(MsgTxtF);
END;
Close(MsgAreaFile);
END;
PROCEDURE UpdateMsgFilesExistingUsers(DataPath,MsgPath: STRING; User: UserRecordType; NewUserNum: Integer);
VAR
MsgAreaFile: FILE OF MessageAreaRecordType;
MsgHdrF: FILE OF MHeaderRec;
MsgTxtF: FILE;
MsgArea: MessageAreaRecordType;
MHeader: MHeaderRec;
Counter: Integer;
MsgNum: Word;
BEGIN
Assign(MsgAreaFile,DataPath+'MBASES.DAT');
Reset(MsgAreaFile);
FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO
BEGIN
Seek(MsgAreaFile,Counter);
Read(MsgAreaFile,MsgArea);
Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR');
Reset(MsgHdrF);
IF (IOResult = 2) THEN
ReWrite(MsgHdrF);
Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT');
Reset(MsgTxtF,1);
IF (IOResult = 2) THEN
ReWrite(MsgTxtF,1);
FOR MsgNum := 1 TO FileSize(MsgHdrF) DO
BEGIN
Seek(MsgHdrF,(MsgNum - 1));
Read(MsgHdrF,MHeader);
IF (MHeader.MTO.UserNum = User.UserID) THEN
MHeader.MTO.UserNum := NewUserNum;
IF (MHeader.From.UserNum = User.UserID) THEN
MHeader.From.UserNum := NewUserNum;
Seek(MsgHdrF,(MsgNum - 1));
Write(MsgHdrF,MHeader);
END;
Close(MsgHdrF);
Close(MsgTxtF);
END;
Close(MsgAreaFile);
END;
PROCEDURE UpdateMsgSCNFilesExistingUsers(DataPath,MsgPath: STRING);
VAR
MessageFile: FILE OF MessageAreaRecordType;
UserFile: FILE OF UserRecordType;
UserFile2: FILE OF UserRecordType;
MsgScanFile: FILE OF ScanRec;
MsgScanFile1: FILE OF ScanRec;
MsgArea: MessageAreaRecordType;
User: UserRecordType;
LastReadRecord: ScanRec;
Path: STRING;
Counter,
Counter1,
NumUsers: Integer;
BEGIN
Assign(UserFile,DataPath+'USERS.DAT');
Reset(UserFile);
Assign(UserFile2,DataPath+'USERS.BAK');
Reset(UserFile2);
Assign(MessageFile,DataPath+'MBASES.DAT');
Reset(MessageFile);
FOR Counter := 0 TO (FileSize(MessageFile) - 1) DO
BEGIN
Seek(MessageFile,Counter);
Read(MessageFile,MsgArea);
Path := MsgPath+MsgArea.FileName;
Assign(MsgScanFile,Path+'.SCN');
Reset(MsgScanFile);
IF (IOResult = 2) THEN
ReWrite(MsgScanFile);
Assign(MsgScanFile1,Path+'.SCB');
ReWrite(MsgScanFile1);
NumUsers := (FileSize(UserFile) - 1);
IF (NumUsers > FileSize(MsgScanFile)) THEN
BEGIN
WITH LastReadRecord DO
BEGIN
LastRead := 0;
NewScan := TRUE;
END;
Seek(MsgScanFile,FileSize(MsgScanFile));
FOR Counter1 := FileSize(MSGScanFile) TO (NumUsers - 1) DO
Write(MsgScanFile,LastReadRecord);
END;
FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
WITH LastReadRecord DO
BEGIN
LastRead := 0;
NewScan := TRUE;
END;
Seek(MsgScanFile1,FileSize(MsgScanFile1));
Write(MsgScanFile1,LastReadRecord);
END;
FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter1);
Read(UserFile2,User);
Seek(MsgScanFile,(User.UserID - 1));
Read(MsgScanFile,LastReadRecord);
Seek(MsgScanFile1,(Counter1 - 1));
Write(MsgScanFile1,LastReadRecord);
END;
Close(MsgScanFile);
Erase(MsgScanFile);
Close(MsgScanFile1);
ReName(MsgScanFile1,Path+'.SCN');
END;
Close(MessageFile);
Close(UserFile);
Close(UserFile2);
END;
PROCEDURE PackMessageArea(MsgPath,FN: STRING; MaxM: LongInt);
VAR
Buffer: ARRAY [1..4096] OF Char;
MsgHdrF1,
MsgHdrF2: FILE OF MheaderRec;
BrdF1,
BrdF2: FILE;
MHeader: MheaderRec;
Numm,
i,
IDX,
TotLoad,
Buffered: Word;
NeedPack: Boolean;
PROCEDURE ErrMsg;
BEGIN
Writeln('Error renaming temp files while packing.');
END;
PROCEDURE Kill(CONST FN: AStr);
VAR
F: FILE;
BEGIN
IF Exist(FN) THEN
BEGIN
Assign(F,FN);
Erase(F);
END;
END;
BEGIN
NeedPack := FALSE;
FN := AllCaps(FN);
FN := MsgPath + FN;
Assign(BrdF1,FN+'.DAT');
Reset(BrdF1,1);
IF (IOResult <> 0) THEN
Exit;
Assign(MsgHdrF1,FN+'.HDR');
Reset(MsgHdrF1);
IF (IOResult <> 0) THEN
BEGIN
Close(BrdF1);
Exit
END;
IF (MaxM <> 0) AND (FileSize(MsgHdrF1) > MaxM) THEN
BEGIN
Numm := 0;
IDX := FileSize(MsgHdrF1);
WHILE (IDX > 0) DO
BEGIN
Seek(MsgHdrF1,(IDX - 1));
Read(MsgHdrF1,MHeader);
IF NOT (MDeleted IN MHeader.Status) THEN
Inc(Numm);
IF (Numm > MaxM) AND NOT (Permanent IN MHeader.Status) THEN
BEGIN
MHeader.Status := [MDeleted];
Seek(MsgHdrF1,(IDX - 1));
Write(MsgHdrF1,MHeader);
END;
Dec(IDX);
END;
END
ELSE
BEGIN
WHILE (FilePos(MsgHdrF1) < FileSize(MsgHdrF1)) AND (NOT NeedPack) DO
BEGIN
Read(MsgHdrF1,MHeader);
IF (MDeleted IN MHeader.Status) THEN
NeedPack := TRUE;
END;
IF (NOT NeedPack) THEN
BEGIN
Close(MsgHdrF1);
Close(BrdF1);
Exit;
END;
END;
Assign(BrdF2,FN+'.DA1');
ReWrite(BrdF2,1);
Assign(MsgHdrF2,FN+'.HD2');
ReWrite(MsgHdrF2);
Kill(FN+'.HD3');
Kill(FN+'.DA3');
IDX := 1;
i := 0;
WHILE (i <= FileSize(MsgHdrF1) - 1) DO
BEGIN
Seek(MsgHdrF1,i);
Read(MsgHdrF1,MHeader);
IF (MHeader.Pointer - 1 + MHeader.TextSize > FileSize(BrdF1)) OR
(MHeader.Pointer < 1) THEN
MHeader.Status := [MDeleted];
IF NOT (MDeleted IN MHeader.Status) THEN
BEGIN
Inc(IDX);
Seek(BrdF1,MHeader.Pointer - 1);
MHeader.Pointer := (FileSize(BrdF2) + 1);
Write(MsgHdrF2,MHeader);
TotLoad := 0;
IF (MHeader.TextSize > 0) THEN
WHILE (MHeader.TextSize > 0) DO
BEGIN
Buffered := MHeader.TextSize;
IF (Buffered > 4096) THEN
Buffered := 4096;
Dec(MHeader.TextSize,Buffered);
BlockRead(BrdF1,Buffer[1],Buffered);
BlockWrite(BrdF2,Buffer[1],Buffered);
END;
END;
Inc(i);
END;
Close(BrdF1);
Close(BrdF2);
Close(MsgHdrF1);
Close(MsgHdrF2);
ReName(BrdF1,FN+'.DA3'); { ReName .DAT to .DA3 }
IF (IOResult <> 0) THEN { Didn't work, abort }
BEGIN
ErrMsg;
Exit;
END;
ReName(BrdF2,FN+'.DAT'); { ReName .DA2 to .DAT }
IF (IOResult <> 0) THEN { Didn't work, abort }
BEGIN
ErrMsg;
ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT }
Exit;
END;
ReName(MsgHdrF1,FN+'.HD3'); { ReName .HDR to .HD3 }
IF (IOResult <> 0) THEN { Didn't work, abort }
BEGIN
ErrMsg;
Erase(BrdF2); { Erase .DA2 }
ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT }
Exit;
END;
ReName(MsgHdrF2,FN+'.HDR'); { ReName .HD2 to .HDR }
IF (IOResult <> 0) THEN { Didn't work, abort }
BEGIN
ErrMsg;
Erase(BrdF2); { Erase .DAT (new) }
Erase(MsgHdrF2); { Erase .HD2 (new) }
ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT }
ReName(MsgHdrF1,FN+'.HDR'); { ReName .HD3 to .HDR }
Exit;
END;
Erase(MsgHdrF1);
Erase(BrdF1);
END;
PROCEDURE PackMessageAreas(DataPath,MsgPath: STRING);
VAR
MsgAreaFile: FILE OF MessageAreaRecordType;
MsgArea: MessageAreaRecordType;
MArea: Integer;
BEGIN
PackMessageArea(MsgPath,'EMAIL',0);
Assign(MsgAreaFile,DataPath+'MBASES.DAT');
Reset(MsgAreaFile);
FOR MArea := 0 TO (FileSize(MsgAreaFile) - 1) DO
BEGIN
Seek(MsgAreaFile,MArea);
Read(MsgAreaFile,MsgArea);
PackMessageArea(MsgPath,MsgArea.FIleName,MsgArea.MaxMsgs);
END;
Close(MsgAreaFile);
END;
PROCEDURE SortFileArea(VAR DirFile1: DirF; NumFiles: Integer);
VAR
F1,
F2: ULFRec;
NumSorted,
RecNum,
RecNum1,
Gap: Integer;
BEGIN
Gap := NumFiles;
REPEAT;
Gap := (Gap DIV 2);
IF (Gap = 0) THEN
Gap := 1;
NumSorted := 0;
FOR RecNum := 1 TO (NumFiles - Gap) DO
BEGIN
RecNum1 := (RecNum + Gap);
Seek(DirFile1,(RecNum - 1));
Read(DirFile1,F1);
Seek(DirFile1,(RecNum1 - 1));
Read(DirFile1,F2);
IF (F1.FileName > F2.FileName) THEN
BEGIN
Seek(DirFile1,(RecNum - 1));
Write(DirFile1,F2);
Seek(DirFile1,(RecNum1 - 1));
Write(DirFile1,F1);
Inc(NumSorted);
END;
END;
UNTIL (NumSorted = 0) AND (Gap = 1);
END;
PROCEDURE SortAllFileAreas(DataPath: STRING);
VAR
FileAreaFile: FILE OF FileAreaRecordType;
DirFile: DirF;
FileArea: FileAreaRecordType;
F: ULFRec;
NumFiles,
Counter: Integer;
BEGIN
Assign(FileAreaFile,DataPath+'FBASES.DAT');
Reset(FileAreaFile);
FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO
BEGIN
Seek(FileAreaFile,Counter);
Read(FileAreaFile,FileArea);
IF (FADirDLPath IN FileArea.FAFlags) THEN
Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR')
ELSE
Assign(Dirfile,Datapath+FileArea.FileName+'.DIR');
Reset(Dirfile);
IF (IOResult = 2) THEN
ReWrite(Dirfile);
NumFiles := FileSize(DirFile);
IF (NumFiles <> 0) THEN
SortFileArea(DirFile,NumFiles);
Close(DirFile);
END;
Close(FileAreaFile);
END;
PROCEDURE InsertIndex(VAR UserIndexFile1: SF; Uname: AStr; UserNum: Integer; IsReal,IsDeleted: Boolean);
VAR
IndexR: UserIDXRec;
Current,
InsertAt: Integer;
Done: Boolean;
PROCEDURE WriteIndex;
BEGIN
FillChar(IndexR,SizeOf(IndexR),0);
WITH IndexR DO
BEGIN
Name := Uname;
Number := UserNum;
RealName := IsReal;
Deleted := IsDeleted;
Left := -1;
Right := -1;
Write(UserIndexFile1,IndexR);
END
END;
BEGIN
Done := FALSE;
Uname := Allcaps(Uname);
Current := 0;
Reset(UserIndexFile1);
IF (FileSize(UserIndexFile1) = 0) THEN
WriteIndex
ELSE
REPEAT
Seek(UserIndexFile1,Current);
InsertAt := Current;
Read(UserIndexFile1,IndexR);
IF (Uname < IndexR.Name) THEN
Current := IndexR.Left
ELSE IF (Uname > IndexR.Name) THEN
Current := IndexR.Right
ELSE IF (IndexR.Deleted <> IsDeleted) THEN
BEGIN
Done := TRUE;
IndexR.Deleted := IsDeleted;
IndexR.RealName := IsReal;
IndexR.Number := UserNum;
Seek(UserIndexFile1,Current);
Write(UserIndexFile1,IndexR);
END
ELSE
BEGIN
IF (UserNum <> IndexR.Number) THEN
WriteLn('Note: Duplicate user '+UName+' #'+IntToStr(IndexR.Number)+' and '+UName+' #'+IntToStr(UserNum))
ELSE
BEGIN
IndexR.RealName := FALSE;
Seek(UserIndexFile1,Current); { Make it be his handle IF it's BOTH }
Write(UserIndexFile1,IndexR);
END;
Done := TRUE;
END;
UNTIL (Current = -1) OR (Done);
IF (Current = -1) THEN
BEGIN
IF (Uname < IndexR.Name) THEN
IndexR.Left := FileSize(UserIndexFile1)
ELSE
IndexR.Right := FileSize(UserIndexFile1);
Seek(UserIndexFile1,InsertAt);
Write(UserIndexFile1,IndexR);
Seek(UserIndexFile1,FileSize(UserIndexFile1));
WriteIndex;
END;
Close(UserIndexFile1);
END;
PROCEDURE PackUsers;
VAR
GeneralFile: FILE OF GeneralRecordType;
UserFile: FILE OF UserRecordType;
UserFile1: FILE OF UserRecordType;
UserFile2: FILE OF UserRecordType;
UserIndexFile: SF;
F: FILE;
General: GeneralRecordType;
User,
SysOpUser: UserRecordType;
DeleteDateStr: STRING;
TotalUsers,
Counter: Integer;
Year: Word;
PackedDeleteDate: LongInt;
UsersToDelete,
DeleteByDate,
InvalidDate: Boolean;
BEGIN
DeleteByDate := FALSE;
IF (ParamCount > 0) THEN
FOR Counter := 1 TO ParamCount DO
IF (AllCaps(Copy(ParamStr(Counter),1,2)) = AllCaps('-D')) THEN
BEGIN
DeleteDateStr := Copy(ParamStr(Counter),3,Length(ParamStr(Counter)));
InvalidDate := FALSE;
IF (Length(DeleteDateStr) <> 10) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,1,2)) = 0) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,1,2)) > 12) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,4,2)) = 0) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [1,3,5,7,8,10,12]) THEN
IF (StrToInt(Copy(DeleteDateStr,4,2)) > 31) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [4,6,9,11]) THEN
IF (StrToInt(Copy(DeleteDateStr,4,2)) > 30) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) <> 0) THEN
IF (StrToInt(Copy(DeleteDateStr,4,2)) > 28) THEN
InvalidDate := TRUE;
IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) = 0) THEN
IF (StrToInt(Copy(DeleteDateStr,4,2)) > 29) THEN
InvalidDate := TRUE;
GetYear(Year);
IF (StrToInt(Copy(DeleteDateStr,7,4)) > Year) THEN
InvalidDate := TRUE;
IF (InvalidDate) THEN
BEGIN
WriteLn;
WriteLn(^G^G^G'Invalid date or format, valid format is "00/00/0000');
Exit;
END
ELSE
BEGIN
PackedDeleteDate := Date2PD(DeleteDateStr);
DeleteByDate := TRUE;
END;
END;
ClrScr;
WriteLn('Renegade User Packer Version 1.0');
Writeln('Copyright 2007 - The Renegade Developement Team');
WriteLn;
Writeln('This utility will pack your Renegade BBS Version 09/30/06 ');
WriteLn('USERS.DAT file and update all required data files.');
WriteLn;
WriteLn('User''s to be packed:');
WriteLn(' - All user''s currently marked for deletion');
IF (DeleteByDate) THEN
WriteLn(' - All user''s that have not logged on since '+DeleteDateStr);
WriteLn;
WriteLn('This process could take awhile depending on the total number');
WriteLn('of files on your BBS that require update.');
WriteLn;
IF PYNQ('Do you wish to continue? ') THEN
BEGIN
WriteLn;
IF (NOT Exist('RENEGADE.DAT')) THEN
WriteLn('This utility must be executed in the same directory as RENEGADE.DAT!')
ELSE
BEGIN
Write('Reading RENEGADE.DAT ... ');
Assign(GeneralFile,'RENEGADE.DAT');
Reset(GeneralFile);
Read(GeneralFile,General);
Close(GeneralFile);
WriteLn('Done!');
WriteLn;
Write('Checking USERS.DAT for user''s to pack ... ');
Assign(UserFile,General.DataPath+'USERS.DAT');
Reset(UserFile);
UsersToDelete := FALSE;
Counter := 2;
WHILE (Counter <= (FileSize(UserFile) - 1)) AND (NOT UsersToDelete) DO
BEGIN
Seek(UserFile,Counter);
Read(UserFile,User);
IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags))
AND (User.LastOn < PackedDeleteDate) THEN
UsersToDelete := TRUE;
Inc(Counter);
END;
WriteLn('Done!');
IF (NOT UsersToDelete) THEN
BEGIN
WriteLn;
WriteLn(^G^G^G'No deleted user''s found to pack!');
END
ELSE
BEGIN
Write('Updating USERS.DAT "UserID" with record number for all user''s ... ');
FOR Counter := 0 TO (FileSize(UserFile) - 1) DO
BEGIN
Seek(UserFile,Counter);
Read(UserFile,User);
User.UserID := Counter;
Seek(UserFile,Counter);
Write(UserFile,User);
END;
WriteLn('Done!');
Write('Locating deleted user''s and creating USERS.DEL and USERS.BAK ... ');
Assign(UserFile1,General.DataPath+'USERS.DEL');
ReWrite(UserFile1);
Assign(UserFile2,General.DataPath+'USERS.BAK');
ReWrite(UserFile2);
Seek(UserFile,0);
Read(UserFile,User);
User.UserID := 0;
Seek(UserFile2,FileSize(UserFile2));
Write(UserFile2,User);
Seek(UserFile,1);
Read(UserFile,User);
User.UserID := 1;
Seek(UserFile2,FileSize(UserFile2));
Write(UserFile2,User);
FOR Counter := 2 TO (FileSize(UserFile) - 1) DO
BEGIN
Seek(UserFile,Counter);
Read(UserFile,User);
IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags))
AND (User.LastOn < PackedDeleteDate) THEN
BEGIN
Seek(UserFile1,FileSize(UserFile1));
Write(UserFile1,User);
END
ELSE
BEGIN
Seek(UserFile2,FileSize(UserFile2));
Write(UserFile2,User);
END;
END;
Close(UserFile);
Close(UserFile2);
WriteLn('Done!');
Write('Removing voting records for deleted user''s ... ');
FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO
BEGIN
Seek(UserFile1,Counter);
Read(UserFile1,User);
KillUserVotes(General.DataPath,User);
Seek(UserFile1,Counter);
Write(UserFile1,User);
END;
WriteLn('Done!');
Write('Setting SHORTMSG.DAT "Destin" to -1 for deleted user''s ... ');
FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO
BEGIN
Seek(UserFile1,Counter);
Read(UserFile1,User);
KillShortMsgs(General.DataPath,User);
END;
WriteLn('Done!');
Write('Updating SHORTMSG.DAT "Destin" with new user number ... ');
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
UpdateSHortMsgs(General.DataPath,User,Counter);
END;
Close(UserFile2);
WriteLn('Done!');
Write('Setting BATCHDL.DAT "BDLUserNum" to -1 for all deleted user''s ... ');
FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO
BEGIN
Seek(UserFile1,Counter);
Read(UserFile1,User);
KillBatchQueue(General.DataPath,User);
END;
WriteLn('Done!');
Write('Updating BATCHDL.DAT "BDLUserNum" with new user number ... ');
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
UpdateBatchQueue(General.DataPath,User,Counter);
END;
Close(UserFile2);
WriteLn('Done!');
Write('Setting EMAIL.HDR "MDeleted" for email to/from deleted user''s ... ');
FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO
BEGIN
Seek(UserFile1,Counter);
Read(UserFile1,User);
KillUserEMail(General.DataPath,General.MsgPath,User);
Seek(UserFile1,Counter);
Write(UserFile1,User);
END;
WriteLn('Done!');
Write('Updating EMAIL.HDR "MTO/FROM" with new user number ... ');
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
UpdateUserEMail(General.MsgPath,User,Counter);
Seek(UserFile2,Counter);
Write(UserFile2,User);
END;
Close(UserFile2);
WriteLn('Done!');
Write('Updating *.DIR files with sysop name/number for all deleted user''s ... ');
Assign(UserFile2,General.DataPath+'USERS.BAK');
Reset(UserFile2);
Seek(UserFile2,1);
Read(UserFile2,SysOpUser);
Close(UserFile2);
Reset(UserFile1);
FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO
BEGIN
Seek(UserFile1,Counter);
Read(UserFile1,User);
UpdateDIRFilesDeletedUsers(General.DataPath,User,SysOpUser);
END;
WriteLn('Done!');
Write('Updating *.DIR files with new user number ... ');
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
UpdateDIRFilesExistingUsers(General.DataPath,User,Counter);
END;
Close(UserFile2);
WriteLn('Done!');
Write('Setting *.HDR files "MTO/FROM" to 0 for all deleted user''s ... ');
Reset(UserFile1);
FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO
BEGIN
Seek(UserFile1,Counter);
Read(UserFile1,User);
UpdateMsgFilesDeletedUsers(General.DataPath,General.MsgPath,User);
END;
WriteLn('Done!');
Write('Updating *.HDR files with new user number for existing user''s ... ');
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
UpdateMsgFilesExistingUsers(General.DataPath,General.MsgPath,User,Counter);
END;
Close(UserFile2);
WriteLn('Done!');
Write('Updating file area scan flags for existing user''s ... ');
UpdateFileSCNFilesExistingUsers(General.DataPath);
WriteLn('Done!');
Write('Updating message area scan flags for existing user''s ... ');
UpdateMsgSCNFilesExistingUsers(General.DataPath,General.MsgPath);
WriteLn('Done!');
Write('Re-Scaning email waiting for existing user''s ... ');
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
ReScanUserEMail(General.MsgPath,User,Counter);
Seek(UserFile2,Counter);
Write(UserFile2,User);
END;
WriteLn('Done!');
Write('Re-Scaning voting for existing user''s ... ');
ResetVotes(General.DataPath);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
ReScanUserVotes(General.DataPath,User);
Seek(UserFile2,Counter);
Write(UserFile2,User);
END;
WriteLn('Done!');
Write('Updating UserID with record number for existing user''s ... ');
FOR Counter := 0 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
User.UserID := Counter;
Seek(UserFile2,Counter);
Write(UserFile2,User);
END;
WriteLn('Done!');
Write('Purging SHORTMSG.DAT of deleted records ... ');
PurgingShortMsgs(General.DataPath);
WriteLn('Done!');
Write('Purging BATCHDL.DAT of deleted records ... ');
PurgingBatchQueue(General.DataPath);
WriteLn('Done!');
Write('Updating all File Area file size ... ');
UpdateDIRFileSize(General.DataPath);
WriteLn('Done!');
Write('Sorting all file areas ... ');
SortAllFileAreas(General.DataPath);
WriteLn('Done!');
Write('Packing all message areas ... ');
PackMessageAreas(General.DataPath,General.MsgPath);
WriteLn('Done!');
Write('Deleting USERS.DEL ... ');
Close(UserFile1);
Erase(UserFile1);
WriteLn('Done!');
Write('Deleting USERS.DAT ... ');
Erase(UserFile);
WriteLn('Done!');
Write('Re-Naming USERS.BAK to USERS.DAT ... ');
ReName(UserFile2,General.DataPath+'USERS.DAT');
WriteLn('Done!');
Write('Deleting USERS.IDX ... ');
Assign(F,General.DataPath+'USERS.IDX');
Erase(F);
WriteLn('Done!');
Write('Creating and re-indexing USERS.IDX ... ');
TotalUsers := 0;
Assign(UserIndexFile,General.DataPath+'USERS.IDX');
ReWrite(UserIndexFile);
Reset(UserFile2);
FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO
BEGIN
Seek(UserFile2,Counter);
Read(UserFile2,User);
IF NOT (Deleted IN User.SFLags) THEN
Inc(TotalUsers);
InsertIndex(UserIndexFile,User.Name,Counter,FALSE,(Deleted IN User.SFLags));
InsertIndex(UserIndexFile,User.RealName,Counter,TRUE,(Deleted IN User.SFLags));
END;
Close(UserFile2);
WriteLn('Done!');
Write('Updating RENEGADE.DAT "NumUsers" ... ');
Assign(GeneralFile,'RENEGADE.DAT');
Reset(GeneralFile);
Read(GeneralFile,General);
General.NumUsers := TotalUsers;
Seek(GeneralFile,0);
Write(GeneralFile,General);
Close(GeneralFile);
WriteLn('Done!');
WriteLn;
WriteLn(^G^G^G'Your USERS.DAT file has been packed and associated files have been updated.');
END;
END;
END;
END;
BEGIN
PackUsers;
END.