Initial commit
This commit is contained in:
commit
6abf234ade
|
|
@ -0,0 +1,14 @@
|
||||||
|
*.CFG
|
||||||
|
*.CMD
|
||||||
|
*.old
|
||||||
|
*.OLD
|
||||||
|
*.TXT
|
||||||
|
*.TPU
|
||||||
|
*.tpu
|
||||||
|
*.ppu
|
||||||
|
*.PPU
|
||||||
|
*.VPI
|
||||||
|
*.vpi
|
||||||
|
SOURCE/ELECOM/
|
||||||
|
SOURCE/UNUSED/
|
||||||
|
|
||||||
|
|
@ -0,0 +1,723 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Archive1;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ArcDeComp(VAR Ok: Boolean; AType: Byte; CONST FileName,FSpec: AStr);
|
||||||
|
PROCEDURE ArcComp(VAR Ok: Boolean; AType: Byte; CONST FileName,FSpec: AStr);
|
||||||
|
PROCEDURE ArcComment(VAR Ok: Boolean; AType: Byte; CommentNum: Byte; CONST FileName: AStr);
|
||||||
|
PROCEDURE ArcIntegrityTest(VAR Ok: Boolean; AType: Byte; CONST FileName: AStr);
|
||||||
|
PROCEDURE ConvA(VAR Ok: Boolean; OldAType,NewAType: Byte; CONST OldFN,NewFN: AStr);
|
||||||
|
FUNCTION ArcType(FileName: AStr): Byte;
|
||||||
|
PROCEDURE ListArcTypes;
|
||||||
|
PROCEDURE InvArc;
|
||||||
|
PROCEDURE ExtractToTemp;
|
||||||
|
PROCEDURE UserArchive;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
ArcView,
|
||||||
|
ExecBat,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File2,
|
||||||
|
File9,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE ArcDeComp(VAR Ok: Boolean; AType: Byte; CONST FileName,FSpec: AStr);
|
||||||
|
VAR
|
||||||
|
ResultCode: Integer;
|
||||||
|
BEGIN
|
||||||
|
PurgeDir(TempDir+'ARC\',FALSE);
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',General.ArcsPath+
|
||||||
|
FunctionalMCI(General.FileArcInfo[AType].UnArcLine,FileName,FSpec),
|
||||||
|
General.FileArcInfo[AType].SuccLevel,ResultCode,FALSE);
|
||||||
|
IF (NOT Ok) AND (Pos('.DIZ',FSpec) = 0) THEN
|
||||||
|
SysOpLog(FileName+': errors during de-compression');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ArcComp(VAR Ok: Boolean; AType: Byte; CONST FileName,FSpec: AStr);
|
||||||
|
VAR
|
||||||
|
ResultCode: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (General.FileArcInfo[AType].ArcLine = '') THEN
|
||||||
|
Ok := TRUE
|
||||||
|
ELSE
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',General.ArcsPath+
|
||||||
|
FunctionalMCI(General.FileArcInfo[AType].ArcLine,FileName,FSpec),
|
||||||
|
General.FileArcInfo[AType].SuccLevel,ResultCode,FALSE);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
SysOpLog(FileName+': errors during compression');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ArcComment(VAR Ok: Boolean; AType: Byte; CommentNum: Byte; CONST FileName: AStr);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
ResultCode: Integer;
|
||||||
|
SaveSwapShell: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (CommentNum > 0) AND (General.FileArcComment[CommentNum] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
SaveSwapShell := General.SwapShell;
|
||||||
|
General.SwapShell := FALSE;
|
||||||
|
TempStr := Substitute(General.FileArcInfo[AType].CmtLine,'%C',General.FileArcComment[CommentNum]);
|
||||||
|
TempStr := Substitute(TempStr,'%C',General.FileArcComment[CommentNum]);
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',General.ArcsPath+FunctionalMCI(TempStr,FileName,''),
|
||||||
|
General.FileArcInfo[AType].SuccLevel,ResultCode,FALSE);
|
||||||
|
General.SwapShell := SaveSwapShell;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ArcIntegrityTest(VAR Ok: Boolean; AType: Byte; CONST FileName: AStr);
|
||||||
|
VAR
|
||||||
|
ResultCode: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (General.FileArcInfo[AType].TestLine <> '') THEN
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',General.ArcsPath+
|
||||||
|
FunctionalMCI(General.FileArcInfo[AType].TestLine,FileName,''),
|
||||||
|
General.FileArcInfo[AType].SuccLevel,ResultCode,FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ConvA(VAR Ok: Boolean; OldAType,NewAType: Byte; CONST OldFN,NewFN: AStr);
|
||||||
|
VAR
|
||||||
|
NoFN: AStr;
|
||||||
|
PS: PathStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
FileTime: LongInt;
|
||||||
|
Match: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Star('Converting archive - stage one.');
|
||||||
|
|
||||||
|
Match := (OldAType = NewAType);
|
||||||
|
IF (Match) THEN
|
||||||
|
BEGIN
|
||||||
|
FSplit(OldFN,PS,NS,ES);
|
||||||
|
NoFN := PS+NS+'.#$%';
|
||||||
|
END;
|
||||||
|
|
||||||
|
GetFileDateTime(OldFN,FileTime);
|
||||||
|
|
||||||
|
ArcDeComp(Ok,OldAType,OldFN,'*.*');
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Star('Errors in decompression!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Star('Converting archive - stage two.');
|
||||||
|
|
||||||
|
IF (Match) THEN
|
||||||
|
RenameFile('',OldFN,NoFN,Ok);
|
||||||
|
|
||||||
|
ArcComp(Ok,NewAType,NewFN,'*.*');
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Errors in compression!');
|
||||||
|
IF (Match) THEN
|
||||||
|
RenameFile('',NoFN,OldFN,Ok);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
|
||||||
|
SetFileDateTime(NewFN,FileTime);
|
||||||
|
|
||||||
|
IF (NOT Exist(SQOutSp(NewFN))) THEN
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
IF (Exist(NoFN)) THEN
|
||||||
|
Kill(NoFN);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ArcType(FileName: AStr): Byte;
|
||||||
|
VAR
|
||||||
|
AType,
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
AType := 0;
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= MaxArcs) AND (AType = 0) DO
|
||||||
|
BEGIN
|
||||||
|
IF (General.FileArcInfo[Counter].Active) THEN
|
||||||
|
IF (General.FileArcInfo[Counter].Ext <> '') THEN
|
||||||
|
IF (General.FileArcInfo[Counter].Ext = Copy(FileName,(Length(FileName) - 2),3)) THEN
|
||||||
|
AType := Counter;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
ArcType := AType;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListArcTypes;
|
||||||
|
VAR
|
||||||
|
RecNum,
|
||||||
|
RecNum1: Byte;
|
||||||
|
BEGIN
|
||||||
|
RecNum1 := 0;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= MaxArcs) AND (General.FileArcInfo[RecNum].Ext <> '') DO
|
||||||
|
BEGIN
|
||||||
|
IF (General.FileArcInfo[RecNum].Active) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(RecNum1);
|
||||||
|
IF (RecNum1 = 1) THEN
|
||||||
|
Prompt('^1Available archive formats: ')
|
||||||
|
ELSE
|
||||||
|
Prompt('^1,');
|
||||||
|
Prompt('^5'+General.FileArcInfo[RecNum].Ext+'^1');
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
IF (RecNum1 = 0) THEN
|
||||||
|
Prompt('No archive formats available.');
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InvArc;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Unsupported archive format.');
|
||||||
|
NL;
|
||||||
|
ListArcTypes;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ExtractToTemp;
|
||||||
|
TYPE
|
||||||
|
TotalsRecordType = RECORD
|
||||||
|
TotalFiles: SmallInt;
|
||||||
|
TotalSize: LongInt;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Totals: TotalsRecordType;
|
||||||
|
FileName,
|
||||||
|
ArcFileName: AStr;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
DS: DirStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
Cmd: Char;
|
||||||
|
AType: Byte;
|
||||||
|
ReturnCode,
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
DidSomething,
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Extract to temporary directory -');
|
||||||
|
NL;
|
||||||
|
Prompt('^1Already in TEMP: ');
|
||||||
|
|
||||||
|
FillChar(Totals,SizeOf(Totals),0);
|
||||||
|
FindFirst(TempDir+'ARC\*.*',AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
|
||||||
|
WHILE (DOSError = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(Totals.TotalFiles);
|
||||||
|
Inc(Totals.TotalSize,DirInfo.Size);
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Totals.TotalFiles = 0) THEN
|
||||||
|
Print('^5Nothing.^1')
|
||||||
|
ELSE
|
||||||
|
Print('^5'+FormatNumber(Totals.TotalFiles)+
|
||||||
|
' '+Plural('file',Totals.TotalFiles)+
|
||||||
|
', '+ConvertBytes(Totals.TotalSize,FALSE)+'.^1');
|
||||||
|
|
||||||
|
IF (NOT FileSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The limit is '+FormatNumber(General.MaxInTemp)+'k bytes.');
|
||||||
|
IF (Totals.TotalSize > (General.MaxInTemp * 1024)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('You have exceeded this limit.');
|
||||||
|
NL;
|
||||||
|
Print('Please remove some files with the user-archive command.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Prt('File name: ');
|
||||||
|
IF (FileSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
MPL(52);
|
||||||
|
Input(FileName,52);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MPL(12);
|
||||||
|
Input(FileName,12);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FileName := SQOutSp(FileName);
|
||||||
|
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (IsUL(FileName)) AND (NOT FileSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Invalid file name!^1');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Pos('.',FileName) = 0) THEN
|
||||||
|
FileName := FileName + '*.*';
|
||||||
|
|
||||||
|
Ok := TRUE;
|
||||||
|
|
||||||
|
IF (NOT IsUL(FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(FileInfo,FileName,DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (NOT AACS(MemFileArea.DLACS)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have access to manipulate that file!^1');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE IF (DirFileRecNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
ArcFileName := MemFileArea.DLPath+SQOutSp(FileInfo.FileName)
|
||||||
|
ELSE
|
||||||
|
ArcFileName := MemFileArea.ULPath+SQOutSp(FileInfo.FileName);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
ArcFileName := FExpand(FileName);
|
||||||
|
IF (NOT Exist(ArcFileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FillChar(FileInfo,SizeOf(FileInfo),0);
|
||||||
|
WITH FileInfo DO
|
||||||
|
BEGIN
|
||||||
|
FileName := Align(StripName(ArcFileName));
|
||||||
|
Description := 'Unlisted file';
|
||||||
|
FilePoints := 0;
|
||||||
|
Downloaded := 0;
|
||||||
|
FileSize := GetFileSize(ArcFileName);
|
||||||
|
OwnerNum := UserNum;
|
||||||
|
OwnerName := Caps(ThisUser.Name);
|
||||||
|
FileDate := Date2PD(DateStr);
|
||||||
|
VPointer := -1;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [];
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
DidSomething := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
AType := ArcType(ArcFileName);
|
||||||
|
IF (AType = 0) THEN
|
||||||
|
InvArc;
|
||||||
|
NL;
|
||||||
|
Print('You can (^5C^1)opy this file into the TEMP Directory,');
|
||||||
|
IF (AType <> 0) THEN
|
||||||
|
Print('or (^5E^1)xtract files from it into the TEMP Directory.')
|
||||||
|
ELSE
|
||||||
|
Print('but you can''t extract files from it.');
|
||||||
|
NL;
|
||||||
|
Prt('Which? (^5C^4=^5Copy'+AOnOff((AType <> 0),'^4,^5E^4=^5Extract','')+'^4,^5Q^4=^5Quit^4): ');
|
||||||
|
OneK(Cmd,'QC'+AOnOff((AType <> 0),'E',''),TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'C' : BEGIN
|
||||||
|
FSplit(ArcFileName,DS,NS,ES);
|
||||||
|
NL;
|
||||||
|
IF CopyMoveFile(TRUE,'^5Progress: ',ArcFileName,TempDir+'ARC\'+NS+ES,TRUE) THEN
|
||||||
|
DidSomething := TRUE;
|
||||||
|
END;
|
||||||
|
'E' : BEGIN
|
||||||
|
NL;
|
||||||
|
DisplayFileInfo(FileInfo,TRUE);
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Prt('Extract files (^5E^4=^5Extract^4,^5V^4=^5View^4,^5Q^4=^5Quit^4): ');
|
||||||
|
OneK(Cmd,'QEV',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'E' : BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Extract all files? ',0,FALSE) THEN
|
||||||
|
FileName := '*.*'
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(FileName,12);
|
||||||
|
FileName := SQOutSp(FileName);
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE IF IsUL(FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Illegal filespec!^1');
|
||||||
|
FileName := '';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (FileName <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Ok := FALSE;
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',General.ArcsPath+
|
||||||
|
FunctionalMCI(General.FileArcInfo[AType].UnArcLine,ArcFileName,FileName),
|
||||||
|
General.FileArcInfo[AType].SuccLevel,ReturnCode,FALSE);
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Star('Decompressed '+FileName+' into TEMP from '+StripName(ArcFileName));
|
||||||
|
SysOpLog('Decompressed '+FileName+' into '+TempDir+'ARC\ from '+StripName(ArcFileName));
|
||||||
|
DidSomething := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Star('Error decompressing '+FileName+' into TEMP from '+StripName(ArcFileName));
|
||||||
|
SysOpLog('Error decompressing '+FileName+' into '+TempDir+'ARC\ from '+StripName(ArcFileName));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'V' : IF (IsUL(ArcFileName)) THEN
|
||||||
|
ViewInternalArchive(ArcFileName)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
ViewInternalArchive(MemFileArea.DLPath+FileInfo.FileName)
|
||||||
|
ELSE
|
||||||
|
ViewInternalArchive(MemFileArea.ULPath+FileInfo.FileName);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (DidSomething) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^5NOTE: ^1Use the user archive menu command to access');
|
||||||
|
Print(' files in the TEMP directory.^1');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UserArchive;
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
TransferFlags: TransferFlagSet;
|
||||||
|
ArcFileName,
|
||||||
|
FName: Str12;
|
||||||
|
Cmd: Char;
|
||||||
|
AType,
|
||||||
|
SaveNumBatchDLFiles: Byte;
|
||||||
|
ReturnCode,
|
||||||
|
GotPts,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
Ok,
|
||||||
|
SaveFileCreditRatio: Boolean;
|
||||||
|
|
||||||
|
FUNCTION OkName(FileName1: AStr): Boolean;
|
||||||
|
BEGIN
|
||||||
|
OkName := TRUE;
|
||||||
|
OkName := NOT IsWildCard(FileName1);
|
||||||
|
IF (IsUL(FileName1)) THEN
|
||||||
|
OkName := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Prt('Temp archive menu [^5?^4=^5Help^4]: ');
|
||||||
|
OneK(Cmd,'QADLRVT?',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('Archive name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(ArcFileName,12);
|
||||||
|
IF (ArcFileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
|
||||||
|
IF (Pos('.',ArcFileName) = 0) AND (MemFileArea.ArcType <> 0) THEN
|
||||||
|
ArcFileName := ArcFileName+'.'+General.FileArcInfo[MemFileArea.ArcType].Ext;
|
||||||
|
|
||||||
|
AType := ArcType(ArcFileName);
|
||||||
|
IF (AType = 0) THEN
|
||||||
|
InvArc
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(FName,12);
|
||||||
|
IF (FName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE IF (IsUL(FName)) OR (Pos('@',FName) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Illegal file name!^1');
|
||||||
|
END
|
||||||
|
ELSE IF (NOT Exist(TempDir+'ARC\'+FName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Ok := FALSE;
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',General.ArcsPath+
|
||||||
|
FunctionalMCI(General.FileArcInfo[AType].ArcLine,TempDir+'ARC\'+ArcFileName,FName),
|
||||||
|
General.FileArcInfo[AType].SuccLevel,ReturnCode,FALSE);
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Star('Compressed "^5'+FName+'^3" into "^5'+ArcFileName+'^3"');
|
||||||
|
SysOpLog('Compressed "^5'+FName+'^1" into "^5'+TempDir+'ARC\'+ArcFileName+'^1"')
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Star('Error compressing "^5'+FName+'^3" into "^5'+ArcFileName+'^3"');
|
||||||
|
SysOpLog('Error compressing "^5'+FName+'^1" into "^5'+TempDir+'ARC\'+ArcFileName+'^1"');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(FName,12);
|
||||||
|
IF (FName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE IF (NOT OkName(FName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Illegal file name!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(TempDir+'ARC\'+FName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
|
||||||
|
IF (DOSError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FileArea := -1;
|
||||||
|
WITH MemFileArea DO
|
||||||
|
BEGIN
|
||||||
|
AreaName := 'Temp Archive';
|
||||||
|
DLPath := TempDir+'ARC\';
|
||||||
|
ULPath := TempDir+'ARC\';
|
||||||
|
FAFlags := [];
|
||||||
|
END;
|
||||||
|
(* Consider charging points, ext. *)
|
||||||
|
LoadURec(User,1);
|
||||||
|
WITH FileInfo DO
|
||||||
|
BEGIN
|
||||||
|
FileName := Align(FName);
|
||||||
|
Description := 'Temporary Archive';
|
||||||
|
FilePoints := 0;
|
||||||
|
Downloaded := 0;
|
||||||
|
FileSize := GetFileSize(TempDir+'ARC\'+FileName);;
|
||||||
|
OwnerNum := 1;
|
||||||
|
OwnerName := Caps(User.Name);
|
||||||
|
FileDate := Date2PD(DateStr);
|
||||||
|
VPointer := -1;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [];
|
||||||
|
END;
|
||||||
|
TransferFlags := [IsTempArc,IsCheckRatio];
|
||||||
|
SaveNumBatchDLFiles := NumBatchDLFiles;
|
||||||
|
DLX(FileInfo,-1,TransferFlags);
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
IF (NumBatchDLFiles <> SaveNumBatchDLFiles) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^5REMEMBER: ^1If you delete this file from the temporary directory,');
|
||||||
|
Print(' you will not be able to download it in your batch queue.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'L' : BEGIN
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
NL;
|
||||||
|
DosDir(TempDir+'ARC\','*.*',TRUE);
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
SysOpLog('Listed temporary directory: "^5'+TempDir+'ARC\*.*^1"');
|
||||||
|
END;
|
||||||
|
'R' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File mask: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(FName,12);
|
||||||
|
IF (FName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE IF (IsUL(FName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Illegal file name!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(TempDir+'ARC\'+FName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
|
||||||
|
IF (DOSError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
REPEAT
|
||||||
|
Kill(TempDir+'ARC\'+DirInfo.Name);
|
||||||
|
Star('Removed temporary archive file: "^5'+DirInfo.Name+'^3"');
|
||||||
|
SysOpLog('^1Removed temp arc file: "^5'+TempDir+'ARC\'+DirInfo.Name+'^1"');
|
||||||
|
FindNext(DirInfo);
|
||||||
|
UNTIL (DOSError <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(FName,12);
|
||||||
|
IF (FName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE IF (NOT OkName(FName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Illegal file name!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(TempDir+'ARC\'+FName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
|
||||||
|
IF (DOSError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
PrintF(TempDir+'ARC\'+DirInfo.Name);
|
||||||
|
SysOpLog('Displayed temp arc file: "^5'+TempDir+'ARC\'+DirInfo.Name+'^1"');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'V' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File mask: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(FName,12);
|
||||||
|
IF (FName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE IF (NOT ValidIntArcType(FName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Not a valid archive type or not supported!^1')
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(TempDir+'ARC\'+FName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
|
||||||
|
IF (DOSError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File not found!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
REPEAT
|
||||||
|
ViewInternalArchive(TempDir+'ARC\'+DirInfo.Name);
|
||||||
|
SysOpLog('Viewed temp arc file: "^5'+TempDir+'ARC\'+DirInfo.Name+'^1"');
|
||||||
|
FindNext(DirInfo);
|
||||||
|
UNTIL (DOSError <> 0) OR (Abort) OR (HangUp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
NL;
|
||||||
|
ListArcTypes;
|
||||||
|
NL;
|
||||||
|
LCmds(30,3,'Add to archive','');
|
||||||
|
LCmds(30,3,'Download files','');
|
||||||
|
LCmds(30,3,'List files in directory','');
|
||||||
|
LCmds(30,3,'Remove files','');
|
||||||
|
LCmds(30,3,'Text view file','');
|
||||||
|
LCmds(30,3,'View archive','');
|
||||||
|
LCmds(30,3,'Quit','');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,919 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Archive2;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE DOArcCommand(Cmd: Char);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Archive1,
|
||||||
|
Archive3,
|
||||||
|
Arcview,
|
||||||
|
Common,
|
||||||
|
ExecBat,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File9,
|
||||||
|
File11,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
CONST
|
||||||
|
MaxDOSChrLine = 127;
|
||||||
|
|
||||||
|
PROCEDURE DOArcCommand(Cmd: Char);
|
||||||
|
CONST
|
||||||
|
MaxFiles = 100;
|
||||||
|
VAR
|
||||||
|
FI: FILE OF Byte;
|
||||||
|
FileListArray: ARRAY [1..MaxFiles] OF AStr;
|
||||||
|
F: FileInfoRecordType;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
FileName,
|
||||||
|
S,
|
||||||
|
S1,
|
||||||
|
S2,
|
||||||
|
OS1: AStr;
|
||||||
|
DS: DirStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
AType,
|
||||||
|
BB,
|
||||||
|
NumExtDesc,
|
||||||
|
NumFiles,
|
||||||
|
RecNum,
|
||||||
|
Counter: Byte;
|
||||||
|
Junk,
|
||||||
|
RN,
|
||||||
|
FArea,
|
||||||
|
SaveFileArea,
|
||||||
|
C_Files: Integer;
|
||||||
|
C_OldSiz,
|
||||||
|
C_NewSiz,
|
||||||
|
OldSiz,
|
||||||
|
NewSiz: LongInt;
|
||||||
|
Ok,
|
||||||
|
Ok1,
|
||||||
|
FNX,
|
||||||
|
WentToSysOp,
|
||||||
|
DelBad: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE AddFL(F1: FileInfoRecordType; FN1: AStr; VAR NumFiles1: Byte; b: Boolean);
|
||||||
|
VAR
|
||||||
|
DirInfo1: SearchRec;
|
||||||
|
DS1: DirStr;
|
||||||
|
NS1: NameStr;
|
||||||
|
ES1: ExtStr;
|
||||||
|
SaveNumFiles: Byte;
|
||||||
|
RN1: Integer;
|
||||||
|
BEGIN
|
||||||
|
SaveNumFiles := NumFiles1;
|
||||||
|
IF (NOT b) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(F1,FN1,RN1);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (RN1 <> -1) AND (NumFiles1 < MaxFiles) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Read(FileInfoFile,F1);
|
||||||
|
Inc(NumFiles1);
|
||||||
|
FileListArray[NumFiles1] := F1.FileName;
|
||||||
|
NRecNo(F1,RN1);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FSplit(FN1,DS1,NS1,ES1);
|
||||||
|
ChDir(BSlash(DS1,FALSE));
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('Path not found.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(FN1,AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo1);
|
||||||
|
WHILE (DOSError = 0) AND (NumFiles1 < MaxFiles) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(NumFiles1);
|
||||||
|
FileListArray[NumFiles1] := FExpand(DS1+DirInfo1.Name);
|
||||||
|
FindNext(DirInfo1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
ChDir(StartDir);
|
||||||
|
END;
|
||||||
|
IF (NumFiles1 = SaveNumFiles) THEN
|
||||||
|
Print('No matching files.')
|
||||||
|
ELSE IF (NumFiles1 >= MaxFiles) THEN
|
||||||
|
Print('File records filled.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE TestFiles(F1: FileInfoRecordType; FArea1: Integer; FN1: AStr; DelBad1: Boolean);
|
||||||
|
VAR
|
||||||
|
AType1: Byte;
|
||||||
|
RN1: Integer;
|
||||||
|
Ok2: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea1) THEN
|
||||||
|
ChangeFileArea(FArea1);
|
||||||
|
IF (FileArea = FArea1) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(F1,FN1,RN1);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (RN1 <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Read(FileInfoFile,F1);
|
||||||
|
IF Exist(MemFileArea.DLPath+F1.FileName) THEN
|
||||||
|
FN1 := MemFileArea.DLPath+F1.FileName
|
||||||
|
ELSE
|
||||||
|
FN1 := MemFileArea.ULPath+F1.FileName;
|
||||||
|
AType1 := ArcType(FN1);
|
||||||
|
IF (AType1 <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
DisplayFileAreaHeader;
|
||||||
|
Star('Testing "'+SQOutSP(FN1)+'"');
|
||||||
|
IF (NOT Exist(FN1)) THEN
|
||||||
|
Star('File "'+SQOutSP(FN1)+'" does not exist.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Ok2 := TRUE;
|
||||||
|
ArcIntegrityTest(Ok2,AType1,SQOutSP(FN1));
|
||||||
|
IF (NOT Ok2) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('File "'+SQOutSP(FN1)+'" did not pass integrity test.');
|
||||||
|
IF (DelBad1) THEN
|
||||||
|
BEGIN
|
||||||
|
DeleteFF(F1,RN1);
|
||||||
|
Kill(FN1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
NRecNo(F1,RN1);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CmtFiles(F1: FileInfoRecordType; FArea1: Integer; FN1: AStr);
|
||||||
|
VAR
|
||||||
|
AType1: Byte;
|
||||||
|
RN1: Integer;
|
||||||
|
Ok2: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea1) THEN
|
||||||
|
ChangeFileArea(FArea1);
|
||||||
|
IF (FileArea = FArea1) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(F1,FN1,RN1);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (RN1 <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Read(FileInfoFile,F1);
|
||||||
|
IF Exist(MemFileArea.DLPath+F1.FileName) THEN
|
||||||
|
FN1 := MemFileArea.DLPath+F1.FileName
|
||||||
|
ELSE
|
||||||
|
FN1 := MemFileArea.ULPath+F1.FileName;
|
||||||
|
AType1 := ArcType(FN1);
|
||||||
|
IF (AType1 <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
DisplayFileAreaHeader;
|
||||||
|
NL;
|
||||||
|
Star('Commenting "'+SQOutSP(FN1)+'"');
|
||||||
|
IF (NOT Exist(FN1)) THEN
|
||||||
|
Star('File "'+SQOutSP(FN1)+'" does not exist.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Ok2 := TRUE;
|
||||||
|
ArcComment(Ok2,AType1,MemFileArea.CmtType,SQOutSP(FN1));
|
||||||
|
(* If NOT Ok *)
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
NRecNo(F1,RN1);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CvtFiles(F1: FileInfoRecordType;
|
||||||
|
FArea1: Integer;
|
||||||
|
FN1: AStr;
|
||||||
|
Toa: Integer;
|
||||||
|
VAR C_Files1: Integer;
|
||||||
|
VAR C_OldSiz1,
|
||||||
|
C_NewSiz1: LongInt);
|
||||||
|
VAR
|
||||||
|
FI: FILE OF Byte;
|
||||||
|
S3: AStr;
|
||||||
|
AType1: Byte;
|
||||||
|
RN1: Integer;
|
||||||
|
Ok2: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea1) THEN
|
||||||
|
ChangeFileArea(FArea1);
|
||||||
|
IF (FileArea = FArea1) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(F1,FN1,RN1);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (RN1 <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Read(FileInfoFile,F1);
|
||||||
|
IF Exist(MemFileArea.DLPath+F1.FileName) THEN
|
||||||
|
FN1 := MemFileArea.DLPath+F1.FileName
|
||||||
|
ELSE
|
||||||
|
FN1 := MemFileArea.ULPath+F1.FileName;
|
||||||
|
AType1 := ArcType(FN1);
|
||||||
|
IF (AType1 <> 0) AND (AType1 <> Toa) THEN
|
||||||
|
BEGIN
|
||||||
|
DisplayFileAreaHeader;
|
||||||
|
NL;
|
||||||
|
Star('Converting "'+SQOutSP(FN1)+'"');
|
||||||
|
Ok2 := FALSE;
|
||||||
|
IF (NOT Exist(FN1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('File "'+SQOutSP(FN1)+'" does not exist - changing extension.');
|
||||||
|
S3 := Copy(FN1,1,Pos('.',FN1))+General.FileArcInfo[Toa].Ext;
|
||||||
|
F1.FileName := Align(StripName(SQOutSP(S3)));
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Write(FileInfoFile,F1);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Ok2 := TRUE;
|
||||||
|
S3 := Copy(FN1,1,Pos('.',FN1))+General.FileArcInfo[Toa].Ext;
|
||||||
|
ConvA(Ok2,AType1,BB,SQOutSP(FN1),SQOutSP(S3));
|
||||||
|
IF (Ok2) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Assign(FI,SQOutSP(FN1));
|
||||||
|
Reset(FI);
|
||||||
|
Ok2 := (IOResult = 0);
|
||||||
|
IF (Ok2) THEN
|
||||||
|
BEGIN
|
||||||
|
OldSiz := FileSize(FI);
|
||||||
|
Close(FI);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Star('Unable to access "'+SQOutSP(FN1)+'"');
|
||||||
|
|
||||||
|
IF (Ok2) THEN
|
||||||
|
IF (NOT Exist(SQOutSP(S3))) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Unable to access "'+SQOutSP(S3)+'"');
|
||||||
|
SysOpLog('Unable to access '+SQOutSP(S3));
|
||||||
|
Ok2 := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Ok2) THEN
|
||||||
|
BEGIN
|
||||||
|
F1.FileName := Align(StripName(SQOutSP(S3)));
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Write(FileInfoFile,F1);
|
||||||
|
|
||||||
|
Kill(SQOutSP(FN1));
|
||||||
|
|
||||||
|
Assign(FI,SQOutSP(S3));
|
||||||
|
Reset(FI);
|
||||||
|
Ok2 := (IOResult = 0);
|
||||||
|
IF (NOT Ok2) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Unable to access '+SQOutSP(S3));
|
||||||
|
SysOpLog('Unable to access '+SQOutSP(S3));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NewSiz := FileSize(FI);
|
||||||
|
F1.FileSize := NewSiz;
|
||||||
|
Close(FI);
|
||||||
|
Seek(FileInfoFile,RN1);
|
||||||
|
Write(FileInfoFile,F1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Ok2) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(C_OldSiz1,OldSiz);
|
||||||
|
Inc(C_NewSiz1,NewSiz);
|
||||||
|
Inc(C_Files1);
|
||||||
|
Star('Old total space took up : '+ConvertBytes(OldSiz,FALSE));
|
||||||
|
Star('New total space taken up : '+ConvertBytes(NewSiz,FALSE));
|
||||||
|
IF (OldSiz - NewSiz > 0) THEN
|
||||||
|
Star('Space saved : '+ConvertBytes(OldSiz-NewSiz,FALSE))
|
||||||
|
ELSE
|
||||||
|
Star('Space wasted : '+ConvertBytes(NewSiz-OldSiz,FALSE));
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Unable to convert '+SQOutSP(FN1));
|
||||||
|
Star('Unable to convert '+SQOutSP(FN1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
NRecNo(F,RN1);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
TempPause := FALSE;
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Add file(s) to archive (up to '+IntToStr(MaxFiles)+') -');
|
||||||
|
NL;
|
||||||
|
Print('Archive file name: ');
|
||||||
|
Prt(':');
|
||||||
|
MPL(78);
|
||||||
|
Input(FileName,78);
|
||||||
|
|
||||||
|
IF IsUL(FileName) AND (NOT FileSysOp) THEN
|
||||||
|
FileName := '';
|
||||||
|
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NumFiles := 0;
|
||||||
|
IF (Pos('.',FileName) = 0) AND (MemFileArea.ArcType <> 0) THEN
|
||||||
|
FileName := FileName+'.'+General.FileArcInfo[MemFileArea.ArcType].Ext;
|
||||||
|
FNX := ISUL(FileName);
|
||||||
|
IF (NOT FNX) THEN
|
||||||
|
BEGIN
|
||||||
|
IF Exist(MemFileArea.DLPath+FileName) THEN
|
||||||
|
FileName := MemFileArea.DLPath+FileName
|
||||||
|
ELSE
|
||||||
|
FileName := MemFileArea.ULPath+FileName
|
||||||
|
END;
|
||||||
|
FileName := FExpand(FileName);
|
||||||
|
AType := ArcType(FileName);
|
||||||
|
IF (AType = 0) THEN
|
||||||
|
InvArc
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Cmd := 'A';
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd = 'A') THEN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Print('Add files to list - <CR> to end');
|
||||||
|
Prt(IntToStr(NumFiles + 1)+':');
|
||||||
|
MPL(70);
|
||||||
|
Input(S,70);
|
||||||
|
IF (S <> '') AND (NOT IsUL(S) OR FileSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Pos('.',S) = 0) THEN
|
||||||
|
S := S + '*.*';
|
||||||
|
AddFL(F,S,NumFiles,IsUL(S));
|
||||||
|
END;
|
||||||
|
UNTIL (S = '') OR (NumFiles >= MaxFiles) OR (HangUp);
|
||||||
|
NL;
|
||||||
|
Prt('Add files to list [^5?^4=^5Help^4]: ');
|
||||||
|
OneK(Cmd,'QADLR?',TRUE,TRUE);
|
||||||
|
NL;
|
||||||
|
CASE Cmd OF
|
||||||
|
'?' : BEGIN
|
||||||
|
LCmds(19,3,'Add more to list','Do it!');
|
||||||
|
LCmds(19,3,'List files in list','Remove files from list');
|
||||||
|
LCmds(19,3,'Quit','');
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
RecNum := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(RecNum);
|
||||||
|
Counter := 1;
|
||||||
|
S2 := SQOutSP(FileListArray[RecNum]);
|
||||||
|
IF (NOT IsUL(S2)) THEN
|
||||||
|
S2 := MemFileArea.DLPath+S2;
|
||||||
|
S1 := FunctionalMCI(General.FileArcInfo[AType].ArcLine,FileName,S2);
|
||||||
|
OS1 := S1;
|
||||||
|
WHILE (Length(S1) <= MaxDOSChrLine) AND (RecNum < NumFiles) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(RecNum);
|
||||||
|
Inc(Counter);
|
||||||
|
S2 := SQOutSP(FileListArray[RecNum]);
|
||||||
|
IF (NOT IsUL(S2)) THEN
|
||||||
|
S2 := MemFileArea.DLPath+S2;
|
||||||
|
OS1 := S1;
|
||||||
|
S1 := S1+' '+S2;
|
||||||
|
END;
|
||||||
|
IF (Length(S1) > MaxDOSChrLine) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(RecNum);
|
||||||
|
Dec(Counter);
|
||||||
|
S1 := OS1;
|
||||||
|
END;
|
||||||
|
Ok := TRUE;
|
||||||
|
Star('Adding '+IntToStr(Counter)+' files to archive...');
|
||||||
|
ExecBatch(Ok,
|
||||||
|
TempDir+'UP\',General.ArcsPath+S1,
|
||||||
|
General.FileArcInfo[AType].SuccLevel,Junk,FALSE);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('errors in adding files');
|
||||||
|
Ok := PYNQ('Continue anyway? ',0,FALSE);
|
||||||
|
IF (HangUp) THEN
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
UNTIL (RecNum >= NumFiles) OR (NOT Ok);
|
||||||
|
ArcComment(Ok,AType,MemFileArea.CmtType,FileName);
|
||||||
|
NL;
|
||||||
|
IF (NOT FNX) THEN
|
||||||
|
BEGIN
|
||||||
|
S1 := StripName(FileName);
|
||||||
|
RecNo(F,S1,RN);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (RN <> -1) THEN
|
||||||
|
Print('^5NOTE: File already exists in listing!');
|
||||||
|
IF PYNQ('Add archive to listing? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Assign(FI,FileName);
|
||||||
|
Reset(FI);
|
||||||
|
IF (IOResult = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
F.fileSize := FileSize(FI);
|
||||||
|
Close(FI);
|
||||||
|
END;
|
||||||
|
|
||||||
|
F.FileName := Align(S1);
|
||||||
|
Ok1 := TRUE;
|
||||||
|
IF PYNQ('Replace a file in directory? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Prt('Enter file name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(S2,12);
|
||||||
|
IF (S2 = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNo(F,S2,RN);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (RN = -1) THEN
|
||||||
|
Print('File not found!');
|
||||||
|
END;
|
||||||
|
UNTIL (RN <> -1) OR (S2 = '') OR (HangUp);
|
||||||
|
IF (S2 <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,RN);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
Kill(MemFileArea.ULPath+SQOutSP(F.FileName));
|
||||||
|
F.FileName := Align(S1);
|
||||||
|
Seek(FileInfoFile,RN);
|
||||||
|
Write(FileInfoFile,F);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Ok1 := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Ok1 := FALSE;
|
||||||
|
IF (NOT Ok1) THEN
|
||||||
|
BEGIN
|
||||||
|
WentToSysOp := FALSE;
|
||||||
|
GetFileDescription(F,ExtendedArray,NumExtDesc,WentToSysOp);
|
||||||
|
F.FilePoints := 0;
|
||||||
|
F.Downloaded := 0;
|
||||||
|
F.OwnerNum := UserNum;
|
||||||
|
F.OwnerName := AllCaps(ThisUser.Name);
|
||||||
|
F.FileDate := Date2PD(DateStr);
|
||||||
|
F.VPointer := -1;
|
||||||
|
F.VTextSize := 0;
|
||||||
|
END;
|
||||||
|
F.FIFlags := [];
|
||||||
|
|
||||||
|
IF (NOT AACS(General.ULValReq)) AND (NOT General.ValidateAllFiles) THEN
|
||||||
|
Include(F.FIFlags,FINotVal);
|
||||||
|
|
||||||
|
IF (NOT General.FileCreditRatio) THEN
|
||||||
|
F.FilePoints := 0
|
||||||
|
ELSE
|
||||||
|
F.FilePoints := ((F.FileSize DIV 1024) DIV General.FileCreditCompBaseSize);
|
||||||
|
|
||||||
|
IF (RN = -1) THEN
|
||||||
|
WriteFV(F,FileSize(FileInfoFile),ExtendedArray)
|
||||||
|
ELSE
|
||||||
|
WriteFV(F,RN,ExtendedArray);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF PYNQ('Delete original files? ',0,FALSE) THEN
|
||||||
|
FOR RecNum := 1 TO NumFiles DO
|
||||||
|
BEGIN
|
||||||
|
S2 := SQOutSP(FileListArray[RecNum]);
|
||||||
|
IF (NOT IsUL(FileListArray[RecNum])) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(F,S2,RN);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (RN <> -1) THEN
|
||||||
|
DeleteFF(F,RN);
|
||||||
|
S2 := MemFileArea.DLPath+S2;
|
||||||
|
END;
|
||||||
|
Kill(S2);
|
||||||
|
END;
|
||||||
|
IF (Ok) THEN
|
||||||
|
Cmd := 'Q';
|
||||||
|
END;
|
||||||
|
'L' : IF (NumFiles = 0) THEN
|
||||||
|
Print('No files in list!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
S := '';
|
||||||
|
Counter := 0;
|
||||||
|
RecNum := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(RecNum);
|
||||||
|
IF IsUL(FileListArray[RecNum]) THEN
|
||||||
|
S := S + '^3'
|
||||||
|
ELSE
|
||||||
|
S := S + '^1';
|
||||||
|
S := S + Align(StripName(FileListArray[RecNum]));
|
||||||
|
Inc(Counter);
|
||||||
|
IF (Counter < 5) THEN
|
||||||
|
S := S + ' '
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintACR(S);
|
||||||
|
S := '';
|
||||||
|
Counter := 0;
|
||||||
|
END;
|
||||||
|
UNTIL (RecNum = NumFiles) OR (Abort) OR (HangUp);
|
||||||
|
IF (Counter in [1..4]) AND (NOT Abort) THEN
|
||||||
|
PrintACR(S);
|
||||||
|
END;
|
||||||
|
'R' : IF (NumFiles = 0) THEN
|
||||||
|
Print('No files in list!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Prt('Remove file name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(S,12);
|
||||||
|
IF (S = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNum := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(RecNum);
|
||||||
|
IF Align(StripName(FileListArray[RecNum])) = Align(S) THEN
|
||||||
|
BEGIN
|
||||||
|
Prompt('^3'+SQOutSP(FileListArray[RecNum]));
|
||||||
|
IF PYNQ(' Remove it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := RecNum TO (NumFiles - 1) DO
|
||||||
|
FileListArray[Counter] := FileListArray[Counter + 1];
|
||||||
|
Dec(NumFiles);
|
||||||
|
Dec(RecNum);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (RecNum >= NumFiles);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'C' : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Convert archive formats -');
|
||||||
|
NL;
|
||||||
|
Print('Filespec:');
|
||||||
|
Prt(':');
|
||||||
|
MPL(78);
|
||||||
|
Input(FileName,78);
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NL;
|
||||||
|
REPEAT
|
||||||
|
Prt('Archive type to use? (?=List): ');
|
||||||
|
MPL(3);
|
||||||
|
Input(S,3);
|
||||||
|
IF (S = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
ListArcTypes;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
UNTIL (S <> '?');
|
||||||
|
|
||||||
|
IF (StrToInt(S) <> 0) THEN
|
||||||
|
BB := StrToInt(S)
|
||||||
|
ELSE
|
||||||
|
BB := ArcType('F.'+S);
|
||||||
|
|
||||||
|
IF (BB <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
C_Files := 0;
|
||||||
|
C_OldSiz := 0;
|
||||||
|
C_NewSiz := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
SysOpLog('Conversion process initiated at '+DateStr+' '+TimeStr+'.');
|
||||||
|
IF (IsUL(FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
FSplit(FileName,DS,NS,ES);
|
||||||
|
FindFirst(FileName,AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
FileName := FExpand(SQOutSP(DS+DirInfo.Name));
|
||||||
|
AType := ArcType(FileName);
|
||||||
|
IF (AType <> 0) AND (AType <> BB) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Converting "'+FileName+'"');
|
||||||
|
Ok := TRUE;
|
||||||
|
S := Copy(FileName,1,Pos('.',FileName))+General.FileArcInfo[BB].Ext;
|
||||||
|
ConvA(Ok,AType,BB,FileName,S);
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Assign(FI,SQOutSP(FileName));
|
||||||
|
Reset(FI);
|
||||||
|
Ok := (IOResult = 0);
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
OldSiz := FileSize(FI);
|
||||||
|
Close(FI);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Star('Unable to access '+SQOutSP(FileName));
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
IF (NOT Exist(SQOutSP(S))) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Unable to access '+SQOutSP(S));
|
||||||
|
SysOpLog('Unable to access '+SQOutSP(S));
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Kill(SQOutSP(FileName));
|
||||||
|
|
||||||
|
Assign(FI,SQOutSP(S));
|
||||||
|
Reset(FI);
|
||||||
|
Ok := (IOResult = 0);
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NewSiz := FileSize(FI);
|
||||||
|
Close(FI);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Star('Unable to access "'+SQOutSP(S)+'"');
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(C_OldSiz,OldSiz);
|
||||||
|
Inc(C_NewSiz,NewSiz);
|
||||||
|
Inc(C_Files);
|
||||||
|
Star('Old total space took up : '+ConvertBytes(OldSiz,FALSE));
|
||||||
|
Star('New total space taken up : '+ConvertBytes(NewSiz,FALSE));
|
||||||
|
IF (OldSiz - NewSiz > 0) THEN
|
||||||
|
Star('Space saved : '+ConvertBytes(OldSiz-NewSiz,FALSE))
|
||||||
|
ELSE
|
||||||
|
Star('Space wasted : '+ConvertBytes(NewSiz-OldSiz,FALSE));
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Unable to convert '+SQOutSP(FileName));
|
||||||
|
Star('Unable to convert '+SQOutSP(FileName));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
|
||||||
|
CvtFiles(F,FileArea,FileName,BB,C_Files,C_OldSiz,C_NewSiz)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
CvtFiles(F,FArea,FileName,BB,C_Files,C_OldSiz,C_NewSiz);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
SysOpLog('Conversion process completed at '+DateStr+' '+TimeStr+'.');
|
||||||
|
NL;
|
||||||
|
Star('Total archives converted : '+IntToStr(C_Files));
|
||||||
|
Star('Old total space took up : '+ConvertBytes(C_OldSiz,FALSE));
|
||||||
|
Star('New total space taken up : '+ConvertBytes(C_NewSiz,FALSE));
|
||||||
|
IF ((C_OldSiz - C_NewSiz) > 0) THEN
|
||||||
|
Star('Space saved : '+ConvertBytes((C_OldSiz - C_NewSiz),FALSE))
|
||||||
|
ELSE
|
||||||
|
Star('Space wasted : '+ConvertBytes((C_NewSiz - C_OldSiz),FALSE));
|
||||||
|
SysOpLog('Converted '+IntToStr(C_Files)+' archives; old size='+
|
||||||
|
ConvertBytes(C_OldSiz,FALSE)+' , new size='+ConvertBytes(C_NewSiz,FALSE));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'M' : BEGIN
|
||||||
|
Ok := FALSE;
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
IF (General.FileArcComment[Counter] <> '') THEN
|
||||||
|
Ok := TRUE;
|
||||||
|
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('No comment''s are available.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('Comment field update -');
|
||||||
|
NL;
|
||||||
|
Print('Filespec:');
|
||||||
|
Prt(':');
|
||||||
|
MPL(78);
|
||||||
|
Input(FileName,78);
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
IF (IsUL(FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
S := '';
|
||||||
|
NL;
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
IF (General.FileArcComment[Counter] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
S := S + IntToStr(Counter);
|
||||||
|
Print('^1'+IntToStr(Counter)+'. Archive comment file: ^5'+General.FileArcComment[Counter]);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Prt('Comment to use [0=Quit]: ');
|
||||||
|
OneK(Cmd,'0'+S,TRUE,TRUE);
|
||||||
|
|
||||||
|
IF (Cmd IN ['1'..'3']) THEN
|
||||||
|
BEGIN
|
||||||
|
FSplit(FileName,DS,NS,ES);
|
||||||
|
FindFirst(FileName,AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
FileName := FExpand(SQOutSP(DS+DirInfo.Name));
|
||||||
|
AType := ArcType(FileName);
|
||||||
|
IF (AType <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Commenting "'+FileName+'"');
|
||||||
|
Ok := TRUE;
|
||||||
|
ArcComment(Ok,AType,(Ord(Cmd) - 48),FileName);
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
|
||||||
|
CmtFiles(F,FileArea,FileName)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
CmtFiles(F,FArea,FileName);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('File integrity testing -');
|
||||||
|
NL;
|
||||||
|
Print('Filespec:');
|
||||||
|
Prt(':');
|
||||||
|
MPL(78);
|
||||||
|
Input(FileName,78);
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
DelBad := PYNQ('Delete files that don''t pass the test? ',0,FALSE);
|
||||||
|
NL;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
IF (IsUL(FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
FSplit(FileName,DS,NS,ES);
|
||||||
|
FindFirst(FileName,AnyFile - Directory - VolumeID - DOS.Hidden - SysFile,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
FileName := FExpand(SQOutSP(DS+DirInfo.Name));
|
||||||
|
AType := ArcType(FileName);
|
||||||
|
IF (AType <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Testing "'+FileName+'"');
|
||||||
|
Ok := TRUE;
|
||||||
|
ArcIntegrityTest(Ok,AType,FileName);
|
||||||
|
IF (Ok) THEN
|
||||||
|
Star('Passed integrity test.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Star('File "'+FileName+'" didn''t pass integrity test.');
|
||||||
|
IF (DelBad) THEN
|
||||||
|
Kill(FileName);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
|
||||||
|
TestFiles(F,FileArea,FileName,DelBad)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
TestFiles(F,FArea,FileName,DelBad);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,244 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Archive3;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ReZipStuff;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Archive1,
|
||||||
|
Common,
|
||||||
|
Execbat,
|
||||||
|
File0,
|
||||||
|
File11,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE CvtFiles(FArea: Integer; FileName,ReZipCmd: AStr; VAR TotalFiles: SmallInt; VAR TotalOldSize,TotalNewSize: LongInt);
|
||||||
|
VAR
|
||||||
|
S: AStr;
|
||||||
|
DS: DirStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
AType: Byte;
|
||||||
|
ReturnCode,
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
OldSiz,
|
||||||
|
NewSiz: LongInt;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) AND (NOT (FACDROM IN MemFileArea.FAFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(FileInfo,FileName,DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
FileName := MemFileArea.DLPath+FileInfo.FileName
|
||||||
|
ELSE
|
||||||
|
FileName := MemFileArea.ULPath+FileInfo.FileName;
|
||||||
|
|
||||||
|
AType := ArcType(FileName);
|
||||||
|
IF (AType <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
DisplayFileAreaHeader;
|
||||||
|
NL;
|
||||||
|
Star('Converting "'+SQOutSp(FileName)+'"');
|
||||||
|
Ok := FALSE;
|
||||||
|
IF (NOT Exist(FileName)) THEN
|
||||||
|
Star('File "'+SQOutSp(FileName)+'" doesn''t exist.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (ReZipCmd <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
OldSiz := GetFileSize(FileName);
|
||||||
|
|
||||||
|
ExecBatch(Ok,TempDir+'ARC\',ReZipCmd+' '+SQOutSp(FileName),-1,ReturnCode,FALSE);
|
||||||
|
|
||||||
|
NewSiz := GetFileSize(FileName);
|
||||||
|
|
||||||
|
FileInfo.FileSize := NewSiz;
|
||||||
|
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Ok := TRUE;
|
||||||
|
S := FileName;
|
||||||
|
|
||||||
|
OldSiz := GetFileSize(FileName);
|
||||||
|
|
||||||
|
ConvA(Ok,AType,AType,SQOutSp(FileName),SQOutSp(S));
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
IF (NOT Exist(SQOutSp(S))) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Unable to access "'+SQOutSp(S)+'"');
|
||||||
|
SysOpLog('Unable to access '+SQOutSp(S));
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
FileInfo.FileName := Align(StripName(SQOutSp(S)));
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
|
||||||
|
FSplit(FileName,DS,NS,ES);
|
||||||
|
FileName := DS+NS+'.#$%';
|
||||||
|
Kill(FileName);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Unable to erase '+SQOutSp(FileName));
|
||||||
|
SysOpLog('Unable to erase '+SQOutSp(FileName));
|
||||||
|
END;
|
||||||
|
|
||||||
|
Ok := Exist(SQOutSp(S));
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Unable to access '+SQOutSp(S));
|
||||||
|
SysOpLog('Unable to access '+SQOutSp(S));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NewSiz := GetFileSize(S);
|
||||||
|
|
||||||
|
FileInfo.FileSize := NewSiz;
|
||||||
|
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
ArcComment(Ok,AType,MemFileArea.CmtType,SQOutSp(S));
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Unable to convert '+SQOutSp(FileName));
|
||||||
|
Star('Unable to convert '+SQOutSp(FileName));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(TotalOldSize,OldSiz);
|
||||||
|
Inc(TotalNewSize,NewSiz);
|
||||||
|
Inc(TotalFiles);
|
||||||
|
Star('Old total space took up : '+ConvertBytes(OldSiz,FALSE));
|
||||||
|
Star('New total space taken up : '+ConvertBytes(NewSiz,FALSE));
|
||||||
|
IF ((OldSiz - NewSiz) > 0) THEN
|
||||||
|
Star('Space saved : '+ConvertBytes(OldSiz - NewSiz,FALSE))
|
||||||
|
ELSE
|
||||||
|
Star('Space wasted : '+ConvertBytes(NewSiz - OldSiz,FALSE));
|
||||||
|
END;
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
NRecNo(FileInfo,DirFileRecNum);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReZipStuff;
|
||||||
|
TYPE
|
||||||
|
TotalsRecordType = RECORD
|
||||||
|
TotalFiles: SmallInt;
|
||||||
|
TotalOldSize,
|
||||||
|
TotalNewSize: LongInt
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
TotalsRecord: TotalsRecordType;
|
||||||
|
FileName: Str12;
|
||||||
|
ReZipCmd: Str78;
|
||||||
|
FArea,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
BEGIN
|
||||||
|
FillChar(TotalsRecord,SizeOf(TotalsRecord),0);
|
||||||
|
NL;
|
||||||
|
Print('Re-compress archives -');
|
||||||
|
NL;
|
||||||
|
Print('Filespec:');
|
||||||
|
Prt(':');
|
||||||
|
MPL(12);
|
||||||
|
Input(FileName,12);
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
ReZipCmd := '';
|
||||||
|
NL;
|
||||||
|
Print('^7Do you wish to use a REZIP external utility?');
|
||||||
|
IF PYNQ('(such as REZIP.EXE)? (Y/N): ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Enter commandline (example: "REZIP"): ');
|
||||||
|
Prt(':');
|
||||||
|
Input(ReZipCmd,78);
|
||||||
|
IF (ReZipCmd = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Conversion process initiated: '+DateStr+' '+TimeStr+'.');
|
||||||
|
SysOpLog('Conversion process initiated: '+DateStr+' '+TimeStr+'.');
|
||||||
|
NL;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
IF NOT PYNQ('Search all file areas? ',0,FALSE) THEN
|
||||||
|
CvtFiles(FileArea,FileName,ReZipCmd,TotalsRecord.TotalFiles,TotalsRecord.TotalOldSize,TotalsRecord.TotalNewSize)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
CvtFiles(FArea,FileName,ReZipCmd,TotalsRecord.TotalFiles,TotalsRecord.TotalOldSize,TotalsRecord.TotalNewSize);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Conversion process complete at '+DateStr+' '+TimeStr+'.');
|
||||||
|
SysOpLog('Conversion process complete at '+DateStr+' '+TimeStr+'.');
|
||||||
|
NL;
|
||||||
|
Star('Total archives converted : '+IntToStr(TotalsRecord.TotalFiles));
|
||||||
|
Star('Old total space took up : '+ConvertBytes(TotalsRecord.TotalOldSize,FALSE));
|
||||||
|
Star('New total space taken up : '+ConvertBytes(TotalsRecord.TotalNewSize,FALSE));
|
||||||
|
|
||||||
|
IF ((TotalsRecord.TotalOldSize - TotalsRecord.TotalNewSize) > 0) THEN
|
||||||
|
Star('Space saved : '+ConvertBytes(TotalsRecord.TotalOldSize - TotalsRecord.TotalNewSize,FALSE))
|
||||||
|
ELSE
|
||||||
|
Star('Space wasted : '+ConvertBytes(TotalsRecord.TotalNewSize - TotalsRecord.TotalOldSize,FALSE));
|
||||||
|
|
||||||
|
|
||||||
|
SysOpLog('Converted '+IntToStr(TotalsRecord.TotalFiles)+' archives; old size='+
|
||||||
|
ConvertBytes(TotalsRecord.TotalOldSize,FALSE)+' , new size='+ConvertBytes(TotalsRecord.TotalNewSize,FALSE));
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,852 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT ArcView;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION ValidIntArcType(FileName: Str12): Boolean;
|
||||||
|
PROCEDURE ViewInternalArchive(FileName: AStr);
|
||||||
|
PROCEDURE ViewDirInternalArchive;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
File0,
|
||||||
|
File14,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
CONST
|
||||||
|
MethodType: ARRAY [0..21] OF STRING[10] =
|
||||||
|
('Directory ', {* Directory marker *}
|
||||||
|
'Unknown! ', {* Unknown compression type *}
|
||||||
|
'Stored ', {* No compression *}
|
||||||
|
'Packed ', {* Repeat-Byte compression *}
|
||||||
|
'Squeezed ', {* Huffman with repeat-Byte compression *}
|
||||||
|
'crunched ', {* Obsolete LZW compression *}
|
||||||
|
'Crunched ', {* LZW 9-12 bit with repeat-Byte compression *}
|
||||||
|
'Squashed ', {* LZW 9-13 bit compression *}
|
||||||
|
'Crushed ', {* LZW 2-13 bit compression *}
|
||||||
|
'Shrunk ', {* LZW 9-13 bit compression *}
|
||||||
|
'Reduced 1 ', {* Probabilistic factor 1 compression *}
|
||||||
|
'Reduced 2 ', {* Probabilistic factor 2 compression *}
|
||||||
|
'Reduced 3 ', {* Probabilistic factor 3 compression *}
|
||||||
|
'Reduced 4 ', {* Probabilistic factor 4 compression *}
|
||||||
|
'Frozen ', {* Modified LZW/Huffman compression *}
|
||||||
|
'Imploded ', {* Shannon-Fano tree compression *}
|
||||||
|
'Compressed',
|
||||||
|
'Method 1 ',
|
||||||
|
'Method 2 ',
|
||||||
|
'Method 3 ',
|
||||||
|
'Method 4 ',
|
||||||
|
'Deflated ');
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
ArcRecordType = RECORD {* structure of ARC archive file header *}
|
||||||
|
FileName: ARRAY [0..12] OF Char; {* FileName *}
|
||||||
|
C_Size: LongInt; {* compressed size *}
|
||||||
|
Mod_Date: SmallInt; {* last mod file Date *}
|
||||||
|
Mod_Time: SmallInt; {* last mod file Time *}
|
||||||
|
CRC: SmallInt; {* CRC *}
|
||||||
|
U_Size: LongInt; {* uncompressed size *}
|
||||||
|
END;
|
||||||
|
|
||||||
|
ZipRecordType = RECORD {* structure of ZIP archive file header *}
|
||||||
|
Version: SmallInt; {* Version needed to extract *}
|
||||||
|
Bit_Flag: SmallInt; {* General purpose bit flag *}
|
||||||
|
Method: SmallInt; {* compression Method *}
|
||||||
|
Mod_Time: SmallInt; {* last mod file Time *}
|
||||||
|
Mod_Date: SmallInt; {* last mod file Date *}
|
||||||
|
CRC: LongInt; {* CRC-32 *}
|
||||||
|
C_Size: LongInt; {* compressed size *}
|
||||||
|
U_Size: LongInt; {* uncompressed size *}
|
||||||
|
F_Length: SmallInt; {* FileName Length *}
|
||||||
|
E_Length: SmallInt; {* extra field Length *}
|
||||||
|
END;
|
||||||
|
|
||||||
|
ZooRecordType = RECORD {* structure of ZOO archive file header *}
|
||||||
|
Tag: LongInt; {* Tag -- redundancy check *}
|
||||||
|
Typ: Byte; {* TYPE of directory entry (always 1 for now) *}
|
||||||
|
Method: Byte; {* 0 = Stored, 1 = Crunched *}
|
||||||
|
Next: LongInt; {* position of Next directory entry *}
|
||||||
|
Offset: LongInt; {* position of this file *}
|
||||||
|
Mod_Date: SmallWord; {* modification Date (DOS format) *}
|
||||||
|
Mod_Time: SmallWord; {* modification Time (DOS format) *}
|
||||||
|
CRC: SmallWord; {* CRC *}
|
||||||
|
U_Size: LongInt; {* uncompressed size *}
|
||||||
|
C_Size: LongInt; {* compressed size *}
|
||||||
|
Major_V: Char; {* major Version number *}
|
||||||
|
Minor_V: Char; {* minor Version number *}
|
||||||
|
Deleted: Byte; {* 0 = active, 1 = Deleted *}
|
||||||
|
Struc: Char; {* file structure if any *}
|
||||||
|
Comment: LongInt; {* location of file Comment (0 = none) *}
|
||||||
|
Cmt_Size: SmallWord; {* Length of Comment (0 = none) *}
|
||||||
|
FName: ARRAY [0..12] OF Char; {* FileName *}
|
||||||
|
Var_DirLen: SmallInt; {* Length of variable part of dir entry *}
|
||||||
|
TZ: Char; {* timezone where file was archived *}
|
||||||
|
Dir_Crc: SmallWord; {* CRC of directory entry *}
|
||||||
|
END;
|
||||||
|
|
||||||
|
LZHRecordType = RECORD {* structure of LZH archive file header *}
|
||||||
|
H_Length: Byte; {* Length of header *}
|
||||||
|
H_Cksum: Byte; {* checksum of header bytes *}
|
||||||
|
Method: ARRAY [1..5] OF Char; {* compression TYPE "-lh#-" *}
|
||||||
|
C_Size: LongInt; {* compressed size *}
|
||||||
|
U_Size: LongInt; {* uncompressed size *}
|
||||||
|
Mod_Time: SmallInt;{* last mod file Time *}
|
||||||
|
Mod_Date: SmallInt;{* last mod file Date *}
|
||||||
|
Attrib: SmallInt; {* file attributes *}
|
||||||
|
F_Length: Byte; {* Length of FileName *}
|
||||||
|
CRC: SmallInt; {* CRC *}
|
||||||
|
END;
|
||||||
|
|
||||||
|
ARJRecordType = RECORD
|
||||||
|
FirstHdrSize: Byte;
|
||||||
|
ARJVersion: Byte;
|
||||||
|
ARJRequired: Byte;
|
||||||
|
HostOS: Byte;
|
||||||
|
Flags: Byte;
|
||||||
|
Method: Byte;
|
||||||
|
FileType: Byte;
|
||||||
|
GarbleMod: Byte;
|
||||||
|
Time,
|
||||||
|
Date: SmallInt;
|
||||||
|
CompSize: LongInt;
|
||||||
|
OrigSize: LongInt;
|
||||||
|
OrigCRC: ARRAY[1..4] OF Byte;
|
||||||
|
EntryName: SmallWord;
|
||||||
|
AccessMode: SmallWord;
|
||||||
|
HostData: SmallWord;
|
||||||
|
END;
|
||||||
|
|
||||||
|
OutRec = RECORD {* output information structure *}
|
||||||
|
FileName: AStr; {* output file name *}
|
||||||
|
Date, {* output Date *}
|
||||||
|
Time, {* output Time *}
|
||||||
|
Method: SmallInt; {* output storage type *}
|
||||||
|
CSize, {* output compressed size *}
|
||||||
|
USize: LongInt; {* output uncompressed size *}
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE AbEnd(VAR Aborted: Boolean);
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7** ^5Error processing archive^7 **');
|
||||||
|
Aborted := TRUE;
|
||||||
|
Abort := TRUE;
|
||||||
|
Next := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Details(Out: OutRec;
|
||||||
|
VAR Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
VAR TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt);
|
||||||
|
VAR
|
||||||
|
OutP: AStr;
|
||||||
|
AMPM: Str2;
|
||||||
|
DT: DateTime;
|
||||||
|
Ratio: LongInt;
|
||||||
|
BEGIN
|
||||||
|
Out.FileName := AllCaps(Out.FileName);
|
||||||
|
DT.Day := Out.Date AND $1f; {* Day = bits 4-0 *}
|
||||||
|
DT.Month := (Out.Date SHR 5) AND $0f; {* Month = bits 8-5 *}
|
||||||
|
DT.Year := ((Out.Date SHR 9) AND $7f) + 80; {* Year = bits 15-9 *}
|
||||||
|
DT.Min := (Out.Time SHR 5) AND $3f; {* Minute = bits 10-5 *}
|
||||||
|
DT.Hour := (Out.Time SHR 11) AND $1f; {* Hour = bits 15-11 *}
|
||||||
|
|
||||||
|
IF (DT.Month > 12) THEN
|
||||||
|
Dec(DT.Month,12); {* adjust for Month > 12 *}
|
||||||
|
IF (DT.Year > 99) THEN
|
||||||
|
Dec(DT.Year,100); {* adjust for Year > 1999 *}
|
||||||
|
IF (DT.Hour > 23) THEN
|
||||||
|
Dec(DT.Hour,24); {* adjust for Hour > 23 *}
|
||||||
|
IF (DT.Min > 59) THEN
|
||||||
|
Dec(DT.Min,60); {* adjust for Minute > 59 *}
|
||||||
|
|
||||||
|
ConvertAmPm(DT.Hour,AmPm);
|
||||||
|
|
||||||
|
IF (Out.USize = 0) THEN
|
||||||
|
Ratio := 0
|
||||||
|
ELSE {* Ratio is 0% for null-Length file *}
|
||||||
|
Ratio := (100 - ((Out.CSize * 100) DIV Out.USize));
|
||||||
|
IF (Ratio > 99) THEN
|
||||||
|
Ratio := 99;
|
||||||
|
|
||||||
|
OutP := '^4'+PadRightStr(FormatNumber(Out.USize),13)+
|
||||||
|
' '+PadRightStr(FormatNumber(Out.CSize),13)+
|
||||||
|
' '+PadRightInt(Ratio,2)+'%'+
|
||||||
|
' ^9'+MethodType[Out.Method]+
|
||||||
|
' ^7'+ZeroPad(IntToStr(DT.Month))+
|
||||||
|
'/'+ZeroPad(IntToStr(DT.Day))+
|
||||||
|
'/'+ZeroPad(IntToStr(DT.Year))+
|
||||||
|
' '+ZeroPad(IntToStr(DT.Hour))+
|
||||||
|
':'+ZeroPad(IntToStr(DT.Min))+
|
||||||
|
AMPM[1]+' ^5';
|
||||||
|
|
||||||
|
IF (Level > 0) THEN
|
||||||
|
OutP := OutP + PadRightStr('',Level); {* spaces for dirs (ARC only)*}
|
||||||
|
|
||||||
|
OutP := OutP + Out.FileName;
|
||||||
|
|
||||||
|
PrintACR(OutP);
|
||||||
|
|
||||||
|
IF (Out.Method = 0) THEN
|
||||||
|
Inc(Level) {* bump dir Level (ARC only) *}
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(TotalCompSize,Out.CSize); {* adjust accumulators and counter *}
|
||||||
|
Inc(TotalUnCompSize,Out.USize);
|
||||||
|
Inc(NumFiles);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Final(NumFiles: Integer;
|
||||||
|
TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt);
|
||||||
|
VAR
|
||||||
|
OutP: AStr;
|
||||||
|
Ratio: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (TotalUnCompSize = 0) THEN
|
||||||
|
Ratio := 0
|
||||||
|
ELSE
|
||||||
|
Ratio := (100 - ((TotalCompSize * 100) DIV TotalUnCompSize));
|
||||||
|
IF (Ratio > 99) THEN
|
||||||
|
Ratio := 99;
|
||||||
|
|
||||||
|
OutP := '^4'+PadRightStr(FormatNumber(TotalUnCompSize),13)+
|
||||||
|
' '+PadRightStr(FormatNumber(TotalCompSize),13)+
|
||||||
|
' '+PadRightInt(Ratio,2)+
|
||||||
|
'% ^5'+IntToStr(NumFiles)+' '+Plural('file',NumFiles);
|
||||||
|
PrintACR('^4------------- ------------- --- ------------');
|
||||||
|
PrintACR(OutP);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetByte(VAR F: FILE; VAR Aborted: Boolean): Char;
|
||||||
|
VAR
|
||||||
|
C: Char;
|
||||||
|
NumRead: Word;
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Aborted) THEN
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,C,1,NumRead);
|
||||||
|
IF (NumRead = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(F);
|
||||||
|
AbEnd(Aborted);
|
||||||
|
END;
|
||||||
|
GetByte := C;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ZIP_Proc(VAR F: FILE;
|
||||||
|
VAR Out: OutRec;
|
||||||
|
VAR Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
VAR TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt;
|
||||||
|
VAR Aborted: Boolean);
|
||||||
|
VAR
|
||||||
|
ZIP: ZipRecordType;
|
||||||
|
C: Char;
|
||||||
|
Counter: Integer;
|
||||||
|
NumRead: Word;
|
||||||
|
Signature: LongInt;
|
||||||
|
BEGIN
|
||||||
|
WHILE (NOT Aborted) DO
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,Signature,4,NumRead);
|
||||||
|
IF (Signature = $02014b50) OR (Signature = $06054b50) THEN
|
||||||
|
Exit;
|
||||||
|
IF (NumRead <> 4) OR (Signature <> $04034b50) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
BlockRead(F,ZIP,26,NumRead);
|
||||||
|
IF (NumRead <> 26) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
FOR Counter := 1 TO ZIP.F_Length DO
|
||||||
|
Out.FileName[Counter] := GetByte(F,Aborted);
|
||||||
|
Out.FileName[0] := Chr(ZIP.F_Length);
|
||||||
|
FOR Counter := 1 TO ZIP.E_Length DO
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
Out.Date := ZIP.Mod_Date;
|
||||||
|
Out.Time := ZIP.Mod_Time;
|
||||||
|
Out.CSize := ZIP.C_Size;
|
||||||
|
Out.USize := ZIP.U_Size;
|
||||||
|
CASE ZIP.Method OF
|
||||||
|
0 : Out.Method := 2;
|
||||||
|
1 : Out.Method := 9;
|
||||||
|
2,3,4,5 :
|
||||||
|
Out.Method := (ZIP.Method + 8);
|
||||||
|
6 : Out.Method := 15;
|
||||||
|
8 : Out.Method := 21;
|
||||||
|
ELSE
|
||||||
|
Out.Method := 1;
|
||||||
|
END;
|
||||||
|
Details(Out,Level,NumFiles,TotalCompSize,TotalUnCompSize);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit;
|
||||||
|
Seek(F,(FilePos(F) + ZIP.C_Size));
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ARJ_Proc(VAR ArjFile: FILE;
|
||||||
|
VAR Out: OutRec;
|
||||||
|
VAR Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
VAR TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt;
|
||||||
|
VAR Aborted: Boolean);
|
||||||
|
TYPE
|
||||||
|
ARJSignature = RECORD
|
||||||
|
MagicNumber: SmallWord;
|
||||||
|
BasicHdrSiz: SmallWord;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Hdr: ARJRecordType;
|
||||||
|
Sig: ARJSignature;
|
||||||
|
FileName,
|
||||||
|
FileTitle: AStr;
|
||||||
|
JunkByte: Byte;
|
||||||
|
Counter: Integer;
|
||||||
|
NumRead,
|
||||||
|
ExtSize: Word;
|
||||||
|
HeaderCrc: LongInt;
|
||||||
|
BEGIN
|
||||||
|
BlockRead(ArjFile,Sig,SizeOf(Sig));
|
||||||
|
IF (IOResult <> 0) OR (Sig.MagicNumber <> $EA60) THEN
|
||||||
|
Exit
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
BlockRead(ArjFile,Hdr,SizeOf(Hdr),NumRead);
|
||||||
|
Counter := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
BlockRead(ArjFile,FileName[Counter],1);
|
||||||
|
UNTIL (FileName[Counter] = #0);
|
||||||
|
FileName[0] := Chr(Counter - 1);
|
||||||
|
REPEAT
|
||||||
|
BlockRead(ArjFile,JunkByte,1);
|
||||||
|
UNTIL (JunkByte = 0);
|
||||||
|
BlockRead(ArjFile,HeaderCRC,4);
|
||||||
|
BlockRead(ArjFile,ExtSize,2);
|
||||||
|
IF (ExtSize > 0) THEN
|
||||||
|
Seek(ArjFile,FilePos(ArjFile) + ExtSize + 4);
|
||||||
|
BlockRead(ArjFile,Sig,SizeOf(Sig));
|
||||||
|
WHILE (Sig.BasicHdrSiz > 0) AND (NOT Abort) AND (IOResult = 0) DO
|
||||||
|
BEGIN
|
||||||
|
BlockRead(ArjFile,Hdr,SizeOf(Hdr),NumRead);
|
||||||
|
Counter := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
BlockRead(ArjFile,FileName[Counter],1);
|
||||||
|
UNTIL (FileName[Counter] = #0);
|
||||||
|
FileName[0] := Chr(Counter - 1);
|
||||||
|
Out.FileName := FileName;
|
||||||
|
Out.Date := Hdr.Date;
|
||||||
|
Out.Time := Hdr.Time;
|
||||||
|
IF (Hdr.Method = 0) THEN
|
||||||
|
Out.Method := 2
|
||||||
|
ELSE
|
||||||
|
Out.Method := (Hdr.Method + 16);
|
||||||
|
Out.CSize := Hdr.CompSize;
|
||||||
|
Out.USize := Hdr.OrigSize;
|
||||||
|
Details(Out,Level,NumFiles,TotalCompSize,TotalUnCompSize);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(ArjFile,JunkByte,1);
|
||||||
|
UNTIL (JunkByte = 0);
|
||||||
|
BlockRead(ArjFile,HeaderCRC,4);
|
||||||
|
BlockRead(ArjFile,ExtSize,2);
|
||||||
|
Seek(ArjFile,(FilePos(ArjFile) + Hdr.CompSize));
|
||||||
|
BlockRead(ArjFile,Sig,SizeOf(Sig));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ARC_Proc(VAR F: FILE;
|
||||||
|
VAR Out: OutRec;
|
||||||
|
VAR Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
VAR TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt;
|
||||||
|
VAR Aborted: Boolean);
|
||||||
|
VAR
|
||||||
|
Arc: ArcRecordType;
|
||||||
|
C: Char;
|
||||||
|
Counter,
|
||||||
|
Method: Integer;
|
||||||
|
NumRead: Word;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
Method := Ord(GetByte(F,Aborted));
|
||||||
|
CASE Method OF
|
||||||
|
0 : Exit;
|
||||||
|
1,2 :
|
||||||
|
Out.Method := 2;
|
||||||
|
3,4,5,6,7 :
|
||||||
|
Out.Method := Method;
|
||||||
|
8,9,10 :
|
||||||
|
Out.Method := (Method - 2);
|
||||||
|
30 : Out.Method := 0;
|
||||||
|
31 : Dec(Level);
|
||||||
|
ELSE
|
||||||
|
Out.Method := 1;
|
||||||
|
END;
|
||||||
|
IF (Method <> 31) THEN
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,Arc,23,NumRead);
|
||||||
|
IF (NumRead <> 23) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (Method = 1) THEN
|
||||||
|
Arc.U_Size := Arc.C_Size
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,Arc.U_Size,4,NumRead);
|
||||||
|
IF (NumRead <> 4) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Counter := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
Out.FileName[Counter] := Arc.FileName[Counter - 1];
|
||||||
|
UNTIL (Arc.FileName[Counter] = #0) OR (Counter = 13);
|
||||||
|
Out.FileName[0] := Chr(Counter);
|
||||||
|
Out.Date := Arc.Mod_Date;
|
||||||
|
Out.Time := Arc.Mod_Time;
|
||||||
|
IF (Method = 30) THEN
|
||||||
|
BEGIN
|
||||||
|
Arc.C_Size := 0;
|
||||||
|
Arc.U_Size := 0;
|
||||||
|
END;
|
||||||
|
Out.CSize := Arc.C_Size;
|
||||||
|
Out.USize := Arc.U_Size;
|
||||||
|
Details(Out,Level,NumFiles,TotalCompSize,TotalUnCompSize);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit;
|
||||||
|
IF (Method <> 30) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(F,(FilePos(F) + Arc.C_Size));
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (C <> #$1a) OR (Aborted);
|
||||||
|
IF (NOT Aborted) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ZOO_Proc(VAR F: FILE;
|
||||||
|
VAR Out: OutRec;
|
||||||
|
VAR Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
VAR TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt;
|
||||||
|
VAR Aborted: Boolean);
|
||||||
|
VAR
|
||||||
|
ZOO: ZooRecordType;
|
||||||
|
ZOO_LongName,
|
||||||
|
ZOO_DirName: AStr;
|
||||||
|
C: Char;
|
||||||
|
NamLen,
|
||||||
|
DirLen: Byte;
|
||||||
|
Counter,
|
||||||
|
Method: Integer;
|
||||||
|
NumRead: Word;
|
||||||
|
ZOO_Temp,
|
||||||
|
ZOO_Tag: LongInt;
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
FOR Counter := 0 TO 19 DO
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
BlockRead(F,ZOO_Tag,4,NumRead);
|
||||||
|
IF (NumRead <> 4) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
IF (ZOO_Tag <> $fdc4a7dc) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
BlockRead(F,ZOO_Temp,4,NumRead);
|
||||||
|
IF (NumRead <> 4) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Seek(F,ZOO_Temp);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
|
||||||
|
WHILE (NOT Aborted) DO
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,ZOO,56,NumRead);
|
||||||
|
IF (NumRead <> 56) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (ZOO.Tag <> $fdc4a7dc) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
IF (Abort) OR (ZOO.Next = 0) THEN
|
||||||
|
Exit;
|
||||||
|
NamLen := Ord(GetByte(F,Aborted));
|
||||||
|
DirLen := Ord(GetByte(F,Aborted));
|
||||||
|
ZOO_LongName := '';
|
||||||
|
ZOO_DirName := '';
|
||||||
|
|
||||||
|
IF (NamLen > 0) THEN
|
||||||
|
FOR Counter := 1 TO NamLen DO
|
||||||
|
ZOO_LongName := ZOO_LongName + GetByte(F,Aborted);
|
||||||
|
|
||||||
|
IF (DirLen > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO DirLen DO
|
||||||
|
ZOO_DirName := ZOO_DirName + GetByte(F,Aborted);
|
||||||
|
IF (ZOO_DirName[Length(ZOO_DirName)] <> '/') THEN
|
||||||
|
ZOO_DirName := ZOO_DirName + '/';
|
||||||
|
END;
|
||||||
|
IF (ZOO_LongName <> '') THEN
|
||||||
|
Out.FileName := ZOO_LongName
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Counter := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
Out.FileName[Counter] := ZOO.FName[Counter - 1];
|
||||||
|
UNTIL (ZOO.FName[Counter] = #0) OR (Counter = 13);
|
||||||
|
Out.FileName[0] := Chr(Counter);
|
||||||
|
Out.FileName := ZOO_DirName+Out.FileName;
|
||||||
|
END;
|
||||||
|
Out.Date := ZOO.Mod_Date;
|
||||||
|
Out.Time := ZOO.Mod_Time;
|
||||||
|
Out.CSize := ZOO.C_Size;
|
||||||
|
Out.USize := ZOO.U_Size;
|
||||||
|
Method := ZOO.Method;
|
||||||
|
CASE Method OF
|
||||||
|
0 : Out.Method := 2;
|
||||||
|
1 : Out.Method := 6;
|
||||||
|
ELSE
|
||||||
|
Out.Method := 1;
|
||||||
|
END;
|
||||||
|
IF NOT (ZOO.Deleted = 1) THEN
|
||||||
|
Details(Out,Level,NumFiles,TotalCompSize,TotalUnCompSize);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit;
|
||||||
|
Seek(F,ZOO.Next);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LZH_Proc(VAR F: FILE;
|
||||||
|
VAR Out: OutRec;
|
||||||
|
VAR Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
VAR TotalCompSize,
|
||||||
|
TotalUnCompSize: LongInt;
|
||||||
|
VAR Aborted: Boolean);
|
||||||
|
VAR
|
||||||
|
LZH: LZHRecordType;
|
||||||
|
C,
|
||||||
|
Method: Char;
|
||||||
|
Counter: Integer;
|
||||||
|
NumRead: Word;
|
||||||
|
BEGIN
|
||||||
|
WHILE (NOT Aborted) DO
|
||||||
|
BEGIN
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
IF (C = #0) THEN
|
||||||
|
Exit
|
||||||
|
ELSE
|
||||||
|
LZH.H_Length := Ord(C);
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
LZH.H_Cksum := Ord(C);
|
||||||
|
BlockRead(F,LZH.Method,5,NumRead);
|
||||||
|
IF (NumRead <> 5) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF ((LZH.Method[1] <> '-') OR (LZH.Method[2] <> 'l') OR (LZH.Method[3] <> 'h')) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
BlockRead(F,LZH.C_Size,15,NumRead);
|
||||||
|
IF (NumRead <> 15) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
FOR Counter := 1 TO LZH.F_Length DO
|
||||||
|
Out.FileName[Counter] := GetByte(F,Aborted);
|
||||||
|
Out.FileName[0] := Chr(LZH.F_Length);
|
||||||
|
IF ((LZH.H_Length - LZH.F_Length) = 22) THEN
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,LZH.CRC,2,NumRead);
|
||||||
|
IF (NumRead <> 2) THEN
|
||||||
|
BEGIN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Out.Date := LZH.Mod_Date;
|
||||||
|
Out.Time := LZH.Mod_Time;
|
||||||
|
Out.CSize := LZH.C_Size;
|
||||||
|
Out.USize := LZH.U_Size;
|
||||||
|
Method := LZH.Method[4];
|
||||||
|
CASE Method OF
|
||||||
|
'0' : Out.Method := 2;
|
||||||
|
'1' : Out.Method := 14;
|
||||||
|
ELSE
|
||||||
|
Out.Method := 1;
|
||||||
|
END;
|
||||||
|
Details(Out,Level,NumFiles,TotalCompSize,TotalUnCompSize);
|
||||||
|
Seek(F,(FilePos(F) + LZH.C_Size));
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ValidIntArcType(FileName: Str12): Boolean;
|
||||||
|
CONST
|
||||||
|
ArcTypes: ARRAY [1..7] OF Str3 = ('ZIP','ARC','PAK','ZOO','LZH','ARK','ARJ');
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
ValidIntArcType := FALSE;
|
||||||
|
FOR Counter := 1 TO 7 DO
|
||||||
|
IF (ArcTypes[Counter] = AllCaps(Copy(FileName,(Pos('.',FileName) + 1),3))) THEN
|
||||||
|
ValidIntArcType := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ViewInternalArchive(FileName: AStr);
|
||||||
|
VAR
|
||||||
|
LZH_Method: ARRAY [1..5] OF Char;
|
||||||
|
F: FILE;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
Out: OutRec;
|
||||||
|
C: Char;
|
||||||
|
LZH_H_Length,
|
||||||
|
Counter,
|
||||||
|
ArcType: Byte;
|
||||||
|
RCode,
|
||||||
|
FileType,
|
||||||
|
Level,
|
||||||
|
NumFiles: Integer;
|
||||||
|
NumRead: Word;
|
||||||
|
TotalUnCompSize,
|
||||||
|
TotalCompSize: LongInt;
|
||||||
|
Aborted: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FileName := SQOutSp(FileName);
|
||||||
|
|
||||||
|
IF (Pos('*',FileName) <> 0) OR (Pos('?',FileName) <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FindFirst(FileName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
|
||||||
|
IF (DOSError = 0) THEN
|
||||||
|
FileName := DirInfo.Name;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF ((Exist(FileName)) AND (NOT Abort) AND (NOT HangUp)) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
ArcType := 1;
|
||||||
|
WHILE (General.FileArcInfo[ArcType].Ext <> '') AND
|
||||||
|
(General.FileArcInfo[ArcType].Ext <> Copy(FileName,(Length(FileName) - 2),3)) AND
|
||||||
|
(ArcType < MaxArcs + 1) DO
|
||||||
|
Inc(ArcType);
|
||||||
|
|
||||||
|
IF NOT ((General.FileArcInfo[ArcType].Ext = '') OR (ArcType = 7)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (General.FileArcInfo[ArcType].ListLine[1] = '/') AND
|
||||||
|
(General.FileArcInfo[ArcType].ListLine[2] IN ['1'..'5']) AND
|
||||||
|
(Length(General.FileArcInfo[ArcType].ListLine) = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
Aborted := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NL;
|
||||||
|
PrintACR('^3'+StripName(FileName)+':');
|
||||||
|
NL;
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(F,FileName);
|
||||||
|
Reset(F,1);
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
CASE C OF
|
||||||
|
#$1a : FileType := 1;
|
||||||
|
'P' : BEGIN
|
||||||
|
IF (GetByte(F,Aborted) <> 'K') THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
FileType := 2;
|
||||||
|
END;
|
||||||
|
'Z' : BEGIN
|
||||||
|
FOR Counter := 0 TO 1 DO
|
||||||
|
IF (GetByte(F,Aborted) <> 'O') THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
FileType := 3;
|
||||||
|
END;
|
||||||
|
#96 : BEGIN
|
||||||
|
IF (GetByte(F,Aborted) <> #234) THEN
|
||||||
|
AbEnd(Aborted);
|
||||||
|
FileType := 5;
|
||||||
|
END;
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LZH_H_Length := Ord(C);
|
||||||
|
C := GetByte(F,Aborted);
|
||||||
|
FOR Counter := 1 TO 5 DO
|
||||||
|
LZH_Method[Counter] := GetByte(F,Aborted);
|
||||||
|
IF ((LZH_Method[1] = '-') AND (LZH_Method[2] = 'l') AND (LZH_Method[3] = 'h')) THEN
|
||||||
|
FileType := 4
|
||||||
|
ELSE
|
||||||
|
AbEnd(Aborted);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Reset(F,1);
|
||||||
|
Level := 0;
|
||||||
|
NumFiles := 0;
|
||||||
|
TotalCompSize := 0;
|
||||||
|
TotalUnCompSize := 0;
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
PrintACR('^3 Length Size Now % Method Date Time FileName');
|
||||||
|
PrintACR('^4------------- ------------- --- ---------- -------- ------ ------------');
|
||||||
|
CASE FileType OF
|
||||||
|
1 : ARC_Proc(F,Out,Level,NumFiles,TotalCompSize,TotalUnCompSize,Aborted);
|
||||||
|
2 : ZIP_Proc(F,Out,Level,NumFiles,TotalCompSize,TotalUnCompSize,Aborted);
|
||||||
|
3 : ZOO_Proc(F,Out,Level,NumFiles,TotalCompSize,TotalUnCompSize,Aborted);
|
||||||
|
4 : LZH_Proc(F,Out,Level,NumFiles,TotalCompSize,TotalUnCompSize,Aborted);
|
||||||
|
5 : ARJ_Proc(F,Out,Level,NumFiles,TotalCompSize,TotalUnCompSize,Aborted);
|
||||||
|
END;
|
||||||
|
Final(NumFiles,TotalCompSize,TotalUnCompSize);
|
||||||
|
Close(F);
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Prompt('^3Archive '+FileName+': ^4Please wait....');
|
||||||
|
ShellDOS(FALSE,FunctionalMCI(General.FileArcInfo[ArcType].ListLine,FileName,'')+' >shell.$$$',RCode);
|
||||||
|
BackErase(15);
|
||||||
|
PFL('SHELL.$$$');
|
||||||
|
Kill('SHELL.$$$');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ViewDirInternalArchive;
|
||||||
|
VAR
|
||||||
|
FileName: Str12;
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
Found,
|
||||||
|
LastArc,
|
||||||
|
LastGif: Boolean;
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
NL;
|
||||||
|
Print('^9Enter the name of the archive(s) you would like to view:');
|
||||||
|
}
|
||||||
|
lRGLngStr(25,FALSE);
|
||||||
|
FileName := '';
|
||||||
|
{ Print(FString.lGFNLine1); }
|
||||||
|
lRGLngStr(28,FALSE);
|
||||||
|
{ Prt(FString.GFNLine2); }
|
||||||
|
lRGLngStr(29,FALSE);
|
||||||
|
GetFileName(FileName);
|
||||||
|
LastArc := FALSE;
|
||||||
|
LastGif := FALSE;
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
Found := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
RecNo(FileInfo,FileName,DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF IsGIFExt(FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
LastArc := FALSE;
|
||||||
|
IF (NOT LastGif) THEN
|
||||||
|
BEGIN
|
||||||
|
LastGif := TRUE;
|
||||||
|
NL;
|
||||||
|
PrintACR('^3Filename.Ext^4:^3Resolution ^4:^3Num Colors^4:^3Signature');
|
||||||
|
PrintACR('^4============:===========:==========:===============');
|
||||||
|
END;
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR(GetGIFSpecs(MemFileArea.DLPath+SQOutSp(FileInfo.FileName),FileInfo.Description,1));
|
||||||
|
Found := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintACR(GetGIFSpecs(MemFileArea.ULPath+SQOutSp(FileInfo.FileName),FileInfo.Description,1));
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF ValidIntArcType(FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
LastGif := FALSE;
|
||||||
|
IF (NOT LastArc) THEN
|
||||||
|
LastArc := TRUE;
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
ViewInternalArchive(MemFileArea.DLPath+FileInfo.FileName);
|
||||||
|
Found := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
ViewInternalArchive(MemFileArea.ULPath+FileInfo.FileName);
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
NRecNo(FileInfo,DirFileRecNum);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('File not found.');
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,163 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT AutoMsg;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ReadAutoMsg;
|
||||||
|
PROCEDURE WriteAutoMsg;
|
||||||
|
PROCEDURE ReplyAutoMsg;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
Email,
|
||||||
|
Mail0,
|
||||||
|
Mail1;
|
||||||
|
|
||||||
|
PROCEDURE ReadAutoMsg;
|
||||||
|
VAR
|
||||||
|
AutoMsgFile: Text;
|
||||||
|
TempStr: AStr;
|
||||||
|
Counter,
|
||||||
|
LenTempStr: Byte;
|
||||||
|
BEGIN
|
||||||
|
Assign(AutoMsgFile,General.MiscPath+'AUTO.ASC');
|
||||||
|
Reset(AutoMsgFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('%LFNo auto-message available.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
ReadLn(AutoMsgFile,TempStr);
|
||||||
|
CASE TempStr[1] OF
|
||||||
|
'@' : IF (AACS(General.AnonPubRead)) THEN
|
||||||
|
TempStr := Copy(TempStr,2,Length(TempStr))+' (Posted Anonymously)'
|
||||||
|
ELSE
|
||||||
|
TempStr := 'Anonymous';
|
||||||
|
'!' : IF (CoSysOp) THEN
|
||||||
|
TempStr := Copy(TempStr,2,Length(TempStr))+' (Posted Anonymously)'
|
||||||
|
ELSE
|
||||||
|
TempStr := 'Anonymous';
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print(lRGLngStr(10,TRUE){FString.AutoMsgT}+TempStr);
|
||||||
|
LenTempStr := 0;
|
||||||
|
REPEAT
|
||||||
|
ReadLn(AutoMsgFile,TempStr);
|
||||||
|
IF (LennMCI(TempStr) > LenTempStr) THEN
|
||||||
|
LenTempStr := LennMCI(TempStr);
|
||||||
|
UNTIL (EOF(AutoMsgFile));
|
||||||
|
IF (LenTempStr >= ThisUser.LineLen) THEN
|
||||||
|
LenTempStr := (ThisUser.LineLen - 1);
|
||||||
|
Reset(AutoMsgFile);
|
||||||
|
ReadLn(AutoMsgFile,TempStr);
|
||||||
|
TempStr := lRGLngStr(11,TRUE);
|
||||||
|
UserColor(0);
|
||||||
|
IF ((NOT OkANSI) AND (NOT OkAvatar) AND (Ord(TempStr[1]{FString.AutoM}) > 128) OR (TempStr[1]{FString.AutoM} = #32)) THEN
|
||||||
|
NL
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO LenTempStr DO
|
||||||
|
OutKey(TempStr[1]{FString.AutoM});
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
ReadLn(AutoMsgFile,TempStr);
|
||||||
|
PrintACR('^3'+TempStr);
|
||||||
|
UNTIL EOF(AutoMsgFile) OR (Abort) OR (HangUp);
|
||||||
|
Close(AutoMsgFile);
|
||||||
|
TempStr := lRGLngStr(11,TRUE);
|
||||||
|
UserColor(0);
|
||||||
|
IF ((NOT OkANSI) AND (NOT OkAvatar) AND (Ord(TempStr[1]{FString.AutoM}) > 128) OR (TempStr[1]{FString.AutoM} = #32)) THEN
|
||||||
|
NL
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO LenTempStr DO
|
||||||
|
OutKey(TempStr[1]{FString.AutoM});
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE WriteAutoMsg;
|
||||||
|
VAR
|
||||||
|
AutoMsgFile1,
|
||||||
|
AutoMsgFile2: Text;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
TempStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (RAMsg IN ThisUser.Flags) THEN
|
||||||
|
Print('%LFYou are restricted from writing auto-messages.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InResponseTo := '';
|
||||||
|
MHeader.Status := [];
|
||||||
|
IF (InputMessage(TRUE,FALSE,'Auto-Message',MHeader,General.MiscPath+'AUTO'+IntToStr(ThisNode)+'.TMP',78,500)) THEN
|
||||||
|
IF Exist(General.MiscPath+'AUTO'+IntToStr(ThisNode)+'.TMP') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(AutoMsgFile1,General.MiscPath+'AUTO.ASC');
|
||||||
|
ReWrite(AutoMsgFile1);
|
||||||
|
Assign(AutoMsgFile2,General.MiscPath+'AUTO'+IntToStr(ThisNode)+'.TMP');
|
||||||
|
Reset(AutoMsgFile2);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Exit;
|
||||||
|
IF (AACS(General.AnonPubPost)) AND PYNQ('Post Anonymously? ',0,FALSE) THEN
|
||||||
|
IF (CoSysOp) THEN
|
||||||
|
WriteLn(AutoMsgFile1,'!'+Caps(ThisUser.Name))
|
||||||
|
ELSE
|
||||||
|
WriteLn(AutoMsgFile1,'@'+Caps(ThisUser.Name))
|
||||||
|
ELSE
|
||||||
|
WriteLn(AutoMsgFile1,Caps(ThisUser.Name));
|
||||||
|
WHILE (NOT EOF(AutoMsgFile2)) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(AutoMsgFile2,TempStr);
|
||||||
|
WriteLn(AutoMsgFile1,TempStr);
|
||||||
|
END;
|
||||||
|
Close(AutoMsgFile1);
|
||||||
|
Close(AutoMsgFile2);
|
||||||
|
Kill(General.MiscPath+'AUTO'+IntToStr(ThisNode)+'.TMP');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReplyAutoMsg;
|
||||||
|
VAR
|
||||||
|
AutoMsgFile: Text;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
TempStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
Assign(AutoMsgFile,General.MiscPath+'AUTO.ASC');
|
||||||
|
Reset(AutoMsgFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('%LFNo auto-message to reply to.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
ReadLn(AutoMsgFile,TempStr);
|
||||||
|
Close(AutoMsgFile);
|
||||||
|
IF (TempStr[1] IN ['!','@']) THEN
|
||||||
|
BEGIN
|
||||||
|
LastAuthor := SearchUser(Copy(TempStr,2,Length(TempStr)),CoSysOp);
|
||||||
|
IF (NOT AACS(General.AnonPrivRead)) THEN
|
||||||
|
LastAuthor := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
LastAuthor := SearchUser(TempStr,CoSysOp);
|
||||||
|
IF (LastAuthor = 0) THEN
|
||||||
|
Print('%LFUnable to reply to an anonymous message!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InResponseTo := 'Your auto-message';
|
||||||
|
MHeader.Status := [];
|
||||||
|
AutoReply(MHeader);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,779 @@
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
|
||||||
|
UNIT BBSList;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE BBSList_Add;
|
||||||
|
PROCEDURE BBSList_Delete;
|
||||||
|
PROCEDURE BBSList_Edit;
|
||||||
|
PROCEDURE BBSList_View;
|
||||||
|
PROCEDURE BBSList_xView;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
FUNCTION BBSListMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
|
||||||
|
VAR
|
||||||
|
BBSListPtr: ^BBSListRecordType;
|
||||||
|
User: UserRecordType;
|
||||||
|
TmpStr : String;
|
||||||
|
BEGIN
|
||||||
|
BBSListPtr := Data1;
|
||||||
|
BBSListMCI := S;
|
||||||
|
CASE S[1] OF
|
||||||
|
'X' : CASE S[2] OF
|
||||||
|
'A' : BBSListMCI := BBSListPtr^.SDA;
|
||||||
|
'B' : BBSListMCI := BBSListPtr^.SDB;
|
||||||
|
'C' : BBSListMCI := BBSListPtr^.SDC;
|
||||||
|
'D' : BBSListMCI := BBSListPtr^.SDD;
|
||||||
|
'E' : BBSListMCI := BBSListPtr^.SDE;
|
||||||
|
'F' : BBSListMCI := BBSListPtr^.SDF;
|
||||||
|
END;
|
||||||
|
'A' : CASE S[2] OF
|
||||||
|
'C' :
|
||||||
|
Begin
|
||||||
|
If (Length(BBSListPtr^.PhoneNumber) > 0) Then
|
||||||
|
Begin
|
||||||
|
TmpStr := BBSListPtr^.PhoneNumber;
|
||||||
|
Delete(TmpStr,4,Length(TmpStr));
|
||||||
|
BBSListMCI := TmpStr;
|
||||||
|
End
|
||||||
|
Else
|
||||||
|
Begin
|
||||||
|
BBSListMCI := 'N/A';
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
END;
|
||||||
|
'B' : CASE S[2] OF
|
||||||
|
'N' : BBSListMCI := BBSListPtr^.BBSName;
|
||||||
|
'P' : BBSListMCI := IntToStr(BBSListPtr^.Port);
|
||||||
|
END;
|
||||||
|
'D' : CASE S[2] OF
|
||||||
|
'A' : BBSListMCI := Pd2Date(BBSListPtr^.DateAdded);
|
||||||
|
'E' : BBSListMCI := Pd2Date(BBSListPtr^.DateEdited);
|
||||||
|
'S' : BBSListMCI := BBSListPtr^.Description;
|
||||||
|
'2' : BBSListMCI := BBSListPtr^.Description2
|
||||||
|
END;
|
||||||
|
'L' : CASE S[2] OF
|
||||||
|
'O' : BBSListMCI := BBSListPtr^.Location;
|
||||||
|
END;
|
||||||
|
'H' : CASE S[2] OF
|
||||||
|
'R' : BBSListMCI := BBSListPtr^.Hours;
|
||||||
|
END;
|
||||||
|
'M' : CASE S[2] OF
|
||||||
|
'N' : BBSListMCI := IntToStr(BBSListPtr^.MaxNodes);
|
||||||
|
END;
|
||||||
|
'O' : CASE S[2] OF
|
||||||
|
'S' : Begin
|
||||||
|
If (Length(BBSListPtr^.OS) > 0) Then
|
||||||
|
BBSListMCI := BBSListPtr^.OS
|
||||||
|
Else
|
||||||
|
BBSListMCI := 'Unknown';
|
||||||
|
End;
|
||||||
|
END;
|
||||||
|
'P' : CASE S[2] OF
|
||||||
|
'N' : Begin
|
||||||
|
If (Length(BBSListPtr^.PhoneNumber) > 0) Then
|
||||||
|
BBSListMCI := BBSListPtr^.PhoneNumber
|
||||||
|
Else
|
||||||
|
BBSListMCI := 'None';
|
||||||
|
End;
|
||||||
|
END;
|
||||||
|
'R' : CASE S[2] OF
|
||||||
|
'N' : BBSListMCI := IntToStr(BBSListPtr^.RecordNum);
|
||||||
|
END;
|
||||||
|
'S' : CASE S[2] OF
|
||||||
|
'A' : BBSListMCI := BBSListPtr^.SDA;
|
||||||
|
'B' : BBSListMCI := BBSListPtr^.SDB;
|
||||||
|
'C' : BBSListMCI := BBSListPtr^.SDC;
|
||||||
|
'D' : BBSListMCI := BBSListPtr^.SDD;
|
||||||
|
'E' : BBSListMCI := BBSListPtr^.SDE;
|
||||||
|
'F' : BBSListMCI := BBSListPtr^.SDF;
|
||||||
|
'G' : BBSListMCI := IntToStr(BBSListPtr^.SDG);
|
||||||
|
'H' : BBSListMCI := ShowYesNo(BBSListPtr^.SDH);
|
||||||
|
'I' : BBSListMCI := ShowYesNo(BBSListPtr^.SDI);
|
||||||
|
'N' : BBSListMCI := BBSListPtr^.SysOpName;
|
||||||
|
'P' : BBSListMCI := BBSListPtr^.Speed;
|
||||||
|
'T' : Begin
|
||||||
|
IF (Length(BBSListPtr^.Birth) > 0) THEN
|
||||||
|
BBSListMCI := BBSListPtr^.Birth
|
||||||
|
ELSE
|
||||||
|
BBSListMCI := 'Unknown';
|
||||||
|
End;
|
||||||
|
'V' : Begin
|
||||||
|
If (Length(BBSListPtr^.SoftwareVersion) > 0) Then
|
||||||
|
Begin
|
||||||
|
BBSListMCI := BBSListPtr^.SoftwareVersion;
|
||||||
|
End
|
||||||
|
Else
|
||||||
|
Begin
|
||||||
|
BBSListMCI := 'Unknown';
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
'W' : BBSListMCI := BBSListPtr^.Software;
|
||||||
|
END;
|
||||||
|
'T' : CASE S[2] OF
|
||||||
|
'N' : BBSListMCI := BBSListPtr^.TelnetUrl;
|
||||||
|
END;
|
||||||
|
'U' : CASE S[2] OF
|
||||||
|
'N' : BEGIN
|
||||||
|
LoadURec(User,BBSListPtr^.UserID);
|
||||||
|
BBSListMCI := User.Name;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'W' : CASE S[2] OF
|
||||||
|
'S' : BBSListMCI := BBSListPtr^.WebSiteUrl;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSListScriptFile(VAR BBSList: BBSListRecordType);
|
||||||
|
VAR
|
||||||
|
BBSScriptText: TEXT;
|
||||||
|
Question: STRING;
|
||||||
|
WhichOne: String;
|
||||||
|
TmpBirth: String[10];
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSScriptText,General.MiscPath+'BBSLIST.SCR');
|
||||||
|
Reset(BBSScriptText);
|
||||||
|
WHILE NOT EOF(BBSScriptText) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(BBSScriptText,Question);
|
||||||
|
IF (Question[1] = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
WhichOne := AllCaps(Copy(Question, Pos('[',Question)+1, Pos(']',Question)-2));
|
||||||
|
Question := Copy(Question,(Pos(':',Question) + 1),Length(Question));
|
||||||
|
|
||||||
|
IF (WhichOne = 'BBSNAME') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
PRT(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.BBSName) - 1);
|
||||||
|
InputMain(BBSList.BBSName,(SizeOf(BBSList.BBSName) - 1),[InterActiveEdit,ColorsAllowed]);
|
||||||
|
Abort := (BBSList.BBSName = '');
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SYSOPNAME' THEN
|
||||||
|
BEGIN
|
||||||
|
PRT(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.SysOpName) - 1);
|
||||||
|
InputMain(BBSList.SysOpName,(SizeOf(BBSList.SysOpName) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
Abort := (BBSList.SysOpName = '');
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'TELNETURL' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.TelnetUrl) - 1);
|
||||||
|
InputMain(BBSList.TelnetUrl,(SizeOf(BBSList.TelnetUrl) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
Abort := (BBSList.TelnetUrl = '');
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'WEBSITEURL' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.WebSiteUrl) - 1);
|
||||||
|
InputMain(BBSList.WebSiteUrl,(SizeOf(BBSList.WebSiteUrl) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.WebSiteUrl = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'PHONENUMBER' THEN
|
||||||
|
BEGIN
|
||||||
|
PRT(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.PhoneNumber) - 1);
|
||||||
|
InputMain(BBSList.PhoneNumber,(SizeOf(BBSList.PhoneNumber) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.PhoneNumber = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SOFTWARE' THEN
|
||||||
|
BEGIN
|
||||||
|
PRT(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.Software) - 1);
|
||||||
|
InputMain(BBSList.Software,(SizeOf(BBSList.Software) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.Software = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SOFTWAREVERSION' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.SoftwareVersion) - 1);
|
||||||
|
InputMain(BBSList.SoftwareVersion,(SizeOf(BBSList.SoftwareVersion) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'OS' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.OS) - 1);
|
||||||
|
InputMain(BBSList.OS,(SizeOf(BBSList.OS) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SPEED' THEN
|
||||||
|
BEGIN
|
||||||
|
PRT(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.Speed) - 1);
|
||||||
|
InputMain(BBSList.Speed,(SizeOf(BBSList.Speed) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.Speed = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'HOURS' THEN
|
||||||
|
BEGIN
|
||||||
|
PRT(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.Hours) - 1);
|
||||||
|
InputMain(BBSList.Hours,(SizeOf(BBSList.Hours) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.Speed = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'DESCRIPTION' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question);
|
||||||
|
MPL(SizeOf(BBSList.Description) - 1);
|
||||||
|
InputMain(BBSList.Description,(SizeOf(BBSList.Description) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.Description = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'DESCRIPTION2' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question);
|
||||||
|
MPL(SizeOf(BBSList.Description2) - 1);
|
||||||
|
InputMain(BBSList.Description2,(SizeOf(BBSList.Description2) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.Description2 = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'MAXNODES' THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
MPL(SizeOf(BBSList.MaxNodes) - 1);
|
||||||
|
IF (BBSList.MaxNodes = 0) THEN
|
||||||
|
BBSList.MaxNodes := 5;
|
||||||
|
InputLongIntWoc(Question,BBSList.MaxNodes,[NumbersOnly,InteractiveEdit],1,1000);
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'PORT' THEN
|
||||||
|
BEGIN
|
||||||
|
IF (BBSList.Port = 0) THEN
|
||||||
|
BBSList.Port := 23;
|
||||||
|
MPL(SizeOf(BBSList.Port) - 1);
|
||||||
|
|
||||||
|
InputLongIntWoc(Question,BBSList.Port,[NumbersOnly,InterActiveEdit],1,65535);
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'LOCATION' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.Location) - 1);
|
||||||
|
InputMain(BBSList.Location,(SizeOf(BBSList.Location) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'BIRTH' THEN
|
||||||
|
BEGIN
|
||||||
|
TmpBirth := BBSList.Birth;
|
||||||
|
IF (Length(TmpBirth) < 10) THEN
|
||||||
|
TmpBirth := '12/31/1969';
|
||||||
|
MPL(10);
|
||||||
|
InputFormatted(Question+' |08(|07'+TmpBirth+'|08) |15: ',BBSList.Birth,'##/##/####',TRUE);
|
||||||
|
IF (Length(BBSList.Birth) <= 0) THEN
|
||||||
|
BBSList.Birth := TmpBirth;
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDA' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.SDA) - 1);
|
||||||
|
InputMain(BBSList.SDA,(SizeOf(BBSList.SDA) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.xA = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDB' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.SDB) - 1);
|
||||||
|
InputMain(BBSList.SDB,(SizeOf(BBSList.SDB) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.xB = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDC' THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.SDC) - 1);
|
||||||
|
InputMain(BBSList.SDC,(SizeOf(BBSList.SDC) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{ Abort := (BBSList.xC = ''); }
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDD' THEN BEGIN
|
||||||
|
Prt(Question+' ');
|
||||||
|
MPL(SizeOf(BBSList.SDD) - 1);
|
||||||
|
InputMain(BBSList.SDD,(SizeOf(BBSList.SDD) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{ Abort := (BBSList.xD = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDE' THEN
|
||||||
|
BEGIN
|
||||||
|
Print(Question);
|
||||||
|
MPL(SizeOf(BBSList.SDE) - 1);
|
||||||
|
InputMain(BBSList.SDE,(SizeOf(BBSList.SDE) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.xE = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDF' THEN
|
||||||
|
BEGIN
|
||||||
|
Print(Question);
|
||||||
|
MPL(SizeOf(BBSList.SDF) - 1);
|
||||||
|
InputMain(BBSList.SDF,(SizeOf(BBSList.SDF) - 1),[ColorsAllowed,InterActiveEdit]);
|
||||||
|
{Abort := (BBSList.xF = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDG' THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
MPL(SizeOf(BBSList.SDG) - 1);
|
||||||
|
InputLongIntWoc(Question,BBSList.SDG,[NumbersOnly,InterActiveEdit],1,65535);
|
||||||
|
{Abort := (BBSList.xE = '');}
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDH' THEN
|
||||||
|
BEGIN
|
||||||
|
BBSList.SDH := PYNQ(Question+' ',0,TRUE);
|
||||||
|
END
|
||||||
|
ELSE IF WhichOne = 'SDI' THEN
|
||||||
|
BEGIN
|
||||||
|
BBSList.SDI := PYNQ(Question+' ',6,FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(BBSScriptText);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BBSList_Exists: Boolean;
|
||||||
|
VAR
|
||||||
|
BBSListFile: FILE OF BBSListRecordType;
|
||||||
|
FSize: Longint;
|
||||||
|
FExist: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FSize := 0;
|
||||||
|
FExist := Exist(General.DataPath+'BBSLIST.DAT');
|
||||||
|
IF (FExist) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
FSize := FileSize(BBSListFile);
|
||||||
|
Close(BBSListFile);
|
||||||
|
END;
|
||||||
|
IF (NOT FExist) OR (FSize = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('There are currently no entries in the BBS List.');
|
||||||
|
SysOpLog('The BBSLIST.DAT file is missing.');
|
||||||
|
END;
|
||||||
|
BBSList_Exists := (FExist) AND (FSize <> 0);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayError(FName: ASTR; VAR FExists: Boolean);
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
PrintACR('|12ú |09The '+FName+'.* File is missing.');
|
||||||
|
PrintACR('|12ú |09Please, inform the Sysop!');
|
||||||
|
SysOpLog('The '+FName+'.* file is missing.');
|
||||||
|
FExists := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BBSListScript_Exists: Boolean;
|
||||||
|
VAR
|
||||||
|
FExists: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FExists := Exist(General.MiscPath+'BBSLIST.SCR');
|
||||||
|
IF (NOT FExists) THEN
|
||||||
|
DisplayError('BBSLIST.SCR',FExists);
|
||||||
|
BBSListScript_Exists := FExists;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BBSListAddScreens_Exists: Boolean;
|
||||||
|
VAR
|
||||||
|
FExistsH,
|
||||||
|
FExistsN,
|
||||||
|
FExistsT: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FExistsH := TRUE;
|
||||||
|
FExistsN := TRUE;
|
||||||
|
FExistsT := TRUE;
|
||||||
|
IF (NOT ReadBuffer('BBSNH')) THEN
|
||||||
|
DisplayError('BBSNH',FExistsH);
|
||||||
|
IF (NOT ReadBuffer('BBSMN')) THEN
|
||||||
|
DisplayError('BBSMN',FExistsN);
|
||||||
|
IF (NOT ReadBuffer('BBSNT')) THEN
|
||||||
|
DisplayError('BBSNT',FExistsT);
|
||||||
|
BBSListAddScreens_Exists := (FExistsH) AND (FExistsN) AND (FExistsT);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BBSListEditScreens_Exists: Boolean;
|
||||||
|
VAR
|
||||||
|
FExistsT,
|
||||||
|
FExistsM: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FExistsT := TRUE;
|
||||||
|
FExistsM := TRUE;
|
||||||
|
IF (NOT ReadBuffer('BBSLET')) THEN
|
||||||
|
DisplayError('BBSLET',FExistsT);
|
||||||
|
IF (NOT ReadBuffer('BBSLEM')) THEN
|
||||||
|
DisplayError('BBSLEM',FExistsM);
|
||||||
|
BBSListEditScreens_Exists := (FExistsT) AND (FExistsM);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_Renumber;
|
||||||
|
VAR
|
||||||
|
BBSListFile: FILE OF BBSListRecordType;
|
||||||
|
BBSList: BBSListRecordType;
|
||||||
|
OnRec: Longint;
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
Abort := FALSE;
|
||||||
|
OnRec := 1;
|
||||||
|
WHILE (OnRec <= FileSize(BBSListFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(OnRec - 1));
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
BBSList.RecordNum := OnRec;
|
||||||
|
Seek(BBSListFile,(OnRec - 1));
|
||||||
|
Write(BBSListFile,BBSList);
|
||||||
|
Inc(OnRec);
|
||||||
|
END;
|
||||||
|
Close(BBSListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_Sort;
|
||||||
|
VAR
|
||||||
|
BBSListFile: FILE OF BBSListRecordType;
|
||||||
|
BBSList1,
|
||||||
|
BBSList2: BBSListRecordType;
|
||||||
|
S,
|
||||||
|
I,
|
||||||
|
J,
|
||||||
|
pl,
|
||||||
|
Gap: INTEGER;
|
||||||
|
BEGIN
|
||||||
|
IF (BBSList_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
pl := FileSize(BBSListFile);
|
||||||
|
Gap := pl;
|
||||||
|
REPEAT;
|
||||||
|
Gap := (Gap DIV 2);
|
||||||
|
IF (Gap = 0) THEN
|
||||||
|
Gap := 1;
|
||||||
|
s := 0;
|
||||||
|
FOR I := 1 TO (pl - Gap) DO
|
||||||
|
BEGIN
|
||||||
|
J := (I + Gap);
|
||||||
|
Seek(BBSListFile,(i - 1));
|
||||||
|
Read(BBSListFile,BBSList1);
|
||||||
|
Seek(BBSListFile,(j - 1));
|
||||||
|
Read(BBSListFile,BBSList2);
|
||||||
|
IF (BBSList1.BBSName > BBSList2.BBSName) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(i - 1));
|
||||||
|
Write(BBSListFile,BBSList2);
|
||||||
|
Seek(BBSListFile,(j - 1));
|
||||||
|
Write(BBSListFile,BBSList1);
|
||||||
|
Inc(s);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (s = 0) AND (Gap = 1);
|
||||||
|
Close(BBSListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (PL > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Sorted '+IntToStr(pl)+' BBS List entries.');
|
||||||
|
SysOpLog('Sorted the BBS Listing');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_Add;
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
BBSList: BBSListRecordType;
|
||||||
|
BEGIN
|
||||||
|
IF (BBSListScript_Exists) AND (BBSListAddScreens_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ(' Add an entry to the BBS list? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
FillChar(BBSList,SizeOf(BBSList),0);
|
||||||
|
BBSListScriptFile(BBSList);
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('BBSNH');
|
||||||
|
ReadBuffer('BBSMN');
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
PrintF('BBSNT');
|
||||||
|
NL;
|
||||||
|
IF (PYNQ(' Save '+BBSList.BBSName+'? ',0,TRUE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
IF (Exist(General.DataPath+'BBSLIST.DAT')) THEN
|
||||||
|
Reset(BBSListFile)
|
||||||
|
ELSE
|
||||||
|
Rewrite(BBSListFile);
|
||||||
|
Seek(BBSListFile,FileSize(BBSListFile));
|
||||||
|
BBSList.UserID := UserNum;
|
||||||
|
BBSList.DateAdded := GetPackDateTime;
|
||||||
|
BBSList.DateEdited := BBSList.DateAdded;
|
||||||
|
BBSList.RecordNum := (FileSize(BBSListFile) + 1);
|
||||||
|
Write(BBSListFile,BBSList);
|
||||||
|
Close(BBSListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
BBSList_Sort;
|
||||||
|
BBSList_Renumber;
|
||||||
|
SysOpLog('Added BBS Listing: '+BBSList.BBSName+'.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_Delete;
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
BBSList: BBSListRecordType;
|
||||||
|
OnRec,
|
||||||
|
RecNum: Longint;
|
||||||
|
Found: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (BBSList_Exists) AND (BBSListEditScreens_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
Found := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
OnRec := 1;
|
||||||
|
WHILE (OnRec <= FileSize(BBSListFile)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(OnRec - 1));
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
IF (BBSList.UserID = UserNum) OR (CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('BBSLDT');
|
||||||
|
ReadBuffer('BBSLEM');
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
NL;
|
||||||
|
IF (PYNQ(' Delete '+BBSLIST.BBSName+'? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Deleted BBS Listing: '+BBSList.BBSName+'.');
|
||||||
|
IF ((OnRec - 1) <= (FileSize(BBSListFile) - 2)) THEN
|
||||||
|
FOR RecNum := (OnRec - 1) TO (FileSize(BBSListFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(RecNum + 1));
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
Seek(BBSListFile,RecNum);
|
||||||
|
Write(BBSListFile,BBSList);
|
||||||
|
END;
|
||||||
|
Seek(BBSListFile,(FileSize(BBSListFile) - 1));
|
||||||
|
Truncate(BBSListFile);
|
||||||
|
Dec(OnRec);
|
||||||
|
END;
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
Inc(OnRec);
|
||||||
|
END;
|
||||||
|
Close(BBSListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
BBSList_ReNumber;
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print(' You may only delete BBS Listing''s that you have entered.');
|
||||||
|
SysOpLog('Tried to delete a BBS Listing.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_Edit;
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
BBSList: BBSListRecordType;
|
||||||
|
OnRec: Longint;
|
||||||
|
Found: Boolean;
|
||||||
|
Edit : LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (BBSList_Exists) AND (BBSListEditScreens_Exists) AND (BBSListAddScreens_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
Found := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
OnRec := 1;
|
||||||
|
WHILE (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
PrintF('BBSLEDT');
|
||||||
|
ReadBuffer('BBSLEM');
|
||||||
|
While OnRec <= FileSize(BBSListFile) Do
|
||||||
|
Begin
|
||||||
|
Seek(BBSListFile, OnRec -1);
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
Inc(OnRec);
|
||||||
|
End;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
MPL(FileSize(BBSListFile));
|
||||||
|
InputLongIntWOC(' Edit which BBS? :',Edit,[],1,FileSize(BBSListFile));
|
||||||
|
|
||||||
|
Abort := (Edit <> 0 );
|
||||||
|
|
||||||
|
IF (Edit <= FileSize(BBSListFile)) AND (Edit > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(Edit -1))
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Close(BBSListFile);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
IF (BBSList.UserID = UserNum) OR (CoSysOp) OR (BBSList.SysopName = ThisUser.Name) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('BBSLEH');
|
||||||
|
ReadBuffer('BBSLEM');
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
NL;
|
||||||
|
IF (PYNQ(' Would you like to edit this BBS Listing? ',0,TRUE)) THEN
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
BBSListScriptFile(BBSList);
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('BBSNH');
|
||||||
|
ReadBuffer('BBSMN');
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
PrintF('BBSNT');
|
||||||
|
NL;
|
||||||
|
IF (PYNQ(' Would you like to save this BBS Listing? ',0,TRUE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(Edit -1));
|
||||||
|
BBSList.DateEdited := GetPackDateTime;
|
||||||
|
Write(BBSListFile,BBSList);
|
||||||
|
SysOpLog('Edited BBS Listing: '+BBSList.BBSName+'.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
{Inc(OnRec);}
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Close(BBSListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print(' You may only edit BBS Listing''s that you have entered.');
|
||||||
|
SysOpLog('Tried to edit a BBS Listing.');
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('There was an error displaying an ASCII file. Let the sysop know so they can investigate.');
|
||||||
|
SysOpLog('Some ASCII Files are missing for editing the bbslist. Investigate ...');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_View;
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
BBSList: BBSListRecordType;
|
||||||
|
OnRec: Longint;
|
||||||
|
Cnt : Byte;
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (BBSList_Exists) AND (BBSListAddScreens_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
ReadBuffer('BBSMN');
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
Abort := FALSE;
|
||||||
|
PrintF('BBSNH');
|
||||||
|
OnRec := 1;
|
||||||
|
Cnt := 1;
|
||||||
|
WHILE (OnRec <= FileSize(BBSListFile)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(OnRec - 1));
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
Inc(OnRec);
|
||||||
|
Inc(Cnt);
|
||||||
|
If Cnt = (23 - 4) Then
|
||||||
|
Begin
|
||||||
|
PauseScr(True);
|
||||||
|
Cnt := 1;
|
||||||
|
End
|
||||||
|
Else
|
||||||
|
Begin
|
||||||
|
Cnt := Cnt;
|
||||||
|
End;
|
||||||
|
END;
|
||||||
|
Close(BBSListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
PrintF('BBSNT');
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
SysOpLog('Viewed the BBS Listing.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BBSList_xView; (* Do we need xview *) {Yes -sk}
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
BBSList: BBSListRecordType;
|
||||||
|
OnRec: Longint;
|
||||||
|
Edit : Longint;
|
||||||
|
BEGIN
|
||||||
|
IF (BBSList_Exists) THEN (* Add BBSME & BBSEH exist checking here *)
|
||||||
|
BEGIN
|
||||||
|
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
|
||||||
|
Reset(BBSListFile);
|
||||||
|
|
||||||
|
PrintF('BBSLEH');
|
||||||
|
ReadBuffer('BBSLEM');
|
||||||
|
OnRec := 1;
|
||||||
|
While OnRec <= FileSize(BBSListFile) Do
|
||||||
|
Begin
|
||||||
|
Seek(BBSListFile, OnRec -1);
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
Inc(OnRec);
|
||||||
|
End;
|
||||||
|
PrintF('BBSLET');
|
||||||
|
NL;
|
||||||
|
MPL(FileSize(BBSListFile));
|
||||||
|
InputLongIntWOC(' View which BBS? ',Edit,[],1,FileSize(BBSListFile));
|
||||||
|
|
||||||
|
Abort := (Edit <> 0 );
|
||||||
|
|
||||||
|
IF (Edit <= FileSize(BBSListFile)) AND (Edit > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(BBSListFile,(Edit -1));
|
||||||
|
Read(BBSListFile,BBSList);
|
||||||
|
Close(BBSListFile);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Close(BBSListFile);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ReadBuffer('BBSME')) THEN
|
||||||
|
BEGIN
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
Abort := FALSE;
|
||||||
|
PrintF('BBSEH');
|
||||||
|
WHILE (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
DisplayBuffer(BBSListMCI,@BBSList,Data2);
|
||||||
|
PrintF('BBSET');
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
{PauseScr(FALSE);}
|
||||||
|
SysOpLog('Viewed Extended BBS Listing of '+BBSList.BBSName+'.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
|
||||||
|
END;
|
||||||
|
{Close(BBSListFile);}
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,592 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
UNIT Bulletin;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION FindOnlyOnce: Boolean;
|
||||||
|
FUNCTION NewBulletins: Boolean;
|
||||||
|
PROCEDURE Bulletins(MenuOption: Str50);
|
||||||
|
PROCEDURE UList(MenuOption: Str50);
|
||||||
|
PROCEDURE TodaysCallers(x: Byte; MenuOptions: Str50);
|
||||||
|
PROCEDURE RGQuote(MenuOption: Str50);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common5,
|
||||||
|
Mail1,
|
||||||
|
ShortMsg,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
LastCallerPtrType = ^LastCallerRec;
|
||||||
|
UserPtrType = ^UserRecordType;
|
||||||
|
|
||||||
|
PROCEDURE Bulletins(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Main,
|
||||||
|
Subs,
|
||||||
|
InputStr: ASTR;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (MenuOption = '') THEN
|
||||||
|
IF (General.BulletPrefix = '') THEN
|
||||||
|
MenuOption := 'BULLETIN;BULLET'
|
||||||
|
ELSE
|
||||||
|
MenuOption := 'BULLETIN;'+General.BulletPrefix;
|
||||||
|
IF (Pos(';',MenuOption) <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Main := Copy(MenuOption,1,(Pos(';',MenuOption) - 1));
|
||||||
|
Subs := Copy(MenuOption,(Pos(';',MenuOption) + 1),(Length(MenuOption) - Pos(';',MenuOption)));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Main := MenuOption;
|
||||||
|
Subs := MenuOption;
|
||||||
|
END;
|
||||||
|
PrintF(Main);
|
||||||
|
IF (NOT NoFile) THEN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
{ Prt(FString.BulletinLine); }
|
||||||
|
lRGLngStr(16,FALSE);
|
||||||
|
ScanInput(InputStr,'ABCDEFGHIJKLMNOPQRSTUVWXYZ?');
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
PrintF(Main);
|
||||||
|
IF (InputStr <> '') AND NOT (InputStr[1] IN ['Q','?']) THEN
|
||||||
|
PrintF(Subs+InputStr);
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION FindOnlyOnce: Boolean;
|
||||||
|
VAR
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
DT: DateTime;
|
||||||
|
BEGIN
|
||||||
|
FindOnlyOnce := FALSE;
|
||||||
|
FindFirst(General.MiscPath+'ONLYONCE.*',AnyFile - Directory - VolumeID- DOS.Hidden,DirInfo);
|
||||||
|
IF (DosError = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
UnPackTime(DirInfo.Time,DT);
|
||||||
|
IF (DateToPack(DT) > ThisUser.LastOn) THEN
|
||||||
|
FindOnlyOnce := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION NewBulletins: Boolean;
|
||||||
|
TYPE
|
||||||
|
BulletinType = ARRAY [0..255] OF Byte;
|
||||||
|
VAR
|
||||||
|
BulletinArray: ^BulletinType;
|
||||||
|
DT: DateTime;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
BullCount,
|
||||||
|
Biggest,
|
||||||
|
LenOfBullPrefix,
|
||||||
|
LenToCopy: Byte;
|
||||||
|
Found: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ShowBulls;
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
Counter1,
|
||||||
|
Counter2: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 0 TO BullCount DO
|
||||||
|
BEGIN
|
||||||
|
FOR Counter1 := 0 TO BullCount DO
|
||||||
|
IF (BulletinArray^[Counter] < BulletinArray^[Counter1]) THEN
|
||||||
|
BEGIN
|
||||||
|
Counter2 := BulletinArray^[Counter];
|
||||||
|
BulletinArray^[Counter] := BulletinArray^[Counter1];
|
||||||
|
BulletinArray^[Counter1] := Counter2;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Counter1 := 1;
|
||||||
|
Prt('|01[ |11');
|
||||||
|
FOR Counter2 := 0 TO (BullCount) DO
|
||||||
|
BEGIN
|
||||||
|
IF (Counter1 = 15) THEN
|
||||||
|
BEGIN
|
||||||
|
Prt(PadRightInt(BulletinArray^[Counter2],2));
|
||||||
|
IF (Counter2 < BullCount) THEN
|
||||||
|
Prt(' |01]'+^M^J+'|01[ |11')
|
||||||
|
ELSE
|
||||||
|
Prt(' |01]');
|
||||||
|
Counter1 := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Prt(PadRightInt(BulletinArray^[Counter2],2));
|
||||||
|
IF (Counter2 < BullCount) THEN
|
||||||
|
Prt('|07,|11 ')
|
||||||
|
ELSE
|
||||||
|
Prt(' |01]');
|
||||||
|
END;
|
||||||
|
Inc(Counter1);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
New(BulletinArray);
|
||||||
|
FOR BullCount := 0 TO 255 DO
|
||||||
|
BulletinArray^[BullCount] := 0;
|
||||||
|
Found := FALSE;
|
||||||
|
Biggest := 0;
|
||||||
|
BullCount := 0;
|
||||||
|
LenOfBullPrefix := (Length(General.BulletPrefix) + 1);
|
||||||
|
FindFirst(General.MiscPath+General.BulletPrefix+'*.ASC',AnyFile - Directory - VolumeID - DOS.Hidden,DirInfo);
|
||||||
|
WHILE (DosError = 0) DO
|
||||||
|
BEGIN
|
||||||
|
IF (((Pos(General.BulletPrefix,General.MiscPath+General.BulletPrefix+'*.ASC') > 0) AND
|
||||||
|
(Pos('BULLETIN',AllCaps(DirInfo.Name)) = 0)) AND
|
||||||
|
(Pos('~',DirInfo.Name) = 0)) THEN
|
||||||
|
BEGIN
|
||||||
|
UnPackTime(DirInfo.Time,DT);
|
||||||
|
IF (DateToPack(DT) > ThisUser.LastOn) THEN
|
||||||
|
BEGIN
|
||||||
|
Found := TRUE;
|
||||||
|
LenToCopy := (Pos('.',DirInfo.Name) - 1) - Length(General.BulletPrefix);
|
||||||
|
BulletinArray^[BullCount] := StrToInt(Copy(DirInfo.Name,LenOfBullPrefix,LenToCopy));
|
||||||
|
IF (BulletinArray^[BullCount] > Biggest) THEN
|
||||||
|
Biggest := BulletinArray^[BullCount];
|
||||||
|
Inc(BullCount);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (BullCount > 254) THEN
|
||||||
|
Exit;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
IF (Found) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(BullCount);
|
||||||
|
ShowBulls;
|
||||||
|
END;
|
||||||
|
Dispose(BulletinArray);
|
||||||
|
NewBulletins := Found;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION UlistMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
|
||||||
|
VAR
|
||||||
|
UserPtr: UserPtrType;
|
||||||
|
BEGIN
|
||||||
|
UlistMCI := S;
|
||||||
|
UserPtr := Data1;
|
||||||
|
CASE S[1] OF
|
||||||
|
'A' : CASE S[2] OF
|
||||||
|
'G' : UListMCI := IntToStr(AgeUser(UserPtr^.BirthDate));
|
||||||
|
END;
|
||||||
|
'D' : CASE S[2] OF
|
||||||
|
'K' : UListMCI := IntToStr(UserPtr^.DK);
|
||||||
|
'L' : UListMCI := IntToStr(UserPtr^.Downloads);
|
||||||
|
END;
|
||||||
|
'L' : CASE S[2] OF
|
||||||
|
'C' : UListMCI := UserPtr^.CityState;
|
||||||
|
'O' : UListMCI := ToDate8(PD2Date(UserPtr^.LastOn));
|
||||||
|
END;
|
||||||
|
'M' : CASE S[2] OF
|
||||||
|
'P' : UListMCI := IntToStr(UserPtr^.MsgPost);
|
||||||
|
END;
|
||||||
|
'N' : CASE S[2] OF
|
||||||
|
'O' : UListMCI := Userptr^.Note;
|
||||||
|
END;
|
||||||
|
'R' : CASE S[2] OF
|
||||||
|
'N' : UListMCI := UserPtr^.RealName;
|
||||||
|
END;
|
||||||
|
'S' : CASE S[2] OF
|
||||||
|
'X' : UListMCI := UserPtr^.Sex;
|
||||||
|
END;
|
||||||
|
'U' : CASE S[2] OF
|
||||||
|
'K' : UListMCI := IntToStr(UserPtr^.UK);
|
||||||
|
'L' : UListMCI := IntToStr(UserPtr^.Uploads);
|
||||||
|
'N' : UListMCI := Caps(UserPtr^.Name);
|
||||||
|
'1' : UListMCI := UserPtr^.UsrDefStr[1];
|
||||||
|
'2' : UListMCI := UserPtr^.UsrDefStr[2];
|
||||||
|
'3' : UListMCI := UserPtr^.UsrDefStr[3];
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UList(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Junk: Pointer;
|
||||||
|
User: UserRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
TempStr: ASTR;
|
||||||
|
Gender: Str1;
|
||||||
|
State,
|
||||||
|
UState: Str2;
|
||||||
|
Age: Str3;
|
||||||
|
DateLastOn: Str8;
|
||||||
|
City,
|
||||||
|
UCity: Str30;
|
||||||
|
RName,
|
||||||
|
UName: Str36;
|
||||||
|
FN: Str50;
|
||||||
|
RecNum: Integer;
|
||||||
|
|
||||||
|
PROCEDURE Option(c1: Char; s1,s2: Str160);
|
||||||
|
BEGIN
|
||||||
|
Prompt('^4<^5'+c1+'^4>'+s1+': ');
|
||||||
|
IF (s2 <> '') THEN
|
||||||
|
Print('^5"^4'+s2+'^5"^1')
|
||||||
|
ELSE
|
||||||
|
Print('^5<<INACTIVE>>^1');
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
IF (RUserList IN ThisUser.Flags) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('You are restricted from listing users.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Age := '';
|
||||||
|
City := '';
|
||||||
|
DateLastOn := '';
|
||||||
|
Gender := '';
|
||||||
|
RName := '';
|
||||||
|
State := '';
|
||||||
|
UName := '';
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Print('^5User lister search options:');
|
||||||
|
NL;
|
||||||
|
Option('A','ge match string ',Age);
|
||||||
|
Option('C','ity match string ',City);
|
||||||
|
Option('D','ate last online match string',DateLastOn);
|
||||||
|
Option('G','ender match string ',Gender);
|
||||||
|
Option('R','eal name match string ',RName);
|
||||||
|
Option('S','tate match string ',State);
|
||||||
|
Option('U','ser name match string ',UName);
|
||||||
|
NL;
|
||||||
|
Prompt('^4Enter choice (^5A^4,^5C^4,^5D^4,^5G^4,^5R^4,^5S^4,^5U^4) [^5L^4]ist [^5Q^4]uit: ');
|
||||||
|
OneK(Cmd,'QACDGLRSU'^M,TRUE,TRUE);
|
||||||
|
NL;
|
||||||
|
IF (Cmd IN ['A','C','D','G','R','S','U']) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := 'Enter new match string for the ';
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : TempStr := TempStr + 'age';
|
||||||
|
'C' : TempStr := TempStr + 'city';
|
||||||
|
'D' : TempStr := TempStr + 'date last online';
|
||||||
|
'G' : TempStr := TempStr + 'gender';
|
||||||
|
'R' : TempStr := TempStr + 'real name';
|
||||||
|
'S' : TempStr := TempStr + 'state';
|
||||||
|
'U' : TempStr := TempStr + 'user name';
|
||||||
|
END;
|
||||||
|
TempStr := TempStr + ' (<CR>=Make INACTIVE)';
|
||||||
|
Print('^4'+TempStr);
|
||||||
|
Prompt('^4: ');
|
||||||
|
END;
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : BEGIN
|
||||||
|
Mpl(3);
|
||||||
|
Input(Age,3);
|
||||||
|
END;
|
||||||
|
'C' : BEGIN
|
||||||
|
Mpl(30);
|
||||||
|
Input(City,30);
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
Mpl(8);
|
||||||
|
InputFormatted('',DateLastOn,'##/##/##',TRUE);
|
||||||
|
IF (DayNum(DateLastOn) <> 0) AND (DayNum(DateLastOn) <= DayNum(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(DateLastOn,3,1);
|
||||||
|
Insert('-',DateLastOn,3);
|
||||||
|
Delete(DateLastOn,6,1);
|
||||||
|
Insert('-',DateLastOn,6);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'G' : BEGIN
|
||||||
|
Mpl(1);
|
||||||
|
Input(Gender,1);
|
||||||
|
END;
|
||||||
|
'R' : BEGIN
|
||||||
|
Mpl(36);
|
||||||
|
Input(RName,36);
|
||||||
|
END;
|
||||||
|
'S' : BEGIN
|
||||||
|
Mpl(2);
|
||||||
|
Input(State,2);
|
||||||
|
END;
|
||||||
|
'U' : BEGIN
|
||||||
|
Mpl(36);
|
||||||
|
Input(UName,36);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd IN ['L','Q',^M]) OR (HangUp);
|
||||||
|
IF (Cmd IN ['L',^M]) THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
IF (Pos(';',MenuOption) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FN := Copy(MenuOption,(Pos(';',MenuOption) + 1),255);
|
||||||
|
MenuOption := Copy(MenuOption,1,(Pos(';',MenuOption) - 1));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
FN := 'USER';
|
||||||
|
IF (NOT ReadBuffer(FN+'M')) THEN
|
||||||
|
Exit;
|
||||||
|
PrintF(FN+'H');
|
||||||
|
Reset(UserFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= (FileSize(UserFile) - 1)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,RecNum);
|
||||||
|
UCity := (Copy(User.CityState,1,(Pos(',',User.CityState) - 1)));
|
||||||
|
UState := SQOutSP((Copy(User.CityState,(Pos(',',User.CityState) + 2),(Length(User.CityState)))));
|
||||||
|
IF (AACS1(User,RecNum,MenuOption)) AND NOT (Deleted IN User.SFlags) THEN
|
||||||
|
IF (Age = '') OR (Pos(Age,IntToStr(AgeUser(User.BirthDate))) > 0) THEN
|
||||||
|
IF (City = '') OR (Pos(City,AllCaps(UCity)) > 0) THEN
|
||||||
|
IF (DateLastOn = '') OR (Pos(DateLastOn,ToDate8(PD2Date(User.LastOn))) > 0) THEN
|
||||||
|
IF (Gender = '') OR (Pos(Gender,User.Sex) > 0) THEN
|
||||||
|
IF (RName = '') OR (Pos(RName,AllCaps(User.RealName)) > 0) THEN
|
||||||
|
IF (State = '') OR (Pos(State,AllCaps(UState)) > 0) THEN
|
||||||
|
IF (UName = '') OR (Pos(UName,User.Name) > 0) THEN
|
||||||
|
DisplayBuffer(UlistMCI,@User,Junk);
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
IF (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
PrintF(FN+'T');
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
END;
|
||||||
|
SysOpLog('Viewed User Listing.');
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION TodaysCallerMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
|
||||||
|
VAR
|
||||||
|
LastCallerPtr: LastCallerPtrType;
|
||||||
|
s1: STRING[100];
|
||||||
|
BEGIN
|
||||||
|
LastCallerPtr := Data1;
|
||||||
|
TodaysCallerMCI := S;
|
||||||
|
CASE S[1] OF
|
||||||
|
'C' : CASE S[2] OF
|
||||||
|
'A' : TodaysCallerMCI := FormatNumber(LastCallerPtr^.Caller);
|
||||||
|
END;
|
||||||
|
'D' : CASE S[2] OF
|
||||||
|
'K' : TodaysCallerMCI := IntToStr(LastCallerPtr^.DK);
|
||||||
|
'L' : TodaysCallerMCI := IntToStr(LastCallerPtr^.Downloads);
|
||||||
|
END;
|
||||||
|
'E' : CASE S[2] OF
|
||||||
|
'S' : TodaysCallerMCI := IntToStr(LastCallerPtr^.EmailSent);
|
||||||
|
END;
|
||||||
|
'F' : CASE S[2] OF
|
||||||
|
'S' : TodaysCallerMCI := IntToStr(LastCallerPtr^.FeedbackSent);
|
||||||
|
END;
|
||||||
|
'L' : CASE S[2] OF
|
||||||
|
'C' : TodaysCallerMCI := LastCallerPtr^.Location;
|
||||||
|
'O' : BEGIN
|
||||||
|
s1 := PDT2Dat(LastCallerPtr^.LogonTime,0);
|
||||||
|
s1[0] := Char(Pos('m',s1) - 2);
|
||||||
|
s1[Length(s1)] := s1[Length(s1) + 1];
|
||||||
|
TodaysCallerMCI := s1;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
IF (LastCallerPtr^.LogoffTime = 0) THEN
|
||||||
|
S1 := 'Online'
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
s1 := PDT2Dat(LastCallerPtr^.LogoffTime,0);
|
||||||
|
s1[0] := Char(Pos('m',s1) - 2);
|
||||||
|
s1[Length(s1)] := s1[Length(s1) + 1];
|
||||||
|
END;
|
||||||
|
TodaysCallerMCI := s1;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'M' : CASE S[2] OF
|
||||||
|
'P' : TodaysCallerMCI := IntToStr(LastCallerPtr^.MsgPost);
|
||||||
|
'R' : TodaysCallerMCI := IntToStr(LastCallerPtr^.MsgRead);
|
||||||
|
END;
|
||||||
|
'N' : CASE S[2] OF
|
||||||
|
'D' : TodaysCallerMCI := IntToStr(LastCallerPtr^.Node);
|
||||||
|
'U' : IF (LastCallerPtr^.NewUser) THEN
|
||||||
|
TodaysCallerMCI := '*'
|
||||||
|
ELSE
|
||||||
|
TodaysCallerMCI := ' ';
|
||||||
|
END;
|
||||||
|
'S' : CASE S[2] OF
|
||||||
|
'P' : IF (LastCallerPtr^.Speed = 0) THEN
|
||||||
|
TodaysCallerMCI := 'Local'
|
||||||
|
ELSE IF (Telnet) THEN
|
||||||
|
TodaysCallerMCI := 'Telnet'
|
||||||
|
ELSE
|
||||||
|
TodaysCallerMCI := IntToStr(LastCallerPtr^.Speed);
|
||||||
|
END;
|
||||||
|
'T' : CASE S[2] OF
|
||||||
|
'O' : WITH LastCallerPtr^ DO
|
||||||
|
TodaysCallerMCI := IntToStr((LogoffTime - LogonTime) DIV 60);
|
||||||
|
END;
|
||||||
|
'U' : CASE S[2] OF
|
||||||
|
'K' : TodaysCallerMCI := IntToStr(LastCallerPtr^.UK);
|
||||||
|
'L' : TodaysCallerMCI := IntToStr(LastCallerPtr^.Uploads);
|
||||||
|
'N' : TodaysCallerMCI := LastCallerPtr^.UserName;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE TodaysCallers(x: Byte; MenuOptions: Str50);
|
||||||
|
VAR
|
||||||
|
Junk: Pointer;
|
||||||
|
LastCallerFile: FILE OF LastCallerRec;
|
||||||
|
LastCaller: LastCallerRec;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
IF (MenuOptions = '') THEN
|
||||||
|
MenuOptions := 'LAST';
|
||||||
|
IF (NOT ReadBuffer(MenuOptions+'M')) THEN
|
||||||
|
Exit;
|
||||||
|
Assign(LastCallerFile,General.DataPath+'LASTON.DAT');
|
||||||
|
Reset(LastCallerFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Exit;
|
||||||
|
RecNum := 0;
|
||||||
|
IF (x > 0) AND (x <= FileSize(LastCallerFile)) THEN
|
||||||
|
RecNum := (FileSize(LastCallerFile) - x);
|
||||||
|
PrintF(MenuOptions+'H');
|
||||||
|
Seek(LastCallerFile,RecNum);
|
||||||
|
WHILE (NOT EOF(LastCallerFile)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Read(LastCallerFile,LastCaller);
|
||||||
|
IF (((LastCaller.LogonTime DIV 86400) <> (GetPackDateTime DIV 86400)) AND (x > 0)) OR
|
||||||
|
(((LastCaller.LogonTime DIV 86400) = (GetPackDateTime DIV 86400))) AND (NOT LastCaller.Invisible) THEN
|
||||||
|
DisplayBuffer(TodaysCallerMCI,@LastCaller,Junk);
|
||||||
|
END;
|
||||||
|
Close(LastCallerFile);
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
PrintF(MenuOptions+'T');
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
SysOpLog('Viewed Todays Callers.');
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE RGQuote(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
StrPointerFile: FILE OF StrPointerRec;
|
||||||
|
StrPointer: StrPointerRec;
|
||||||
|
RGStrFile: FILE;
|
||||||
|
F,
|
||||||
|
F1: Text;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
S: STRING;
|
||||||
|
StrNum: Word;
|
||||||
|
TotLoad: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (MenuOption = '') THEN
|
||||||
|
Exit;
|
||||||
|
Assign(StrPointerFile,General.LMultPath+MenuOption+'.PTR');
|
||||||
|
Reset(StrPointerFile);
|
||||||
|
TotLoad := FileSize(StrPointerFile);
|
||||||
|
IF (TotLoad < 1) THEN
|
||||||
|
Exit;
|
||||||
|
IF (TotLoad > 65535) THEN
|
||||||
|
Totload := 65535
|
||||||
|
ELSE
|
||||||
|
Dec(TotLoad);
|
||||||
|
Randomize;
|
||||||
|
StrNum := Random(Totload);
|
||||||
|
Seek(StrPointerFile,StrNum);
|
||||||
|
Read(StrPointerFile,StrPointer);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (Exist(General.MiscPath+'QUOTEHDR.*')) THEN
|
||||||
|
PrintF('QUOTEHDR')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('|03[ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ |11And Now |03... |11A Quote For You! |03]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ]');
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
TotLoad := 0;
|
||||||
|
Assign(RGStrFile,General.LMultPath+MenuOption+'.DAT');
|
||||||
|
Reset(RGStrFile,1);
|
||||||
|
Seek(RGStrFile,(StrPointer.Pointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(RGStrFile,S[0],1);
|
||||||
|
BlockRead(RGStrFile,S[1],Ord(S[0]));
|
||||||
|
Inc(TotLoad,(Length(S) + 1));
|
||||||
|
IF (S[Length(S)] = '@') THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(S[0]);
|
||||||
|
Prt(Centre(S));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
PrintACR(Centre(S));
|
||||||
|
UNTIL (TotLoad >= StrPointer.TextSize) OR EOF(RGStrFile);
|
||||||
|
Close(RGStrFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (Exist(General.MiscPath+'QUOTEFTR.*')) THEN
|
||||||
|
PrintF('QUOTEFTR')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('|03[ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ]');
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
IF (NOT General.UserAddQuote) THEN
|
||||||
|
PauseScr(FALSE)
|
||||||
|
ELSE IF (PYNQ('Would you like to add a quote? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('QUOTE');
|
||||||
|
InResponseTo := '';
|
||||||
|
MHeader.Status := [];
|
||||||
|
IF (InputMessage(TRUE,FALSE,'New Quote',MHeader,General.LMultPath+MenuOption+'.TMP',78,500)) then
|
||||||
|
IF Exist(General.LMultPath+MenuOption+'.TMP') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(F,General.LMultPath+MenuOption+'.NEW');
|
||||||
|
Reset(F);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
ReWrite(F)
|
||||||
|
ELSE
|
||||||
|
Append(F);
|
||||||
|
Assign(F1,General.LMultPath+MenuOption+'.TMP');
|
||||||
|
Reset(F1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Exit;
|
||||||
|
WriteLn(F,'New quote from: '+Caps(ThisUser.Name)+' #'+IntToStr(UserNum)+'.');
|
||||||
|
WriteLn(F,'');
|
||||||
|
WriteLn(F,'$');
|
||||||
|
WHILE (NOT EOF(F1)) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F1,S);
|
||||||
|
WriteLn(F,S);
|
||||||
|
END;
|
||||||
|
WriteLn(F,'$');
|
||||||
|
WriteLn(F,'');
|
||||||
|
WriteLn(F);
|
||||||
|
Close(F);
|
||||||
|
Close(F1);
|
||||||
|
Kill(General.LMultPath+MenuOption+'.TMP');
|
||||||
|
NL;
|
||||||
|
Print('^7Your new quote was saved.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
SendShortMessage(1,Caps(ThisUser.Name)+' added a new quote to "'+MenuOption+'.NEW".');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,414 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-}
|
||||||
|
|
||||||
|
UNIT Common1;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
FUNCTION CheckPW: Boolean;
|
||||||
|
PROCEDURE NewCompTables;
|
||||||
|
PROCEDURE Wait(b: Boolean);
|
||||||
|
PROCEDURE InitTrapFile;
|
||||||
|
PROCEDURE Local_Input1(VAR S: STRING; MaxLen: Byte; LowerCase: Boolean);
|
||||||
|
PROCEDURE Local_Input(VAR S: STRING; MaxLen: Byte);
|
||||||
|
PROCEDURE Local_InputL(VAR S: STRING; MaxLen: Byte);
|
||||||
|
PROCEDURE Local_OneK(VAR C: Char; S: STRING);
|
||||||
|
PROCEDURE SysOpShell;
|
||||||
|
PROCEDURE ReDrawForANSI;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Common,
|
||||||
|
File0,
|
||||||
|
Mail0,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
FUNCTION CheckPW: Boolean;
|
||||||
|
VAR
|
||||||
|
Password: STR20;
|
||||||
|
BEGIN
|
||||||
|
IF (NOT General.SysOpPWord) OR (InWFCMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
CheckPW := TRUE;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
CheckPW := FALSE;
|
||||||
|
{ Prompt(FString.SysOpPrompt); }
|
||||||
|
lRGLngStr(33,FALSE);
|
||||||
|
GetPassword(Password,20);
|
||||||
|
IF (Password = General.SysOpPW) THEN
|
||||||
|
CheckPW := TRUE
|
||||||
|
ELSE IF (InCom) AND (Password <> '') THEN
|
||||||
|
SysOpLog('--> SysOp Password Failure = '+Password+' ***');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE NewCompTables;
|
||||||
|
VAR
|
||||||
|
FileCompArrayFile: FILE OF CompArrayType;
|
||||||
|
MsgCompArrayFile: FILE OF CompArrayType;
|
||||||
|
CompFileArray: CompArrayType;
|
||||||
|
CompMsgArray: CompArrayType;
|
||||||
|
Counter,
|
||||||
|
Counter1,
|
||||||
|
Counter2,
|
||||||
|
SaveReadMsgArea,
|
||||||
|
SaveReadFileArea: Integer;
|
||||||
|
BEGIN
|
||||||
|
SaveReadMsgArea := ReadMsgArea;
|
||||||
|
SaveReadFileArea := ReadFileArea;
|
||||||
|
Reset(FileAreaFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error opening FBASES.DAT (Procedure: NewCompTables)');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
NumFileAreas := FileSize(FileAreaFile);
|
||||||
|
Assign(FileCompArrayFile,TempDir+'FACT'+IntToStr(ThisNode)+'.DAT');
|
||||||
|
ReWrite(FileCompArrayFile);
|
||||||
|
CompFileArray[0] := 0;
|
||||||
|
CompFileArray[1] := 0;
|
||||||
|
FOR Counter := 1 TO FileSize(FileAreaFile) DO
|
||||||
|
Write(FileCompArrayFile,CompFileArray);
|
||||||
|
Reset(FileCompArrayFile);
|
||||||
|
IF (NOT General.CompressBases) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO FileSize(FileAreaFile) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileAreaFile,(Counter - 1));
|
||||||
|
Read(FileAreaFile,MemFileArea);
|
||||||
|
IF (NOT AACS(MemFileArea.ACS)) THEN
|
||||||
|
BEGIN
|
||||||
|
CompFileArray[0] := 0;
|
||||||
|
CompFileArray[1] := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CompFileArray[0] := Counter;
|
||||||
|
CompFileArray[1] := Counter;
|
||||||
|
END;
|
||||||
|
Seek(FileCompArrayFile,(Counter - 1));
|
||||||
|
Write(FileCompArrayFile,CompFileArray);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Counter2 := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
FOR Counter := 1 TO FileSize(FileAreaFile) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileAreaFile,(Counter - 1));
|
||||||
|
Read(FileAreaFile,MemFileArea);
|
||||||
|
Inc(Counter1);
|
||||||
|
IF (NOT AACS(MemFileArea.ACS)) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Counter1);
|
||||||
|
CompFileArray[0] := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CompFileArray[0] := Counter1;
|
||||||
|
Seek(FileCompArrayFile,(Counter - 1));
|
||||||
|
Write(FileCompArrayFile,CompFileArray);
|
||||||
|
Inc(Counter2);
|
||||||
|
Seek(FileCompArrayFile,(Counter2 - 1));
|
||||||
|
Read(FileCompArrayFile,CompFileArray);
|
||||||
|
CompFileArray[1] := Counter;
|
||||||
|
Seek(FileCompArrayFile,(Counter2 - 1));
|
||||||
|
Write(FileCompArrayFile,CompFileArray);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(FileAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
LowFileArea := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= FileSize(FileCompArrayFile)) AND (Counter1 = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileCompArrayFile,(Counter - 1));
|
||||||
|
Read(FileCompArrayFile,CompFileArray);
|
||||||
|
IF (CompFileArray[0] <> 0) THEN
|
||||||
|
Counter1 := CompFileArray[0];
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
LowFileArea := Counter1;
|
||||||
|
HighFileArea := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= FileSize(FileCompArrayFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileCompArrayFile,(Counter - 1));
|
||||||
|
Read(FileCompArrayFile,CompFileArray);
|
||||||
|
IF (CompFileArray[0] <> 0) THEN
|
||||||
|
Counter1 := CompFileArray[0];
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
HighFileArea := Counter1;
|
||||||
|
Close(FileCompArrayFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Reset(MsgAreaFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error opening MBASES.DAT (Procedure: NewCompTables)');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
NumMsgAreas := FileSize(MsgAreaFile);
|
||||||
|
Assign(MsgCompArrayFile,TempDir+'MACT'+IntToStr(ThisNode)+'.DAT');
|
||||||
|
ReWrite(MsgCompArrayFile);
|
||||||
|
CompMsgArray[0] := 0;
|
||||||
|
CompMsgArray[1] := 0;
|
||||||
|
FOR Counter := 1 TO FileSize(MsgAreaFile) DO
|
||||||
|
Write(MsgCompArrayFile,CompMsgArray);
|
||||||
|
Reset(MsgCompArrayFile);
|
||||||
|
IF (NOT General.CompressBases) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO FileSize(MsgAreaFile) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgAreaFile,(Counter - 1));
|
||||||
|
Read(MsgAreaFile,MemMsgArea);
|
||||||
|
IF (NOT AACS(MemMsgArea.ACS)) THEN
|
||||||
|
BEGIN
|
||||||
|
CompMsgArray[0] := 0;
|
||||||
|
CompMsgArray[1] := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CompMsgArray[0] := Counter;
|
||||||
|
CompMsgArray[1] := Counter;
|
||||||
|
END;
|
||||||
|
Seek(MsgCompArrayFile,(Counter - 1));
|
||||||
|
Write(MsgCompArrayFile,CompMsgArray);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Counter2 := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
FOR Counter := 1 TO FileSize(MsgAreaFile) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgAreaFile,(Counter - 1));
|
||||||
|
Read(MsgAreaFile,MemMsgArea);
|
||||||
|
Inc(Counter1);
|
||||||
|
IF (NOT AACS(MemMsgArea.ACS)) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Counter1);
|
||||||
|
CompMsgArray[0] := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CompMsgArray[0] := Counter1;
|
||||||
|
Seek(MsgCompArrayFile,(Counter - 1));
|
||||||
|
Write(MsgCompArrayFile,CompMsgArray);
|
||||||
|
Inc(Counter2);
|
||||||
|
Seek(MsgCompArrayFile,(Counter2 - 1));
|
||||||
|
Read(MsgCompArrayFile,CompMsgArray);
|
||||||
|
CompMsgArray[1] := Counter;
|
||||||
|
Seek(MsgCompArrayFile,(Counter2 - 1));
|
||||||
|
Write(MsgCompArrayFile,CompMsgArray);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(MsgAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
LowMsgArea := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= FileSize(MsgCompArrayFile)) AND (Counter1 = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgCompArrayFile,(Counter - 1));
|
||||||
|
Read(MsgCompArrayFile,CompMsgArray);
|
||||||
|
IF (CompMsgArray[0] <> 0) THEN
|
||||||
|
Counter1 := CompMsgArray[0];
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
LowMsgArea := Counter1;
|
||||||
|
HighMsgArea := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= FileSize(MsgCompArrayFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgCompArrayFile,(Counter - 1));
|
||||||
|
Read(MsgCompArrayFile,CompMsgArray);
|
||||||
|
IF (CompMsgArray[0] <> 0) THEN
|
||||||
|
Counter1 := CompMsgArray[0];
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
HighMsgArea := Counter1;
|
||||||
|
Close(MsgCompArrayFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
ReadMsgArea := -1;
|
||||||
|
ReadFileArea := -1;
|
||||||
|
IF (NOT FileAreaAC(FileArea)) THEN
|
||||||
|
ChangeFileArea(CompFileArea(1,1));
|
||||||
|
IF (NOT MsgAreaAC(MsgArea)) THEN
|
||||||
|
ChangeMsgArea(CompMsgArea(1,1));
|
||||||
|
LoadMsgArea(SaveReadMsgArea);
|
||||||
|
LoadFileArea(SaveReadFileArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Wait(b: Boolean);
|
||||||
|
CONST
|
||||||
|
SaveCurrentColor: Byte = 0;
|
||||||
|
BEGIN
|
||||||
|
IF (B) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveCurrentColor := CurrentColor;
|
||||||
|
{ Prompt(FString.lWait); }
|
||||||
|
lRGLngStr(4,FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
BackErase(LennMCI(lRGLngStr(4,TRUE){FString.lWait}));
|
||||||
|
SetC(SaveCurrentColor);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitTrapFile;
|
||||||
|
BEGIN
|
||||||
|
Trapping := FALSE;
|
||||||
|
IF (General.GlobalTrap) OR (TrapActivity IN ThisUser.SFlags) THEN
|
||||||
|
Trapping := TRUE;
|
||||||
|
IF (Trapping) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (TrapSeparate IN ThisUser.SFlags) THEN
|
||||||
|
Assign(TrapFile,General.LogsPath+'TRAP'+IntToStr(UserNum)+'.LOG')
|
||||||
|
ELSE
|
||||||
|
Assign(TrapFile,General.LogsPath+'TRAP.LOG');
|
||||||
|
Append(TrapFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(TrapFile);
|
||||||
|
WriteLn(TrapFile);
|
||||||
|
END;
|
||||||
|
WriteLn(TrapFile,'***** Renegade User Audit - '+Caps(ThisUser.Name)+' on at '+DateStr+' '+TimeStr+' *****');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Local_Input1(VAR S: STRING; MaxLen: Byte; LowerCase: Boolean);
|
||||||
|
VAR
|
||||||
|
C: Char;
|
||||||
|
B: Byte;
|
||||||
|
BEGIN
|
||||||
|
B := 1;
|
||||||
|
REPEAT
|
||||||
|
C := ReadKey;
|
||||||
|
IF (NOT LowerCase) THEN
|
||||||
|
C := UpCase(C);
|
||||||
|
IF (C IN [#32..#255]) THEN
|
||||||
|
IF (B <= MaxLen) THEN
|
||||||
|
BEGIN
|
||||||
|
S[B] := C;
|
||||||
|
Inc(B);
|
||||||
|
Write(C);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
ELSE
|
||||||
|
CASE C of
|
||||||
|
^H : IF (B > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Write(^H' '^H);
|
||||||
|
C := ^H;
|
||||||
|
Dec(B);
|
||||||
|
END;
|
||||||
|
^U,^X : WHILE (B <> 1) DO
|
||||||
|
BEGIN
|
||||||
|
Write(^H' '^H);
|
||||||
|
Dec(B);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (C IN [^M,^N]);
|
||||||
|
S[0] := Chr(B - 1);
|
||||||
|
IF (WhereY <= Hi(WindMax) - Hi(WindMin)) THEN
|
||||||
|
WriteLn;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Local_Input(VAR S: STRING; MaxLen: Byte);
|
||||||
|
BEGIN
|
||||||
|
Local_Input1(S,MaxLen,FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Local_InputL(VAR S: STRING; MaxLen: Byte);
|
||||||
|
BEGIN
|
||||||
|
Local_Input1(S,MaxLen,TRUE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Local_OneK(VAR C: Char; S: STRING);
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
C := UpCase(ReadKey)
|
||||||
|
UNTIL (Pos(C,S) > 0);
|
||||||
|
WriteLn(C);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SysOpShell;
|
||||||
|
VAR
|
||||||
|
SavePath: STRING;
|
||||||
|
SaveWhereX,
|
||||||
|
SaveWhereY,
|
||||||
|
SaveCurCo: Byte;
|
||||||
|
ReturnCode: Integer;
|
||||||
|
SaveTimer: LongInt;
|
||||||
|
BEGIN
|
||||||
|
SaveCurCo := CurrentColor;
|
||||||
|
GetDir(0,SavePath);
|
||||||
|
SaveTimer := Timer;
|
||||||
|
IF (UserOn) THEN
|
||||||
|
BEGIN
|
||||||
|
{ Prompt(FString.ShellDOS1); }
|
||||||
|
lRGLngStr(12,FALSE);
|
||||||
|
Com_Flush_Send;
|
||||||
|
Delay(100);
|
||||||
|
END;
|
||||||
|
SaveWhereX := WhereX;
|
||||||
|
SaveWhereY := WhereY;
|
||||||
|
Window(1,1,80,25);
|
||||||
|
TextBackGround(Black);
|
||||||
|
TextColor(LightGray);
|
||||||
|
ClrScr;
|
||||||
|
TextColor(LightCyan);
|
||||||
|
WriteLn('Type "EXIT" to return to Renegade.');
|
||||||
|
WriteLn;
|
||||||
|
TimeLock := TRUE;
|
||||||
|
ShellDOS(FALSE,'',ReturnCode);
|
||||||
|
TimeLock := FALSE;
|
||||||
|
IF (UserOn) THEN
|
||||||
|
Com_Flush_Recv;
|
||||||
|
ChDir(SavePath);
|
||||||
|
TextBackGround(Black);
|
||||||
|
TextColor(LightGray);
|
||||||
|
ClrScr;
|
||||||
|
TextAttr := SaveCurCo;
|
||||||
|
GoToXY(SaveWhereX,SaveWhereY);
|
||||||
|
IF (UserOn) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT InChat) THEN
|
||||||
|
FreeTime := ((FreeTime + Timer) - SaveTimer);
|
||||||
|
Update_Screen;
|
||||||
|
FOR SaveCurCo := 1 TO LennMCI(lRGLngStr(12,TRUE){FString.ShellDOS1}) DO
|
||||||
|
BackSpace;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReDrawForANSI;
|
||||||
|
BEGIN
|
||||||
|
IF (DOSANSIOn) THEN
|
||||||
|
BEGIN
|
||||||
|
DOSANSIOn := FALSE;
|
||||||
|
Update_Screen;
|
||||||
|
END;
|
||||||
|
TextAttr := 7;
|
||||||
|
CurrentColor := 7;
|
||||||
|
IF (OutCom) THEN
|
||||||
|
IF (OKAvatar) THEN
|
||||||
|
SerialOut(^V^A^G)
|
||||||
|
ELSE IF (OkANSI) THEN
|
||||||
|
SerialOut(#27+'[0m');
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,545 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-,X-}
|
||||||
|
|
||||||
|
UNIT Common3;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean);
|
||||||
|
PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; Format: STRING; Abortable: Boolean);
|
||||||
|
PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean);
|
||||||
|
PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt);
|
||||||
|
PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean);
|
||||||
|
PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word);
|
||||||
|
PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean);
|
||||||
|
PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer);
|
||||||
|
PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean);
|
||||||
|
PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte);
|
||||||
|
PROCEDURE InputWN1(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; InputFlags: InputFlagSet; VAR Changed: Boolean);
|
||||||
|
PROCEDURE InputWNWC(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; VAR Changed: Boolean);
|
||||||
|
PROCEDURE InputMain(VAR S: STRING; MaxLen: Byte; InputFlags: InputFlagSet);
|
||||||
|
PROCEDURE InputWC(VAR S: STRING; MaxLen: Byte);
|
||||||
|
PROCEDURE Input(VAR S: STRING; MaxLen: Byte);
|
||||||
|
PROCEDURE InputL(VAR S: STRING; MaxLen: Byte);
|
||||||
|
PROCEDURE InputCaps(VAR S: STRING; MaxLen: Byte);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
,RPScreen
|
||||||
|
{$ENDIF}
|
||||||
|
;
|
||||||
|
|
||||||
|
PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean);
|
||||||
|
VAR
|
||||||
|
C: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
MPL(MaxLen);
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
ColorAllowed := FALSE;
|
||||||
|
Prompt(v);
|
||||||
|
ColorAllowed := TRUE;
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
C := Char(GetKey);
|
||||||
|
IF (C <> #13) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO Length(v) DO
|
||||||
|
BackSpace;
|
||||||
|
Buf := C + Buf;
|
||||||
|
InputMain(S,MaxLen,InputFlags);
|
||||||
|
IF (S = '') THEN
|
||||||
|
BEGIN
|
||||||
|
S := v;
|
||||||
|
MPL(MaxLen);
|
||||||
|
Prompt(S);
|
||||||
|
END
|
||||||
|
ELSE IF (S = ' ') THEN
|
||||||
|
S := '';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := v;
|
||||||
|
IF NOT (NolineFeed IN InputFlags) THEN
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
UserColor(1);
|
||||||
|
IF (LineFeed) THEN
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
|
||||||
|
PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; Format: STRING; Abortable: Boolean);
|
||||||
|
VAR
|
||||||
|
c: Char;
|
||||||
|
i,
|
||||||
|
FarBack: Byte;
|
||||||
|
|
||||||
|
PROCEDURE UpdateString;
|
||||||
|
BEGIN
|
||||||
|
WHILE (NOT (Format[i] IN ['#','@']) AND (i <= Length(Format))) DO
|
||||||
|
BEGIN
|
||||||
|
OutKey(Format[i]);
|
||||||
|
InputStr := InputStr + Format[i];
|
||||||
|
Inc(i);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
InputStr := '';
|
||||||
|
Prt(DisplayStr);
|
||||||
|
MPL(Length(Format));
|
||||||
|
i := 1;
|
||||||
|
UpdateString;
|
||||||
|
FarBack := i;
|
||||||
|
REPEAT
|
||||||
|
c := Char(GetKey);
|
||||||
|
IF (i <= Length(Format)) THEN
|
||||||
|
IF ((Format[i] = '@') AND (c IN ['a'..'z','A'..'Z'])) OR ((Format[i] = '#') AND (c IN ['0'..'9'])) THEN
|
||||||
|
BEGIN
|
||||||
|
c := UpCase(c);
|
||||||
|
OutKey(c);
|
||||||
|
InputStr := InputStr + c;
|
||||||
|
Inc(i);
|
||||||
|
UpdateString;
|
||||||
|
END;
|
||||||
|
IF (c = ^H) THEN
|
||||||
|
BEGIN
|
||||||
|
WHILE ((i > FarBack) AND NOT (Format[i - 1] IN ['#','@'])) DO
|
||||||
|
BEGIN
|
||||||
|
BackSpace;
|
||||||
|
Dec(InputStr[0]);
|
||||||
|
Dec(i);
|
||||||
|
END;
|
||||||
|
IF (i > FarBack) THEN
|
||||||
|
BEGIN
|
||||||
|
BackSpace;
|
||||||
|
Dec(InputStr[0]);
|
||||||
|
Dec(i);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (HangUp) OR ((i > Length(Format)) OR (Abortable)) AND (c = #13);
|
||||||
|
UserColor(1);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr: Str10;
|
||||||
|
SaveL: LongInt;
|
||||||
|
TempL: Real;
|
||||||
|
BEGIN
|
||||||
|
SaveL := L;
|
||||||
|
IF (NOT (DisplayValue IN InputFlags)) THEN
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4): ')
|
||||||
|
ELSE
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4) [^5'+IntToStr(L)+'^4]: ');
|
||||||
|
MPL(Length(IntToStr(HighNum)));
|
||||||
|
TempStr := IntToStr(L);
|
||||||
|
InputMain(TempStr,Length(IntToStr(HighNum)),InputFlags);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
TempL := ValueR(TempStr);
|
||||||
|
IF ((Trunc(TempL) >= LowNum) AND (Trunc(TempL) <= HighNum)) THEN
|
||||||
|
L := Trunc(TempL)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from '+IntToStr(LowNum)+' to '+IntToStr(HighNum)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (SaveL <> L) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt);
|
||||||
|
VAR
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Changed := FALSE;
|
||||||
|
InputLongIntWC(S,L,InputFlags,LowNum,HighNum,Changed);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr: Str5;
|
||||||
|
SaveW: Word;
|
||||||
|
TempW: Longint;
|
||||||
|
BEGIN
|
||||||
|
SaveW := W;
|
||||||
|
IF (NOT (DisplayValue IN InputFlags)) THEN
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4): ')
|
||||||
|
ELSE
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4) [^5'+IntToStr(W)+'^4]: ');
|
||||||
|
MPL(Length(IntToStr(HighNum)));
|
||||||
|
TempStr := IntToStr(W);
|
||||||
|
InputMain(TempStr,Length(IntToStr(HighNum)),InputFlags);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
TempW := StrToInt(TempStr);
|
||||||
|
IF ((TempW >= LowNum) AND (TempW <= HighNum)) THEN
|
||||||
|
W := TempW
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from '+IntToStr(LowNum)+' to '+IntToStr(HighNum)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (SaveW <> W) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word);
|
||||||
|
VAR
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Changed := FALSE;
|
||||||
|
InputWordWC(S,W,InputFlags,LowNum,HighNum,Changed);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr: Str5;
|
||||||
|
SaveI: Integer;
|
||||||
|
TempI: Longint;
|
||||||
|
BEGIN
|
||||||
|
SaveI := I;
|
||||||
|
IF (NOT (DisplayValue IN InputFlags)) THEN
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4): ')
|
||||||
|
ELSE
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4) [^5'+IntToStr(I)+'^4]: ');
|
||||||
|
MPL(Length(IntToStr(HighNum)));
|
||||||
|
TempStr := IntToStr(I);
|
||||||
|
InputMain(TempStr,Length(IntToStr(HighNum)),InputFlags);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
TempI := StrToInt(TempStr);
|
||||||
|
IF ((TempI >= LowNum) AND (TempI <= HighNum)) THEN
|
||||||
|
I := TempI
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from '+IntToStr(LowNum)+' to '+IntToStr(HighNum)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (SaveI <> I) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer);
|
||||||
|
VAR
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Changed := FALSE;
|
||||||
|
InputIntegerWC(S,I,InputFlags,LowNum,HighNum,Changed);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr: Str3;
|
||||||
|
SaveB: Byte;
|
||||||
|
TempB: Integer;
|
||||||
|
BEGIN
|
||||||
|
SaveB := B;
|
||||||
|
IF (NOT (DisplayValue IN InputFlags)) THEN
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4): ')
|
||||||
|
ELSE
|
||||||
|
Prt(S+' (^5'+IntToStr(LowNum)+'^4-^5'+IntToStr(HighNum)+'^4) [^5'+IntToStr(B)+'^4]: ');
|
||||||
|
MPL(Length(IntToStr(HighNum)));
|
||||||
|
TempStr := IntToStr(B);
|
||||||
|
InputMain(TempStr,Length(IntToStr(HighNum)),InputFlags);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
TempB := StrToInt(TempStr);
|
||||||
|
IF ((TempB >= LowNum) AND (TempB <= HighNum)) THEN
|
||||||
|
B := TempB
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from '+IntToStr(LowNum)+' to '+IntToStr(HighNum)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (SaveB <> B) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte);
|
||||||
|
VAR
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Changed := FALSE;
|
||||||
|
InputByteWC(S,B,InputFlags,LowNum,HighNum,Changed);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputWN1(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; InputFlags: InputFlagSet; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
SaveInputStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
Prt(DisplayStr);
|
||||||
|
IF (NOT (ColorsAllowed IN InputFlags)) THEN
|
||||||
|
MPL(MaxLen);
|
||||||
|
SaveInputStr := InputStr;
|
||||||
|
InputMain(SaveInputStr,MaxLen,InputFlags);
|
||||||
|
IF (SaveInputStr = '') THEN
|
||||||
|
SaveInputStr := InputStr;
|
||||||
|
IF (SaveInputStr = ' ') THEN
|
||||||
|
IF PYNQ('Blank String? ',0,FALSE) THEN
|
||||||
|
SaveInputStr := ''
|
||||||
|
ELSE
|
||||||
|
SaveInputStr := InputStr;
|
||||||
|
IF (SaveInputStr <> InputStr) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
InputStr := SaveInputStr;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputWNWC(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; VAR Changed: Boolean);
|
||||||
|
BEGIN
|
||||||
|
InputWN1(DisplayStr,InputStr,MaxLen,[ColorsAllowed,InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputMain(VAR S: STRING; MaxLen: Byte; InputFlags: InputFlagSet);
|
||||||
|
VAR
|
||||||
|
SaveS: STRING;
|
||||||
|
Is: STRING[2];
|
||||||
|
Cp,
|
||||||
|
Cl,
|
||||||
|
Counter: Byte;
|
||||||
|
c,
|
||||||
|
C1: Word;
|
||||||
|
InsertMode,
|
||||||
|
FirstKey: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE MPrompt(S: STRING);
|
||||||
|
BEGIN
|
||||||
|
SerialOut(S);
|
||||||
|
IF (WantOut) THEN
|
||||||
|
Write(S);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Cursor_Left;
|
||||||
|
BEGIN
|
||||||
|
IF (NOT OkAvatar) THEN
|
||||||
|
SerialOut(#27'[D')
|
||||||
|
ELSE
|
||||||
|
SerialOut(^V^E);
|
||||||
|
IF (WantOut) THEN
|
||||||
|
GotoXY((WhereX - 1),WhereY);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Cursor_Right;
|
||||||
|
BEGIN
|
||||||
|
OutKey(S[Cp]);
|
||||||
|
Inc(Cp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
PROCEDURE SetCursor(InsertMode: Boolean); ASSEMBLER;
|
||||||
|
ASM
|
||||||
|
cmp InsertMode,0
|
||||||
|
je @turnon
|
||||||
|
mov ch,0
|
||||||
|
mov Cl,7
|
||||||
|
jmp @goforit
|
||||||
|
@turnon:
|
||||||
|
mov ch,6
|
||||||
|
mov Cl,7
|
||||||
|
@goforit:
|
||||||
|
mov ah,1
|
||||||
|
int 10h
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
PROCEDURE SetCursor(InsertMode: Boolean);
|
||||||
|
BEGIN
|
||||||
|
if (InsertMode) then
|
||||||
|
begin
|
||||||
|
RPInsertCursor;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
RPBlockCursor;
|
||||||
|
end;
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
FirstKey := FALSE;
|
||||||
|
|
||||||
|
IF (NOT (InterActiveEdit IN InputFlags)) OR NOT (Okansi OR OkAvatar) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '';
|
||||||
|
Cp := 1;
|
||||||
|
Cl := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Cp := Length(S);
|
||||||
|
Cl := Length(S);
|
||||||
|
IF (Cp = 0) THEN
|
||||||
|
Cp := 1;
|
||||||
|
MPrompt(S);
|
||||||
|
IF (Length(S) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Cursor_Left;
|
||||||
|
IF (Cp <= MaxLen) THEN (* Was Cp < MaxLen *)
|
||||||
|
Cursor_Right;
|
||||||
|
END;
|
||||||
|
FirstKey := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
SaveS := S;
|
||||||
|
InsertMode := FALSE;
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
MLC := S;
|
||||||
|
SetCursor(InsertMode);
|
||||||
|
c := GetKey;
|
||||||
|
|
||||||
|
IF (FirstKey) AND (C = 32) THEN
|
||||||
|
C := 24;
|
||||||
|
|
||||||
|
FirstKey := FALSE;
|
||||||
|
|
||||||
|
CASE c OF
|
||||||
|
8 : IF (Cp > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Cl);
|
||||||
|
Dec(Cp);
|
||||||
|
Delete(S,Cp,1);
|
||||||
|
BackSpace;
|
||||||
|
IF (Cp < Cl) THEN
|
||||||
|
BEGIN
|
||||||
|
MPrompt(Copy(S,Cp,255)+' ');
|
||||||
|
FOR Counter := Cp TO (Cl + 1) DO
|
||||||
|
Cursor_Left;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
24 : BEGIN
|
||||||
|
FOR Counter := Cp TO Cl DO
|
||||||
|
OutKey(' ');
|
||||||
|
FOR Counter := 1 TO Cl DO
|
||||||
|
BackSpace;
|
||||||
|
Cl := 0;
|
||||||
|
Cp := 1;
|
||||||
|
END;
|
||||||
|
32..255:
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (NumbersOnly IN InputFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (UpperOnly IN InputFlags) THEN
|
||||||
|
c := Ord(UpCase(Char(c)));
|
||||||
|
IF (CapWords IN InputFlags) THEN
|
||||||
|
IF (Cp > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (S[Cp - 1] IN [#32..#64]) THEN
|
||||||
|
c := Ord(UpCase(Char(c)))
|
||||||
|
ELSE IF (c IN [Ord('A')..Ord('Z')]) THEN
|
||||||
|
Inc(c,32);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
c := Ord(UpCase(Char(c)));
|
||||||
|
END;
|
||||||
|
IF (NOT (NumbersOnly IN InputFlags)) OR (c IN [45,48..57]) THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((InsertMode) AND (Cl < MaxLen)) OR ((NOT InsertMode) AND (Cp <= MaxLen)) THEN
|
||||||
|
BEGIN
|
||||||
|
OutKey(Char(c));
|
||||||
|
IF (InsertMode) THEN
|
||||||
|
BEGIN
|
||||||
|
Is := Char(c);
|
||||||
|
MPrompt(Copy(S,Cp,255));
|
||||||
|
Insert(Is,S,Cp);
|
||||||
|
FOR Counter := Cp TO Cl DO
|
||||||
|
Cursor_Left;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
S[Cp]:= Char(c);
|
||||||
|
IF (InsertMode) OR ((Cp - 1) = Cl) THEN
|
||||||
|
Inc(Cl);
|
||||||
|
Inc(Cp);
|
||||||
|
IF (Trapping) THEN
|
||||||
|
Write(TrapFile,Char(c));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
F_END :
|
||||||
|
WHILE (Cp < (Cl + 1)) AND (Cp <= MaxLen) DO
|
||||||
|
Cursor_Right;
|
||||||
|
F_HOME :
|
||||||
|
WHILE (Cp > 1) DO
|
||||||
|
BEGIN
|
||||||
|
Cursor_Left;
|
||||||
|
Dec(Cp);
|
||||||
|
END;
|
||||||
|
F_LEFT :
|
||||||
|
IF (Cp > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Cursor_Left;
|
||||||
|
Dec(Cp);
|
||||||
|
END;
|
||||||
|
F_RIGHT :
|
||||||
|
IF (Cp <= Cl) THEN
|
||||||
|
Cursor_Right;
|
||||||
|
F_INS :
|
||||||
|
BEGIN
|
||||||
|
InsertMode := (NOT InsertMode);
|
||||||
|
SetCursor(InsertMode);
|
||||||
|
END;
|
||||||
|
F_DEL :
|
||||||
|
IF (Cp > 0) AND (Cp <= Cl) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Cl);
|
||||||
|
Delete(S,Cp,1);
|
||||||
|
MPrompt(Copy(S,Cp,255)+' ');
|
||||||
|
FOR Counter := Cp TO (Cl + 1) DO
|
||||||
|
Cursor_Left;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
S[0] := Chr(Cl);
|
||||||
|
UNTIL (c = 13) OR (HangUp);
|
||||||
|
IF ((Redisplay IN InputFlags) AND (S = '')) THEN
|
||||||
|
BEGIN
|
||||||
|
S := SaveS;
|
||||||
|
MPrompt(S);
|
||||||
|
END;
|
||||||
|
|
||||||
|
UserColor(1);
|
||||||
|
|
||||||
|
IF (NOT (NoLineFeed IN InputFlags)) THEN
|
||||||
|
NL;
|
||||||
|
MLC := '';
|
||||||
|
SetCursor(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputWC(VAR S: STRING; MaxLen: Byte);
|
||||||
|
BEGIN
|
||||||
|
InputMain(S,MaxLen,[ColorsAllowed]);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Input(VAR S: STRING; MaxLen: Byte);
|
||||||
|
BEGIN
|
||||||
|
InputMain(S,MaxLen,[UpperOnly]);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputL(VAR S: STRING; MaxLen: Byte);
|
||||||
|
BEGIN
|
||||||
|
InputMain(S,MaxLen,[]);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InputCaps(VAR S: STRING; MaxLen: Byte);
|
||||||
|
BEGIN
|
||||||
|
InputMain(S,MaxLen,[CapWords]);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,533 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-}
|
||||||
|
|
||||||
|
UNIT Common5;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE FileAreaScanInput(DisplayStr: AStr; MaxLen: Byte; VAR S: AStr; CONST Allowed: AStr; MinNum,MaxNum: Integer);
|
||||||
|
PROCEDURE MsgAreaScanInput(DisplayStr: AStr; MaxLen: Byte; VAR S: AStr; CONST Allowed: AStr; MinNum,MaxNum: Integer);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt;
|
||||||
|
|
||||||
|
PROCEDURE ANSIG(X,Y: Byte);
|
||||||
|
BEGIN
|
||||||
|
IF (ComPortSpeed > 0) THEN
|
||||||
|
IF (OkAvatar) THEN
|
||||||
|
SerialOut(^V^H+Chr(Y)+Chr(X))
|
||||||
|
ELSE
|
||||||
|
SerialOut(#27+'['+IntToStr(Y)+';'+IntToStr(X)+'H');
|
||||||
|
IF (WantOut) THEN
|
||||||
|
GoToXY(X,Y);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION CmdExists(Num: Integer): Boolean;
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
Found: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Found := FALSE;
|
||||||
|
FOR Counter := 1 TO LightBarCounter DO
|
||||||
|
IF (LightBarArray[Counter].CmdToExec = Num) THEN
|
||||||
|
BEGIN
|
||||||
|
Found := TRUE;
|
||||||
|
Break;
|
||||||
|
END;
|
||||||
|
CmdExists := Found;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FileAreaScanInput(DisplayStr: AStr; MaxLen: Byte; VAR S: AStr; CONST Allowed: AStr; MinNum,MaxNum: Integer);
|
||||||
|
VAR
|
||||||
|
SaveS: AStr;
|
||||||
|
C: Char;
|
||||||
|
Counter,
|
||||||
|
SaveX,
|
||||||
|
SaveY: Byte;
|
||||||
|
W: Word;
|
||||||
|
GotCmd: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Prt(DisplayStr);
|
||||||
|
MPL(MaxLen);
|
||||||
|
|
||||||
|
IF (LightBarFirstCmd) THEN
|
||||||
|
LightBarCmd := 1
|
||||||
|
ELSE
|
||||||
|
LightBarCmd := LightBarCounter;
|
||||||
|
|
||||||
|
IF (General.UseFileAreaLightBar) AND (FileAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
|
||||||
|
GotCmd := FALSE;
|
||||||
|
|
||||||
|
s := '';
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
W := GetKey;
|
||||||
|
|
||||||
|
IF (General.UseFileAreaLightBar) AND (FileAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (W = 13) AND (S = '') THEN
|
||||||
|
BEGIN
|
||||||
|
S := IntToStr(LightBarArray[LightBarCmd].CmdToExec);
|
||||||
|
GotCmd := TRUE;
|
||||||
|
END
|
||||||
|
ELSE IF (W = 91) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (CmdExists(MinNum)) THEN
|
||||||
|
W := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := '[';
|
||||||
|
LightBarFirstCmd := FALSE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (W = 93) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (CmdExists(MaxNum)) THEN
|
||||||
|
W := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := ']';
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Home) AND (LightBarCmd <> 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
LightBarCmd := 1;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_End) AND (LightBarCmd <> LightBarCounter) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
LightBarCmd := LightBarCounter;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Left) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = 1) AND (LightBarArray[LightBarCmd].CmdToExec <> MinNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '[';
|
||||||
|
LightBarFirstCmd := FALSE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF (LightBarCmd > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Dec(LightBarCmd);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Right) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = LightBarCounter) AND (LightBarArray[LightBarCmd].CmdToExec <> MaxNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := ']';
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF (LightBarCmd < LightBarCounter) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Inc(LightBarCmd);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Up) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = 1) AND (LightBarArray[LightBarCmd].CmdToExec <> MinNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '[';
|
||||||
|
LightBarFirstCmd := FALSE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF ((LightBarCmd - 2) >= 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Dec(LightBarCmd,2);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Down) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = LightBarCounter) AND (LightBarArray[LightBarCmd].CmdToExec <> MaxNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := ']';
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF ((LightBarCmd + 2) <= LightBarCounter) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Inc(LightBarCmd,2);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
C := UpCase(Char(W));
|
||||||
|
|
||||||
|
SaveS := s;
|
||||||
|
|
||||||
|
IF ((Pos(c,Allowed) <> 0) AND (s = '')) THEN
|
||||||
|
BEGIN
|
||||||
|
GotCmd := TRUE;
|
||||||
|
s := c;
|
||||||
|
END
|
||||||
|
ELSE IF (Pos(c,'0123456789') > 0) OR (c = '-') THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((Length(s) < 6) OR ((Pos('-',s) > 0) AND (Length(s) < 11))) THEN
|
||||||
|
s := s + c;
|
||||||
|
END
|
||||||
|
ELSE IF ((s <> '') AND (c = ^H)) THEN
|
||||||
|
Dec(s[0])
|
||||||
|
ELSE IF (c = ^X) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO Length(s) DO
|
||||||
|
BackSpace;
|
||||||
|
s := '';
|
||||||
|
SaveS := '';
|
||||||
|
END
|
||||||
|
ELSE IF (c = #13) AND (S <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (S = '-') THEN
|
||||||
|
BEGIN
|
||||||
|
BackSpace;
|
||||||
|
S := '';
|
||||||
|
SaveS := '';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
GotCmd := TRUE;
|
||||||
|
END;
|
||||||
|
IF (Length(s) < Length(SaveS)) THEN
|
||||||
|
BackSpace;
|
||||||
|
IF (Length(s) > Length(SaveS)) THEN
|
||||||
|
Prompt(s[Length(s)]);
|
||||||
|
UNTIL (GotCmd) OR (HangUp);
|
||||||
|
|
||||||
|
IF (General.UseFileAreaLightBar) AND (FileAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
END;
|
||||||
|
|
||||||
|
UserColor(1);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MsgAreaScanInput(DisplayStr: AStr; MaxLen: Byte; VAR S: AStr; CONST Allowed: AStr; MinNum,MaxNum: Integer);
|
||||||
|
VAR
|
||||||
|
SaveS: AStr;
|
||||||
|
C: Char;
|
||||||
|
Counter,
|
||||||
|
SaveX,
|
||||||
|
SaveY: Byte;
|
||||||
|
W: Word;
|
||||||
|
GotCmd: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Prt(DisplayStr);
|
||||||
|
MPL(MaxLen);
|
||||||
|
|
||||||
|
IF (LightBarFirstCmd) THEN
|
||||||
|
LightBarCmd := 1
|
||||||
|
ELSE
|
||||||
|
LightBarCmd := LightBarCounter;
|
||||||
|
|
||||||
|
IF (General.UseMsgAreaLightBar) AND (MsgAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
|
||||||
|
GotCmd := FALSE;
|
||||||
|
|
||||||
|
s := '';
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
W := GetKey;
|
||||||
|
|
||||||
|
IF (General.UseMsgAreaLightBar) AND (MsgAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (W = 13) AND (S = '') THEN
|
||||||
|
BEGIN
|
||||||
|
S := IntToStr(LightBarArray[LightBarCmd].CmdToExec);
|
||||||
|
GotCmd := TRUE;
|
||||||
|
END
|
||||||
|
ELSE IF (W = 91) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (CmdExists(MinNum)) THEN
|
||||||
|
W := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := '[';
|
||||||
|
LightBarFirstCmd := FALSE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (W = 93) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (CmdExists(MaxNum)) THEN
|
||||||
|
W := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := ']';
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Home) AND (LightBarCmd <> 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
LightBarCmd := 1;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_End) AND (LightBarCmd <> LightBarCounter) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
LightBarCmd := LightBarCounter;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Left) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = 1) AND (LightBarArray[LightBarCmd].CmdToExec <> MinNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '[';
|
||||||
|
LightBarFirstCmd := FALSE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF (LightBarCmd > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Dec(LightBarCmd);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Right) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = LightBarCounter) AND (LightBarArray[LightBarCmd].CmdToExec <> MaxNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := ']';
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF (LightBarCmd < LightBarCounter) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Inc(LightBarCmd);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Up) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = 1) AND (LightBarArray[LightBarCmd].CmdToExec <> MinNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '[';
|
||||||
|
LightBarFirstCmd := FALSE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF ((LightBarCmd - 2) >= 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Dec(LightBarCmd,2);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE IF (W = F_Down) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LightBarCmd = LightBarCounter) AND (LightBarArray[LightBarCmd].CmdToExec <> MaxNum) THEN
|
||||||
|
BEGIN
|
||||||
|
S := ']';
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
GotCmd := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF ((LightBarCmd + 2) <= LightBarCounter) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
Inc(LightBarCmd,2);
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(114);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
SetC(31);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
C := UpCase(Char(W));
|
||||||
|
|
||||||
|
SaveS := s;
|
||||||
|
|
||||||
|
IF ((Pos(c,Allowed) <> 0) AND (s = '')) THEN
|
||||||
|
BEGIN
|
||||||
|
GotCmd := TRUE;
|
||||||
|
s := c;
|
||||||
|
END
|
||||||
|
ELSE IF (Pos(c,'0123456789') > 0) OR (c = '-') THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((Length(s) < 6) OR ((Pos('-',s) > 0) AND (Length(s) < 11))) THEN
|
||||||
|
s := s + c;
|
||||||
|
END
|
||||||
|
ELSE IF ((s <> '') AND (c = ^H)) THEN
|
||||||
|
Dec(s[0])
|
||||||
|
ELSE IF (c = ^X) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO Length(s) DO
|
||||||
|
BackSpace;
|
||||||
|
s := '';
|
||||||
|
SaveS := '';
|
||||||
|
END
|
||||||
|
ELSE IF (c = #13) AND (S <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (S = '-') THEN
|
||||||
|
BEGIN
|
||||||
|
BackSpace;
|
||||||
|
S := '';
|
||||||
|
SaveS := '';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
GotCmd := TRUE;
|
||||||
|
END;
|
||||||
|
IF (Length(s) < Length(SaveS)) THEN
|
||||||
|
BackSpace;
|
||||||
|
IF (Length(s) > Length(SaveS)) THEN
|
||||||
|
Prompt(s[Length(s)]);
|
||||||
|
UNTIL (GotCmd) OR (HangUp);
|
||||||
|
|
||||||
|
IF (General.UseMsgAreaLightBar) AND (MsgAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
ANSIG(LightBarArray[LightBarCmd].XPos,LightBarArray[LightBarCmd].YPos);
|
||||||
|
SetC(10);
|
||||||
|
Prompt(PadLeftStr(LightBarArray[LightBarCmd].CmdToShow,32));
|
||||||
|
ANSIG(SaveX,SaveY);
|
||||||
|
END;
|
||||||
|
|
||||||
|
UserColor(1);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,772 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
UNIT Doors;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE DoDoorFunc(DropFileType: Char; MenuOption: Str50);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
ExecBat,
|
||||||
|
Events,
|
||||||
|
File0,
|
||||||
|
Mail0,
|
||||||
|
SysOp12,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE ShowUserName(RName: Boolean; VAR First,Last: AStr);
|
||||||
|
BEGIN
|
||||||
|
First := '';
|
||||||
|
Last := '';
|
||||||
|
IF (RName) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Pos(' ',ThisUser.RealName) = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
First := ThisUser.RealName;
|
||||||
|
Last := '';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
First := Copy(ThisUser.RealName,1,(Pos(' ',ThisUser.RealName) - 1));
|
||||||
|
Last := Copy(ThisUser.RealName,(Length(First) + 2),Length(ThisUser.RealName));
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Pos(' ',ThisUser.Name) = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
First := ThisUser.Name;
|
||||||
|
Last := '';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
First := Copy(ThisUser.Name,1,(Pos(' ',ThisUser.Name) - 1));
|
||||||
|
Last := Copy(ThisUser.Name,(Length(First) + 2),Length(ThisUser.Name));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
START POS SAVED
|
||||||
|
& LENGTH AS DESCRIPTION OF DATA
|
||||||
|
--------- ------ --------------------------------------------
|
||||||
|
1, 2 ASCII "-1" always used by FeatherNet PRO!
|
||||||
|
3, 2 ASCII " 0" always used By FeatherNet PRO!
|
||||||
|
5, 2 ASCII "-1" if page allowed or 0 if not.
|
||||||
|
7, 2 ASCII User Number in Users file
|
||||||
|
9, 1 ASCII "Y" if Expert or "N"if Not
|
||||||
|
10, 2 ASCII "-1" if Error Correcting modem, "0" if not
|
||||||
|
12, 1 ASCII "Y" if Graphics Mode or "N" if Not
|
||||||
|
13, 1 ASCII "A" is always placed here by FeatherNet PRO!
|
||||||
|
14, 5 ASCII The DTE speed or PC to Modem baud rate
|
||||||
|
19, 5 ASCII The connect baud rate:"300-38400" or "Local"
|
||||||
|
24, 2 MKI$ User's Record # in "USERS" file
|
||||||
|
26, 15 ASCII User's FIRST Name padded with spaces
|
||||||
|
41, 12 ASCII User's Password
|
||||||
|
53, 2 MKI$ Time user logged on in Mins: (60 x Hr)+Mins
|
||||||
|
55, 2 MKI$ User's Time on today in minutes
|
||||||
|
57, 5 ASCII Time user logged on in HH:MM format. Ex: "12:30"
|
||||||
|
62, 2 MKI$ Time user allowed today in minutes
|
||||||
|
64, 2 ASCII Daily D/L Limit from pwrd file
|
||||||
|
66, 1 Chr$ Conference the user has last joined
|
||||||
|
67, 5 Bitmap Areas user has been in
|
||||||
|
72, 5 Bitmap Areas user has scanned
|
||||||
|
77, 2 MKI$i An mki$(0) used by FeatherNet PRO!
|
||||||
|
79, 2 MKI$ Currently a value of 0 is here (MKI$(0))
|
||||||
|
81, 4 ASCII 4 Spaces are placed here
|
||||||
|
85, 25 ASCII User's Full name placed here.
|
||||||
|
110, 2 MKI$ Number of minutes user has left today
|
||||||
|
112, 1 chr$ Node user is on (actual character)
|
||||||
|
113, 5 ASCII Scheduled EVENT time
|
||||||
|
118, 2 ASCII A "-1" if EVENT is active or a " 0"
|
||||||
|
120, 2 ASCII " 0" is Placed here by FeatherNet PRO!
|
||||||
|
122, 4 MKS$ Time of day in secs format when user is on
|
||||||
|
126, 1 ASCII The Com port this node uses (0 - 8)
|
||||||
|
127, 2 ASCII Flag to let FNET PRO! know type of file xfer
|
||||||
|
129, 1 CHAR Ansi Detected Flag - Char[0] or Char[1]
|
||||||
|
130, 13 ASCII Unused by FeatherNet PRO! - SPACE filled
|
||||||
|
143, 2 MKI$ Last Area User was in (0 - 32766 possible)
|
||||||
|
145 BITMAP Not Currently Used by FeatherNet PRO!
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
Some BASIC functions:
|
||||||
|
CHR$
|
||||||
|
Writes a character (8 bit value). One byte.
|
||||||
|
MKI$
|
||||||
|
Writes a short integer (16 bit value). Low byte then high byte.
|
||||||
|
MKS$
|
||||||
|
I didn't want to research this, and am writing four zeroes. Anyone know?
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Write_PCBoard_Sys(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: FILE;
|
||||||
|
S,
|
||||||
|
UN: STRING[50];
|
||||||
|
i: Integer;
|
||||||
|
|
||||||
|
PROCEDURE Dump(x: STRING);
|
||||||
|
BEGIN
|
||||||
|
BlockWrite(DoorFile,x[1],Length(x));
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
UN := AOnOff(RName,ThisUser.RealName,ThisUser.Name);
|
||||||
|
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'PCBOARD.SYS');
|
||||||
|
ReWrite(DoorFile,1);
|
||||||
|
Dump(AOnOff(WantOut,'-1',' 0'));
|
||||||
|
Dump(AOnOff(FALSE,'-1',' 0'));
|
||||||
|
Dump(AOnOff(SysOpAvailable,'-1',' 0'));
|
||||||
|
Dump(' 0 ');
|
||||||
|
Dump(AOnOff(Reliable,'-1',' 0'));
|
||||||
|
Dump(Copy(ShowYesNo(OkANSI OR OKAvatar),1,1));
|
||||||
|
Dump('A');
|
||||||
|
Dump(PadLeftInt(ComPortSpeed,5));
|
||||||
|
Dump(AOnOff((ComPortSpeed = 0),'Local',PadLeftInt(ComPortSpeed,5)));
|
||||||
|
BlockWrite(DoorFile,UserNum,2);
|
||||||
|
Dump(PadLeftStr(Copy(UN,1,Pos(' ',UN) - 1),15));
|
||||||
|
Dump(PadLeftStr('PASSWORD',12));
|
||||||
|
i := 0;
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
Dump('00:00');
|
||||||
|
i := General.TimeAllow[ThisUser.SL];
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
i := General.DLKOneDay[ThisUser.SL];
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
Dump(#0#0#0#0#0#0);
|
||||||
|
Dump(Copy(S,1,5));
|
||||||
|
i := 0;
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
Dump(' ');
|
||||||
|
Dump(PadLeftStr(UN,25));
|
||||||
|
i := (NSL DIV 60);
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
Dump(Chr(ThisNode)+'00:00');
|
||||||
|
Dump(AOnOff(FALSE,'-1',' 0'));
|
||||||
|
Dump(AOnOff(FALSE,'-1',' 0'));
|
||||||
|
Dump(#0#0#0#0);
|
||||||
|
S := AOnOff((ComPortSpeed = 0),'0',IntToStr(Liner.Comport));
|
||||||
|
S := S[1]+#0#0;
|
||||||
|
IF (OkANSI OR OKAvatar) THEN
|
||||||
|
S := S + #1
|
||||||
|
ELSE
|
||||||
|
S := S + #0;
|
||||||
|
Dump(S);
|
||||||
|
Dump(DateStr);
|
||||||
|
i := 0;
|
||||||
|
BlockWrite(DoorFile,i,2);
|
||||||
|
Dump(#0#0#0#0#0#0#0#0#0#0);
|
||||||
|
Close(DoorFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
Node name The name of the system.
|
||||||
|
Sysop f.name The sysop's name up to the first space.
|
||||||
|
Sysop l.name The sysop's name following the first space.
|
||||||
|
Com port The serial port the modem is connected to, or 0 if logged in on console.
|
||||||
|
Baud rate The current port (DTE) rate.
|
||||||
|
Networked The number "0"
|
||||||
|
User's first name The current user's name, up to the first space.
|
||||||
|
User's last name The current user's name, following the first space.
|
||||||
|
City Where the user lives, or a blank line if unknown.
|
||||||
|
Terminal type The number "0" if TTY, or "1" if ANSI.
|
||||||
|
Security level The number 5 for problem users, 30 for regular users, 80 for Aides, and 100 for Sysops.
|
||||||
|
Minutes remaining The number of minutes left in the current user's account, limited to 546 to keep from
|
||||||
|
overflowing other software.
|
||||||
|
FOSSIL The number "-1" if using an external serial driver or "0" if using internal serial routines.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Write_DorInfo1_Def(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: Text;
|
||||||
|
First,
|
||||||
|
Last: AStr;
|
||||||
|
BEGIN
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'DORINFO1.DEF');
|
||||||
|
ReWrite(DoorFile);
|
||||||
|
WriteLn(DoorFile,StripColor(General.BBSName));
|
||||||
|
|
||||||
|
First := Copy(General.SysOpName,1,(Pos(' ',General.SysOpName) - 1));
|
||||||
|
Last := SQOutSp(Copy(General.SysOpName,(Length(First) + 1),Length(General.SysOpName)));
|
||||||
|
WriteLn(DoorFile,First);
|
||||||
|
WriteLn(DoorFile,Last);
|
||||||
|
|
||||||
|
WriteLn(DoorFile,'COM'+AOnOff((ComPortSpeed = 0),'0',IntToStr(Liner.Comport)));
|
||||||
|
WriteLn(DoorFile,IntToStr(ComPortSpeed)+' BAUD,N,8,1');
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
|
||||||
|
ShowUserName(RName,First,Last);
|
||||||
|
|
||||||
|
WriteLn(DoorFile,AllCaps(First));
|
||||||
|
WriteLn(DoorFile,AllCaps(Last));
|
||||||
|
|
||||||
|
WriteLn(DoorFile,ThisUser.CityState);
|
||||||
|
WriteLn(DoorFile,AOnOff((OkANSI OR OKAvatar),'1','0'));
|
||||||
|
WriteLn(DoorFile,ThisUser.SL);
|
||||||
|
WriteLn(DoorFile,(NSL DIV 60));
|
||||||
|
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
|
||||||
|
Close(DoorFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
0 Line 1 : Comm type (0=local, 1=serial, 2=telnet)
|
||||||
|
0 Line 2 : Comm or socket handle
|
||||||
|
38400 Line 3 : Baud rate
|
||||||
|
Mystic 1.07 Line 4 : BBSID (software name and version)
|
||||||
|
1 Line 5 : User record position (1-based)
|
||||||
|
James Coyle Line 6 : User's real name
|
||||||
|
g00r00 Line 7 : User's handle/alias
|
||||||
|
255 Line 8 : User's security level
|
||||||
|
58 Line 9 : User's time left (in minutes)
|
||||||
|
1 Line 10: Emulation *See Below
|
||||||
|
1 Line 11: Current node number
|
||||||
|
|
||||||
|
* The following are values we've predefined for the emulation:
|
||||||
|
|
||||||
|
0 = Ascii
|
||||||
|
1 = Ansi
|
||||||
|
2 = Avatar
|
||||||
|
3 = RIP
|
||||||
|
4 = Max Graphics { Not Used by RG }
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Write_Door32_Sys(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: Text;
|
||||||
|
|
||||||
|
FUNCTION ShowSpeed: AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (TelNet) THEN
|
||||||
|
ShowSpeed := '2'
|
||||||
|
ELSE IF (ComportSpeed <> 0) THEN
|
||||||
|
ShowSpeed := '1'
|
||||||
|
ELSE
|
||||||
|
ShowSpeed := '0'
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ShowEmulation: AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (OkRIP) THEN
|
||||||
|
ShowEmulation := '3'
|
||||||
|
ELSE IF (OKAvatar) THEN
|
||||||
|
ShowEmulation := '2'
|
||||||
|
ELSE IF (OkANSI) THEN
|
||||||
|
ShowEmulation := '1'
|
||||||
|
ELSE
|
||||||
|
ShowEmulation := '0';
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'DOOR32.SYS');
|
||||||
|
ReWrite(DoorFile);
|
||||||
|
WriteLn(DoorFile,ShowSpeed);
|
||||||
|
WriteLn(DoorFile,SockHandle);
|
||||||
|
WriteLn(DoorFile,ComPortSpeed);
|
||||||
|
WriteLn(DoorFile,'Renegade BBS '+General.Version); (* Was General.BBSName *)
|
||||||
|
WriteLn(DoorFile,UserNum);
|
||||||
|
WriteLn(DoorFile,ThisUser.RealName);
|
||||||
|
WriteLn(DoorFile,AOnOff(RName,ThisUser.RealName,Caps(ThisUser.Name))); (* Was AllCaps Name and force real name missing *)
|
||||||
|
WriteLn(DoorFile,ThisUser.SL);
|
||||||
|
WriteLn(DoorFile,(NSL DIV 60));
|
||||||
|
WriteLn(DoorFile,ShowEmulation); (* Was "1" *)
|
||||||
|
WriteLn(DoorFile,ThisNode);
|
||||||
|
Close(DoorFile);
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
COM1: <-- Comm Port - COM0: = LOCAL MODE
|
||||||
|
2400 <-- Baud Rate - 300 to 38400
|
||||||
|
8 <-- Parity - 7 or 8
|
||||||
|
1 <-- Node Number - 1 to 99 (Default to 1)
|
||||||
|
19200 <-- DTE Rate. Actual BPS rate to use. (kg)
|
||||||
|
Y <-- Screen Display - Y=On N=Off (Default to Y)
|
||||||
|
Y <-- Printer Toggle - Y=On N=Off (Default to Y)
|
||||||
|
Y <-- Page Bell - Y=On N=Off (Default to Y)
|
||||||
|
Y <-- Caller Alarm - Y=On N=Off (Default to Y)
|
||||||
|
Rick Greer <-- User Full Name
|
||||||
|
Lewisville, Tx. <-- Calling From
|
||||||
|
214 221-7814 <-- Home Phone
|
||||||
|
214 221-7814 <-- Work/Data Phone
|
||||||
|
PASSWORD <-- Password
|
||||||
|
110 *<-- Security Level
|
||||||
|
1456 <-- Total Times On
|
||||||
|
03/14/88 <-- Last Date Called
|
||||||
|
7560 <-- Seconds Remaining THIS call (for those that particular)
|
||||||
|
126 <-- Minutes Remaining THIS call
|
||||||
|
GR <-- Graphics Mode - GR=Graph, NG=Non-Graph, 7E=7,E Caller
|
||||||
|
23 <-- Page Length
|
||||||
|
Y <-- User Mode - Y = Expert, N = Novice
|
||||||
|
1,2,3,4,5,6,7 <-- Conferences/Forums Registered In (ABCDEFG)
|
||||||
|
7 <-- Conference Exited To \cf1\f1 DOOR\cf0 From (G)
|
||||||
|
01/01/99 <-- User Expiration Date (mm/dd/yy)
|
||||||
|
1 <-- User File's Record Number
|
||||||
|
Y <-- Default Protocol - X, C, Y, G, I, N, Etc.
|
||||||
|
0 *<-- Total Uploads
|
||||||
|
0 *<-- Total Downloads
|
||||||
|
0 *<-- Daily Download "K" Total
|
||||||
|
999999 <-- Daily Download Max. "K" Limit
|
||||||
|
10/22/88 <-- Caller's Birthdate (kg)
|
||||||
|
G:\\GAP\\MAIN <-- Path to the MAIN directory (where User File is) (kg)
|
||||||
|
G:\\GAP\\GEN <-- Path to the GEN directory (kg)
|
||||||
|
Michael <-- Sysop's Name (name \cf1 BBS\cf0 refers to Sysop as) (kg)
|
||||||
|
Stud <-- Alias name (rc)
|
||||||
|
00:05 <-- Event time (hh:mm) (rc)
|
||||||
|
Y <-- If its an error correcting connection (Y/N) (rc)
|
||||||
|
N <-- ANSI supported & caller using NG mode (Y/N) (rc)
|
||||||
|
Y <-- Use Record Locking (Y/N) (rc)
|
||||||
|
14 <-- \cf1 BBS\cf0 Default Color (Standard IBM color code, ie, 1-15) (rc)
|
||||||
|
10 *<-- Time Credits In Minutes (positive/negative) (rc)
|
||||||
|
07/07/90 <-- Last New \cf1 Files\cf0 Scan Date (mm/dd/yy) (rc)
|
||||||
|
14:32 <-- Time of This Call (hh:mm) (rc)
|
||||||
|
07:30 <-- Time of Last Call (hh:mm) (rc)
|
||||||
|
6 <-- Maximum daily \cf1 files\cf0 available (rc)
|
||||||
|
3 *<-- \cf1 Files\cf0 d/led so far today (rc)
|
||||||
|
23456 *<-- Total "K" Bytes Uploaded (rc)
|
||||||
|
76329 *<-- Total "K" Bytes Downloaded (rc)
|
||||||
|
A File Sucker <-- User Comment (rc)
|
||||||
|
10 <-- Total Doors Opened (rc)
|
||||||
|
10283 <-- Total Messages Left (rc)
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Write_Door_Sys(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: Text;
|
||||||
|
|
||||||
|
FUNCTION ShowEmulation: AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (OkRIP) THEN
|
||||||
|
ShowEmulation := 'RIP'
|
||||||
|
ELSE IF (OkANSI OR OKAvatar) THEN
|
||||||
|
ShowEmulation := 'GR'
|
||||||
|
ELSE
|
||||||
|
ShowEmulation := 'NG';
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'DOOR.SYS');
|
||||||
|
ReWrite(DoorFile);
|
||||||
|
WriteLn(DoorFile,'COM'+AOnOff((ComPortSpeed = 0),'0',IntToStr(Liner.Comport))+':');
|
||||||
|
WriteLn(DoorFile,ActualSpeed);
|
||||||
|
WriteLn(DoorFile,'8');
|
||||||
|
WriteLn(DoorFile,ThisNode);
|
||||||
|
WriteLn(DoorFile,ComPortSpeed);
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(WantOut),1,1));
|
||||||
|
WriteLn(DoorFile,'N');
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(SysOpAvailable),1,1));
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(Alert IN ThisUser.Flags),1,1));
|
||||||
|
WriteLn(DoorFile,AOnOff(RName,ThisUser.RealName,Caps(ThisUser.Name))); (* ThisUser.Name Was All Caps *)
|
||||||
|
WriteLn(DoorFile,ThisUser.CityState);
|
||||||
|
WriteLn(DoorFile,Copy(ThisUser.Ph,1,3)+' '+Copy(ThisUser.Ph,5,8));
|
||||||
|
WriteLn(DoorFile,Copy(ThisUser.Ph,1,3)+' '+Copy(ThisUser.Ph,5,8));
|
||||||
|
WriteLn(DoorFile,'PASSWORD');
|
||||||
|
WriteLn(DoorFile,ThisUser.SL);
|
||||||
|
WriteLn(DoorFile,ThisUser.LoggedOn);
|
||||||
|
WriteLn(DoorFile,DoorToDate8(PD2Date(ThisUser.LastOn))); (* Used - vice / for separator *)
|
||||||
|
WriteLn(DoorFile,NSL);
|
||||||
|
WriteLn(DoorFile,(NSL DIV 60));
|
||||||
|
WriteLn(DoorFile,ShowEmulation);
|
||||||
|
WriteLn(DoorFile,ThisUser.PageLen);
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(Novice IN ThisUser.Flags),1,1));
|
||||||
|
WriteLn(DoorFile,ShowConferences); (* Was AR Flags *)
|
||||||
|
WriteLn(DoorFile,ThisUser.LastConf); (* Was 7 *)
|
||||||
|
WriteLn(DoorFile,DoorToDate8(PD2Date(ThisUser.Expiration))); (* Was 12/31/99 *)
|
||||||
|
WriteLn(DoorFile,UserNum);
|
||||||
|
WriteLn(DoorFile,'Z');
|
||||||
|
WriteLn(DoorFile,ThisUser.Uploads);
|
||||||
|
WriteLn(DoorFile,ThisUser.Downloads);
|
||||||
|
WriteLn(DoorFile,ThisUser.DLKToday);
|
||||||
|
WriteLn(DoorFile,General.DLKOneDay[ThisUser.SL]); (* Was 999999 *)
|
||||||
|
WriteLn(DoorFile,DoorToDate8(PD2Date(ThisUser.BirthDate))); (* Used - vice / for separator *)
|
||||||
|
WriteLn(DoorFile,General.DataPath); (* Was "\" *)
|
||||||
|
WriteLn(DoorFile,General.DataPath); (* Was "\" *)
|
||||||
|
WriteLn(DoorFile,General.SysOpName);
|
||||||
|
WriteLn(DoorFile,Caps(ThisUser.Name));
|
||||||
|
|
||||||
|
(* Fix - Event Time *)
|
||||||
|
WriteLn(DoorFile,'00:00');
|
||||||
|
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(Reliable),1,1));
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(ANSIDetected AND (ShowEmulation = 'NG')),1,1)); (* Was 'N'*)
|
||||||
|
WriteLn(DoorFile,Copy(ShowYesNo(General.MultiNode),1,1));
|
||||||
|
|
||||||
|
(* Fix - Default User Color *)
|
||||||
|
WriteLn(DoorFile,'3');
|
||||||
|
|
||||||
|
(* Fix - Time Credits In Minutes (Positive/Negative *)
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
|
||||||
|
WriteLn(DoorFile,DoorToDate8(PD2Date(NewFileDate))); (* Used - vice / for separator *)
|
||||||
|
WriteLn(DoorFile,PD2Time24(TimeOn)); (* Was TimeStr *)
|
||||||
|
WriteLn(DoorFile,PD2Time24(ThisUser.LastOn)); (* Was 00:00 *)
|
||||||
|
WriteLn(DoorFile,General.DLOneDay[ThisUser.SL]);
|
||||||
|
WriteLn(DoorFile,ThisUser.DLToday);
|
||||||
|
WriteLn(DoorFile,ThisUser.UK);
|
||||||
|
WriteLn(DoorFile,ThisUser.DK);
|
||||||
|
WriteLn(DoorFile,ThisUser.Note);
|
||||||
|
|
||||||
|
(* Fix - Total Doors Opened *)
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
|
||||||
|
(* Fix - Total Messages Left *)
|
||||||
|
WriteLn(DoorFile,'0'); (* Was 10 *)
|
||||||
|
|
||||||
|
Close(DoorFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
1 User number
|
||||||
|
MRBILL User alias
|
||||||
|
Bill User real name
|
||||||
|
User callsign (HAM radio)
|
||||||
|
21 User age
|
||||||
|
M User sex
|
||||||
|
16097.00 User gold
|
||||||
|
05/19/89 User last logon date
|
||||||
|
80 User colums
|
||||||
|
25 User width
|
||||||
|
255 User security level (0-255)
|
||||||
|
1 1 if Co-SysOp, 0 if not
|
||||||
|
1 1 if SysOp, 0 if not
|
||||||
|
1 1 if ANSI, 0 if not
|
||||||
|
0 1 if at remote, 0 if local console
|
||||||
|
2225.78 User number of seconds left till logoff
|
||||||
|
F:\WWIV\GFILES\ System GFILES directory (gen. txt files)
|
||||||
|
F:\WWIV\DATA\ System DATA directory
|
||||||
|
890519.LOG System log of the day
|
||||||
|
2400 User baud rate
|
||||||
|
2 System com port
|
||||||
|
MrBill's Abode (the original) System name
|
||||||
|
The incredible inedible MrBill System SysOp
|
||||||
|
83680 Time user logged on/# of secs. from midn.
|
||||||
|
554 User number of seconds on system so far
|
||||||
|
5050 User number of uploaded k
|
||||||
|
22 User number of uploads
|
||||||
|
42 User amount of downloaded k
|
||||||
|
1 User number of downloads
|
||||||
|
8N1 User parity
|
||||||
|
2400 Com port baud rate
|
||||||
|
7400 WWIVnet node number
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Write_Chain_Txt(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: Text;
|
||||||
|
TUsed: LongInt;
|
||||||
|
BEGIN
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'CHAIN.TXT');
|
||||||
|
ReWrite(DoorFile);
|
||||||
|
WriteLn(DoorFile,UserNum);
|
||||||
|
WriteLn(DoorFile,AOnOff(RName,ThisUser.RealName,Caps(ThisUser.Name))); (* Was AllCaps Name and force real name missing *)
|
||||||
|
WriteLn(DoorFile,ThisUser.RealName);
|
||||||
|
WriteLn(DoorFile,'');
|
||||||
|
WriteLn(DoorFile,AgeUser(ThisUser.BirthDate));
|
||||||
|
WriteLn(DoorFile,ThisUser.Sex);
|
||||||
|
|
||||||
|
(* What is gold ??? *)
|
||||||
|
WriteLn(DoorFile,'00.00');
|
||||||
|
|
||||||
|
WriteLn(DoorFile,DoorToDate8(PD2Date(ThisUser.LastOn))); (* Used "-" vice "/" *)
|
||||||
|
WriteLn(DoorFile,ThisUser.LineLen);
|
||||||
|
WriteLn(DoorFile,ThisUser.PageLen);
|
||||||
|
WriteLn(DoorFile,ThisUser.SL);
|
||||||
|
WriteLn(DoorFile,AOnOff(CoSysOp,'1','0')); (* Was Sysop *)
|
||||||
|
WriteLn(DoorFile,AOnOff(SysOp,'1','0')); (* Was CoSysOp *)
|
||||||
|
WriteLn(DoorFile,AOnOff((OkANSI OR OKAvatar),'1','0'));
|
||||||
|
WriteLn(DoorFile,AOnOff(InCom,'1','0'));
|
||||||
|
WriteLn(DoorFile,NSL);
|
||||||
|
WriteLn(DoorFile,General.DataPath);
|
||||||
|
WriteLn(DoorFile,General.DataPath);
|
||||||
|
WriteLn(DoorFile,General.LogsPath+'SYSOP.LOG'); (* Was missing path to the LOG *)
|
||||||
|
WriteLn(DoorFile,ComPortSpeed);
|
||||||
|
WriteLn(DoorFile,AOnOff((ComportSpeed = 0),'0',IntToStr(Liner.ComPort))); (* Was Liner.ComPort *)
|
||||||
|
WriteLn(DoorFile,StripColor(General.BBSName));
|
||||||
|
WriteLn(DoorFile,General.SysOpName);
|
||||||
|
|
||||||
|
(* Fix - Time user logged on/# of secs. from midnight *)
|
||||||
|
WriteLn(DoorFile,(GetPackDateTime - TimeOn));
|
||||||
|
|
||||||
|
(* Fix - User number of seconds on system so far *)
|
||||||
|
WriteLn(DoorFile,TUsed);
|
||||||
|
|
||||||
|
WriteLn(DoorFile,ThisUser.UK);
|
||||||
|
WriteLn(DoorFile,ThisUser.Uploads);
|
||||||
|
WriteLn(DoorFile,ThisUser.DK);
|
||||||
|
WriteLn(DoorFile,ThisUser.Downloads);
|
||||||
|
WriteLn(DoorFile,'8N1');
|
||||||
|
|
||||||
|
(* Fix - Com port baud rate *)
|
||||||
|
WriteLn(DoorFile,''); (* Line was missing *)
|
||||||
|
|
||||||
|
WriteLn(DoorFile,'0'); (* Line was missing *)
|
||||||
|
Close(DoorFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
|
||||||
|
User's Name The name of the currently logged in user, with all color codes removed.
|
||||||
|
Speed The number 0 for 2400 baud, 1 for 300 baud, 2 for 1200 baud, 3 for 9600 baud, or 5 for console or
|
||||||
|
other speed.
|
||||||
|
City The last line of the user's mailing address that has data in it, or blank if no lines have data.
|
||||||
|
Security Level The number 5 for problem users, 30 for normal users, 80 for Aides, and 100 for Sysops.
|
||||||
|
Time left The time left in the user's accounts, in minutes. In an attempt to keep from overflowing other
|
||||||
|
software's limits, no value larger than 546 minutes is written.
|
||||||
|
ANSI Color The word "COLOR" if the current user has ANSI color enabled or "MONO" if he does not.
|
||||||
|
Password The current user's password (but not initials).
|
||||||
|
Userlog Number The current user's slot in LOG.DAT. (Not that this means anything to Citadel.)
|
||||||
|
Time used The number of minutes this call has lasted. If there is no user logged in, the number 0.
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "01:23".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "01:23 01/02/90".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "ABCDEFGH".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "0".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "99".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "0".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "9999".
|
||||||
|
Phone number The current user's phone number.
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "01/01/90 02:34".
|
||||||
|
Expert The word "EXPERT" if helpful hints are turned off or "NOVICE" if they are on.
|
||||||
|
File transfer protocol The name of the user's default file transfer protocol, or a blank line if none is specified.
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "01/01/90".
|
||||||
|
Times on The number of times the current user has logged onto the system.
|
||||||
|
Lines per screen The number of lines per screen, or 0 if the current user has screen pause turned off.
|
||||||
|
Last message read The new message pointer for the current room.
|
||||||
|
Total uploads The total number of files the user has uploaded.
|
||||||
|
Total downloads The total number of files the user has downloaded.
|
||||||
|
Excessively Stupid!!! The text "8 { Databits }". (There are two spaces between the "8" and the "{".)
|
||||||
|
User's location The text "LOCAL if logged in on console, or "REMOTE" if logged in over the modem.
|
||||||
|
Port The text "COM" followed by the serial port number of the modem. (For example, "COM1" if the modem is
|
||||||
|
on the first serial port.)
|
||||||
|
Speed The number 0 for 2400 baud, 1 for 300 baud, 2 for 1200 baud, 3 for 9600 baud, or 5 for other speed.
|
||||||
|
No attention is paid to whether the user is on console or not.
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "FALSE".
|
||||||
|
Another stupid thing The text "Normal Connection".
|
||||||
|
Unknown Citadel writes nothing out. Our information lists this field as being "01/02/94 01:20".
|
||||||
|
Task number Citadel writes the number 0.
|
||||||
|
Door number Citadel writes the number 1.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Write_CallInfo_BBS(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: Text;
|
||||||
|
|
||||||
|
FUNCTION ShowSpeed: AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (ComPortSpeed = 300) THEN
|
||||||
|
ShowSpeed := '1'
|
||||||
|
ELSE IF (ComPortSpeed = 1200) THEN
|
||||||
|
ShowSpeed := '2'
|
||||||
|
ELSE IF (ComPortSpeed = 2400) THEN
|
||||||
|
ShowSpeed := '0'
|
||||||
|
ELSE IF (ComPortSpeed = 9600) THEN
|
||||||
|
ShowSpeed := '3'
|
||||||
|
ELSE IF (ComPortSpeed = 0) THEN
|
||||||
|
ShowSpeed := '5'
|
||||||
|
ELSE
|
||||||
|
ShowSpeed := '4';
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'CALLINFO.BBS');
|
||||||
|
ReWrite(DoorFile);
|
||||||
|
WITH ThisUser DO
|
||||||
|
BEGIN
|
||||||
|
WriteLn(DoorFile,AOnOff(RName,AllCaps(ThisUser.RealName),AllCaps(ThisUser.Name)));
|
||||||
|
WriteLn(DoorFile,ShowSpeed);
|
||||||
|
WriteLn(DoorFile,AllCaps(ThisUser.CityState));
|
||||||
|
WriteLn(DoorFile,ThisUser.SL);
|
||||||
|
WriteLn(DoorFile,NSL DIV 60);
|
||||||
|
WriteLn(DoorFile,AOnOff((OkANSI OR OKAvatar),'COLOR','MONO'));
|
||||||
|
WriteLn(DoorFile,'PASSWORD');
|
||||||
|
WriteLn(DoorFile,UserNum);
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
WriteLn(DoorFile,Copy(TimeStr,1,5));
|
||||||
|
WriteLn(DoorFile,Copy(TimeStr,1,5)+' '+DateStr);
|
||||||
|
WriteLn(DoorFile,'A');
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
WriteLn(DoorFile,'999999');
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
WriteLn(DoorFile,'999999');
|
||||||
|
WriteLn(DoorFile,ThisUser.Ph);
|
||||||
|
WriteLn(DoorFile,ToDate8(PD2Date(ThisUser.LastOn))+' 00:00');
|
||||||
|
WriteLn(DoorFile,AOnOff((Novice IN ThisUser.Flags),'NOVICE','EXPERT'));
|
||||||
|
WriteLn(DoorFile,'All');
|
||||||
|
WriteLn(DoorFile,'01/01/80');
|
||||||
|
WriteLn(DoorFile,ThisUser.LoggedOn);
|
||||||
|
WriteLn(DoorFile,ThisUser.PageLen);
|
||||||
|
WriteLn(DoorFile,'0');
|
||||||
|
WriteLn(DoorFile,ThisUser.Uploads);
|
||||||
|
WriteLn(DoorFile,ThisUser.Downloads);
|
||||||
|
WriteLn(DoorFile,'8 { Databits }');
|
||||||
|
WriteLn(DoorFile,AOnOff((InCom OR OutCom),'REMOTE','LOCAL'));
|
||||||
|
WriteLn(DoorFile,'COM'+AOnOff((InCom OR OutCom),IntToStr(Liner.Comport),'0'));
|
||||||
|
WriteLn(DoorFile,PD2Date(ThisUser.BirthDate));
|
||||||
|
WriteLn(DoorFile,ComPortSpeed);
|
||||||
|
WriteLn(DoorFile,AOnOff((InCom OR OutCom),'TRUE','FALSE'));
|
||||||
|
WriteLn(DoorFile,AOnOff(Reliable,'MNP/ARQ','Normal')+' Connection');
|
||||||
|
WriteLn(DoorFile,'12/31/99 23:59');
|
||||||
|
WriteLn(DoorFile,ThisNode);
|
||||||
|
WriteLn(DoorFile,'1');
|
||||||
|
END;
|
||||||
|
Close(DoorFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Write_SFDoors_Dat(RName: Boolean);
|
||||||
|
VAR
|
||||||
|
DoorFile: Text;
|
||||||
|
S: AStr;
|
||||||
|
BEGIN
|
||||||
|
Assign(DoorFile,Liner.DoorPath+'SFDOORS.DAT');
|
||||||
|
ReWrite(DoorFile);
|
||||||
|
WriteLn(DoorFile,UserNum);
|
||||||
|
WriteLn(DoorFile,AOnOff(RName,AllCaps(ThisUser.RealName),AllCaps(ThisUser.Name)));
|
||||||
|
WriteLn(DoorFile,'PASSWORD');
|
||||||
|
IF (RName) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Pos(' ',ThisUser.RealName) = 0) THEN
|
||||||
|
S := ThisUser.RealName
|
||||||
|
ELSE
|
||||||
|
S := Copy(ThisUser.RealName,1,(Pos(' ',ThisUser.RealName) - 1));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Pos(' ',ThisUser.Name) = 0) THEN
|
||||||
|
S := ThisUser.Name
|
||||||
|
ELSE
|
||||||
|
S := Copy(ThisUser.Name,1,(Pos(' ',ThisUser.Name) - 1));
|
||||||
|
END;
|
||||||
|
WriteLn(DoorFile,S);
|
||||||
|
WriteLn(DoorFile,ComPortSpeed);
|
||||||
|
WriteLn(DoorFile,AOnOff((ComPortSpeed = 0),'0',IntToStr(Liner.Comport)));
|
||||||
|
WriteLn(DoorFile,NSL DIV 60);
|
||||||
|
WriteLn(DoorFile,Timer); { seconds since midnight }
|
||||||
|
WriteLn(DoorFile,StartDir);
|
||||||
|
WriteLn(DoorFile,AOnOff((OkANSI OR OKAvatar),'TRUE','FALSE'));
|
||||||
|
WriteLn(DoorFile,ThisUser.SL);
|
||||||
|
WriteLn(DoorFile,ThisUser.Uploads);
|
||||||
|
WriteLn(DoorFile,ThisUser.Downloads);
|
||||||
|
WriteLn(DoorFile,General.TimeAllow[ThisUser.SL]);
|
||||||
|
WriteLn(DoorFile,'0'); { time on (seconds) }
|
||||||
|
WriteLn(DoorFile,'0'); { extra time (seconds) }
|
||||||
|
WriteLn(DoorFile,'FALSE');
|
||||||
|
WriteLn(DoorFile,'FALSE');
|
||||||
|
WriteLn(DoorFile,'FALSE');
|
||||||
|
WriteLn(DoorFile,Liner.InitBaud);
|
||||||
|
WriteLn(DoorFile,AOnOff(Reliable,'TRUE','FALSE'));
|
||||||
|
WriteLn(DoorFile,'A');
|
||||||
|
WriteLn(DoorFile,'A');
|
||||||
|
WriteLn(DoorFile,ThisNode);
|
||||||
|
WriteLn(DoorFile,General.DLOneDay[ThisUser.SL]);
|
||||||
|
WriteLn(DoorFile,ThisUser.DLToday);
|
||||||
|
WriteLn(DoorFile,General.DLKOneDay[ThisUser.SL]);
|
||||||
|
WriteLn(DoorFile,ThisUser.DLKToday);
|
||||||
|
WriteLn(DoorFile,ThisUser.UK);
|
||||||
|
WriteLn(DoorFile,ThisUser.DK);
|
||||||
|
WriteLn(DoorFile,ThisUser.Ph);
|
||||||
|
WriteLn(DoorFile,ThisUser.CityState);
|
||||||
|
WriteLn(DoorFile,General.TimeAllow[ThisUser.SL]);
|
||||||
|
Close(DoorFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DoDoorFunc(DropFileType: Char; MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Answer: AStr;
|
||||||
|
ReturnCode: Integer;
|
||||||
|
DoorTime: LongInt;
|
||||||
|
UseRealName: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (MenuOption = '') AND (InCom) THEN
|
||||||
|
Exit;
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
UseRealName := FALSE;
|
||||||
|
IF (Copy(AllCaps(MenuOption),1,2) = 'R;') THEN
|
||||||
|
BEGIN
|
||||||
|
UseRealName := TRUE;
|
||||||
|
MenuOption := Copy(MenuOption,3,(Length(MenuOption) - 2));
|
||||||
|
END;
|
||||||
|
Answer := FunctionalMCI(MenuOption,'','');
|
||||||
|
CASE DropFileType OF
|
||||||
|
'3' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting DOOR32.SYS ...',FALSE,Answer);
|
||||||
|
Write_Door32_Sys(UseRealName);
|
||||||
|
END;
|
||||||
|
'P' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting PCBOARD.SYS ...',FALSE,Answer);
|
||||||
|
Write_PCBoard_Sys(UseRealName);
|
||||||
|
END;
|
||||||
|
'C' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting CHAIN.TXT ...',FALSE,Answer);
|
||||||
|
Write_Chain_Txt(UseRealName);
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting DORINFO1.DEF ...',FALSE,Answer);
|
||||||
|
Write_DorInfo1_Def(UseRealName);
|
||||||
|
END;
|
||||||
|
'G' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting DOOR.SYS ...',FALSE,Answer);
|
||||||
|
Write_Door_Sys(UseRealName);
|
||||||
|
END;
|
||||||
|
'S' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting SFDOORS.DAT ...',FALSE,Answer);
|
||||||
|
Write_SFDoors_Dat(UseRealName);
|
||||||
|
END;
|
||||||
|
'W' : BEGIN
|
||||||
|
lStatus_Screen(100,'Outputting CALLINFO.BBS ...',FALSE,Answer);
|
||||||
|
Write_CallInfo_BBS(UseRealName);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Answer = '') THEN
|
||||||
|
Exit;
|
||||||
|
Shel('Running "'+Answer+'"');
|
||||||
|
SysOpLog('Opened door '+Answer+' on '+DateStr+' at '+TimeStr);
|
||||||
|
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
SaveNAvail := (NAvail IN NodeR.Status);
|
||||||
|
Exclude(NodeR.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
|
||||||
|
DoorTime := GetPackDateTime;
|
||||||
|
ShellDos(FALSE,Answer,ReturnCode);
|
||||||
|
DoorTime := (GetPackDateTime - DoorTime);
|
||||||
|
Shel2(FALSE);
|
||||||
|
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
IF (SaveNAvail) THEN
|
||||||
|
Include(NodeR.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
|
||||||
|
NewCompTables;
|
||||||
|
SaveGeneral(TRUE);
|
||||||
|
LoadURec(ThisUser,UserNum);
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
LoadMsgArea(MsgArea);
|
||||||
|
ChDir(StartDir);
|
||||||
|
Com_Flush_Recv;
|
||||||
|
SysOpLog('Returned on '+DateStr+' at '+TimeStr+'. Spent '+FormattedTime(DoorTime));
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,258 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Events;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
FUNCTION InTime(Tim,Tim1,Tim2: LongInt): Boolean;
|
||||||
|
FUNCTION CheckPreEventTime(EventNum: Integer; T: LongInt): Boolean;
|
||||||
|
FUNCTION CheckEventTime(EventNum: Integer; T: LongInt): Boolean;
|
||||||
|
FUNCTION CheckEvents(T: LongInt): Integer;
|
||||||
|
FUNCTION SysOpAvailable: Boolean;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common,
|
||||||
|
TimeFunc
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
,Windows
|
||||||
|
{$ENDIF}
|
||||||
|
;
|
||||||
|
|
||||||
|
FUNCTION InTime(Tim,Tim1,Tim2: LongInt): Boolean;
|
||||||
|
BEGIN
|
||||||
|
InTime := TRUE;
|
||||||
|
WHILE (Tim >= 86400) DO
|
||||||
|
Dec(Tim,86400);
|
||||||
|
IF (Tim1 <> Tim2) THEN
|
||||||
|
IF (Tim2 > Tim1) THEN
|
||||||
|
IF (Tim <= (Tim1 * 60)) OR (Tim >= (Tim2 * 60)) THEN
|
||||||
|
InTime := FALSE
|
||||||
|
ELSE
|
||||||
|
ELSE
|
||||||
|
IF (Tim <= (Tim1 * 60)) AND (Tim >= (Tim2 * 60)) THEN
|
||||||
|
InTime := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
function checkeventday(i:integer; t:longint):boolean;
|
||||||
|
var
|
||||||
|
year,month,day,dayofweek:word;
|
||||||
|
e:integer;
|
||||||
|
begin
|
||||||
|
e := 0;
|
||||||
|
checkeventday := FALSE;
|
||||||
|
if not events[i]^.active then
|
||||||
|
exit;
|
||||||
|
with events[i]^ do
|
||||||
|
begin
|
||||||
|
getdate(year,month,day,dayofweek);
|
||||||
|
if (timer + t >= 86400.0) then
|
||||||
|
begin
|
||||||
|
inc(dayofweek);
|
||||||
|
e := 1;
|
||||||
|
if (dayofweek > 6) then
|
||||||
|
dayofweek := 0;
|
||||||
|
end;
|
||||||
|
if (monthly) then
|
||||||
|
begin
|
||||||
|
if (value(copy(date,4,2)) + e = execdays) then
|
||||||
|
checkeventday := TRUE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
e := 1 shl (dayofweek + 1);
|
||||||
|
if (execdays and e = e) then
|
||||||
|
checkeventday:=TRUE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
|
||||||
|
FUNCTION lCheckEventDay(EventNum: Integer; T: LongInt): Boolean;
|
||||||
|
VAR
|
||||||
|
DayOfWeek,
|
||||||
|
Day: Byte;
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
lCheckEventDay := FALSE;
|
||||||
|
WITH MemEventArray[EventNum]^ DO
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (EventIsActive IN EFlags)) THEN
|
||||||
|
Exit;
|
||||||
|
Day := 0;
|
||||||
|
GetDayOfWeek(DayOfWeek);
|
||||||
|
IF ((Timer + T) >= 86400) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(DayOfWeek);
|
||||||
|
IF (DayOfWeek > 6) THEN
|
||||||
|
DayOfWeek := 0;
|
||||||
|
Day := 1;
|
||||||
|
END;
|
||||||
|
IF (EventIsMonthly IN EFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((StrToInt(Copy(DateStr,4,2)) + Day) = MemEventArray[EventNum]^.EventDayOfMonth) THEN
|
||||||
|
lCheckEventDay := TRUE;
|
||||||
|
END
|
||||||
|
ELSE IF (DayOfWeek IN EventDays) THEN
|
||||||
|
lCheckEventDay := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
function checkpreeventtime(i:integer; t:longint):boolean;
|
||||||
|
begin
|
||||||
|
with events[i]^ do
|
||||||
|
if (offhooktime = 0) or
|
||||||
|
(durationorlastday=daynum(date)) or
|
||||||
|
((Enode > 0) and (Enode <> node)) or
|
||||||
|
(not events[i]^.active) or not
|
||||||
|
(checkeventday(i,t)) then
|
||||||
|
checkpreeventtime:=FALSE
|
||||||
|
else
|
||||||
|
checkpreeventtime:=intime(timer+t,exectime-offhooktime,exectime);
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
|
||||||
|
FUNCTION CheckPreEventTime(EventNum: Integer; T: LongInt): Boolean;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
WITH MemEventArray[EventNum]^ DO
|
||||||
|
IF (NOT (EventIsActive IN EFlags)) OR
|
||||||
|
(EventPreTime = 0) OR
|
||||||
|
(PD2Date(EventLastDate) = DateStr) OR
|
||||||
|
((EventNode > 0) AND (EventNode <> ThisNode)) OR
|
||||||
|
NOT (lCheckEventDay(EventNum,T)) THEN
|
||||||
|
CheckPreEventTime := FALSE
|
||||||
|
ELSE
|
||||||
|
CheckPreEventTime := InTime((Timer + T),(EventStartTime - EventPreTime),EventStartTime);
|
||||||
|
(*
|
||||||
|
checkpreeventtime := intime(timer + t,exectime-offhooktime,exectime);
|
||||||
|
*)
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
function checkeventtime(i:integer; t:longint):boolean;
|
||||||
|
begin
|
||||||
|
with events[i]^ do
|
||||||
|
if (durationorlastday=daynum(date)) or
|
||||||
|
((Enode > 0) and (Enode <> node)) or
|
||||||
|
(not events[i]^.active) or not
|
||||||
|
(checkeventday(i,t)) then
|
||||||
|
checkeventtime:=FALSE
|
||||||
|
else
|
||||||
|
if (etype in ['A','C']) then
|
||||||
|
checkeventtime:=intime(timer+t,exectime,exectime+durationorlastday)
|
||||||
|
else
|
||||||
|
if (missed) then
|
||||||
|
checkeventtime := (((timer + t) div 60) > exectime)
|
||||||
|
else
|
||||||
|
checkeventtime := (((timer + t) div 60) = exectime);
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
|
||||||
|
FUNCTION CheckEventTime(EventNum: Integer; T: LongInt): Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH MemEventArray[EventNum]^ DO
|
||||||
|
IF (PD2Date(EventLastDate) = DateStr) OR
|
||||||
|
((EventNode > 0) AND (EventNode <> ThisNode)) OR
|
||||||
|
(NOT (EventIsActive IN EFlags)) OR
|
||||||
|
NOT (lCheckEventDay(EventNum,T)) THEN
|
||||||
|
CheckEventTime := FALSE
|
||||||
|
ELSE
|
||||||
|
IF (EventIsLogon IN EFlags) OR (EventIsChat IN EFlags) THEN
|
||||||
|
CheckEventTime := InTime((Timer + T),EventStartTime,(EventStartTime + EventFinishTime))
|
||||||
|
(*
|
||||||
|
checkeventtime := intime(timer + t,exectime,exectime+durationorlastday)
|
||||||
|
*)
|
||||||
|
ELSE
|
||||||
|
IF (EventIsMissed IN EFlags) THEN
|
||||||
|
CheckEventTime := (((Timer + T) DIV 60) > EventStartTime)
|
||||||
|
ELSE
|
||||||
|
CheckEventTime := (((Timer + T) DIV 60) = EventStartTime);
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
function checkevents(t:longint):integer;
|
||||||
|
var i:integer;
|
||||||
|
begin
|
||||||
|
for i := 1 to numevents do
|
||||||
|
with events[i]^ do
|
||||||
|
if (active) and ((Enode = 0) or (Enode = node)) then
|
||||||
|
if (checkeventday(i,t)) then begin
|
||||||
|
if (softevent) and (not inwfcmenu) then
|
||||||
|
checkevents:=0
|
||||||
|
else
|
||||||
|
checkevents:=i;
|
||||||
|
if (checkpreeventtime(i,t)) or (checkeventtime(i,t)) then begin
|
||||||
|
if (etype in ['D','E','P']) then exit;
|
||||||
|
if ((etype='A') and (not aacs(execdata)) and (useron)) then exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
checkevents:=0;
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
|
||||||
|
FUNCTION CheckEvents(T: LongInt): Integer;
|
||||||
|
VAR
|
||||||
|
EventNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
FOR EventNum := 1 TO NumEvents DO
|
||||||
|
WITH MemEventArray[EventNum]^ DO
|
||||||
|
IF (EventIsActive IN EFlags) AND ((EventNode = 0) OR (EventNode = ThisNode)) THEN
|
||||||
|
IF (lCheckEventDay(EventNum,T)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (EventIsSoft IN EFlags) AND (NOT InWFCMenu) THEN
|
||||||
|
CheckEvents := 0
|
||||||
|
ELSE
|
||||||
|
CheckEvents := EventNum;
|
||||||
|
IF (CheckPreEventTime(EventNum,T)) OR (CheckEventTime(EventNum,T)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (EventIsExternal IN EFlags) THEN
|
||||||
|
IF (EventIsShell IN EFlags) OR
|
||||||
|
(EventIsErrorLevel IN EFlags) OR
|
||||||
|
(EventIsPackMsgAreas IN EFlags) OR
|
||||||
|
(EventIsSortFiles IN EFlags) OR
|
||||||
|
(EventIsFilesBBS IN EFlags) THEN
|
||||||
|
Exit;
|
||||||
|
IF ((EventIsLogon IN EFlags) AND (NOT AACS(EventACS)) AND (UserOn)) THEN
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
CheckEvents := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION SysOpAvailable: Boolean;
|
||||||
|
VAR
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
A: Byte ABSOLUTE $0000:$0417;
|
||||||
|
{$ENDIF}
|
||||||
|
EventNum: Integer;
|
||||||
|
ChatOk: Boolean;
|
||||||
|
BEGIN
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
ChatOk := ((A AND 16) = 0);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
// Availability is togged with scroll lock key
|
||||||
|
ChatOk := (GetKeyState($91) and $ffff) <> 0;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
IF (RChat IN ThisUser.Flags) THEN
|
||||||
|
ChatOk := FALSE;
|
||||||
|
|
||||||
|
FOR EventNum := 1 TO NumEvents DO
|
||||||
|
WITH MemEventArray[EventNum]^ DO
|
||||||
|
IF (EventIsActive IN EFlags) AND (EventIsChat IN EFlags) AND (CheckEventTime(EventNum,0)) THEN
|
||||||
|
ChatOk := TRUE;
|
||||||
|
|
||||||
|
SysOpAvailable := ChatOk;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,229 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT ExecBat;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
MyIO;
|
||||||
|
|
||||||
|
PROCEDURE ExecWindow(VAR Ok: Boolean;
|
||||||
|
CONST Dir,
|
||||||
|
BatLine: AStr;
|
||||||
|
OkLevel: Integer;
|
||||||
|
VAR RCode: Integer);
|
||||||
|
PROCEDURE ExecBatch(VAR Ok: Boolean;
|
||||||
|
Dir,
|
||||||
|
BatLine: AStr;
|
||||||
|
OkLevel: Integer;
|
||||||
|
VAR RCode: Integer;
|
||||||
|
Windowed: Boolean);
|
||||||
|
PROCEDURE Shel(CONST s: AStr);
|
||||||
|
PROCEDURE Shel2(x: Boolean);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
CurInt21: Pointer;
|
||||||
|
WindPos,
|
||||||
|
WindLo,
|
||||||
|
WindHi: Word;
|
||||||
|
WindAttr: Byte;
|
||||||
|
|
||||||
|
SaveX,
|
||||||
|
SaveY: Byte;
|
||||||
|
SavCurWind: Integer;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{$L EXECWIN}
|
||||||
|
|
||||||
|
PROCEDURE SetCsInts; EXTERNAL;
|
||||||
|
PROCEDURE NewInt21; EXTERNAL;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
PROCEDURE ExecWindow(VAR Ok: Boolean;
|
||||||
|
CONST Dir,
|
||||||
|
BatLine: AStr;
|
||||||
|
OkLevel: Integer;
|
||||||
|
VAR RCode: Integer);
|
||||||
|
VAR
|
||||||
|
SaveWindowOn: Boolean;
|
||||||
|
SaveCurWindow: Byte;
|
||||||
|
s: AStr;
|
||||||
|
|
||||||
|
{-Exec a program in a Window}
|
||||||
|
|
||||||
|
{$IFDEF Ver70}
|
||||||
|
VAR
|
||||||
|
TmpInt21 : Pointer;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveCurWindow := General.CurWindow;
|
||||||
|
SaveWindowOn := General.WindowOn;
|
||||||
|
General.WindowOn := TRUE;
|
||||||
|
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
SaveScreen(Wind);
|
||||||
|
|
||||||
|
ClrScr;
|
||||||
|
|
||||||
|
lStatus_Screen(1,'',FALSE,s);
|
||||||
|
|
||||||
|
{Store global copies of Window data for interrupt handler}
|
||||||
|
WindAttr := 7;
|
||||||
|
WindLo := WindMin;
|
||||||
|
WindHi := WindMax;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{Assure cursor is in Window}
|
||||||
|
INLINE
|
||||||
|
(
|
||||||
|
{;get cursor pos}
|
||||||
|
$B4/$03/ { mov ah,3}
|
||||||
|
$30/$FF/ { xor bh,bh}
|
||||||
|
$CD/$10/ { int $10}
|
||||||
|
{;assure it's within Window}
|
||||||
|
$8B/$0E/>WindLo/ { mov cx,[>windlo]}
|
||||||
|
$38/$EE/ { cmp dh,ch ;row above minimum?}
|
||||||
|
$73/$02/ { jae okxlo ;jump IF so}
|
||||||
|
$88/$EE/ { mov dh,ch}
|
||||||
|
{okxlo:}
|
||||||
|
$38/$CA/ { cmp dl,cl ;col above minimum?}
|
||||||
|
$73/$02/ { jae okylo ;jump IF so}
|
||||||
|
$88/$CA/ { mov dl,cl}
|
||||||
|
{okylo:}
|
||||||
|
$8B/$0E/>WindHi/ { mov cx,[>windhi]}
|
||||||
|
$38/$EE/ { cmp dh,ch ;row below maximum?}
|
||||||
|
$76/$02/ { jbe okxhi ;jump IF so}
|
||||||
|
$88/$EE/ { mov dh,ch}
|
||||||
|
{okxhi:}
|
||||||
|
$38/$CA/ { cmp dl,cl ;col below maximum?}
|
||||||
|
$76/$02/ { jbe okyhi ;jump IF so}
|
||||||
|
$88/$CA/ { mov dl,cl}
|
||||||
|
{okyhi:}
|
||||||
|
$89/$16/>WindPos/ { mov [>windpos],dx ;save current position}
|
||||||
|
{;position cursor}
|
||||||
|
$B4/$02/ { mov ah,2}
|
||||||
|
$30/$FF/ { xor bh,bh}
|
||||||
|
$CD/$10); { int $10}
|
||||||
|
|
||||||
|
{Take over interrupt}
|
||||||
|
GetIntVec($21,CurInt21);
|
||||||
|
SetCsInts;
|
||||||
|
SetIntVec($21,@NewInt21);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF Ver70}
|
||||||
|
{Prevent SwapVectors from undoing our int21 change}
|
||||||
|
TmpInt21 := SaveInt21;
|
||||||
|
SaveInt21 := @NewInt21;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{Exec the program}
|
||||||
|
ExecBatch(Ok,Dir,BatLine,OkLevel,RCode,TRUE);
|
||||||
|
|
||||||
|
{$IFDEF Ver70}
|
||||||
|
SaveInt21 := TmpInt21;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Window(1,1,MaxDisplayCols,MaxDisplayRows);
|
||||||
|
RemoveWindow(Wind);
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{Restore interrupt}
|
||||||
|
SetIntVec($21,CurInt21);
|
||||||
|
{$ENDIF}
|
||||||
|
General.CurWindow := SaveCurWindow;
|
||||||
|
General.WindowOn := SaveWindowOn;
|
||||||
|
LastScreenSwap := (Timer - 5);
|
||||||
|
lStatus_Screen(General.CurWindow,'',FALSE,s);
|
||||||
|
|
||||||
|
GoToXY(SaveX,SaveY);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ExecBatch(VAR Ok: Boolean; { result }
|
||||||
|
Dir: AStr; { directory takes place in }
|
||||||
|
BatLine: AStr; { .BAT file line to execute }
|
||||||
|
OkLevel: Integer; { DOS errorlevel for success }
|
||||||
|
VAR RCode: Integer; { errorlevel returned }
|
||||||
|
Windowed: Boolean); { Windowed? }
|
||||||
|
VAR
|
||||||
|
BatchFile: Text;
|
||||||
|
SaveDir: AStr;
|
||||||
|
BName: STRING[20];
|
||||||
|
BEGIN
|
||||||
|
BName := 'TEMP'+IntToStr(ThisNode)+'.BAT';
|
||||||
|
GetDir(0,SaveDir);
|
||||||
|
Dir := BSlash(FExpand(Dir),FALSE);
|
||||||
|
Assign(BatchFile,BName);
|
||||||
|
ReWrite(BatchFile);
|
||||||
|
WriteLn(BatchFile,'@ECHO OFF');
|
||||||
|
WriteLn(BatchFile,Chr(ExtractDriveNumber(Dir) + 64)+':');
|
||||||
|
IF (Dir <> '') THEN
|
||||||
|
WriteLn(BatchFile,'CD '+Dir);
|
||||||
|
IF (NOT WantOut) THEN
|
||||||
|
BatLine := BatLine + ' > NUL';
|
||||||
|
WriteLn(BatchFile,BatLine);
|
||||||
|
WriteLn(BatchFile,':DONE');
|
||||||
|
WriteLn(BatchFile,Chr(ExtractDriveNumber(SaveDir) + 64)+':');
|
||||||
|
WriteLn(BatchFile,'CD '+SaveDir);
|
||||||
|
WriteLn(BatchFile,'Exit');
|
||||||
|
Close(BatchFile);
|
||||||
|
|
||||||
|
IF (WantOut) AND (NOT Windowed) THEN
|
||||||
|
Shel(BatLine);
|
||||||
|
|
||||||
|
IF (NOT WantOut) THEN
|
||||||
|
BName := BName + ' > NUL';
|
||||||
|
|
||||||
|
ShellDOS(FALSE,BName,RCode);
|
||||||
|
|
||||||
|
Shel2(Windowed);
|
||||||
|
|
||||||
|
ChDir(SaveDir);
|
||||||
|
Kill(BName);
|
||||||
|
IF (OkLevel <> -1) THEN
|
||||||
|
Ok := (RCode = OkLevel)
|
||||||
|
ELSE
|
||||||
|
Ok := TRUE;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Shel(CONST s: AStr);
|
||||||
|
BEGIN
|
||||||
|
SavCurWind := General.CurWindow;
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
SetWindow(Wind,1,1,80,25,7,0,0);
|
||||||
|
ClrScr;
|
||||||
|
TextBackGround(1);
|
||||||
|
TextColor(15);
|
||||||
|
ClrEOL;
|
||||||
|
Write(s);
|
||||||
|
TextBackGround(0);
|
||||||
|
TextColor(7);
|
||||||
|
WriteLn;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Shel2(x: Boolean);
|
||||||
|
BEGIN
|
||||||
|
ClrScr;
|
||||||
|
RemoveWindow(Wind);
|
||||||
|
IF (x) THEN
|
||||||
|
Exit;
|
||||||
|
GoToXY(SaveX,SaveY);
|
||||||
|
LastScreenSwap := (Timer - 5);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,609 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File0;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION CompFileArea(FArea,ArrayNum: Integer): Integer;
|
||||||
|
FUNCTION GetCPS(TotalBytes,TransferTime: LongInt): LongInt;
|
||||||
|
PROCEDURE CountDown;
|
||||||
|
FUNCTION Align(CONST FName: Str12): Str12;
|
||||||
|
FUNCTION BadDownloadPath: Boolean;
|
||||||
|
FUNCTION BadUploadPath: Boolean;
|
||||||
|
PROCEDURE DisplayFileInfo(VAR F: FileInfoRecordType; Editing: Boolean);
|
||||||
|
FUNCTION FileAreaAC(FArea: Integer): Boolean;
|
||||||
|
PROCEDURE ChangeFileArea(FArea: Integer);
|
||||||
|
PROCEDURE LoadFileArea(FArea: Integer);
|
||||||
|
FUNCTION GetDirPath(MemFileArea: FileAreaRecordType): ASTR;
|
||||||
|
PROCEDURE LoadNewScanFile(VAR NewScanFile: Boolean);
|
||||||
|
PROCEDURE SaveNewScanFile(NewScanFile: Boolean);
|
||||||
|
PROCEDURE InitFileArea(FArea: Integer);
|
||||||
|
FUNCTION Fit(CONST FileName1,FileName2: Str12): Boolean;
|
||||||
|
PROCEDURE GetFileName(VAR FileName: Str12);
|
||||||
|
FUNCTION ISUL(CONST s: AStr): Boolean;
|
||||||
|
FUNCTION IsWildCard(CONST s: AStr): Boolean;
|
||||||
|
PROCEDURE NRecNo(FileInfo: FileInfoRecordType; VAR RN: Integer);
|
||||||
|
PROCEDURE LRecNo(Fileinfo: FileInfoRecordType; VAR RN: Integer);
|
||||||
|
PROCEDURE RecNo(FileInfo: FileInfoRecordType; FileName: Str12; VAR RN: Integer);
|
||||||
|
PROCEDURE LoadVerbArray(F: FileInfoRecordType; VAR ExtArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte);
|
||||||
|
PROCEDURE SaveVerbArray(VAR F: FileInfoRecordType; ExtArray: ExtendedDescriptionArray; NumExtDesc: Byte);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
File1,
|
||||||
|
ShortMsg,
|
||||||
|
TimeFunc
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
,Windows
|
||||||
|
{$ENDIF}
|
||||||
|
;
|
||||||
|
|
||||||
|
FUNCTION CompFileArea(FArea,ArrayNum: Integer): Integer;
|
||||||
|
VAR
|
||||||
|
FileCompArrayFile: FILE OF CompArrayType;
|
||||||
|
CompFileArray: CompArrayType;
|
||||||
|
BEGIN
|
||||||
|
Assign(FileCompArrayFile,TempDir+'FACT'+IntToStr(ThisNode)+'.DAT');
|
||||||
|
Reset(FileCompArrayFile);
|
||||||
|
Seek(FileCompArrayFile,(FArea - 1));
|
||||||
|
Read(FileCompArrayFile,CompFileArray);
|
||||||
|
Close(FileCompArrayFile);
|
||||||
|
CompFileArea := CompFileArray[ArrayNum];
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetCPS(TotalBytes,TransferTime: LongInt): LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (TransferTime > 0) THEN
|
||||||
|
GetCPS := (TotalBytes DIV TransferTime)
|
||||||
|
ELSE
|
||||||
|
GetCPS := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(* Done - 01/01/07 Lee Palmer *)
|
||||||
|
FUNCTION Align(CONST FName: Str12): Str12;
|
||||||
|
VAR
|
||||||
|
F: Str8;
|
||||||
|
E: Str3;
|
||||||
|
Counter,
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
Counter := Pos('.',FName);
|
||||||
|
IF (Counter = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
F := FName;
|
||||||
|
E := ' ';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
F := Copy(FName,1,(Counter - 1));
|
||||||
|
E := Copy(FName,(Counter + 1),3);
|
||||||
|
END;
|
||||||
|
F := PadLeftStr(F,8);
|
||||||
|
E := PadLeftStr(E,3);
|
||||||
|
Counter := Pos('*',F);
|
||||||
|
IF (Counter <> 0) THEN
|
||||||
|
FOR Counter1 := Counter TO 8 DO
|
||||||
|
F[Counter1] := '?';
|
||||||
|
Counter := Pos('*',E);
|
||||||
|
IF (Counter <> 0) THEN
|
||||||
|
FOR Counter1 := Counter TO 3 DO
|
||||||
|
E[Counter1] := '?';
|
||||||
|
Counter := Pos(' ',F);
|
||||||
|
IF (Counter <> 0) THEN
|
||||||
|
FOR Counter1 := Counter TO 8 DO
|
||||||
|
F[Counter1] := ' ';
|
||||||
|
Counter := Pos(' ',E);
|
||||||
|
IF (Counter <> 0) THEN
|
||||||
|
FOR Counter1 := Counter TO 3 DO
|
||||||
|
E[Counter1] := ' ';
|
||||||
|
Align := F+'.'+E;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BadDownloadPath: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (BadDLPath) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File area #'+IntToStr(FileArea)+': Unable to perform command.');
|
||||||
|
SysOpLog('^5Bad DL file path: "'+MemFileArea.DLPath+'".');
|
||||||
|
Print('^5Please inform the SysOp.');
|
||||||
|
SysOpLog('Invalid DL path (File Area #'+IntToStr(FileArea)+'): "'+MemFileArea.DLPath+'"');
|
||||||
|
END;
|
||||||
|
BadDownloadPath := BadDLPath;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BadUploadPath: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (BadULPath) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File area #'+IntToStr(FileArea)+': Unable to perform command.');
|
||||||
|
SysOpLog('^5Bad UL file path: "'+MemFileArea.Ulpath+'".');
|
||||||
|
Print('^5Please inform the SysOp.');
|
||||||
|
SysOpLog('Invalid UL path (File Area #'+IntToStr(FileArea)+'): "'+MemFileArea.Ulpath+'"');
|
||||||
|
END;
|
||||||
|
BadUploadPath := BadULPath;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION FileAreaAC(FArea: Integer): Boolean;
|
||||||
|
BEGIN
|
||||||
|
FileAreaAC := FALSE;
|
||||||
|
IF (FArea < 1) OR (FArea > NumFileAreas) THEN
|
||||||
|
Exit;
|
||||||
|
LoadFileArea(FArea);
|
||||||
|
FileAreaAC := AACS(MemFileArea.ACS);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChangeFileArea(FArea: Integer);
|
||||||
|
VAR
|
||||||
|
PW: Str20;
|
||||||
|
BEGIN
|
||||||
|
IF (FArea < 1) OR (FArea > NumFileAreas) OR (NOT FileAreaAC(FArea)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (MemFileArea.Password <> '') AND (NOT SortFilesOnly) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('File area: ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FArea,0))+'^1');
|
||||||
|
NL;
|
||||||
|
Prt('Password: ');
|
||||||
|
GetPassword(PW,20);
|
||||||
|
IF (PW <> MemFileArea.Password) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Incorrect password!^1');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
FileArea := FArea;
|
||||||
|
ThisUser.LastFileArea := FileArea;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LoadFileArea(FArea: Integer);
|
||||||
|
VAR
|
||||||
|
FO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (ReadFileArea = FArea) THEN
|
||||||
|
Exit;
|
||||||
|
IF (FArea < 1) THEN
|
||||||
|
Exit;
|
||||||
|
IF (FArea > NumFileAreas) THEN
|
||||||
|
BEGIN
|
||||||
|
MemFileArea := TempMemFileArea;
|
||||||
|
ReadFileArea := FArea;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
FO := (FileRec(FileAreaFile).Mode <> FMClosed);
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(FileAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('FBASES.DAT/Open Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(FileAreaFile,(FArea - 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('FBASES.DAT/Seek Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Read(FileAreaFile,MemFileArea);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('FBASES.DAT/Read Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
ReadFileArea := FArea;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(FileAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('FBASES.DAT/Close Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetDirPath(MemFileArea: FileAreaRecordType): AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (FADirDLPath IN MemFileArea.FAFlags) THEN
|
||||||
|
GetDirPath := MemFileArea.DLPath+MemFileArea.FileName
|
||||||
|
ELSE
|
||||||
|
GetDirPath := General.DataPath+MemFileArea.FileName;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LoadNewScanFile(VAR NewScanFile: Boolean);
|
||||||
|
VAR
|
||||||
|
FileAreaScanFile: FILE OF Boolean;
|
||||||
|
Counter: Integer;
|
||||||
|
BEGIN
|
||||||
|
Assign(FileAreaScanFile,GetDirPath(MemFileArea)+'.SCN');
|
||||||
|
Reset(FileAreaScanFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(FileAreaScanFile);
|
||||||
|
IF (UserNum > FileSize(FileAreaScanFile)) THEN
|
||||||
|
BEGIN
|
||||||
|
NewScanFile := TRUE;
|
||||||
|
Seek(FileAreaScanFile,FileSize(FileAreaScanFile));
|
||||||
|
FOR Counter := FileSize(FileAreaScanFile) TO (UserNum - 1) DO
|
||||||
|
Write(FileAreaScanFile,NewScanFile);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(FileAreaScanFile,(UserNum - 1));
|
||||||
|
Read(FileAreaScanFile,NewScanFile);
|
||||||
|
END;
|
||||||
|
Close(FileAreaScanFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SaveNewScanFile(NewScanFile: Boolean);
|
||||||
|
VAR
|
||||||
|
FileAreaScanFile: FILE OF Boolean;
|
||||||
|
BEGIN
|
||||||
|
Assign(FileAreaScanFile,GetDirPath(MemFileArea)+'.SCN');
|
||||||
|
Reset(FileAreaScanFile);
|
||||||
|
Seek(FileAreaScanFile,(UserNum - 1));
|
||||||
|
Write(FileAreaScanFile,NewScanFile);
|
||||||
|
Close(FileAreaScanFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitFileArea(FArea: Integer);
|
||||||
|
BEGIN
|
||||||
|
LoadFileArea(FArea);
|
||||||
|
|
||||||
|
IF ((Length(MemFileArea.DLPath) = 3) AND (MemFileArea.DLPath[2] = ':') AND (MemFileArea.DLPath[3] = '\')) THEN
|
||||||
|
BadDLPath := NOT ExistDrive(MemFileArea.DLPath[1])
|
||||||
|
ELSE IF NOT (FACDRom IN MemFileArea.FAFlags) THEN
|
||||||
|
BadDLPath := NOT ExistDir(MemFileArea.DLPath)
|
||||||
|
ELSE
|
||||||
|
BadDLPath := FALSE;
|
||||||
|
|
||||||
|
IF ((Length(MemFileArea.ULPath) = 3) AND (MemFileArea.ULPath[2] = ':') AND (MemFileArea.DLPath[3] = '\')) THEN
|
||||||
|
BadULPath := NOT ExistDrive(MemFileArea.ULPath[1])
|
||||||
|
ELSE IF NOT (FACDRom IN MemFileArea.FAFlags) THEN
|
||||||
|
BadULPath := NOT ExistDir(MemFileArea.ULPath)
|
||||||
|
ELSE
|
||||||
|
BadULPath := FALSE;
|
||||||
|
|
||||||
|
IF (NOT DirFileOpen1) THEN
|
||||||
|
IF (FileRec(FileInfoFile).Mode <> FMClosed) THEN
|
||||||
|
Close(FileInfoFile);
|
||||||
|
DirFileOpen1 := FALSE;
|
||||||
|
|
||||||
|
Assign(FileInfoFile,GetDirPath(MemFileArea)+'.DIR');
|
||||||
|
Reset(FileInfoFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(FileInfoFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error opening file: '+GetDirPath(MemFileArea)+'.DIR');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT ExtFileOpen1) THEN
|
||||||
|
IF (FileRec(ExtInfoFile).Mode <> FMClosed) THEN
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
ExtFileOpen1 := FALSE;
|
||||||
|
|
||||||
|
Assign(ExtInfoFile,GetDirPath(MemFileArea)+'.EXT');
|
||||||
|
Reset(ExtInfoFile,1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(ExtInfoFile,1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error opening file: '+GetDirPath(MemFileArea)+'.EXT');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LoadNewScanFile(NewScanFileArea);
|
||||||
|
|
||||||
|
FileAreaNameDisplayed := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayFileInfo(VAR F: FileInfoRecordType; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
Counter,
|
||||||
|
NumLine,
|
||||||
|
NumExtDesc: Byte;
|
||||||
|
|
||||||
|
FUNCTION DisplayFIStr(FIFlags: FIFlagSet): AStr;
|
||||||
|
VAR
|
||||||
|
TempStr1: AStr;
|
||||||
|
BEGIN
|
||||||
|
TempStr1 := '';
|
||||||
|
IF (FINotVal IN FIFlags) THEN
|
||||||
|
TempStr1 := TempStr1 + ' ^8'+'<NV>';
|
||||||
|
IF (FIIsRequest IN FIFlags) THEN
|
||||||
|
TempStr1 := TempStr1 + ' ^9'+'Ask (Request File)';
|
||||||
|
IF (FIResumeLater IN FIFlags) THEN
|
||||||
|
TempStr1 := TempStr1 + ' ^7'+'Resume later';
|
||||||
|
IF (FIHatched IN FIFlags) THEN
|
||||||
|
TempStr1 := TempStr1 + ' ^7'+'Hatched';
|
||||||
|
DisplayFIStr := TempStr1;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= 7) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
WITH F DO
|
||||||
|
BEGIN
|
||||||
|
IF (Editing) THEN
|
||||||
|
TempStr := IntToStr(Counter)+'. '
|
||||||
|
ELSE
|
||||||
|
TempStr := '';
|
||||||
|
CASE Counter OF
|
||||||
|
1 : TempStr := TempStr + 'Filename : ^0'+SQOutSp(FileName);
|
||||||
|
2 : IF (NOT General.FileCreditRatio) THEN
|
||||||
|
TempStr := TempStr + 'File size : ^2'+ConvertBytes(FileSize,FALSE)
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + 'File size : ^2'+ConvertKB(FileSize DIV 1024,FALSE);
|
||||||
|
3 : BEGIN
|
||||||
|
TempStr := TempStr + 'Description : ^9'+Description;
|
||||||
|
PrintACR('^1'+TempStr);
|
||||||
|
IF (F.VPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadVerbArray(F,ExtendedArray,NumExtDesc);
|
||||||
|
NumLine := 1;
|
||||||
|
WHILE (NumLine <= NumExtDesc) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^1'+AOnOff(Editing,PadLeftStr('',3),'')
|
||||||
|
+AOnOff(Editing AND (NumLine = 1),PadLeftStr('Extended',13),PadLeftStr('',13))
|
||||||
|
+AOnOff(Editing,PadRightInt(NumLine,3),PadRightStr('',3))
|
||||||
|
+' : ^9'+ExtendedArray[NumLine]);
|
||||||
|
Inc(NumLine);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Editing) THEN
|
||||||
|
IF (F.VPointer = -1) THEN
|
||||||
|
PrintACR('^5 No extended description.');
|
||||||
|
END;
|
||||||
|
4 : TempStr := TempStr + 'Uploaded by : ^4'+Caps(OwnerName);
|
||||||
|
5 : TempStr := TempStr + 'Uploaded on : ^5'+PD2Date(FileDate);
|
||||||
|
6 : BEGIN
|
||||||
|
TempStr := TempStr + 'Times downloaded : ^5'+FormatNumber(Downloaded);
|
||||||
|
PrintACR('^1'+TempStr);
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := 'Block size : 128-"^5'+IntToStr(FileSize DIV 128)+
|
||||||
|
'^1" / 1024-"^5'+IntToStr(FileSize DIV 1024)+'^1"';
|
||||||
|
PrintACR('^1'+TempStr);
|
||||||
|
TempStr := 'Time to download : ^5'+CTim(FileSize DIV Rate);
|
||||||
|
PrintACR('^1'+TempStr);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
7 : TempStr := TempStr + 'File point cost : ^4'+AOnOff((FilePoints > 0),FormatNumber(FilePoints),'FREE')+
|
||||||
|
DisplayFIStr(FIFlags);
|
||||||
|
END;
|
||||||
|
IF (NOT (Counter IN [3,6])) THEN
|
||||||
|
PrintACR('^1'+TempStr+'^1');
|
||||||
|
END;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION Fit(CONST FileName1,FileName2: Str12): Boolean;
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
Match: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Match := TRUE;
|
||||||
|
FOR Counter := 1 TO 12 DO
|
||||||
|
IF (FileName1[Counter] <> FileName2[Counter]) AND (FileName1[Counter] <> '?') THEN
|
||||||
|
Match := FALSE;
|
||||||
|
IF (FileName2 = '') THEN
|
||||||
|
Match := FALSE;
|
||||||
|
Fit := Match;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GetFileName(VAR FileName: Str12);
|
||||||
|
BEGIN
|
||||||
|
MPL(12);
|
||||||
|
InputMain(FileName,12,[NoLineFeed,UpperOnly]);
|
||||||
|
IF (FileName <> '') THEN
|
||||||
|
NL
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MPL(12);
|
||||||
|
FileName := '*.*';
|
||||||
|
Print(FileName);
|
||||||
|
END;
|
||||||
|
FileName := Align(FileName);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ISUL(CONST s: AStr): Boolean;
|
||||||
|
BEGIN
|
||||||
|
ISUL := ((Pos('/',s) <> 0) OR (Pos('\',s) <> 0) OR (Pos(':',s) <> 0) OR (Pos('|',s) <> 0));
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION IsWildCard(CONST S: AStr): Boolean;
|
||||||
|
BEGIN
|
||||||
|
IsWildCard := ((Pos('*',S) <> 0) OR (Pos('?',S) <> 0));
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LRecNo(FileInfo: FileInfoRecordType; VAR RN: Integer);
|
||||||
|
VAR
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
RN := 0;
|
||||||
|
IF (LastDIRRecNum <= FileSize(FileInfoFile)) AND (LastDIRRecNum >= 0) THEN
|
||||||
|
BEGIN
|
||||||
|
DirFileRecNum := (LastDIRRecNum - 1);
|
||||||
|
WHILE (DirFileRecNum >= 0) AND (RN = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF Fit(LastDIRFileName,FileInfo.FileName) THEN
|
||||||
|
RN := DirFileRecNum;
|
||||||
|
Dec(DirFileRecNum);
|
||||||
|
END;
|
||||||
|
LastDIRRecNum := RN;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
RN := -1;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE NRecNo(FileInfo: FileInfoRecordType; VAR RN: Integer);
|
||||||
|
VAR
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
RN := 0;
|
||||||
|
IF (LastDIRRecNum < FileSize(FileInfoFile)) AND (LastDIRRecNum >= -1) THEN
|
||||||
|
BEGIN
|
||||||
|
DirFileRecNum := (LastDIRRecNum + 1);
|
||||||
|
WHILE (DirFileRecNum < FileSize(FileInfoFile)) AND (RN = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF Fit(LastDIRFileName,FileInfo.FileName) THEN
|
||||||
|
RN := (DirFileRecNum + 1);
|
||||||
|
Inc(DirFileRecNum);
|
||||||
|
END;
|
||||||
|
Dec(RN);
|
||||||
|
LastDIRRecNum := RN;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
RN := -1;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE RecNo(FileInfo: FileInfoRecordType; FileName: Str12; VAR RN: Integer);
|
||||||
|
VAR
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
FileName := Align(FileName);
|
||||||
|
RN := 0;
|
||||||
|
DirFileRecNum := 0;
|
||||||
|
WHILE (DirFileRecNum < FileSize(FileInfoFile)) AND (RN = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF Fit(FileName,FileInfo.FileName) THEN
|
||||||
|
RN := (DirFileRecNum + 1);
|
||||||
|
Inc(DirFileRecNum);
|
||||||
|
END;
|
||||||
|
Dec(RN);
|
||||||
|
LastDIRRecNum := RN;
|
||||||
|
LastDIRFileName := FileName;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LoadVerbArray(F: FileInfoRecordType; VAR ExtArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte);
|
||||||
|
VAR
|
||||||
|
VerbStr: AStr;
|
||||||
|
TotLoad: Integer;
|
||||||
|
VFO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FillChar(ExtArray,SizeOf(ExtArray),0);
|
||||||
|
NumExtDesc := 1;
|
||||||
|
VFO := (FileRec(ExtInfoFile).Mode <> FMClosed);
|
||||||
|
IF (NOT VFO) THEN
|
||||||
|
Reset(ExtInfoFile,1);
|
||||||
|
IF (IOResult = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
TotLoad := 0;
|
||||||
|
Seek(ExtInfoFile,(F.VPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(ExtInfoFile,VerbStr[0],1);
|
||||||
|
BlockRead(ExtInfoFile,VerbStr[1],Ord(VerbStr[0]));
|
||||||
|
Inc(TotLoad,(Length(VerbStr) + 1));
|
||||||
|
ExtArray[NumExtDesc] := VerbStr;
|
||||||
|
Inc(NumExtDesc);
|
||||||
|
UNTIL (TotLoad >= F.VTextSize);
|
||||||
|
IF (NOT VFO) THEN
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
Dec(NumExtDesc);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SaveVerbArray(VAR F: FileInfoRecordType; ExtArray: ExtendedDescriptionArray; NumExtDesc: Byte);
|
||||||
|
VAR
|
||||||
|
LineNum: Byte;
|
||||||
|
VFO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
VFO := (FileRec(ExtInfoFile).Mode <> FMClosed);
|
||||||
|
IF (NOT VFO) THEN
|
||||||
|
Reset(ExtInfoFile,1);
|
||||||
|
IF (IOResult = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
F.VPointer := (FileSize(ExtInfoFile) + 1);
|
||||||
|
F.VTextSize := 0;
|
||||||
|
Seek(ExtInfoFile,FileSize(ExtInfoFile));
|
||||||
|
FOR LineNum := 1 TO NumExtDesc DO
|
||||||
|
IF (ExtArray[LineNum] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(F.VTextSize,(Length(ExtArray[LineNum]) + 1));
|
||||||
|
BlockWrite(ExtInfoFile,ExtArray[LineNum],(Length(ExtArray[LineNum]) + 1));
|
||||||
|
END;
|
||||||
|
IF (NOT VFO) THEN
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CountDown;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
SaveTimer: LongInt;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Press <^5CR^1> to logoff now.');
|
||||||
|
Print('Press <^5Esc^1> to abort logoff.');
|
||||||
|
NL;
|
||||||
|
Prompt('|12Hanging up in: ^99');
|
||||||
|
SaveTimer := Timer;
|
||||||
|
Cmd := #0;
|
||||||
|
Counter := 9;
|
||||||
|
WHILE (Counter > 0) AND NOT (Cmd IN [#13,#27]) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Empty) THEN
|
||||||
|
Cmd := Char(InKey);
|
||||||
|
IF (Timer <> SaveTimer) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Counter);
|
||||||
|
Prompt(^H+IntToStr(Counter));
|
||||||
|
SaveTimer := Timer;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
ASM
|
||||||
|
Int 28h
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
END;
|
||||||
|
IF (Cmd <> #27) THEN
|
||||||
|
BEGIN
|
||||||
|
HangUp := TRUE;
|
||||||
|
OutCom := FALSE;
|
||||||
|
END;
|
||||||
|
UserColor(1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,910 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File10;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE CreditFileOwner(VAR User: UserRecordType; VAR FileInfo: FileInfoRecordType; Credit: Boolean; GotPts: Integer);
|
||||||
|
PROCEDURE EditFile(DirFileRecNum: Integer; VAR Cmd: Char; NoPrompt,IsPoints: Boolean);
|
||||||
|
PROCEDURE EditFiles;
|
||||||
|
PROCEDURE ValidateFiles;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
ArcView,
|
||||||
|
Common5,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File2,
|
||||||
|
File9,
|
||||||
|
Mail1,
|
||||||
|
SysOp3,
|
||||||
|
TimeFunc,
|
||||||
|
MiscUser;
|
||||||
|
|
||||||
|
PROCEDURE CreditFileOwner(VAR User: UserRecordType; VAR FileInfo: FileInfoRecordType; Credit: Boolean; GotPts: Integer);
|
||||||
|
VAR
|
||||||
|
FilePointsReceived: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (AllCaps(FileInfo.OwnerName) <> AllCaps(User.Name)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7File owner name does not match user name!^1');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT General.FileCreditRatio) THEN
|
||||||
|
GotPts := 0
|
||||||
|
ELSE IF (GotPts = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FilePointsReceived := 0;
|
||||||
|
IF (General.FileCreditCompBaseSize <> 0) THEN
|
||||||
|
FilePointsReceived := ((FileInfo.FileSize DIV 1024) DIV General.FileCreditCompBaseSize);
|
||||||
|
GotPts := (FilePointsReceived * General.FileCreditComp);
|
||||||
|
IF (GotPts < 1) THEN
|
||||||
|
GotPts := 1;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print(AOnOff(Credit,'^1Awarding upload','^1Removing upload')+' credits:'+
|
||||||
|
' ^51 file'+
|
||||||
|
', '+ConvertKB(FileInfo.FileSize DIV 1024,FALSE)+
|
||||||
|
', '+IntToStr(GotPts)+' file points.^1');
|
||||||
|
SysOpLog(AOnOff(Credit,'^1Awarding upload','^1Removing upload')+' credits:'+
|
||||||
|
' ^51 file'+
|
||||||
|
', '+ConvertKB(FileInfo.FileSize DIV 1024,FALSE)+
|
||||||
|
', '+IntToStr(GotPts)+' file points.^1');
|
||||||
|
IF (Credit) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (User.Uploads < 2147483647) THEN
|
||||||
|
Inc(User.Uploads);
|
||||||
|
IF ((User.UK + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(User.UK,(FileInfo.FileSize DIV 1024))
|
||||||
|
ELSE
|
||||||
|
User.UK := 2147483647;
|
||||||
|
IF ((User.FilePoints + GotPts) < 2147483647) THEN
|
||||||
|
Inc(User.FilePoints,GotPts)
|
||||||
|
ELSE
|
||||||
|
User.FilePoints := 2147483647;
|
||||||
|
Include(FileInfo.FIFlags,FIOwnerCredited);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (User.Uploads > 0) THEN
|
||||||
|
Dec(User.Uploads);
|
||||||
|
IF ((User.UK - (FileInfo.FileSize DIV 1024)) > 0) THEN
|
||||||
|
Dec(User.UK,(FileInfo.FileSize DIV 1024))
|
||||||
|
ELSE
|
||||||
|
User.UK := 0;
|
||||||
|
IF ((User.FilePoints - GotPts) > 0) THEN
|
||||||
|
Dec(User.FilePoints,GotPts)
|
||||||
|
ELSE
|
||||||
|
User.FilePoints := 0;
|
||||||
|
Exclude(FileInfo.FIFlags,FIOwnerCredited);
|
||||||
|
END;
|
||||||
|
SaveURec(User,FileInfo.OwnerNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditFile(DirFileRecNum: Integer; VAR Cmd: Char; NoPrompt,IsPoints: Boolean);
|
||||||
|
VAR
|
||||||
|
FF: FILE;
|
||||||
|
ExtText: Text;
|
||||||
|
User: UserRecordType;
|
||||||
|
Mheader: MheaderRec;
|
||||||
|
InputStr,
|
||||||
|
MoveFromDir,
|
||||||
|
MoveToDir: AStr;
|
||||||
|
LineNum,
|
||||||
|
NumExtDesc: Byte;
|
||||||
|
UNum,
|
||||||
|
NewFileArea,
|
||||||
|
SaveFileArea,
|
||||||
|
FArea,
|
||||||
|
NumFAreas,
|
||||||
|
Totload,
|
||||||
|
SaveFArea: Integer;
|
||||||
|
FSize: Longint;
|
||||||
|
SaveConfSystem,
|
||||||
|
SaveTempPause,
|
||||||
|
DontShowList,
|
||||||
|
Ok: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ToggleFIFlag(FIFlagT: FileInfoFlagType; VAR FIFlagS: FIFlagSet);
|
||||||
|
BEGIN
|
||||||
|
IF (FIFlagT IN FIFlagS) THEN
|
||||||
|
Exclude(FIFlagS,FIFlagT)
|
||||||
|
ELSE
|
||||||
|
Include(FIFlagS,FIFlagT);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleFIFlags(C: Char; VAR FIFlagS: FIFlagSet);
|
||||||
|
BEGIN
|
||||||
|
CASE C OF
|
||||||
|
'V' : ToggleFIFlag(FiNotVal,FIFlagS);
|
||||||
|
'T' : ToggleFIFlag(FiIsRequest,FIFlagS);
|
||||||
|
'R' : ToggleFIFlag(FIResumeLater,FIFlagS);
|
||||||
|
'H' : ToggleFIFlag(FIHatched,FIFlagS);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
IF (FileInfo.OwnerNum < 1) OR (FileInfo.OwnerNum > (MaxUsers - 1)) THEN
|
||||||
|
FileInfo.OwnerNum := 1;
|
||||||
|
LoadURec(User,FileInfo.OwnerNum);
|
||||||
|
|
||||||
|
IF (IsPoints) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
DisplayFileInfo(FileInfo,TRUE);
|
||||||
|
NL;
|
||||||
|
Prt('File points for file (^50^4-^5999^4,^5<CR>^4=^5Skip^4,^5Q^4=^5Quit^4): ');
|
||||||
|
MPL(3);
|
||||||
|
Input(InputStr,3);
|
||||||
|
IF (InputStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted.');
|
||||||
|
Abort := TRUE
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) >= 0) AND (StrToInt(InputStr) <= 999) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FilePoints := StrToInt(InputStr);
|
||||||
|
Exclude(FileInfo.FIFlags,FINotVal);
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
|
||||||
|
CreditFileOwner(User,FileInfo,TRUE,FileInfo.FilePoints);
|
||||||
|
|
||||||
|
IF (FileInfo.OwnerNum = UserNum) THEN
|
||||||
|
User.FilePoints := ThisUser.FilePoints;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Prt('File points for user (^5-'+IntToStr(User.FilePoints)+'^4 to ^5999^4): ');
|
||||||
|
MPL(4);
|
||||||
|
Input(InputStr,4);
|
||||||
|
IF (InputStr <> '') AND (StrToInt(InputStr) >= -User.FilePoints) AND (StrToInt(InputStr) <= 999) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Inc(User.FilePoints,StrToInt(InputStr));
|
||||||
|
|
||||||
|
IF (FileInfo.OwnerNum = UserNum) THEN
|
||||||
|
ThisUser.FilePoints := User.FilePoints;
|
||||||
|
|
||||||
|
SaveURec(User,FileInfo.OwnerNum);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NoPrompt) THEN
|
||||||
|
BEGIN
|
||||||
|
Exclude(FileInfo.FIFlags,FINotVal);
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
CreditFileOwner(User,FileInfo,TRUE,0);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
DontShowList := FALSE;
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
IF (NOT DontShowList) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
DisplayFileInfo(FileInfo,TRUE);
|
||||||
|
Abort := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
DontShowList := FALSE;
|
||||||
|
NL;
|
||||||
|
Abort := FALSE;
|
||||||
|
IF (Next) THEN
|
||||||
|
Cmd := 'N'
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Prt('Edit files (^5?^4=^5Help^4): ');
|
||||||
|
OneK(Cmd,'Q1234567DEGHIMNPRTUVW?'^M,TRUE,TRUE);
|
||||||
|
END;
|
||||||
|
CASE Cmd OF
|
||||||
|
'1' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('New file name: ');
|
||||||
|
MPL((SizeOf(FileInfo.FileName) - 1));
|
||||||
|
Input(InputStr,(SizeOf(FileInfo.FileName) - 1));
|
||||||
|
IF (InputStr = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted.');
|
||||||
|
END
|
||||||
|
ELSE IF (SQOutSp(InputStr) = SQOutSp(FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You must specify a different file name!^1');
|
||||||
|
END
|
||||||
|
ELSE IF (Exist(MemFileArea.DLPath+InputStr) OR Exist(MemFileArea.ULPath+InputStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7That file name exists in the download or upload path!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Exist(MemFileArea.DLPath+FileInfo.FileName)) OR
|
||||||
|
(NOT Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('That file name does not exist in the download or upload path.');
|
||||||
|
Ok := FALSE;
|
||||||
|
IF (CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (FIIsRequest IN FileInfo.FIFlagS)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (PYNQ('Do you want to set this file to offline? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileSize := 0;
|
||||||
|
Include(FileInfo.FIFlagS,FIIsRequest);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
IF (PYNQ('Do you want to rename the file anyway? ', 0,FALSE)) THEN
|
||||||
|
Ok := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Exist(MemFileArea.DLPath+FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(FF,MemFileArea.DLPath+FileInfo.FileName);
|
||||||
|
ReName(FF,MemFileArea.DLPath+InputStr);
|
||||||
|
END
|
||||||
|
ELSE IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(FF,MemFileArea.ULPath+FileInfo.FileName);
|
||||||
|
ReName(FF,MemFileArea.ULPath+InputStr);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
FileInfo.FileName := Align(InputStr);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'2' : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Limit on file size restricted to 1.9 Gig.');
|
||||||
|
OK := TRUE;
|
||||||
|
IF (NOT Exist(MemFileArea.DLPath+FileInfo.FileName)) OR (NOT Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (PYNQ('File does not exist, set to offline? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
FSize := 0;
|
||||||
|
Include(FileInfo.FIFlags,FiIsRequest);
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Update with actual file size? ', 0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
FSize := 0;
|
||||||
|
IF (Exist(MemFileArea.DLPath+FileInfo.FileName)) THEN
|
||||||
|
FSize := GetFileSize(MemFileArea.DLPath+SQOutSp(FileInfo.FileName))
|
||||||
|
ELSE IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
|
||||||
|
FSize := GetFileSize(MemFileArea.ULPath+SqOutSp(FileInfo.FileName));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FSize := FileInfo.FileSize;
|
||||||
|
InputLongIntWOC('%LFNew file size in bytes',FSize,[DisplayValue,NumbersOnly],0,2147483647);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (FSize >= 0) AND (FSize <= 2147483647) THEN
|
||||||
|
FileInfo.FileSize := FSize;
|
||||||
|
END;
|
||||||
|
'3' : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('New description: ');
|
||||||
|
Prt(': ');
|
||||||
|
MPL((SizeOf(FileInfo.Description) - 1));
|
||||||
|
InputMain(FileInfo.Description,(SizeOf(FileInfo.Description) - 1),[InteractiveEdit]);
|
||||||
|
END;
|
||||||
|
'4' : BEGIN
|
||||||
|
LoadURec(User,FileInfo.OwnerNum);
|
||||||
|
IF (AllCaps(FileInfo.OwnerName) <> AllCaps(User.Name)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Previous owner was '+Caps(FileInfo.OwnerName)+' #'+IntToStr(FileInfo.OwnerNum));
|
||||||
|
NL;
|
||||||
|
LoadURec(User,1);
|
||||||
|
FileInfo.OwnerNum := 1;
|
||||||
|
FileInfo.OwnerName := AllCaps(User.Name);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('New owner user number or name ('+Caps(FileInfo.OwnerName)+' #'+IntToStr(FileInfo.OwnerNum)+'): ');
|
||||||
|
Prt(': ');
|
||||||
|
MPL((SizeOf(FileInfo.OwnerName) - 1));
|
||||||
|
FindUser(UNum);
|
||||||
|
IF (UNum <= 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('User not found.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,UNum);
|
||||||
|
FileInfo.OwnerNum := UNum;
|
||||||
|
FileInfo.OwnerName := AllCaps(User.Name);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'5' : BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('New upload file date ('+PD2Date(FileInfo.FileDate)+'): ');
|
||||||
|
InputFormatted('',InputStr,'##-##-####',TRUE);
|
||||||
|
IF (InputStr = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (DayNum(InputStr) = 0) OR (DayNum(InputStr) > DayNum(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Invalid date entered!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
FileInfo.FileDate := Date2PD(InputStr);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'6' : InputLongIntWOC('%LFNew number of downloads',FileInfo.DownLoaded,[DisplayValue,NumbersOnly],0,2147483647);
|
||||||
|
'7' : InputIntegerWOC('%LFNew amount of file points',FileInfo.FilePoints,[NumbersOnly],0,999);
|
||||||
|
'D' : IF PYNQ('%LFAre you sure? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Deleteff(FileInfo,DirFileRecNum);
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
Dec(LastDIRRecNum);
|
||||||
|
InputStr := 'Removed "'+SQOutSp(FileInfo.FileName)+'" from '+MemFileArea.AreaName;
|
||||||
|
IF (Exist(MemFileArea.DLPath+FileInfo.FileName) OR Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Erase file also? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Kill(MemFileArea.DLPath+FileInfo.FileName);
|
||||||
|
Kill(MemFileArea.ULPath+FileInfo.FileName);
|
||||||
|
InputStr := InputStr+' [FILE DELETED]'
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT (FIOwnerCredited IN FileInfo.FIFlags)) THEN
|
||||||
|
Print('%LF^7Owner did not receive upload credit for this file!^1')
|
||||||
|
ELSE IF PYNQ('%LFRemove from ^5'+Caps(User.Name)+' #'+IntToStr(FileInfo.OwnerNum)+'^7''s ratio? ',0,FALSE) THEN
|
||||||
|
CreditFileOwner(User,FileInfo,FALSE,FileInfo.FilePoints);
|
||||||
|
|
||||||
|
SysOpLog(InputStr);
|
||||||
|
Cmd := 'N';
|
||||||
|
END;
|
||||||
|
'E' : BEGIN
|
||||||
|
OK := TRUE;
|
||||||
|
IF (FileInfo.VPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT PYNQ('%LFDelete the extended description for this file? ',0,FALSE)) THEN
|
||||||
|
LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileInfo.VPointer := -1;
|
||||||
|
FileInfo.VTextSize := 0;
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (NOT PYNQ('%LFCreate an extended description for this file? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.VPointer := -1;
|
||||||
|
FileInfo.VTextSize := 0;
|
||||||
|
OK := FALSE
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
|
||||||
|
NumExtDesc := 1;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(ExtText,TempDir+MemFileArea.FileName+'.TMP');
|
||||||
|
ReWrite(ExtText);
|
||||||
|
LineNum := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(LineNum);
|
||||||
|
IF (ExtendedArray[LineNum] <> '') THEN
|
||||||
|
WriteLn(ExtText,ExtendedArray[LineNum]);
|
||||||
|
UNTIL (LineNum = NumExtDesc);
|
||||||
|
Close(ExtText);
|
||||||
|
MHeader.Status := [];
|
||||||
|
InResponseTo := '';
|
||||||
|
IF (InputMessage(TRUE,FALSE,'Extended Description',
|
||||||
|
MHeader,TempDir+MemFileArea.FileName+'.TMP',50,99)) then
|
||||||
|
IF Exist(TempDir+MemFileArea.FileName+'.TMP') THEN
|
||||||
|
BEGIN
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
|
||||||
|
Assign(ExtText,TempDir+MemFileArea.FileName+'.TMP');
|
||||||
|
Reset(ExtText);
|
||||||
|
NumExtDesc := 0;
|
||||||
|
REPEAT
|
||||||
|
ReadLn(ExtText,InputStr);
|
||||||
|
IF (InputStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(NumExtDesc);
|
||||||
|
ExtendedArray[NumExtDesc] := InputStr;
|
||||||
|
END;
|
||||||
|
UNTIL (NumExtDesc = MaxExtDesc) OR EOF(ExtText);
|
||||||
|
Close(ExtText);
|
||||||
|
IF (ExtendedArray[1] <> '') THEN
|
||||||
|
SaveVerbArray(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
END;
|
||||||
|
Kill(TempDir+MemFileArea.FileName+'.TMP');
|
||||||
|
END;
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'G' : IF (NOT General.FileDiz) THEN
|
||||||
|
Print('%LF^7This option is not active in the System Configuration!^1')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
|
||||||
|
InputStr := MemFileArea.ULPath+SQOutSp(FileInfo.FileName)
|
||||||
|
ELSE
|
||||||
|
InputStr := MemFileArea.DLPath+SQOutSp(FileInfo.FileName);
|
||||||
|
IF (NOT DizExists(InputStr)) THEN
|
||||||
|
Print('%LFFile has no internal description.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
GetDiz(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
IF (ExtendedArray[1] <> '') THEN
|
||||||
|
SaveVerbArray(FileInfo,ExtendedArray,NumExtDesc)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileInfo.VPointer := -1;
|
||||||
|
FileInfo.VTextSize := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'H' : ToggleFIFlags('H',FileInfo.FIFlagS);
|
||||||
|
'I' : IF (NOT ValidIntArcType(FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Not a valid archive type or not supported!^1')
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
OK := FALSE;
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
ViewInternalArchive(MemFileArea.DLPath+SQOutSp(FileInfo.FileName));
|
||||||
|
OK := TRUE;
|
||||||
|
END
|
||||||
|
ELSE IF Exist(MemFileArea.ULPath+FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
ViewInternalArchive(MemFileArea.ULPath+SQOutSp(FileInfo.FileName));
|
||||||
|
OK := TRUE;
|
||||||
|
END;
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (PYNQ('File does not exist, set to offline? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileSize := 0;
|
||||||
|
ToggleFIFlags('T',FileInfo.FIFlagS);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
END;
|
||||||
|
'M' : BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
FArea := 1;
|
||||||
|
NumFAreas := 0;
|
||||||
|
LightBarCmd := 1;
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveFArea := FArea;
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
LFileAreaList(FArea,NumFAreas,5,FALSE);
|
||||||
|
{
|
||||||
|
%LFMove to which file area? (^5'+IntToStr(LowFileArea)+'^4-^5'+IntToStr(HighFileArea)+'^4)
|
||||||
|
[^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
|
||||||
|
}
|
||||||
|
FileAreaScanInput(LRGLngStr(76,TRUE),Length(IntToStr(HighFileArea)),InputStr,'Q[]?',LowFileArea,HighFileArea);
|
||||||
|
IF (InputStr <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
Farea := (SaveFArea - ((PageLength - 5) * 2));
|
||||||
|
IF (FArea < 1) THEN
|
||||||
|
FArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (FArea > NumFileAreas) THEN
|
||||||
|
FArea := SaveFArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
$File_Message_Area_List_Help
|
||||||
|
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
|
||||||
|
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
|
||||||
|
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
|
||||||
|
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
|
||||||
|
^1(^3[^1)Previous page ^1(^3]^1)Next page
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(71,FALSE);
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) < LowFileArea) OR (StrToInt(InputStr) > HighFileArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from '+IntToStr(LowFileArea)+' to '+IntToStr(HighFileArea)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) = FileArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You can not move a file to the same file area.^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NewFileArea := CompFileArea(StrToInt(InputStr),1);
|
||||||
|
IF (FileArea <> NewFileArea) THEN
|
||||||
|
ChangeFileArea(NewFileArea);
|
||||||
|
IF (FileArea <> NewFileArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have access to this file area!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
MoveFromDir := MemFileArea.DLPath
|
||||||
|
ELSE
|
||||||
|
MoveFromDir := MemFileArea.ULPath;
|
||||||
|
LoadFileArea(NewFileArea);
|
||||||
|
MoveToDir := MemFileArea.ULPath;
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Move file to '+MemFileArea.AreaName+'? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
OK := TRUE;
|
||||||
|
IF Exist(MoveToDir+SQoutSp(FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The file exists in the upload path!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (NOT Exist(MoveFromDir+SQOutSp(FileInfo.FileName))) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The file does not exist in the download path!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
CopyMoveFile(FALSE,'^5Moving file: ',
|
||||||
|
MoveFromDir+SQOutSp(FileInfo.FileName),
|
||||||
|
MoveToDir+SQOutSp(FileInfo.FileName),
|
||||||
|
TRUE);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Prompt('^5Moving records: ');
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (FileInfo.VPointer <> -1) THEN
|
||||||
|
LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
Deleteff(FileInfo,DirFileRecNum);
|
||||||
|
FileArea := NewFileArea;
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (FileInfo.VPointer <> - 1) THEN
|
||||||
|
SaveVerbArray(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
Seek(FileInfoFile,FileSize(FileInfoFile));
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
Dec(LastDIRRecNum);
|
||||||
|
Print('Done!^1');
|
||||||
|
Cmd := 'N';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (InputStr = 'Q') THEN
|
||||||
|
Cmd := 'N';
|
||||||
|
UNTIL (Cmd = 'N') OR (HangUp);
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
'P' : ;
|
||||||
|
'Q' : Abort := TRUE;
|
||||||
|
'R' : ToggleFIFlags('R',FileInfo.FIFlagS);
|
||||||
|
'T' : ToggleFIFlags('T',FileInfo.FIFlagS);
|
||||||
|
'U' : IF (NOT CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have the required access level for this option!^1')
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (FileInfo.OwnerNum < 1) OR (FileInfo.OwnerNum > (MaxUsers - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,1);
|
||||||
|
FileInfo.OwnerNum := 1;
|
||||||
|
FileInfo.OwnerName := AllCaps(User.Name);
|
||||||
|
END;
|
||||||
|
UserEditor(FileInfo.OwnerNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
'V' : BEGIN
|
||||||
|
ToggleFIFlags('V',FileInfo.FIFlagS);
|
||||||
|
|
||||||
|
IF (FINotVal IN FileInfo.FIFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (FIOwnerCredited IN FileInfo.FIFlags)) THEN
|
||||||
|
Print('%LF^7Owner did not receive upload credit for this file!^1')
|
||||||
|
ELSE
|
||||||
|
CreditFileOwner(User,FileInfo,FALSE,FileInfo.FilePoints);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
CreditFileOwner(User,FileInfo,TRUE,0);
|
||||||
|
END;
|
||||||
|
|
||||||
|
'W' : IF (NOT (FIOwnerCredited IN FileInfo.FIFlags)) THEN
|
||||||
|
Print('%LF^7Owner did not receive upload credit for this file!^1')
|
||||||
|
ELSE IF PYNQ('%LFWithdraw credit? ',0,FALSE) THEN
|
||||||
|
CreditFileOwner(User,FileInfo,FALSE,FileInfo.FilePoints);
|
||||||
|
|
||||||
|
'?' : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^31-7^1:Modify item');
|
||||||
|
LCmds(18,3,'Move file','Delete file');
|
||||||
|
LCmds(18,3,'Extended edit','Hatched toggle');
|
||||||
|
LCmds(18,3,'Previous file','Next file');
|
||||||
|
LCmds(18,3,'Resume toggle','Toggle availability');
|
||||||
|
LCmds(18,3,'Validation toggle','Withdraw credit');
|
||||||
|
LCmds(18,3,'Internal listing','Get Description');
|
||||||
|
LCmds(18,3,'Uploader','Quit');
|
||||||
|
DontShowList := TRUE;
|
||||||
|
END;
|
||||||
|
^M : Cmd := 'N';
|
||||||
|
ELSE
|
||||||
|
Next := TRUE;
|
||||||
|
END;
|
||||||
|
IF (NOT (Cmd IN ['P','N','Q'])) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd IN ['P','N','Q']) OR (Abort) OR (Next) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditFiles;
|
||||||
|
VAR
|
||||||
|
FileName,
|
||||||
|
SaveLastDirFileName: Str12;
|
||||||
|
Cmd: Char;
|
||||||
|
DirFileRecNum,
|
||||||
|
SaveLastDirFileRecNum: Integer;
|
||||||
|
FO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('File editor:');
|
||||||
|
{ Print(FString.lGFNLine1); }
|
||||||
|
lRGLngStr(28,FALSE);
|
||||||
|
{ Prt(FString.GFNLine2); }
|
||||||
|
lRGLngStr(29,FALSE);
|
||||||
|
GetFileName(FileName);
|
||||||
|
IF (FileName = '') OR (Pos('.',FileName) = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveLastDirFileRecNum := LastDIRRecNum;
|
||||||
|
SaveLastDirFileName := LastDIRFileName;
|
||||||
|
FO := (FileRec(FileInfoFile).Mode <> FMClosed);
|
||||||
|
IF (FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
RecNo(FileInfo,FileName,DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (DirFileRecNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('No matching files.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
EditFile(DirFileRecNum,Cmd,FALSE,FALSE);
|
||||||
|
IF (Cmd = 'Q') THEN
|
||||||
|
Abort := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Cmd = 'P') THEN
|
||||||
|
LRecNo(FileInfo,DirFileRecNum)
|
||||||
|
ELSE
|
||||||
|
NRecNo(FileInfo,DirFileRecNum);
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
IF (FO) THEN
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
LastDIRRecNum := SaveLastDirFileRecNum;
|
||||||
|
LastDIRFileName := SaveLastDirFileName;
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ValidateFiles;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
FArea,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ValFiles(FArea: Integer; Cmd1: Char; NoPrompt,IsPoints: Boolean);
|
||||||
|
VAR
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
Found,
|
||||||
|
FirstOne: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(FileInfo,'*.*',DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
LIL := 0;
|
||||||
|
CLS;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Found := FALSE;
|
||||||
|
FirstOne := TRUE;
|
||||||
|
Prompt('^1Scanning ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FileArea,0))+'^1 ...');
|
||||||
|
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF (FINotVal IN FileInfo.FIFlagS) AND (NOT (FIResumeLater IN FileInfo.FIFlagS)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (FirstOne) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
FirstOne := FALSE;
|
||||||
|
END;
|
||||||
|
EditFile(DirFileRecNum,Cmd1,NoPrompt,IsPoints);
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
IF (Cmd1 = 'P') THEN
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
LRecNo(FileInfo,DirFileRecNum);
|
||||||
|
UNTIL (DirFileRecNum = -1) OR ((FINotVal IN FileInfo.FIFlags) AND NOT (FIResumeLater IN FileInfo.FIFlags));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
NRecNo(FileInfo,DirFileRecNum);
|
||||||
|
WKey;
|
||||||
|
END;
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FileArea,0))));
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^4[^5M^4]anual, [^5A^4]utomatic, [^5P^4]oint entry, [^5Q^4]uit');
|
||||||
|
NL;
|
||||||
|
Prt('File validation: ');
|
||||||
|
OneK(Cmd,'QMAP',TRUE,TRUE);
|
||||||
|
IF (Cmd <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
TempPause := (Cmd <> 'A');
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NL;
|
||||||
|
IF (NOT InWFCMenu) AND (NOT PYNQ('Search all file areas? ',0,TRUE)) THEN
|
||||||
|
ValFiles(FileArea,Cmd,(Cmd = 'A'),(Cmd = 'P'))
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
ValFiles(FArea,Cmd,(Cmd = 'A'),(Cmd = 'P'));
|
||||||
|
WKey;
|
||||||
|
IF (Next) THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
END;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,963 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File12;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION CheckBatchUL(FileName: Str12): Boolean;
|
||||||
|
PROCEDURE EditBatchULQueue;
|
||||||
|
PROCEDURE ListBatchULFiles;
|
||||||
|
PROCEDURE RemoveBatchULFiles;
|
||||||
|
PROCEDURE ClearBatchULQueue;
|
||||||
|
PROCEDURE BatchUpload(BiCleanUp: Boolean; TransferTime: LongInt);
|
||||||
|
PROCEDURE BatchDLULInfo;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common5,
|
||||||
|
ExecBat,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File2,
|
||||||
|
File4,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
FUNCTION CheckBatchUL(FileName: Str12): Boolean;
|
||||||
|
VAR
|
||||||
|
RecNum: LongInt;
|
||||||
|
FileFound: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FileFound := FALSE;
|
||||||
|
IF (NumBatchULFiles > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
|
||||||
|
Reset(BatchULFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchULFile)) AND (NOT FileFound) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
IF (BatchUL.BULUserNum = UserNum) AND (BatchUL.BULFileName = SQOutSp(FileName)) THEN
|
||||||
|
FileFound := TRUE;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchULFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
CheckBatchUL := FileFound;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditBatchULQueue;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchULFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch upload queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Prt('Batch upoad queue [^5C^4]lear, [^5L^4]ist batch, [^5R^4]emove a file, [^5Q^4]uit: ');
|
||||||
|
OneK(Cmd,'QCLR',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'C' : ClearBatchULQueue;
|
||||||
|
'L' : ListBatchULFiles;
|
||||||
|
'R' : RemoveBatchULFiles;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListBatchULFiles;
|
||||||
|
VAR
|
||||||
|
TempStr: STRING;
|
||||||
|
FileNumToList: Byte;
|
||||||
|
TempBULVTextSize: Integer;
|
||||||
|
RecNum: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchULFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch upload queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NL;
|
||||||
|
PrintACR('^4###:Filename.Ext Area Description^1');
|
||||||
|
PrintACR('^4===:============:=====:==================================================^1');
|
||||||
|
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
|
||||||
|
Reset(BatchULFile);
|
||||||
|
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
|
||||||
|
Reset(BatchULF,1);
|
||||||
|
FileNumToList := 1;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchULFile)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
IF (BatchUL.BULUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^3'+PadRightInt(FileNumToList,3)+
|
||||||
|
'^4:^5'+Align(BatchUL.BULFileName)+
|
||||||
|
' '+AOnOff((BatchUL.BULSection = General.ToSysOpDir),'^7SysOp',PadRightInt(BatchUL.BULSection,5))+
|
||||||
|
' ^3'+BatchUL.BULDescription);
|
||||||
|
IF (BatchUL.BULVPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
TempBULVTextSize := 0;
|
||||||
|
Seek(BatchULF,(BatchUL.BULVPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(BatchULF,TempStr[0],1);
|
||||||
|
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
|
||||||
|
Inc(TempBULVTextSize,(Length(TempStr) + 1));
|
||||||
|
PrintACR('^3'+PadRightStr(TempStr,24)+'^1');
|
||||||
|
UNTIL (TempBULVTextSize >= BatchUL.BULVTextSize);
|
||||||
|
END;
|
||||||
|
Inc(FileNumToList);
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchULFile);
|
||||||
|
Close(BatchULF);
|
||||||
|
LastError := IOResult;
|
||||||
|
PrintACR('^4===:============:=====:==================================================^1');
|
||||||
|
SysOpLog('Viewed the batch upload queue.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE RemoveBatchULFiles;
|
||||||
|
VAR
|
||||||
|
BatchULF1: FILE;
|
||||||
|
BatchUL1: BatchULRecordType;
|
||||||
|
TempStr: STRING;
|
||||||
|
InputStr: Str3;
|
||||||
|
Counter,
|
||||||
|
FileNumToRemove: Byte;
|
||||||
|
TotLoad: Integer;
|
||||||
|
TempVPointer,
|
||||||
|
RecNum,
|
||||||
|
RecNum1: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchULFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch upload queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
ListBatchULFiles;
|
||||||
|
NL;
|
||||||
|
Prt('File to remove? (^51^4-^5'+IntToStr(NumBatchULFiles)+'^4) [^5?^4=^5List^4,^5<CR>^4=^5Quit^4]: ');
|
||||||
|
MPL(Length(IntToStr(NumBatchULFiles)));
|
||||||
|
ScanInput(InputStr,^M'?');
|
||||||
|
FileNumToRemove := StrToInt(InputStr);
|
||||||
|
IF (NOT (InputStr[1] IN ['?','-',^M])) THEN
|
||||||
|
IF (FileNumToRemove < 1) OR (FileNumToRemove > NumBatchULFiles) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from 1 to '+IntToStr(NumBatchULFiles)+'!^1');
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Counter := 0;
|
||||||
|
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
|
||||||
|
Reset(BatchULFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchULFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
IF (BatchUL.BULUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(Counter);
|
||||||
|
IF (Counter = FileNumToRemove) THEN
|
||||||
|
BEGIN
|
||||||
|
BatchUL.BULVPointer := -1;
|
||||||
|
BatchUL.BULVTextSize := 0;
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Write(BatchULFile,BatchUL);
|
||||||
|
Dec(NumBatchULFiles);
|
||||||
|
NL;
|
||||||
|
Print('Removed from batch upload queue: "^5'+BatchUL.BULFileName+'^1".');
|
||||||
|
SysOpLog('Batch UL Remove: "^5'+BatchUL.BULFileName+'^1".');
|
||||||
|
|
||||||
|
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
|
||||||
|
Reset(BatchULF,1);
|
||||||
|
Assign(BatchULF1,General.DataPath+'BATCHUL.EX1');
|
||||||
|
ReWrite(BatchULF1,1);
|
||||||
|
FOR RecNum1 := 0 TO (FileSize(BatchULFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Read(BatchULFile,BatchUL1);
|
||||||
|
IF (BatchUL1.BULVPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
TempVPointer := (FileSize(BatchULF1) + 1);
|
||||||
|
Seek(BatchULF1,FileSize(BatchULF1));
|
||||||
|
TotLoad := 0;
|
||||||
|
Seek(BatchULF,(BatchUL1.BULVPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(BatchULF,TempStr[0],1);
|
||||||
|
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
|
||||||
|
Inc(TotLoad,(Length(TempStr) + 1));
|
||||||
|
BlockWrite(BatchULF1,TempStr,(Length(TempStr) + 1));
|
||||||
|
UNTIL (TotLoad >= BatchUL1.BULVTextSize);
|
||||||
|
BatchUL1.BULVPointer := TempVPointer;
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Write(BatchULFile,BatchUL1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(BatchULF);
|
||||||
|
Erase(BatchULF);
|
||||||
|
Close(BatchULF1);
|
||||||
|
ReName(BatchULF1,General.DataPath+'BATCHUL.EXT');
|
||||||
|
|
||||||
|
Dec(RecNum);
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchULFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum1 + 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Write(BatchULFile,BatchUL);
|
||||||
|
END;
|
||||||
|
Seek(BatchULFile,(FileSize(BatchULFile) - 1));
|
||||||
|
Truncate(BatchULFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchULFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumBatchULFiles <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^1Batch upload queue: ^5'+IntToStr(NumBatchULFiles)+' '+Plural('file',NumBatchULFiles));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch upload queue is now empty.');
|
||||||
|
SysOpLog('Cleared the batch upload queue.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr <> '?') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ClearBatchULQueue;
|
||||||
|
VAR
|
||||||
|
BatchULF1: FILE;
|
||||||
|
BatchUL1: BatchULRecordType;
|
||||||
|
TempStr: STRING;
|
||||||
|
TotLoad: Integer;
|
||||||
|
TempVPointer,
|
||||||
|
RecNum,
|
||||||
|
RecNum1: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchULFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch upload queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Clear batch upload queue? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
|
||||||
|
Reset(BatchULFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchULFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
IF (BatchUL.BULUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
BatchUL.BULVPointer := -1;
|
||||||
|
BatchUL.BULVTextSize := 0;
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Write(BatchULFile,BatchUL);
|
||||||
|
Dec(NumBatchULFiles);
|
||||||
|
|
||||||
|
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
|
||||||
|
Reset(BatchULF,1);
|
||||||
|
Assign(BatchULF1,General.DataPath+'BATCHUL.EX1');
|
||||||
|
ReWrite(BatchULF1,1);
|
||||||
|
FOR RecNum1 := 0 TO (FileSize(BatchULFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Read(BatchULFile,BatchUL1);
|
||||||
|
IF (BatchUL1.BULVPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
TempVPointer := (FileSize(BatchULF1) + 1);
|
||||||
|
Seek(BatchULF1,FileSize(BatchULF1));
|
||||||
|
TotLoad := 0;
|
||||||
|
Seek(BatchULF,(BatchUL1.BULVPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(BatchULF,TempStr[0],1);
|
||||||
|
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
|
||||||
|
Inc(TotLoad,(Length(TempStr) + 1));
|
||||||
|
BlockWrite(BatchULF1,TempStr,(Length(TempStr) + 1));
|
||||||
|
UNTIL (TotLoad >= BatchUL1.BULVTextSize);
|
||||||
|
BatchUL1.BULVPointer := TempVPointer;
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Write(BatchULFile,BatchUL1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(BatchULF);
|
||||||
|
Erase(BatchULF);
|
||||||
|
Close(BatchULF1);
|
||||||
|
ReName(BatchULF1,General.DataPath+'BATCHUL.EXT');
|
||||||
|
|
||||||
|
Print('Removed from batch upload queue: "^5'+BatchUL.BULFileName+'^1".');
|
||||||
|
SysOpLog('Batch UL Remove: "^5'+BatchUL.BULFileName+'^1".');
|
||||||
|
|
||||||
|
Dec(RecNum);
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchULFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum1 + 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Write(BatchULFile,BatchUL);
|
||||||
|
END;
|
||||||
|
Seek(BatchULFile,(FileSize(BatchULFile) - 1));
|
||||||
|
Truncate(BatchULFile);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchULFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
NL;
|
||||||
|
Print('The batch upload queue is now empty.');
|
||||||
|
SysOpLog('Cleared the batch upload queue.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BatchUpload(BiCleanUp: Boolean; TransferTime: LongInt);
|
||||||
|
TYPE
|
||||||
|
TotalsRecordType = RECORD
|
||||||
|
FilesUL,
|
||||||
|
FilesULCredit: Byte;
|
||||||
|
BytesUL,
|
||||||
|
BytesULCredit,
|
||||||
|
PointsULCredit: LongInt;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Totals: TotalsRecordType;
|
||||||
|
BatchUL1: BatchULRecordType;
|
||||||
|
BatchULF1: FILE;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
TempStr: STRING;
|
||||||
|
InputStr: AStr;
|
||||||
|
LineNum,
|
||||||
|
FileNumToList,
|
||||||
|
NumExtDesc: Byte;
|
||||||
|
TotLoad,
|
||||||
|
ReturnCode,
|
||||||
|
ProtocolNumber,
|
||||||
|
SaveFArea,
|
||||||
|
SaveFileArea,
|
||||||
|
NumFAreas,
|
||||||
|
FArea,
|
||||||
|
TempBULVTextSize: Integer;
|
||||||
|
TempVPointer,
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
RefundTime,
|
||||||
|
TakeAwayRefundTime,
|
||||||
|
TotConversionTime: LongInt;
|
||||||
|
AutoLogOff,
|
||||||
|
AHangUp,
|
||||||
|
WentToSysOp,
|
||||||
|
SaveTempPause,
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE UpFile;
|
||||||
|
VAR
|
||||||
|
GotPts: Integer;
|
||||||
|
ConversionTime: LongInt;
|
||||||
|
ArcOk,
|
||||||
|
Convt: Boolean;
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
|
||||||
|
ArcStuff(ArcOk,Convt,FileInfo.FileSize,ConversionTime,TRUE,TempDir+'UP\',FileInfo.FileName,FileInfo.Description);
|
||||||
|
|
||||||
|
Inc(TotConversionTime,ConversionTime);
|
||||||
|
|
||||||
|
UpdateFileInfo(FileInfo,FileInfo.FileName,GotPts);
|
||||||
|
|
||||||
|
IF (ArcOk) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Moving file to ^5'+MemFileArea.AreaName);
|
||||||
|
NL;
|
||||||
|
IF CopyMoveFile(FALSE,'',SQOutSp(TempDir+'UP\'+FileInfo.FileName),
|
||||||
|
SQOutSp(MemFileArea.ULPath+FileInfo.FileName),FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (Totals.FilesULCredit < 255) THEN
|
||||||
|
Inc(Totals.FilesULCredit);
|
||||||
|
|
||||||
|
IF ((Totals.BytesULCredit + FileInfo.FileSize) < 2147483647) THEN
|
||||||
|
Inc(Totals.BytesULCredit,FileInfo.FileSize)
|
||||||
|
ELSE
|
||||||
|
Totals.BytesULCredit := 2147483647;
|
||||||
|
|
||||||
|
IF ((Totals.PointsULCredit + GotPts) < 2147483647) THEN
|
||||||
|
Inc(Totals.PointsULCredit,GotPts)
|
||||||
|
ELSE
|
||||||
|
Totals.PointsULCredit := 2147483647;
|
||||||
|
|
||||||
|
IF (AACS(General.ULValReq)) OR (General.ValidateAllFiles) THEN
|
||||||
|
Include(FileInfo.FIFlags,FIOwnerCredited);
|
||||||
|
|
||||||
|
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
|
||||||
|
|
||||||
|
Star(SQOutSp(FileInfo.FileName)+' successfully uploaded.');
|
||||||
|
|
||||||
|
SysOpLog('^3Batch uploaded: "^5'+SQOutSp(FileInfo.FileName)+'^3" to ^5'+MemFileArea.AreaName+'.');
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Star('Upload not received.');
|
||||||
|
|
||||||
|
IF ((FileInfo.FileSize DIV 1024) >= General.MinResume) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Save file for a later resume? ',0,TRUE) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF CopyMoveFile(FALSE,'^5Progress: ',TempDir+'UP\'+FileInfo.FileName,MemFileArea.ULPath+FileInfo.FileName,TRUE) THEN
|
||||||
|
BEGIN
|
||||||
|
Include(FileInfo.FIFlags,FIResumeLater);
|
||||||
|
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT (FIResumeLater IN FileInfo.FIFlags)) THEN
|
||||||
|
Kill(TempDir+'UP\'+FileInfo.FileName);
|
||||||
|
|
||||||
|
SysOpLog('^3Errors batch uploading '+SQOutSp(FileInfo.FileName)+' - '+
|
||||||
|
AOnOff(FIResumeLater IN FileInfo.FIFlags,'file saved for resume','file deleted'));
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT ArcOk) AND (NOT BiCleanUp) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Inc(TakeAwayRefundTime,(FileInfo.FileSize DIV Rate));
|
||||||
|
|
||||||
|
Star('Time refund of '+FormattedTime(FileInfo.FileSize DIV Rate)+' will be taken away.');
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (NOT CheckDriveSpace('Batch upload',MemFileArea.ULPath,General.MinSpaceForUpload)) THEN
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
|
||||||
|
AutoLogOff := FALSE;
|
||||||
|
|
||||||
|
IF (BiCleanUp) THEN
|
||||||
|
RefundTime := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Batch upload (Statistics):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(NumBatchULFiles)+'^1');
|
||||||
|
|
||||||
|
IF (NumBatchULFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('BATCHUL0');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Warning! No upload batch files specified yet.');
|
||||||
|
Print('If you continue, and batch upload files, you will have to');
|
||||||
|
Print('enter file descriptions for each file after the batch upload');
|
||||||
|
Print('is complete.');
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintF('BATCHUL');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^1If you batch upload files IN ADDITION to the files already');
|
||||||
|
Print('specified in your upload batch queue, you must enter file');
|
||||||
|
Print('descriptions for them after the batch upload is complete.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
ProtocolNumber := DoProtocol(Protocol,TRUE,FALSE,TRUE,FALSE);
|
||||||
|
CASE ProtocolNumber OF
|
||||||
|
-1 : ;
|
||||||
|
-2 : Exit;
|
||||||
|
-3 : ;
|
||||||
|
-4 : ;
|
||||||
|
-5 : EditBatchULQueue;
|
||||||
|
ELSE
|
||||||
|
IF (InCom) THEN
|
||||||
|
BEGIN
|
||||||
|
PurgeDir(TempDir+'UP\',FALSE);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
AutoLogOff := PYNQ('Auto-logoff after file transfer? ',0,FALSE);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Ready to receive batch upload transfer.');
|
||||||
|
|
||||||
|
TimeLock := TRUE;
|
||||||
|
|
||||||
|
ExecProtocol('',
|
||||||
|
TempDir+'UP\',
|
||||||
|
FunctionalMCI(Protocol.EnvCmd,'','')
|
||||||
|
+#13#10+
|
||||||
|
General.ProtPath+FunctionalMCI(Protocol.ULCmd,'',''),
|
||||||
|
-1,
|
||||||
|
ReturnCode,
|
||||||
|
TransferTime);
|
||||||
|
|
||||||
|
TimeLock := FALSE;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Batch upload transfer complete.');
|
||||||
|
|
||||||
|
RefundTime := (TransferTime * (General.ULRefund DIV 100));
|
||||||
|
|
||||||
|
Inc(FreeTime,RefundTime);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
|
||||||
|
Reset(BatchULFile);
|
||||||
|
|
||||||
|
FillChar(Totals,SizeOf(Totals),0);
|
||||||
|
|
||||||
|
FindFirst(TempDir+'UP\*.*',AnyFile - Directory - VolumeID - Dos.Hidden - SysFile ,DirInfo);
|
||||||
|
WHILE (DosError = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(Totals.FilesUL);
|
||||||
|
Inc(Totals.BytesUL,DirInfo.Size);
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Totals.FilesUL = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('No uploads detected!^1');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
AHangUp := FALSE;
|
||||||
|
|
||||||
|
IF (HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ComPortSpeed > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
lStatus_Screen(100,'Hanging up and taking phone off hook...',FALSE,InputStr);
|
||||||
|
DoPhoneHangUp(FALSE);
|
||||||
|
DoPhoneOffHook(FALSE);
|
||||||
|
ComPortSpeed := 0;
|
||||||
|
END;
|
||||||
|
HangUp := FALSE;
|
||||||
|
AHangUp := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT AHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^5Batch upload (Totals):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(Totals.FilesUL)+'^1');
|
||||||
|
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesUL,FALSE)+'^1');
|
||||||
|
Star('^1Upload time : ^5'+FormattedTime(TransferTime)+'^1');
|
||||||
|
Star('^1Transfer rate : ^5'+FormatNumber(GetCPS(Totals.BytesUL,TransferTime))+' cps^1');
|
||||||
|
Star('^1Time refund : ^5'+FormattedTime(RefundTime)+'^1');
|
||||||
|
IF (AutoLogOff) THEN
|
||||||
|
CountDown;
|
||||||
|
END;
|
||||||
|
|
||||||
|
TotConversionTime := 0;
|
||||||
|
TakeAwayRefundTime := 0;
|
||||||
|
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchULFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
IF (BatchUL.BULUserNum = UserNum) AND Exist(TempDir+'UP\'+BatchUL.BULFileName) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileName := BatchUL.BULFileName;
|
||||||
|
FileArea := BatchUL.BULSection;
|
||||||
|
NL;
|
||||||
|
Star('Found: "^5'+FileInfo.FileName+'^1"');
|
||||||
|
IF (General.FileDiz) AND (DizExists(TempDir+'UP\'+FileInfo.FileName)) THEN
|
||||||
|
GetDiz(FileInfo,ExtendedArray,NumExtDesc)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileInfo.Description := BatchUL.BULDescription;
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),#0);
|
||||||
|
IF (BatchUL.BULVPointer <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
|
||||||
|
Reset(BatchULF,1);
|
||||||
|
LineNum := 1;
|
||||||
|
TempBULVTextSize := 0;
|
||||||
|
Seek(BatchULF,(BatchUL.BULVPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(BatchULF,TempStr[0],1);
|
||||||
|
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
|
||||||
|
Inc(TempBULVTextSize,(Length(TempStr) + 1));
|
||||||
|
ExtendedArray[LineNum] := TempStr;
|
||||||
|
Inc(LineNum);
|
||||||
|
UNTIL (TempBULVTextSize >= BatchUL.BULVTextSize);
|
||||||
|
BatchUL.BULVPointer := -1;
|
||||||
|
BatchUL.BULVTextSize := 0;
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Write(BatchULFile,BatchUL);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UpFile;
|
||||||
|
Reset(BatchULF,1);
|
||||||
|
Assign(BatchULF1,General.DataPath+'BATCHUL.EX1');
|
||||||
|
ReWrite(BatchULF1,1);
|
||||||
|
FOR RecNum1 := 0 TO (FileSize(BatchULFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Read(BatchULFile,BatchUL1);
|
||||||
|
IF (BatchUL1.BULVPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
TempVPointer := (FileSize(BatchULF1) + 1);
|
||||||
|
Seek(BatchULF1,FileSize(BatchULF1));
|
||||||
|
TotLoad := 0;
|
||||||
|
Seek(BatchULF,(BatchUL1.BULVPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(BatchULF,TempStr[0],1);
|
||||||
|
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
|
||||||
|
Inc(TotLoad,(Length(TempStr) + 1));
|
||||||
|
BlockWrite(BatchULF1,TempStr,(Length(TempStr) + 1));
|
||||||
|
UNTIL (TotLoad >= BatchUL1.BULVTextSize);
|
||||||
|
BatchUL1.BULVPointer := TempVPointer;
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Write(BatchULFile,BatchUL1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(BatchULF);
|
||||||
|
Erase(BatchULF);
|
||||||
|
Close(BatchULF1);
|
||||||
|
ReName(BatchULF1,General.DataPath+'BATCHUL.EXT');
|
||||||
|
Dec(RecNum);
|
||||||
|
IF (RecNum >= 0) AND (RecNum <= (FileSize(BatchULFile) - 2)) THEN
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchULFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum1 + 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
Seek(BatchULFile,RecNum1);
|
||||||
|
Write(BatchULFile,BatchUL);
|
||||||
|
END;
|
||||||
|
Seek(BatchULFile,(FileSize(BatchULFile) - 1));
|
||||||
|
Truncate(BatchULFile);
|
||||||
|
Dec(NumBatchULFiles);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FindFirst(TempDir+'UP\*.*',AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo);
|
||||||
|
WHILE (DosError = 0) DO
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileName := DirInfo.Name;
|
||||||
|
NL;
|
||||||
|
Star('Found: "^5'+FileInfo.FileName+'^1"');
|
||||||
|
|
||||||
|
IF (General.SearchDup) THEN
|
||||||
|
IF (NOT FileSysOp) OR (PYNQ('Search for duplicates? ',0,FALSE)) THEN
|
||||||
|
IF (SearchForDups(FileInfo.FileName)) THEN
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
IF (General.SearchDup) AND (SearchForDups(FileInfo.FileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
Star('Deleting duplicate file: "^5'+FileInfo.FileName+'^1"');
|
||||||
|
Kill(TempDir+'UP\'+FileInfo.FileName);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
WentToSysOp := FALSE;
|
||||||
|
IF (General.FileDiz) AND (DizExists(TempDir+'UP\'+FileInfo.FileName)) THEN
|
||||||
|
GetDiz(FileInfo,ExtendedArray,NumExtDesc)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
GetFileDescription(FileInfo,ExtendedArray,NumExtDesc,WentToSysOp);
|
||||||
|
IF (AHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.Description := 'Not in upload batch queue - hungup after transfer';
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),#0);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (WentToSysOp) THEN
|
||||||
|
FileArea := General.ToSysOpDir
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (AHangUp) THEN
|
||||||
|
FArea := SaveFileArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
FArea := 1;
|
||||||
|
NumFAreas := 0;
|
||||||
|
LightBarCmd := 1;
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveFArea := FArea;
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
LFileAreaList(FArea,NumFAreas,5,FALSE);
|
||||||
|
|
||||||
|
FileAreaScanInput('%LFMove to which file area? (^5'+IntToStr(LowFileArea)+'^4-^5'+IntToStr(HighFileArea)+'^4)'+
|
||||||
|
' [^5?^4=^5First^4,^5<CR>^4=^5Next^4]: ',Length(IntToStr(HighFileArea)),InputStr,'[]?',
|
||||||
|
LowFileArea,HighFileArea);
|
||||||
|
|
||||||
|
IF (InputStr = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
FArea := (SaveFArea - ((PageLength - 5) * 2));
|
||||||
|
IF (FArea < 1) THEN
|
||||||
|
FArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (FArea > NumFileAreas) THEN
|
||||||
|
FArea := SaveFArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry');
|
||||||
|
Print('^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page');
|
||||||
|
Print('^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry');
|
||||||
|
Print('^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down');
|
||||||
|
Print('^1(^3[^1)Previous page ^1(^3]^1)Next page');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) < LowFileArea) OR (StrToInt(InputStr) > HighFileArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from '+IntToStr(LowFileArea)+' to '+IntToStr(HighFileArea)+'!^1');
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := 1
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FArea := CompFileArea(StrToInt(InPutStr),1);
|
||||||
|
IF (FArea <> FileArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FArea <> FileArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have access to this file area.^1');
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := 1
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(FArea);
|
||||||
|
IF (NOT AACS(MemFileArea.ULACS)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have the required upload access for this file area.^1');
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := 1
|
||||||
|
END
|
||||||
|
ELSE IF ((NOT FileSysOp) AND (Exist(MemFileArea.ULPath+FileInfo.FileName)) OR
|
||||||
|
(Exist(MemFileArea.DLPath+FileInfo.FileName))) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The file already exists in the upload or download path.^1');
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := 1
|
||||||
|
END
|
||||||
|
ELSE IF (FileSize(FileInfoFile) >= MemFileArea.MaxFiles) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7This file area is full.^1');
|
||||||
|
InputStr := '?';
|
||||||
|
FArea := 1
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (NOT (InputStr[1] IN [^M,'?'])) OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
END;
|
||||||
|
FileArea := FArea;
|
||||||
|
END;
|
||||||
|
UpFile;
|
||||||
|
END;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
|
||||||
|
lil := 0;
|
||||||
|
|
||||||
|
Dec(RefundTime,TakeAwayRefundTime);
|
||||||
|
|
||||||
|
Dec(FreeTime,TakeAwayRefundTime);
|
||||||
|
|
||||||
|
SysOpLog('^3 - Totals:'+
|
||||||
|
' '+FormatNumber(Totals.FilesUL)+' '+Plural('file',Totals.FilesUL)+
|
||||||
|
', '+ConvertBytes(Totals.BytesUL,FALSE)+
|
||||||
|
', '+FormattedTime(TransferTime)+' tt'+
|
||||||
|
', '+FormatNumber(GetCPS(Totals.BytesUL,Transfertime))+' cps'+
|
||||||
|
', '+FormattedTime(RefundTime)+' rt');
|
||||||
|
|
||||||
|
IF ((UploadsToday + Totals.FilesULCredit) < 2147483647) THEN
|
||||||
|
Inc(UploadsToday,Totals.FilesULCredit)
|
||||||
|
ELSE
|
||||||
|
UploadsToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((UploadKBytesToday + (Totals.BytesULCredit DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(UploadKBytesToday,(Totals.BytesULCredit DIV 1024))
|
||||||
|
ELSE
|
||||||
|
UploadKBytesToday := 2147483647;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Batch upload (Credits):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(Totals.FilesULCredit));
|
||||||
|
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesULCredit,FALSE));
|
||||||
|
Star('^1Total file points : ^5'+FormatNumber(Totals.PointsULCredit));
|
||||||
|
Star('^1Time refund : ^5'+FormattedTime(RefundTime)+'^1');
|
||||||
|
|
||||||
|
IF (AACS(General.ULValReq)) OR (General.ValidateAllFiles) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF ((ThisUser.Uploads + Totals.FilesULCredit) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.Uploads,Totals.FilesULCredit)
|
||||||
|
ELSE
|
||||||
|
ThisUser.Uploads := 2147483647;
|
||||||
|
|
||||||
|
IF (ThisUser.UK + (Totals.BytesULCredit DIV 1024) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.UK,(Totals.BytesULCredit DIV 1024))
|
||||||
|
ELSE
|
||||||
|
ThisUser.UK := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.FilePoints + Totals.PointsULCredit) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.FilePoints,Totals.PointsULCredit)
|
||||||
|
ELSE
|
||||||
|
ThisUser.FilePoints := 2147483647;
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^5You will receive upload credit after the SysOp validates the '+Plural('file',Totals.FilesULCredit)+'!');
|
||||||
|
Totals.FilesULCredit := 0;
|
||||||
|
Totals.BytesULCredit := 0;
|
||||||
|
Totals.PointsULCredit := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ChopTime <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
ChopTime := ((ChopTime + RefundTime) - TakeAwayRefundTime);
|
||||||
|
FreeTime := ((FreeTime - RefundTime) + TakeAwayRefundTime);
|
||||||
|
NL;
|
||||||
|
Star('You will receive your time refund after the event.');
|
||||||
|
RefundTime := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
SysOpLog('^3 - Credits:'+
|
||||||
|
' '+FormatNumber(Totals.FilesULCredit)+' '+Plural('file',Totals.FilesULCredit)+
|
||||||
|
', '+ConvertBytes(Totals.BytesULCredit,FALSE)+
|
||||||
|
', '+FormatNumber(Totals.PointsULCredit)+' fp'+
|
||||||
|
', '+FormattedTime(RefundTime)+' rt');
|
||||||
|
|
||||||
|
IF (NumBatchULFiles > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
NL;
|
||||||
|
Print('^5Batch upload (Not Transferred):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(NumBatchULFiles));
|
||||||
|
SysOpLog('^3 - Not uploaded:'+
|
||||||
|
' '+FormatNumber(NumBatchULFiles)+' '+Plural('file',NumBatchULFiles));
|
||||||
|
END;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Thanks for the '+Plural('file',Totals.FilesULCredit)+', '+Caps(ThisUser.Name)+'!');
|
||||||
|
PauseScr(False);
|
||||||
|
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
|
||||||
|
Close(BatchULFile);
|
||||||
|
|
||||||
|
IF (AHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
lStatus_Screen(100,'Hanging up phone again...',FALSE,InputStr);
|
||||||
|
DoPhoneHangUp(FALSE);
|
||||||
|
HangUp := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BatchDLULInfo;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchDLFiles <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^9>> ^3You have ^5'+FormatNumber(NumBatchDLFiles)+'^3 '+Plural('file',NumBatchDLFiles)+
|
||||||
|
' left in your batch download queue.^1');
|
||||||
|
END;
|
||||||
|
IF (NumBatchULFiles <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^9>> ^3You have ^5'+FormatNumber(NumBatchULFiles)+'^3 '+Plural('file',NumBatchULFiles)+
|
||||||
|
' left in your batch upload queue.^1');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,128 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File13;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE Sort;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
File0;
|
||||||
|
|
||||||
|
PROCEDURE SortDir(NumFiles: Word);
|
||||||
|
VAR
|
||||||
|
FileInfo1: FileInfoRecordType;
|
||||||
|
NumSorted,
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
Gap: Word;
|
||||||
|
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(FileInfoFile,(RecNum - 1));
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
Seek(FileInfoFile,(RecNum1 - 1));
|
||||||
|
Read(FileInfoFile,FileInfo1);
|
||||||
|
IF (FileInfo.FileName > FileInfo1.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,(RecNum - 1));
|
||||||
|
Write(FileInfoFile,FileInfo1);
|
||||||
|
Seek(FileInfoFile,(RecNum1 - 1));
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
Inc(NumSorted);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (NumSorted = 0) AND (Gap = 1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
SysOpLog('Error sorting files!');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SortFiles(FArea: Integer; VAR TotFiles: LongInt; VAR TotAreas: Integer);
|
||||||
|
VAR
|
||||||
|
NumFiles: Word;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) THEN
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
NumFiles := FileSize(FileInfoFile);
|
||||||
|
Prompt('^1Sorting ^5'+MemFileArea.AreaName+' #'+IntToStr(FileArea)+'^1 ('+FormatNumber(NumFiles)+
|
||||||
|
' '+Plural('file',NumFiles)+')');
|
||||||
|
IF (NumFiles <> 0) THEN
|
||||||
|
SortDir(NumFiles);
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
Inc(TotAreas);
|
||||||
|
Inc(TotFiles,NumFiles);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Sort;
|
||||||
|
VAR
|
||||||
|
FArea,
|
||||||
|
TotAreas,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
TotFiles: LongInt;
|
||||||
|
Global,
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (NOT SortFilesOnly) THEN
|
||||||
|
Global := PYNQ('Sort all file areas? ',0,FALSE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Global := TRUE;
|
||||||
|
CLS;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
TotFiles := 0;
|
||||||
|
TotAreas := 0;
|
||||||
|
IF (NOT Global) THEN
|
||||||
|
SortFiles(FileArea,TotFiles,TotAreas)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
TempPause := FALSE;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF FileAreaAC(FArea) OR (SortFilesOnly) THEN
|
||||||
|
SortFiles(FArea,TotFiles,TotAreas);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Sorted '+FormatNumber(TotFiles)+' '+Plural('file',TotFiles)+
|
||||||
|
' in '+FormatNumber(TotAreas)+' '+Plural('area',TotAreas));
|
||||||
|
SysOpLog('Sorted file areas');
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,190 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File14;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION IsGIFExt(CONST FileName: AStr): Boolean;
|
||||||
|
FUNCTION IsGIFDesc(CONST Description: AStr): Boolean;
|
||||||
|
FUNCTION GetGIFSpecs(CONST FileName: AStr; Description: AStr; Which: Byte): AStr;
|
||||||
|
PROCEDURE AddGIFSpecs;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
File0,
|
||||||
|
File11;
|
||||||
|
|
||||||
|
FUNCTION IsGIFExt(CONST FileName: AStr): Boolean;
|
||||||
|
VAR
|
||||||
|
TempFN: AStr;
|
||||||
|
BEGIN
|
||||||
|
TempFN := AllCaps(SQOutSp(StripName(FileName)));
|
||||||
|
IsGIFExt := (Copy(TempFN,(Length(TempFN) - 2),3) = 'GIF');
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION IsGIFDesc(CONST Description: AStr): Boolean;
|
||||||
|
BEGIN
|
||||||
|
IsGIFDesc := (Pos('< Bad GIF >',Description) <> 0) OR
|
||||||
|
(Pos('< Missing GIF >',Description) <> 0) OR
|
||||||
|
((Description[1] = '(') AND (Pos('x',Description) IN [1..7]) AND (Pos('c)',Description) <> 0));
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetGIFSpecs(CONST FileName: AStr; Description: AStr; Which: Byte): AStr;
|
||||||
|
VAR
|
||||||
|
F: FILE;
|
||||||
|
Buf: ARRAY [1..11] OF Byte;
|
||||||
|
Sig: AStr;
|
||||||
|
X,
|
||||||
|
Y,
|
||||||
|
C,
|
||||||
|
C1,
|
||||||
|
Counter,
|
||||||
|
NumRead: Word;
|
||||||
|
BEGIN
|
||||||
|
FillChar(Buf,SizeOf(Buf),0);
|
||||||
|
Sig := '';
|
||||||
|
X := 0;
|
||||||
|
Y := 0;
|
||||||
|
C := 0;
|
||||||
|
NumRead := 0;
|
||||||
|
Assign(F,FileName);
|
||||||
|
Reset(F,1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Sig := '< Missing GIF >'
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
BlockRead(F,Buf,SizeOf(Buf),NumRead);
|
||||||
|
Close(F);
|
||||||
|
IF (NumRead <> 11) THEN
|
||||||
|
Sig := '< Bad GIF >'
|
||||||
|
ELSE IF (Buf[1] <> Ord('G')) OR (Buf[2] <> Ord('I')) OR (Buf[3] <> Ord('F')) THEN
|
||||||
|
Sig := '< Missing GIF >';
|
||||||
|
END;
|
||||||
|
IF (Sig <> '< Bad GIF >') AND (Sig <> '< Missing GIF >') THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
Sig := Sig + Chr(Buf[Counter]);
|
||||||
|
X := ((Buf[7] + Buf[8]) * 256);
|
||||||
|
Y := ((Buf[9] + Buf[10]) * 256);
|
||||||
|
C1 := ((Buf[11] AND 7) + 1);
|
||||||
|
C := 1;
|
||||||
|
FOR Counter := 1 TO C1 DO
|
||||||
|
C := (C * 2);
|
||||||
|
END;
|
||||||
|
IF (Which = 1) THEN
|
||||||
|
GetGIFSpecs := '^3'+Align(StripName(FileName))+
|
||||||
|
' ^5'+PadLeftStr(IntToStr(X)+'x'+IntToStr(Y),11)+
|
||||||
|
' '+PadLeftStr(IntToStr(C)+' colors',10)+
|
||||||
|
' '+AOnOff((Sig = '< Missing GIF >') OR (Sig = '< Bad GIF >'),'^8'+Sig+'^1','^7'+Sig+'^1')
|
||||||
|
ELSE IF (Which IN [2,3]) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Sig = '< Missing GIF >') THEN
|
||||||
|
GetGifSpecs := Copy('^8< Missing GIF > ^9'+Description,1,50)
|
||||||
|
ELSE IF (Sig = '< Bad GIF >') THEN
|
||||||
|
GetGIFSpecs := Copy('^8< Bad GIF > ^9'+Description,1,50)
|
||||||
|
ELSE
|
||||||
|
GetGIFSPecs := Copy('('+IntToStr(X)+'x'+IntToStr(Y)+','+IntToStr(C)+'c) '+Description,1,50);
|
||||||
|
END;
|
||||||
|
IF (Sig = '< Missing GIF >') OR (Sig = '< Bad GIF >') THEN
|
||||||
|
SysOpLog('^7Bad or missing GIF: "^5'+StripName(FileName)+'^7" in ^5'+MemFileArea.AreaName);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE AddGIFSpecs;
|
||||||
|
VAR
|
||||||
|
FArrayRecNum: Byte;
|
||||||
|
FArea,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
TotalFiles: LongInt;
|
||||||
|
|
||||||
|
PROCEDURE AddFileAreaGIFSpecs(FArea: Integer; VAR FArrayRecNum1: Byte; VAR TotalFiles1: LongInt);
|
||||||
|
VAR
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
Found: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(FileInfo,'*.*',DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (FAUseGifSpecs IN MemFileArea.FAFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
CLS;
|
||||||
|
Found := FALSE;
|
||||||
|
Prompt('^1Scanning ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FArea,0))+'^1 ...');
|
||||||
|
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
IF (IsGIFExt(FileInfo.FileName) AND (NOT IsGIFDesc(FileInfo.Description))) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.Description := GetGIFSpecs(MemFileArea.DLPath+SQOutSp(FileInfo.FileName),FileInfo.Description,3);
|
||||||
|
WITH FArray[FArrayRecNum1] DO
|
||||||
|
BEGIN
|
||||||
|
FArrayFileArea := FileArea;
|
||||||
|
FArrayDirFileRecNum := DirFileRecNum;
|
||||||
|
END;
|
||||||
|
lDisplay_File(FileInfo,FArrayRecNum1,'',FALSE);
|
||||||
|
Inc(FArrayRecNum1);
|
||||||
|
IF (FArrayRecNum1 = 100) THEN
|
||||||
|
FArrayRecNum1 := 0;
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
Inc(TotalFiles1);
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
Wkey;
|
||||||
|
NRecNo(FileInfo,DirFileRecNum);
|
||||||
|
END;
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FArea,0))));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Adding GIF Resolution to file descriptions -');
|
||||||
|
InitFArray(FArray);
|
||||||
|
FArrayRecNum := 0;
|
||||||
|
TotalFiles := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
|
||||||
|
AddFileAreaGIFSpecs(FileArea,FArrayRecNum,TotalFiles)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
AddFileAreaGIFSpecs(FArea,FArrayRecNum,TotalFiles);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Added GIF specifications to '+FormatNumber(TotalFiles)+' '+Plural('file',Totalfiles)+'.');
|
||||||
|
SysOpLog('Added GIF specifications to '+FormatNumber(TotalFiles)+' '+Plural('file',Totalfiles)+'.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,125 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File2;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION CopyMoveFile(CopyFile: Boolean; DisplayStr: AStr; CONST SrcName,DestName: AStr; CONST ShowProg: Boolean): Boolean;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
FUNCTION CopyMoveFile(CopyFile: Boolean; DisplayStr: AStr; CONST SrcName,DestName: AStr; CONST ShowProg: Boolean): Boolean;
|
||||||
|
VAR
|
||||||
|
Buffer: ARRAY [1..8192] OF Byte;
|
||||||
|
FromF,
|
||||||
|
ToF: FILE;
|
||||||
|
CurDir: AStr;
|
||||||
|
ProgressStr: Str3;
|
||||||
|
NumRead: Word;
|
||||||
|
TotalNumRead,
|
||||||
|
FileDate: LongInt;
|
||||||
|
OK,
|
||||||
|
Nospace: Boolean;
|
||||||
|
BEGIN
|
||||||
|
OK := TRUE;
|
||||||
|
NoSpace := FALSE;
|
||||||
|
GetDir(0,CurDir);
|
||||||
|
IF (ShowProg) THEN
|
||||||
|
Prompt(DisplayStr);
|
||||||
|
IF (NOT CopyFile) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(FromF,SrcName);
|
||||||
|
ReName(FromF,DestName);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
OK := FALSE
|
||||||
|
ELSE IF (ShowProg) THEN
|
||||||
|
Print('^5100%^1')
|
||||||
|
END;
|
||||||
|
IF (NOT OK) OR (CopyFile) THEN
|
||||||
|
BEGIN
|
||||||
|
OK := TRUE;
|
||||||
|
IF (SrcName = DestName) THEN
|
||||||
|
OK := FALSE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Assign(FromF,SrcName);
|
||||||
|
Reset(FromF,1);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
OK := FALSE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
GetFTime(FromF,FileDate);
|
||||||
|
IF ((FileSize(FromF) DIV 1024) >= DiskKBFree(DestName)) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(FromF);
|
||||||
|
NoSpace := TRUE;
|
||||||
|
OK := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Assign(ToF,DestName);
|
||||||
|
ReWrite(ToF,1);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
OK := FALSE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SetFTime(ToF,FileDate);
|
||||||
|
IF (ShowProg) THEN
|
||||||
|
Prompt('^5 0%^1');
|
||||||
|
TotalNumRead := 0;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(FromF,Buffer,SizeOf(Buffer),NumRead);
|
||||||
|
BlockWrite(ToF,Buffer,NumRead);
|
||||||
|
Inc(TotalNumRead,NumRead);
|
||||||
|
IF (ShowProg) AND (FileSize(FromF) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Str(Trunc(TotalNumRead / FileSize(FromF) * 100):3,ProgressStr);
|
||||||
|
Prompt(^H^H^H^H+'^5'+ProgressStr+'%^1');
|
||||||
|
END;
|
||||||
|
UNTIL (NumRead < SizeOf(Buffer));
|
||||||
|
IF (ShowProg) THEN
|
||||||
|
BEGIN
|
||||||
|
UserColor(1);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
Close(ToF);
|
||||||
|
Close(FromF);
|
||||||
|
IF (NOT CopyFile) AND (OK) AND (NOT NoSpace) THEN
|
||||||
|
Kill(SrcName);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
ChDir(CurDir);
|
||||||
|
IF (NoSpace) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ShowProg) THEN
|
||||||
|
Print('^7destination drive full!^1');
|
||||||
|
SysOpLog('^7Error '+AOnOff(CopyFile,'copying','moving')+' (No-Space): "'+SrcName+'" to "'+DestName+'"!');
|
||||||
|
END
|
||||||
|
ELSE IF (NOT Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ShowProg) THEN
|
||||||
|
Print('^7failed!^1');
|
||||||
|
SysOpLog('^7Error '+AOnOff(CopyFile,'copying','moving')+' (I/O): "'+SrcName+'" to "'+DestName+'"!');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
SysOpLog('^1'+AOnOff(CopyFile,'Copied','Moved')+' file: "^5'+SrcName+'^1" to "^5'+DestName+'^1".');
|
||||||
|
CopyMoveFile := (OK) AND (NOT NoSpace);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,115 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File3;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ReCheck;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common,
|
||||||
|
File0,
|
||||||
|
File1;
|
||||||
|
|
||||||
|
PROCEDURE CheckFiles(FArea: Integer; CheckDiz: Boolean);
|
||||||
|
VAR
|
||||||
|
FN: AStr;
|
||||||
|
NumExtDesc: Byte;
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
FSize: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(FileInfo,'*.*',DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
NL;
|
||||||
|
Print('^1Checking ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FArea,0))+'^1 ...');
|
||||||
|
WHILE (DirFileRecNum <> - 1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
|
||||||
|
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
|
||||||
|
FN := MemFileArea.DLPath+SQOutSp(FileInfo.FileName)
|
||||||
|
ELSE
|
||||||
|
FN := MemFileArea.ULPath+SQOutSp(FileInfo.FileName);
|
||||||
|
|
||||||
|
FSize := GetFileSize(FN);
|
||||||
|
IF (FSize = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileSize := 0;
|
||||||
|
Include(FileInfo.FIFlags,FIIsRequest);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileSize := FSize;
|
||||||
|
Exclude(FileInfo.FIFlags,FIIsRequest);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (CheckDiz) AND (DizExists(FN)) THEN
|
||||||
|
BEGIN
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
|
||||||
|
GetDiz(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
WriteFV(FileInfo,DirFileRecNum,ExtendedArray);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
|
||||||
|
NRecNo(FileInfo,DirFileRecNum);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReCheck;
|
||||||
|
VAR
|
||||||
|
SaveFileArea,
|
||||||
|
FArea: Integer;
|
||||||
|
CheckDiz,
|
||||||
|
SaveConfSystem,
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
BEGIN
|
||||||
|
CheckDiz := PYNQ('%LFReimport descriptions? ',0,FALSE);
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Recheck all file areas? ',0,FALSE)) THEN
|
||||||
|
CheckFiles(FileArea,CheckDiz)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Checkfiles(FArea,CheckDiz);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,251 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File4;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ExecProtocol(TextFN,
|
||||||
|
Dir,
|
||||||
|
BatLine: AStr;
|
||||||
|
OKLevel: Integer;
|
||||||
|
VAR ReturnCode: Integer;
|
||||||
|
VAR TransferTime: LongInt);
|
||||||
|
FUNCTION FindReturnCode(ProtCode: ProtocolCodeType; XBStat: PRFlagSet; ReturnCode: AStr): Boolean;
|
||||||
|
FUNCTION DoProtocol(VAR Protocol: ProtocolRecordType; UL,DL,Batch,Resume: Boolean): Integer;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
ExecBat,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
FUNCTION FindReturnCode(ProtCode: ProtocolCodeType; XBStat: PRFlagSet; ReturnCode: AStr): Boolean;
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
Found: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FindReturnCode := FALSE;
|
||||||
|
Found := FALSE;
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
IF (ProtCode[Counter] <> '') THEN
|
||||||
|
IF (Pos(ProtCode[Counter],Copy(ReturnCode,1,Length(ProtCode[Counter]))) <> 0) THEN
|
||||||
|
Found := TRUE;
|
||||||
|
IF (Found) AND (NOT (ProtXferOkCode IN Protocol.PRFlags)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (NOT Found) AND (ProtXferOkCode IN Protocol.PRFlags) THEN
|
||||||
|
Exit;
|
||||||
|
FindReturnCode := Found;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ExecProtocol(TextFN,
|
||||||
|
Dir,
|
||||||
|
BatLine: AStr;
|
||||||
|
OKLevel: Integer;
|
||||||
|
VAR ReturnCode: Integer;
|
||||||
|
VAR TransferTime: LongInt);
|
||||||
|
VAR
|
||||||
|
SaveSwapShell,
|
||||||
|
ResultOk: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
SaveNAvail := (NAvail IN NodeR.Status);
|
||||||
|
Exclude(NodeR.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
|
||||||
|
TransferTime := GetPackDateTime;
|
||||||
|
|
||||||
|
IF (TextFN <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
UserColor(1);
|
||||||
|
ReturnCode := 0;
|
||||||
|
PrintF(TextFN);
|
||||||
|
IF (NoFile) THEN
|
||||||
|
ReturnCode := 2;
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
UserColor(1);
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveSwapShell := General.SwapShell;
|
||||||
|
General.SwapShell := FALSE;
|
||||||
|
ExecWindow(ResultOK,
|
||||||
|
Dir,
|
||||||
|
BatLine,
|
||||||
|
OKLevel,
|
||||||
|
ReturnCode);
|
||||||
|
General.SwapShell := SaveSwapShell;
|
||||||
|
END;
|
||||||
|
|
||||||
|
TransferTime := (GetPackDateTime - TransferTime);
|
||||||
|
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
IF (SaveNAvail) THEN
|
||||||
|
Include(NodeR.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION OkProt(Protocol: ProtocolRecordType; UL,DL,Batch,Resume: Boolean): Boolean;
|
||||||
|
VAR
|
||||||
|
ULDLCmdStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
OkProt := FALSE;
|
||||||
|
WITH Protocol DO
|
||||||
|
BEGIN
|
||||||
|
IF (UL) THEN
|
||||||
|
ULDLCmdStr := ULCmd
|
||||||
|
ELSE IF (DL) THEN
|
||||||
|
ULDLCmdStr := DLCmd
|
||||||
|
ELSE
|
||||||
|
ULDLCmdStr := '';
|
||||||
|
IF (ULDLCmdStr = '') THEN
|
||||||
|
Exit;
|
||||||
|
IF (ULDLCmdStr = 'NEXT') AND ((UL) OR (Batch) OR (Resume)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (ULDLCmdStr = 'ASCII') AND ((UL) OR (Batch) OR (Resume)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (ULDLCmdStr = 'BATCH') AND ((Batch) OR (Resume)) AND (NOT Write_Msg) THEN
|
||||||
|
Exit;
|
||||||
|
IF (Batch <> (ProtIsBatch in PRFlags)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (Resume <> (ProtIsResume in PRFlags)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (ProtReliable in PRFlags) AND (NOT Reliable) THEN
|
||||||
|
Exit;
|
||||||
|
IF (NOT (ProtActive in PRFlags)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (NOT AACS(ACS)) THEN
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
OkProt := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ShowProts(VAR CmdStr: AStr; UL,DL,Batch,Resume: Boolean);
|
||||||
|
VAR
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
NoFile := TRUE;
|
||||||
|
IF (Resume) THEN
|
||||||
|
PrintF('PROTRES')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Batch) THEN
|
||||||
|
IF (UL) THEN
|
||||||
|
PrintF('PROTBUL')
|
||||||
|
ELSE
|
||||||
|
PrintF('PROTBDL')
|
||||||
|
ELSE IF (UL) THEN
|
||||||
|
PrintF('PROTSUL')
|
||||||
|
ELSE
|
||||||
|
PrintF('PROTSDL');
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CmdStr := '';
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= NumProtocols) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNum - 1));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
IF (OkProt(Protocol,UL,DL,Batch,Resume)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NoFile) AND (Protocol.Description <> '') THEN
|
||||||
|
Print(Protocol.Description);
|
||||||
|
IF (Protocol.CKeys = 'ENTER') then
|
||||||
|
CmdStr := CmdStr + ^M
|
||||||
|
ELSE
|
||||||
|
CmdStr := CmdStr + Protocol.CKeys[1];
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
IF (NoFile) THEN
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION FindProt(Cmd: Char; UL,DL,Batch,Resume: Boolean): Integer;
|
||||||
|
VAR
|
||||||
|
ULDLCmdStr: AStr;
|
||||||
|
RecNum,
|
||||||
|
RecNum1: Integer;
|
||||||
|
BEGIN
|
||||||
|
RecNum1 := -99;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= NumProtocols) AND (RecNum1 = -99) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNum - 1));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
IF (Cmd = Protocol.Ckeys[1]) OR ((Cmd = ^M) AND (Protocol.Ckeys = 'ENTER')) THEN
|
||||||
|
IF (OkProt(Protocol,UL,DL,Batch,Resume)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (UL) THEN
|
||||||
|
ULDLCmdStr := Protocol.ULCmd
|
||||||
|
ELSE IF (DL) THEN
|
||||||
|
ULDLCmdStr := Protocol.DLCmd
|
||||||
|
ELSE
|
||||||
|
ULDLCmdStr := '';
|
||||||
|
IF (ULDLCmdStr = 'ASCII') THEN
|
||||||
|
RecNum1 := -1
|
||||||
|
ELSE IF (ULDLCmdStr = 'QUIT') THEN
|
||||||
|
RecNum1 := -2
|
||||||
|
ELSE IF (ULDLCmdStr = 'NEXT') THEN
|
||||||
|
RecNum1 := -3
|
||||||
|
ELSE IF (ULDLCmdStr = 'BATCH') THEN
|
||||||
|
RecNum1 := -4
|
||||||
|
ELSE IF (ULDLCmdStr = 'EDIT') THEN
|
||||||
|
RecNum1 := -5
|
||||||
|
ELSE IF (ULDLCmdStr <> '') THEN
|
||||||
|
RecNum1 := RecNum;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
FindProt := RecNum1;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION DoProtocol(VAR Protocol: ProtocolRecordType; UL,DL,Batch,Resume: Boolean): Integer;
|
||||||
|
VAR
|
||||||
|
CmdStr: AStr;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
REPEAT
|
||||||
|
ShowProts(CmdStr,UL,DL,Batch,Resume);
|
||||||
|
{ Prompt('%DFPROTLIST%^4Selection^2: ');}
|
||||||
|
lRGLngStr(17,FALSE);;
|
||||||
|
OneK(Cmd,CmdStr,TRUE,TRUE);
|
||||||
|
RecNum := FindProt(Cmd,UL,DL,Batch,Resume);
|
||||||
|
IF (RecNum = -99) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Invalid option.');
|
||||||
|
END
|
||||||
|
ELSE IF (RecNum >= 1) AND (RecNum <= NumProtocols) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNum - 1));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
END
|
||||||
|
UNTIL (RecNum <> -99) OR (HangUp);
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
DoProtocol := RecNum;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,804 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File5;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE MiniDOS;
|
||||||
|
PROCEDURE UploadAll;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common,
|
||||||
|
Arcview,
|
||||||
|
Archive1,
|
||||||
|
ExecBat,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File2,
|
||||||
|
File8,
|
||||||
|
File9,
|
||||||
|
File11,
|
||||||
|
MultNode,
|
||||||
|
Sysop4;
|
||||||
|
|
||||||
|
PROCEDURE MiniDOS;
|
||||||
|
VAR
|
||||||
|
XWord: ARRAY [1..9] OF AStr;
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
CurDir,
|
||||||
|
s,
|
||||||
|
s1: AStr;
|
||||||
|
Done,
|
||||||
|
NoCmd,
|
||||||
|
NoSpace,
|
||||||
|
Junk,
|
||||||
|
junk2,
|
||||||
|
junk3,
|
||||||
|
Found: Boolean;
|
||||||
|
TransferTime: LongInt;
|
||||||
|
|
||||||
|
PROCEDURE Parse(CONST s: AStr);
|
||||||
|
VAR
|
||||||
|
i,
|
||||||
|
j,
|
||||||
|
k: Integer;
|
||||||
|
BEGIN
|
||||||
|
FOR i := 1 TO 9 DO
|
||||||
|
XWord[i] := '';
|
||||||
|
i := 1;
|
||||||
|
j := 1;
|
||||||
|
k := 1;
|
||||||
|
IF (Length(s) = 1) THEN
|
||||||
|
XWord[1] := s;
|
||||||
|
WHILE (i < Length(s)) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(i);
|
||||||
|
IF ((s[i] = ' ') OR (Length(s) = i)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Length(s) = i) THEN
|
||||||
|
Inc(i);
|
||||||
|
XWord[k] := AllCaps(Copy(s,j,(i - j)));
|
||||||
|
j := (i + 1);
|
||||||
|
Inc(k);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE VersionInfo;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Renegade''s internal DOS emulator. Supported commands are limited.');
|
||||||
|
NL;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION DOSErrorMsg(ErrorNum: Byte): AStr;
|
||||||
|
VAR
|
||||||
|
S: AStr;
|
||||||
|
BEGIN
|
||||||
|
CASE ErrorNum OF
|
||||||
|
1 : S := 'The snytax of the command is incorrect.';
|
||||||
|
END;
|
||||||
|
DOSErrorMsg := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DoCmd(CONST Cmd: AStr);
|
||||||
|
VAR
|
||||||
|
F: FILE;
|
||||||
|
ps,
|
||||||
|
ns,
|
||||||
|
es,
|
||||||
|
op,
|
||||||
|
np,
|
||||||
|
s1,
|
||||||
|
s2,
|
||||||
|
s3: AStr;
|
||||||
|
NumFiles,
|
||||||
|
TSiz: LongInt;
|
||||||
|
i,
|
||||||
|
j: Byte;
|
||||||
|
RetLevel: Integer;
|
||||||
|
b,
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NoCmd := FALSE;
|
||||||
|
s := XWord[1];
|
||||||
|
IF (s = '?') OR (s = 'HELP') THEN
|
||||||
|
PrintF('DOSHELP')
|
||||||
|
ELSE IF (s = 'EDIT') THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((Exist(XWord[2])) AND (XWord[2] <> '')) THEN
|
||||||
|
TEdit(XWord[2])
|
||||||
|
ELSE IF (XWord[2] = '') THEN
|
||||||
|
TEdit1
|
||||||
|
ELSE
|
||||||
|
TEdit(XWord[2]);
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'EXIT') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE IF (s = 'DEL') THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((NOT Exist(XWord[2])) AND (NOT IsWildCard(XWord[2]))) OR (XWord[2] = '') THEN
|
||||||
|
Print('File not found.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
XWord[2] := FExpand(XWord[2]);
|
||||||
|
FindFirst(XWord[2],AnyFile - VolumeID - Directory,DirInfo);
|
||||||
|
IF (NOT IsWildCard(XWord[2])) OR (PYNQ('Are you sure? ',0,FALSE)) THEN
|
||||||
|
REPEAT
|
||||||
|
Kill(DirInfo.Name);
|
||||||
|
FindNext(DirInfo);
|
||||||
|
UNTIL (DOSError <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'TYPE') THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF(FExpand(XWord[2]));
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print('File not found.');
|
||||||
|
END
|
||||||
|
ELSE IF (Copy(s,1,3) = 'REN') THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((NOT Exist(XWord[2])) AND (XWord[2] <> '')) THEN
|
||||||
|
Print('File not found.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
XWord[2] := FExpand(XWord[2]);
|
||||||
|
Assign(F,XWord[2]);
|
||||||
|
ReName(F,XWord[3]);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('File not found.');
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'DIR') THEN
|
||||||
|
BEGIN
|
||||||
|
b := TRUE;
|
||||||
|
FOR i := 2 TO 9 DO
|
||||||
|
IF (XWord[i] = '/W') THEN
|
||||||
|
BEGIN
|
||||||
|
b := FALSE;
|
||||||
|
XWord[i] := '';
|
||||||
|
END;
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
XWord[2] := '*.*';
|
||||||
|
s1 := CurDir;
|
||||||
|
XWord[2] := FExpand(XWord[2]);
|
||||||
|
FSplit(XWord[2],ps,ns,es);
|
||||||
|
s1 := ps;
|
||||||
|
s2 := ns + es;
|
||||||
|
IF (s2[1] = '.') THEN
|
||||||
|
s2 := '*' + s2;
|
||||||
|
IF (s2 = '') THEN
|
||||||
|
s2 := '*.*';
|
||||||
|
IF (Pos('.', s2) = 0) THEN
|
||||||
|
s2 := s2 + '.*';
|
||||||
|
IF (NOT IsWildCard(XWord[2])) THEN
|
||||||
|
BEGIN
|
||||||
|
FindFirst(XWord[2],AnyFile,DirInfo);
|
||||||
|
IF ((DOSError = 0) AND (DirInfo.Attr = Directory)) OR ((Length(s1) = 3) AND (s1[3] = '\')) THEN
|
||||||
|
BEGIN
|
||||||
|
s1 := BSlash(XWord[2],TRUE);
|
||||||
|
s2 := '*.*';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
DosDir(s1,s2,b);
|
||||||
|
NL;
|
||||||
|
END
|
||||||
|
ELSE IF ((s = 'CD') OR (s = 'CHDIR')) AND (XWord[2] <> '') OR (Copy(s,1,3) = 'CD\') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Copy(s,1,3) = 'CD\') THEN
|
||||||
|
XWord[2] := Copy(s,3,Length(s)-2);
|
||||||
|
XWord[2] := FExpand(XWord[2]);
|
||||||
|
ChDir(XWord[2]);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('Invalid pathname.');
|
||||||
|
END
|
||||||
|
(* Done - Lee Palmer - 01/09/08 *)
|
||||||
|
ELSE IF (s = 'MD') OR (s = 'MKDIR') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
Print(DOSErrorMsg(1))
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(XWord[2],AnyFile,DirInfo);
|
||||||
|
IF (DosError = 0) THEN
|
||||||
|
Print('A subdirectory or file '+XWord[2]+' already exists.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MkDir(XWord[2]);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('Access is denied.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE IF ((s = 'RD') OR (s = 'RMDIR')) THEN
|
||||||
|
BEGIN
|
||||||
|
(* Finish Me *)
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
Print(DOSErrorMsg(1))
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FindFirst(XWord[2],AnyFile,DirInfo);
|
||||||
|
IF (DosError <> 0) THEN
|
||||||
|
Print('The system cannot find the file specified.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Found := FALSE;
|
||||||
|
FindFirst(BSlash(XWord[2],TRUE)+'*.*',AnyFile,DirInfo);
|
||||||
|
WHILE (DosError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (DirInfo.Name <> '.') AND (DirInfo.Name <> '..') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := TRUE;
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
IF (Found) THEN
|
||||||
|
Print('The directory is not empty.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RmDir(XWord[2]);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('Access is denied.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'COPY') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (IsWildCard(XWord[3])) THEN
|
||||||
|
Print('Wildcards not allowed in destination parameter!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[3] = '') THEN
|
||||||
|
XWord[3] := CurDir;
|
||||||
|
XWord[2] := BSlash(FExpand(XWord[2]),FALSE);
|
||||||
|
XWord[3] := FExpand(XWord[3]);
|
||||||
|
FindFirst(XWord[3],AnyFile,DirInfo);
|
||||||
|
b := ((DOSError = 0) AND (DirInfo.Attr AND Directory = Directory));
|
||||||
|
IF ((NOT b) AND (Copy(XWord[3],2,2) = ':\') AND (Length(XWord[3]) = 3)) THEN
|
||||||
|
b := TRUE;
|
||||||
|
FSplit(XWord[2],op,ns,es);
|
||||||
|
op := BSlash(OP,TRUE);
|
||||||
|
IF (b) THEN
|
||||||
|
np := BSlash(XWord[3],TRUE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FSplit(XWord[3],np,ns,es);
|
||||||
|
np := BSlash(np,TRUE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
j := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FindFirst(XWord[2],AnyFile - Directory - VolumeID,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
s1 := op + DirInfo.Name;
|
||||||
|
IF (b) THEN
|
||||||
|
s2 := np + DirInfo.Name
|
||||||
|
ELSE
|
||||||
|
s2 := np + ns + es;
|
||||||
|
|
||||||
|
IF CopyMoveFile(TRUE,s1+' -> '+s2+' :',s1,s2,TRUE) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(j);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
IF (NOT Empty) THEN
|
||||||
|
WKey;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
Print(' '+IntToStr(j)+' file(s) copied.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'MOVE') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (IsWildCard(XWord[3])) THEN
|
||||||
|
Print('Wildcards not allowed in destination parameter!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[3] = '') THEN
|
||||||
|
XWord[3] := CurDir;
|
||||||
|
XWord[2] := BSlash(FExpand(XWord[2]),FALSE);
|
||||||
|
XWord[3] := FExpand(XWord[3]);
|
||||||
|
FindFirst(XWord[3],AnyFile,DirInfo);
|
||||||
|
b := ((DOSError = 0) AND (DirInfo.Attr AND Directory = Directory));
|
||||||
|
IF ((NOT b) AND (Copy(XWord[3],2,2) = ':\') AND (Length(XWord[3]) = 3)) THEN
|
||||||
|
b := TRUE;
|
||||||
|
FSplit(XWord[2],op,ns,es);
|
||||||
|
op := BSlash(op,TRUE);
|
||||||
|
IF (b) THEN
|
||||||
|
np := BSlash(XWord[3],TRUE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FSplit(XWord[3],np,ns,es);
|
||||||
|
np := BSlash(np,TRUE);
|
||||||
|
END;
|
||||||
|
j := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FindFirst(XWord[2],AnyFile - Directory - VolumeID,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
s1 := op + DirInfo.Name;
|
||||||
|
IF (b) THEN
|
||||||
|
s2 := np + DirInfo.Name
|
||||||
|
ELSE
|
||||||
|
s2 := np + ns + es;
|
||||||
|
CopyMoveFile(FALSE,s1+' -> '+s2+' :',s1,s2,TRUE);
|
||||||
|
BEGIN
|
||||||
|
Inc(j);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
IF (NOT Empty) THEN
|
||||||
|
WKey;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
Print(' '+IntToStr(j)+' file(s) moved.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'CLS') THEN
|
||||||
|
CLS
|
||||||
|
ELSE IF (Length(s) = 2) AND (s[1] >= 'A') AND (s[1] <= 'Z') AND (s[2] = ':') THEN
|
||||||
|
BEGIN
|
||||||
|
GetDir(Ord(s[1]) - 64,s1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('Invalid drive.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
ChDir(s1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('Invalid drive.');
|
||||||
|
ChDir(CurDir);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'VIEW') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
Print('Syntax is: "VIEW filename"')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
s1 := XWord[2];
|
||||||
|
IF (Pos('.',s1) = 0) THEN
|
||||||
|
s1 := s1 + '*.*';
|
||||||
|
ViewInternalArchive(s1);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'SEND') AND (XWord[2] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF Exist(XWord[2]) THEN
|
||||||
|
UnlistedDownload(FExpand(XWord[2]))
|
||||||
|
ELSE
|
||||||
|
Print('File not found.');
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'RECEIVE') THEN
|
||||||
|
BEGIN
|
||||||
|
Prt('File Name: ');
|
||||||
|
MPL(12);
|
||||||
|
Input(s,12);
|
||||||
|
s := StripName(s);
|
||||||
|
Receive(s,'',FALSE,Junk,junk2,junk3,TransferTime);
|
||||||
|
IF (Junk) THEN
|
||||||
|
SysOpLog('DOS emulator upload of: '+s);
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'VER') THEN
|
||||||
|
VersionInfo
|
||||||
|
ELSE IF (s = 'DIRSIZE') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
Print('Needs a parameter.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NumFiles := 0;
|
||||||
|
TSiz := 0;
|
||||||
|
FindFirst(XWord[2],AnyFile,DirInfo);
|
||||||
|
WHILE (DOSError = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(TSiz,DirInfo.Size);
|
||||||
|
Inc(NumFiles);
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
IF (NumFiles = 0) THEN
|
||||||
|
Print('No files found!')
|
||||||
|
ELSE
|
||||||
|
Print('"'+AllCaps(XWord[2])+'": '+IntToStr(NumFiles)+' files, '+ConvertBytes(TSiz,FALSE));
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'DISKFREE') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
j := ExtractDriveNumber(CurDir)
|
||||||
|
ELSE
|
||||||
|
j := ExtractDriveNumber(XWord[2]);
|
||||||
|
IF (DiskFree(j) = -1) THEN
|
||||||
|
Print('Invalid drive specification'^M^J)
|
||||||
|
ELSE
|
||||||
|
Print(^M^J + ConvertBytes(DiskFree(j),FALSE)+' free on '+Chr(j + 64)+':'^M^J);
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'EXT') THEN
|
||||||
|
BEGIN
|
||||||
|
s1 := Cmd;
|
||||||
|
j := Pos('EXT',AllCaps(s1)) + 3;
|
||||||
|
s1 := Copy(s1,j,Length(s1) - (j - 1));
|
||||||
|
WHILE (s1[1] = ' ') AND (Length(s1) > 0) DO
|
||||||
|
Delete(s1,1,1);
|
||||||
|
IF (s1 <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Shel('Running "'+s1+'"');
|
||||||
|
ShellDOS(FALSE,s1,RetLevel);
|
||||||
|
Shel2(FALSE);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (s = 'CONVERT') OR (s = 'CVT') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print(s+' - Renegade archive conversion command.');
|
||||||
|
NL;
|
||||||
|
Print('Syntax is: "'+s+' <Old Archive-name> <New Archive-extension>"');
|
||||||
|
NL;
|
||||||
|
Print('Renegade will convert from the one archive format to the other.');
|
||||||
|
Print('You only need to specify the 3-letter extension of the new format.');
|
||||||
|
NL;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Exist(XWord[2])) OR (XWord[2] = '') THEN
|
||||||
|
Print('File not found.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
i := ArcType(XWord[2]);
|
||||||
|
IF (i = 0) THEN
|
||||||
|
InvArc
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
s3 := XWord[3];
|
||||||
|
s3 := Copy(s3,(Length(s3) - 2),3);
|
||||||
|
j := ArcType('FILENAME.'+s3);
|
||||||
|
FSplit(XWord[2],ps,ns,es);
|
||||||
|
IF (Length(XWord[3]) <= 3) AND (j <> 0) THEN
|
||||||
|
s3 := ps+ns+'.'+General.FileArcInfo[j].ext
|
||||||
|
ELSE
|
||||||
|
s3 := XWord[3];
|
||||||
|
IF (j = 0) THEN
|
||||||
|
InvArc
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Ok := TRUE;
|
||||||
|
ConvA(Ok,i,j,SQOutSp(FExpand(XWord[2])),SQOutSp(FExpand(s3)));
|
||||||
|
IF (Ok) THEN
|
||||||
|
Kill(SQOutSp(FExpand(XWord[2])))
|
||||||
|
ELSE
|
||||||
|
Star('Conversion unsuccessful.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END ELSE IF (s = 'UNARC') OR (s = 'UNZIP') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print(s+' - Renegade archive de-compression command.');
|
||||||
|
NL;
|
||||||
|
Print('Syntax: '+s+' <ARCHIVE> [FILESPECS]');
|
||||||
|
NL;
|
||||||
|
Print('The archive type can be any archive format which has been');
|
||||||
|
Print('configured into Renegade via System Configuration.');
|
||||||
|
NL;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
i := ArcType(XWord[2]);
|
||||||
|
IF (NOT Exist(XWord[2])) THEN
|
||||||
|
Print('File not found.')
|
||||||
|
ELSE IF (i = 0) THEN
|
||||||
|
InvArc
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
s3 := '';
|
||||||
|
IF (XWord[3] = '') THEN
|
||||||
|
s3 := ' *.*'
|
||||||
|
ELSE FOR j := 3 TO 9 DO
|
||||||
|
IF (XWord[j] <> '') THEN
|
||||||
|
s3 := s3 + ' '+XWord[j];
|
||||||
|
s3 := Copy(s3,2,Length(s3)-1);
|
||||||
|
ExecBatch(Junk,BSlash(CurDir,TRUE),General.ArcsPath+
|
||||||
|
FunctionalMCI(General.FileArcInfo[i].UnArcLine,XWord[2],s3),
|
||||||
|
0,
|
||||||
|
RetLevel,
|
||||||
|
FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF ((s = 'ARC') OR (s = 'ZIP') OR (s = 'PKARC') OR (s = 'PKPAK') OR (s = 'PKZIP')) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (XWord[2] = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print(s+' - Renegade archive compression command.');
|
||||||
|
NL;
|
||||||
|
Print('Syntax is: "'+s+' <Archive-name> Archive filespecs..."');
|
||||||
|
NL;
|
||||||
|
Print('The archive type can be ANY archive format which has been');
|
||||||
|
Print('configured into Renegade via System Configuration.');
|
||||||
|
NL;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
i := ArcType(XWord[2]);
|
||||||
|
IF (i = 0) THEN
|
||||||
|
InvArc
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
s3 := '';
|
||||||
|
IF (XWord[3] = '') THEN
|
||||||
|
s3 := ' *.*'
|
||||||
|
ELSE FOR j := 3 TO 9 DO
|
||||||
|
IF (XWord[j] <> '') THEN
|
||||||
|
s3 := s3 + ' '+FExpand(XWord[j]);
|
||||||
|
s3 := Copy(s3,2,(Length(s3) - 1));
|
||||||
|
ExecBatch(Junk,
|
||||||
|
BSlash(CurDir,TRUE),
|
||||||
|
General.ArcsPath+FunctionalMCI(General.FileArcInfo[i].ArcLine,FExpand(XWord[2]),s3),
|
||||||
|
0,
|
||||||
|
RetLevel,
|
||||||
|
FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NoCmd := TRUE;
|
||||||
|
IF (s <> '') THEN
|
||||||
|
Print('Bad command or file name.')
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
NL;
|
||||||
|
Print('Type "EXIT" to return to Renegade');
|
||||||
|
NL;
|
||||||
|
VersionInfo;
|
||||||
|
REPEAT
|
||||||
|
GetDir(0,CurDir);
|
||||||
|
Prompt('^1'+CurDir+'>');
|
||||||
|
InputL(s1,128);
|
||||||
|
Parse(s1);
|
||||||
|
Check_Status;
|
||||||
|
DoCmd(s1);
|
||||||
|
IF (NOT NoCmd) THEN
|
||||||
|
SysOpLog('> '+s1);
|
||||||
|
UNTIL (Done) OR (HangUp);
|
||||||
|
ChDir(StartDir);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UploadAll;
|
||||||
|
VAR
|
||||||
|
FileName: Str12;
|
||||||
|
FArrayRecNum: Byte;
|
||||||
|
FArea,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
SearchAllFileAreas: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE UploadFiles(FArea: Integer; FileName1: Str12; VAR FArrayRecNum1: Byte);
|
||||||
|
VAR
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
Cmd: Char;
|
||||||
|
NumExtDesc: Byte;
|
||||||
|
DirFileRecNum,
|
||||||
|
GotPts,
|
||||||
|
Counter: Integer;
|
||||||
|
FSize: LongInt;
|
||||||
|
FlagAll,
|
||||||
|
Ok,
|
||||||
|
FirstOne,
|
||||||
|
GotDesc,
|
||||||
|
Found: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FirstOne := TRUE;
|
||||||
|
FlagAll := FALSE;
|
||||||
|
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
CLS;
|
||||||
|
Found := FALSE;
|
||||||
|
Prompt('^1Scanning ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FArea,0))+'^1 ...');
|
||||||
|
|
||||||
|
FindFirst(MemFileArea.DLPath+FileName1,AnyFile - VolumeID - Directory - DOS.Hidden,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
DirInfo.Name := Align(DirInfo.Name);
|
||||||
|
RecNo(FileInfo,DirInfo.Name,DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
IF (DirFileRecNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
FSize := GetFileSize(MemFileArea.DLPath+DirInfo.Name);
|
||||||
|
IF (FSize = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileSize := 0;
|
||||||
|
Include(FileInfo.FIFlags,FIIsRequest);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FileSize := FSize;
|
||||||
|
Exclude(FileInfo.FIFlags,FIIsRequest);
|
||||||
|
END;
|
||||||
|
|
||||||
|
UpdateFileInfo(FileInfo,DirInfo.Name,GotPts);
|
||||||
|
|
||||||
|
IF (FirstOne) THEN
|
||||||
|
BEGIN
|
||||||
|
DisplayFileAreaHeader;
|
||||||
|
FirstOne := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
GotDesc := FALSE;
|
||||||
|
|
||||||
|
IF (General.FileDiz) AND (DizExists(MemFileArea.DLPath+DirInfo.Name)) THEN
|
||||||
|
BEGIN
|
||||||
|
GetDiz(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
Star('Complete.');
|
||||||
|
Prompt(' ^9'+PadRightInt(FArrayRecNum1,2)+' ^5'+DirInfo.Name+' ^4'+GetFileStats(FileInfo)+' ');
|
||||||
|
IF (FlagAll) THEN
|
||||||
|
Ok := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Prt('Upload? (Yes,No,All,Quit): ');
|
||||||
|
OneK(Cmd,'QYNA',TRUE,TRUE);
|
||||||
|
Ok := (Cmd = 'Y') OR (Cmd = 'A');
|
||||||
|
FlagAll := (Cmd = 'A');
|
||||||
|
Abort := (Cmd = 'Q');
|
||||||
|
END;
|
||||||
|
GotDesc := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Prompt(' ^9'+PadRightInt(FArrayRecNum1,2)+' ^5'+DirInfo.Name+' ^4'+GetFileStats(FileInfo)+' ');
|
||||||
|
MPL(50);
|
||||||
|
InputL(FileInfo.Description,50);
|
||||||
|
Ok := TRUE;
|
||||||
|
IF (FileInfo.Description <> '') AND (FileInfo.Description[1] = '.') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Length(FileInfo.Description) = 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := TRUE;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Cmd := UpCase(FileInfo.Description[2]);
|
||||||
|
CASE Cmd OF
|
||||||
|
'D' : BEGIN
|
||||||
|
Kill(MemFileArea.DLPath+DirInfo.Name);
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
'N' : BEGIN
|
||||||
|
Next := TRUE;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
'S' : Ok := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Inc(FArrayRecNum1);
|
||||||
|
IF (FArrayRecNum1 = 100) THEN
|
||||||
|
FArrayRecNum1 := 0;
|
||||||
|
|
||||||
|
IF (Ok) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT GotDesc) THEN
|
||||||
|
BEGIN
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
|
||||||
|
Counter := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
Prt(PadLeftStr('',28));
|
||||||
|
MPL(50);
|
||||||
|
InputL(ExtendedArray[Counter],50);
|
||||||
|
IF (ExtendedArray[Counter] = '') THEN
|
||||||
|
Counter := MaxExtDesc;
|
||||||
|
UNTIL (Counter = MaxExtDesc) OR (HangUp);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
|
||||||
|
SysOpLog('^3Uploaded "^5'+SQOutSp(DirInfo.Name)+'^3" to ^5'+MemFileArea.AreaName);
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
WKey;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FArea,0))));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Upload files into file areas -');
|
||||||
|
NL;
|
||||||
|
SearchAllFileAreas := PYNQ('Search all file areas? ',0,FALSE);
|
||||||
|
NL;
|
||||||
|
IF NOT PYNQ('Search by file spec? ',0,FALSE) THEN
|
||||||
|
FileName := '*.*'
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Prompt('File name (^5<CR>^1=^5All^1): ');
|
||||||
|
GetFileName(FileName);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('^1Enter . to end processing, .S to skip the file, .N to skip to');
|
||||||
|
Print('^1the next directory, and .D to delete the file.');
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
InitFArray(FArray);
|
||||||
|
FArrayRecNum := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
IF (NOT SearchAllFileAreas) THEN
|
||||||
|
UploadFiles(FileArea,FileName,FArrayRecNum)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
UploadFiles(FArea,FileName,FArrayRecNum);
|
||||||
|
WKey;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,995 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File6;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION CheckBatchDL(FileName: Str52): Boolean;
|
||||||
|
PROCEDURE EditBatchDLQueue;
|
||||||
|
PROCEDURE BatchDownload;
|
||||||
|
PROCEDURE ListBatchDLFiles;
|
||||||
|
PROCEDURE RemoveBatchDLFiles;
|
||||||
|
PROCEDURE ClearBatchDlQueue;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common5,
|
||||||
|
ExecBat,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File2,
|
||||||
|
File4,
|
||||||
|
File12,
|
||||||
|
MultNode,
|
||||||
|
ShortMsg,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
FUNCTION CheckBatchDL(FileName: Str52): Boolean;
|
||||||
|
VAR
|
||||||
|
RecNum: LongInt;
|
||||||
|
FileFound: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FileFound := FALSE;
|
||||||
|
IF (NumBatchDLFiles > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) AND (NOT FileFound) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) AND (BatchDL.BDLFileName = FileName) THEN
|
||||||
|
FileFound := TRUE;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchDLFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
CheckBatchDL := FileFound;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditBatchDLQueue;
|
||||||
|
VAR
|
||||||
|
Cmd: CHAR;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchDLFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is empty');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Prt('Batch download queue [^5C^4=^5Clear Batch^4,^5L^4=^5List Batch^4,^5R^4=^5Remove a file^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QCLR',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'C' : ClearBatchDlQueue;
|
||||||
|
'L' : ListBatchDLFiles;
|
||||||
|
'R' : RemoveBatchDLFiles;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BatchDownload;
|
||||||
|
TYPE
|
||||||
|
TotalsRecordType = RECORD
|
||||||
|
FilesDL,
|
||||||
|
FilesDLRatio: Byte;
|
||||||
|
BytesDL,
|
||||||
|
BytesDLRatio,
|
||||||
|
PointsDL,
|
||||||
|
PointsDLRatio: LongInt;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Totals: TotalsRecordType;
|
||||||
|
FileListTxt,
|
||||||
|
DLFListTxt: Text;
|
||||||
|
NewFileName: AStr;
|
||||||
|
SaveLastDirFileName: Str12;
|
||||||
|
NumExtDesc,
|
||||||
|
Counter,
|
||||||
|
Counter1: BYTE;
|
||||||
|
ReturnCode,
|
||||||
|
SaveFileArea,
|
||||||
|
DirFileRecNum,
|
||||||
|
ProtocolNumber,
|
||||||
|
SaveLastDirFileRecNum,
|
||||||
|
ToXfer: Integer;
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
TransferTime: LongInt;
|
||||||
|
AutoLogOff,
|
||||||
|
FO: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE AddNacc(BatchDL: BatchDLRecordType);
|
||||||
|
BEGIN
|
||||||
|
IF (BatchDL.BDLSection = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (IsFileAttach IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'File Attach'
|
||||||
|
ELSE IF (IsUnlisted IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'Unlisted Download'
|
||||||
|
ELSE IF (IsTempArc IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'Temporary Archive'
|
||||||
|
ELSE IF (IsQWK IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'QWK Download';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveLastDirFileRecNum := LastDIRRecNum;
|
||||||
|
SaveLastDirFileName := LastDIRFileName;
|
||||||
|
FO := (FileRec(FileInfoFile).Mode <> FMClosed);
|
||||||
|
IF (FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FileArea := BatchDL.BDLSection;
|
||||||
|
RecNo(FileInfo,StripName(BatchDL.BDLFileName),DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (DirFileRecNum <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
Inc(FileInfo.Downloaded);
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
IF (FO) THEN
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
LastDIRRecNum := SaveLastDirFileRecNum;
|
||||||
|
LastDIRFileName := SaveLastDirFileName;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Star(StripName(BatchDL.BDLFileName)+' successfully downloaded.');
|
||||||
|
SysOpLog('^3Batch downloaded: "^5'+StripName(BatchDL.BDLFileName)+'^3" from ^5'+
|
||||||
|
MemFileArea.AreaName+'.');
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ReverseSlash(S: AStr): AStr;
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO Length(S) DO
|
||||||
|
IF (S[Counter] = '/') THEN
|
||||||
|
S[Counter] := '\';
|
||||||
|
ReverseSlash := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UpdateSatistics(BatchDL: BatchDLRecordType);
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (Totals.FilesDL < 255) THEN
|
||||||
|
Inc(Totals.FilesDL);
|
||||||
|
|
||||||
|
IF ((Totals.BytesDL + BatchDL.BDLFSize) < 2147483647) THEN
|
||||||
|
Inc(Totals.BytesDL,BatchDL.BDLFSize)
|
||||||
|
ELSE
|
||||||
|
Totals.BytesDL := 2147483647;
|
||||||
|
|
||||||
|
IF ((Totals.PointsDL + BatchDL.BDLPoints) < 2147483647) THEN
|
||||||
|
Inc(Totals.PointsDL,BatchDL.BDLPoints)
|
||||||
|
ELSE
|
||||||
|
Totals.PointsDL := 2147483647;
|
||||||
|
|
||||||
|
IF (NOT (IsNoRatio IN BatchDL.BDLFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Totals.FilesDLRatio < 255) THEN
|
||||||
|
Inc(Totals.FilesDLRatio);
|
||||||
|
|
||||||
|
IF ((Totals.BytesDLRatio + BatchDL.BDLFSize) < 2147483647) THEN
|
||||||
|
Inc(Totals.BytesDLRatio,BatchDL.BDLFSize)
|
||||||
|
ELSE
|
||||||
|
Totals.BytesDLRatio := 2147483647;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT (IsNoFilePoints IN BatchDL.BDLFlags)) THEN
|
||||||
|
IF ((Totals.PointsDLRatio + BatchDL.BDLPoints) < 2147483647) THEN
|
||||||
|
Inc(Totals.PointsDLRatio,BatchDL.BDLPoints)
|
||||||
|
ELSE
|
||||||
|
Totals.PointsDLRatio := 2147483647;
|
||||||
|
|
||||||
|
AddNacc(BatchDL);
|
||||||
|
|
||||||
|
WITH FileInfo DO
|
||||||
|
BEGIN
|
||||||
|
FileName := StripName(BatchDL.BDLFileName);
|
||||||
|
Description := '';
|
||||||
|
FilePoints := BatchDL.BDLPoints;
|
||||||
|
Downloaded := 0;
|
||||||
|
FileSize := 0;
|
||||||
|
OwnerNum := BatchDL.BDLUploader;
|
||||||
|
OwnerName := BatchDL.BDLOwnerName;
|
||||||
|
FileDate := 0;
|
||||||
|
VPointer := 0;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [];
|
||||||
|
END;
|
||||||
|
|
||||||
|
CreditUploader(FileInfo);
|
||||||
|
|
||||||
|
Dec(NumBatchDLFiles);
|
||||||
|
Dec(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
Dec(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
Dec(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
IF (BatchDL.BDLStorage = Copied) THEN
|
||||||
|
Kill(BatchDL.BDLFileName);
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChopOfSpace(VAR S: AStr);
|
||||||
|
BEGIN
|
||||||
|
WHILE (S[1] = ' ') DO
|
||||||
|
S := Copy(S,2,(Length(S) - 1));
|
||||||
|
IF (Pos(' ',S) <> 0) THEN
|
||||||
|
S := Copy(S,1,(Pos(' ',S) - 1));
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FigureSucc;
|
||||||
|
VAR
|
||||||
|
TempLogTxt,
|
||||||
|
DLoadLogTxt: Text;
|
||||||
|
LogStr,
|
||||||
|
FileStr,
|
||||||
|
StatStr: AStr;
|
||||||
|
RecNum,
|
||||||
|
RecNum1: LongInt;
|
||||||
|
ToFile,
|
||||||
|
ReadLog,
|
||||||
|
FoundFile,
|
||||||
|
FoundReturnCode: Boolean;
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
ReadLog := FALSE;
|
||||||
|
ToFile := FALSE;
|
||||||
|
IF (Protocol.TempLog <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(TempLogTxt,FunctionalMCI(Protocol.TempLog,'',''));
|
||||||
|
Reset(TempLogTxt);
|
||||||
|
IF (IOResult = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
ReadLog := TRUE;
|
||||||
|
IF (FunctionalMCI(Protocol.DLoadLog,'','') <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(DLoadLogTxt,FunctionalMCI(Protocol.DLoadLog,'',''));
|
||||||
|
Append(DLoadLogTxt);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(DLoadLogTxt);
|
||||||
|
ToFile := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
SysOpLog('Start scan of: "^0'+AllCaps(FunctionalMCI(Protocol.TempLog,'',''))+'^1".');
|
||||||
|
|
||||||
|
WHILE (NOT EOF(TempLogTxt)) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(TempLogTxt,LogStr);
|
||||||
|
IF (ToFile) THEN
|
||||||
|
WriteLn(DLoadLogTxt,LogStr);
|
||||||
|
FileStr := Copy(LogStr,Protocol.TempLogPF,((Length(LogStr) - Protocol.TempLogPF) - 1));
|
||||||
|
StatStr := Copy(LogStr,Protocol.TempLogPS,((Length(LogStr) - Protocol.TempLogPS) - 1));
|
||||||
|
|
||||||
|
FileStr := ReverseSlash(FileStr);
|
||||||
|
|
||||||
|
ChopOfSpace(FileStr);
|
||||||
|
|
||||||
|
FoundReturnCode := FALSE;
|
||||||
|
FoundFile := FALSE;
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) AND (NOT FoundFile) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) AND (Pos(AllCaps(BatchDL.BDLFileName),AllCaps(FileStr)) <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FoundFile := TRUE;
|
||||||
|
IF (FindReturnCode(Protocol.DLCode,Protocol.PRFlags,StatStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
FoundReturnCode := TRUE;
|
||||||
|
UpdateSatistics(BatchDL);
|
||||||
|
Dec(RecNum);
|
||||||
|
IF (RecNum >= 0) AND (RecNum <= (FileSize(BatchDLFile) - 2)) THEN
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchDLFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum1 + 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
Seek(BatchDLFile,RecNum1);
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
END;
|
||||||
|
Seek(BatchDLFile,(FileSize(BatchDLFile) - 1));
|
||||||
|
Truncate(BatchDLFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT FoundFile) THEN
|
||||||
|
SysOpLog('^7File not found: "^5'+BatchDL.BDLFileName+'^7"')
|
||||||
|
ELSE IF (NOT FoundReturnCode) THEN
|
||||||
|
SysOpLog('^7Return code not found: "^5'+BatchDL.BDLFileName+'^7"');
|
||||||
|
END;
|
||||||
|
SysOpLog('End scan of: "^0'+AllCaps(FunctionalMCI(Protocol.TempLog,'',''))+'^1".');
|
||||||
|
|
||||||
|
Close(TempLogTxt);
|
||||||
|
IF (ToFile) THEN
|
||||||
|
Close(DLoadLogTxt);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT ReadLog) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Start scan of: "^0BATCHDL.DAT^1"');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateSatistics(BatchDL);
|
||||||
|
Dec(RecNum);
|
||||||
|
IF (RecNum >= 0) AND (RecNum <= (FileSize(BatchDLFile) - 2)) THEN
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchDLFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum1 + 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
Seek(BatchDLFile,RecNum1);
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
END;
|
||||||
|
Seek(BatchDLFile,(FileSize(BatchDLFile) - 1));
|
||||||
|
Truncate(BatchDLFile);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
SysOpLog('End scan of: "^0BATCHDL.DAT^1"');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchDLFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Batch download (Statistics):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(NumBatchDLFiles)+'^1');
|
||||||
|
Star('^1Total size : ^5'+ConvertBytes(BatchDLSize,FALSE)+'^1');
|
||||||
|
Star('^1Total file points : ^5'+FormatNumber(BatchDLPoints)+'^1');
|
||||||
|
Star('^1Download time : ^5'+CTim(BatchDLTime)+'^1');
|
||||||
|
Star('^1Time left online : ^5'+CTim(NSL)+'^1');
|
||||||
|
|
||||||
|
IF (BatchDLPoints > ThisUser.FilePoints) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Insufficient file points, remove file(s) from your batch queue!^1');
|
||||||
|
NL;
|
||||||
|
Print('^1Chargeable : ^5'+FormatNumber(BatchDLPoints)+'^1');
|
||||||
|
Print('^1Your account : ^5'+FormatNumber(ThisUser.FilePoints)+'^1');
|
||||||
|
NL;
|
||||||
|
EditBatchDLQueue;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (BatchDLTime > NSL) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Insufficient time left online, remove file(s) from your batch queue!^1');
|
||||||
|
NL;
|
||||||
|
EditBatchDLQueue;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
ProtocolNumber := DoProtocol(Protocol,FALSE,TRUE,TRUE,FALSE);
|
||||||
|
|
||||||
|
CASE ProtocolNumber OF
|
||||||
|
-1 : ;
|
||||||
|
-2 : Exit;
|
||||||
|
-3 : ;
|
||||||
|
-4 : ;
|
||||||
|
-5 : EditBatchDLQueue;
|
||||||
|
ELSE
|
||||||
|
IF (InCom) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
|
||||||
|
FillChar(Totals,SizeOf(Totals),0);
|
||||||
|
|
||||||
|
PurgeDir(TempDir+'UP\',FALSE);
|
||||||
|
|
||||||
|
IF Exist(FunctionalMCI(Protocol.TempLog,'','')) THEN
|
||||||
|
Kill(FunctionalMCI(Protocol.TempLog,'',''));
|
||||||
|
|
||||||
|
IF Exist(TempDir+'ARC\FILES.BBS') THEN
|
||||||
|
Kill(TempDir+'ARC\FILES.BBS');
|
||||||
|
|
||||||
|
IF Exist(FunctionalMCI(Protocol.DLFList,'','')) THEN
|
||||||
|
Kill(FunctionalMCI(Protocol.DLFList,'',''));
|
||||||
|
|
||||||
|
NL;
|
||||||
|
AutoLogOff := PYNQ('Auto-logoff after file transfer? ',0,FALSE);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Download file descriptions? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(FileListTxt,TempDir+'ARC\FILES.BBS');
|
||||||
|
ReWrite(FileListTxt);
|
||||||
|
Writeln(FileListTxt,StripColor(General.BBSName)+' Batch Download File Listing');
|
||||||
|
WriteLn(FileListTxt);
|
||||||
|
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (BatchDL.BDLSection = -1) THEN
|
||||||
|
WriteLn(FileListTxt,PadLeftStr(Align(StripName(BatchDL.BDLFileName)),14)+' [No Description Available]')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
SaveLastDirFileRecNum := LastDIRRecNum;
|
||||||
|
SaveLastDirFileName := LastDIRFileName;
|
||||||
|
FO := (FileRec(FileInfoFile).Mode <> FMClosed);
|
||||||
|
IF (FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FileArea := BatchDL.BDLSection;
|
||||||
|
RecNo(FileInfo,StripName(BatchDL.BDLFileName),DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
WriteLn(FileListTxt,PadLeftStr(Align(StripName(BatchDL.BDLFileName)),14)+' [Bad Download Path]')
|
||||||
|
ELSE IF (DirFileRecNum = -1) THEN
|
||||||
|
WriteLn(FileListTxt,PadLeftStr(Align(StripName(BatchDL.BDLFileName)),14)+' [File Not Found]')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,FileInfo);
|
||||||
|
WriteLn(FileListTxt,PadLeftStr(Align(StripName(BatchDL.BDLFileName)),14)+FileInfo.Description);
|
||||||
|
IF (FileInfo.VPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
FOR Counter1 := 1 TO NumExtDesc DO
|
||||||
|
IF (ExtendedArray[Counter1] <> '') THEN
|
||||||
|
WriteLn(FileListTxt,PadLeftStr('',14)+ExtendedArray[Counter1]);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
IF (FO) THEN
|
||||||
|
InitFileArea(FileArea);
|
||||||
|
LastDIRRecNum := SaveLastDirFileRecNum;
|
||||||
|
LastDIRFileName := SaveLastDirFileName;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
WriteLn(FileListTxt);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(FileListTxt);
|
||||||
|
|
||||||
|
WITH BatchDL DO
|
||||||
|
BEGIN
|
||||||
|
BDLFileName := TempDir+'ARC\FILES.BBS';
|
||||||
|
BDLOwnerName := Caps(ThisUser.Name);
|
||||||
|
BDLStorage := Disk;
|
||||||
|
BDLUserNum := UserNum;
|
||||||
|
BDLSection := -1;
|
||||||
|
BDLPoints := 0;
|
||||||
|
BDLUploader := UserNum;
|
||||||
|
BDLFSize := GetFileSize(TempDir+'ARC\FILES.BBS');
|
||||||
|
BDLTime := (BDLFSize DIV Rate);
|
||||||
|
BDLFlags := [];
|
||||||
|
END;
|
||||||
|
|
||||||
|
Seek(BatchDLFile,FileSize(BatchDLFILE));
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
|
||||||
|
Inc(NumBatchDLFiles);
|
||||||
|
Inc(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
Inc(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
Inc(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^1File : ^5FILES.BBS^1');
|
||||||
|
Print('^1Size : ^5'+ConvertBytes(BatchDL.BDLFSize,FALSE)+'^1');
|
||||||
|
Print('^1File points : ^5'+FormatNumber(BatchDL.BDLPoints)+'^1');
|
||||||
|
Print('^1Download time : ^5'+CTim(BatchDL.BDLTime)+'^1');
|
||||||
|
NL;
|
||||||
|
Print('^1New download time : ^5'+CTim(BatchDLTime)+'^1');
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
Counter1 := 0;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) AND (Counter1 = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) AND (BatchDL.BDLStorage = CD) THEN
|
||||||
|
Inc(Counter1);
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Counter1 <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Please wait, copying files from CD-ROM ... ');
|
||||||
|
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) AND (BatchDL.BDLStorage = CD) THEN
|
||||||
|
IF CopyMoveFile(TRUE,'',BatchDL.BDLFileName,
|
||||||
|
TempDir+'CD\'+StripName(BatchDL.BDLFileName),FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
BatchDL.BDLStorage := Copied;
|
||||||
|
BatchDL.BDLFileName := TempDir+'CD\'+StripName(BatchDL.BDLFileName);
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
|
||||||
|
NewFileName := General.ProtPath+FunctionalMCI(Protocol.DLCmd,'','');
|
||||||
|
|
||||||
|
ToXfer := 0;
|
||||||
|
|
||||||
|
IF (Pos('%F',Protocol.DLCmd) <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(ToXFer);
|
||||||
|
NewFileName := FunctionalMCI(NewFileName,BatchDL.BDLFileName,'');
|
||||||
|
IF (Length(NewFileName) > Protocol.MaxChrs) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('^7Exceeds maximum DOS char length: "^5'+NewFileName+'^1"');
|
||||||
|
RecNum := FileSize(BatchDLFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Protocol.DLFList <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(DLFListTxt,FunctionalMCI(Protocol.DLFList,'',''));
|
||||||
|
ReWrite(DLFListTxt);
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn(DLFListTxt,BatchDL.BDLFileName);
|
||||||
|
Inc(ToXfer);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(DLFListTxt);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Ready to send batch download transfer.');
|
||||||
|
|
||||||
|
ExecProtocol('',
|
||||||
|
TempDir+'UP\',
|
||||||
|
FunctionalMCI(Protocol.EnvCmd,'','')
|
||||||
|
+#13#10+
|
||||||
|
NewFileName,
|
||||||
|
-1,
|
||||||
|
ReturnCode,
|
||||||
|
TransferTime);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Batch download transfer complete.');
|
||||||
|
|
||||||
|
IF Exist(FunctionalMCI(Protocol.DLFList,'','')) THEN
|
||||||
|
Kill(FunctionalMCI(Protocol.DLFList,'',''));
|
||||||
|
|
||||||
|
IF Exist(TempDir+'ARC\FILES.BBS') THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum1 := -1;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF ((BatchDL.BDLUserNum = UserNum) AND (BatchDL.BDLFileName = TempDir+'ARC\FILES.BBS')) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(NumBatchDLFiles);
|
||||||
|
Dec(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
Dec(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
Dec(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
IF (BatchDL.BDLStorage = Copied) THEN
|
||||||
|
Kill(BatchDL.BDLFileName);
|
||||||
|
RecNum1 := RecNum;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
IF (RecNum1 <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(RecNum1);
|
||||||
|
FOR RecNum := RecNum1 TO (FileSize(BatchDLFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum + 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
Seek(BatchDLFile,RecNum);
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
END;
|
||||||
|
Seek(BatchDLFile,(FileSize(BatchDLFile) - 1));
|
||||||
|
Truncate(BatchDLFile);
|
||||||
|
END;
|
||||||
|
Kill(TempDir+'ARC\FILES.BBS');
|
||||||
|
END;
|
||||||
|
|
||||||
|
FigureSucc;
|
||||||
|
|
||||||
|
IF Exist(FunctionalMCI(Protocol.TempLog,'','')) THEN
|
||||||
|
Kill(FunctionalMCI(Protocol.TempLog,'',''));
|
||||||
|
|
||||||
|
IF ((DownloadsToday + Totals.FilesDL) < 2147483647) THEN
|
||||||
|
Inc(DownloadsToday,Totals.FilesDL)
|
||||||
|
ELSE
|
||||||
|
DownloadsToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((DownloadKBytesToday + (Totals.BytesDL DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(DownloadKBytesToday,(Totals.BytesDL DIV 1024))
|
||||||
|
ELSE
|
||||||
|
DownloadKBytesToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.Downloads + Totals.FilesDLRatio) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.Downloads,Totals.FilesDLRatio)
|
||||||
|
ELSE
|
||||||
|
ThisUser.Downloads := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.DLToday + Totals.FilesDLRatio) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.DLToday,Totals.FilesDLRatio)
|
||||||
|
ELSE
|
||||||
|
ThisUser.DLToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.DK + (Totals.BytesDLRatio DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.DK,(Totals.BytesDLRatio DIV 1024))
|
||||||
|
ELSE
|
||||||
|
ThisUser.DK := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.DLKToday + (Totals.BytesDLRatio DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.DLKToday,(Totals.BytesDLRatio DIV 1024))
|
||||||
|
ELSE
|
||||||
|
ThisUser.DLKToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.FilePoints - Totals.PointsDLRatio) > 0) THEN
|
||||||
|
Dec(ThisUser.FilePoints,Totals.PointsDLRatio)
|
||||||
|
ELSE
|
||||||
|
ThisUser.FilePoints := 0;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Batch download (Totals):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(Totals.FilesDL));
|
||||||
|
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesDL,FALSE));
|
||||||
|
Star('^1Total file points : ^5'+FormatNumber(Totals.PointsDL));
|
||||||
|
Star('^1Download time : ^5'+FormattedTime(TransferTime));
|
||||||
|
Star('^1Transfer rate : ^5'+FormatNumber(GetCPS(Totals.BytesDL,TransferTime))+' cps');
|
||||||
|
|
||||||
|
SysOpLog('^3 - Totals:'+
|
||||||
|
' '+FormatNumber(Totals.FilesDL)+' '+Plural('file',Totals.FilesDL)+
|
||||||
|
', '+ConvertBytes(Totals.BytesDL,FALSE)+
|
||||||
|
', '+FormatNumber(Totals.PointsDL)+' fp'+
|
||||||
|
', '+FormattedTime(TransferTime)+' tt'+
|
||||||
|
', '+FormatNumber(GetCPS(Totals.BytesDL,Transfertime))+' cps.');
|
||||||
|
|
||||||
|
IF (Totals.FilesDL < Totals.FilesDLRatio) THEN
|
||||||
|
Totals.FilesDLRatio := Totals.FilesDL;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Batch download (Charges):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(Totals.FilesDLRatio));
|
||||||
|
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesDLRatio,FALSE));
|
||||||
|
Star('^1Total file points : ^5'+FormatNumber(Totals.PointsDLRatio));
|
||||||
|
|
||||||
|
SysOpLog('^3 - Charges:'+
|
||||||
|
' '+FormatNumber(Totals.FilesDLRatio)+' '+Plural('file',Totals.FilesDLRatio)+
|
||||||
|
', '+ConvertBytes(Totals.BytesDLRatio,FALSE)+
|
||||||
|
', '+FormatNumber(Totals.PointsDLRatio)+' fp.');
|
||||||
|
|
||||||
|
IF (NumBatchDLFiles > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Totals.BytesDL := 0;
|
||||||
|
Totals.PointsDL := 0;
|
||||||
|
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(Totals.BytesDL,BatchDL.BDLFSize);
|
||||||
|
Inc(Totals.PointsDL,BatchDL.BDLPoints);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Batch download (Not Transferred):^1');
|
||||||
|
NL;
|
||||||
|
Star('^1Total file(s) : ^5'+FormatNumber(NumBatchDLFiles));
|
||||||
|
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesDL,FALSE));
|
||||||
|
Star('^1Total file points : ^5'+FormatNumber(Totals.PointsDL));
|
||||||
|
|
||||||
|
SysOpLog('^3 - Not downloaded:'+
|
||||||
|
' '+FormatNumber(NumBatchDLFiles)+' '+Plural('file',NumBatchDLFiles)+
|
||||||
|
', '+ConvertBytes(Totals.BytesDL,FALSE)+
|
||||||
|
', '+FormatNumber(Totals.PointsDL)+' fp.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
Close(BatchDLFile);
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Enjoy the file(s), '+Caps(ThisUser.Name)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
|
||||||
|
IF (ProtBiDirectional IN Protocol.PRFlags) THEN
|
||||||
|
BatchUpload(TRUE,TransferTime);
|
||||||
|
|
||||||
|
IF (AutoLogOff) THEN
|
||||||
|
CountDown
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListBatchDLFiles;
|
||||||
|
VAR
|
||||||
|
FileNumToList: Byte;
|
||||||
|
RecNum: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchDLFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NL;
|
||||||
|
PrintACR('^4###:FileName.Ext Area Pts Bytes hh:mm:ss^1');
|
||||||
|
PrintACR('^4===:============:=====:======:=============:========^1');
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
FileNumToList := 1;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^3'+PadRightInt(FileNumToList,3)+
|
||||||
|
'^4:^5'+Align(StripName(BatchDL.BDLFileName))+
|
||||||
|
' '+AOnOff((BatchDL.BDLSection = -1),'^7 --- ','^5'+PadRightInt(CompFileArea(BatchDL.BDLSection,0),5))+
|
||||||
|
' ^4'+PadRightStr(FormatNumber(BatchDL.BDLPoints),6)+
|
||||||
|
' ^4'+PadRightStr(FormatNumber(BatchDL.BDLFSize),13)+
|
||||||
|
' ^7'+CTim(BatchDL.BDLTime)+
|
||||||
|
AOnOff(IsNoRatio IN BatchDL.BDLFlags,'^5 [No-Ratio]','')+
|
||||||
|
AOnOff(IsNoFilePoints IN BatchDL.BDLFlags,'^5 [No-Points]','')+'^1');
|
||||||
|
Inc(FileNumToList);
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchDLFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
PrintACR('^4===:============:=====:======:=============:========^1');
|
||||||
|
PrintACR('^3'+PadLeftStr('Totals:',22)+
|
||||||
|
' ^4'+PadRightStr(FormatNumber(BatchDLPoints),6)+
|
||||||
|
' '+PadRightStr(FormatNumber(BatchDLSize),13)+
|
||||||
|
' ^7'+CTim(BatchDLTime)+'^1');
|
||||||
|
SysOpLog('Viewed the batch download queue.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE RemoveBatchDLFiles;
|
||||||
|
VAR
|
||||||
|
InputStr: Str3;
|
||||||
|
Counter,
|
||||||
|
FileNumToRemove: Byte;
|
||||||
|
RecNum,
|
||||||
|
RecNum1: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchDLFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
ListBatchDLFiles;
|
||||||
|
NL;
|
||||||
|
Prt('File to remove? (^51^4-^5'+IntToStr(NumBatchDLFiles)+'^4) [^5?^4=^5List^4,^5<CR>^4=^5Quit^4]: ');
|
||||||
|
MPL(Length(IntToStr(NumBatchDLFiles)));
|
||||||
|
ScanInput(InputStr,^M'?');
|
||||||
|
FileNumToRemove := StrToInt(InputStr);
|
||||||
|
IF (NOT (InputStr[1] IN ['?','-',^M])) THEN
|
||||||
|
IF (FileNumToRemove < 1) OR (FileNumToRemove > NumBatchDLFiles) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from 1 to '+IntToStr(NumBatchDLFiles)+'!^1');
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Counter := 0;
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(Counter);
|
||||||
|
IF (Counter = FileNumToRemove) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(NumBatchDLFiles);
|
||||||
|
Dec(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
Dec(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
Dec(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
IF (BatchDL.BDLStorage = Copied) THEN
|
||||||
|
Kill(BatchDL.BDLFileName);
|
||||||
|
NL;
|
||||||
|
Print('Removed from batch download queue: "^5'+StripName(BatchDL.BDLFileName)+'^1".');
|
||||||
|
SysOpLog('Batch DL Remove: "^5'+StripName(BatchDL.BDLFileName)+'^1".');
|
||||||
|
Dec(RecNum);
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchDLFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum1 + 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
Seek(BatchDLFile,RecNum1);
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
END;
|
||||||
|
Seek(BatchDLFile,(FileSize(BatchDLFile) - 1));
|
||||||
|
Truncate(BatchDLFile);
|
||||||
|
RecNum := FileSize(BatchDLFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchDLFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumBatchDLFiles <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^1Batch download queue: ^5'+IntToStr(NumBatchDLFiles)+' '+Plural('file',NumBatchDLFiles)+
|
||||||
|
', '+ConvertBytes(BatchDLSize,FALSE)+
|
||||||
|
', '+FormatNumber(BatchDLPoints)+
|
||||||
|
' '+Plural('file point',BatchDLPoints)+', '+FormattedTime(BatchDLTime));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
BatchDLTime := 0;
|
||||||
|
BatchDLSize := 0;
|
||||||
|
BatchDLPoints := 0;
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is now empty.');
|
||||||
|
SysOpLog('Cleared the batch download queue.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr <> '?') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ClearBatchDLQueue;
|
||||||
|
VAR
|
||||||
|
RecNum,
|
||||||
|
RecNum1: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumBatchDLFiles = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is empty.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Clear batch download queue? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(NumBatchDLFiles);
|
||||||
|
Dec(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
Dec(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
Dec(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
IF (BatchDL.BDLStorage = Copied) THEN
|
||||||
|
Kill(BatchDL.BDLFileName);
|
||||||
|
Print('Removed from batch download queue: "^5'+StripName(BatchDL.BDLFileName)+'^1".');
|
||||||
|
SysOpLog('Batch DL Remove: "^5'+StripName(BatchDL.BDLFileName)+'^1".');
|
||||||
|
Dec(RecNum);
|
||||||
|
FOR RecNum1 := RecNum TO (FileSize(BatchDLFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum1 + 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
Seek(BatchDLFile,RecNum1);
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
END;
|
||||||
|
Seek(BatchDLFile,(FileSize(BatchDLFile) - 1));
|
||||||
|
Truncate(BatchDLFile);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchDLFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
BatchDLTime := 0;
|
||||||
|
BatchDLSize := 0;
|
||||||
|
BatchDLPoints := 0;
|
||||||
|
NL;
|
||||||
|
Print('The batch download queue is now empty.');
|
||||||
|
SysOpLog('Cleared the batch download queue.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,199 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File7;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE CheckFilesBBS;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
DOS,
|
||||||
|
Common,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File10,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE AddToDirFile(FileInfo: FileInfoRecordType);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
NumExtDesc: Byte;
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,1);
|
||||||
|
|
||||||
|
WITH FileInfo DO
|
||||||
|
BEGIN
|
||||||
|
(*
|
||||||
|
FileName := ''; Value Passed
|
||||||
|
Description := ''; Value Passed
|
||||||
|
*)
|
||||||
|
FilePoints := 0;
|
||||||
|
Downloaded := 0;
|
||||||
|
(*
|
||||||
|
FileSize := 0; Value Passed
|
||||||
|
*)
|
||||||
|
OwnerNum := 1;
|
||||||
|
OwnerName := AllCaps(User.Name);
|
||||||
|
FileDate := Date2PD(DateStr);
|
||||||
|
VPointer := -1;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [FIHatched];
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT General.FileCreditRatio) THEN
|
||||||
|
FileInfo.FilePoints := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileInfo.FilePoints := 0;
|
||||||
|
IF (General.FileCreditCompBaseSize > 0) THEN
|
||||||
|
FileInfo.FilePoints := ((FileInfo.FileSize DIV 1024) DIV General.FileCreditCompBaseSize);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
|
||||||
|
|
||||||
|
IF (General.FileDiz) AND (DizExists(MemFileArea.DLPath+SQOutSp(FileInfo.FileName))) THEN
|
||||||
|
GetDiz(FileInfo,ExtendedArray,NumExtDesc);
|
||||||
|
|
||||||
|
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
|
||||||
|
|
||||||
|
IF (UploadsToday < 2147483647) THEN
|
||||||
|
Inc(UploadsToday);
|
||||||
|
|
||||||
|
IF ((UploadKBytesToday + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(UploadKBytesToday,(FileInfo.FileSize DIV 1024))
|
||||||
|
ELSE
|
||||||
|
UploadKBytesToday := 2147483647;
|
||||||
|
|
||||||
|
SaveGeneral(FALSE);
|
||||||
|
|
||||||
|
Print('^1hatched!');
|
||||||
|
|
||||||
|
SysOpLog(' Hatched: "^5'+SQOutSp(FileInfo.FileName)+'^1" to "^5'+MemFileArea.AreaName+'^1"');
|
||||||
|
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(* Sample FILES.BBS
|
||||||
|
TDRAW463.ZIP THEDRAW SCREEN EDITOR VERSION 4.63 - (10/93) A text-orient
|
||||||
|
ZEJNGAME.LST [4777] 12-30-01 ZeNet Games list, Updated December 29th, 2
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE CheckFilesBBS;
|
||||||
|
VAR
|
||||||
|
BBSTxtFile: Text;
|
||||||
|
TempStr: AStr;
|
||||||
|
FArea,
|
||||||
|
SaveFileArea,
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
Found,
|
||||||
|
FirstTime,
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Scanning for FILES.BBS ...');
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
LoadFileArea(FArea);
|
||||||
|
|
||||||
|
FirstTime := TRUE;
|
||||||
|
Found := FALSE;
|
||||||
|
LIL := 0;
|
||||||
|
CLS;
|
||||||
|
Prompt('^1Checking ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FArea,0))+'^1 ...');
|
||||||
|
|
||||||
|
IF (Exist(MemFileArea.DLPath+'FILES.BBS')) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Assign(BBSTxtFile,MemFileArea.DLPath+'FILES.BBS');
|
||||||
|
Reset(BBSTxtFile);
|
||||||
|
WHILE NOT EOF(BBSTxtFile) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(BBSTxtFile,TempStr);
|
||||||
|
TempStr := StripLeadSpace(TempStr);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
FileInfo.FileName := Align(AllCaps(Copy(TempStr,1,(Pos(' ',TempStr) - 1))));
|
||||||
|
|
||||||
|
IF (FirstTime) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
NL;
|
||||||
|
FirstTime := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Prompt('^1Processing "^5'+SQOutSp(FileInfo.FileName)+'^1" ... ');
|
||||||
|
|
||||||
|
IF (NOT Exist(MemFileArea.DLPath+SQOutSp(FileInfo.FileName))) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('^7missing!^1');
|
||||||
|
SysOpLog(' ^7Missing: "^5'+SQOutSp(FileInfo.FileName)+'^7" from "^5'+MemFileArea.AreaName+'^7"');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileArea := FArea;
|
||||||
|
RecNo(FileInfo,FileInfo.FileName,DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
IF (DirFileRecNum <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('^7duplicate!^1');
|
||||||
|
SysOpLog(' ^7Duplicate: "^5'+SQOutSp(FileInfo.FileName)+'^7" from "^5'+MemFileArea.AreaName+'^7"');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
TempStr := StripLeadSpace(Copy(TempStr,Pos(' ',TempStr),Length(TempStr)));
|
||||||
|
IF (TempStr[1] <> '[') THEN
|
||||||
|
FileInfo.Description := Copy(TempStr,1,50)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempStr := StripLeadSpace(Copy(TempStr,(Pos(']',TempStr) + 1),Length(TempStr)));
|
||||||
|
FileInfo.Description := StripLeadSpace(Copy(TempStr,(Pos(' ',TempStr) + 1),50));
|
||||||
|
END;
|
||||||
|
|
||||||
|
FileInfo.FileSize := GetFileSize(MemFileArea.DLPath+SQOutSp(FileInfo.FileName));
|
||||||
|
|
||||||
|
AddToDirFile(FileInfo);
|
||||||
|
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
Found := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(BBSTxtFile);
|
||||||
|
|
||||||
|
IF (NOT (FACDROM IN MemFileArea.FAFlags)) THEN
|
||||||
|
Erase(BBSTxtFile);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT Found) THEN
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FArea,0))));
|
||||||
|
END;
|
||||||
|
|
||||||
|
Inc(FArea);
|
||||||
|
|
||||||
|
END;
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,607 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File8;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE Send(FileInfo: FileInfoRecordType;
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
DownloadPath: PathStr;
|
||||||
|
VAR TransferFlags: TransferFlagSet);
|
||||||
|
PROCEDURE Receive(FileName: Str12;
|
||||||
|
UploadPath: PathStr;
|
||||||
|
ResumeFile: Boolean;
|
||||||
|
VAR UploadOk,
|
||||||
|
KeyboardAbort,
|
||||||
|
AddULBatch: Boolean;
|
||||||
|
VAR TransferTime: LongInt);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
ExecBat,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File2,
|
||||||
|
File4,
|
||||||
|
File6,
|
||||||
|
File12,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
{ CheckFileRatio
|
||||||
|
1 - File bad
|
||||||
|
2 - File + Batch bad
|
||||||
|
3 - File Bad - Daily
|
||||||
|
4 - File + Batch bad - Daily
|
||||||
|
}
|
||||||
|
|
||||||
|
PROCEDURE CheckFileRatio(FileInfo: FileInfoRecordType; VAR ProtocolNumber: Integer);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
RecNum: LongInt;
|
||||||
|
FileKBSize: LongInt;
|
||||||
|
Ratio: Real;
|
||||||
|
BadRatio,
|
||||||
|
DailyLimits: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FileKbSize := (FileInfo.FileSize DIV 1024);
|
||||||
|
|
||||||
|
IF (NumBatchDLFiles > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) AND (BatchDL.BDLFileName = FileInfo.FileName) THEN
|
||||||
|
IF (NOT (IsNoRatio IN BatchDL.BDLFlags)) THEN
|
||||||
|
Inc(FileKBSize,(BatchDL.BDLFSize DIV 1024));
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchDLFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BadRatio := FALSE;
|
||||||
|
|
||||||
|
IF (ThisUser.UK > 0) THEN
|
||||||
|
Ratio := ((FileKbSize + ThisUser.DK) / ThisUser.UK)
|
||||||
|
ELSE
|
||||||
|
Ratio := (FileKBSize + ThisUser.DK);
|
||||||
|
|
||||||
|
IF (General.DLKRatio[ThisUser.SL] > 0) AND (Ratio > General.DLKRatio[ThisUser.SL]) THEN
|
||||||
|
BadRatio := TRUE;
|
||||||
|
|
||||||
|
IF (ThisUser.Uploads > 0) THEN
|
||||||
|
Ratio := (((ThisUser.Downloads + NumBatchDLFiles) + 1) / ThisUser.Uploads)
|
||||||
|
ELSE
|
||||||
|
Ratio := ((ThisUser.Downloads + NumBatchDLFiles) + 1);
|
||||||
|
|
||||||
|
IF (General.DLRatio[ThisUser.SL] > 0) AND (Ratio > General.DLRatio[ThisUser.SL]) THEN
|
||||||
|
BadRatio := TRUE;
|
||||||
|
|
||||||
|
IF (NOT General.ULDLRatio) THEN
|
||||||
|
BadRatio := FALSE;
|
||||||
|
|
||||||
|
DailyLimits := FALSE;
|
||||||
|
IF (General.DailyLimits) THEN
|
||||||
|
IF ((ThisUser.DLKToday + FileKbSize) > General.DLKOneDay[ThisUser.SL]) OR
|
||||||
|
(((ThisUser.DLToday + NumBatchDLFiles) + 1) > General.DLOneDay[ThisUser.SL]) THEN
|
||||||
|
BEGIN
|
||||||
|
BadRatio := TRUE;
|
||||||
|
DailyLimits := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (AACS(General.NoDLRatio)) OR (FNoDLRatio IN ThisUser.Flags) THEN
|
||||||
|
BadRatio := FALSE;
|
||||||
|
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
IF (FANoRatio IN MemFileArea.FAFlags) THEN
|
||||||
|
BadRatio := FALSE;
|
||||||
|
|
||||||
|
Counter := 0;
|
||||||
|
|
||||||
|
IF (BadRatio) THEN
|
||||||
|
IF (NumBatchDLFiles = 0) THEN
|
||||||
|
Counter := 1
|
||||||
|
ELSE
|
||||||
|
Counter := 2;
|
||||||
|
|
||||||
|
IF (DailyLimits) AND (Counter > 0) THEN
|
||||||
|
Inc(Counter,2);
|
||||||
|
|
||||||
|
CASE Counter OF
|
||||||
|
1,3 : BEGIN
|
||||||
|
IF (Counter = 3) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('DLTMAX');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
NL;
|
||||||
|
Print('^5Your upload/download ratio is too poor to download this.');
|
||||||
|
}
|
||||||
|
NL;
|
||||||
|
lRGLngStr(27,FALSE);
|
||||||
|
NL;
|
||||||
|
Print('^1Today you have downloaded '+FormatNumber(ThisUser.DLToday)+' '+Plural('file',ThisUser.DLToday)+
|
||||||
|
'^1 totaling '+FormatNumber(ThisUser.DLKToday)+'k');
|
||||||
|
NL;
|
||||||
|
Print('^1The maximum you can download in one day is '+FormatNumber(General.DLOneDay[ThisUser.SL])+
|
||||||
|
' '+Plural('file',General.DLOneDay[ThisUser.SL])+
|
||||||
|
'^1 totaling '+FormatNumber(General.DLKOneDay[ThisUser.SL])+'k');
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintF('DLMAX');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
NL;
|
||||||
|
Print('^5Your upload/download ratio is too poor to download this.');
|
||||||
|
}
|
||||||
|
NL;
|
||||||
|
lRGLngStr(27,FALSE);
|
||||||
|
NL;
|
||||||
|
Print('^5You have downloaded: '+FormatNumber(ThisUser.DK)+'k in '+FormatNumber(ThisUser.Downloads)+
|
||||||
|
' '+Plural('file',ThisUser.Downloads));
|
||||||
|
Print('^5You have uploaded : '+FormatNumber(ThisUser.UK)+'k in '+FormatNumber(ThisUser.Uploads)+
|
||||||
|
' '+Plural('file',ThisUser.Uploads));
|
||||||
|
NL;
|
||||||
|
Print('^5 1 upload for every '+FormatNumber(General.DLRatio[ThisUser.SL])+
|
||||||
|
' downloads must be maintained.');
|
||||||
|
Print('^5 1k must be uploaded for every '+FormatNumber(General.DLKRatio[ThisUser.SL])+'k downloaded.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
2,4 : BEGIN
|
||||||
|
IF (Counter = 4) THEN
|
||||||
|
PrintF('DLBTMAX')
|
||||||
|
ELSE
|
||||||
|
PrintF('DLBMAX');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
NL;
|
||||||
|
Print('^5Your upload/download ratio is too poor to download this.');
|
||||||
|
}
|
||||||
|
NL;
|
||||||
|
lRGLngStr(27,FALSE);
|
||||||
|
NL;
|
||||||
|
Print('^5Assuming you download the files already in the batch queue,');
|
||||||
|
IF (Counter = 2) THEN
|
||||||
|
Print('^5your upload/download ratio would be out of balance.')
|
||||||
|
ELSE
|
||||||
|
Print('^5you would exceed the maximum download limits for one day.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Counter IN [1..4]) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Download refused: Ratio out of balance: '+SQOutSp(FileInfo.FileName));
|
||||||
|
SysOpLog(' ULs: '+FormatNumber(ThisUser.UK)+'k in '+FormatNumber(ThisUser.Uploads)+
|
||||||
|
' '+Plural('file',ThisUser.Uploads)+
|
||||||
|
' - DLs: '+FormatNumber(ThisUser.DK)+'k in '+FormatNumber(ThisUser.Downloads)+
|
||||||
|
' '+Plural('file',ThisUser.Downloads));
|
||||||
|
ProtocolNumber := -2;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE BatchDLAdd(FileInfo: FileInfoRecordType; DownloadPath: Str40; TransferFlags: TransferFlagSet);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
BEGIN
|
||||||
|
IF CheckBatchDL(DownloadPath+FileInfo.FileName) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7This file is already in the batch download queue!^1');
|
||||||
|
END
|
||||||
|
ELSE IF (NumBatchDLFiles = General.MaxBatchDLFiles) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The batch download queue is full!^1');
|
||||||
|
END
|
||||||
|
ELSE IF ((BatchDLTime + (FileInfo.FileSize DIV Rate)) > NSL) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Insufficient time left online to add to the batch download queue!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
IF (NOT Exist(General.DataPath+'BATCHDL.DAT')) THEN
|
||||||
|
ReWrite(BatchDLFile)
|
||||||
|
ELSE
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
|
||||||
|
WITH BatchDL DO
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
BDLFileName := SQOutSp(DownloadPath+FileInfo.FileName);
|
||||||
|
|
||||||
|
IF (FileArea <> -1) THEN
|
||||||
|
BDLOwnerName := AllCaps(FileInfo.OwnerName)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,1);
|
||||||
|
BDLOwnerName := AllCaps(User.Name);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (IsCDRom IN TransferFlags) THEN
|
||||||
|
BDLStorage := CD
|
||||||
|
ELSE
|
||||||
|
BDLStorage := Disk;
|
||||||
|
|
||||||
|
BDLUserNum := UserNum;
|
||||||
|
|
||||||
|
BDLSection := FileArea;
|
||||||
|
|
||||||
|
IF (FileArea <> -1) THEN
|
||||||
|
BDLPoints := FileInfo.FilePoints
|
||||||
|
ELSE
|
||||||
|
BDLPoints := 0;
|
||||||
|
|
||||||
|
IF (FileArea <> -1) THEN
|
||||||
|
BDLUploader := FileInfo.OwnerNum
|
||||||
|
ELSE
|
||||||
|
BDLUploader := 1;
|
||||||
|
|
||||||
|
BDLFSize := FileInfo.FileSize;
|
||||||
|
|
||||||
|
BDLTime := (FileInfo.FileSize DIV Rate);
|
||||||
|
|
||||||
|
IF (IsFileAttach IN TransferFlags) THEN
|
||||||
|
Include(BDLFlags,IsFileAttach)
|
||||||
|
ELSE IF (IsUnlisted IN TransferFlags) THEN
|
||||||
|
Include(BDLFlags,IsUnlisted)
|
||||||
|
ELSE IF (IsTempArc IN TransferFlags) THEN
|
||||||
|
Include(BDLFlags,IsTempArc)
|
||||||
|
ELSE IF (IsQWK IN TransferFlags) THEN
|
||||||
|
Include(BDLFlags,IsQWK);
|
||||||
|
|
||||||
|
IF (NOT ChargeFilePoints(FileArea)) THEN
|
||||||
|
Include(BDLFlags,IsNoFilePoints);
|
||||||
|
|
||||||
|
IF (NOT ChargeFileRatio(FileArea)) THEN
|
||||||
|
Include(BDLFlags,IsNoRatio);
|
||||||
|
|
||||||
|
END;
|
||||||
|
Seek(BatchDLFile,FileSize(BatchDLFile));
|
||||||
|
Write(BatchDLFile,BatchDL);
|
||||||
|
Close(BatchDLFile);
|
||||||
|
|
||||||
|
Inc(NumBatchDLFiles);
|
||||||
|
|
||||||
|
Inc(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
|
||||||
|
Inc(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
|
||||||
|
Inc(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
|
||||||
|
{
|
||||||
|
NL;
|
||||||
|
Print('^5File added to batch download queue.');
|
||||||
|
}
|
||||||
|
lRGLngStr(30,FALSE);
|
||||||
|
NL;
|
||||||
|
Print('^1Batch download queue:'+
|
||||||
|
' ^5'+IntToStr(NumBatchDLFiles)+' '+Plural('file',NumBatchDLFiles)+
|
||||||
|
', '+ConvertBytes(BatchDLSize,FALSE)+
|
||||||
|
', '+FormatNumber(BatchDLPoints)+' '+Plural('file point',BatchDLPoints)+
|
||||||
|
', '+FormattedTime(BatchDLTime)+'^1');
|
||||||
|
|
||||||
|
IF (IsFileAttach IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'File Attach'
|
||||||
|
ELSE IF (IsUnlisted IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'Unlisted Download'
|
||||||
|
ELSE IF (IsTempArc IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'Temporary Archive'
|
||||||
|
ELSE IF (IsQWK IN BatchDL.BDLFlags) THEN
|
||||||
|
MemFileArea.AreaName := 'QWK Download';
|
||||||
|
|
||||||
|
SysOpLog('Batch DL Add: "^5'+StripName(BatchDL.BDLFileName)+
|
||||||
|
'^1" from ^5'+MemFileArea.AreaName);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Send(FileInfo: FileInfoRecordType;
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
DownloadPath: PathStr;
|
||||||
|
VAR TransferFlags: TransferFlagSet);
|
||||||
|
TYPE
|
||||||
|
TotalsRecordType = RECORD
|
||||||
|
FilesDL,
|
||||||
|
FilesDLRatio: Byte;
|
||||||
|
BytesDL,
|
||||||
|
BytesDLRatio,
|
||||||
|
PointsDL,
|
||||||
|
PointsDLRatio: LongInt;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Totals: TotalsRecordType;
|
||||||
|
ReturnCode,
|
||||||
|
ProtocolNumber: Integer;
|
||||||
|
TransferTime: LongInt;
|
||||||
|
BEGIN
|
||||||
|
Exclude(TransferFlags,IsKeyboardAbort);
|
||||||
|
|
||||||
|
Exclude(TransferFlags,IsTransferOk);
|
||||||
|
|
||||||
|
IF (lIsAddDLBatch IN TransferFlags) THEN
|
||||||
|
ProtocolNumber := -4
|
||||||
|
ELSE
|
||||||
|
ProtocolNumber := DoProtocol(Protocol,FALSE,TRUE,FALSE,FALSE);
|
||||||
|
|
||||||
|
IF (IsCheckRatio IN TransferFlags) THEN
|
||||||
|
IF (-ProtocolNumber IN [1,4]) OR (NOT (-ProtocolNumber IN [2..3,5])) THEN
|
||||||
|
CheckFileRatio(FileInfo,ProtocolNumber);
|
||||||
|
|
||||||
|
CASE ProtocolNumber OF
|
||||||
|
-2 : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^1Aborted!');
|
||||||
|
Include(TransferFlags,IsKeyboardAbort);
|
||||||
|
END;
|
||||||
|
-3 : BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^1Skipped!');
|
||||||
|
END;
|
||||||
|
-4 : BatchDLAdd(FileInfo,DownloadPath,TransferFlags);
|
||||||
|
-5 : ;
|
||||||
|
ELSE
|
||||||
|
IF (InCom) OR (ProtocolNumber = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ProtocolNumber = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^5Caution: ^1No check is made to ensure the file you selected for viewing^1');
|
||||||
|
Print('^1 is an ascii text file!');
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Continue to view selected file? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Include(TransferFlags,IsKeyboardAbort);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (IsCDRom IN TransferFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Please wait, copying file from CD-ROM ... ');
|
||||||
|
IF CopyMoveFile(TRUE,'',DownloadPath+SQOutSp(FileInfo.FileName),TempDir+'CD\'+SQOutSp(FileInfo.FileName),FALSE) THEN
|
||||||
|
DownloadPath := TempDir+'CD\';
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Auto-logoff after '+AOnOff(ProtocolNumber = -1,'viewing file','file transfer')+'? ',0,FALSE) THEN
|
||||||
|
Include(TransferFlags,IsAutoLogOff);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Ready to '+AOnOff(ProtocolNumber = -1,'view','send')+': ^5'+SQOutSp(FileInfo.FileName)+'.');
|
||||||
|
|
||||||
|
ExecProtocol(AOnOff(ProtocolNumber = -1,DownloadPath+SQOutSp(FileInfo.FileName),''),
|
||||||
|
TempDir+'UP\',
|
||||||
|
FunctionalMCI(Protocol.EnvCmd,'','')+
|
||||||
|
#13#10
|
||||||
|
+General.ProtPath+FunctionalMCI(Protocol.DLCmd,DownloadPath+SQOutSp(FileInfo.FileName),''),
|
||||||
|
0,
|
||||||
|
ReturnCode,
|
||||||
|
TransferTime);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('File '+AOnOff(ProtocolNumber = -1,'viewing','download')+' complete.');
|
||||||
|
|
||||||
|
IF (ProtocolNumber = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ReturnCode = 0) THEN
|
||||||
|
Include(TransferFlags,IsTransferOk);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF FindReturnCode(Protocol.DLCode,Protocol.PRFlags,IntToStr(ReturnCode)) THEN
|
||||||
|
Include(TransferFlags,IsTransferOk);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT (IsTransferOk IN TransferFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Star(AOnOff(ProtocolNumber = -1,'Text view','Download')+' unsuccessful.');
|
||||||
|
SysOpLog('^7'+AOnOff(ProtocolNumber = -1,'Text view','Download')+' failed: "^5'+SQOutSp(FileInfo.FileName)+
|
||||||
|
'^7" from ^5'+MemFileArea.AreaName);
|
||||||
|
Include(TransferFlags,isPaused);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
SysOpLog('^3'+AOnOff(ProtocolNumber = -1,'Viewed','Downloaded')+' "^5'+SQOutSp(FileInfo.FileName)+
|
||||||
|
'^3" from ^5'+MemFileArea.AreaName+'.');
|
||||||
|
|
||||||
|
FillChar(Totals,SizeOf(Totals),0);
|
||||||
|
|
||||||
|
Inc(Totals.FilesDL);
|
||||||
|
Inc(Totals.BytesDL,FileInfo.FileSize);
|
||||||
|
Inc(Totals.PointsDL,FileInfo.FilePoints);
|
||||||
|
|
||||||
|
IF (ChargeFileRatio(FileArea)) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(Totals.FilesDLRatio);
|
||||||
|
Inc(Totals.BytesDLRatio,FileInfo.FileSize);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ChargeFilePoints(FileArea)) THEN
|
||||||
|
Inc(Totals.PointsDLRatio,FileInfo.FilePoints);
|
||||||
|
|
||||||
|
IF ((ThisUser.Downloads + Totals.FilesDLRatio) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.Downloads,Totals.FilesDLRatio)
|
||||||
|
ELSE
|
||||||
|
ThisUser.Downloads := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.DLToday + Totals.FilesDLRatio) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.DLToday,Totals.FilesDLRatio)
|
||||||
|
ELSE
|
||||||
|
ThisUser.DLToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.DK + (Totals.BytesDLRatio DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.DK,(Totals.BytesDLRatio DIV 1024))
|
||||||
|
ELSE
|
||||||
|
ThisUser.DK := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.DLKToday + (Totals.BytesDLRatio DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(ThisUser.DLKToday,(Totals.BytesDLRatio DIV 1024))
|
||||||
|
ELSE
|
||||||
|
ThisUser.DLKToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((ThisUser.FilePoints - Totals.PointsDLRatio) > 0) THEN
|
||||||
|
Dec(ThisUser.FilePoints,Totals.PointsDLRatio)
|
||||||
|
ELSE
|
||||||
|
ThisUser.FilePoints := 0;
|
||||||
|
|
||||||
|
IF ((DownloadsToday + Totals.FilesDL) < 2147483647) THEN
|
||||||
|
Inc(DownloadsToday,Totals.FilesDL)
|
||||||
|
ELSE
|
||||||
|
DownloadsToday := 2147483647;
|
||||||
|
|
||||||
|
IF ((DownloadKBytesToday + (Totals.BytesDL DIV 1024)) < 2147483647) THEN
|
||||||
|
Inc(DownloadKBytesToday,(Totals.BytesDL DIV 1024))
|
||||||
|
ELSE
|
||||||
|
DownloadKBytesToday := 2147483647;
|
||||||
|
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Download statistics (Totals):^1');
|
||||||
|
NL;
|
||||||
|
Star('File name : ^5'+SQOutSp(FileInfo.FileName));
|
||||||
|
Star('File size : ^5'+ConvertBytes(Totals.BytesDL,FALSE));
|
||||||
|
Star('File point(s) : ^5'+FormatNumber(Totals.PointsDL));
|
||||||
|
Star(AOnOff(ProtocolNumber = -1,'View time ','Download time ')+': ^5'+FormattedTime(TransferTime));
|
||||||
|
Star('Transfer rate : ^5'+FormatNumber(GetCPS(FileInfo.FileSize,Transfertime))+' cps');
|
||||||
|
|
||||||
|
SysOpLog('^3 - Totals:'+
|
||||||
|
' '+FormatNumber(Totals.FilesDL)+' '+Plural('file',Totals.FilesDL)+
|
||||||
|
', '+ConvertBytes(Totals.BytesDL,FALSE)+
|
||||||
|
', '+FormatNumber(Totals.PointsDL)+' fp'+
|
||||||
|
', '+FormattedTime(TransferTime)+
|
||||||
|
', '+FormatNumber(GetCPS(Totals.BytesDL,Transfertime))+' cps.');
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Download statistics (Charges):^1');
|
||||||
|
NL;
|
||||||
|
Star('File(s) : ^5'+FormatNumber(Totals.FilesDLRatio));
|
||||||
|
Star('File size : ^5'+ConvertBytes(Totals.BytesDLRatio,FALSE));
|
||||||
|
Star('File point(s) : ^5'+FormatNumber(Totals.PointsDLRatio));
|
||||||
|
|
||||||
|
SysOpLog('^3 - Charges:'+
|
||||||
|
' '+FormatNumber(Totals.FilesDLRatio)+' '+Plural('file',Totals.FilesDLRatio)+
|
||||||
|
', '+ConvertBytes(Totals.BytesDLRatio,FALSE)+
|
||||||
|
', '+FormatNumber(Totals.PointsDLRatio)+' fp.');
|
||||||
|
|
||||||
|
CreditUploader(FileInfo);
|
||||||
|
|
||||||
|
IF (DirFileRecNum <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(FileInfo.Downloaded);
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,FileInfo);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Enjoy the file, '+Caps(ThisUser.Name)+'!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ProtBiDirectional IN Protocol.PRFlags) AND (NOT OfflineMail) THEN
|
||||||
|
BatchUpload(TRUE,0);
|
||||||
|
|
||||||
|
IF (IsAutoLogoff IN TransferFlags) THEN
|
||||||
|
CountDown
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Receive(FileName: Str12;
|
||||||
|
UploadPath: PathStr;
|
||||||
|
ResumeFile: Boolean;
|
||||||
|
VAR UploadOk,
|
||||||
|
KeyboardAbort,
|
||||||
|
AddULBatch: Boolean;
|
||||||
|
VAR TransferTime: LongInt);
|
||||||
|
VAR
|
||||||
|
ReturnCode,
|
||||||
|
ProtocolNumber: Integer;
|
||||||
|
BEGIN
|
||||||
|
UploadOk := TRUE;
|
||||||
|
|
||||||
|
KeyboardAbort := FALSE;
|
||||||
|
|
||||||
|
TransferTime := 0;
|
||||||
|
|
||||||
|
ProtocolNumber := DoProtocol(Protocol,TRUE,FALSE,FALSE,ResumeFile);
|
||||||
|
|
||||||
|
CASE ProtocolNumber OF
|
||||||
|
-1 : UploadOk := FALSE;
|
||||||
|
-2 : BEGIN
|
||||||
|
UploadOk := FALSE;
|
||||||
|
KeyboardAbort := TRUE;
|
||||||
|
END;
|
||||||
|
-3 : BEGIN
|
||||||
|
UploadOk := FALSE;
|
||||||
|
KeyboardAbort := TRUE;
|
||||||
|
END;
|
||||||
|
-4 : AddULBatch := TRUE;
|
||||||
|
-5 : UploadOk := FALSE;
|
||||||
|
ELSE
|
||||||
|
IF (NOT InCom) THEN
|
||||||
|
UploadOk := FALSE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
PurgeDir(TempDir+'UP\',FALSE);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('Ready to receive: ^5'+SQOutSp(FileName)+'.');
|
||||||
|
|
||||||
|
TimeLock := TRUE;
|
||||||
|
|
||||||
|
ExecProtocol('',
|
||||||
|
UploadPath,
|
||||||
|
FunctionalMCI(Protocol.EnvCmd,'','')+
|
||||||
|
#13#10+
|
||||||
|
General.ProtPath+FunctionalMCI(Protocol.ULCmd,SQOutSp(FileName),''),
|
||||||
|
0,
|
||||||
|
ReturnCode,
|
||||||
|
TransferTime);
|
||||||
|
|
||||||
|
TimeLock := FALSE;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Star('File upload complete.');
|
||||||
|
|
||||||
|
UploadOk := FindReturnCode(Protocol.ULCode,Protocol.PRFlags,IntToStr(ReturnCode));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,420 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT File9;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE DosDir(CurDir: ASTR; CONST FSpec: Str12; Expanded: Boolean);
|
||||||
|
PROCEDURE DirF(Expanded: Boolean);
|
||||||
|
PROCEDURE DeleteFF(F: FileInfoRecordType; RN: Integer);
|
||||||
|
PROCEDURE ToggleFileAreaScanFlags;
|
||||||
|
PROCEDURE SetFileAreaNewScanDate;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common5,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE DosDir(CurDir: ASTR; CONST FSpec: Str12; Expanded: Boolean);
|
||||||
|
VAR
|
||||||
|
(*
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
*)
|
||||||
|
DT: DateTime;
|
||||||
|
TempStr: ASTR;
|
||||||
|
AmPm: Str2;
|
||||||
|
Online: Byte;
|
||||||
|
NumFiles,
|
||||||
|
NumDirs,
|
||||||
|
BytesUsed: LongInt;
|
||||||
|
BEGIN
|
||||||
|
CurDir := BSlash(CurDir,TRUE);
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FindFirst(CurDir[1]+':\*.*',VolumeID,DirInfo);
|
||||||
|
IF (DOSError <> 0) THEN
|
||||||
|
TempStr := 'has no label.'
|
||||||
|
ELSE
|
||||||
|
TempStr := 'is '+DirInfo.Name;
|
||||||
|
PrintACR(' Volume in drive '+UpCase(CurDir[1])+' '+TempStr);
|
||||||
|
|
||||||
|
(* Add Serial Number if possible *)
|
||||||
|
|
||||||
|
NL;
|
||||||
|
PrintACR(' Directory of '+CurDir);
|
||||||
|
NL;
|
||||||
|
TempStr := '';
|
||||||
|
Online := 0;
|
||||||
|
NumFiles := 0;
|
||||||
|
NumDirs := 0;
|
||||||
|
BytesUsed := 0;
|
||||||
|
CurDir := CurDir + FSpec;
|
||||||
|
FindFirst(CurDir,AnyFile,DirInfo);
|
||||||
|
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (DirInfo.Attr AND Directory = Directory)) OR (FileSysOp) THEN
|
||||||
|
IF (NOT (DirInfo.Attr AND VolumeID = VolumeID)) THEN
|
||||||
|
IF ((NOT (DirInfo.Attr AND DOS.Hidden = DOS.Hidden)) OR (UserNum = 1)) THEN
|
||||||
|
IF ((DirInfo.Attr AND DOS.Hidden = DOS.Hidden) AND
|
||||||
|
(NOT (DirInfo.Attr AND Directory = Directory))) OR
|
||||||
|
(NOT (DirInfo.Attr AND DOS.Hidden = DOS.Hidden)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Expanded) THEN
|
||||||
|
BEGIN
|
||||||
|
UnPackTime(DirInfo.Time,DT);
|
||||||
|
ConvertAmPm(DT.Hour,AmPm);
|
||||||
|
TempStr := ZeroPad(IntToStr(DT.Month))+
|
||||||
|
'/'+ZeroPad(IntToStr(DT.Day))+
|
||||||
|
'/'+IntToStr(DT.Year)+
|
||||||
|
' '+ZeroPad(IntToStr(DT.Hour))+
|
||||||
|
':'+ZeroPad(IntToStr(DT.Min))+
|
||||||
|
AmPm[1];
|
||||||
|
END;
|
||||||
|
IF ((DirInfo.Attr AND Directory) = Directory) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr+PadRightStr('<DIR>',11);
|
||||||
|
TempStr := TempStr+PadRightStr('',14);
|
||||||
|
TempStr := TempStr+' '+DirInfo.Name;
|
||||||
|
Inc(NumDirs);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr+' '+PadRightStr(FormatNumber(DirInfo.Size),23);
|
||||||
|
TempStr := TempStr+' '+DirInfo.Name;
|
||||||
|
Inc(NumFiles);
|
||||||
|
Inc(BytesUsed,DirInfo.Size);
|
||||||
|
END;
|
||||||
|
PrintACR(TempStr)
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(Online);
|
||||||
|
IF ((DirInfo.Attr AND Directory) = Directory) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr+PadLeftStr('['+DirInfo.Name+']',15);
|
||||||
|
Inc(NumDirs);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr+PadLeftStr(DirInfo.Name,15);
|
||||||
|
Inc(NumFiles);
|
||||||
|
Inc(BytesUsed,DirInfo.Size);
|
||||||
|
END;
|
||||||
|
IF (Online = 5) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR(TempStr);
|
||||||
|
TempStr := '';
|
||||||
|
Online := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
FindNext(DirInfo);
|
||||||
|
END;
|
||||||
|
IF (DOSError <> 0) AND (Online IN [1..5]) THEN
|
||||||
|
PrintACR(TempStr);
|
||||||
|
IF (NumFiles = 0) THEN
|
||||||
|
PrintACR('File Not Found')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintACR(PadRightStr(FormatNumber(NumFiles),16)+' File(s)'+
|
||||||
|
PadRightStr(FormatNumber(BytesUsed),15)+' bytes');
|
||||||
|
PrintACR(PadRightStr(FormatNumber(NumDirs),16)+' Dir(s)'+
|
||||||
|
PadRightStr(FormatNumber(DiskFree(ExtractDriveNumber(CurDir))),16)+' bytes free');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DirF(Expanded: Boolean);
|
||||||
|
VAR
|
||||||
|
FSpec: Str12;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Raw directory.');
|
||||||
|
{ Print(FString.lGFNLine1); }
|
||||||
|
lRGLngStr(28,FALSE);
|
||||||
|
{ Prt(FString.GFNLine2); }
|
||||||
|
lRGLngStr(29,FALSE);
|
||||||
|
GetFileName(FSpec);
|
||||||
|
NL;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
DosDir(MemFileArea.DLPath,FSpec,Expanded);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteFF(F: FileInfoRecordType; RN: Integer);
|
||||||
|
VAR
|
||||||
|
ExtFile1: FILE;
|
||||||
|
S,
|
||||||
|
FN: STRING;
|
||||||
|
TotLoad,
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
TempVPointer: LongInt;
|
||||||
|
BEGIN
|
||||||
|
IF (RN <= FileSize(FileInfoFile)) AND (RN > -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,RN);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
|
||||||
|
F.VPointer := -1;
|
||||||
|
F.VTextSize := 0;
|
||||||
|
|
||||||
|
Seek(FileInfoFile,RN);
|
||||||
|
Write(FileInfoFile,F);
|
||||||
|
|
||||||
|
Reset(ExtInfoFile,1);
|
||||||
|
IF (FADirDLPath IN MemFileArea.FAFlags) THEN
|
||||||
|
FN := MemFileArea.DLPath+MemFileArea.FileName
|
||||||
|
ELSE
|
||||||
|
FN := General.Datapath+MemFileArea.FileName;
|
||||||
|
Assign(ExtFile1,FN+'.EX1');
|
||||||
|
ReWrite(ExtFile1,1);
|
||||||
|
FOR DirFileRecNum := 0 TO (FileSize(FileInfoFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
IF (F.VPointer <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
TempVPointer := (FileSize(ExtFile1) + 1);
|
||||||
|
Seek(ExtFile1,FileSize(ExtFile1));
|
||||||
|
TotLoad := 0;
|
||||||
|
Seek(ExtInfoFile,(F.VPointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(ExtInfoFile,S[0],1);
|
||||||
|
BlockRead(ExtInfoFile,S[1],Ord(S[0]));
|
||||||
|
Inc(TotLoad,(Length(S) + 1));
|
||||||
|
BlockWrite(ExtFile1,S,(Length(S) + 1));
|
||||||
|
UNTIL (TotLoad >= F.VTextSize);
|
||||||
|
F.VPointer := TempVPointer;
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,F);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
Erase(ExtInfoFile);
|
||||||
|
Close(ExtFile1);
|
||||||
|
ReName(ExtFile1,FN+'.EXT');
|
||||||
|
|
||||||
|
IF (RN <> (FileSize(FileInfoFile) - 1)) THEN
|
||||||
|
FOR DirFileRecNum := RN TO (FileSize(FileInfoFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,(DirFileRecNum + 1));
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Write(FileInfoFile,F);
|
||||||
|
END;
|
||||||
|
Seek(FileInfoFile,(FileSize(FileInfoFile) - 1));
|
||||||
|
Truncate(FileInfoFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(* 1. Verify if CDROM's can have new files in them *)
|
||||||
|
PROCEDURE ToggleFileAreaScanFlags;
|
||||||
|
VAR
|
||||||
|
InputStr: Str11;
|
||||||
|
FirstFArea,
|
||||||
|
LastFArea,
|
||||||
|
FArea,
|
||||||
|
NumFAreas,
|
||||||
|
SaveFArea,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
SaveConfSystem,
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ToggleScanFlags(FArea1: Integer; ScanType: Byte);
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea1) THEN
|
||||||
|
ChangeFileArea(FArea1);
|
||||||
|
IF (FileArea = FArea1) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNewScanFile(NewScanFileArea);
|
||||||
|
IF (ScanType = 1) THEN
|
||||||
|
NewScanFileArea := TRUE
|
||||||
|
ELSE IF (ScanType = 2) THEN
|
||||||
|
NewScanFileArea := FALSE
|
||||||
|
ELSE IF (ScanType = 3) THEN
|
||||||
|
NewScanFileArea := (NOT NewScanFileArea);
|
||||||
|
SaveNewScanFile(NewScanFileArea);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
FArea := 1;
|
||||||
|
NumFAreas := 0;
|
||||||
|
LightBarCmd := 1;
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveFArea := FArea;
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
LFileAreaList(FArea,NumFAreas,5,TRUE);
|
||||||
|
{
|
||||||
|
%LFToggle new scan? [^5#^4,^5#^4-^5#^4,^5F^4=^5Flag ^4or ^5U^4=^5Unflag All^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
|
||||||
|
}
|
||||||
|
FileAreaScanInput(LRGLngStr(74,TRUE),((Length(IntToStr(HighFileArea)) * 2) + 1),InputStr,'QFU[]?',LowFileArea,
|
||||||
|
HighFileArea);
|
||||||
|
IF (InputStr <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
FArea := (SaveFArea - ((PageLength - 5) * 2));
|
||||||
|
IF (FArea < 1) THEN
|
||||||
|
FArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (FArea > NumFileAreas) THEN
|
||||||
|
FArea := SaveFArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
$File_Message_Area_List_Help
|
||||||
|
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
|
||||||
|
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
|
||||||
|
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
|
||||||
|
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
|
||||||
|
^1(^3[^1)Previous page ^1(^3]^1)Next page
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(71,FALSE);
|
||||||
|
FArea := SaveFArea;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FileArea := 0;
|
||||||
|
IF (InputStr = 'F') THEN
|
||||||
|
BEGIN
|
||||||
|
FOR FArea := 1 TO NumFileAreas DO
|
||||||
|
ToggleScanFlags(FArea,1);
|
||||||
|
{
|
||||||
|
%LFYou are now scanning all file areas.
|
||||||
|
}
|
||||||
|
LRGLngStr(86,FALSE);
|
||||||
|
Farea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = 'U') THEN
|
||||||
|
BEGIN
|
||||||
|
FOR FArea := 1 TO NumFileAreas DO
|
||||||
|
ToggleScanFlags(FArea,2);
|
||||||
|
{
|
||||||
|
%LFYou are now not scanning any file areas.
|
||||||
|
}
|
||||||
|
LRGLngStr(88,FALSE);
|
||||||
|
Farea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FirstFArea := StrToInt(InputStr);
|
||||||
|
IF (Pos('-',InputStr) = 0) THEN
|
||||||
|
LastFArea := FirstFArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LastFArea := StrToInt(Copy(InputStr,(Pos('-',InputStr) + 1),(Length(InputStr) - Pos('-',InputStr))));
|
||||||
|
IF (FirstFArea > LastFArea) THEN
|
||||||
|
BEGIN
|
||||||
|
FArea := FirstFArea;
|
||||||
|
FirstFArea := LastFArea;
|
||||||
|
LastFArea := FArea;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (FirstFArea < LowFileArea) OR (LastFArea > HighFileArea) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^7The range must be from %A1 to %A2!^1
|
||||||
|
}
|
||||||
|
LRGLngStr(90,FALSE);
|
||||||
|
Farea := SavefArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FirstFArea := CompFileArea(FirstFArea,1);
|
||||||
|
LastFArea := CompFileArea(LastFArea,1);
|
||||||
|
FOR FArea := FirstFArea TO LastFArea DO
|
||||||
|
ToggleScanFlags(FArea,3);
|
||||||
|
IF (FirstFArea = LastFArea) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^5%FB^3 will %FSbe scanned.
|
||||||
|
}
|
||||||
|
LRGLngStr(92,FALSE);
|
||||||
|
END;
|
||||||
|
Farea := SaveFArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr = 'Q') OR (HangUp);
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
(* Done - Lee Palmer 06/18/06 *)
|
||||||
|
PROCEDURE SetFileAreaNewScanDate;
|
||||||
|
VAR
|
||||||
|
TempDate: Str10;
|
||||||
|
Key: CHAR;
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
NL;
|
||||||
|
Prt(FString.FileNewScan);
|
||||||
|
}
|
||||||
|
lRGLngStr(54,FALSE);
|
||||||
|
MPL(10);
|
||||||
|
Prompt(PD2Date(NewFileDate));
|
||||||
|
Key := Char(GetKey);
|
||||||
|
IF (Key = #13) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
TempDate := PD2Date(NewFileDate);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Buf := Key;
|
||||||
|
DOBackSpace(1,10);
|
||||||
|
InputFormatted('',TempDate,'##/##/####',TRUE);
|
||||||
|
IF (TempDate = '') THEN
|
||||||
|
TempDate := PD2Date(NewFileDate);
|
||||||
|
END;
|
||||||
|
IF (DayNum(TempDate) = 0) OR (DayNum(TempDate) > DayNum(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Invalid date entered!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('New file scan date set to: ^5'+TempDate+'^1');
|
||||||
|
NewFileDate := Date2PD(TempDate);
|
||||||
|
SL1('Reset file new scan date to: ^5'+TempDate+'.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,454 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT LineChat;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE RequestSysOpChat(CONST MenuOption: Str50);
|
||||||
|
PROCEDURE ChatFileLog(b: Boolean);
|
||||||
|
PROCEDURE SysOpLineChat;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Dos,
|
||||||
|
Email,
|
||||||
|
Events,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE RequestSysOpChat(CONST MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
Reason: AStr;
|
||||||
|
Cmd: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
UNum,
|
||||||
|
Counter1: Integer;
|
||||||
|
Chatted: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (ChatAttempts < General.MaxChat) OR (CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (Pos(';',MenuOption) <> 0) THEN
|
||||||
|
Print(Copy(MenuOption,(Pos(';',MenuOption) + 1),Length(MenuOption)))
|
||||||
|
ELSE
|
||||||
|
lRGLngStr(37,FALSE); { FString.ChatReason; }
|
||||||
|
Chatted := FALSE;
|
||||||
|
Prt(': ');
|
||||||
|
MPL(60);
|
||||||
|
InputL(Reason,60);
|
||||||
|
IF (Reason <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(ChatAttempts);
|
||||||
|
SysOpLog('^4Chat attempt:');
|
||||||
|
SL1(Reason);
|
||||||
|
IF (NOT SysOpAvailable) AND AACS(General.OverRideChat) THEN
|
||||||
|
PrintF('CHATOVR');
|
||||||
|
IF (SysOpAvailable) OR (AACS(General.OverRideChat) AND PYNQ(^M^J'SysOp is not available. Override? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
lStatus_Screen(100,'Press [SPACE] to chat or [ENTER] for silence.',FALSE,Reason);
|
||||||
|
{ Print(FString.ChatCall1); }
|
||||||
|
lRGLngStr(14,FALSE);
|
||||||
|
Counter := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
NL;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
WKey;
|
||||||
|
IF (OutCom) THEN
|
||||||
|
Com_Send(^G);
|
||||||
|
{ Prompt(FString.ChatCall2); }
|
||||||
|
lRGLngStr(15,FALSE);
|
||||||
|
IF (OutCom) THEN
|
||||||
|
Com_Send(^G);
|
||||||
|
IF (ShutUpChatCall) THEN
|
||||||
|
Delay(600)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
FOR Counter1 := 300 DOWNTO 2 DO
|
||||||
|
BEGIN
|
||||||
|
Delay(1);
|
||||||
|
Sound(Counter1 * 10);
|
||||||
|
END;
|
||||||
|
FOR Counter1 := 2 TO 300 DO
|
||||||
|
BEGIN
|
||||||
|
Delay(1);
|
||||||
|
Sound(Counter1 * 10);
|
||||||
|
END;
|
||||||
|
NoSound;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sound(3000, 200);
|
||||||
|
Sound(1000, 200);
|
||||||
|
Sound(3000, 200);
|
||||||
|
{$ENDIF}
|
||||||
|
END;
|
||||||
|
IF (KeyPressed) THEN
|
||||||
|
BEGIN
|
||||||
|
Cmd := ReadKey;
|
||||||
|
CASE Cmd OF
|
||||||
|
#0 : BEGIN
|
||||||
|
Cmd := ReadKey;
|
||||||
|
SKey1(Cmd);
|
||||||
|
END;
|
||||||
|
#32 : BEGIN
|
||||||
|
Chatted := TRUE;
|
||||||
|
ChatAttempts := 0;
|
||||||
|
SysOpLineChat;
|
||||||
|
END;
|
||||||
|
^M : ShutUpChatCall := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Counter = 9) OR (Chatted) OR (Abort) OR (HangUp);
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
lStatus_Screen(100,'Chat Request: '+Reason,FALSE,Reason);
|
||||||
|
IF (Chatted) THEN
|
||||||
|
ChatReason := ''
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
ChatReason := Reason;
|
||||||
|
PrintF('NOSYSOP');
|
||||||
|
UNum := StrToInt(MenuOption);
|
||||||
|
IF (UNum > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
InResponseTo := #1'Tried chatting';
|
||||||
|
LoadURec(User,UNum);
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Send mail to '+Caps(User.Name)+'? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
MHeader.Status := [];
|
||||||
|
SEmail(UNum,MHeader);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
TLeft;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintF('GOAWAY');
|
||||||
|
UNum := StrToInt(MenuOption);
|
||||||
|
IF (UNum > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
InResponseTo := 'Tried chatting (more than '+IntToStr(General.MaxChat)+' times!)';
|
||||||
|
SysOpLog(InResponseTo);
|
||||||
|
MHeader.Status := [];
|
||||||
|
SEmail(UNum,MHeader);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChatFileLog(b: Boolean);
|
||||||
|
VAR
|
||||||
|
s: AStr;
|
||||||
|
BEGIN
|
||||||
|
s := 'Chat';
|
||||||
|
IF (ChatSeparate IN ThisUser.SFlags) THEN
|
||||||
|
s := s + IntToStr(UserNum);
|
||||||
|
s := General.LogsPath+s+'.LOG';
|
||||||
|
IF (NOT b) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (CFO) THEN
|
||||||
|
BEGIN
|
||||||
|
lStatus_Screen(100,'Chat recorded to '+s,FALSE,s);
|
||||||
|
CFO := FALSE;
|
||||||
|
IF (TextRec(ChatFile).Mode <> FMClosed) THEN
|
||||||
|
Close(ChatFile);
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CFO := TRUE;
|
||||||
|
IF (TextRec(ChatFile).Mode = FMOutPut) THEN
|
||||||
|
Close(ChatFile);
|
||||||
|
Assign(ChatFile,s);
|
||||||
|
Append(ChatFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(ChatFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
SysOpLog('Cannot open chat log file: '+s);
|
||||||
|
lStatus_Screen(100,'Recording chat to '+s,FALSE,s);
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
WriteLn(ChatFile,Dat);
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
Writeln(ChatFile,'Recorded with user: '+Caps(ThisUser.Name));
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
WriteLn(ChatFile,'Chat reason: '+AOnOff(ChatReason = '','None',ChatReason));
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
WriteLn(ChatFile,'------------------------------------');
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InLi1(VAR S: STRING);
|
||||||
|
VAR
|
||||||
|
C,
|
||||||
|
C1: Char;
|
||||||
|
Counter,
|
||||||
|
Counter1,
|
||||||
|
CPos: Byte;
|
||||||
|
BEGIN
|
||||||
|
CPos := 1;
|
||||||
|
S := '';
|
||||||
|
IF (LastLineStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Prompt(LastLineStr);
|
||||||
|
S := LastLineStr;
|
||||||
|
LastLineStr := '';
|
||||||
|
CPos := (Length(S) + 1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
C := Char(GetKey);
|
||||||
|
CheckHangUp;
|
||||||
|
CASE Ord(C) OF
|
||||||
|
32..255 :
|
||||||
|
IF (CPos < 79) THEN
|
||||||
|
BEGIN
|
||||||
|
S[CPos] := C;
|
||||||
|
Inc(CPos);
|
||||||
|
OutKey(C);
|
||||||
|
IF (Trapping) THEN
|
||||||
|
Write(TrapFile,C);
|
||||||
|
END;
|
||||||
|
16 : IF (OkANSI OR OkAvatar) THEN
|
||||||
|
BEGIN
|
||||||
|
C1 := Char(GetKey);
|
||||||
|
UserColor(Ord(C1) - 48);
|
||||||
|
END;
|
||||||
|
27 : IF (CPos < 79) THEN
|
||||||
|
BEGIN
|
||||||
|
S[CPos] := C;
|
||||||
|
Inc(CPos);
|
||||||
|
OutKey(C);
|
||||||
|
IF (Trapping) THEN
|
||||||
|
Write(TrapFile,C);
|
||||||
|
END;
|
||||||
|
8 : IF (CPos > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(CPos);
|
||||||
|
BackSpace;
|
||||||
|
END;
|
||||||
|
24 : BEGIN
|
||||||
|
FOR Counter := 1 TO (CPos - 1) DO
|
||||||
|
BackSpace;
|
||||||
|
CPos := 1;
|
||||||
|
END;
|
||||||
|
7 : IF (OutCom) THEN
|
||||||
|
Com_Send(^G);
|
||||||
|
23 : IF (CPos > 1) THEN
|
||||||
|
REPEAT
|
||||||
|
Dec(CPos);
|
||||||
|
BackSpace;
|
||||||
|
UNTIL (CPos = 1) OR (S[CPos] = ' ');
|
||||||
|
9 : BEGIN
|
||||||
|
Counter := (5 - (CPos MOD 5));
|
||||||
|
IF ((CPos + Counter) < 79) THEN
|
||||||
|
FOR Counter1 := 1 TO Counter DO
|
||||||
|
BEGIN
|
||||||
|
S[CPos] := ' ';
|
||||||
|
Inc(CPos);
|
||||||
|
Prompt(' ');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL ((C = ^M) OR (CPos = 79) OR (HangUp) OR (NOT InChat));
|
||||||
|
IF (NOT InChat) THEN
|
||||||
|
BEGIN
|
||||||
|
C := #13;
|
||||||
|
InChat := FALSE;
|
||||||
|
END;
|
||||||
|
S[0] := Chr(CPos - 1);
|
||||||
|
IF (C <> ^M) THEN
|
||||||
|
BEGIN
|
||||||
|
Counter := (CPos - 1);
|
||||||
|
WHILE (Counter > 0) AND (S[Counter] <> ' ') AND (S[Counter] <> ^H) DO
|
||||||
|
Dec(Counter);
|
||||||
|
IF (Counter > (CPos DIV 2)) AND (Counter <> (CPos - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
LastLineStr := Copy(S,(Counter + 1),(CPos - Counter));
|
||||||
|
FOR Counter1 := (CPos - 2) DOWNTO Counter DO
|
||||||
|
Prompt(^H);
|
||||||
|
FOR Counter1 := (CPos - 2) DOWNTO Counter DO
|
||||||
|
Prompt(' ');
|
||||||
|
S[0] := Chr(Counter - 1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SysOpLineChat;
|
||||||
|
VAR
|
||||||
|
S: AStr;
|
||||||
|
Counter: Integer;
|
||||||
|
ChatTime: LongInt;
|
||||||
|
SaveEcho,
|
||||||
|
SavePrintingFile,
|
||||||
|
SaveMCIAllowed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
UserColor(1);
|
||||||
|
SaveMCIAllowed := MCIAllowed;
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
ChatTime := GetPackDateTime;
|
||||||
|
DOSANSIOn := FALSE;
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
SaveNAvail := (NAvail IN Noder.Status);
|
||||||
|
Exclude(Noder.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
SavePrintingFile := PrintingFile;
|
||||||
|
InChat := TRUE;
|
||||||
|
ChatCall := FALSE;
|
||||||
|
SaveEcho := Echo;
|
||||||
|
Echo := TRUE;
|
||||||
|
IF (General.AutoChatOpen) THEN
|
||||||
|
ChatFileLog(TRUE)
|
||||||
|
ELSE IF (ChatAuto IN ThisUser.SFlags) THEN
|
||||||
|
ChatFileLog(TRUE);
|
||||||
|
NL;
|
||||||
|
Exclude(ThisUser.Flags,Alert);
|
||||||
|
PrintF('CHATINIT');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
(*
|
||||||
|
Prompt('^5'+FString.EnGage);
|
||||||
|
*)
|
||||||
|
lRGLNGStr(2,FALSE);
|
||||||
|
|
||||||
|
UserColor(General.SysOpColor);
|
||||||
|
WColor := TRUE;
|
||||||
|
|
||||||
|
IF (ChatReason <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
lStatus_Screen(100,ChatReason,FALSE,S);
|
||||||
|
ChatReason := '';
|
||||||
|
END;
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
InLi1(S);
|
||||||
|
|
||||||
|
IF (S[1] = '/') THEN
|
||||||
|
S := AllCaps(S);
|
||||||
|
|
||||||
|
IF (Copy(S,1,6) = '/TYPE ') AND (SysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
S := Copy(S,7,(Length(S) - 6));
|
||||||
|
IF (S <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
PrintFile(S);
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print('*File not found*');
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF ((S = '/HELP') OR (S = '/?')) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (SysOp) THEN
|
||||||
|
Print('^5/TYPE d:\path\filename.ext^3: Type a file');
|
||||||
|
(*
|
||||||
|
Print('^5/BYE^3: Hang up');
|
||||||
|
Print('^5/CLS^3: Clear the screen');
|
||||||
|
Print('^5/PAGE^3: Page the SysOp and User');
|
||||||
|
Print('^5/Q^3: Exit chat mode'^M^J);
|
||||||
|
*)
|
||||||
|
lRGLngStr(65,FALSE);
|
||||||
|
END
|
||||||
|
ELSE IF (S = '/CLS') THEN
|
||||||
|
CLS
|
||||||
|
ELSE IF (S = '/PAGE') THEN
|
||||||
|
BEGIN
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
FOR Counter := 650 TO 700 DO
|
||||||
|
BEGIN
|
||||||
|
Sound(Counter);
|
||||||
|
Delay(4);
|
||||||
|
NoSound;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Dec(Counter);
|
||||||
|
Sound(Counter);
|
||||||
|
Delay(2);
|
||||||
|
NoSound;
|
||||||
|
UNTIL (Counter = 200);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sound(650, 200);
|
||||||
|
Sound(700, 200);
|
||||||
|
Sound(600, 200);
|
||||||
|
Sound(500, 200);
|
||||||
|
Sound(400, 200);
|
||||||
|
Sound(300, 200);
|
||||||
|
{$ENDIF}
|
||||||
|
Prompt(^G^G);
|
||||||
|
END
|
||||||
|
ELSE IF (S = '/BYE') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('Hanging up ...');
|
||||||
|
HangUp := TRUE;
|
||||||
|
END
|
||||||
|
ELSE IF (S = '/Q') THEN
|
||||||
|
BEGIN
|
||||||
|
InChat := FALSE;
|
||||||
|
Print('Chat Aborted ...');
|
||||||
|
END;
|
||||||
|
IF (CFO) THEN
|
||||||
|
WriteLn(ChatFile,S);
|
||||||
|
UNTIL ((NOT InChat) OR (HangUp));
|
||||||
|
|
||||||
|
PrintF('CHATEND');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
(*
|
||||||
|
Print('^5'+FString.lEndChat);
|
||||||
|
*)
|
||||||
|
lRGLngStr(3,FALSE);
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
IF (SaveNAvail) THEN
|
||||||
|
Include(Noder.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
ChatTime := (GetPackDateTime - ChatTime);
|
||||||
|
IF (ChopTime = 0) THEN
|
||||||
|
Inc(FreeTime,ChatTime);
|
||||||
|
TLeft;
|
||||||
|
S := 'Chatted for '+FormattedTime(ChatTime);
|
||||||
|
IF (CFO) THEN
|
||||||
|
BEGIN
|
||||||
|
S := S+' -{ Recorded in Chat';
|
||||||
|
IF (ChatSeparate IN ThisUser.SFlags) THEN
|
||||||
|
S := S + IntToStr(UserNum);
|
||||||
|
S := S+'.LOG }-';
|
||||||
|
END;
|
||||||
|
SysOpLog(S);
|
||||||
|
InChat := FALSE;
|
||||||
|
Echo := SaveEcho;
|
||||||
|
IF ((HangUp) AND (CFO)) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
WriteLn(ChatFile,'=> User disconnected');
|
||||||
|
WriteLn(ChatFile);
|
||||||
|
END;
|
||||||
|
PrintingFile := SavePrintingFile;
|
||||||
|
IF (CFO) THEN
|
||||||
|
ChatFileLog(FALSE);
|
||||||
|
IF (InVisEdit) THEN
|
||||||
|
Buf := ^L;
|
||||||
|
MCIAllowed := SaveMCIAllowed;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,895 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Mail0;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION CompMsgArea(MArea: Integer; ArrayNum: Byte): Integer;
|
||||||
|
FUNCTION UseName(AnonNum: Byte; NameToUse: Str36): Str36;
|
||||||
|
PROCEDURE UpdateBoard;
|
||||||
|
PROCEDURE ExtractMsgToFile(MsgNum: Word; MHeader: MheaderRec);
|
||||||
|
PROCEDURE DumpQuote(MHeader: MHeaderRec);
|
||||||
|
PROCEDURE LoadHeader(MsgNum: Word; VAR MHeader: MHeaderRec);
|
||||||
|
PROCEDURE SaveHeader(MsgNum: Word; MHeader: MHeaderRec);
|
||||||
|
FUNCTION MsgAreaAC(MArea: Integer): Boolean;
|
||||||
|
PROCEDURE ChangeMsgArea(MArea: Integer);
|
||||||
|
PROCEDURE LoadMsgArea(MArea: Integer);
|
||||||
|
PROCEDURE LoadLastReadRecord(VAR LastReadRec: ScanRec);
|
||||||
|
PROCEDURE SaveLastReadRecord(LastReadRec: ScanRec);
|
||||||
|
PROCEDURE InitMsgArea(MArea: Integer);
|
||||||
|
PROCEDURE ReadMsg(Anum,MNum,TNum: Word);
|
||||||
|
FUNCTION HeaderLine(MHeader: MHeaderRec; MNum,TNum: Word; Line: byte; VAR FileOwner: Str36): STRING;
|
||||||
|
FUNCTION ToYou(MessageHeader: MHeaderRec): Boolean;
|
||||||
|
FUNCTION FromYou(MessageHeader: MHeaderRec): Boolean;
|
||||||
|
FUNCTION GetTagLine: Str74;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
Shortmsg,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
MHeaderRecPtrType = ^MHeaderRec;
|
||||||
|
|
||||||
|
FUNCTION CompMsgArea(MArea: Integer; ArrayNum: Byte): Integer;
|
||||||
|
VAR
|
||||||
|
MsgCompArrayFile: FILE OF CompArrayType;
|
||||||
|
CompMsgArray: CompArrayType;
|
||||||
|
BEGIN
|
||||||
|
Assign(MsgCompArrayFile,TempDir+'MACT'+IntToStr(ThisNode)+'.DAT');
|
||||||
|
Reset(MsgCompArrayFile);
|
||||||
|
Seek(MsgCompArrayFile,(MArea - 1));
|
||||||
|
Read(MsgCompArrayFile,CompMsgArray);
|
||||||
|
Close(MsgCompArrayFile);
|
||||||
|
CompMsgArea := CompMsgArray[ArrayNum];
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION UseName(AnonNum: Byte; NameToUse: Str36): Str36;
|
||||||
|
BEGIN
|
||||||
|
CASE AnonNum OF
|
||||||
|
1,2 :
|
||||||
|
NameToUse := lRGLNGStr(0,TRUE); {FString.Anonymous;}
|
||||||
|
3 : NameToUse := 'Abby';
|
||||||
|
4 : NameToUse := 'Problemed Person';
|
||||||
|
ELSE
|
||||||
|
NameToUse := Caps(NameToUse);
|
||||||
|
END;
|
||||||
|
UseName := NameToUse;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION FromYou(MessageHeader: MHeaderRec): Boolean;
|
||||||
|
BEGIN
|
||||||
|
FromYou := FALSE;
|
||||||
|
IF (MessageHeader.From.UserNum = UserNum) OR
|
||||||
|
(AllCaps(MessageHeader.From.A1S) = ThisUser.Name) OR
|
||||||
|
(AllCaps(MessageHeader.From.Name) = ThisUser.Name) OR
|
||||||
|
(AllCaps(MessageHeader.From.A1S) = AllCaps(ThisUser.RealName)) THEN
|
||||||
|
FromYou := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ToYou(MessageHeader: MHeaderRec): Boolean;
|
||||||
|
BEGIN
|
||||||
|
ToYou := FALSE;
|
||||||
|
IF (MessageHeader.MTO.UserNum = UserNum) OR
|
||||||
|
(AllCaps(MessageHeader.MTO.A1S) = ThisUser.Name) OR
|
||||||
|
(AllCaps(MessageHeader.MTO.Name) = ThisUser.Name) OR
|
||||||
|
(AllCaps(MessageHeader.MTO.A1S) = AllCaps(ThisUser.RealName)) THEN
|
||||||
|
ToYou := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UpdateBoard;
|
||||||
|
VAR
|
||||||
|
FO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (ReadMsgArea < 1) OR (ReadMsgArea > NumMsgAreas) THEN
|
||||||
|
Exit;
|
||||||
|
FO := (FileRec(MsgAreaFile).Mode <> FMClosed);
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(MsgAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Open Error - '+IntToStr(LastError)+' (Procedure: UpDateBoard - '+IntToStr(ReadMsgArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(MsgAreaFile,(ReadMsgArea - 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Seek Error - '+IntToStr(LastError)+' (Procedure: UpDateBoard - '+IntToStr(ReadMsgArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Read(MsgAreaFile,MemMsgArea);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Read Error - '+IntToStr(LastError)+' (Procedure: UpDateBoard - '+IntToStr(ReadMsgArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Include(MemMsgArea.MAFlags,MAScanOut);
|
||||||
|
Seek(MsgAreaFile,(ReadMsgArea - 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Seek Error - '+IntToStr(LastError)+' (Procedure: UpDateBoard - '+IntToStr(ReadMsgArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Write(MsgAreaFile,MemMsgArea);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Write Error - '+IntToStr(LastError)+' (Procedure: UpDateBoard - '+IntToStr(ReadMsgArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(MsgAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Close Error - '+IntToStr(LastError)+' (Procedure: UpDateBoard - '+IntToStr(ReadMsgArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LoadHeader(MsgNum: Word; VAR MHeader: MHeaderRec);
|
||||||
|
VAR
|
||||||
|
FO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FO := FileRec(MsgHdrF).Mode <> FMClosed;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(MsgHdrF);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(MsgHdrF);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/ReWrite Error - '+IntToStr(LastError)+' (Procedure: LoadHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(MsgHdrF,(MsgNum - 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/Seek Error - '+IntToStr(LastError)+' (Procedure: LoadHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Read(MsgHdrF,MHeader);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/Read Error - '+IntToStr(LastError)+' (Procedure: LoadHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(MsgHdrF);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/Close Error - '+IntToStr(LastError)+' (Procedure: LoadHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SaveHeader(MsgNum: Word; MHeader: MHeaderRec);
|
||||||
|
VAR
|
||||||
|
FO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FO := FileRec(MsgHdrF).Mode <> FMClosed;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(MsgHdrF);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(MsgHdrF);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/ReWrite Error - '+IntToStr(LastError)+
|
||||||
|
'(Procedure: SaveHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(MsgHdrF,(MsgNum - 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/Seek Error - '+IntToStr(LastError)+' (Procedure: SaveHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Write(MsgHdrF,MHeader);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/Write Error - '+IntToStr(LastError)+' (Procedure: SaveHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(MsgHdrF);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog(MemMsgArea.FileName+'/Close Error - '+IntToStr(LastError)+' (Procedure: SaveHeader - '+IntToStr(MsgNum)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION MsgAreaAC(MArea: Integer): Boolean;
|
||||||
|
BEGIN
|
||||||
|
MsgAreaAC := FALSE;
|
||||||
|
IF (MArea <> -1) THEN
|
||||||
|
IF (MArea < 1) OR (MArea > NumMsgAreas) THEN
|
||||||
|
Exit;
|
||||||
|
LoadMsgArea(MArea);
|
||||||
|
MsgAreaAC := AACS(MemMsgArea.ACS);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChangeMsgArea(MArea: Integer);
|
||||||
|
VAR
|
||||||
|
TempPassword: Str20;
|
||||||
|
BEGIN
|
||||||
|
IF (MArea < 1) OR (MArea > NumMsgAreas) OR (NOT MsgAreaAC(MArea)) THEN
|
||||||
|
Exit;
|
||||||
|
IF (MemMsgArea.Password <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Message area: ^5'+MemMsgArea.Name+' #'+IntToStr(CompMsgArea(MArea,0))+'^1');
|
||||||
|
NL;
|
||||||
|
Prt('Password: ');
|
||||||
|
GetPassword(TempPassword,20);
|
||||||
|
IF (TempPassword <> MemMsgArea.Password) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Incorrect password!^1');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
MsgArea := MArea;
|
||||||
|
ThisUser.LastMsgArea := MsgArea;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LoadMsgArea(MArea: Integer);
|
||||||
|
VAR
|
||||||
|
FO: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (MArea = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(EmailFile,General.DataPath+'MEMAIL.DAT');
|
||||||
|
Reset(EmailFile);
|
||||||
|
Read(EmailFile,MemMsgArea);
|
||||||
|
Close(EmailFile);
|
||||||
|
ReadMsgArea := -1;
|
||||||
|
WITH LastReadRecord DO
|
||||||
|
BEGIN
|
||||||
|
LastRead := 0;
|
||||||
|
NewScan := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (MArea < 1) OR (MArea > NumMsgAreas) OR (ReadMsgArea = MArea) THEN
|
||||||
|
Exit;
|
||||||
|
FO := (FileRec(MsgAreaFile).Mode <> FMClosed);
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(MsgAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Open Error - '+IntToStr(LastError)+' (Procedure: LoadMsgArea - '+IntToStr(MArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(MsgAreaFile,(MArea - 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Seek Error - '+IntToStr(LastError)+' (Procedure: LoadMsgArea - '+IntToStr(MArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Read(MsgAreaFile,MemMsgArea);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Read Error - '+IntToStr(LastError)+' (Procedure: LoadMsgArea - '+IntToStr(MArea)+')');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
ReadMsgArea := MArea;
|
||||||
|
IF (NOT FO) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(MsgAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('MBASES.DAT/Close Error - '+IntToStr(LastError)+' (Procedure: LoadMsgArea - '+IntToStr(MArea)+')');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LoadLastReadRecord(VAR LastReadRec: ScanRec);
|
||||||
|
VAR
|
||||||
|
MsgAreaScanFile: FILE OF ScanRec;
|
||||||
|
Counter: Integer;
|
||||||
|
BEGIN
|
||||||
|
Assign(MsgAreaScanFile,General.MsgPath+MemMsgArea.FileName+'.SCN');
|
||||||
|
Reset(MsgAreaScanFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgAreaScanFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error opening file: '+General.MsgPath+MemMsgArea.FileName+'.SCN');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (UserNum > FileSize(MsgAreaScanFile)) THEN
|
||||||
|
BEGIN
|
||||||
|
WITH LastReadRec DO
|
||||||
|
BEGIN
|
||||||
|
LastRead := 0;
|
||||||
|
NewScan := TRUE;
|
||||||
|
END;
|
||||||
|
Seek(MsgAreaScanFile,FileSize(MsgAreaScanFile));
|
||||||
|
FOR Counter := FileSize(MsgAreaScanFile) TO (UserNum - 1) DO
|
||||||
|
Write(MsgAreaScanFile,LastReadRec);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgAreaScanFile,(UserNum - 1));
|
||||||
|
Read(MsgAreaScanFile,LastReadRec);
|
||||||
|
END;
|
||||||
|
Close(MsgAreaScanFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SaveLastReadRecord(LastReadRec: ScanRec);
|
||||||
|
VAR
|
||||||
|
MsgAreaScanFile: FILE OF ScanRec;
|
||||||
|
BEGIN
|
||||||
|
Assign(MsgAreaScanFile,General.MsgPath+MemMsgArea.FileName+'.SCN');
|
||||||
|
Reset(MsgAreaScanFile);
|
||||||
|
Seek(MsgAreaScanFile,(UserNum - 1));
|
||||||
|
Write(MsgAreaScanFile,LastReadRec);
|
||||||
|
Close(MsgAreaScanFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitMsgArea(MArea: Integer);
|
||||||
|
BEGIN
|
||||||
|
LoadMsgArea(MArea);
|
||||||
|
Assign(MsgHdrF,General.MsgPath+MemMsgArea.FileName+'.HDR');
|
||||||
|
Reset(MsgHdrF);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgHdrF);
|
||||||
|
Close(MsgHdrF);
|
||||||
|
Assign(MsgTxtF,General.MsgPath+MemMsgArea.FileName+'.DAT');
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgTxtF,1);
|
||||||
|
Close(MsgTxtF);
|
||||||
|
IF (MArea = -1) THEN
|
||||||
|
Exit;
|
||||||
|
LoadLastReadRecord(LastReadRecord);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DumpQuote(MHeader: MHeaderRec);
|
||||||
|
VAR
|
||||||
|
QuoteFile: Text;
|
||||||
|
DT: DateTime;
|
||||||
|
S: STRING;
|
||||||
|
S1: STRING[80];
|
||||||
|
Counter: Byte;
|
||||||
|
TempTextSize: Word;
|
||||||
|
BEGIN
|
||||||
|
IF (MHeader.TextSize < 1) THEN
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
Assign(QuoteFile,'TEMPQ'+IntToStr(ThisNode));
|
||||||
|
ReWrite(QuoteFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('^7Error creating file: ^5TEMPQ'+IntToStr(ThisNode)+'^1!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
S := AOnOff(MARealName IN MemMsgArea.MAFlags,MHeader.From.Real,MHeader.From.A1S);
|
||||||
|
|
||||||
|
FOR Counter := 1 TO 2 DO
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (Counter = 1) THEN
|
||||||
|
S1 := MemMsgArea.QuoteStart
|
||||||
|
ELSE
|
||||||
|
S1 := MemMsgArea.QuoteEnd;
|
||||||
|
|
||||||
|
S1 := Substitute(S1,'@F',UseName(MHeader.From.Anon,S));
|
||||||
|
|
||||||
|
S1 := Substitute(S1,'@T',UseName(MHeader.MTO.Anon,
|
||||||
|
AOnOff(MARealName IN MemMsgArea.MAFlags,
|
||||||
|
Caps(MHeader.MTO.Real),
|
||||||
|
Caps(MHeader.MTO.A1S))));
|
||||||
|
|
||||||
|
|
||||||
|
IF (MHeader.Origindate <> '') THEN
|
||||||
|
S1 := Substitute(S1,'@D',MHeader.Origindate)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Packtodate(DT,MHeader.Date);
|
||||||
|
S1 := Substitute(S1,'@D',IntToStr(DT.Day)+
|
||||||
|
' '+Copy(MonthString[DT.Month],1,3)+
|
||||||
|
' '+Copy(IntToStr(DT.Year),3,2)+
|
||||||
|
' '+Zeropad(IntToStr(DT.Hour))+
|
||||||
|
':'+Zeropad(IntToStr(DT.Min)));
|
||||||
|
END;
|
||||||
|
|
||||||
|
S1 := Substitute(S1,'@S',AOnOff(MHeader.FileAttached = 0,
|
||||||
|
Substitute(S1,'@S',MHeader.Subject),
|
||||||
|
Substitute(S1,'@S',StripName(MHeader.Subject))));
|
||||||
|
|
||||||
|
S1 := Substitute(S1,'@B',MemMsgArea.Name);
|
||||||
|
|
||||||
|
IF (S1 <> '') THEN
|
||||||
|
WriteLn(QuoteFile,S1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
WriteLn(QuoteFile);
|
||||||
|
|
||||||
|
S1 := S[1];
|
||||||
|
IF (Pos(' ',S) > 0) AND (Length(S) > Pos(' ',S)) THEN
|
||||||
|
S1 := S1 + S[Pos(' ',S) + 1]
|
||||||
|
ELSE IF (Length(S1) > 1) THEN
|
||||||
|
S1 := S1 + S[2];
|
||||||
|
IF (MHeader.From.Anon <> 0) THEN
|
||||||
|
S1 := '';
|
||||||
|
S1 := Copy(S1,1,2);
|
||||||
|
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
||||||
|
TempTextSize := 0;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(MsgTxtF,S[0],1);
|
||||||
|
BlockRead(MsgTxtF,S[1],Ord(S[0]));
|
||||||
|
LastError := IOResult;
|
||||||
|
Inc(TempTextSize,Length(S) + 1);
|
||||||
|
IF (Pos('> ',Copy(S,1,4)) > 0) THEN
|
||||||
|
S := Copy(StripColor(S),1,78)
|
||||||
|
ELSE
|
||||||
|
S := Copy(S1+'> '+StripColor(S),1,78);
|
||||||
|
WriteLn(QuoteFile,S);
|
||||||
|
UNTIL (TempTextSize >= MHeader.TextSize);
|
||||||
|
Close(QuoteFile);
|
||||||
|
Close(MsgTxtF);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ExtractMsgToFile(MsgNum: Word; MHeader: MHeaderRec);
|
||||||
|
VAR
|
||||||
|
ExtTxtFile: Text;
|
||||||
|
FileOwner: Str36;
|
||||||
|
FileName: Str52;
|
||||||
|
MsgTxtStr: STRING;
|
||||||
|
Counter: Byte;
|
||||||
|
TempTextSize: Word;
|
||||||
|
StripColors: Boolean;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Extract message to file:');
|
||||||
|
Prt(': ');
|
||||||
|
InputDefault(FileName,'MSG'+IntToStr(ThisNode)+'.TXT',52,[UpperOnly,NoLineFeed],TRUE);
|
||||||
|
IF (FileName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Are you sure? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
StripColors := PYNQ('Strip color codes from output? ',0,FALSE);
|
||||||
|
|
||||||
|
Assign(ExtTxtFile,FileName);
|
||||||
|
Append(ExtTxtFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(ExtTxtFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('^7Unable to create file: ^5'+FileName+'!^1');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LoadHeader(MsgNum,MHeader);
|
||||||
|
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
BEGIN
|
||||||
|
MsgTxtStr := HeaderLine(MHeader,MsgNum,HiMsg,Counter,FileOwner);
|
||||||
|
IF (MsgTxtStr <> '') THEN
|
||||||
|
IF (StripColors) THEN
|
||||||
|
WriteLn(ExtTxtFile,StripColor(MsgTxtStr))
|
||||||
|
ELSE
|
||||||
|
WriteLn(ExtTxtFile,MsgTxtStr);
|
||||||
|
END;
|
||||||
|
|
||||||
|
WriteLn(ExtTxtFile);
|
||||||
|
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
||||||
|
TempTextSize := 0;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(MsgTxtF,MsgTxtStr[0],1);
|
||||||
|
BlockRead(MsgTxtF,MsgTxtStr[1],Ord(MsgTxtStr[0]));
|
||||||
|
LastError := IOResult;
|
||||||
|
Inc(TempTextSize,(Length(MsgTxtStr) + 1));
|
||||||
|
IF (StripColors) THEN
|
||||||
|
MsgTxtStr := StripColor(MsgTxtStr);
|
||||||
|
IF (MsgTxtStr[Length(MsgTxtStr)] = #29) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(MsgTxtStr[0]);
|
||||||
|
Write(ExtTxtFile,MsgTxtStr);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
WriteLn(ExtTxtFile,MsgTxtStr);
|
||||||
|
UNTIL (TempTextSize >= MHeader.TextSize);
|
||||||
|
WriteLn(ExtTxtFile);
|
||||||
|
Close(ExtTxtFile);
|
||||||
|
Close(MsgTxtF);
|
||||||
|
NL;
|
||||||
|
Print('Message extracted.');
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION MHeaderRecMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
|
||||||
|
VAR
|
||||||
|
MHeaderPtr: MHeaderRecPtrType;
|
||||||
|
S1: STRING;
|
||||||
|
BEGIN
|
||||||
|
MheaderPtr := Data1;
|
||||||
|
MHeaderRecMCI := S;
|
||||||
|
CASE S[1] OF
|
||||||
|
'C' : CASE S[2] OF
|
||||||
|
'A' : ;{TodaysCallerMCI := FormatNumber(LastCallerPtr^.Caller);}
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION HeaderLine(MHeader: MHeaderRec; MNum,TNum: Word; Line: byte; VAR FileOwner: Str36): STRING;
|
||||||
|
VAR
|
||||||
|
S,
|
||||||
|
S1: STRING;
|
||||||
|
Pub,
|
||||||
|
SeeAnon: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Pub := (ReadMsgArea <> -1);
|
||||||
|
|
||||||
|
IF (Pub) THEN
|
||||||
|
SeeAnon := (AACS(General.AnonPubRead) OR MsgSysOp)
|
||||||
|
ELSE
|
||||||
|
SeeAnon := AACS(General.AnonPrivRead);
|
||||||
|
|
||||||
|
IF (MHeader.From.Anon = 2) THEN
|
||||||
|
SeeAnon := CoSysOp;
|
||||||
|
|
||||||
|
S := '';
|
||||||
|
|
||||||
|
CASE Line OF
|
||||||
|
1 : BEGIN
|
||||||
|
|
||||||
|
IF (MHeader.FileAttached > 0) THEN
|
||||||
|
InResponseTo := StripName(MHeader.Subject)
|
||||||
|
ELSE
|
||||||
|
InResponseTo := Mheader.Subject;
|
||||||
|
|
||||||
|
IF ((MHeader.From.Anon = 0) OR (SeeAnon)) THEN
|
||||||
|
LastAuthor := MHeader.From.UserNum
|
||||||
|
ELSE
|
||||||
|
LastAuthor := 0;
|
||||||
|
|
||||||
|
IF ((MHeader.From.Anon = 0) OR (SeeAnon)) THEN
|
||||||
|
S := PDT2Dat(MHeader.Date,MHeader.DayOfWeek)
|
||||||
|
ELSE
|
||||||
|
S := '[Unknown]';
|
||||||
|
|
||||||
|
S := '^1Date: ^9'+S;
|
||||||
|
|
||||||
|
S := PadLeftStr(S,39)+'^1Number : ^9'+IntToStr(MNum)+'^1 of ^9'+IntToStr(TNum);
|
||||||
|
END;
|
||||||
|
2 : BEGIN
|
||||||
|
IF (Pub) AND (MARealName IN MemMsgArea.MAFlags) THEN
|
||||||
|
S1 := MHeader.From.Real
|
||||||
|
ELSE
|
||||||
|
S1 := MHeader.From.A1S;
|
||||||
|
S := '^1From: ^5'+Caps(UseName(MHeader.From.Anon,S1));
|
||||||
|
|
||||||
|
FileOwner := Caps(UseName(MHeader.From.Anon,S1));
|
||||||
|
|
||||||
|
IF (NOT Pub) AND (Netmail IN MHeader.Status) THEN
|
||||||
|
BEGIN
|
||||||
|
S := S + '^2 ('+IntToStr(MHeader.From.Zone)+':'+IntToStr(MHeader.From.Net)+'/'+IntToStr(MHeader.From.Node);
|
||||||
|
IF (MHeader.From.Point > 0) THEN
|
||||||
|
S := S + '.'+IntToStr(MHeader.From.Point);
|
||||||
|
S := S + ')';
|
||||||
|
END;
|
||||||
|
S := PadLeftStr(S,38)+'^1 Area : ^5';
|
||||||
|
|
||||||
|
IF (LennMCI(MemMsgArea.Name) > 30) THEN
|
||||||
|
S := S + PadLeftStr(MemMsgArea.Name,30)
|
||||||
|
ELSE
|
||||||
|
S := S + MemMsgArea.Name;
|
||||||
|
END;
|
||||||
|
3 : BEGIN
|
||||||
|
IF (Pub) AND (MARealName IN MemMsgArea.MAFlags) THEN
|
||||||
|
S1 := Caps(MHeader.MTO.Real)
|
||||||
|
ELSE
|
||||||
|
S1 := Caps(MHeader.MTO.A1S);
|
||||||
|
S := '^1To : ^5'+UseName(MHeader.MTO.Anon,S1);
|
||||||
|
IF (NOT Pub) AND (Netmail IN MHeader.Status) THEN
|
||||||
|
BEGIN
|
||||||
|
S := S + '^2 ('+IntToStr(MHeader.MTO.Zone)+':'+IntToStr(MHeader.MTO.Net)+'/'+IntToStr(MHeader.MTO.Node);
|
||||||
|
IF (MHeader.MTO.Point > 0) THEN
|
||||||
|
S := S + '.'+IntToStr(MHeader.MTO.Point);
|
||||||
|
S := S + ')';
|
||||||
|
END;
|
||||||
|
S := PadLeftStr(S,38)+'^1 Refer #: ^5';
|
||||||
|
IF (MHeader.Replyto > 0) AND (MHeader.Replyto < MNum) THEN
|
||||||
|
S := S + IntToStr(MNum - MHeader.Replyto)
|
||||||
|
ELSE
|
||||||
|
S := S + 'None';
|
||||||
|
END;
|
||||||
|
4 : BEGIN
|
||||||
|
S := '^1Subj: ';
|
||||||
|
IF (MHeader.FileAttached = 0) THEN
|
||||||
|
S := S + '^5'+MHeader.Subject
|
||||||
|
ELSE
|
||||||
|
S := S + '^8'+StripName(MHeader.Subject);
|
||||||
|
S := PadLeftStr(S,38)+'^1 Replies: ^5';
|
||||||
|
IF (MHeader.Replies <> 0) THEN
|
||||||
|
S := S + IntToStr(MHeader.Replies)
|
||||||
|
ELSE
|
||||||
|
S := S + 'None';
|
||||||
|
END;
|
||||||
|
5 : BEGIN
|
||||||
|
S := '^1Stat: ^';
|
||||||
|
IF (MDeleted IN MHeader.Status) THEN
|
||||||
|
S := S + '8Deleted'
|
||||||
|
ELSE IF (Prvt IN MHeader.Status) THEN
|
||||||
|
S := S + '8Private'
|
||||||
|
ELSE IF (Pub) AND (UnValidated IN MHeader.Status) THEN
|
||||||
|
S := S + '8Unvalidated'
|
||||||
|
ELSE IF (Pub) AND (Permanent IN MHeader.Status) THEN
|
||||||
|
S := S + '5Permanent'
|
||||||
|
ELSE IF (MemMsgArea.MAType <> 0) THEN
|
||||||
|
IF (Sent IN MHeader.Status) THEN
|
||||||
|
S := S + '5Sent'
|
||||||
|
ELSE
|
||||||
|
S := S + '5Unsent'
|
||||||
|
ELSE
|
||||||
|
S := S + '5Normal';
|
||||||
|
IF (NOT Pub) AND (Netmail IN MHeader.Status) THEN
|
||||||
|
S := S + ' Netmail';
|
||||||
|
S := PadLeftStr(S,39) + '^1Origin : ^5';
|
||||||
|
IF (MHeader.Origindate <> '') THEN
|
||||||
|
S := S + MHeader.Origindate
|
||||||
|
ELSE
|
||||||
|
S := S + 'Local';
|
||||||
|
END;
|
||||||
|
6 : IF ((SeeAnon) AND ((MHeader.MTO.Anon + MHeader.From.Anon) > 0) AND (MemMsgArea.MAType = 0)) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '^1Real: ^5';
|
||||||
|
IF (MARealName IN MemMsgArea.MAFlags) THEN
|
||||||
|
S := S + Caps(Mheader.From.Real)
|
||||||
|
ELSE
|
||||||
|
S := S + Caps(MHeader.From.Name);
|
||||||
|
S := S + '^1 to ^5';
|
||||||
|
IF (MARealName IN MemMsgArea.MAFlags) THEN
|
||||||
|
S := S + Caps(MHeader.MTO.Real)
|
||||||
|
ELSE
|
||||||
|
S := S + Caps(MHeader.MTO.Name);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
HeaderLine := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
{ anum=actual, MNum=M#/t# <-displayed, TNum=m#/T# <- max? }
|
||||||
|
|
||||||
|
PROCEDURE ReadMsg(Anum,MNum,TNum: Word);
|
||||||
|
VAR
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
FileInfo: FileInfoRecordType;
|
||||||
|
TransferFlags: TransferFlagSet;
|
||||||
|
MsgTxtStr: AStr;
|
||||||
|
FileOwner: Str36;
|
||||||
|
DS: DirStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
TempTextSize: Word;
|
||||||
|
BEGIN
|
||||||
|
AllowAbort := (CoSysOp) OR (NOT (MAForceRead IN MemMsgArea.MAFlags));
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
LoadHeader(Anum,MHeader);
|
||||||
|
IF ((MDeleted IN Mheader.Status) OR (UnValidated IN MHeader.Status)) AND
|
||||||
|
NOT (CoSysOp OR FromYou(MHeader) OR ToYou(MHeader)) THEN
|
||||||
|
Exit;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
|
||||||
|
FOR TempTextSize := 1 TO 6 DO
|
||||||
|
BEGIN
|
||||||
|
MsgTxtStr := HeaderLine(MHeader,MNum,TNum,TempTextSize,FileOwner);
|
||||||
|
IF (TempTextSize <> 2) THEN
|
||||||
|
MCIAllowed := (AllowMCI IN MHeader.Status);
|
||||||
|
IF (MsgTxtStr <> '') THEN
|
||||||
|
PrintACR(MsgTxtStr);
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error accessing message text.');
|
||||||
|
AllowAbort := TRUE;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
Reading_A_Msg := TRUE;
|
||||||
|
MCIAllowed := (AllowMCI IN Mheader.Status);
|
||||||
|
TempTextSize := 0;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
UserColor(MemMsgArea.Text_Color);
|
||||||
|
IF (MHeader.TextSize > 0) THEN
|
||||||
|
IF (((MHeader.Pointer - 1) + MHeader.TextSize) <= FileSize(MsgTxtF)) AND (MHeader.Pointer > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
||||||
|
REPEAT
|
||||||
|
BlockRead(MsgTxtF,MsgTxtStr[0],1);
|
||||||
|
BlockRead(MsgTxtF,MsgTxtStr[1],Ord(MsgTxtStr[0]));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error loading message text.');
|
||||||
|
TempTextSize := MHeader.TextSize;
|
||||||
|
END;
|
||||||
|
Inc(TempTextSize,(Length(MsgTxtStr) + 1));
|
||||||
|
IF (' * Origin: ' = Copy(MsgTxtStr,1,11)) THEN
|
||||||
|
MsgTxtStr := '^'+IntToStr(MemMsgArea.Origin_Color) + MsgTxtStr
|
||||||
|
ELSE IF ('---'= Copy(MsgTxtStr,1,3)) AND ((Length(MsgTxtStr) = 3) OR (MsgTxtStr[4] <> '-')) THEN
|
||||||
|
MsgTxtStr := '^'+IntToStr(MemMsgArea.Tear_Color) + MsgTxtStr
|
||||||
|
ELSE IF (Pos('> ',Copy(MsgTxtStr,1,5)) > 0) THEN
|
||||||
|
MsgTxtStr := '^'+IntToStr(MemMsgArea.Quote_Color)+ MsgTxtStr +'^'+IntToStr(MemMsgArea.Text_Color)
|
||||||
|
ELSE IF (Pos(#254,Copy(MsgTxtStr,1,5)) > 0) THEN
|
||||||
|
MsgTxtStr := '^'+IntToStr(MemMsgArea.Tear_Color) + MsgTxtStr;
|
||||||
|
PrintACR('^1'+MsgTxtStr);
|
||||||
|
UNTIL (TempTextSize >= MHeader.TextSize) OR (Abort) OR (HangUp);
|
||||||
|
END;
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
Reading_A_Msg := FALSE;
|
||||||
|
IF (DOSANSIOn) THEN
|
||||||
|
ReDrawForANSI;
|
||||||
|
END;
|
||||||
|
Close(MsgTxtF);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (MHeader.FileAttached > 0) THEN
|
||||||
|
IF (NOT Exist(MHeader.Subject)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The attached file does not actually exist!^1');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
FileArea := -1;
|
||||||
|
FSplit(MHeader.Subject,DS,NS,ES);
|
||||||
|
WITH MemFileArea DO
|
||||||
|
BEGIN
|
||||||
|
AreaName := 'File Attach';
|
||||||
|
DLPath := DS;
|
||||||
|
ULPath := DS;
|
||||||
|
FAFlags := [FANoRatio];
|
||||||
|
END;
|
||||||
|
WITH FileInfo DO
|
||||||
|
BEGIN
|
||||||
|
FileName := Align(NS+ES);
|
||||||
|
Description := 'File Attach';
|
||||||
|
FilePoints := 0;
|
||||||
|
Downloaded := 0;
|
||||||
|
FileSize := GetFileSize(MHeader.Subject);
|
||||||
|
OwnerNum := SearchUser(StripColor(FileOwner),FALSE);
|
||||||
|
OwnerName := StripColor(FileOwner);
|
||||||
|
FileDate := MHeader.Date;
|
||||||
|
VPointer := -1;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [];
|
||||||
|
END;
|
||||||
|
TransferFlags := [IsFileAttach];
|
||||||
|
DLX(FileInfo,-1,TransferFlags);
|
||||||
|
IF (IsTransferOk IN TransferFLags) AND (NOT (IsKeyboardAbort IN TransferFlags)) THEN
|
||||||
|
SendShortMessage(MHeader.From.UserNum,Caps(ThisUser.Name)+' downloaded "^5'+StripName(MHeader.Subject)+
|
||||||
|
'^1" from ^5File Attach');
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
AllowAbort := TRUE;
|
||||||
|
TempPause := (Pause IN ThisUser.Flags);
|
||||||
|
END;
|
||||||
|
|
||||||
|
(* Done: Lee Palmer 10/23/09 *)
|
||||||
|
FUNCTION GetTagLine: Str74;
|
||||||
|
VAR
|
||||||
|
StrPointerFile: FILE OF StrPointerRec;
|
||||||
|
RGStrFile: FILE;
|
||||||
|
StrPointer: StrPointerRec;
|
||||||
|
TagLine: Str74;
|
||||||
|
TempTextSize: Word;
|
||||||
|
StrNum: Word;
|
||||||
|
FSize: LongInt;
|
||||||
|
BEGIN
|
||||||
|
TagLine := '';
|
||||||
|
IF (NOT Exist(General.lMultPath+'TAGLINE.PTR')) OR (NOT Exist(General.LMultPath+'TAGLINE.DAT')) THEN
|
||||||
|
SL1('* TAGLINE.PTR or TAGLINE.DAT file(s) do not exist!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Assign(StrPointerFile,General.LMultPath+'TAGLINE.PTR');
|
||||||
|
Reset(StrPointerFile);
|
||||||
|
FSize := FileSize(StrPointerFile);
|
||||||
|
IF (FSize < 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SL1('* TAGLINE.PTR does not contain any TagLines!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (FSize > 65535) THEN
|
||||||
|
FSize := 65535
|
||||||
|
ELSE
|
||||||
|
Dec(FSize);
|
||||||
|
Randomize;
|
||||||
|
StrNum := Random(FSize);
|
||||||
|
Seek(StrPointerFile,StrNum);
|
||||||
|
Read(StrPointerFile,StrPointer);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Assign(RGStrFile,General.LMultPath+'TAGLINE.DAT');
|
||||||
|
Reset(RGStrFile,1);
|
||||||
|
Seek(RGStrFile,(StrPointer.Pointer - 1));
|
||||||
|
TempTextSize := 0;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(RGStrFile,TagLine[0],1);
|
||||||
|
BlockRead(RGStrFile,TagLine[1],Ord(TagLine[0]));
|
||||||
|
Inc(TempTextSize,(Length(TagLine) + 1));
|
||||||
|
UNTIL (TempTextSize >= StrPointer.TextSize);
|
||||||
|
Close(RGStrFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
GetTagLine := TagLine;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,477 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Mail3;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE EditMessageText(MsgNum: Word);
|
||||||
|
PROCEDURE ForwardMessage(MsgNum: Word);
|
||||||
|
PROCEDURE MoveMsg(MsgNum: Word);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Common,
|
||||||
|
Common5,
|
||||||
|
Mail0,
|
||||||
|
Mail1,
|
||||||
|
Mail4,
|
||||||
|
MsgPack,
|
||||||
|
MiscUser,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE EditMessageText(MsgNum: Word);
|
||||||
|
VAR
|
||||||
|
TempQuoteFile: Text;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
MsgTempStr: STRING;
|
||||||
|
SaveFileAttached: Byte;
|
||||||
|
TempTextSize: Word;
|
||||||
|
FileDateTime1,
|
||||||
|
FileDateTime2: LongInt;
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Edited message #'+IntToStr(MsgNum)+' on '+MemMsgArea.Name);
|
||||||
|
Assign(TempQuoteFile,'TEMPQ'+IntToStr(ThisNode)+'.MSG');
|
||||||
|
ReWrite(TempQuoteFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Error creating TEMPQ'+IntToStr(ThisNode)+'.MSG file.');
|
||||||
|
SysOpLog('Error creating TEMPQ'+IntToStr(ThisNode)+'.MSG file.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
LoadHeader(MsgNum,MHeader);
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
||||||
|
TempTextSize := 0;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(MsgTxtF,MsgTempStr[0],1);
|
||||||
|
BlockRead(MsgTxtF,MsgTempStr[1],Ord(MsgTempStr[0]));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Error reading from '+MemMsgArea.FileName+'.DAT file.');
|
||||||
|
SysOpLog('Error reading from '+MemMsgArea.FileName+'.DAT file.');
|
||||||
|
TempTextSize := MHeader.TextSize;
|
||||||
|
END;
|
||||||
|
Inc(TempTextSize,(Length(MsgTempStr) + 1));
|
||||||
|
WriteLn(TempQuoteFile,MsgTempStr);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Error writting to TEMPQ'+IntToStr(ThisNode)+'.MSG file.');
|
||||||
|
SysOpLog('Error writting to TEMPQ'+IntToStr(ThisNode)+'.MSG file.');
|
||||||
|
TempTextSize := MHeader.TextSize;
|
||||||
|
END;
|
||||||
|
UNTIL (TempTextSize >= MHeader.TextSize);
|
||||||
|
Close(MsgTxtF);
|
||||||
|
Close(TempQuoteFile);
|
||||||
|
GetFileDateTime('TEMPQ'+IntToStr(ThisNode)+'.MSG',FileDateTime1);
|
||||||
|
SaveFileAttached := MHeader.FileAttached;
|
||||||
|
IF NOT (InputMessage((ReadMsgArea <> -1),FALSE,'',MHeader,'TEMPQ'+IntToStr(ThisNode)+'.MSG',78,500)) THEN
|
||||||
|
BEGIN
|
||||||
|
Kill('TEMPQ'+IntToStr(ThisNode)+'.MSG');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
MHeader.FileAttached := SaveFileAttached;
|
||||||
|
GetFileDateTime('TEMPQ'+IntToStr(ThisNode)+'.MSG',FileDateTime2);
|
||||||
|
IF (FileDateTime1 <> FileDateTime2) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(TempQuoteFile,'TEMPQ'+IntToStr(ThisNode)+'.MSG');
|
||||||
|
Reset(TempQuoteFile);
|
||||||
|
MHeader.TextSize := 0;
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
MHeader.Pointer := (FileSize(MsgTxtF) + 1);
|
||||||
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
||||||
|
REPEAT
|
||||||
|
ReadLn(TempQuoteFile,MsgTempStr);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Error reading from TEMPQ'+IntToStr(ThisNode)+'.MSG file.');
|
||||||
|
SysOpLog('Error reading from TEMPQ'+IntToStr(ThisNode)+'.MSG file.');
|
||||||
|
END;
|
||||||
|
Inc(MHeader.TextSize,(Length(MsgTempStr) + 1));
|
||||||
|
BlockWrite(MsgTxtF,MsgTempStr,(Length(MsgTempStr) + 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (LastError <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Error writting to '+MemMsgArea.FileName+'.DAT file.');
|
||||||
|
SysOpLog('Error writting to '+MemMsgArea.FileName+'.DAT file.');
|
||||||
|
END;
|
||||||
|
UNTIL (EOF(TempQuoteFile));
|
||||||
|
Close(MsgTxtF);
|
||||||
|
Close(TempQuoteFile);
|
||||||
|
SaveHeader(MsgNum,MHeader);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
Kill('TEMPQ'+IntToStr(ThisNode)+'.MSG');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ForwardMessage(MsgNum: Word);
|
||||||
|
VAR
|
||||||
|
MsgHdrF1: FILE OF MHeaderRec;
|
||||||
|
MsgTxtF1: FILE;
|
||||||
|
User: UserRecordType;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
MsgTempStr: STRING;
|
||||||
|
SaveReadMsgArea,
|
||||||
|
Unum: Integer;
|
||||||
|
TempTextSize: Word;
|
||||||
|
TempPtr,
|
||||||
|
TempPtr1: LongInt;
|
||||||
|
ForwardOk,
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
BEGIN
|
||||||
|
SaveReadMsgArea := ReadMsgArea;
|
||||||
|
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('^5Forward message to which user (1-'+(IntToStr(MaxUsers - 1))+')?^1');
|
||||||
|
NL;
|
||||||
|
Print('Enter User Number, Name, or Partial Search String.');
|
||||||
|
Prt(': ');
|
||||||
|
lFindUserWS(UNum);
|
||||||
|
IF (UNum < 1) THEN
|
||||||
|
PauseScr(FALSE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,UNum);
|
||||||
|
|
||||||
|
ForwardOk := TRUE;
|
||||||
|
|
||||||
|
IF (User.Name = ThisUser.Name) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You can not forward messages to yourself!^1');
|
||||||
|
ForwardOk := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (NoMail IN User.Flags) AND (NOT CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The mailbox for this user is closed!^1');
|
||||||
|
ForwardOk := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (User.Waiting >= General.MaxWaiting) AND (NOT CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The mailbox for this user is full!^1');
|
||||||
|
ForwardOk := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT ForwardOk) THEN
|
||||||
|
PauseScr(FALSE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
InitMsgArea(SaveReadMsgArea);
|
||||||
|
|
||||||
|
LoadHeader(MsgNum,MHeader);
|
||||||
|
|
||||||
|
Mheader.MTO.UserNum := UNum;
|
||||||
|
|
||||||
|
MHeader.MTO.A1S := User.Name;
|
||||||
|
|
||||||
|
MHeader.MTO.Name := User.Name;
|
||||||
|
|
||||||
|
MHeader.MTO.Real := User.RealName;
|
||||||
|
|
||||||
|
TempPtr := (MHeader.Pointer - 1);
|
||||||
|
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
|
||||||
|
MHeader.Pointer := (FileSize(MsgTxtF) + 1);
|
||||||
|
|
||||||
|
Seek(MsgTxtF,FileSize(MsgTxtF));
|
||||||
|
|
||||||
|
IF (SaveReadMsgArea <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
LoadMsgArea(-1);
|
||||||
|
|
||||||
|
Assign(MsgHdrF1,General.MsgPath+MemMsgArea.FIleName+'.HDR');
|
||||||
|
Reset(MsgHdrF1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgHdrF1);
|
||||||
|
|
||||||
|
Assign(MsgTxtF1,General.MsgPath+MemMsgArea.FIleName+'.DAT');
|
||||||
|
Reset(MsgTxtF1,1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgTxtF1,1);
|
||||||
|
|
||||||
|
TempPtr1 := (FileSize(MsgTxtF1) + 1);
|
||||||
|
|
||||||
|
Seek(MsgTxtF1,FileSize(MsgTxtF1));
|
||||||
|
END;
|
||||||
|
|
||||||
|
UNum := 0;
|
||||||
|
|
||||||
|
MsgTempStr := 'Message forwarded from '+Caps(ThisUser.Name);
|
||||||
|
Inc(UNum,(Length(MsgTempStr) + 1));
|
||||||
|
IF (SaveReadMsgArea <> -1) THEN
|
||||||
|
BlockWrite(MsgTxtF1,MsgTempStr,(Length(MsgTempStr) + 1))
|
||||||
|
ELSE
|
||||||
|
BlockWrite(MsgTxtF,MsgTempStr,(Length(MsgTempStr) + 1));
|
||||||
|
|
||||||
|
MsgTempStr := 'Message forwarded on '+DateStr+' at '+TimeStr;
|
||||||
|
Inc(UNum,(Length(MsgTempStr) + 1));
|
||||||
|
IF (SaveReadMsgArea <> -1) THEN
|
||||||
|
BlockWrite(MsgTxtF1,MsgTempStr,(Length(MsgTempStr) + 1))
|
||||||
|
ELSE
|
||||||
|
BlockWrite(MsgTxtF,MsgTempStr,(Length(MsgTempStr) + 1));
|
||||||
|
|
||||||
|
MsgTempStr := '';
|
||||||
|
Inc(UNum,(Length(MsgTempStr) + 1));
|
||||||
|
IF (SaveReadMsgArea <> -1) THEN
|
||||||
|
BlockWrite(MsgTxtF1,MsgTempStr,(Length(MsgTempStr) + 1))
|
||||||
|
ELSE
|
||||||
|
BlockWrite(MsgTxtF,MsgTempStr,(Length(MsgTempStr) + 1));
|
||||||
|
|
||||||
|
TempTextSize := 0;
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
Seek(MsgTxtF,(TempPtr + TempTextSize));
|
||||||
|
|
||||||
|
BlockRead(MsgTxtF,MsgTempStr[0],1);
|
||||||
|
|
||||||
|
BlockRead(MsgTxtF,MsgTempStr[1],Ord(MsgTempStr[0]));
|
||||||
|
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
Inc(TempTextSize,(Length(MsgTempStr) + 1));
|
||||||
|
|
||||||
|
IF (SaveReadMsgArea <> - 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgTxtF1,FileSize(MsgTxtF1));
|
||||||
|
BlockWrite(MsgTxtF1,MsgTempStr,(Length(MsgTempStr) + 1));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgTxtF,FileSize(MsgTxtF));
|
||||||
|
BlockWrite(MsgTxtF,MsgTempStr,(Length(MsgTempStr) + 1));
|
||||||
|
END;
|
||||||
|
|
||||||
|
UNTIL (TempTextSize >= MHeader.TextSize);
|
||||||
|
|
||||||
|
Close(MsgTxtF);
|
||||||
|
IF (SaveReadMsgArea <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Close(MsgTxtF1);
|
||||||
|
Close(MsgHdrF1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Inc(MHeader.TextSize,UNum);
|
||||||
|
|
||||||
|
IF (SaveReadMsgArea <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
InitMsgArea(-1);
|
||||||
|
MHeader.Pointer := TempPtr1;
|
||||||
|
END;
|
||||||
|
|
||||||
|
SaveHeader((HiMsg + 1),MHeader);
|
||||||
|
|
||||||
|
LoadURec(User,MHeader.MTO.UserNum);
|
||||||
|
Inc(User.Waiting);
|
||||||
|
SaveURec(User,MHeader.MTO.UserNum);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Print('Message forwarded to: ^5'+Caps(User.Name)+'^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
|
||||||
|
SysOpLog('Message forwarded to: ^5'+Caps(User.Name));
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
|
||||||
|
InitMsgArea(SaveReadMsgArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MoveMsg(MsgNum: Word);
|
||||||
|
VAR
|
||||||
|
MsgHdrF1: FILE OF MHeaderRec;
|
||||||
|
MsgTxtF1: FILE;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
MsgTxtStr: STRING;
|
||||||
|
InputStr: Str5;
|
||||||
|
MArea,
|
||||||
|
NumMAreas,
|
||||||
|
SaveMArea,
|
||||||
|
NewMsgArea,
|
||||||
|
SaveReadMsgArea: Integer;
|
||||||
|
TempTextSize: Word;
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
BEGIN
|
||||||
|
SaveReadMsgArea := ReadMsgArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
MArea := 1;
|
||||||
|
NumMAreas := 0;
|
||||||
|
NewMsgArea := 0;
|
||||||
|
LightBarCmd := 1;
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveMArea := MArea;
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
MessageAreaList(MArea,NumMAreas,5,FALSE);
|
||||||
|
{
|
||||||
|
%LFMove to which area? (^50^4=^5Private^4,^5'+IntToStr(LowMsgArea)+'^4-^5'+IntToStr(HighMsgArea)+'^4)
|
||||||
|
[^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
|
||||||
|
}
|
||||||
|
MsgAreaScanInput(LRGLngStr(77,TRUE),Length(IntToStr(HighMsgArea)),InputStr,'Q[]?',LowMsgArea,HighMsgArea);
|
||||||
|
IF (InputStr <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := (SaveMArea - ((PageLength - 5) * 2));
|
||||||
|
IF (MArea < 1) THEN
|
||||||
|
MArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (MArea > NumMsgAreas) THEN
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
$File_Message_Area_List_Help
|
||||||
|
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
|
||||||
|
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
|
||||||
|
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
|
||||||
|
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
|
||||||
|
^1(^3[^1)Previous page ^1(^3]^1)Next page
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(71,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) < 0) OR (StrToInt(InputStr) > HighMsgArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7The range must be from 0 to '+IntToStr(HighMsgArea)+'!^1');
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '0') THEN
|
||||||
|
NewMsgArea := -1
|
||||||
|
ELSE
|
||||||
|
NewMsgArea := CompMsgArea(StrToInt(InputStr),1);
|
||||||
|
IF (NewMsgArea = ReadMsgArea) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You can not move a message to the same area!^1');
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InitMsgArea(NewMsgArea);
|
||||||
|
IF (NOT MsgAreaAC(NewMsgArea)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have access to this message area!^1');
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (NOT AACS(MemMsgArea.PostAcs)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7You do not have posting access to this message area!^1');
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF (NOT PYNQ('Move message to '+MemMsgArea.Name+'? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InitMsgArea(SaveReadMsgArea);
|
||||||
|
LoadHeader(MsgNum,MHeader);
|
||||||
|
IF (NOT (MDeleted IN MHeader.Status)) THEN
|
||||||
|
Include(MHeader.Status,MDeleted);
|
||||||
|
SaveHeader(MsgNum,MHeader);
|
||||||
|
LoadMsgArea(NewMsgArea);
|
||||||
|
Assign(MsgHdrF1,General.MsgPath+MemMsgArea.FileName+'.HDR');
|
||||||
|
Reset(MsgHdrF1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgHdrF1);
|
||||||
|
Seek(MsgHdrF1,FileSize(MsgHdrF1));
|
||||||
|
Assign(MsgTxtF1,General.MsgPath+MemMsgArea.FileName+'.DAT');
|
||||||
|
Reset(MsgTxtF1,1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(MsgTxtF1,1);
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
||||||
|
MHeader.Pointer := (FileSize(MsgTxtF1) + 1);
|
||||||
|
Seek(MsgTxtF1,FileSize(MsgTxtF1));
|
||||||
|
IF (MDeleted IN MHeader.Status) THEN
|
||||||
|
Exclude(MHeader.Status,MDeleted);
|
||||||
|
Write(MsgHdrF1,MHeader);
|
||||||
|
Close(MsgHdrF1);
|
||||||
|
TempTextSize := 0;
|
||||||
|
REPEAT
|
||||||
|
BlockRead(MsgTxtF,MsgTxtStr[0],1);
|
||||||
|
BlockRead(MsgTxtF,MsgTxtStr[1],Ord(MsgTxtStr[0]));
|
||||||
|
LastError := IOResult;
|
||||||
|
Inc(TempTextSize,(Length(MsgTxtStr) + 1));
|
||||||
|
BlockWrite(MsgTxtF1,MsgTxtStr,(Length(MsgTxtStr) + 1));
|
||||||
|
LastError := IOResult;
|
||||||
|
UNTIL (TempTextSize >= MHeader.TextSize);
|
||||||
|
Close(MsgTxtF1);
|
||||||
|
Close(MsgTxtF);
|
||||||
|
NL;
|
||||||
|
Print('The message was moved successfully.');
|
||||||
|
InputStr := 'Q';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
ReadMsgArea := SaveReadMsgArea;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr = 'Q') OR (HangUp);
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
InitMsgArea(SaveReadMsgArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,485 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Mail4;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE MessageAreaList(VAR MArea,NumMAreas: Integer; AdjPageLen: Byte; ShowScan: Boolean);
|
||||||
|
PROCEDURE MessageAreaChange(VAR Done: Boolean; CONST MenuOption: Str50);
|
||||||
|
PROCEDURE ToggleMsgAreaScanFlags;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Common5,
|
||||||
|
Mail0;
|
||||||
|
|
||||||
|
PROCEDURE MessageAreaList(VAR MArea,NumMAreas: Integer; AdjPageLen: Byte; ShowScan: Boolean);
|
||||||
|
VAR
|
||||||
|
ScanChar: Str1;
|
||||||
|
TempStr: AStr;
|
||||||
|
NumOnline,
|
||||||
|
NumDone: Byte;
|
||||||
|
SaveMsgArea: Integer;
|
||||||
|
BEGIN
|
||||||
|
SaveMsgArea := MsgArea;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
NumOnline := 0;
|
||||||
|
TempStr := '';
|
||||||
|
|
||||||
|
FillChar(LightBarArray,SizeOf(LightBarArray),0);
|
||||||
|
LightBarCounter := 0;
|
||||||
|
|
||||||
|
{
|
||||||
|
$New_Scan_Char_Message
|
||||||
|
ţ
|
||||||
|
$
|
||||||
|
}
|
||||||
|
IF (ShowScan) THEN
|
||||||
|
ScanChar := lRGLngStr(66,TRUE);
|
||||||
|
{
|
||||||
|
$Message_Area_Select_Header
|
||||||
|
%CL7ÚÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄż
|
||||||
|
7ł8 Num 7ł9 Name 7ł8 Num 7ł9 Name 7ł
|
||||||
|
7ŔÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŮ
|
||||||
|
$
|
||||||
|
}
|
||||||
|
lRGLngStr(58,FALSE);
|
||||||
|
Reset(MsgAreaFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - AdjPageLen)) AND (MArea >= 1) AND (MArea <= NumMsgAreas) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
LoadMsgArea(MArea);
|
||||||
|
IF (ShowScan) THEN
|
||||||
|
LoadLastReadRecord(LastReadRecord);
|
||||||
|
IF (AACS(MemMsgArea.ACS)) OR (MAUnHidden IN MemMsgArea.MAFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (General.UseMsgAreaLightBar) AND (MsgAreaLightBar IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(LightBarCounter);
|
||||||
|
LightBarArray[LightBarCounter].CmdToExec := CompMsgArea(MArea,0);
|
||||||
|
LightBarArray[LightBarCounter].CmdToShow := MemMsgArea.Name;
|
||||||
|
IF (NumOnline = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
LightBarArray[LightBarCounter].Xpos := 8;
|
||||||
|
LightBarArray[LightBarCounter].YPos := WhereY;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LightBarArray[LightBarCounter].Xpos := 47;
|
||||||
|
LightBarArray[LightBarCounter].YPos := WhereY;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
TempStr := TempStr + AOnOff(ShowScan AND LastReadRecord.NewScan,':'+ScanChar[1],' ')+
|
||||||
|
PadLeftStr(PadRightStr(';'+IntToStr(CompMsgArea(MArea,0)),5)+
|
||||||
|
+'< '+MemMsgArea.Name,37)+' ';
|
||||||
|
Inc(NumOnline);
|
||||||
|
IF (NumOnline = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintaCR(TempStr);
|
||||||
|
NumOnline := 0;
|
||||||
|
Inc(NumDone);
|
||||||
|
TempStr := '';
|
||||||
|
END;
|
||||||
|
Inc(NumMAreas);
|
||||||
|
END;
|
||||||
|
WKey;
|
||||||
|
Inc(MArea);
|
||||||
|
END;
|
||||||
|
Close(MsgAreaFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumOnline = 1) AND (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
PrintACR(TempStr)
|
||||||
|
ELSE IF (NumMAreas = 0) AND (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
LRGLngStr(68,FALSE);
|
||||||
|
{
|
||||||
|
%LF^7No message areas!^1'
|
||||||
|
}
|
||||||
|
MsgArea := SaveMsgArea;
|
||||||
|
LoadMsgArea(MsgArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MessageAreaChange(VAR Done: Boolean; CONST MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
InputStr: Str5;
|
||||||
|
Cmd: Char;
|
||||||
|
MArea,
|
||||||
|
NumMAreas,
|
||||||
|
SaveMArea: Integer;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (MenuOption <> '') THEN
|
||||||
|
CASE UpCase(MenuOption[1]) OF
|
||||||
|
'+' : BEGIN
|
||||||
|
MArea := MsgArea;
|
||||||
|
IF (MsgArea >= NumMsgAreas) THEN
|
||||||
|
MArea := 0
|
||||||
|
ELSE
|
||||||
|
REPEAT
|
||||||
|
Inc(MArea);
|
||||||
|
ChangeMsgArea(MArea);
|
||||||
|
UNTIL (MsgArea = MArea) OR (MArea >= NumMsgAreas);
|
||||||
|
IF (MsgArea <> MArea) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LFHighest accessible message area.
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(85,FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
'-' : BEGIN
|
||||||
|
MArea := MsgArea;
|
||||||
|
IF (MsgArea <= 0) THEN
|
||||||
|
MArea := 0
|
||||||
|
ELSE
|
||||||
|
REPEAT
|
||||||
|
Dec(MArea);
|
||||||
|
ChangeMsgArea(MArea);
|
||||||
|
UNTIL (MsgArea = MArea) OR (MArea <= 0);
|
||||||
|
IF (MsgArea <> MArea) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LFLowest accessible message area.
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(84,FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
'L' : BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
MArea := 1;
|
||||||
|
NumMAreas := 0;
|
||||||
|
Cmd := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveMArea := MArea;
|
||||||
|
IF (Cmd = '?') THEN
|
||||||
|
MessageAreaList(MArea,NumMAreas,5,FALSE);
|
||||||
|
{
|
||||||
|
%LFMessage area list? [^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
|
||||||
|
}
|
||||||
|
LOneK(LRGLngStr(69,TRUE),Cmd,'Q?[]',TRUE,TRUE);
|
||||||
|
TempPause := FALSE;
|
||||||
|
IF (Cmd <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Cmd = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := (SaveMArea - ((PageLength - 5) * 2));
|
||||||
|
IF (MArea < 1) THEN
|
||||||
|
MArea := 1;
|
||||||
|
Cmd := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (Cmd = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (MArea > NumMsgAreas) THEN
|
||||||
|
MArea := SaveMArea;
|
||||||
|
Cmd := '?';
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE IF (Cmd = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
$File_Message_Area_List_Help
|
||||||
|
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
|
||||||
|
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
|
||||||
|
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
|
||||||
|
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
|
||||||
|
^1(^3[^1)Previous page ^1(^3]^1)Next page
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(71,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
END
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (StrToInt(MenuOption) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := StrToInt(MenuOption);
|
||||||
|
IF (MArea <> MsgArea) THEN
|
||||||
|
ChangeMsgArea(MArea);
|
||||||
|
IF (Pos(';',MenuOption) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := StrToInt(Copy(MenuOption,(Pos(';',MenuOption) + 1),Length(MenuOption)));
|
||||||
|
NewMenuToLoad := TRUE;
|
||||||
|
Done := TRUE;
|
||||||
|
END;
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
MArea := 1;
|
||||||
|
NumMAreas := 0;
|
||||||
|
LightBarCmd := 1;
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveMArea := MArea;
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
MessageAreaList(MArea,NumMAreas,5,FALSE);
|
||||||
|
{
|
||||||
|
%LFChange message area? [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
|
||||||
|
}
|
||||||
|
MsgAreaScanInput(LRGLngStr(73,TRUE),Length(IntToStr(HighMsgArea)),InputStr,'Q[]?',LowMsgarea,HighMsgArea);
|
||||||
|
IF (InputStr <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := (SaveMArea - ((PageLength - 5) * 2));
|
||||||
|
IF (MArea < 1) THEN
|
||||||
|
MArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (MArea > NumMsgAreas) THEN
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
$File_Message_Area_List_Help
|
||||||
|
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
|
||||||
|
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
|
||||||
|
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
|
||||||
|
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
|
||||||
|
^1(^3[^1)Previous page ^1(^3]^1)Next page
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(71,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) < LowMsgArea) OR (StrToInt(InputStr) > HighMsgArea) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^7The range must be from %A3 to %A4!^1
|
||||||
|
}
|
||||||
|
LRGLngStr(79,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MArea := CompMsgArea(StrToInt(InputStr),1);
|
||||||
|
IF (MArea <> MsgArea) THEN
|
||||||
|
ChangeMsgArea(MArea);
|
||||||
|
IF (MArea = MsgArea) THEN
|
||||||
|
InputStr := 'Q'
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^7You do not have access to this message area!^1
|
||||||
|
}
|
||||||
|
LRGLngStr(81,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleMsgAreaScanFlags;
|
||||||
|
VAR
|
||||||
|
InputStr: Str11;
|
||||||
|
FirstMArea,
|
||||||
|
LastMArea,
|
||||||
|
MArea,
|
||||||
|
NumMAreas,
|
||||||
|
SaveMArea,
|
||||||
|
SaveMsgArea: Integer;
|
||||||
|
SaveConfSystem,
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ToggleScanFlags(MArea1: Integer; ScanType: Byte);
|
||||||
|
BEGIN
|
||||||
|
IF (MsgArea <> MArea1) THEN
|
||||||
|
ChangeMsgArea(MArea1);
|
||||||
|
IF (MsgArea = MArea1) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadLastReadRecord(LastReadRecord);
|
||||||
|
IF (ScanType = 1) THEN
|
||||||
|
LastReadRecord.NewScan := TRUE
|
||||||
|
ELSE IF (ScanType = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (MAForceRead IN MemMsgArea.MAFlags)) THEN
|
||||||
|
LastReadRecord.NewScan := FALSE
|
||||||
|
ELSE
|
||||||
|
LastReadRecord.NewScan := TRUE;
|
||||||
|
END
|
||||||
|
ELSE IF (ScanType = 3) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (MAForceRead IN MemMsgArea.MAFlags)) THEN
|
||||||
|
LastReadRecord.NewScan := (NOT LastReadRecord.NewScan)
|
||||||
|
ELSE
|
||||||
|
LastReadRecord.NewScan := TRUE;
|
||||||
|
END;
|
||||||
|
SaveLastReadRecord(LastReadRecord);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveMsgArea := MsgArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
MArea := 1;
|
||||||
|
NumMAreas := 0;
|
||||||
|
LightBarCmd := 1;
|
||||||
|
LightBarFirstCmd := TRUE;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
SaveMArea := MArea;
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
MessageAreaList(MArea,NumMAreas,5,TRUE);
|
||||||
|
{
|
||||||
|
%LFToggle new scan? [^5#^4,^5#^4-^5#^4,^5F^4=^5Flag ^4or ^5U^4=^5Unflag All^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
|
||||||
|
}
|
||||||
|
MsgAreaScanInput(LRGLngStr(75,TRUE),((Length(IntToStr(HighMsgArea)) * 2) + 1),InputStr,'QFU[]?',LowMsgArea,HighMsgArea);
|
||||||
|
IF (InputStr <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = '[') THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := (SaveMArea - ((PageLength - 5) * 2));
|
||||||
|
IF (MArea < 1) THEN
|
||||||
|
MArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = ']') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (MArea > NumMsgAreas) THEN
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
$File_Message_Area_List_Help
|
||||||
|
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
|
||||||
|
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
|
||||||
|
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
|
||||||
|
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
|
||||||
|
^1(^3[^1)Previous page ^1(^3]^1)Next page
|
||||||
|
%PA
|
||||||
|
}
|
||||||
|
LRGLngStr(71,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MsgArea := 0;
|
||||||
|
IF (InputStr = 'F') THEN
|
||||||
|
BEGIN
|
||||||
|
FOR MArea := 1 TO NumMsgAreas DO
|
||||||
|
ToggleScanFlags(MArea,1);
|
||||||
|
{
|
||||||
|
%LFYou are now reading all message areas.
|
||||||
|
}
|
||||||
|
LRGLngStr(87,FALSE);
|
||||||
|
MArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = 'U') THEN
|
||||||
|
BEGIN
|
||||||
|
FOR MArea := 1 TO NumMsgAreas DO
|
||||||
|
ToggleScanFlags(MArea,2);
|
||||||
|
{
|
||||||
|
%LFYou are now not reading any message areas.
|
||||||
|
}
|
||||||
|
LRGLngStr(89,FALSE);
|
||||||
|
MArea := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE IF (StrToInt(InputStr) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FirstMArea := StrToInt(InputStr);
|
||||||
|
IF (Pos('-',InputStr) = 0) THEN
|
||||||
|
LastMArea := FirstMArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LastMArea := StrToInt(Copy(InputStr,(Pos('-',InputStr) + 1),(Length(InputStr) - Pos('-',InputStr))));
|
||||||
|
IF (FirstMArea > LastMArea) THEN
|
||||||
|
BEGIN
|
||||||
|
MArea := FirstMArea;
|
||||||
|
FirstMArea := LastMArea;
|
||||||
|
LastMArea := MArea;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (FirstMArea < LowMsgArea) OR (LastMArea > HighMsgArea) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^7The range must be from %A3 to %A4!^1
|
||||||
|
}
|
||||||
|
LRGLngStr(91,FALSE);
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FirstMArea := CompMsgArea(FirstMArea,1);
|
||||||
|
LastMArea := CompMsgArea(LastMArea,1);
|
||||||
|
FOR MArea := FirstMArea TO LastMArea DO
|
||||||
|
ToggleScanFlags(MArea,3);
|
||||||
|
IF (FirstMArea = LastMArea) THEN
|
||||||
|
IF (NOT (MAForceRead IN MemMsgArea.MAFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^5%MB^3 will %MSbe scanned.
|
||||||
|
}
|
||||||
|
LRGLngStr(93,FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
{
|
||||||
|
%LF^5%MB^3 cannot be removed from your newscan.
|
||||||
|
}
|
||||||
|
LRGLngStr(94,FALSE);
|
||||||
|
END;
|
||||||
|
MArea := SaveMArea;
|
||||||
|
InputStr := '?';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
MsgArea := SaveMsgArea;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr = 'Q') OR (HangUp);
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
MsgArea := SaveMsgArea;
|
||||||
|
LoadMsgArea(MsgArea);
|
||||||
|
LastCommandOvr := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,973 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Maint;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE LogonMaint;
|
||||||
|
PROCEDURE LogoffMaint;
|
||||||
|
PROCEDURE DailyMaint;
|
||||||
|
PROCEDURE UpdateGeneral;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Automsg,
|
||||||
|
Bulletin,
|
||||||
|
Common,
|
||||||
|
CUser,
|
||||||
|
Email,
|
||||||
|
Events,
|
||||||
|
File6,
|
||||||
|
File12,
|
||||||
|
Mail1,
|
||||||
|
Mail4,
|
||||||
|
ShortMsg,
|
||||||
|
TimeFunc,
|
||||||
|
Vote;
|
||||||
|
|
||||||
|
PROCEDURE LogonMaint;
|
||||||
|
VAR
|
||||||
|
LastCallerFile: FILE OF LastCallerRec;
|
||||||
|
LastCaller: LastCallerRec;
|
||||||
|
TempStr,
|
||||||
|
TempStr1: AStr;
|
||||||
|
Cmd: Char;
|
||||||
|
Counter,
|
||||||
|
Counter1: Integer;
|
||||||
|
RecNum: LongInt;
|
||||||
|
BSince: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE UpdateUserInformation;
|
||||||
|
VAR
|
||||||
|
UpdateArray: ARRAY [0..10] OF Integer;
|
||||||
|
Counter,
|
||||||
|
Counter1: Integer;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 0 TO 10 DO
|
||||||
|
UpdateArray[Counter] := 0;
|
||||||
|
Counter := 0;
|
||||||
|
IF (ThisUser.RealName = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[1] := 10;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.Street = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[2] := 1;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.CityState = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[0] := 23;
|
||||||
|
UpdateArray[3] := 4;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.ZipCode = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[0] := 23;
|
||||||
|
UpdateArray[4] := 14;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.BirthDate = User_Date_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[5] := 2;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.Ph = User_Phone_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[6] := 8;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.UsrDefStr[1] = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[7] := 5;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.UsrDefStr[2] = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[8] := 6;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.UsrDefStr[3] = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[9] := 13;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (ThisUser.ForgotPWAnswer = User_String_Ask) THEN
|
||||||
|
BEGIN
|
||||||
|
UpdateArray[10] := 30;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
IF (Counter <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CLS;
|
||||||
|
NL;
|
||||||
|
Print('Please update the following information:');
|
||||||
|
Counter := 0;
|
||||||
|
WHILE (Counter <= 10) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (UpDateArray[Counter] <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Update_Screen;
|
||||||
|
CStuff(UpdateArray[Counter],1,ThisUser);
|
||||||
|
END;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Thank you!');
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION CheckBirthday: Boolean;
|
||||||
|
VAR
|
||||||
|
BDate: LongInt;
|
||||||
|
BEGIN
|
||||||
|
BSince := FALSE;
|
||||||
|
BDate := Date2PD(Copy(PD2Date(ThisUser.BirthDate),1,6) + Copy(DateStr,7,4));
|
||||||
|
IF (BDate > ThisUser.LastOn) AND (BDate <= Date2PD(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
CheckBirthday := TRUE;
|
||||||
|
BSince := (BDate < Date2PD(DateStr));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
CheckBirthday := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ShowBDay(CONST UserNumber: AStr);
|
||||||
|
BEGIN
|
||||||
|
IF (BSince) THEN
|
||||||
|
PrintF('BDYS'+UserNumber);
|
||||||
|
IF (NoFile) THEN
|
||||||
|
PrintF('BDAY'+UserNumber);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FindChopTime;
|
||||||
|
VAR
|
||||||
|
LNG,
|
||||||
|
LNG2,
|
||||||
|
LNG3: LongInt;
|
||||||
|
EventNum: Byte;
|
||||||
|
|
||||||
|
PROCEDURE OnlineTime;
|
||||||
|
BEGIN
|
||||||
|
PrintF('REVENT'+IntToStr(EventNum));
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
Print(^G);
|
||||||
|
NL;
|
||||||
|
Print('^8Note: ^5System event approaching.');
|
||||||
|
Print('System will be shut down in '+FormattedTime(NSL));
|
||||||
|
NL;
|
||||||
|
Print(^G);
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
IF (ExtEventTime <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
LNG := ExtEventTime;
|
||||||
|
IF (LNG < (NSL DIV 60)) THEN
|
||||||
|
BEGIN
|
||||||
|
ChopTime := (NSL - (LNG * 60)) + 120;
|
||||||
|
OnlineTime;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LNG := 1;
|
||||||
|
LNG2 := (NSL DIV 60);
|
||||||
|
IF (LNG2 > 180) THEN
|
||||||
|
LNG2 := 180;
|
||||||
|
WHILE (LNG <= LNG2) DO
|
||||||
|
BEGIN
|
||||||
|
LNG3 := (LNG * 60);
|
||||||
|
EventNum := CheckEvents(LNG3);
|
||||||
|
IF (EventNum <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
ChopTime := (NSL - (LNG * 60)) + 60;
|
||||||
|
OnlineTime;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Inc(LNG,2);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
IF AACS(General.Invisible) AND PYNQ(lRGLngStr(45,TRUE){FString.AskInvisibleLoginStr},0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
IsInvisible := TRUE;
|
||||||
|
Include(NodeR.Status,NInvisible);
|
||||||
|
SysOpLog('Selected invisible mode.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
IsInvisible := FALSE;
|
||||||
|
FillChar(NodeR.Invited,SizeOf(NodeR.Invited),0);
|
||||||
|
FillChar(NodeR.Booted,SizeOf(NodeR.Booted),0);
|
||||||
|
FillChar(NodeR.Forget,SizeOf(NodeR.Forget),0);
|
||||||
|
Include(NodeR.Status,NAvail);
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
Update_Node(RGNoteStr(37,TRUE),TRUE);
|
||||||
|
FOR Counter := 1 TO MaxNodes DO
|
||||||
|
BEGIN
|
||||||
|
LoadNode(Counter);
|
||||||
|
NodeR.Forget[ThisNode DIV 8] := NodeR.Forget[ThisNode DIV 8] - [ThisNode MOD 8];
|
||||||
|
SaveNode(Counter);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
ConfSystem := TRUE;
|
||||||
|
|
||||||
|
IF (ThisUser.LastConf IN ConfKeys) THEN
|
||||||
|
CurrentConf := ThisUser.LastConf
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CurrentConf := '@';
|
||||||
|
ThisUser.LastConf := CurrentConf;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PublicReadThisCall := 0;
|
||||||
|
ExtraTime := 0;
|
||||||
|
FreeTime := 0;
|
||||||
|
CreditTime := 0;
|
||||||
|
TimeOn := GetPackDateTime;
|
||||||
|
UserOn := TRUE;
|
||||||
|
|
||||||
|
Com_Flush_Recv;
|
||||||
|
|
||||||
|
lStatus_Screen(100,'Cleaning up work areas...',FALSE,TempStr);
|
||||||
|
PurgeDir(TempDir+'ARC\',FALSE);
|
||||||
|
PurgeDir(TempDir+'QWK\',FALSE);
|
||||||
|
PurgeDir(TempDir+'UP\',FALSE);
|
||||||
|
PurgeDir(TempDir+'CD\',FALSE);
|
||||||
|
|
||||||
|
DailyMaint;
|
||||||
|
|
||||||
|
IF (ComPortSpeed > 0) AND (NOT LocalIOOnly) THEN
|
||||||
|
Inc(TodayCallers);
|
||||||
|
|
||||||
|
IF (SLogSeparate IN ThisUser.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(SysOpLogFile1,General.LogsPath+'SLOG'+IntToStr(UserNum)+'.LOG');
|
||||||
|
Append(SysOpLogFile1);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(SysOpLogFile1);
|
||||||
|
Append(SysOpLogFile1);
|
||||||
|
TempStr := '';
|
||||||
|
TempStr1 := '';
|
||||||
|
FOR Counter := 1 TO (26 + Length(ThisUser.Name)) DO
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr + '_';
|
||||||
|
TempStr1 := TempStr1 + ' ';
|
||||||
|
END;
|
||||||
|
WriteLn(SysOpLogFile1,'');
|
||||||
|
WriteLn(SysOpLogFile1,' '+TempStr);
|
||||||
|
WriteLn(SysOpLogFile1,'>>'+TempStr1+'<<');
|
||||||
|
WriteLn(SysOpLogFile1,'>> Renegade SysOp Log for '+Caps(ThisUser.Name)+': <<');
|
||||||
|
WriteLn(SysOpLogFile1,'>>'+TempStr+'<<');
|
||||||
|
WriteLn(SysOpLogFile1,'');
|
||||||
|
END;
|
||||||
|
WriteLn(SysOpLogFile1);
|
||||||
|
|
||||||
|
TempStr := '^3Logon ^5['+Dat+']^4 (';
|
||||||
|
|
||||||
|
IF (ComPortSpeed > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr + IntToStr(ActualSpeed)+' baud';
|
||||||
|
|
||||||
|
IF (Reliable) THEN
|
||||||
|
TempStr := TempStr + '/Reliable)'
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + ')';
|
||||||
|
|
||||||
|
IF (CallerIDNumber > '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Telnet) THEN
|
||||||
|
TempStr := TempStr + ' Number: '+CallerIDNumber
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + ' IP Number: '+CallerIDNumber;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + 'Keyboard)';
|
||||||
|
|
||||||
|
IF (General.StripCLog) THEN
|
||||||
|
TempStr := StripColor(TempStr);
|
||||||
|
|
||||||
|
WriteLn(SysOpLogFile1,TempStr);
|
||||||
|
|
||||||
|
Close(SysOpLogFile1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
TempStr := '^3'+IntToStr(General.CallerNum)+'^4 -- ^0'+Caps(ThisUser.Name)+'^4 -- ^3'+'Today '+IntToStr(ThisUser.OnToday);
|
||||||
|
IF (Trapping) THEN
|
||||||
|
TempStr := TempStr + '^0*';
|
||||||
|
SL1(TempStr);
|
||||||
|
SaveGeneral(FALSE);
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
IF ((CoSysOp) AND (NOT FastLogon) AND (ComPortSpeed > 0)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF PYNQ(lRGLngStr(57,TRUE){FString.QuickLogon},0,FALSE) THEN
|
||||||
|
FastLogon := TRUE;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Assign(LastCallerFile,General.DataPath+'LASTON.DAT');
|
||||||
|
IF Exist(General.DataPath+'LASTON.DAT') THEN
|
||||||
|
Reset(LastCallerFile)
|
||||||
|
ELSE
|
||||||
|
ReWrite(LastCallerFile);
|
||||||
|
FillChar(LastCaller,SizeOf(LastCaller),#0);
|
||||||
|
WITH LastCaller DO
|
||||||
|
BEGIN
|
||||||
|
Node := ThisNode;
|
||||||
|
Caller := General.CallerNum;
|
||||||
|
UserName := Caps(ThisUser.Name);
|
||||||
|
UserID := UserNum;
|
||||||
|
Location := ThisUser.CityState;
|
||||||
|
IF (ComPortSpeed <> 0) THEN
|
||||||
|
Speed := ActualSpeed
|
||||||
|
ELSE
|
||||||
|
Speed := 0;
|
||||||
|
LogonTime := TimeOn;
|
||||||
|
LogoffTime := 0;
|
||||||
|
NewUser := WasNewUser;
|
||||||
|
Invisible := IsInvisible;
|
||||||
|
END;
|
||||||
|
IF AACS(General.LastOnDatACS) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(LastCallerFile,FileSize(LastCallerFile));
|
||||||
|
Write(LastCallerFile,LastCaller);
|
||||||
|
END;
|
||||||
|
Close(LastCallerFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
SaveGeneral(TRUE);
|
||||||
|
|
||||||
|
IF (NOT FastLogon) AND (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
PrintF('LOGON');
|
||||||
|
Counter := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Counter);
|
||||||
|
PrintF('LOGON'+IntToStr(Counter));
|
||||||
|
UNTIL (Counter = 9) OR (NoFile) OR (HangUp);
|
||||||
|
|
||||||
|
PrintF('SL'+IntToStr(ThisUser.SL));
|
||||||
|
|
||||||
|
PrintF('DSL'+IntToStr(ThisUser.DSL));
|
||||||
|
|
||||||
|
FOR Cmd := 'A' TO 'Z' DO
|
||||||
|
IF (Cmd IN ThisUser.AR) THEN
|
||||||
|
PrintF('ARLEVEL'+Cmd);
|
||||||
|
|
||||||
|
PrintF('USER'+IntToStr(UserNum));
|
||||||
|
|
||||||
|
IF (FindOnlyOnce) THEN
|
||||||
|
PrintF('ONCEONLY');
|
||||||
|
|
||||||
|
UpdateUserInformation;
|
||||||
|
|
||||||
|
IF (General.LogonQuote) THEN
|
||||||
|
RGQuote('LGNQUOTE');
|
||||||
|
|
||||||
|
IF (CheckBirthday) THEN
|
||||||
|
BEGIN
|
||||||
|
ShowBDay(IntToStr(UserNum));
|
||||||
|
IF (NoFile) THEN
|
||||||
|
ShowBDay('');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
IF (BSince) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^3Happy Birthday, '+Caps(ThisUser.Name)+' !!!');
|
||||||
|
Print('^3(a little late, but it''s the thought that counts!)');
|
||||||
|
NL;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^3Happy Birthday, '+Caps(ThisUser.Name)+' !!!');
|
||||||
|
Print('^3You turned '+IntToStr(AgeUser(ThisUser.BirthDate))+' today!!');
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
CLS;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NL;
|
||||||
|
IF (General.AutoMInLogon) THEN
|
||||||
|
ReadAutoMsg;
|
||||||
|
NL;
|
||||||
|
|
||||||
|
IF (General.YourInfoInLogon) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('YOURINFO');
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LIL := 0;
|
||||||
|
|
||||||
|
IF (General.BullInLogon) AND (NewBulletins) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ(lRGLngStr(56,TRUE){FString.ShowBulletins},0,FALSE) THEN
|
||||||
|
Bulletins('')
|
||||||
|
ELSE
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT (RVoting IN ThisUser.Flags)) THEN
|
||||||
|
BEGIN
|
||||||
|
Counter := UnVotedTopics;
|
||||||
|
IF (Counter > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Prompt('^5You have not voted on ^9'+IntToStr(Counter)+'^5 voting '+Plural('question',Counter));
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF Exist(General.DataPath+'BATCHDL.DAT') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BatchDLFile,General.DataPath+'BATCHDL.DAT');
|
||||||
|
Reset(BatchDLFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchDLFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchDLFile,(RecNum - 1));
|
||||||
|
Read(BatchDLFile,BatchDL);
|
||||||
|
IF (BatchDL.BDLUserNum = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(NumBatchDLFiles);
|
||||||
|
Inc(BatchDLTime,BatchDL.BDLTime);
|
||||||
|
Inc(BatchDLSize,BatchDL.BDLFSize);
|
||||||
|
Inc(BatchDLPoints,BatchDL.BDLPoints);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchDLFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF Exist(General.DataPath+'BATCHUL.DAT') THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
|
||||||
|
Reset(BatchULFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(BatchULFile)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(BatchULFile,(RecNum - 1));
|
||||||
|
Read(BatchULFile,BatchUL);
|
||||||
|
IF (BatchUL.BULUserNum = UserNum) THEN
|
||||||
|
Inc(NumBatchULFiles);
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(BatchULFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NumBatchDLFiles > 0) AND (General.ForceBatchDL) THEN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Print('^4You must (^5D^4)ownload, (^5R^4)emove or (^5C^4)lear your batch queued files.');
|
||||||
|
NL;
|
||||||
|
Prt('Select option: ');
|
||||||
|
OneK(Cmd,'DRC',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'D' : BatchDownload;
|
||||||
|
'R' : RemoveBatchDLFiles;
|
||||||
|
'C' : ClearBatchDLQueue;
|
||||||
|
END;
|
||||||
|
UNTIL (NumBatchDLFiles = 0) OR (FileSysOp) OR (HangUp);
|
||||||
|
|
||||||
|
IF (NumBatchULFiles > 0) AND (General.ForceBatchUL) THEN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Print('^4You must (^5U^4)pload, (^5R^4)emove or (^5C^4)lear your batch queued files.');
|
||||||
|
NL;
|
||||||
|
Prt('Select option: ');
|
||||||
|
OneK(Cmd,'URC',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'U' : BatchUpload(FALSE,0);
|
||||||
|
'R' : RemoveBatchULFiles;
|
||||||
|
'C' : ClearBatchULQueue;
|
||||||
|
END;
|
||||||
|
UNTIL (NumBatchULFiles = 0) OR (FileSysOp) OR (HangUp);
|
||||||
|
|
||||||
|
BatchDLULInfo;
|
||||||
|
|
||||||
|
IF (LIL <> 0) THEN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
|
||||||
|
NL;
|
||||||
|
Update_Screen;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FindChopTime;
|
||||||
|
|
||||||
|
|
||||||
|
IF (SMW IN ThisUser.Flags) THEN
|
||||||
|
BEGIN
|
||||||
|
ReadShortMessage;
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF ((Alert IN ThisUser.Flags) AND (SysOpAvailable)) THEN
|
||||||
|
ChatCall := TRUE;
|
||||||
|
|
||||||
|
IF (ThisUser.Waiting > 0) THEN
|
||||||
|
IF (RMsg IN ThisUser.Flags) THEN
|
||||||
|
ReadMail
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF PYNQ('Read your private messages? ',0,TRUE) THEN
|
||||||
|
ReadMail;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (General.PasswordChange > 0) THEN
|
||||||
|
IF ((DayNum(DateStr) - ThisUser.PasswordChanged) >= General.PasswordChange) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('PWCHANGE');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('You must select a new password every '+IntToStr(General.PasswordChange)+' days.');
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
CStuff(9,3,ThisUser);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FastLogon := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LogoffMaint;
|
||||||
|
VAR
|
||||||
|
HistoryFile: FILE OF HistoryRecordType;
|
||||||
|
LastCallerFile: FILE OF LastCallerRec;
|
||||||
|
History: HistoryRecordType;
|
||||||
|
LastCaller: LastCallerRec;
|
||||||
|
Counter: Integer;
|
||||||
|
TotTimeOn: LongInt;
|
||||||
|
BEGIN
|
||||||
|
Com_Flush_Send;
|
||||||
|
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
WITH NodeR DO
|
||||||
|
BEGIN
|
||||||
|
User := 0;
|
||||||
|
UserName := '';
|
||||||
|
CityState := '';
|
||||||
|
Sex := 'M';
|
||||||
|
Age := 0;
|
||||||
|
LogonTime := 0;
|
||||||
|
GroupChat := FALSE;
|
||||||
|
ActivityDesc := '';
|
||||||
|
Status := [NActive];
|
||||||
|
Room := 0;
|
||||||
|
Channel := 0;
|
||||||
|
FillChar(Invited,SizeOf(Invited),0);
|
||||||
|
FillChar(Booted,SizeOf(Booted),0);
|
||||||
|
FillChar(Forget,SizeOf(Forget),0);
|
||||||
|
END;
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
|
||||||
|
IF (UserNum > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
PurgeDir(TempDir+'ARC\',FALSE);
|
||||||
|
PurgeDir(TempDir+'QWK\',FALSE);
|
||||||
|
PurgeDir(TempDir+'UP\',FALSE);
|
||||||
|
PurgeDir(TempDir+'CD\',FALSE);
|
||||||
|
|
||||||
|
SLogging := TRUE;
|
||||||
|
|
||||||
|
IF (Trapping) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (HungUp) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn(TrapFile);
|
||||||
|
WriteLn(TrapFile,'NO CARRIER');
|
||||||
|
END;
|
||||||
|
Close(TrapFile);
|
||||||
|
Trapping := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
TotTimeOn := ((GetPackDateTime - TimeOn) DIV 60);
|
||||||
|
|
||||||
|
ThisUser.LastOn := GetPackDateTime;
|
||||||
|
Inc(ThisUser.LoggedOn);
|
||||||
|
|
||||||
|
ThisUser.Illegal := 0;
|
||||||
|
ThisUser.TTimeOn := (ThisUser.TTimeOn + TotTimeOn);
|
||||||
|
ThisUser.TLToday := (NSL DIV 60);
|
||||||
|
|
||||||
|
IF (ChopTime <> 0) THEN
|
||||||
|
Inc(ThisUser.TLToday,(ChopTime DIV 60));
|
||||||
|
|
||||||
|
ThisUser.LastMsgArea := MsgArea;
|
||||||
|
ThisUser.LastFileArea := FileArea;
|
||||||
|
|
||||||
|
IF ((UserNum >= 1) AND (UserNum <= (MaxUsers - 1))) THEN
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
|
||||||
|
IF (HungUp) THEN
|
||||||
|
SL1('^7-= Hung Up =-');
|
||||||
|
|
||||||
|
SL1('^4Read: ^3'+IntToStr(PublicReadThisCall)+'^4 / Time on: ^3'+IntToStr(TotTimeOn));
|
||||||
|
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
SL1('^3Logoff node '+IntToStr(ThisNode)+' ^5'+'['+Dat+']');
|
||||||
|
|
||||||
|
Assign(HistoryFile,General.DataPath+'HISTORY.DAT');
|
||||||
|
Reset(HistoryFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(HistoryFile);
|
||||||
|
FillChar(History,SizeOf(History),0);
|
||||||
|
History.Date := Date2PD(DateStr);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,(FileSize(HistoryFile) - 1));
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
END;
|
||||||
|
Inc(History.Active,(GetPackDateTime - TimeOn) DIV 60);
|
||||||
|
IF (NOT LocalIOOnly) THEN
|
||||||
|
Inc(History.Callers);
|
||||||
|
IF (WasNewUser) THEN
|
||||||
|
Inc(History.NewUsers);
|
||||||
|
|
||||||
|
IF ((History.Posts + PublicPostsToday) < 2147483647) THEN
|
||||||
|
Inc(History.Posts,PublicPostsToday)
|
||||||
|
ELSE
|
||||||
|
History.Posts := 2147483647;
|
||||||
|
|
||||||
|
IF ((History.Email + PrivatePostsToday) < 2147483647) THEN
|
||||||
|
Inc(History.Email,PrivatePostsToday)
|
||||||
|
ELSE
|
||||||
|
History.Email := 2147483647;
|
||||||
|
|
||||||
|
IF ((History.FeedBack + FeedbackPostsToday) < 2147483647) THEN
|
||||||
|
Inc(History.FeedBack,FeedbackPostsToday)
|
||||||
|
ELSE
|
||||||
|
History.FeedBack := 2147483647;
|
||||||
|
|
||||||
|
IF ((History.Uploads + UploadsToday) < 2147483647) THEN
|
||||||
|
Inc(History.Uploads,UploadsToday)
|
||||||
|
ELSE
|
||||||
|
History.Uploads := 2147483647;
|
||||||
|
|
||||||
|
IF ((History.Downloads + DownloadsToday) < 2147483647) THEN
|
||||||
|
Inc(History.Downloads,DownloadsToday)
|
||||||
|
ELSE
|
||||||
|
History.Downloads := 2147483647;
|
||||||
|
|
||||||
|
IF ((History.UK + UploadKBytesToday) < 2147483647) THEN
|
||||||
|
Inc(History.UK,UploadKBytesToday)
|
||||||
|
ELSE
|
||||||
|
History.UK := 2147483647;
|
||||||
|
|
||||||
|
IF ((History.DK + DownloadKBytesToday) < 2147483647) THEN
|
||||||
|
Inc(History.DK,DownloadKBytesToday)
|
||||||
|
ELSE
|
||||||
|
History.DK := 2147483647;
|
||||||
|
|
||||||
|
IF (Exist(StartDir+'\CRITICAL.ERR')) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(History.Errors);
|
||||||
|
Kill(StartDir+'\CRITICAL.ERR');
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ComPortSpeed <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ComportSpeed = 300) THEN
|
||||||
|
Inc(History.UserBaud[1])
|
||||||
|
ELSE IF (ComportSpeed = 600) THEN
|
||||||
|
Inc(History.UserBaud[2])
|
||||||
|
ELSE IF (ComportSpeed = 1200) THEN
|
||||||
|
Inc(History.UserBaud[3])
|
||||||
|
ELSE IF (ComportSpeed = 2400) THEN
|
||||||
|
Inc(History.UserBaud[4])
|
||||||
|
ELSE IF (ComportSpeed = 4800) THEN
|
||||||
|
Inc(History.UserBaud[5])
|
||||||
|
ELSE IF (ComportSpeed = 7200) THEN
|
||||||
|
Inc(History.UserBaud[6])
|
||||||
|
ELSE IF (ComportSpeed = 9600) THEN
|
||||||
|
Inc(History.UserBaud[7])
|
||||||
|
ELSE IF (ComportSpeed = 12000) THEN
|
||||||
|
Inc(History.UserBaud[8])
|
||||||
|
ELSE IF (ComportSpeed = 14400) THEN
|
||||||
|
Inc(History.UserBaud[9])
|
||||||
|
ELSE IF (ComportSpeed = 16800) THEN
|
||||||
|
Inc(History.UserBaud[10])
|
||||||
|
ELSE IF (ComportSpeed = 19200) THEN
|
||||||
|
Inc(History.UserBaud[11])
|
||||||
|
ELSE IF (ComportSpeed = 21600) THEN
|
||||||
|
Inc(History.UserBaud[12])
|
||||||
|
ELSE IF (ComportSpeed = 24000) THEN
|
||||||
|
Inc(History.UserBaud[13])
|
||||||
|
ELSE IF (ComportSpeed = 26400) THEN
|
||||||
|
Inc(History.UserBaud[14])
|
||||||
|
ELSE IF (ComportSpeed = 28800) THEN
|
||||||
|
Inc(History.UserBaud[15])
|
||||||
|
ELSE IF (ComportSpeed = 31200) THEN
|
||||||
|
Inc(History.UserBaud[16])
|
||||||
|
ELSE IF (ComportSpeed = 33600) THEN
|
||||||
|
Inc(History.UserBaud[17])
|
||||||
|
ELSE IF (ComportSpeed = 38400) THEN
|
||||||
|
Inc(History.UserBaud[18])
|
||||||
|
ELSE IF (ComportSpeed = 57600) THEN
|
||||||
|
Inc(History.UserBaud[19])
|
||||||
|
ELSE IF (ComportSpeed = 115200) THEN
|
||||||
|
Inc(History.UserBaud[20])
|
||||||
|
ELSE
|
||||||
|
Inc(History.UserBaud[0]);
|
||||||
|
END;
|
||||||
|
Seek(HistoryFile,(FileSize(HistoryFile) - 1));
|
||||||
|
Write(Historyfile,History);
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
Assign(LastCallerFile,General.DataPath+'LASTON.DAT');
|
||||||
|
Reset(LastCallerFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(LastCallerFile);
|
||||||
|
FOR Counter := (FileSize(LastCallerFile) - 1) DOWNTO 0 DO
|
||||||
|
BEGIN
|
||||||
|
Seek(LastCallerFile,Counter);
|
||||||
|
Read(LastCallerFile,LastCaller);
|
||||||
|
IF (LastCaller.Node = ThisNode) AND (LastCaller.UserID = UserNum) THEN
|
||||||
|
WITH LastCaller DO
|
||||||
|
BEGIN
|
||||||
|
LogOffTime := GetPackDateTime;
|
||||||
|
Uploads := UploadsToday;
|
||||||
|
Downloads := DownloadsToday;
|
||||||
|
UK := UploadKBytesToday;
|
||||||
|
DK := DownloadKBytesToday;
|
||||||
|
MsgRead := PublicReadThisCall;
|
||||||
|
MsgPost := PublicPostsToday;
|
||||||
|
EmailSent := PrivatePostsToday;
|
||||||
|
FeedbackSent := FeedbackPostsToday;
|
||||||
|
Seek(LastCallerFile,Counter);
|
||||||
|
Write(LastCallerFile,LastCaller);
|
||||||
|
Break;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(LastCallerFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DailyMaint;
|
||||||
|
VAR
|
||||||
|
LastCallerFile: FILE OF LastCallerRec;
|
||||||
|
HistoryFile: FILE OF HistoryRecordType;
|
||||||
|
ShortMsgFile: FILE OF ShortMessageRecordType;
|
||||||
|
F: Text;
|
||||||
|
History: HistoryRecordType;
|
||||||
|
ShortMsg: ShortMessageRecordType;
|
||||||
|
TempStr: AStr;
|
||||||
|
Counter,
|
||||||
|
Counter1: Integer;
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (Date2PD(General.LastDate) <> Date2PD(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
General.LastDate := DateStr;
|
||||||
|
|
||||||
|
SaveGeneral(FALSE);
|
||||||
|
|
||||||
|
(* Test code only *)
|
||||||
|
IF (NOT InWFCMenu) THEN
|
||||||
|
SysOpLog('Daily maintenance ran from Caller Logon.')
|
||||||
|
ELSE
|
||||||
|
SysOpLog('Daily maintenance ran from Waiting For Caller.');
|
||||||
|
(* End test code *)
|
||||||
|
|
||||||
|
IF (NOT InWFCMenu) THEN
|
||||||
|
lStatus_Screen(100,'Updating data files ...',FALSE,TempStr);
|
||||||
|
|
||||||
|
(* Test *)
|
||||||
|
IF Exist(General.DataPath+'LASTON.DAT') THEN
|
||||||
|
Kill(General.DataPath+'LASTON.DAT');
|
||||||
|
|
||||||
|
Assign(LastCallerFile,General.DataPath+'LASTON.DAT');
|
||||||
|
ReWrite(LastCallerFile);
|
||||||
|
Close(LastCallerFile);
|
||||||
|
|
||||||
|
Assign(ShortMsgFile,General.DataPath+'SHORTMSG.DAT');
|
||||||
|
Reset(ShortMsgFile);
|
||||||
|
IF (IOResult = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (FileSize(ShortMsgFile) >= 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Counter := 0;
|
||||||
|
Counter1 := 0;
|
||||||
|
WHILE (Counter <= (FileSize(ShortMsgFile) - 1)) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ShortMsgFile,Counter);
|
||||||
|
Read(ShortMsgFile,ShortMsg);
|
||||||
|
IF (ShortMsg.Destin <> -1) THEN
|
||||||
|
IF (Counter = Counter1) THEN
|
||||||
|
Inc(Counter1)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Seek(ShortMsgFile,Counter1);
|
||||||
|
Write(ShortMsgFile,ShortMsg);
|
||||||
|
Inc(Counter1);
|
||||||
|
END;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
Seek(ShortMsgFile,Counter1);
|
||||||
|
Truncate(ShortMsgFile);
|
||||||
|
END;
|
||||||
|
Close(ShortMsgFile);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
Assign(HistoryFile,General.DataPath+'HISTORY.DAT');
|
||||||
|
IF NOT Exist(General.DataPath+'HISTORY.DAT') THEN
|
||||||
|
ReWrite(HistoryFile)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Reset(HistoryFile);
|
||||||
|
Seek(HistoryFile,(FileSize(HistoryFile) - 1));
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
Inc(General.DaysOnline);
|
||||||
|
Inc(General.TotalCalls,History.Callers);
|
||||||
|
Inc(General.TotalUsage,History.Active);
|
||||||
|
Inc(General.TotalPosts,History.Posts);
|
||||||
|
Inc(General.TotalDloads,History.Downloads);
|
||||||
|
Inc(General.TotalUloads,History.Uploads);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (History.Date <> Date2PD(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF Exist(General.LogsPath+'SYSOP'+IntToStr(General.BackSysOpLogs)+'.LOG') THEN
|
||||||
|
Kill(General.LogsPath+'SYSOP'+IntToStr(General.BackSysOpLogs)+'.LOG');
|
||||||
|
|
||||||
|
FOR Counter := (General.BackSysOpLogs - 1) DOWNTO 1 DO
|
||||||
|
IF (Exist(General.LogsPath+'SYSOP'+IntToStr(Counter)+'.LOG')) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(F,General.LogsPath+'SYSOP'+IntToStr(Counter)+'.LOG');
|
||||||
|
Rename(F,General.LogsPath+'SYSOP'+IntToStr(Counter + 1)+'.LOG');
|
||||||
|
END;
|
||||||
|
|
||||||
|
SL1('');
|
||||||
|
SL1('Total mins active..: '+IntToStr(History.Active));
|
||||||
|
SL1('Percent of activity: '+SQOutSp(CTP(History.Active,1440))+' ('+IntToStr(History.Callers)+' calls)');
|
||||||
|
SL1('New users..........: '+IntToStr(History.NewUsers));
|
||||||
|
SL1('Public posts.......: '+IntToStr(History.Posts));
|
||||||
|
SL1('Private mail sent..: '+IntToStr(History.Email));
|
||||||
|
SL1('FeedBack sent......: '+IntToStr(History.FeedBack));
|
||||||
|
SL1('Critical errors....: '+IntToStr(History.Errors));
|
||||||
|
SL1('Downloads today....: '+IntToStr(History.Downloads)+'-'+ConvertKB(History.DK,FALSE));
|
||||||
|
SL1('Uploads today......: '+IntToStr(History.Uploads)+'-'+ConvertKB(History.UK,FALSE));
|
||||||
|
|
||||||
|
FillChar(History,SizeOf(History),0);
|
||||||
|
History.Date := Date2PD(DateStr);
|
||||||
|
|
||||||
|
Seek(HistoryFile,FileSize(HistoryFile));
|
||||||
|
Write(HistoryFile,History);
|
||||||
|
Close(HistoryFile);
|
||||||
|
|
||||||
|
IF (General.MultiNode) AND Exist(TempDir+'TEMPLOG.'+IntToStr(ThisNode)) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(F,General.LogsPath+'SYSOP.LOG');
|
||||||
|
Append(F);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(F);
|
||||||
|
Reset(SysOpLogFile);
|
||||||
|
WHILE NOT EOF(SysOpLogFile) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(SysOpLogFile,TempStr);
|
||||||
|
WriteLn(F,TempStr);
|
||||||
|
END;
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
Close(F);
|
||||||
|
Erase(SysOpLogFile);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
Rename(SysOpLogFile,General.LogsPath+'SYSOP1.LOG');
|
||||||
|
|
||||||
|
Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
ReWrite(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
|
||||||
|
SL1(^M^J' Renegade SysOp Log for '+DateStr+^M^J);
|
||||||
|
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
Assign(SysOpLogFile,TempDir+'TEMPLOG.'+IntToStr(ThisNode))
|
||||||
|
ELSE
|
||||||
|
Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
Append(SysOpLogFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Close(HistoryFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UpdateGeneral;
|
||||||
|
VAR
|
||||||
|
HistoryFile: FILE OF HistoryRecordType;
|
||||||
|
History: HistoryRecordType;
|
||||||
|
Counter: LongInt;
|
||||||
|
BEGIN
|
||||||
|
Assign(HistoryFile,General.DataPath+'HISTORY.DAT');
|
||||||
|
Reset(HistoryFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(HistoryFile);
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
DaysOnline := FileSize(HistoryFile);
|
||||||
|
TotalCalls := 0;
|
||||||
|
TotalUsage := 0;
|
||||||
|
TotalPosts := 0;
|
||||||
|
TotalDloads := 0;
|
||||||
|
TotalUloads := 0;
|
||||||
|
FOR Counter := 1 TO (FileSize(HistoryFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
Inc(TotalCalls,History.Callers);
|
||||||
|
Inc(TotalUsage,History.Active);
|
||||||
|
Inc(TotalPosts,History.Posts);
|
||||||
|
Inc(TotalDloads,History.Downloads);
|
||||||
|
Inc(TotalUloads,History.Uploads);
|
||||||
|
END;
|
||||||
|
IF (TotalUsage < 1) THEN
|
||||||
|
TotalUsage := 1;
|
||||||
|
IF (DaysOnline < 1) THEN
|
||||||
|
DaysOnline := 1;
|
||||||
|
END;
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
SaveGeneral(FALSE);
|
||||||
|
IF (NOT InWFCMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('System averages have been updated.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,518 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Menus2;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE LoadMenu;
|
||||||
|
PROCEDURE ShowCmds(MenuOption: Str50);
|
||||||
|
FUNCTION OkSecurity(CmdToExec: Byte; VAR CmdNotHid: Boolean): Boolean;
|
||||||
|
PROCEDURE GenericMenu(ListType: Byte);
|
||||||
|
PROCEDURE ShowThisMenu;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
PROCEDURE LoadMenu;
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
MenuNum: Integer;
|
||||||
|
TempCkeys: CHAR;
|
||||||
|
FoundMenu: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (GlobalCmds > 0) THEN
|
||||||
|
Move(MemCmd^[((NumCmds - GlobalCmds) + 1)],MemCmd^[((MaxCmds - GlobalCmds) + 1)],(GlobalCmds * Sizeof(MemCmdRec)));
|
||||||
|
NumCmds := 0;
|
||||||
|
FoundMenu := FALSE;
|
||||||
|
Reset(MenuFile);
|
||||||
|
MenuNum := 1;
|
||||||
|
WHILE (MenuNum <= NumMenus) AND (NOT FoundMenu) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[MenuNum]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
IF (MenuR.MenuNum = CurMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
FallBackMenu := MenuR.FallBack;
|
||||||
|
FoundMenu := TRUE;
|
||||||
|
END;
|
||||||
|
Inc(MenuNum);
|
||||||
|
END;
|
||||||
|
Dec(MenuNum);
|
||||||
|
IF (NOT FoundMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('That menu is missing, dropping to fallback ...');
|
||||||
|
SysOpLog('Menu #'+IntToStr(CurMenu)+' is missing - Dropping to FallBack #'+IntToStr(FallBackMenu));
|
||||||
|
IF (FallBackMenu > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
FoundMenu := FALSE;
|
||||||
|
MenuNum := 1;
|
||||||
|
WHILE (MenuNum <= NumMenus) AND (NOT FoundMenu) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[MenuNum]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
IF (MenuR.MenuNum = FallBackMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := FallBackMenu;
|
||||||
|
FallBackMenu := MenuR.FallBack;
|
||||||
|
FoundMenu := TRUE;
|
||||||
|
END;
|
||||||
|
Inc(MenuNum);
|
||||||
|
END;
|
||||||
|
Dec(MenuNum);
|
||||||
|
END;
|
||||||
|
IF (FallBackMenu = 0) OR (NOT FoundMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Emergency System shutdown. Please call back later.');
|
||||||
|
NL;
|
||||||
|
Print('Critical error; hanging up.');
|
||||||
|
IF (FallBackMenu = 0) THEN
|
||||||
|
SysOpLog('FallBack menu is set to ZERO - Hung user up.')
|
||||||
|
ELSE
|
||||||
|
SysOpLog('FallBack #'+IntToStr(FallBackMenu)+' is MISSING - Hung user up.');
|
||||||
|
HangUp := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (FoundMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[MenuNum]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
WITH MemMenu DO
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
LDesc[Counter] := MenuR.LDesc[Counter];
|
||||||
|
ACS := MenuR.ACS;
|
||||||
|
NodeActivityDesc := MenuR.NodeActivityDesc;
|
||||||
|
MenuFlags := MenuR.MenuFlags;
|
||||||
|
LongMenu := MenuR.LongMenu;
|
||||||
|
MenuNum := MenuR.MenuNum;
|
||||||
|
MenuPrompt := MenuR.MenuPrompt;
|
||||||
|
Password := MenuR.Password;
|
||||||
|
FallBack := MenuR.FallBack;
|
||||||
|
Directive := MenuR.Directive;
|
||||||
|
ForceHelpLevel := MenuR.ForceHelpLevel;
|
||||||
|
GenCols := MenuR.GenCols;
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
GCol[Counter] := MenuR.GCol[Counter];
|
||||||
|
END;
|
||||||
|
|
||||||
|
Update_Node(MemMenu.NodeActivityDesc,TRUE);
|
||||||
|
|
||||||
|
MQArea := FALSE;
|
||||||
|
FQArea := FALSE;
|
||||||
|
VQArea := FALSE;
|
||||||
|
RQArea := FALSE;
|
||||||
|
MenuKeys := '';
|
||||||
|
NumCmds := 1;
|
||||||
|
WHILE (NumCmds <= CmdNumArray[MenuNum]) DO
|
||||||
|
BEGIN
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
WITH MemCmd^[NumCmds] DO
|
||||||
|
BEGIN
|
||||||
|
LDesc := MenuR.LDesc[1];
|
||||||
|
ACS := MenuR.ACS;
|
||||||
|
NodeActivityDesc := MenuR.NodeActivityDesc;
|
||||||
|
CmdFlags := MenuR.CmdFlags;
|
||||||
|
SDesc := MenuR.SDesc;
|
||||||
|
CKeys := MenuR.CKeys;
|
||||||
|
IF (CKeys = 'ENTER') THEN
|
||||||
|
TempCkeys := #13
|
||||||
|
ELSE IF (CKeys = 'UP_ARROW') THEN
|
||||||
|
TempCkeys := #255
|
||||||
|
ELSE IF (CKeys = 'DOWN_ARROW') THEN
|
||||||
|
TempCkeys := #254
|
||||||
|
ELSE IF (CKeys = 'LEFT_ARROW') THEN
|
||||||
|
TempCkeys := #253
|
||||||
|
ELSE IF (CKeys = 'RIGHT_ARROW') THEN
|
||||||
|
TempCkeys := #252
|
||||||
|
ELSE IF (Length(CKeys) > 1) THEN
|
||||||
|
TempCkeys := '/'
|
||||||
|
ELSE
|
||||||
|
TempCkeys := UpCase(CKeys[1]);
|
||||||
|
IF (Pos(TempCkeys,MenuKeys) = 0) THEN
|
||||||
|
MenuKeys := MenuKeys + TempCkeys;
|
||||||
|
CmdKeys := MenuR.CmdKeys;
|
||||||
|
IF (CmdKeys = 'M#') THEN
|
||||||
|
MQArea := TRUE
|
||||||
|
ELSE IF (CmdKeys = 'F#') THEN
|
||||||
|
FQArea := TRUE
|
||||||
|
ELSE IF (CmdKeys = 'V#') THEN
|
||||||
|
VQArea := TRUE
|
||||||
|
ELSE IF (CmdKeys = 'R#') THEN
|
||||||
|
RQArea := TRUE;
|
||||||
|
Options := MenuR.Options;
|
||||||
|
END;
|
||||||
|
Inc(NumCmds);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Dec(NumCmds);
|
||||||
|
Close(MenuFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (GlobalCmds > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Move(MemCmd^[((MaxCmds - GlobalCmds) + 1)],MemCmd^[(NumCmds + 1)],(GlobalCmds * Sizeof(MemCmdRec)));
|
||||||
|
Inc(NumCmds,GlobalCmds);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ShowCmds(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
TempStr,
|
||||||
|
TempStr1: AStr;
|
||||||
|
CmdToList,
|
||||||
|
Counter,
|
||||||
|
NumRows: Byte;
|
||||||
|
|
||||||
|
FUNCTION Type1(CTL: Byte): AStr;
|
||||||
|
BEGIN
|
||||||
|
Type1 := '^0'+PadRightInt(CTL,3)+
|
||||||
|
' ^3'+PadLeftStr(MemCmd^[CTL].CKeys,2)+
|
||||||
|
' ^3'+PadLeftStr(MemCmd^[CTL].CmdKeys,2)+
|
||||||
|
' '+PadLeftStr(MemCmd^[CTL].Options,15);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
IF (MenuOption = '') THEN
|
||||||
|
Exit;
|
||||||
|
IF (NumCmds = 0) THEN
|
||||||
|
Print('*** No commands on this menu ***')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
AllowAbort := TRUE;
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
NL;
|
||||||
|
CASE MenuOption[1] OF
|
||||||
|
'1' : BEGIN
|
||||||
|
PrintACR('^0###^4:^3KK ^4:^3CF^4:^3ACS ^4:^3CK^4:^3Options');
|
||||||
|
PrintACR('^4===:==============:==:==========:==:========================================');
|
||||||
|
CmdToList := 1;
|
||||||
|
WHILE (CmdToList <= NumCmds) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^0'+PadRightInt(CmdToList,3)+
|
||||||
|
' ^3'+PadLeftStr(MemCmd^[CmdToList].CKeys,14)+
|
||||||
|
' '+AOnOff(Hidden IN MemCmd^[CmdToList].CmdFlags,'H','-')+
|
||||||
|
AOnOff(UnHidden IN MemCmd^[CmdToList].CmdFlags,'U','-')+
|
||||||
|
' ^9'+PadLeftStr(MemCmd^[CmdToList].ACS,10)+
|
||||||
|
' ^3'+PadLeftStr(MemCmd^[CmdToList].CmdKeys,2)+
|
||||||
|
' '+PadLeftStr(MemCmd^[CmdToList].Options,40));
|
||||||
|
Inc(CmdToList);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'2' : BEGIN
|
||||||
|
NumRows := ((NumCmds + 2) DIV 3);
|
||||||
|
TempStr := '^0###^4:^3KK^4:^3CK^4:^3Options ';
|
||||||
|
TempStr1 := '^4===:==:==:===============';
|
||||||
|
CmdToList := 1;
|
||||||
|
WHILE (CmdToList <= NumRows) AND (CmdToList < 3) DO
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr+' ^0###^4:^3KK^4:^3CK^4:^3Options ';
|
||||||
|
TempStr1 := TempStr1 + ' ^4===:==:==:===============';
|
||||||
|
Inc(CmdToList);
|
||||||
|
END;
|
||||||
|
PrintACR(TempStr);
|
||||||
|
PrintACR(TempStr1);
|
||||||
|
CmdToList := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(CmdToList);
|
||||||
|
TempStr := Type1(CmdToList);
|
||||||
|
FOR Counter := 1 TO 2 DO
|
||||||
|
IF ((CmdToList + (Counter * NumRows)) <= NumCmds) THEN
|
||||||
|
TempStr := TempStr + ' '+Type1(CmdToList + (Counter * NumRows));
|
||||||
|
PrintACR('^1'+TempStr);
|
||||||
|
UNTIL ((CmdToList >= NumRows) OR (Abort) OR (HangUp));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
AllowAbort := FALSE;
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION OkSecurity(CmdToExec: Byte; VAR CmdNotHid: Boolean): Boolean;
|
||||||
|
BEGIN
|
||||||
|
OkSecurity := FALSE;
|
||||||
|
IF (UnHidden IN MemCmd^[CmdToExec].CmdFlags) THEN
|
||||||
|
CmdNotHid := TRUE;
|
||||||
|
IF (NOT AACS(MemCmd^[CmdToExec].ACS)) THEN
|
||||||
|
EXIT;
|
||||||
|
OkSecurity := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GenericMenu(ListType: Byte);
|
||||||
|
VAR
|
||||||
|
GColors: ARRAY [1..3] OF Byte;
|
||||||
|
Counter,
|
||||||
|
ColSiz,
|
||||||
|
NumCols: Byte;
|
||||||
|
|
||||||
|
FUNCTION GenColored(CONST Keys: AStr; Desc: AStr; Acc: Boolean): AStr;
|
||||||
|
VAR
|
||||||
|
j: Byte;
|
||||||
|
BEGIN
|
||||||
|
j := Pos(AllCaps(Keys),AllCaps(Desc));
|
||||||
|
IF (j <> 0) AND (Pos('^',Desc) = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Insert('^'+IntToStr(GColors[3]),Desc,((j + Length(Keys) + 1)));
|
||||||
|
Insert('^'+IntToStr(GColors[1]),Desc,j + Length(Keys));
|
||||||
|
IF (acc) THEN
|
||||||
|
Insert('^'+IntToStr(GColors[2]),Desc,j);
|
||||||
|
IF (j <> 1) THEN
|
||||||
|
Insert('^'+IntToStr(GColors[1]),Desc,j - 1);
|
||||||
|
END;
|
||||||
|
GenColored := '^'+IntToStr(GColors[3])+Desc;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION TCentered(c: Integer; CONST s: AStr): AStr;
|
||||||
|
CONST
|
||||||
|
SpaceStr = ' ';
|
||||||
|
BEGIN
|
||||||
|
c := (c DIV 2) - (LennMCI(s) DIV 2);
|
||||||
|
IF (c < 1) THEN
|
||||||
|
c := 0;
|
||||||
|
TCentered := Copy(SpaceStr,1,c) + s;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE NewGColors(CONST S: STRING);
|
||||||
|
VAR
|
||||||
|
TempStr: STRING;
|
||||||
|
BEGIN
|
||||||
|
TempStr := SemiCmd(s,1);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
GColors[1] := StrToInt(TempStr);
|
||||||
|
TempStr := SemiCmd(s,2);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
GColors[2] := StrToInt(TempStr);
|
||||||
|
TempStr := SemiCmd(s,3);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
GColors[3] := StrToInt(TempStr);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GetMaxRight(VAR MaxRight: Byte);
|
||||||
|
VAR
|
||||||
|
CmdToList,
|
||||||
|
Len,
|
||||||
|
Onlin: Byte;
|
||||||
|
TempStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
MaxRight := 0;
|
||||||
|
OnLin := 0;
|
||||||
|
TempStr := '';
|
||||||
|
FOR CmdToList := 1 TO NumCmds DO
|
||||||
|
IF (MemCmd^[CmdToList].CKeys <> 'GTITLE') THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(OnLin);
|
||||||
|
IF (OnLin <> NumCols) THEN
|
||||||
|
TempStr := TempStr + PadLeftStr(MemCmd^[CmdToList].SDesc,ColSiz)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr + MemCmd^[CmdToList].SDesc;
|
||||||
|
OnLin := 0;
|
||||||
|
Len := LennMCI(TempStr);
|
||||||
|
IF (Len > MaxRight) THEN
|
||||||
|
MaxRight := Len;
|
||||||
|
TempStr := '';
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempStr := '';
|
||||||
|
OnLin := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DoMenuTitles(MaxRight: Byte);
|
||||||
|
VAR
|
||||||
|
Counter1: Byte;
|
||||||
|
ShownAlready: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (ClrScrBefore IN MemMenu.MenuFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
CLS;
|
||||||
|
NL;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
IF (NOT (NoMenuTitle IN MemMenu.MenuFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
ShownAlready := FALSE;
|
||||||
|
FOR Counter1 := 1 TO 3 DO
|
||||||
|
IF (MemMenu.LDesc[Counter1] <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (NOT ShownAlready) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
ShownAlready := TRUE;
|
||||||
|
END;
|
||||||
|
IF (DontCenter IN MemMenu.MenuFlags) THEN
|
||||||
|
PrintACR(MemMenu.LDesc[Counter1])
|
||||||
|
ELSE
|
||||||
|
PrintACR(TCentered(MaxRight,MemMenu.LDesc[Counter1]));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GenTuto;
|
||||||
|
VAR
|
||||||
|
CmdToList,
|
||||||
|
MaxRight: Byte;
|
||||||
|
Acc,
|
||||||
|
CmdNotHid: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
GetMaxRight(MaxRight);
|
||||||
|
DoMenuTitles(MaxRight);
|
||||||
|
IF (NoGlobalDisplayed IN MemMenu.MenuFlags) OR (NoGlobalUsed IN MemMenu.MenuFlags) THEN
|
||||||
|
Dec(NumCmds,GlobalCmds);
|
||||||
|
CmdToList := 0;
|
||||||
|
WHILE (CmdToList < NumCmds) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(CmdToList);
|
||||||
|
CmdNotHid := FALSE;
|
||||||
|
Acc := OkSecurity(CmdToList,CmdNotHid);
|
||||||
|
IF (((Acc) OR (UnHidden IN MemCmd^[CmdToList].CmdFlags)) AND (NOT (Hidden IN MemCmd^[CmdToList].CmdFlags))) THEN
|
||||||
|
IF (MemCmd^[CmdToList].CKeys = 'GTITLE') THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR(MemCmd^[CmdToList].LDesc);
|
||||||
|
IF (MemCmd^[CmdToList].Options <> '') THEN
|
||||||
|
NewGColors(MemCmd^[CmdToList].Options);
|
||||||
|
END
|
||||||
|
ELSE IF (MemCmd^[CmdToList].LDesc <> '') THEN
|
||||||
|
PrintACR(GenColored(MemCmd^[CmdToList].CKeys,MemCmd^[CmdToList].LDesc,Acc));
|
||||||
|
END;
|
||||||
|
IF (NoGlobalDisplayed IN MemMenu.MenuFlags) OR (NoGlobalUsed IN MemMenu.MenuFlags) THEN
|
||||||
|
Inc(NumCmds,GlobalCmds);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GenNorm;
|
||||||
|
VAR
|
||||||
|
TempStr,
|
||||||
|
TempStr1: AStr;
|
||||||
|
CmdToList,
|
||||||
|
Onlin,
|
||||||
|
MaxRight: Byte;
|
||||||
|
Acc,
|
||||||
|
CmdNotHid: Boolean;
|
||||||
|
BEGIN
|
||||||
|
TempStr1 := '';
|
||||||
|
OnLin := 0;
|
||||||
|
TempStr := '';
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
GetMaxRight(MaxRight);
|
||||||
|
DoMenuTitles(MaxRight);
|
||||||
|
IF (NoGlobalDisplayed IN MemMenu.MenuFlags) OR (NoGlobalUsed IN MemMenu.MenuFlags) THEN
|
||||||
|
Dec(NumCmds,GlobalCmds);
|
||||||
|
CmdToList := 0;
|
||||||
|
WHILE (CmdToList < NumCmds) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(CmdToList);
|
||||||
|
CmdNotHid := FALSE;
|
||||||
|
Acc := OkSecurity(CmdToList,CmdNotHid);
|
||||||
|
IF (((Acc) OR (UnHidden IN MemCmd^[CmdToList].CmdFlags)) AND (NOT (Hidden IN MemCmd^[CmdToList].CmdFlags))) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (MemCmd^[CmdToList].CKeys = 'GTITLE') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (OnLin <> 0) THEN
|
||||||
|
PrintACR(TempStr);
|
||||||
|
PrintACR(TCentered(MaxRight,MemCmd^[CmdToList].LDesc));
|
||||||
|
TempStr := '';
|
||||||
|
OnLin := 0;
|
||||||
|
IF (MemCmd^[CmdToList].Options <> '') THEN
|
||||||
|
NewGColors(MemCmd^[CmdToList].Options);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (MemCmd^[CmdToList].SDesc <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(OnLin);
|
||||||
|
TempStr1 := GenColored(MemCmd^[CmdToList].CKeys,MemCmd^[CmdToList].SDesc,Acc);
|
||||||
|
IF (OnLin <> NumCols) THEN
|
||||||
|
TempStr1 := PadLeftStr(TempStr1,ColSiz);
|
||||||
|
TempStr := TempStr + TempStr1;
|
||||||
|
END;
|
||||||
|
IF (OnLin = NumCols) THEN
|
||||||
|
BEGIN
|
||||||
|
OnLin := 0;
|
||||||
|
PrintACR(TempStr);
|
||||||
|
TempStr := '';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (NoGlobalDisplayed IN MemMenu.MenuFlags) OR (NoGlobalUsed IN MemMenu.MenuFlags) THEN
|
||||||
|
Inc(NumCmds,GlobalCmds);
|
||||||
|
IF (OnLin > 0) THEN
|
||||||
|
PrintACR(TempStr);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
GColors[Counter] := MemMenu.GCol[Counter];
|
||||||
|
NumCols := MemMenu.GenCols;
|
||||||
|
CASE NumCols OF
|
||||||
|
2 : ColSiz := 39;
|
||||||
|
3 : ColSiz := 25;
|
||||||
|
4 : ColSiz := 19;
|
||||||
|
5 : ColSiz := 16;
|
||||||
|
6 : ColSiz := 12;
|
||||||
|
7 : ColSiz := 11;
|
||||||
|
END;
|
||||||
|
IF ((NumCols * ColSiz) >= ThisUser.LineLen) THEN
|
||||||
|
NumCols := (ThisUser.LineLen DIV ColSiz);
|
||||||
|
DisplayingMenu := TRUE;
|
||||||
|
IF (ListType = 2) THEN
|
||||||
|
GenNorm
|
||||||
|
ELSE
|
||||||
|
GenTuto;
|
||||||
|
DisplayingMenu := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ShowThisMenu;
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
CASE CurHelpLevel OF
|
||||||
|
2 : BEGIN
|
||||||
|
DisplayingMenu := TRUE;
|
||||||
|
NoFile := TRUE;
|
||||||
|
TempStr := MemMenu.Directive;
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Pos('@S',TempStr) > 0) THEN
|
||||||
|
PrintF(Substitute(TempStr,'@S',IntToStr(ThisUser.SL)));
|
||||||
|
IF (NoFile) THEN
|
||||||
|
PrintF(Substitute(TempStr,'@S',''));
|
||||||
|
END;
|
||||||
|
DisplayingMenu := FALSE;
|
||||||
|
END;
|
||||||
|
3 : BEGIN
|
||||||
|
DisplayingMenu := TRUE;
|
||||||
|
NoFile := TRUE;
|
||||||
|
TempStr := MemMenu.LongMenu;
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Pos('@C',TempStr) <> 0) THEN
|
||||||
|
PrintF(Substitute(TempStr,'@C',CurrentConf));
|
||||||
|
IF (NoFile) AND (Pos('@S',TempStr) <> 0) THEN
|
||||||
|
PrintF(Substitute(TempStr,'@S',IntToStr(ThisUser.SL)));
|
||||||
|
IF (NoFile) THEN
|
||||||
|
PrintF(Substitute(TempStr,'@S',''));
|
||||||
|
END;
|
||||||
|
DisplayingMenu := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF ((NoFile) AND (CurHelpLevel IN [2,3])) THEN
|
||||||
|
GenericMenu(CurHelpLevel);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,97 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Menus3;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE DoChangeMenu(VAR Done: BOOLEAN; VAR NewMenuCmd: ASTR; Cmd: CHAR; CONST MenuOption: Str50);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
PROCEDURE DoChangeMenu(VAR Done: BOOLEAN; VAR NewMenuCmd: ASTR; Cmd: CHAR; CONST MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
TempStr,
|
||||||
|
TempStr1: ASTR;
|
||||||
|
BEGIN
|
||||||
|
CASE Cmd OF
|
||||||
|
'^' : BEGIN
|
||||||
|
TempStr1 := MenuOption;
|
||||||
|
IF (Pos(';',TempStr1) <> 0) THEN
|
||||||
|
TempStr1 := Copy(TempStr1,1,(Pos(';',TempStr1) - 1));
|
||||||
|
IF (MenuOption <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := MenuOption;
|
||||||
|
IF (Pos(';',TempStr) <> 0) THEN
|
||||||
|
TempStr := Copy(TempStr,(Pos(';',TempStr) + 1),Length(TempStr));
|
||||||
|
IF (UpCase(TempStr[1]) = 'C') THEN
|
||||||
|
MenuStackPtr := 0;
|
||||||
|
IF (Pos(';',TempStr) = 0) OR (Length(TempStr) = 1) THEN
|
||||||
|
TempStr := ''
|
||||||
|
ELSE
|
||||||
|
TempStr := Copy(TempStr,(Pos(';',TempStr) + 1),Length(TempStr));
|
||||||
|
END;
|
||||||
|
IF (TempStr1 <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := StrToInt(TempStr1);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
NewMenuCmd := AllCaps(TempStr);
|
||||||
|
Done := TRUE;
|
||||||
|
NewMenuToLoad := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'/' : BEGIN
|
||||||
|
TempStr1 := MenuOption;
|
||||||
|
IF (Pos(';',TempStr1) <> 0) THEN
|
||||||
|
TempStr1 := Copy(TempStr1,1,Pos(';',TempStr1) - 1);
|
||||||
|
IF ((MenuOption <> '') AND (MenuStackPtr <> MaxMenus)) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := MenuOption;
|
||||||
|
IF (Pos(';',TempStr) <> 0) THEN
|
||||||
|
TempStr := Copy(TempStr,(Pos(';',TempStr) + 1),Length(TempStr));
|
||||||
|
IF (UpCase(TempStr[1]) = 'C') THEN
|
||||||
|
MenuStackPtr := 0;
|
||||||
|
IF (Pos(';',TempStr) = 0) OR (Length(TempStr) = 1) THEN
|
||||||
|
TempStr := ''
|
||||||
|
ELSE
|
||||||
|
TempStr := Copy(TempStr,(Pos(';',TempStr) + 1),Length(TempStr));
|
||||||
|
IF (CurMenu <> StrToInt(TempStr1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(MenuStackPtr);
|
||||||
|
MenuStack[MenuStackPtr] := CurMenu;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
TempStr1 := '';
|
||||||
|
END;
|
||||||
|
IF (TempStr1 <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := StrToInt(TempStr1);
|
||||||
|
IF (TempStr <> '') THEN
|
||||||
|
NewMenuCmd := AllCaps(TempStr);
|
||||||
|
Done := TRUE;
|
||||||
|
NewMenuToLoad := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'\' : BEGIN
|
||||||
|
IF (MenuStackPtr <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := MenuStack[MenuStackPtr];
|
||||||
|
Dec(MenuStackPtr);
|
||||||
|
END;
|
||||||
|
IF (UpCase(MenuOption[1]) = 'C') THEN
|
||||||
|
MenuStackPtr := 0;
|
||||||
|
IF (Pos(';',MenuOption) <> 0) THEN
|
||||||
|
NewMenuCmd := AllCaps(Copy(MenuOption,(Pos(';',MenuOption) + 1),Length(MenuOption)));
|
||||||
|
Done := TRUE;
|
||||||
|
NewMenuToLoad := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
%LF [1;30mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ [0;36mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ[1mﾄﾄﾄﾄﾄﾄﾄﾄﾄ[37mﾄﾄ[36mﾄﾄﾄﾄﾄﾄﾄﾄﾄ[0;36mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ [1;30mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ%LF
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
%LF |15ﾄﾄﾄ |07ﾄﾄ ﾄﾄ ﾄﾄ|08ﾄﾄﾄ ﾄﾄ ﾄﾄ ﾄ |03ﾄﾄ ﾄﾄ ﾄ ﾄ |11ﾄﾄ ﾄ ﾄ ﾄﾄ |03ﾄﾄ ﾄﾄ ﾄ ﾄ |08ﾄﾄﾄ ﾄﾄ ﾄﾄ|07 ﾄﾄﾄ ﾄﾄ |15ﾄﾄ ﾄﾄ%LF
|
||||||
|
|
@ -0,0 +1,7 @@
|
||||||
|
[?7h[40m[2J[1C[0;36mﾛﾛﾛﾛﾛﾛﾛﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟ [1;30mﾟﾟﾛﾛﾛ [0;36mﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾛﾛﾛﾛﾛﾛﾛ
|
||||||
|
ﾟﾟﾟﾟﾟﾟﾟﾟ [1;30mｲｲﾛﾛﾛﾛﾛ ｲｲﾛﾛﾛﾛﾛ ｲｲﾛﾛﾛﾛ ｲﾛﾛ ｲﾛﾛ ｲｲﾛﾛﾛﾛﾛ ｲｲﾛﾛﾛﾛ ｲｲﾛﾛﾛﾛﾛ ｲｲﾛﾛﾛﾛ [0;36mﾟﾟﾟﾟﾟﾟﾟﾟ
|
||||||
|
ﾛﾛﾛﾛﾛﾛﾛﾛ [1;30mｲﾛﾛﾛﾛﾛﾛ ｲﾛﾛﾛﾛﾛﾛ ｲﾛﾛﾛ ﾟ ﾛﾛﾛ ﾛﾛﾛ ｲﾛﾛﾛﾛﾛﾛ ｲﾛﾛﾛ ﾟ ｲﾛﾛﾟﾛﾛﾛ ｲﾛﾛﾛ ﾟ [0;36mﾛﾛﾛﾛﾛﾛﾛﾛ
|
||||||
|
ﾛﾛﾛﾛﾛﾛﾛﾛ [1;30mﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛﾛﾛ ﾛﾛﾛﾛﾛﾛﾛ ﾛﾛﾛﾛﾛﾛ [0;36mﾛﾛﾛﾛﾛﾛﾛﾛ
|
||||||
|
ﾛﾛﾛﾛﾛﾛﾛﾛ [1;30mﾛﾛﾛﾛﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛﾛ ﾜ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛ ﾛﾛﾛﾛ ﾜ ﾛﾛﾛ ﾛﾛ ﾜ ﾛﾛﾛﾛ [0;36mﾛﾛﾛﾛﾛﾛﾛﾛ
|
||||||
|
ﾜﾜﾜﾜﾜﾜﾜﾜ [1;30mﾛﾛﾛﾛﾛｲﾛ ﾛﾛﾛ ﾛｲﾛ ﾛﾛﾛﾛﾛｲ ﾛﾟﾛ ﾛﾟﾛ ﾛﾛﾛ ﾛｲﾛ ﾛﾛﾛﾛﾛｲ ﾛｲﾛ ﾛﾛｲ ﾛﾛﾛﾛﾛｰ [0;36mﾜﾜﾜﾜﾜﾜﾜﾜ
|
||||||
|
[1;30mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ [0;36mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ[1mﾄﾄﾄﾄﾄﾄﾄﾄﾄ[37mﾄﾄ[36mﾄﾄﾄﾄﾄﾄﾄﾄﾄ[0;36mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ [1;30mﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ%LF
|
||||||
|
|
@ -0,0 +1,12 @@
|
||||||
|
|
||||||
|
ﾛﾛﾛﾛﾛﾛ
|
||||||
|
ﾛﾛﾛﾟﾟﾟ ﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ
|
||||||
|
ﾟﾟﾟ ﾜﾛﾛﾛﾟﾟﾛﾛﾛﾜ ﾟﾞﾛﾛﾛﾟﾛﾛﾛﾜ ﾜﾛﾛﾛﾟﾛﾛﾛﾛ ﾛﾛﾛﾛ ﾛﾛﾛﾛ ﾟﾞﾛﾛﾛﾟﾛﾛﾛﾜ ﾜﾛﾛﾛﾟﾛﾛﾛﾛ
|
||||||
|
ｰ ﾞﾛﾛﾛﾝ ﾞﾛﾛﾛﾝ ﾛﾛﾛﾛ ﾞﾛﾛﾛﾝ ﾞﾛﾛﾛﾝ ﾛﾛﾛﾛ ﾛﾛﾛﾛ ﾛﾛﾛﾛ ﾛﾛﾛﾛ ﾞﾛﾛﾛﾝ ﾞﾛﾛﾛﾝ ﾛﾛﾛﾛ ｰ
|
||||||
|
ﾟﾛ ｰｰﾛﾛ ﾛﾛｰｰ ﾛﾛﾛｰ ﾛﾛｰｰ ｰｰﾛﾛﾜﾜﾛﾛﾛﾛ ﾛﾛﾛｰ ﾛﾛﾛｰ ﾛﾛﾛｰ ﾛﾛｰｰ ｰｰﾛﾛﾜﾜﾛﾛﾛﾛ ﾟﾟﾛ
|
||||||
|
ﾛ ｱｱｰﾛ ﾛｰｱｱ ﾛｰｰｱ ﾛｰｱｱ ｱｱｰﾛ ﾜﾜﾜﾜ ﾛｰｰｱ ﾛｰｰｱ ﾛｰｰｱ ﾛｰｱｱ ｱｱｰﾛ ﾜﾜﾜﾜ ﾛ
|
||||||
|
ﾛﾜﾜﾞｲｱｱﾝ ﾞｱｱｲﾝ ｰｱｲｲ ﾞｱｱｲﾝ ﾞｲｱｱﾝ ﾛﾛｰﾛ ｰｱｲｲ ｰｱｲｲ ｰｱｲｲ ﾞｱｱｲﾝ ﾞｲｱｱﾝ ﾛﾛｰﾛ rlﾛ
|
||||||
|
ｰ ﾟﾛﾛﾛﾜﾜﾛﾛﾛﾟ ｲｲﾛﾛ ﾛﾛﾛﾟ ﾟﾛﾛﾛﾜｲｱｱｰ ｲｲﾛﾛﾜﾜ ｲｲﾛﾛ ｲｲﾛﾛ ﾛﾛﾛﾟ ﾟﾛﾛﾛﾜｲｱｱｰ v!ｰ
|
||||||
|
ﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄ ﾜﾜﾜﾜﾛﾛ
|
||||||
|
ﾛﾛﾛﾛﾛﾛ
|
||||||
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
|03~OL |11 ... |15~UN{16%LF
|
||||||
|
|
@ -0,0 +1,266 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT MiscUser;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE lFindUserWS(VAR UserNum: Integer);
|
||||||
|
PROCEDURE ChangeARFlags(MenuOption: Str50);
|
||||||
|
PROCEDURE ChangeACFlags(MenuOption: Str50);
|
||||||
|
PROCEDURE FindUser(VAR UserNum: Integer);
|
||||||
|
PROCEDURE InsertIndex(uname: AStr; UserNum: Integer; IsReal,IsDeleted: Boolean);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
PROCEDURE lFindUserWS(VAR UserNum: Integer);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
UserIDX: UserIDXRec;
|
||||||
|
UserName: AStr;
|
||||||
|
Cmd: Char;
|
||||||
|
Counter,
|
||||||
|
NumIDX: Integer;
|
||||||
|
Done,
|
||||||
|
Asked: Boolean;
|
||||||
|
BEGIN
|
||||||
|
MPL(36);
|
||||||
|
Input(UserName,36);
|
||||||
|
IF (UserName = 'SYSOP') THEN
|
||||||
|
UserName := '1';
|
||||||
|
UserNum := StrToInt(UserName);
|
||||||
|
IF (UserNum > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (UserNum > (MaxUsers - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Unknown user.');
|
||||||
|
UserNum := 0
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
LoadURec(User,UserNum);
|
||||||
|
END
|
||||||
|
ELSE IF (UserName = '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Aborted.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
Asked := FALSE;
|
||||||
|
UserNum := SearchUser(UserName,CoSysOp);
|
||||||
|
IF (UserNum > 0) THEN
|
||||||
|
Exit;
|
||||||
|
Reset(UserIDXFile);
|
||||||
|
Counter := 0;
|
||||||
|
NumIDX := FileSize(UserIDXFile);
|
||||||
|
WHILE (Counter < NumIDX) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
Read(UserIDXFile,UserIDX);
|
||||||
|
Inc(Counter);
|
||||||
|
IF NOT (UserIDX.Deleted) AND (Pos(UserName,UserIDX.Name) <> 0) AND ((NOT UserIDX.RealName) OR (CoSysOp)) THEN
|
||||||
|
IF ((UserIDX.Name = UserName) OR (CoSysOp AND (UserIDX.Name = UserName))) AND (UserIDX.number <= (MaxUsers - 1)) THEN
|
||||||
|
UserNum := UserIDX.Number
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Asked) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Asked := TRUE;
|
||||||
|
END;
|
||||||
|
Prompt('^1Did you mean ^3'+Caps(UserIDX.Name)+'^1? ');
|
||||||
|
OneK(Cmd,'QYN'^M,TRUE,TRUE);
|
||||||
|
Done := TRUE;
|
||||||
|
CASE Cmd OF
|
||||||
|
'Q' : UserNum := -1;
|
||||||
|
'Y' : UserNum := UserIDX.Number;
|
||||||
|
ELSE
|
||||||
|
Done := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(UserIDXFile);
|
||||||
|
IF (UserNum = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('User not found.');
|
||||||
|
END;
|
||||||
|
IF (UserNum = -1) THEN
|
||||||
|
UserNum := 0;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChangeARFlags(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
MenuOption := AllCaps(MenuOption);
|
||||||
|
FOR Counter := 1 TO (Length(MenuOption) - 1) DO
|
||||||
|
CASE MenuOption[Counter] OF
|
||||||
|
'+' : IF (MenuOption[Counter + 1] IN ['A'..'Z']) THEN
|
||||||
|
Include(ThisUser.AR,MenuOption[Counter + 1]);
|
||||||
|
'-' : IF (MenuOption[Counter + 1] IN ['A'..'Z']) THEN
|
||||||
|
Exclude(ThisUser.AR,MenuOption[Counter + 1]);
|
||||||
|
'!' : IF (MenuOption[Counter + 1] IN ['A'..'Z']) THEN
|
||||||
|
ToggleARFlag((MenuOption[Counter + 1]),ThisUser.AR,Changed);
|
||||||
|
END;
|
||||||
|
NewCompTables;
|
||||||
|
Update_Screen;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChangeACFlags(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
MenuOption := AllCaps(MenuOption);
|
||||||
|
FOR Counter := 1 TO (Length(MenuOption) - 1) DO
|
||||||
|
CASE MenuOption[Counter] OF
|
||||||
|
'+' : Include(ThisUser.Flags,TACCH(MenuOption[Counter + 1]));
|
||||||
|
'-' : Exclude(ThisUser.Flags,TACCH(MenuOption[Counter + 1]));
|
||||||
|
'!' : ToggleACFlags(MenuOption[Counter + 1],ThisUser.Flags,Changed);
|
||||||
|
END;
|
||||||
|
NewCompTables;
|
||||||
|
Update_Screen;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FindUser(VAR UserNum: Integer);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
TempUserName: Str36;
|
||||||
|
TempUserNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
UserNum := 0;
|
||||||
|
TempUserName := '';
|
||||||
|
Input(TempUserName,36);
|
||||||
|
IF (TempUserName = 'NEW') THEN
|
||||||
|
BEGIN
|
||||||
|
UserNum := -1;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (TempUserName = '?') THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (Pos(' ',TempUserName) <> 0) DO
|
||||||
|
Delete(TempUserName,Pos(' ',TempUserName),1);
|
||||||
|
WHILE (TempUserName[1] = ' ') AND (Length(TempUserName) > 0) DO
|
||||||
|
Delete(TempUserName,1,1);
|
||||||
|
IF (TempUserName = '') OR (HangUp) THEN
|
||||||
|
Exit;
|
||||||
|
UserNum := StrToInt(TempUserName);
|
||||||
|
IF (UserNum <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (UserNum < 0) OR (UserNum > (MaxUsers - 1)) THEN
|
||||||
|
UserNum := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,UserNum);
|
||||||
|
IF (Deleted IN User.SFlags) THEN
|
||||||
|
UserNum := 0;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE IF (TempUserName <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
TempUserNum := SearchUser(TempUserName,TRUE);
|
||||||
|
IF (TempUserNum <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,TempUserNum);
|
||||||
|
IF (NOT (Deleted IN User.SFlags)) THEN
|
||||||
|
UserNum := TempUserNum
|
||||||
|
ELSE
|
||||||
|
UserNum := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertIndex(Uname: AStr; UserNum: Integer; IsReal,IsDeleted: Boolean);
|
||||||
|
VAR
|
||||||
|
UserIDX: UserIDXRec;
|
||||||
|
Current,
|
||||||
|
InsertAt: Integer;
|
||||||
|
SFO,
|
||||||
|
Done: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE WriteIndex;
|
||||||
|
BEGIN
|
||||||
|
WITH UserIDX DO
|
||||||
|
BEGIN
|
||||||
|
FillChar(UserIDX,SizeOf(UserIDX),0);
|
||||||
|
Name := Uname;
|
||||||
|
Number := UserNum;
|
||||||
|
RealName := IsReal;
|
||||||
|
Deleted := IsDeleted;
|
||||||
|
Left := -1;
|
||||||
|
Right := -1;
|
||||||
|
Write(UserIDXFile,UserIDX);
|
||||||
|
END
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
Uname := AllCaps(Uname);
|
||||||
|
Current := 0;
|
||||||
|
SFO := (FileRec(UserIDXFile).Mode <> FMClosed);
|
||||||
|
IF (NOT SFO) THEN
|
||||||
|
Reset(UserIDXFile);
|
||||||
|
IF (FileSize(UserIDXFile) = 0) THEN
|
||||||
|
WriteIndex
|
||||||
|
ELSE
|
||||||
|
REPEAT
|
||||||
|
Seek(UserIDXFile,Current);
|
||||||
|
InsertAt := Current;
|
||||||
|
Read(UserIDXFile,UserIDX);
|
||||||
|
IF (Uname < UserIDX.Name) THEN
|
||||||
|
Current := UserIDX.Left
|
||||||
|
ELSE IF (Uname > UserIDX.Name) THEN
|
||||||
|
Current := UserIDX.Right
|
||||||
|
ELSE IF (UserIDX.Deleted <> IsDeleted) THEN
|
||||||
|
BEGIN
|
||||||
|
Done := TRUE;
|
||||||
|
UserIDX.Deleted := IsDeleted;
|
||||||
|
UserIDX.RealName := IsReal;
|
||||||
|
UserIDX.Number := UserNum;
|
||||||
|
Seek(UserIDXFile,Current);
|
||||||
|
Write(UserIDXFile,UserIDX);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (UserNum <> UserIDX.Number) THEN
|
||||||
|
SysOpLog('Note: Duplicate user '+UName+' #'+IntToStr(UserIDX.Number)+' and '+UName+' #'+IntToStr(UserNum))
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
UserIDX.RealName := FALSE;
|
||||||
|
Seek(UserIDXFile,Current); { Make it be his handle IF it's BOTH }
|
||||||
|
Write(UserIDXFile,UserIDX);
|
||||||
|
END;
|
||||||
|
Done := TRUE;
|
||||||
|
END;
|
||||||
|
UNTIL (Current = -1) OR (Done);
|
||||||
|
IF (Current = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Uname < UserIDX.Name) THEN
|
||||||
|
UserIDX.Left := FileSize(UserIDXFile)
|
||||||
|
ELSE
|
||||||
|
UserIDX.Right := FileSize(UserIDXFile);
|
||||||
|
Seek(UserIDXFile,InsertAt);
|
||||||
|
Write(UserIDXFile,UserIDX);
|
||||||
|
Seek(UserIDXFile,FileSize(UserIDXFile));
|
||||||
|
WriteIndex;
|
||||||
|
END;
|
||||||
|
IF (NOT SFO) THEN
|
||||||
|
Close(UserIDXFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,242 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT MsgPack;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE DoShowPackMessageAreas;
|
||||||
|
PROCEDURE PackMessageAreas;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Mail0;
|
||||||
|
|
||||||
|
PROCEDURE PackMessageArea(FN: Astr; 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 OhShit;
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('Error renaming temp files while packing.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
NeedPack := FALSE;
|
||||||
|
FN := AllCaps(FN);
|
||||||
|
FN := General.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;
|
||||||
|
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
Assign(BrdF2,FN+'.DA1');
|
||||||
|
ReWrite(BrdF2,1);
|
||||||
|
|
||||||
|
Assign(MsgHdrF2,FN+'.HD2');
|
||||||
|
ReWrite(MsgHdrF2);
|
||||||
|
|
||||||
|
Kill(FN+'.HD3');
|
||||||
|
Kill(FN+'.DA3');
|
||||||
|
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
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);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(i);
|
||||||
|
END;
|
||||||
|
|
||||||
|
LastError := IOResult;
|
||||||
|
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
|
||||||
|
OhShit;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
|
||||||
|
ReName(BrdF2,FN+'.DAT'); { ReName .DA2 to .DAT }
|
||||||
|
|
||||||
|
IF (IOResult <> 0) THEN { Didn't work, abort }
|
||||||
|
BEGIN
|
||||||
|
OhShit;
|
||||||
|
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
|
||||||
|
OhShit;
|
||||||
|
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
|
||||||
|
OhShit;
|
||||||
|
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);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DoShowPackMessageAreas;
|
||||||
|
VAR
|
||||||
|
TempBoard: MessageAreaRecordType;
|
||||||
|
MArea: Integer;
|
||||||
|
BEGIN
|
||||||
|
TempPause := FALSE;
|
||||||
|
SysOpLog('Packed all message areas');
|
||||||
|
NL;
|
||||||
|
Star('Packing all message areas');
|
||||||
|
NL;
|
||||||
|
Print('^1Packing ^5Private Mail');
|
||||||
|
PackMessageArea('EMAIL',0);
|
||||||
|
Reset(MsgAreaFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Exit;
|
||||||
|
Abort := FALSE;
|
||||||
|
FOR MArea := 0 TO (FileSize(MsgAreaFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MsgAreaFile,MArea);
|
||||||
|
Read(MsgAreaFile,TempBoard);
|
||||||
|
Print('^1Packing ^5'+TempBoard.Name+'^5 #'+IntToStr(MArea + 1));
|
||||||
|
PackMessageArea(TempBoard.FIleName,TempBoard.MaxMsgs);
|
||||||
|
WKey;
|
||||||
|
IF (Abort) THEN
|
||||||
|
Break;
|
||||||
|
END;
|
||||||
|
Close(MsgAreaFile);
|
||||||
|
lil := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PackMessageAreas;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Pack all message areas? ',0,FALSE) THEN
|
||||||
|
DoShowPackMessageAreas
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InitMsgArea(MsgArea);
|
||||||
|
SysOpLog('Packed message area ^5'+MemMsgArea.Name);
|
||||||
|
NL;
|
||||||
|
Print('^1Packing ^5'+MemMsgArea.Name+'^5 #'+IntToStr(CompMsgArea(MsgArea,0)));
|
||||||
|
PackMessageArea(MemMsgArea.FIleName,MemMsgArea.MaxMsgs);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,708 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R+,S-,V-}
|
||||||
|
|
||||||
|
UNIT MyIO;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
AStr = STRING[160];
|
||||||
|
WindowRec = ARRAY[0..8000] OF Byte;
|
||||||
|
ScreenType = ARRAY [0..3999] OF Byte;
|
||||||
|
Infield_Special_Function_Proc_Rec = PROCEDURE(c: Char);
|
||||||
|
|
||||||
|
CONST
|
||||||
|
Infield_Seperators: SET OF Char = [' ','\','.'];
|
||||||
|
|
||||||
|
Infield_Only_Allow_On: BOOLEAN = FALSE;
|
||||||
|
Infield_Arrow_Exit: BOOLEAN = FALSE;
|
||||||
|
Infield_Arrow_Exited: BOOLEAN = FALSE;
|
||||||
|
Infield_Arrow_Exited_Keep: BOOLEAN = FALSE;
|
||||||
|
Infield_Special_Function_On: BOOLEAN = FALSE;
|
||||||
|
Infield_Arrow_Exit_TypeDefs: BOOLEAN = FALSE;
|
||||||
|
Infield_Normal_Exit_Keydefs: BOOLEAN = FALSE;
|
||||||
|
Infield_Normal_Exited: BOOLEAN = FALSE;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
Wind: WindowRec;
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
MonitorType: Byte ABSOLUTE $0000:$0449;
|
||||||
|
ScreenAddr: ScreenType ABSOLUTE $B800:$0000;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
MonitorType: Byte = 3; // REENOTE 3=CO80, a safe assumption I think
|
||||||
|
{$ENDIF}
|
||||||
|
ScreenSize: Integer;
|
||||||
|
MaxDisplayRows,
|
||||||
|
MaxDisplayCols,
|
||||||
|
Infield_Out_FGrd,
|
||||||
|
Infield_Out_BkGd,
|
||||||
|
Infield_Inp_FGrd,
|
||||||
|
Infield_Inp_BkGd,
|
||||||
|
Infield_Last_Arrow,
|
||||||
|
Infield_Last_Normal: Byte;
|
||||||
|
Infield_Special_Function_Proc: infield_special_function_proc_rec;
|
||||||
|
Infield_Only_Allow,
|
||||||
|
Infield_Special_Function_Keys,
|
||||||
|
Infield_Arrow_Exit_Types,
|
||||||
|
Infield_Normal_Exit_Keys: STRING;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
PROCEDURE Update_Logo(VAR Addr1,Addr2; BlkLen: Integer);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
procedure Update_Logo(Data: Array of Char; OriginX, OriginY, DataLength: integer);
|
||||||
|
{$ENDIF}
|
||||||
|
PROCEDURE CursorOn(b: BOOLEAN);
|
||||||
|
PROCEDURE infield1(x,y: Byte; VAR s: AStr; Len: Byte);
|
||||||
|
PROCEDURE Infielde(VAR s: AStr; Len: Byte);
|
||||||
|
PROCEDURE Infield(VAR s: AStr; Len: Byte);
|
||||||
|
FUNCTION l_yn: BOOLEAN;
|
||||||
|
FUNCTION l_pynq(CONST s: AStr): BOOLEAN;
|
||||||
|
PROCEDURE CWrite(CONST s: AStr);
|
||||||
|
PROCEDURE CWriteAt(x,y: Integer; CONST s: AStr);
|
||||||
|
FUNCTION CStringLength(CONST s: AStr): Integer;
|
||||||
|
PROCEDURE cwritecentered(y: Integer; CONST s: AStr);
|
||||||
|
PROCEDURE Box(LineType,TLX,TLY,BRX,BRY: Integer);
|
||||||
|
PROCEDURE SaveScreen(VAR Wind: WindowRec);
|
||||||
|
PROCEDURE RemoveWindow(VAR Wind: WindowRec);
|
||||||
|
PROCEDURE SetWindow(VAR Wind: WindowRec; TLX,TLY,BRX,BRY,TColr,BColr,BoxType: Integer);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
,RPScreen
|
||||||
|
,VpSysLow
|
||||||
|
{$ENDIF}
|
||||||
|
;
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
VAR
|
||||||
|
SavedScreen: TScreenBuf;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
PROCEDURE CursorOn(b: BOOLEAN); ASSEMBLER;
|
||||||
|
ASM
|
||||||
|
cmp b, 1
|
||||||
|
je @turnon
|
||||||
|
mov ch, 9
|
||||||
|
mov cl, 0
|
||||||
|
jmp @goforit
|
||||||
|
@turnon:
|
||||||
|
mov ch, 6
|
||||||
|
mov cl, 7
|
||||||
|
@goforit:
|
||||||
|
mov ah,1
|
||||||
|
int 10h
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
PROCEDURE CursorOn(b: BOOLEAN);
|
||||||
|
BEGIN
|
||||||
|
if (b) then
|
||||||
|
begin
|
||||||
|
RPShowCursor;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
RPHideCursor;
|
||||||
|
end;
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
PROCEDURE infield1(x,y: Byte; VAR s: AStr; Len: Byte);
|
||||||
|
VAR
|
||||||
|
SaveS: AStr;
|
||||||
|
c: Char;
|
||||||
|
SaveTextAttr,
|
||||||
|
SaveX,
|
||||||
|
SaveY: Byte;
|
||||||
|
i,
|
||||||
|
p,
|
||||||
|
z: Integer;
|
||||||
|
Ins,
|
||||||
|
Done,
|
||||||
|
NoKeyYet: BOOLEAN;
|
||||||
|
|
||||||
|
PROCEDURE gocpos;
|
||||||
|
BEGIN
|
||||||
|
GoToXY(x + p - 1,y);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Exit_W_Arrow;
|
||||||
|
VAR
|
||||||
|
i: Integer;
|
||||||
|
BEGIN
|
||||||
|
Infield_Arrow_Exited := TRUE;
|
||||||
|
Infield_Last_Arrow := Ord(c);
|
||||||
|
Done := TRUE;
|
||||||
|
IF (Infield_Arrow_Exited_Keep) THEN
|
||||||
|
BEGIN
|
||||||
|
z := Len;
|
||||||
|
FOR i := Len DOWNTO 1 DO
|
||||||
|
IF (s[i] = ' ') THEN
|
||||||
|
Dec(z)
|
||||||
|
ELSE
|
||||||
|
i := 1;
|
||||||
|
s[0] := chr(z);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
s := SaveS;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Exit_W_Normal;
|
||||||
|
VAR
|
||||||
|
i: Integer;
|
||||||
|
BEGIN
|
||||||
|
Infield_Normal_Exited := TRUE;
|
||||||
|
Infield_Last_Normal := Ord(c);
|
||||||
|
Done := TRUE;
|
||||||
|
IF (Infield_Arrow_Exited_Keep) THEN
|
||||||
|
BEGIN
|
||||||
|
z := Len;
|
||||||
|
FOR i := Len DOWNTO 1 DO
|
||||||
|
IF (s[i] = ' ') THEN
|
||||||
|
Dec(z)
|
||||||
|
ELSE
|
||||||
|
i := 1;
|
||||||
|
s[0] := chr(z);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
s := SaveS;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveTextAttr := TextAttr;
|
||||||
|
SaveX := WhereX;
|
||||||
|
SaveY := WhereY;
|
||||||
|
SaveS := s;
|
||||||
|
Ins := FALSE;
|
||||||
|
Done := FALSE;
|
||||||
|
Infield_Arrow_Exited := FALSE;
|
||||||
|
GoToXY(x,y);
|
||||||
|
TextAttr := (Infield_Inp_BkGd * 16) + Infield_Inp_FGrd;
|
||||||
|
FOR i := 1 TO Len DO
|
||||||
|
Write(' ');
|
||||||
|
FOR i := (Length(s) + 1) TO Len DO
|
||||||
|
s[i] := ' ';
|
||||||
|
GoToXY(x,y);
|
||||||
|
Write(s);
|
||||||
|
p := 1;
|
||||||
|
gocpos;
|
||||||
|
NoKeyYet := TRUE;
|
||||||
|
REPEAT
|
||||||
|
REPEAT
|
||||||
|
c := ReadKey
|
||||||
|
UNTIL ((NOT Infield_Only_Allow_On) OR
|
||||||
|
(Pos(c,Infield_Special_Function_Keys) <> 0) OR
|
||||||
|
(Pos(c,Infield_Normal_Exit_Keys) <> 0) OR
|
||||||
|
(Pos(c,Infield_Only_Allow) <> 0) OR (c = #0));
|
||||||
|
|
||||||
|
IF ((Infield_Normal_Exit_Keydefs) AND
|
||||||
|
(Pos(c,Infield_Normal_Exit_Keys) <> 0)) THEN
|
||||||
|
Exit_W_Normal;
|
||||||
|
|
||||||
|
IF ((Infield_Special_Function_On) AND
|
||||||
|
(Pos(c,Infield_Special_Function_Keys) <> 0)) THEN
|
||||||
|
Infield_Special_Function_Proc(c)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (NoKeyYet) THEN
|
||||||
|
BEGIN
|
||||||
|
NoKeyYet := FALSE;
|
||||||
|
IF (c IN [#32..#255]) THEN
|
||||||
|
BEGIN
|
||||||
|
GoToXY(x,y);
|
||||||
|
FOR i := 1 TO Len DO
|
||||||
|
BEGIN
|
||||||
|
Write(' ');
|
||||||
|
s[i] := ' ';
|
||||||
|
END;
|
||||||
|
GoToXY(x,y);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
CASE c OF
|
||||||
|
#0 : BEGIN
|
||||||
|
c := ReadKey;
|
||||||
|
IF ((Infield_Arrow_Exit) AND (Infield_Arrow_Exit_TypeDefs) AND
|
||||||
|
(Pos(c,Infield_Arrow_Exit_Types) <> 0)) THEN
|
||||||
|
Exit_W_Arrow
|
||||||
|
ELSE
|
||||||
|
CASE c OF
|
||||||
|
#72,#80 :
|
||||||
|
IF (Infield_Arrow_Exit) THEN
|
||||||
|
Exit_W_Arrow;
|
||||||
|
#75 : IF (p > 1) THEN
|
||||||
|
Dec(p);
|
||||||
|
#77 : IF (p < Len + 1) THEN
|
||||||
|
Inc(p);
|
||||||
|
#71 : p := 1;
|
||||||
|
#79 : BEGIN
|
||||||
|
z := 1;
|
||||||
|
FOR i := Len DOWNTO 2 DO
|
||||||
|
IF ((s[i - 1] <> ' ') AND (z = 1)) THEN
|
||||||
|
z := i;
|
||||||
|
IF (s[z] = ' ') THEN
|
||||||
|
p := z
|
||||||
|
ELSE
|
||||||
|
p := Len + 1;
|
||||||
|
END;
|
||||||
|
#82 : Ins := NOT Ins;
|
||||||
|
#83 : IF (p <= Len) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR i := p TO (Len - 1) DO
|
||||||
|
BEGIN
|
||||||
|
s[i] := s[i + 1];
|
||||||
|
Write(s[i]);
|
||||||
|
END;
|
||||||
|
s[Len] := ' ';
|
||||||
|
Write(' ');
|
||||||
|
END;
|
||||||
|
#115 : IF (p > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
i := (p - 1);
|
||||||
|
WHILE ((NOT (s[i - 1] IN Infield_Seperators)) OR
|
||||||
|
(s[i] IN Infield_Seperators)) AND (i > 1) DO
|
||||||
|
Dec(i);
|
||||||
|
p := i;
|
||||||
|
END;
|
||||||
|
#116 : IF (p <= Len) THEN
|
||||||
|
BEGIN
|
||||||
|
i := p + 1;
|
||||||
|
WHILE ((NOT (s[i-1] IN Infield_Seperators)) OR
|
||||||
|
(s[i] IN Infield_Seperators)) AND (i <= Len) DO
|
||||||
|
Inc(i);
|
||||||
|
p := i;
|
||||||
|
END;
|
||||||
|
#117 : IF (p <= Len) THEN
|
||||||
|
FOR i := p TO Len DO
|
||||||
|
BEGIN
|
||||||
|
s[i] := ' ';
|
||||||
|
Write(' ');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
gocpos;
|
||||||
|
END;
|
||||||
|
#27 : BEGIN
|
||||||
|
s := SaveS;
|
||||||
|
Done := TRUE;
|
||||||
|
END;
|
||||||
|
#13 : BEGIN
|
||||||
|
Done := TRUE;
|
||||||
|
z := Len;
|
||||||
|
FOR i := Len DOWNTO 1 DO
|
||||||
|
IF (s[i] = ' ') THEN
|
||||||
|
Dec(z)
|
||||||
|
ELSE
|
||||||
|
i := 1;
|
||||||
|
s[0] := chr(z);
|
||||||
|
END;
|
||||||
|
#8 : IF (p <> 1) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(p);
|
||||||
|
s[p] := ' ';
|
||||||
|
gocpos;
|
||||||
|
Write(' ');
|
||||||
|
gocpos;
|
||||||
|
END;
|
||||||
|
ELSE
|
||||||
|
IF ((c IN [#32..#255]) AND (p <= Len)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((Ins) AND (p <> Len)) THEN
|
||||||
|
BEGIN
|
||||||
|
Write(' ');
|
||||||
|
FOR i := Len DOWNTO (p + 1) DO
|
||||||
|
s[i] := s[i - 1];
|
||||||
|
FOR i := (p + 1) TO Len DO
|
||||||
|
Write(s[i]);
|
||||||
|
gocpos;
|
||||||
|
END;
|
||||||
|
Write(c);
|
||||||
|
s[p] := c;
|
||||||
|
Inc(p);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Done);
|
||||||
|
GoToXY(x,y);
|
||||||
|
TextAttr := (Infield_Out_BkGd * 16) + Infield_Out_FGrd;
|
||||||
|
FOR i := 1 TO Len DO
|
||||||
|
Write(' ');
|
||||||
|
GoToXY(x,y);
|
||||||
|
Write(s);
|
||||||
|
GoToXY(SaveX,SaveY);
|
||||||
|
TextAttr := SaveTextAttr;
|
||||||
|
Infield_Only_Allow_On := FALSE;
|
||||||
|
Infield_Special_Function_On := FALSE;
|
||||||
|
Infield_Normal_Exit_Keydefs := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Infielde(VAR s: AStr; Len: Byte);
|
||||||
|
BEGIN
|
||||||
|
infield1(WhereX,WhereY,s,Len);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Infield(VAR S: AStr; Len: Byte);
|
||||||
|
BEGIN
|
||||||
|
S := '';
|
||||||
|
Infielde(S,Len);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION l_yn: BOOLEAN;
|
||||||
|
VAR
|
||||||
|
C: Char;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
C := UpCase(ReadKey)
|
||||||
|
UNTIL (C IN ['Y','N',#13,#27]);
|
||||||
|
IF (C = 'Y') THEN
|
||||||
|
BEGIN
|
||||||
|
l_yn := TRUE;
|
||||||
|
WriteLn('Yes');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
l_yn := FALSE;
|
||||||
|
WriteLn('No');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION l_pynq(CONST S: AStr): BOOLEAN;
|
||||||
|
BEGIN
|
||||||
|
TextColor(4);
|
||||||
|
Write(S);
|
||||||
|
TextColor(11);
|
||||||
|
l_pynq := l_yn;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CWrite(CONST S: AStr);
|
||||||
|
VAR
|
||||||
|
C: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
LastB,
|
||||||
|
LastC: BOOLEAN;
|
||||||
|
BEGIN
|
||||||
|
LastB := FALSE;
|
||||||
|
LastC := FALSE;
|
||||||
|
FOR Counter := 1 TO Length(S) DO
|
||||||
|
BEGIN
|
||||||
|
C := S[Counter];
|
||||||
|
IF ((LastB) OR (LastC)) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (LastB) THEN
|
||||||
|
TextBackGround(Ord(C))
|
||||||
|
ELSE IF (LastC) THEN
|
||||||
|
TextColor(Ord(C));
|
||||||
|
LastB := FALSE;
|
||||||
|
LastC := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
CASE C OF
|
||||||
|
#2 : LastB := TRUE;
|
||||||
|
#3 : LastC := TRUE;
|
||||||
|
ELSE
|
||||||
|
Write(C);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CWriteAt(x,y: Integer; CONST s: AStr);
|
||||||
|
BEGIN
|
||||||
|
GoToXY(x,y);
|
||||||
|
CWrite(s);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION CStringLength(CONST s: AStr): Integer;
|
||||||
|
VAR
|
||||||
|
Len,
|
||||||
|
i: Integer;
|
||||||
|
BEGIN
|
||||||
|
Len := Length(s);
|
||||||
|
i := 1;
|
||||||
|
WHILE (i <= Length(s)) DO
|
||||||
|
BEGIN
|
||||||
|
IF ((s[i] = #2) OR (s[i] = #3)) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Len,2);
|
||||||
|
Inc(i);
|
||||||
|
END;
|
||||||
|
Inc(i);
|
||||||
|
END;
|
||||||
|
CStringLength := Len;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE cwritecentered(y: Integer; CONST s: AStr);
|
||||||
|
BEGIN
|
||||||
|
CWriteAt(40 - (CStringLength(s) DIV 2),y,s);
|
||||||
|
END;
|
||||||
|
|
||||||
|
{*
|
||||||
|
* ÚÄÄÄ¿ ÉÍÍÍ» °°°°° ±±±±± ²²²²² ÛÛÛÛÛ ÖÄÄÄ· ÕÍÍ͸
|
||||||
|
* ³ 1 ³ º 2 º ° 3 ° ± 4 ± ² 5 ² Û 6 Û º 7 º ³ 8 ³
|
||||||
|
* ÀÄÄÄÙ ÈÍÍͼ °°°°° ±±±±± ²²²²² ÛÛÛÛÛ ÓÄÄĽ ÔÍÍ;
|
||||||
|
*}
|
||||||
|
PROCEDURE Box(LineType,TLX,TLY,BRX,BRY: Integer);
|
||||||
|
VAR
|
||||||
|
TL,TR,BL,BR,HLine,VLine: Char;
|
||||||
|
i: Integer;
|
||||||
|
BEGIN
|
||||||
|
Window(1,1,MaxDisplayCols,MaxDisplayRows);
|
||||||
|
CASE LineType OF
|
||||||
|
1 : BEGIN
|
||||||
|
TL := #218;
|
||||||
|
TR := #191;
|
||||||
|
BL := #192;
|
||||||
|
BR := #217;
|
||||||
|
VLine := #179;
|
||||||
|
HLine := #196;
|
||||||
|
END;
|
||||||
|
2 : BEGIN
|
||||||
|
TL := #201;
|
||||||
|
TR := #187;
|
||||||
|
BL := #200;
|
||||||
|
BR := #188;
|
||||||
|
VLine := #186;
|
||||||
|
HLine := #205;
|
||||||
|
END;
|
||||||
|
3 : BEGIN
|
||||||
|
TL := #176;
|
||||||
|
TR := #176;
|
||||||
|
BL := #176;
|
||||||
|
BR := #176;
|
||||||
|
VLine := #176;
|
||||||
|
HLine := #176;
|
||||||
|
END;
|
||||||
|
4 : BEGIN
|
||||||
|
TL := #177;
|
||||||
|
TR := #177;
|
||||||
|
BL := #177;
|
||||||
|
BR := #177;
|
||||||
|
VLine := #177;
|
||||||
|
HLine := #177;
|
||||||
|
END;
|
||||||
|
5 : BEGIN
|
||||||
|
TL := #178;
|
||||||
|
TR := #178;
|
||||||
|
BL := #178;
|
||||||
|
BR := #178;
|
||||||
|
VLine := #178;
|
||||||
|
HLine := #178;
|
||||||
|
END;
|
||||||
|
6 : BEGIN
|
||||||
|
TL := #219;
|
||||||
|
TR := #219;
|
||||||
|
BL := #219;
|
||||||
|
BR := #219;
|
||||||
|
VLine := #219;
|
||||||
|
HLine := #219;
|
||||||
|
END;
|
||||||
|
7 : BEGIN
|
||||||
|
TL := #214;
|
||||||
|
TR := #183;
|
||||||
|
BL := #211;
|
||||||
|
BR := #189;
|
||||||
|
VLine := #186;
|
||||||
|
HLine := #196;
|
||||||
|
END;
|
||||||
|
8 : BEGIN
|
||||||
|
TL := #213;
|
||||||
|
TR := #184;
|
||||||
|
BL := #212;
|
||||||
|
BR := #190;
|
||||||
|
VLine := #179;
|
||||||
|
HLine := #205;
|
||||||
|
END;
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TL := #32;
|
||||||
|
TR := #32;
|
||||||
|
BL := #32;
|
||||||
|
BR := #32;
|
||||||
|
VLine := #32;
|
||||||
|
HLine := #32;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
GoToXY(TLX,TLY);
|
||||||
|
Write(TL);
|
||||||
|
GoToXY(BRX,TLY);
|
||||||
|
Write(TR);
|
||||||
|
GoToXY(TLX,BRY);
|
||||||
|
Write(BL);
|
||||||
|
GoToXY(BRX,BRY);
|
||||||
|
Write(BR);
|
||||||
|
FOR i := (TLX + 1) TO (BRX - 1) DO
|
||||||
|
BEGIN
|
||||||
|
GoToXY(i,TLY);
|
||||||
|
Write(HLine);
|
||||||
|
END;
|
||||||
|
FOR i := (TLX + 1) TO (BRX - 1) DO
|
||||||
|
BEGIN
|
||||||
|
GoToXY(i,BRY);
|
||||||
|
Write(HLine);
|
||||||
|
END;
|
||||||
|
FOR i := (TLY + 1) TO (BRY - 1) DO
|
||||||
|
BEGIN
|
||||||
|
GoToXY(TLX,i);
|
||||||
|
Write(VLine);
|
||||||
|
END;
|
||||||
|
FOR i := (TLY + 1) TO (BRY - 1) DO
|
||||||
|
BEGIN
|
||||||
|
GoToXY(BRX,I);
|
||||||
|
Write(VLine);
|
||||||
|
END;
|
||||||
|
IF (LineType > 0) THEN
|
||||||
|
Window((TLX + 1),(TLY + 1),(BRX - 1),(BRY - 1))
|
||||||
|
ELSE
|
||||||
|
Window(TLX,TLY,BRX,BRY);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SaveScreen(VAR Wind: WindowRec);
|
||||||
|
BEGIN
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Move(ScreenAddr[0],Wind[0],ScreenSize);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
RPSaveScreen(SavedScreen);
|
||||||
|
{$ENDIF}
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE RemoveWindow(VAR Wind: WindowRec);
|
||||||
|
BEGIN
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Move(Wind[0],ScreenAddr[0],ScreenSize);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
RPRestoreScreen(SavedScreen);
|
||||||
|
{$ENDIF}
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SetWindow(VAR Wind: WindowRec; TLX,TLY,BRX,BRY,TColr,BColr,BoxType:Integer);
|
||||||
|
BEGIN
|
||||||
|
SaveScreen(Wind); { save under Window }
|
||||||
|
Window(TLX,TLY,BRX,BRY); { SET Window size }
|
||||||
|
TextColor(TColr);
|
||||||
|
TextBackGround(BColr);
|
||||||
|
ClrScr; { clear window for action }
|
||||||
|
Box(BoxType,TLX,TLY,BRX,BRY); { Set the border }
|
||||||
|
END;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
PROCEDURE Update_Logo(VAR Addr1,Addr2; BlkLen: Integer);
|
||||||
|
BEGIN
|
||||||
|
INLINE (
|
||||||
|
$1E/
|
||||||
|
$C5/$B6/ADDR1/
|
||||||
|
$C4/$BE/ADDR2/
|
||||||
|
$8B/$8E/BLKLEN/
|
||||||
|
$E3/$5B/
|
||||||
|
$8B/$D7/
|
||||||
|
$33/$C0/
|
||||||
|
$FC/
|
||||||
|
$AC/
|
||||||
|
$3C/$20/
|
||||||
|
$72/$05/
|
||||||
|
$AB/
|
||||||
|
$E2/$F8/
|
||||||
|
$EB/$4C/
|
||||||
|
$3C/$10/
|
||||||
|
$73/$07/
|
||||||
|
$80/$E4/$F0/
|
||||||
|
$0A/$E0/
|
||||||
|
$EB/$F1/
|
||||||
|
$3C/$18/
|
||||||
|
$74/$13/
|
||||||
|
$73/$19/
|
||||||
|
$2C/$10/
|
||||||
|
$02/$C0/
|
||||||
|
$02/$C0/
|
||||||
|
$02/$C0/
|
||||||
|
$02/$C0/
|
||||||
|
$80/$E4/$8F/
|
||||||
|
$0A/$E0/
|
||||||
|
$EB/$DA/
|
||||||
|
$81/$C2/$A0/$00/
|
||||||
|
$8B/$FA/
|
||||||
|
$EB/$D2/
|
||||||
|
$3C/$1B/
|
||||||
|
$72/$07/
|
||||||
|
$75/$CC/
|
||||||
|
$80/$F4/$80/
|
||||||
|
$EB/$C7/
|
||||||
|
$3C/$19/
|
||||||
|
$8B/$D9/
|
||||||
|
$AC/
|
||||||
|
$8A/$C8/
|
||||||
|
$B0/$20/
|
||||||
|
$74/$02/
|
||||||
|
$AC/
|
||||||
|
$4B/
|
||||||
|
$32/$ED/
|
||||||
|
$41/
|
||||||
|
$F3/$AB/
|
||||||
|
$8B/$CB/
|
||||||
|
$49/
|
||||||
|
$E0/$AA/
|
||||||
|
$1F);
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
procedure Update_Logo(Data: Array of Char; OriginX, OriginY, DataLength: integer);
|
||||||
|
var
|
||||||
|
i, x, y, count, counter: Integer;
|
||||||
|
character: Char;
|
||||||
|
spaces: String;
|
||||||
|
begin
|
||||||
|
i := 0;
|
||||||
|
x := OriginX;
|
||||||
|
y := OriginY;
|
||||||
|
spaces := ' '; // 80 spaces
|
||||||
|
|
||||||
|
while (i < DataLength) do
|
||||||
|
begin
|
||||||
|
case Data[i] of
|
||||||
|
#0..#15: begin
|
||||||
|
TextColor(Ord(Data[i]));
|
||||||
|
end;
|
||||||
|
#16..#23: begin
|
||||||
|
TextBackground(Ord(Data[i]) - 16);
|
||||||
|
end;
|
||||||
|
#24: begin
|
||||||
|
x := OriginX;
|
||||||
|
Inc(y);
|
||||||
|
end;
|
||||||
|
#25: begin
|
||||||
|
Inc(i);
|
||||||
|
count := Ord(Data[i])+1;
|
||||||
|
SysWrtCharStrAtt(@spaces[1], count, x-1, y-1, TextAttr);
|
||||||
|
Inc(x, count);
|
||||||
|
end;
|
||||||
|
#26: begin
|
||||||
|
Inc(i);
|
||||||
|
count := Ord(Data[i])+1;
|
||||||
|
Inc(i);
|
||||||
|
character := Data[i];
|
||||||
|
for counter := 1 to count do
|
||||||
|
begin
|
||||||
|
SysWrtCharStrAtt(@Data[i], 1, x-1, y-1, TextAttr);
|
||||||
|
Inc(x);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
#27: begin
|
||||||
|
TextAttr := TextAttr XOR $80; // Invert blink flag
|
||||||
|
end;
|
||||||
|
#32..#255: begin
|
||||||
|
SysWrtCharStrAtt(@Data[i], 1, x-1, y-1, TextAttr);
|
||||||
|
Inc(x);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,284 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT NewUsers;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE NewUser;
|
||||||
|
PROCEDURE NewUserInit;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
CUser,
|
||||||
|
EMail,
|
||||||
|
Mail0,
|
||||||
|
Menus,
|
||||||
|
MiscUser,
|
||||||
|
Script,
|
||||||
|
SysOp2G,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE NewUser;
|
||||||
|
VAR
|
||||||
|
Letter: Text;
|
||||||
|
User: UserRecordType;
|
||||||
|
UserIDX: UserIDXRec;
|
||||||
|
MHeader: MHeaderRec;
|
||||||
|
TempStr: STRING;
|
||||||
|
Cmd,
|
||||||
|
NewMenuCmd: AStr;
|
||||||
|
NewUserPassword: Str20;
|
||||||
|
SaveMenu,
|
||||||
|
PasswordAttemps,
|
||||||
|
CmdToExec: Byte;
|
||||||
|
Counter,
|
||||||
|
Counter1,
|
||||||
|
TempNewApp: Integer;
|
||||||
|
CmdNotHid,
|
||||||
|
CmdExists,
|
||||||
|
Done: Boolean;
|
||||||
|
BEGIN
|
||||||
|
SL1('* New user logon');
|
||||||
|
|
||||||
|
UserNum := 0;
|
||||||
|
|
||||||
|
Update_Node(RGNoteStr(36,TRUE){'New user logging on'},TRUE);
|
||||||
|
|
||||||
|
UserNum := -1;
|
||||||
|
|
||||||
|
IF (General.NewUserPW <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
PasswordAttemps := 0;
|
||||||
|
NewUserPassword := '';
|
||||||
|
WHILE ((NewUserPassword <> General.NewUserPW) AND (PasswordAttemps < General.MaxLogonTries) AND (NOT HangUp)) DO
|
||||||
|
BEGIN
|
||||||
|
(*
|
||||||
|
Prt(FString.NewUserPassword);
|
||||||
|
*)
|
||||||
|
RGMainStr(10,FALSE);
|
||||||
|
GetPassword(NewUserPassword,20);
|
||||||
|
IF ((NewUserPassword <> '') AND (General.NewUserPW <> NewUserPassword)) THEN
|
||||||
|
BEGIN
|
||||||
|
(*
|
||||||
|
Print('Invalid password, keep trying ...');
|
||||||
|
*)
|
||||||
|
RGNoteStr(38,FALSE);
|
||||||
|
SL1('* Invalid new user password: '+NewUserPassword);
|
||||||
|
Inc(PasswordAttemps);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (PasswordAttemps >= General.MaxLogonTries) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('NUPWFAIL');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
(*
|
||||||
|
Print('You have exceeded the maximum new user logon attempts, hanging up ...');
|
||||||
|
*)
|
||||||
|
RGNoteStr(39,FALSE);
|
||||||
|
SL1('* Maximum new user logon attempts exceeded - hung user up.');
|
||||||
|
HangUp := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('NEWUSER');
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= 20) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (General.NewUserToggles[Counter] <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Update_Screen;
|
||||||
|
CStuff(General.NewUserToggles[Counter],1,ThisUser);
|
||||||
|
END;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
|
||||||
|
SaveMenu := CurMenu;
|
||||||
|
CurMenu := General.NewUserInformationMenu;
|
||||||
|
LoadMenuPW;
|
||||||
|
AutoExecCmd('FIRSTCMD');
|
||||||
|
REPEAT
|
||||||
|
MainMenuHandle(Cmd);
|
||||||
|
NewMenuCmd := '';
|
||||||
|
CmdToExec := 0;
|
||||||
|
Done := FALSE;
|
||||||
|
REPEAT
|
||||||
|
FCmd(Cmd,CmdToExec,CmdExists,CmdNotHid);
|
||||||
|
IF (CmdToExec <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
DoMenuCommand(Done,
|
||||||
|
MemCmd^[CmdToExec].CmdKeys,
|
||||||
|
MemCmd^[CmdToExec].Options,
|
||||||
|
NewMenuCmd,
|
||||||
|
MemCmd^[CmdToExec].NodeActivityDesc);
|
||||||
|
|
||||||
|
IF (MemCmd^[CmdToExec].CmdKeys = 'OQ') THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
|
||||||
|
END;
|
||||||
|
UNTIL (CmdToExec = 0) OR (Done) OR (HangUp);
|
||||||
|
UNTIL (Abort) OR (Next) OR (HangUp);
|
||||||
|
CurMenu := SaveMenu;
|
||||||
|
NewMenuToLoad := TRUE;
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
END;
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
(*
|
||||||
|
Prompt('Saving your information ... ');
|
||||||
|
*)
|
||||||
|
RGNoteStr(40,FALSE);
|
||||||
|
SysOpLog('Saving new user information ...');
|
||||||
|
Counter1 := 0;
|
||||||
|
Counter := 1;
|
||||||
|
Reset(UserIDXFile);
|
||||||
|
WHILE (Counter <= (FileSize(UserIDXFile) - 1)) AND (Counter1 = 0) DO
|
||||||
|
BEGIN
|
||||||
|
Read(UserIDXFile,UserIDX);
|
||||||
|
IF (UserIDX.Deleted) THEN
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,UserIDX.Number);
|
||||||
|
IF (Deleted IN User.SFlags) THEN
|
||||||
|
Counter1 := UserIDX.Number;
|
||||||
|
END;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
Close(UserIDXFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (Counter1 > 0) THEN
|
||||||
|
UserNum := Counter1
|
||||||
|
ELSE
|
||||||
|
UserNum := MaxUsers;
|
||||||
|
WITH ThisUser DO
|
||||||
|
BEGIN
|
||||||
|
FirstOn := GetPackDateTime;
|
||||||
|
LastOn := FirstOn;
|
||||||
|
IF (CallerIDNumber <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
CallerID := CallerIDNumber;
|
||||||
|
Note := CallerID;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
|
||||||
|
AutoValidate(ThisUser,UserNum,'!');
|
||||||
|
|
||||||
|
InsertIndex(ThisUser.Name,UserNum,FALSE,FALSE);
|
||||||
|
InsertIndex(ThisUser.Realname,UserNum,TRUE,FALSE);
|
||||||
|
Inc(lTodayNumUsers);
|
||||||
|
SaveGeneral(TRUE);
|
||||||
|
(*
|
||||||
|
Print('^3Saved.');
|
||||||
|
*)
|
||||||
|
RGNoteStr(41,FALSE);
|
||||||
|
SysOpLog('Saved as user #'+IntToStr(UserNum));
|
||||||
|
UserOn := TRUE;
|
||||||
|
WasNewUser := TRUE;
|
||||||
|
END;
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
CLS;
|
||||||
|
IF ((Exist(General.MiscPath+'NEWUSER.INF')) OR (Exist(General.DataPath+'NEWUSER.INF'))) THEN
|
||||||
|
ReadQ('NEWUSER');
|
||||||
|
Update_Screen;
|
||||||
|
TempNewApp := -1;
|
||||||
|
IF (General.NewApp <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
TempNewApp := General.NewApp;
|
||||||
|
IF (TempNewApp < 1) OR (TempNewApp > (MaxUsers - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
SL1('* Invalid user number for New User Application: '+IntToStr(General.NewApp));
|
||||||
|
TempNewApp := 1;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (TempNewApp <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('NEWAPP');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
(*
|
||||||
|
Print('You must now send a new user application letter to the SysOp.');
|
||||||
|
*)
|
||||||
|
RGNoteStr(42,FALSE);
|
||||||
|
InResponseTo := '\'+#1+RGNoteStr(43,TRUE); { 'New User Application' }
|
||||||
|
MHeader.Status := [];
|
||||||
|
SeMail(TempNewApp,MHeader);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Exist(General.MiscPath+'NEWLET.ASC')) THEN
|
||||||
|
BEGIN
|
||||||
|
FillChar(MHeader,SizeOf(MHeader),0);
|
||||||
|
InitMsgArea(-1);
|
||||||
|
Reset(MsgHdrF);
|
||||||
|
Seek(MsgHdrF,FileSize(MsgHdrF));
|
||||||
|
Reset(MsgTxtF,1);
|
||||||
|
Seek(MsgTxtF,FileSize(MsgTxtF));
|
||||||
|
MHeader.Pointer := (FileSize(MsgTxtF) + 1);
|
||||||
|
MHeader.TextSize := 0;
|
||||||
|
Assign(Letter,General.MiscPath+'NEWLET.ASC');
|
||||||
|
Reset(Letter);
|
||||||
|
ReadLn(Letter,MHeader.From.A1S);
|
||||||
|
ReadLn(Letter,MHeader.Subject);
|
||||||
|
WITH MHeader DO
|
||||||
|
BEGIN
|
||||||
|
From.UserNum := TempNewApp;
|
||||||
|
MTO.UserNum := UserNum;
|
||||||
|
MTO.A1S := ThisUser.Name;
|
||||||
|
Date := GetPackDateTime;
|
||||||
|
Status := [AllowMCI];
|
||||||
|
END;
|
||||||
|
WHILE NOT EOF(Letter) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(Letter,TempStr);
|
||||||
|
Inc(MHeader.TextSize,(Length(TempStr) + 1));
|
||||||
|
BlockWrite(MsgTxtF,TempStr[0],(Length(TempStr) + 1));
|
||||||
|
END;
|
||||||
|
Close(Letter);
|
||||||
|
Close(MsgTxtF);
|
||||||
|
Write(MsgHdrF,MHeader);
|
||||||
|
Close(MsgHdrF);
|
||||||
|
LastError := IOResult;
|
||||||
|
ThisUser.Waiting := 1;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE NewUserInit;
|
||||||
|
BEGIN
|
||||||
|
IF (General.ClosedSystem) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('NONEWUSR');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
(*
|
||||||
|
Print('This BBS is currently not accepting new users, hanging up ...');
|
||||||
|
*)
|
||||||
|
RGNoteStr(32,FALSE);
|
||||||
|
SL1('* Attempted logon when BBS closed to new users - hung user up.');
|
||||||
|
HangUp := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LoadURec(ThisUser,0);
|
||||||
|
WITH ThisUser DO
|
||||||
|
BEGIN
|
||||||
|
FirstOn := GetPackDateTime;
|
||||||
|
LastOn := FirstOn;
|
||||||
|
END;
|
||||||
|
InitTrapFile;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,652 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Nodelist;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ToggleNetAttr(NetAttrT: NetAttr; VAR NetAttrS: NetAttribs);
|
||||||
|
PROCEDURE ToggleNetAttrs(C: CHAR; VAR NetAttrS: NetAttribs);
|
||||||
|
FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: SmallWord): Boolean;
|
||||||
|
PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point: SmallWord; var Fee: Word; GetFee: Boolean);
|
||||||
|
PROCEDURE ChangeFlags(VAR MsgHeader: MHeaderRec);
|
||||||
|
FUNCTION NetMail_Attr(NetAttribute: NetAttribs): AStr;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Mail0;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
CompProc = FUNCTION(VAR ALine,Desire; L: Char): Integer;
|
||||||
|
|
||||||
|
DATRec = RECORD
|
||||||
|
Zone, { Zone of board }
|
||||||
|
Net, { Net Address of board }
|
||||||
|
Node, { Node Address of board }
|
||||||
|
Point: SmallInt; { Either Point number OR 0 }
|
||||||
|
CallCost, { Cost to sysop to send }
|
||||||
|
MsgFee, { Cost to user to send }
|
||||||
|
NodeFlags: SmallWord; { Node flags }
|
||||||
|
ModemType, { Modem TYPE }
|
||||||
|
PassWord: STRING[9];
|
||||||
|
Phone,
|
||||||
|
BName,
|
||||||
|
CName,
|
||||||
|
SName: STRING[39];
|
||||||
|
BaudRate, { Highest Baud Rate }
|
||||||
|
RecSize: Byte; { Size of the Node on FILE }
|
||||||
|
END;
|
||||||
|
|
||||||
|
IndxRefBlk = RECORD
|
||||||
|
IndxOfs, { Offset of STRING into block }
|
||||||
|
IndxLen: SmallWord; { Length of STRING }
|
||||||
|
IndxData, { RECORD number of STRING }
|
||||||
|
IndxPtr: LongInt; { Block number of lower index }
|
||||||
|
END; { IndxRef }
|
||||||
|
|
||||||
|
LeafRefBlk = RECORD
|
||||||
|
KeyOfs, { Offset of STRING into block }
|
||||||
|
KeyLen: SmallWord; { Length of STRING }
|
||||||
|
KeyVal: LongInt; { Pointer to Data block }
|
||||||
|
END; { LeafRef }
|
||||||
|
|
||||||
|
CtlBlk = RECORD
|
||||||
|
CtlBlkSize: SmallWord; { blocksize of Index blocks }
|
||||||
|
CtlRoot, { Block number of Root }
|
||||||
|
CtlHiBlk, { Block number of last block }
|
||||||
|
CtlLoLeaf, { Block number of first leaf }
|
||||||
|
CtlHiLeaf, { Block number of last leaf }
|
||||||
|
CtlFree: LongInt; { Head of freelist }
|
||||||
|
CtlLvls, { Number of index levels }
|
||||||
|
CtlParity: SmallWord; { XOR of above fields }
|
||||||
|
END;
|
||||||
|
|
||||||
|
INodeBlk = RECORD
|
||||||
|
IndxFirst, { Pointer to next lower level }
|
||||||
|
IndxBLink, { Pointer to previous link }
|
||||||
|
IndxFLink: LongInt; { Pointer to next link }
|
||||||
|
IndxCnt: SmallInt; { Count of Items IN block }
|
||||||
|
IndxStr: SmallWord; { Offset IN block of 1st str }
|
||||||
|
{ IF IndxFirst is NOT -1, this is INode: }
|
||||||
|
IndxRef: ARRAY [0..49] OF IndxRefBlk;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LNodeBlk = RECORD
|
||||||
|
IndxFirst, { Pointer to next lower level }
|
||||||
|
IndxBLink, { Pointer to previous link }
|
||||||
|
IndxFLink: LongInt; { Pointer to next link }
|
||||||
|
IndxCnt: SmallInt; { Count of Items IN block }
|
||||||
|
IndxStr: SmallWord; { Offset IN block of 1st str }
|
||||||
|
LeafRef: ARRAY [0..49] OF LeafRefBlk;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleNetAttr(NetAttrT: NetAttr; VAR NetAttrS: NetAttribs);
|
||||||
|
BEGIN
|
||||||
|
IF (NetAttrT IN NetAttrS) THEN
|
||||||
|
Exclude(NetAttrS,NetAttrT)
|
||||||
|
ELSE
|
||||||
|
Include(NetAttrS,NetAttrT);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleNetAttrs(C: CHAR; VAR NetAttrS: NetAttribs);
|
||||||
|
BEGIN
|
||||||
|
CASE C OF
|
||||||
|
'C' : ToggleNetAttr(Crash,NetAttrS);
|
||||||
|
'H' : ToggleNetAttr(Hold,NetAttrS);
|
||||||
|
'I' : ToggleNetAttr(InTransit,NetAttrS);
|
||||||
|
'K' : ToggleNetAttr(KillSent,NetAttrS);
|
||||||
|
'L' : ToggleNetAttr(Local,NetAttrS);
|
||||||
|
'P' : ToggleNetAttr(Private,NetAttrS);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: SmallWord): Boolean;
|
||||||
|
BEGIN
|
||||||
|
GetNewAddr := FALSE;
|
||||||
|
Prt(DisplayStr);
|
||||||
|
MPL(MaxLen);
|
||||||
|
Input(DisplayStr,MaxLen);
|
||||||
|
IF (DisplayStr = '') OR (Pos('/',DisplayStr) = 0) THEN
|
||||||
|
Exit;
|
||||||
|
IF (Pos(':',DisplayStr) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Zone := StrToInt(Copy(DisplayStr,1,Pos(':',DisplayStr)));
|
||||||
|
DisplayStr := Copy(DisplayStr,Pos(':',DisplayStr)+1,Length(DisplayStr));
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Zone := 1;
|
||||||
|
IF (Pos('.',DisplayStr) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Point := StrToInt(Copy(DisplayStr,Pos('.',DisplayStr)+1,Length(DisplayStr)));
|
||||||
|
DisplayStr := Copy(DisplayStr,1,Pos('.',DisplayStr)-1);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Point := 0;
|
||||||
|
Net := StrToInt(Copy(DisplayStr,1,Pos('/',DisplayStr)));
|
||||||
|
Node := StrToInt(Copy(DisplayStr,Pos('/',DisplayStr)+1,Length(DisplayStr)));
|
||||||
|
GetNewAddr := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION NetMail_Attr(NetAttribute: NetAttribs): Astr;
|
||||||
|
VAR
|
||||||
|
s: AStr;
|
||||||
|
BEGIN
|
||||||
|
s := '';
|
||||||
|
IF (Local IN NetAttribute) THEN
|
||||||
|
s := 'Local ';
|
||||||
|
IF (Private IN NetAttribute) THEN
|
||||||
|
s := s + 'Private ';
|
||||||
|
IF (Crash IN NetAttribute) THEN
|
||||||
|
s := s + 'Crash ';
|
||||||
|
IF (FileAttach IN NetAttribute) THEN
|
||||||
|
s := s + 'FileAttach ';
|
||||||
|
IF (InTransit IN NetAttribute) THEN
|
||||||
|
s := s + 'InTransit ';
|
||||||
|
IF (KillSent IN NetAttribute) THEN
|
||||||
|
s := s + 'KillSent ';
|
||||||
|
IF (Hold IN NetAttribute) THEN
|
||||||
|
s := s + 'Hold ';
|
||||||
|
IF (FileRequest IN NetAttribute) THEN
|
||||||
|
s := s + 'File Request ';
|
||||||
|
IF (FileUpdateRequest IN NetAttribute) THEN
|
||||||
|
s := s + 'Update Request ';
|
||||||
|
NetMail_Attr := s;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION CompName(VAR ALine,Desire; L: Char): Integer;
|
||||||
|
VAR
|
||||||
|
Key,
|
||||||
|
Desired: STRING[36];
|
||||||
|
Len: Byte ABSOLUTE L;
|
||||||
|
BEGIN
|
||||||
|
Key[0] := L;
|
||||||
|
Desired[0] := L;
|
||||||
|
Move(ALine,Key[1],Len);
|
||||||
|
Move(Desire,Desired[1],Len);
|
||||||
|
IF (Key > Desired) THEN
|
||||||
|
CompName := 1
|
||||||
|
ELSE IF (Key < Desired) THEN
|
||||||
|
CompName := -1
|
||||||
|
ELSE
|
||||||
|
CompName := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION CompAddress(VAR ALine,Desire; L: Char): Integer;
|
||||||
|
TYPE
|
||||||
|
NodeType = RECORD
|
||||||
|
Zone,
|
||||||
|
Net,
|
||||||
|
Node,
|
||||||
|
Point: SmallWord;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Key: NodeType ABSOLUTE ALine;
|
||||||
|
Desired: NodeType ABSOLUTE Desire;
|
||||||
|
Count: Byte;
|
||||||
|
K: Integer;
|
||||||
|
BEGIN
|
||||||
|
Count := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(Count);
|
||||||
|
CASE Count OF
|
||||||
|
1 : Word(K) := Key.Zone - Desired.Zone;
|
||||||
|
2 : Word(K) := Key.Net - Desired.Net;
|
||||||
|
3 : Word(K) := Key.Node - Desired.Node;
|
||||||
|
4 : BEGIN
|
||||||
|
IF (L = #6) THEN
|
||||||
|
Key.Point := 0;
|
||||||
|
Word(K) := Key.Point - Desired.Point;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Count = 4) OR (K <> 0);
|
||||||
|
Compaddress := K;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point: SmallWord; var Fee: Word; GetFee: Boolean);
|
||||||
|
VAR
|
||||||
|
DataFile,
|
||||||
|
NDXFile: FILE;
|
||||||
|
s: STRING[36];
|
||||||
|
Location: LongInt;
|
||||||
|
Dat: DatRec;
|
||||||
|
Internet: Boolean;
|
||||||
|
|
||||||
|
FUNCTION FullNodeStr(NodeStr: AStr): STRING;
|
||||||
|
{ These constants are the defaults IF the user does NOT specify them }
|
||||||
|
CONST
|
||||||
|
DefZone = '1'; { Default Zone }
|
||||||
|
DefNet = '1'; { Default Net }
|
||||||
|
DefNode = '1'; { Default Node }
|
||||||
|
DefPoint = '0'; { Default Point }
|
||||||
|
BEGIN
|
||||||
|
IF (NodeStr[1] = '.') THEN
|
||||||
|
NodeStr := DefNode + NodeStr;
|
||||||
|
IF (Pos('/',NodeStr) = 0) THEN
|
||||||
|
IF (Pos(':',NodeStr) = 0) THEN
|
||||||
|
NodeStr := DefZone+':'+DefNet+'/'+NodeStr
|
||||||
|
ELSE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (NodeStr [1] = '/') THEN
|
||||||
|
NodeStr := DefNet + NodeStr;
|
||||||
|
IF (Pos(':',NodeStr) = 0) THEN
|
||||||
|
NodeStr := DefZone + ':' + NodeStr;
|
||||||
|
IF (NodeStr[Length(NodeStr)] = '/') THEN
|
||||||
|
NodeStr := NodeStr + DefNode;
|
||||||
|
END;
|
||||||
|
IF (Pos('.',NodeStr) = 0) THEN
|
||||||
|
NodeStr := NodeStr+'.'+DefPoint;
|
||||||
|
FullNodeStr := NodeStr;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION MakeAddress(Z,Nt,N,P: Word): STRING;
|
||||||
|
TYPE
|
||||||
|
NodeType = RECORD { A Node address TYPE }
|
||||||
|
Len: Byte;
|
||||||
|
Zone,
|
||||||
|
Net,
|
||||||
|
Node,
|
||||||
|
Point: SmallWord;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Address: NodeType;
|
||||||
|
S2: STRING ABSOLUTE Address;
|
||||||
|
BEGIN
|
||||||
|
WITH Address DO
|
||||||
|
BEGIN
|
||||||
|
Zone := Z;
|
||||||
|
Net := Nt;
|
||||||
|
Node := N;
|
||||||
|
Point := P;
|
||||||
|
Len := 8;
|
||||||
|
END;
|
||||||
|
MakeAddress := S2;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION MakeName(Name: AStr): STRING;
|
||||||
|
VAR
|
||||||
|
Temp: STRING[36];
|
||||||
|
Comma: STRING[2];
|
||||||
|
BEGIN
|
||||||
|
Temp := Caps(Name);
|
||||||
|
IF (Pos(' ', Name) > 0) THEN
|
||||||
|
Comma := ', '
|
||||||
|
ELSE
|
||||||
|
Comma := '';
|
||||||
|
MakeName := Copy(Temp, Pos(' ',Temp) + 1, Length(Temp) - Pos(' ',Temp))
|
||||||
|
+ Comma + Copy(Temp,1,Pos(' ',Temp) - 1) + #0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE UnPk(S1: STRING; VAR S2: STRING; Count: Byte);
|
||||||
|
CONST
|
||||||
|
UnWrk: ARRAY [0..38] OF Char = ' EANROSTILCHBDMUGPKYWFVJXZQ-''0123456789';
|
||||||
|
TYPE
|
||||||
|
CharType = RECORD
|
||||||
|
C1,
|
||||||
|
C2: Byte;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
U: CharType;
|
||||||
|
W1: Word ABSOLUTE U;
|
||||||
|
I,
|
||||||
|
J: Integer;
|
||||||
|
OBuf: ARRAY [0..2] OF Char;
|
||||||
|
Loc1,
|
||||||
|
Loc2: Byte;
|
||||||
|
BEGIN
|
||||||
|
S2 := '';
|
||||||
|
Loc1 := 1;
|
||||||
|
Loc2 := 1;
|
||||||
|
WHILE (Count > 0) DO
|
||||||
|
BEGIN
|
||||||
|
U.C1 := Ord(S1[Loc1]);
|
||||||
|
Inc(Loc1);
|
||||||
|
U.C2 := Ord(S1[Loc1]);
|
||||||
|
Inc(Loc1);
|
||||||
|
Count := Count - 2;
|
||||||
|
for J := 2 downto 0 DO
|
||||||
|
BEGIN
|
||||||
|
I := W1 MOD 40;
|
||||||
|
W1 := W1 DIV 40;
|
||||||
|
OBuf[J] := UnWrk[I];
|
||||||
|
END;
|
||||||
|
Move(OBuf,S2[Loc2],3);
|
||||||
|
Inc(Loc2,3);
|
||||||
|
END;
|
||||||
|
S2[0] := Chr(Loc2);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetData(VAR F1: FILE; SL: LongInt; VAR Dat: DATRec): Boolean;
|
||||||
|
TYPE
|
||||||
|
RealDATRec = RECORD
|
||||||
|
Zone, { Zone of board }
|
||||||
|
Net, { Net Address of board }
|
||||||
|
Node, { Node Address of board }
|
||||||
|
Point: SmallInt; { Either Point number OR 0 }
|
||||||
|
CallCost, { Cost to sysop to send }
|
||||||
|
MsgFee, { Cost to user to send }
|
||||||
|
NodeFlags: SmallWord; { Node flags }
|
||||||
|
ModemType, { Modem TYPE }
|
||||||
|
PhoneLen, { Length of Phone Number }
|
||||||
|
PassWordLen, { Length of Password }
|
||||||
|
BNameLen, { Length of Board Name }
|
||||||
|
SNameLen, { Length of Sysop Name }
|
||||||
|
CNameLen, { Length of City/State Name }
|
||||||
|
PackLen, { Length of Packed STRING }
|
||||||
|
Baud: Byte; { Highest Baud Rate }
|
||||||
|
Pack: ARRAY [1..160] of Char; { The Packed STRING }
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
Data: RealDATRec;
|
||||||
|
Error: Boolean;
|
||||||
|
UnPack: STRING[160];
|
||||||
|
BEGIN
|
||||||
|
Seek(F1,SL);
|
||||||
|
{ Read everything at once to keep disk access to a minimum }
|
||||||
|
BlockRead(F1,Data,SizeOf(Data));
|
||||||
|
Error := (IOResult <> 0);
|
||||||
|
IF (NOT Error) THEN
|
||||||
|
WITH Dat,Data DO
|
||||||
|
BEGIN
|
||||||
|
Move(Data,Dat,15);
|
||||||
|
Phone := Copy(Pack,1,PhoneLen);
|
||||||
|
PassWord := Copy(Pack,(PhoneLen + 1),PasswordLen);
|
||||||
|
Move(Pack[PhoneLen + PasswordLen + 1],Pack[1],PackLen);
|
||||||
|
UnPk(Pack,UnPack,PackLen);
|
||||||
|
BName := Caps(Copy(UnPack,1,BNameLen));
|
||||||
|
SName := Caps(Copy(Unpack,(BNameLen + 1),SNameLen));
|
||||||
|
CName := Caps(Copy(UnPack,BNameLen + SNameLen + 1,CNameLen));
|
||||||
|
BaudRate := Baud;
|
||||||
|
RecSize := (PhoneLen + PassWordLen + PackLen) + 22;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE Get7Node(VAR F: FILE; SL: LongInt; VAR Buf);
|
||||||
|
BEGIN
|
||||||
|
Seek(F,SL);
|
||||||
|
BlockRead(F,Buf,512);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Halt(1);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION BTree(VAR F1: FILE; Desired: AStr; Compare: CompProc): LongInt;
|
||||||
|
LABEL
|
||||||
|
Return;
|
||||||
|
VAR
|
||||||
|
Buf: ARRAY [0..511] OF Char; { These four variables all occupy }
|
||||||
|
CTL: CTLBlk ABSOLUTE Buf; { the same memory location. Total }
|
||||||
|
INode: INodeBlk ABSOLUTE Buf; { of 512 bytes. }
|
||||||
|
LNode: LNodeBlk ABSOLUTE Buf; { --------------------------------- }
|
||||||
|
NodeCTL: CTLBlk; { Store the CTL block seperately }
|
||||||
|
ALine: STRING[160]; { Address from NDX FILE }
|
||||||
|
J,
|
||||||
|
K,
|
||||||
|
L,Count: Integer; { Temp integers }
|
||||||
|
TP: Word; { Pointer to location IN BUF }
|
||||||
|
Rec, { A temp RECORD IN the FILE }
|
||||||
|
FRec: LongInt; { The RECORD when found OR NOT }
|
||||||
|
BEGIN
|
||||||
|
FRec := -1;
|
||||||
|
Get7Node(F1,0,Buf);
|
||||||
|
IF (CTL.CTLBlkSize = 0) THEN GOTO
|
||||||
|
Return;
|
||||||
|
Move(Buf,NodeCTL,SizeOf(CTL));
|
||||||
|
Get7Node(F1,NodeCTL.CtlRoot * NodeCTL.CtlBlkSize,Buf);
|
||||||
|
WHILE (INode.IndxFirst <> -1) AND (FRec = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Count := INode.IndxCnt;
|
||||||
|
IF (Count = 0) THEN GOTO
|
||||||
|
Return;
|
||||||
|
J := 0;
|
||||||
|
K := -1;
|
||||||
|
WHILE (J < Count) AND (K < 0) DO
|
||||||
|
BEGIN
|
||||||
|
TP := INode.IndxRef[J].IndxOfs;
|
||||||
|
L := INode.IndxRef[J].IndxLen;
|
||||||
|
{ ALine [0] := Chr (L); }
|
||||||
|
Move(Buf[TP],ALine[1],L);
|
||||||
|
K := Compare(ALine[1],Desired[1],Chr(L));
|
||||||
|
IF (K = 0) THEN
|
||||||
|
FRec := INode.IndxRef[J].IndxData
|
||||||
|
ELSE IF (K < 0) THEN
|
||||||
|
Inc(J);
|
||||||
|
END;
|
||||||
|
IF (FRec = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (J = 0) THEN
|
||||||
|
Rec := INode.IndxFirst
|
||||||
|
ELSE
|
||||||
|
Rec := INode.IndxRef[J - 1].IndxPtr;
|
||||||
|
Get7Node(F1,Rec * NodeCTL.CtlBlkSize,Buf);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (FRec = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Count := LNode.IndxCnt;
|
||||||
|
IF (Count <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
J := 0;
|
||||||
|
WHILE (J < Count) AND (FRec = -1) DO
|
||||||
|
BEGIN
|
||||||
|
TP := LNode.LeafRef[J].KeyOfs;
|
||||||
|
L := LNode.LeafRef[J].KeyLen;
|
||||||
|
{ ALine [0] := Chr (L); }
|
||||||
|
Move(Buf[TP],ALine[1],L);
|
||||||
|
K := Compare(ALine[1],Desired[1],Chr(L));
|
||||||
|
IF (K = 0) THEN
|
||||||
|
FRec := LNode.LeafRef[J].KeyVal;
|
||||||
|
Inc(J);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Return :
|
||||||
|
BTree := FRec;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION Pull(VAR S: STRING; C: Char): STRING;
|
||||||
|
VAR
|
||||||
|
I: Byte;
|
||||||
|
BEGIN
|
||||||
|
I := Pos(C,S);
|
||||||
|
Pull := Copy(S,1,(I - 1));
|
||||||
|
Delete(S,1,I);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Internet := FALSE;
|
||||||
|
IF NOT Exist(General.NodePath+'NODEX.DAT') OR
|
||||||
|
NOT Exist(General.NodePath+'SYSOP.NDX') OR
|
||||||
|
NOT Exist(General.NodePath+'NODEX.NDX') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (GetFee) THEN
|
||||||
|
BEGIN
|
||||||
|
Fee := 0;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Print('Enter name of intended receiver.');
|
||||||
|
Prt(':');
|
||||||
|
InputDefault(SysOpName,SysOpName,36,[CapWords],TRUE);
|
||||||
|
IF (SysOpName = '') THEN
|
||||||
|
Exit;
|
||||||
|
IF (Pos('@',SysOpName) > 0) THEN
|
||||||
|
IF (PYNQ('Is this an Internet message? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Internet := TRUE;
|
||||||
|
Zone := General.Aka[20].Zone;
|
||||||
|
Net := General.Aka[20].Net;
|
||||||
|
Node := General.Aka[20].Node;
|
||||||
|
Point := General.Aka[20].Point;
|
||||||
|
Fee := 0;
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
NL;
|
||||||
|
IF NOT GetNewAddr('Enter network address (^5Z^4:^5N^4/^5N^4.^5P^4 format): ',30,Zone,Net,Node,Point) THEN
|
||||||
|
Exit;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Assign(DataFile,General.NodePath+'NODEX.DAT');
|
||||||
|
IF (GetFee) THEN
|
||||||
|
BEGIN
|
||||||
|
s := IntToStr(Net)+'/'+IntToStr(Node);
|
||||||
|
IF (Zone > 0) THEN
|
||||||
|
s := IntToStr(Zone)+':'+s;
|
||||||
|
IF (Point > 0) THEN
|
||||||
|
s := s+'.'+IntToStr(Point);
|
||||||
|
s := FullNodeStr(s);
|
||||||
|
Assign(NDXFile,General.NodePath+'NODEX.NDX');
|
||||||
|
Reset(NDXFile,1);
|
||||||
|
Location := BTree(NDXFile,MakeAddress(StrToInt(Pull(S,':')),
|
||||||
|
StrToInt(Pull(S,'/')),StrToInt(Pull(S,'.')),
|
||||||
|
StrToInt(S)),Compaddress);
|
||||||
|
Close(NDXFile);
|
||||||
|
IF (Location <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(DataFile,1);
|
||||||
|
GetData(DataFile,Location,Dat);
|
||||||
|
Close(DataFile);
|
||||||
|
Fee := Dat.MsgFee;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
Fee := 0;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
s := SysOpName;
|
||||||
|
SysOpName := '';
|
||||||
|
Fee := 0;
|
||||||
|
REPEAT
|
||||||
|
Print('Enter a name, a Fidonet address, or an Internet address.');
|
||||||
|
Prt(':');
|
||||||
|
InputDefault(s,s,36,[],TRUE);
|
||||||
|
IF (s = '') THEN
|
||||||
|
Break;
|
||||||
|
IF (Pos('/',s) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
s := FullNodeStr(s);
|
||||||
|
Assign(NDXFile,General.NodePath+'NODEX.NDX');
|
||||||
|
Reset(NDXFile,1);
|
||||||
|
Location := BTree(NDXFile,MakeAddress(StrToInt(Pull(S,':')),StrToInt(Pull(S,'/')),StrToInt(Pull(S,'.')),StrToInt(S)),
|
||||||
|
Compaddress);
|
||||||
|
Close(NDXFile);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Assign(NDXFile,General.NodePath+'SYSOP.NDX');
|
||||||
|
Reset(NDXFile,1);
|
||||||
|
Location := BTree(NDXFile,MakeName(S),CompName);
|
||||||
|
Close(NDXFile);
|
||||||
|
END;
|
||||||
|
IF (Location <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(DataFile,1);
|
||||||
|
GetData(DataFile,Location,Dat);
|
||||||
|
Close(DataFile);
|
||||||
|
WITH Dat DO
|
||||||
|
BEGIN
|
||||||
|
Print('^1System: '+BName+' ('+IntToStr(Zone)+':'+IntToStr(Net)+'/'+IntToStr(Node)+')');
|
||||||
|
Print('SysOp : '+SName);
|
||||||
|
Print('Phone : '+Phone);
|
||||||
|
Print('Where : '+CName);
|
||||||
|
Print('Cost : '+IntToStr(MsgFee)+' credits');
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
IF (Dat.MsgFee > (ThisUser.lCredit - ThisUser.Debit)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('You do not have enough credit to netmail this Node!');
|
||||||
|
s := '';
|
||||||
|
END
|
||||||
|
ELSE IF PYNQ('Is this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpName := Dat.Sname;
|
||||||
|
Zone := Dat.Zone;
|
||||||
|
Net := Dat.Net;
|
||||||
|
Node := Dat.Node;
|
||||||
|
Point := 0;
|
||||||
|
Fee := Dat.MsgFee;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
s := '';
|
||||||
|
END
|
||||||
|
ELSE IF (Pos('@',s) > 0) THEN
|
||||||
|
IF (NOT PYNQ('Is this an Internet message? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('That name is not in the nodelist!'^M^J);
|
||||||
|
S := '';
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Internet := TRUE;
|
||||||
|
SysOpName := s;
|
||||||
|
Zone := General.Aka[20].Zone;
|
||||||
|
Net := General.Aka[20].Net;
|
||||||
|
Node := General.Aka[20].Node;
|
||||||
|
Point := General.Aka[20].Point;
|
||||||
|
Fee := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('That name is not in the nodelist!'^M^J);
|
||||||
|
S := '';
|
||||||
|
END
|
||||||
|
UNTIL (SysOpName <> '') OR (HangUp);
|
||||||
|
IF (NOT Internet) AND (Pos('/',s) = 0) AND (s <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Enter name of intended receiver.');
|
||||||
|
Prt(':');
|
||||||
|
InputDefault(SysOpName,SysOpName,36,[CapWords],FALSE);
|
||||||
|
IF (SysOpName = '') THEN
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChangeFlags(VAR MsgHeader: MHeaderRec);
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
BEGIN
|
||||||
|
IF (CoSysOp) AND (PYNQ('Change default netmail flags? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Cmd := #0;
|
||||||
|
NL;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('^4Current flags: ^5'+NetMail_Attr(MsgHeader.NetAttribute));
|
||||||
|
NL
|
||||||
|
END;
|
||||||
|
Prt('Flag to change: ');
|
||||||
|
OneK(Cmd,'QPCAIKHRLU?'^M,TRUE,TRUE);
|
||||||
|
IF (Cmd IN ['?']) THEN
|
||||||
|
NL;
|
||||||
|
WITH MsgHeader DO
|
||||||
|
CASE Cmd OF
|
||||||
|
'L' : ToggleNetAttr(Local,NetAttribute);
|
||||||
|
'U' : ToggleNetAttr(FileUpdateRequest,NetAttribute);
|
||||||
|
'R' : ToggleNetAttr(FileRequest,NetAttribute);
|
||||||
|
'H' : ToggleNetAttr(Hold,NetAttribute);
|
||||||
|
'K' : ToggleNetAttr(KillSent,NetAttribute);
|
||||||
|
'I' : ToggleNetAttr(InTransit,NetAttribute);
|
||||||
|
'A' : ToggleNetAttr(FileAttach,NetAttribute);
|
||||||
|
'C' : ToggleNetAttr(Crash,NetAttribute);
|
||||||
|
'P' : ToggleNetAttr(Private,NetAttribute);
|
||||||
|
'?' : BEGIN
|
||||||
|
LCmds3(15,3,'Private','Crash','Attached File');
|
||||||
|
LCmds3(15,3,'InTransit','KillSent','Hold');
|
||||||
|
LCmds3(15,3,'Req file','Update Req','Local');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd IN ['Q',^M]) OR (HangUp);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,320 @@
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
Unit OneLiner;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
Uses
|
||||||
|
Common,
|
||||||
|
Timefunc,
|
||||||
|
Mail1;
|
||||||
|
|
||||||
|
Type
|
||||||
|
OneLinerRecordType = {$IFDEF WIN32} Packed {$ENDIF} Record
|
||||||
|
RecordNum : LongInt;
|
||||||
|
OneLiner : String[55];
|
||||||
|
UserID : LongInt;
|
||||||
|
UserName : String[36];
|
||||||
|
DateAdded,
|
||||||
|
DateEdited : UnixTime;
|
||||||
|
Anonymous : Boolean;
|
||||||
|
End;
|
||||||
|
|
||||||
|
PROCEDURE DoOneLiners;
|
||||||
|
PROCEDURE OneLiner_Add;
|
||||||
|
PROCEDURE OneLiner_View;
|
||||||
|
FUNCTION OneLiner_Random : STRING;
|
||||||
|
FUNCTION ToLower( S : STRING ) : STRING;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
VAR
|
||||||
|
OneLinerListFile : FILE OF OneLinerRecordType;
|
||||||
|
OneLineRec : OneLinerRecordType;
|
||||||
|
|
||||||
|
FUNCTION ToLower( S : STRING ) : STRING;
|
||||||
|
VAR
|
||||||
|
i : BYTE;
|
||||||
|
BEGIN
|
||||||
|
FOR i := 1 TO Length(S) DO
|
||||||
|
BEGIN
|
||||||
|
IF S[i] IN ['A'..'Z'] THEN
|
||||||
|
S[i] := Chr(Ord(S[i]) + 32);
|
||||||
|
END;
|
||||||
|
ToLower := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION OneLinerListMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
|
||||||
|
VAR
|
||||||
|
OneLinerListPtr: ^OneLinerRecordType;
|
||||||
|
User: UserRecordType;
|
||||||
|
TmpStr : String;
|
||||||
|
BEGIN
|
||||||
|
OneLinerListPtr := Data1;
|
||||||
|
OneLinerListMCI := S;
|
||||||
|
CASE S[1] OF
|
||||||
|
'A' : CASE S[2] OF
|
||||||
|
'N' : OneLinerListMCI := ShowYesNo(OneLinerListPtr^.Anonymous); { Anon - Yes/No }
|
||||||
|
'T' : OneLinerListMCI := AonOff(OneLinerListPtr^.Anonymous, 'True', 'False'); { Anon - True/False }
|
||||||
|
END;
|
||||||
|
'D' : CASE S[2] OF
|
||||||
|
'A' : OneLinerListMCI := Pd2Date(OneLinerListPtr^.DateAdded); { Date Added }
|
||||||
|
'E' : OneLinerListMCI := Pd2Date(OneLinerListPtr^.DateEdited); { Date Edited - Not Used }
|
||||||
|
END;
|
||||||
|
'O' : CASE S[2] OF
|
||||||
|
'L' : OneLinerListMCI := OneLinerListPtr^.OneLiner; { The Oneliner }
|
||||||
|
END;
|
||||||
|
'R' : CASE S[2] OF
|
||||||
|
'N' : OneLinerListMCI := IntToStr(OneLinerListPtr^.RecordNum); { Oneliner Record Number }
|
||||||
|
END;
|
||||||
|
'U' : CASE S[2] OF
|
||||||
|
'#' : BEGIN { User ID }
|
||||||
|
IF (OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := '';
|
||||||
|
IF (OneLinerListPtr^.Anonymous) AND (SysOp) THEN
|
||||||
|
OneLinerListMCI := '#' + IntToStr(OneLinerListPtr^.UserID);
|
||||||
|
IF (NOT OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := '#' + IntToStr(OneLinerListPtr^.UserID);
|
||||||
|
END;
|
||||||
|
'1' : BEGIN { User ID Without # }
|
||||||
|
IF (OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := '';
|
||||||
|
IF (OneLinerListPtr^.Anonymous) AND (SysOp) THEN
|
||||||
|
OneLinerListMCI := IntToStr(OneLinerListPtr^.UserID);
|
||||||
|
IF (NOT OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := IntToStr(OneLinerListPtr^.UserID);
|
||||||
|
END;
|
||||||
|
'N' : BEGIN { User Name }
|
||||||
|
LoadURec(User,OneLinerListPtr^.UserID);
|
||||||
|
IF (OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := 'Anon';
|
||||||
|
IF (OneLinerListPtr^.Anonymous) AND (SysOp) THEN
|
||||||
|
OneLinerListMCI := Caps(User.Name) + ' ^4(^5A^4)';
|
||||||
|
IF (NOT OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := Caps(User.Name);
|
||||||
|
END;
|
||||||
|
'L' : BEGIN { User Name Lower }
|
||||||
|
LoadURec(User,OneLinerListPtr^.UserID);
|
||||||
|
IF (OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := 'anon';
|
||||||
|
IF (OneLinerListPtr^.Anonymous) AND (SysOp) THEN
|
||||||
|
OneLinerListMCI := ToLower(User.Name) + ' ^4(^5a^4)';
|
||||||
|
IF (NOT OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := ToLower(User.Name);
|
||||||
|
END;
|
||||||
|
'S' : BEGIN { User Name Short }
|
||||||
|
LoadURec(User,OneLinerListPtr^.UserID);
|
||||||
|
IF (OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := 'Anon';
|
||||||
|
IF (OneLinerListPtr^.Anonymous) AND (SysOp) THEN
|
||||||
|
OneLinerListMCI := Copy(User.Name,1,2) + ' ^4(^5A^4)';
|
||||||
|
IF (NOT OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := Copy(User.Name,1,2);
|
||||||
|
END;
|
||||||
|
'U' : BEGIN { User Name Short Lower }
|
||||||
|
LoadURec(User,OneLinerListPtr^.UserID);
|
||||||
|
IF (OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := 'anon';
|
||||||
|
IF (OneLinerListPtr^.Anonymous) AND (SysOp) THEN
|
||||||
|
OneLinerListMCI := ToLower(Copy(User.Name,1,2)) + ' ^4(^5a^4)';
|
||||||
|
IF (NOT OneLinerListPtr^.Anonymous) THEN
|
||||||
|
OneLinerListMCI := ToLower(Copy(User.Name,1,2));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION OneLinerList_Exists: Boolean;
|
||||||
|
VAR
|
||||||
|
OneLinerListFile: FILE OF OneLinerRecordType;
|
||||||
|
FSize: Longint;
|
||||||
|
FExist: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FSize := 0;
|
||||||
|
FExist := Exist(General.DataPath+'ONELINER.DAT');
|
||||||
|
IF (FExist) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(OneLinerListFile,General.DataPath+'ONELINER.DAT');
|
||||||
|
Reset(OneLinerListFile);
|
||||||
|
FSize := FileSize(OneLinerListFile);
|
||||||
|
Close(OneLinerListFile);
|
||||||
|
END;
|
||||||
|
IF (NOT FExist) OR (FSize = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
PrintF('ONELH');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
CLS; NL;
|
||||||
|
Print(Centre('^4' + General.BBSName + ' One Liners'));
|
||||||
|
Print(Centre('^5ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'));
|
||||||
|
END;
|
||||||
|
Print(' ^4There are currently no One Liners.');
|
||||||
|
NL;
|
||||||
|
PrintF('ONELE');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print(Centre('^5ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'));
|
||||||
|
|
||||||
|
SysOpLog('^5* The ONELINER.DAT file is missing.');
|
||||||
|
END;
|
||||||
|
OneLinerList_Exists := (FExist) AND (FSize <> 0);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayError(FName: ASTR; VAR FExists: Boolean);
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
PrintACR('|12ú |09The '+FName+'.* File is missing.');
|
||||||
|
PrintACR('|12ú |09Please, inform the Sysop!');
|
||||||
|
SysOpLog('The '+FName+'.* file is missing.');
|
||||||
|
FExists := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION OneLinerAddScreens_Exists: Boolean;
|
||||||
|
VAR
|
||||||
|
FExistsH,
|
||||||
|
FExistsM,
|
||||||
|
FExistsE: Boolean;
|
||||||
|
BEGIN
|
||||||
|
FExistsH := TRUE;
|
||||||
|
FExistsM := TRUE;
|
||||||
|
FExistsE := TRUE;
|
||||||
|
(*IF (NOT ReadBuffer('ONELH')) THEN
|
||||||
|
DisplayError('ONELH',FExistsH); *)
|
||||||
|
IF (NOT ReadBuffer('ONELM')) THEN
|
||||||
|
DisplayError('ONELM',FExistsM);
|
||||||
|
(*IF (NOT ReadBuffer('ONELE')) THEN
|
||||||
|
DisplayError('ONELE',FExistsE); *)
|
||||||
|
OneLinerAddScreens_Exists := (*(FExistsH) AND *)(FExistsM) (*AND (FExistsE)*);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Procedure AskOneLinerQuestions(VAR OneLinerList: OneLinerRecordType);
|
||||||
|
{Var MHeader : MHeaderRec; }
|
||||||
|
Begin
|
||||||
|
|
||||||
|
WHILE (NOT Abort) AND (NOT Hangup) DO
|
||||||
|
Begin
|
||||||
|
NL;
|
||||||
|
Print('^4 Enter your one liner');
|
||||||
|
Prt(' ^5:');
|
||||||
|
MPL(76);
|
||||||
|
InputMain(OneLinerList.OneLiner,(SizeOf(OneLinerList.OneLiner) - 1),[InterActiveEdit,ColorsAllowed]);
|
||||||
|
NL;
|
||||||
|
Abort := (OneLinerList.OneLiner = '');
|
||||||
|
IF (Abort) THEN
|
||||||
|
Exit
|
||||||
|
ELSE
|
||||||
|
OneLinerList.Anonymous := PYNQ('^4 Post Anonymous? ^5',0,FALSE);
|
||||||
|
Exit;
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
|
||||||
|
PROCEDURE OneLiner_Add;
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
OneLinerList: OneLinerRecordType;
|
||||||
|
BEGIN
|
||||||
|
IF (OneLinerAddScreens_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
OneLiner_View;
|
||||||
|
IF PYNQ('^4 Add a one liner? ^5',0, FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
FillChar(OneLinerList,SizeOf(OneLinerList),0);
|
||||||
|
AskOneLinerQuestions(OneLinerList);
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('ONELH');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
CLS; NL;
|
||||||
|
Print(Centre('^4' + General.BBSName + ' One Liners'));
|
||||||
|
Print(Centre('^5ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'));
|
||||||
|
END;
|
||||||
|
Print(' ^4'+OneLinerList.OneLiner);
|
||||||
|
PrintF('ONELE');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print(Centre('^5ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'));
|
||||||
|
NL;
|
||||||
|
IF (PYNQ('^4 Add this oneliner? ^5',0,TRUE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(OneLinerListFile,General.DataPath+'ONELINER.DAT');
|
||||||
|
IF (Exist(General.DataPath+'ONELINER.DAT')) THEN
|
||||||
|
Reset(OneLinerListFile)
|
||||||
|
ELSE
|
||||||
|
Rewrite(OneLinerListFile);
|
||||||
|
Seek(OneLinerListFile,FileSize(OneLinerListFile));
|
||||||
|
OneLinerList.UserID := UserNum;
|
||||||
|
OneLinerList.DateAdded := GetPackDateTime;
|
||||||
|
OneLinerList.DateEdited := OneLinerList.DateAdded;
|
||||||
|
OneLinerList.RecordNum := (FileSize(OneLinerListFile) + 1);
|
||||||
|
Write(OneLinerListFile,OneLinerList);
|
||||||
|
Close(OneLinerListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
|
||||||
|
SysOpLog('Added Oneliner : '+OneLinerList.OneLiner+'.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE OneLiner_View;
|
||||||
|
VAR
|
||||||
|
Data2: Pointer;
|
||||||
|
OneLinerList: OneLinerRecordType;
|
||||||
|
OnRec: Longint;
|
||||||
|
Cnt : Byte;
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
IF (OneLinerList_Exists) AND (OneLinerAddScreens_Exists) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(OneLinerListFile,General.DataPath+'ONELINER.DAT');
|
||||||
|
Reset(OneLinerListFile);
|
||||||
|
ReadBuffer('ONELM');
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
Abort := FALSE;
|
||||||
|
PrintF('ONELH');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
CLS; NL;
|
||||||
|
Print(Centre('^4' + General.BBSName + ' One Liners'));
|
||||||
|
Print(Centre('^5ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'));
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
OnRec := 1;
|
||||||
|
Cnt := (FileSize(OneLinerListFile));
|
||||||
|
{WHILE (OnRec <= FileSize(OneLinerListFile)) AND (NOT Abort) AND (NOT HangUp) DO}
|
||||||
|
|
||||||
|
FOR Cnt := (FileSize(OneLinerListFile)) DOWNTO 1 DO
|
||||||
|
BEGIN
|
||||||
|
Seek(OneLinerListFile,(Cnt-1));
|
||||||
|
Read(OneLinerListFile,OneLinerList);
|
||||||
|
DisplayBuffer(OneLinerListMCI,@OneLinerList,Data2);
|
||||||
|
Inc(OnRec);
|
||||||
|
IF ((OnRec-1) = 10) THEN
|
||||||
|
Break
|
||||||
|
ELSE
|
||||||
|
OnRec := OnRec;
|
||||||
|
END;
|
||||||
|
Close(OneLinerListFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
PrintF('ONELE');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print(Centre('^5ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'));
|
||||||
|
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
SysOpLog('^5* ^4'+ ThisUser.Name + '^5 Viewed the OneLiners.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Function OneLiner_Random : String;
|
||||||
|
Begin
|
||||||
|
|
||||||
|
End;
|
||||||
|
|
||||||
|
Procedure DoOneLiners; { To-Do : Variable Number of One Liners To Display }
|
||||||
|
Begin
|
||||||
|
OneLiner_Add;
|
||||||
|
End;
|
||||||
|
|
||||||
|
End.
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,586 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN64}
|
||||||
|
{$DEFINE WIN32}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{$M 35500,0,131072}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ R E N E G A D E }
|
||||||
|
{ =============== }
|
||||||
|
|
||||||
|
{$A+} { Align Data for faster execution }
|
||||||
|
{$B-} { Shortcut Boolean eval }
|
||||||
|
{$D+} { No Debug Info }
|
||||||
|
{$E-} { No Math-Co library }
|
||||||
|
{$F+} { Force Far Calls }
|
||||||
|
{$I-} { Disable I/O check }
|
||||||
|
{$L+} { Local Symbols, Ignored IF D-, don't need cause of D- }
|
||||||
|
{$N-} { No Math-Co use }
|
||||||
|
{$P+} { Allow OpenString }
|
||||||
|
{$O+} { Use Overlays? }
|
||||||
|
{$Q-} { No overflow check }
|
||||||
|
{$R-} { No range check }
|
||||||
|
{$S-} { Don't Check stack usage }
|
||||||
|
{$V-} { Variable string Length allowed }
|
||||||
|
{$X+} { Allow extended syntax }
|
||||||
|
|
||||||
|
PROGRAM Renegade;
|
||||||
|
|
||||||
|
USES
|
||||||
|
OverLay,
|
||||||
|
{ OvrUMB,}
|
||||||
|
Crt,
|
||||||
|
Dos,
|
||||||
|
Boot,
|
||||||
|
Common,
|
||||||
|
Common1,
|
||||||
|
Events,
|
||||||
|
File0,
|
||||||
|
File7,
|
||||||
|
File13,
|
||||||
|
Logon,
|
||||||
|
Mail0,
|
||||||
|
Maint,
|
||||||
|
Menus,
|
||||||
|
Menus2,
|
||||||
|
MsgPack,
|
||||||
|
MyIO,
|
||||||
|
NewUsers,
|
||||||
|
OffLine,
|
||||||
|
TimeFunc,
|
||||||
|
WfCMenu;
|
||||||
|
|
||||||
|
{$O MsgPack } {$O Common1 } {$O Common2 } {$O Common3 } {$O Boot }
|
||||||
|
{$O WfcMenu } {$O Timefunc } {$O Sysop1 } {$O Sysop2 } {$O Offline }
|
||||||
|
{$O Sysop2j } {$O Sysop2a } {$O Sysop2b } {$O Sysop2c } {$O Sysop2d }
|
||||||
|
{$O Sysop2e } {$O Sysop2f } {$O Sysop2l } {$O Sysop2g } {$O Sysop2i }
|
||||||
|
{$O Sysop2h } {$O File4 } {$O Sysop2k } {$O Sysop3 } {$O Sysop4 }
|
||||||
|
{$O Sysop6 } {$O Sysop7 } {$O Sysop7m } {$O Sysop8 } {$O Sysop2m }
|
||||||
|
{$O Sysop9 } {$O Sysop10 } {$O Sysop11 } {$O Mail0 } {$O Mail1 }
|
||||||
|
{$O Email } {$O Mail2 } {$O Mail3 } {$O Vote } {$O Nodelist }
|
||||||
|
{$O Mail4 } {$O Arcview } {$O File0 } {$O File1 } {$O File2 }
|
||||||
|
{$O File5 } {$O File6 } {$O File8 } {$O MultNode } {$O Script }
|
||||||
|
{$O File9 } {$O File10 } {$O File11 } {$O File12 } {$O File13 }
|
||||||
|
{$O File14 } {$O Archive1 } {$O Archive2 } {$O Archive3 } {$O Logon }
|
||||||
|
{$O Maint } {$O NewUsers } {$O TimeBank } {$O Bulletin } {$O MiscUser }
|
||||||
|
{$O ShortMsg } {$O CUser } {$O Doors } {$O ExecBat } {$O Automsg }
|
||||||
|
{$O MyIO } {$O Menus2 } {$O Menus3 } {$O LineChat } {$O Stats }
|
||||||
|
{$O Events } {$O BBSList } {$O Common4 } {$O File7 } {$O SplitCha }
|
||||||
|
{$O Sysop2o } {$O Sysop5 } {$O SysOp12 } {$O OneLiner }
|
||||||
|
|
||||||
|
CONST
|
||||||
|
NeedToHangUp: Boolean = FALSE;
|
||||||
|
BBSVersion: Astr = '1.20.1/'
|
||||||
|
{$IFDEF LINUX} + 'Linux'; {$ENDIF}
|
||||||
|
{$IFDEF WIN32} + 'Win32'; {$ENDIF}
|
||||||
|
{$IFDEF WIN64} + 'Win64'; {$ENDIF}
|
||||||
|
{$IFDEF MSDOS} + 'Dos16'; {$ENDIF}
|
||||||
|
|
||||||
|
VAR
|
||||||
|
ExitSave: Pointer;
|
||||||
|
GeneralF: FILE OF GeneralRecordType;
|
||||||
|
ByteFile: FILE OF Byte;
|
||||||
|
TextFile: Text;
|
||||||
|
S: Astr;
|
||||||
|
Counter: Byte;
|
||||||
|
Counter1: Integer;
|
||||||
|
BBSVersion: Astr;
|
||||||
|
|
||||||
|
PROCEDURE ErrorHandle;
|
||||||
|
VAR
|
||||||
|
TextFile: Text;
|
||||||
|
S: STRING[50];
|
||||||
|
BEGIN
|
||||||
|
ExitProc := ExitSave;
|
||||||
|
IF (ErrorAddr <> NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
CHDir(StartDir);
|
||||||
|
|
||||||
|
IF (General.Multinode) AND (ThisNode > 0) THEN
|
||||||
|
Assign(SysOpLogFile,TempDir+'TEMPLOG.'+IntToStr(ThisNode) )
|
||||||
|
ELSE
|
||||||
|
Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
|
||||||
|
Append(SysOpLogFile);
|
||||||
|
S := '^8*>>^7 Runtime error '+IntToStr(ExitCode)+' at '+DateStr+' '+TimeStr+ '^8 <<*^5'+' (Check ERROR.LOG)';
|
||||||
|
WriteLn(SysOpLogFile,S);
|
||||||
|
Flush(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
|
||||||
|
IF (TextRec(Trapfile).Mode = FMOutPut) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn(Trapfile,S);
|
||||||
|
Flush(Trapfile);
|
||||||
|
Close(Trapfile);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Assign(TextFile,'ERROR.LOG');
|
||||||
|
Append(TextFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
ReWrite(TextFile);
|
||||||
|
|
||||||
|
WriteLn(TextFile,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
|
||||||
|
WriteLn(TextFile,'Critical error Log file - Contains screen images at instant of error.');
|
||||||
|
WriteLn(TextFile,'The "²" character shows the cursor position at time of error.');
|
||||||
|
WriteLn(TextFile,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
|
||||||
|
WriteLn(TextFile);
|
||||||
|
WriteLn(TextFile);
|
||||||
|
WriteLn(TextFile,'¯>¯ error #'+IntToStr(ExitCode)+' at '+DateStr+' '+TimeStr+' version: '+General.Version);
|
||||||
|
|
||||||
|
IF (UserOn) THEN
|
||||||
|
BEGIN
|
||||||
|
Write(TextFile,'¯>¯ User "'+AllCaps(ThisUser.name)+' #'+IntToStr(UserNum)+'" was on ');
|
||||||
|
IF (ComPortSpeed > 0) THEN
|
||||||
|
WriteLn(TextFile,'at '+IntToStr(ActualSpeed)+ 'baud')
|
||||||
|
ELSE
|
||||||
|
WriteLn(TextFile,'Locally');
|
||||||
|
END;
|
||||||
|
Close(TextFile);
|
||||||
|
|
||||||
|
ScreenDump('ERROR.LOG');
|
||||||
|
|
||||||
|
Assign(TextFile,'CRITICAL.ERR');
|
||||||
|
ReWrite(TextFile);
|
||||||
|
Close(TextFile);
|
||||||
|
SetFAttr(TextFile,Dos.Hidden);
|
||||||
|
|
||||||
|
Print('^8System malfunction.');
|
||||||
|
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
Noder.Status := [];
|
||||||
|
Noder.User := 0;
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
|
||||||
|
Com_Flush_Send;
|
||||||
|
Dtr(FALSE);
|
||||||
|
Com_DeInstall;
|
||||||
|
|
||||||
|
Halt(ExitErrors);
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReadP;
|
||||||
|
VAR
|
||||||
|
d: astr;
|
||||||
|
Counter: Integer;
|
||||||
|
|
||||||
|
FUNCTION SC(s: astr; i: Integer): Char;
|
||||||
|
BEGIN
|
||||||
|
SC := UpCase(s[i]);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Reliable := FALSE;
|
||||||
|
Telnet := FALSE;
|
||||||
|
CallerIDNumber := '';
|
||||||
|
Counter := 0;
|
||||||
|
WHILE (Counter < ParamCount) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(Counter);
|
||||||
|
IF ((SC(ParamStr(Counter),1) = '-') OR (SC(ParamStr(Counter),1) = '/')) THEN
|
||||||
|
CASE SC(ParamStr(Counter),2) OF
|
||||||
|
'5' : TextMode(259);
|
||||||
|
'B' : AnswerBaud := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
'C' : Reliable := (Pos(AllCaps(Liner.Reliable),AllCaps(ParamStr(Counter))) > 0);
|
||||||
|
'D' : OvrUseEms := FALSE;
|
||||||
|
'E' : IF (Length(ParamStr(Counter)) >= 4) THEN
|
||||||
|
BEGIN
|
||||||
|
d := AllCaps(ParamStr(Counter));
|
||||||
|
CASE d[3] OF
|
||||||
|
'E' : ExitErrors := StrToInt(Copy(d,4,(Length(d) - 3)));
|
||||||
|
'N' : ExitNormal := StrToInt(Copy(d,4,(Length(d) - 3)));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'H' : SockHandle := Copy(ParamStr(Counter),3,255);
|
||||||
|
'I' : BEGIN
|
||||||
|
CASE SC(ParamStr(Counter),3) OF
|
||||||
|
'D' : CallerIDNumber := Copy(ParamStr(Counter),4,255);
|
||||||
|
'P' : CallerIDNumber := Copy(ParamStr(Counter),4,255);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'L' : LocalIOOnly := TRUE;
|
||||||
|
'M' : BEGIN
|
||||||
|
MakeQWKFor := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'N' : ThisNode := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
'P' : BEGIN
|
||||||
|
PackBasesOnly := TRUE;
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'Q' : QuitAfterDone := TRUE;
|
||||||
|
'S' : BEGIN
|
||||||
|
SortFilesOnly := TRUE;
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'F' : BEGIN
|
||||||
|
FileBBSOnly := TRUE;
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
IF (SC(ParamStr(Counter),3) <> 'C') THEN
|
||||||
|
HangUpTelnet := TRUE;
|
||||||
|
Telnet := TRUE;
|
||||||
|
END;
|
||||||
|
'U' : BEGIN
|
||||||
|
UpQWKFor := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'X' : ExtEventTime := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
AllowAbort := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
ClrScr;
|
||||||
|
TextColor(Yellow);
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
GetIntVec($14,Interrupt14);
|
||||||
|
{$ENDIF}
|
||||||
|
FileMode := 66;
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
FileModeReadWrite := FileMode;
|
||||||
|
{$ENDIF}
|
||||||
|
ExitSave := ExitProc;
|
||||||
|
ExitProc := @ErrorHandle;
|
||||||
|
|
||||||
|
DirectVideo := FALSE;
|
||||||
|
CheckSnow := FALSE;
|
||||||
|
|
||||||
|
UserOn := FALSE;
|
||||||
|
UserNum := 0;
|
||||||
|
|
||||||
|
GetDir(0,StartDir);
|
||||||
|
|
||||||
|
DatFilePath := GetEnv('RENEGADE');
|
||||||
|
IF (DatFilePath <> '') THEN
|
||||||
|
DatFilePath := BSlash(DatFilePath,TRUE);
|
||||||
|
Assign(ByteFile,DatFilePath+'RENEGADE.DAT');
|
||||||
|
Reset(ByteFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error opening RENEGADE.DAT.');
|
||||||
|
Halt;
|
||||||
|
END;
|
||||||
|
Counter := 0;
|
||||||
|
Seek(ByteFile,FileSize(ByteFile));
|
||||||
|
WHILE FileSize(ByteFile) < SizeOf(General) DO
|
||||||
|
Write(ByteFile,Counter);
|
||||||
|
Close(ByteFile);
|
||||||
|
|
||||||
|
Assign(GeneralF,DatFilePath+'RENEGADE.DAT');
|
||||||
|
Reset(GeneralF);
|
||||||
|
Read(GeneralF,General);
|
||||||
|
Close(GeneralF);
|
||||||
|
|
||||||
|
ReadP;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
OvrFileMode := 0;
|
||||||
|
Write('Initializing RENEGADE.OVR ... ');
|
||||||
|
OvrInit('RENEGADE.OVR');
|
||||||
|
IF (OvrResult <> OvrOK) THEN
|
||||||
|
OvrInit(General.DataPath+'RENEGADE.OVR');
|
||||||
|
IF (OvrResult <> OvrOK) THEN
|
||||||
|
BEGIN
|
||||||
|
CASE OvrResult OF
|
||||||
|
OvrError : WriteLn('Program has no overlays.');
|
||||||
|
OvrNotFound : WriteLn('Overlay file not found.');
|
||||||
|
END;
|
||||||
|
Halt;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
WriteLn('Done.');
|
||||||
|
|
||||||
|
IF (General.UseEMS) AND (OvrUseEms) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Write('Attempting to load overlays into XMS memory ... ');
|
||||||
|
|
||||||
|
{vrMovBufToUMB;}
|
||||||
|
|
||||||
|
IF (OvrResult <> OvrOK) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Failed.');
|
||||||
|
Write('Attempting to load overlays into EMS memory ... ');
|
||||||
|
OvrInitEMS;
|
||||||
|
IF (OvrResult = OvrOK) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Done.');
|
||||||
|
OverLayLocation := 1
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CASE OvrResult OF
|
||||||
|
OvrIOError : WriteLn('Overlay file I/O error.');
|
||||||
|
OvrNoEMSDriver : WriteLn('EMS driver not installed.');
|
||||||
|
OvrNoEMSMemory : WriteLn('Not enough EMS memory.');
|
||||||
|
END;
|
||||||
|
Halt;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Done.');
|
||||||
|
OverLayLocation := 2;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WriteLn('Initial size of the overlay buffer is '+FormatNumber(OvrGetBuf)+' bytes.');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Init;
|
||||||
|
|
||||||
|
MaxDisplayRows := (Hi(WindMax) + 1);
|
||||||
|
MaxDisplayCols := (Lo(WindMax) + 1);
|
||||||
|
ScreenSize := 2 * MaxDisplayRows * MaxDisplayCols;
|
||||||
|
IF (ScreenSize > 8000) THEN
|
||||||
|
ScreenSize := 8000;
|
||||||
|
|
||||||
|
IF (FileBBSOnly) OR (PackBasesOnly) OR (SortFilesOnly) OR (MakeQWKFor > 0) OR (UpQWKFor > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
WFCMDefine;
|
||||||
|
TempPause := FALSE;
|
||||||
|
IF (MakeQWKFor > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
UserNum := MakeQWKFor;
|
||||||
|
LoadURec(ThisUser,MakeQWKFor);
|
||||||
|
NewFileDate := ThisUser.LastOn;
|
||||||
|
Downloadpacket;
|
||||||
|
SaveURec(ThisUser,MakeQWKFor);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (UpQWKFor > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
UserNum := UpQWKFor;
|
||||||
|
LoadURec(ThisUser,UpQWKFor);
|
||||||
|
Uploadpacket(TRUE);
|
||||||
|
SaveURec(ThisUser,UpQWKFor);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (PackBasesOnly) THEN
|
||||||
|
BEGIN
|
||||||
|
DoShowPackMessageAreas;
|
||||||
|
NL;
|
||||||
|
Print('^5Message areas packed.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (SortFilesOnly) THEN
|
||||||
|
Sort;
|
||||||
|
|
||||||
|
IF (FileBBSOnly) THEN
|
||||||
|
CheckFilesBBS;
|
||||||
|
|
||||||
|
Halt(0);
|
||||||
|
END;
|
||||||
|
|
||||||
|
GetMem(MemCmd,MaxCmds * SizeOf(MemCmdRec));
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
IF (NeedToHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
NeedToHangUp := FALSE;
|
||||||
|
DoPhoneHangUp(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
WFCMenus;
|
||||||
|
|
||||||
|
UserOn := FALSE;
|
||||||
|
UserNum := 0;
|
||||||
|
|
||||||
|
IF (NOT DoneDay) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
lStatus_Screen(100,'User logging in.',FALSE,S);
|
||||||
|
|
||||||
|
LastScreenSwap := 0;
|
||||||
|
|
||||||
|
IF (GetUser) THEN
|
||||||
|
NewUser;
|
||||||
|
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NumBatchDLFiles := 0;
|
||||||
|
NumBatchULFiles := 0;
|
||||||
|
BatchDLPoints := 0;
|
||||||
|
BatchDLSize := 0;
|
||||||
|
BatchDLTime := 0;
|
||||||
|
|
||||||
|
LogonMaint;
|
||||||
|
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NewFileDate := ThisUser.LastOn;
|
||||||
|
|
||||||
|
IF (MsgAreaAC(ThisUser.LastMsgArea)) THEN
|
||||||
|
MsgArea := ThisUser.LastMsgArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO NumMsgAreas DO
|
||||||
|
IF (MsgAreaAC(Counter)) THEN
|
||||||
|
BEGIN
|
||||||
|
MsgArea := Counter;
|
||||||
|
Counter := NumMsgAreas;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (FileAreaAC(ThisUser.LastFileArea)) THEN
|
||||||
|
FileArea := ThisUser.LastFileArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO NumFileAreas DO
|
||||||
|
IF (FileAreaAC(Counter)) THEN
|
||||||
|
BEGIN
|
||||||
|
FileArea := Counter;
|
||||||
|
Counter := NumFileAreas;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NewCompTables;
|
||||||
|
|
||||||
|
MenuStackPtr := 0;
|
||||||
|
|
||||||
|
FOR Counter := 1 TO MaxMenus DO
|
||||||
|
MenuStack[Counter] := 0;
|
||||||
|
|
||||||
|
IF (Novice in ThisUser.Flags) THEN
|
||||||
|
CurHelpLevel := 2
|
||||||
|
ELSE
|
||||||
|
CurHelpLevel := 1;
|
||||||
|
|
||||||
|
GlobalCmds := 0;
|
||||||
|
NumCmds := 0;
|
||||||
|
CurMenu := 0;
|
||||||
|
FallBackMenu := 0;
|
||||||
|
|
||||||
|
IF (General.GlobalMenu <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := General.GlobalMenu;
|
||||||
|
LoadMenu;
|
||||||
|
GlobalCmds := NumCmds;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ThisUser.UserStartMenu = 0) THEN
|
||||||
|
CurMenu := General.AllStartMenu
|
||||||
|
ELSE
|
||||||
|
CurMenu := ThisUser.UserStartMenu;
|
||||||
|
|
||||||
|
LoadMenu;
|
||||||
|
|
||||||
|
AutoExecCmd('FIRSTCMD');
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
WHILE (NOT HangUp) DO
|
||||||
|
MenuExec;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (QuitAfterDone) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ExitErrorLevel = 0) THEN
|
||||||
|
ExitErrorLevel := ExitNormal;
|
||||||
|
HangUp := TRUE;
|
||||||
|
DoneDay := TRUE;
|
||||||
|
NeedToHangUp := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LogOffMaint;
|
||||||
|
|
||||||
|
IF (General.Multinode) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(TextFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
IF Exist(General.LogsPath+'SYSOP.LOG') THEN
|
||||||
|
Append(TextFile)
|
||||||
|
ELSE
|
||||||
|
ReWrite(TextFile);
|
||||||
|
Reset(SysOpLogFile);
|
||||||
|
WHILE NOT EOF(SysOpLogFile) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(SysOpLogFile,S);
|
||||||
|
WriteLn(TextFile,S);
|
||||||
|
END;
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
Close(TextFile);
|
||||||
|
ReWrite(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Com_Carrier) AND (NOT DoneDay) THEN
|
||||||
|
IF (InCom) THEN
|
||||||
|
NeedToHangUp := TRUE;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
UNTIL (DoneDay);
|
||||||
|
|
||||||
|
FreeMem(MemCmd,MaxCmds * SizeOf(MemCmdRec));
|
||||||
|
|
||||||
|
IF (MCIBuffer <> NIL) THEN
|
||||||
|
Dispose(MCIBuffer);
|
||||||
|
|
||||||
|
IF (MemEventArray[NumEvents] <> NIL) THEN
|
||||||
|
FOR Counter1 := 1 TO NumEvents DO
|
||||||
|
IF (MemEventArray[Counter1] <> NIL) THEN
|
||||||
|
Dispose(MemEventArray[Counter1]);
|
||||||
|
|
||||||
|
IF (NeedToHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (HangUpTelnet) THEN
|
||||||
|
DoTelnetHangUp(TRUE);
|
||||||
|
IF (NOT HangUpTelnet) THEN
|
||||||
|
DoPhoneHangUp(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (General.Multinode) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(TextFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
IF Exist(General.LogsPath+'SYSOP.LOG') THEN
|
||||||
|
Append(TextFile)
|
||||||
|
ELSE
|
||||||
|
ReWrite(TextFile);
|
||||||
|
Reset(SysOpLogFile);
|
||||||
|
WHILE NOT EOF(SysOpLogFile) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(SysOpLogFile,S);
|
||||||
|
WriteLn(TextFile,S);
|
||||||
|
END;
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
Close(TextFile);
|
||||||
|
ReWrite(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (General.Multinode) THEN
|
||||||
|
Kill(TempDir+'TEMPLOG.'+IntToStr(ThisNode));
|
||||||
|
|
||||||
|
Window(1,1,MaxDisplayCols,MaxDisplayRows);
|
||||||
|
TextBackGround(0);
|
||||||
|
TextColor(7);
|
||||||
|
ClrScr;
|
||||||
|
TextColor(14);
|
||||||
|
|
||||||
|
IF (NewEchoMail) AND (ExitErrorLevel = 0) THEN
|
||||||
|
ExitErrorLevel := 2;
|
||||||
|
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
Noder.Status := [];
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
|
||||||
|
PurgeDir(TempDir,FALSE);
|
||||||
|
|
||||||
|
Com_DeInstall;
|
||||||
|
|
||||||
|
WriteLn('Exiting with errorlevel ',ExitErrorLevel);
|
||||||
|
Halt(ExitErrorLevel);
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,580 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN64}
|
||||||
|
{$DEFINE WIN32}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{$M 35500,0,131072}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ R E N E G A D E }
|
||||||
|
{ =============== }
|
||||||
|
|
||||||
|
{$A+} { Align Data for faster execution }
|
||||||
|
{$B-} { Shortcut Boolean eval }
|
||||||
|
{$D+} { No Debug Info }
|
||||||
|
{$E-} { No Math-Co library }
|
||||||
|
{$F+} { Force Far Calls }
|
||||||
|
{$I-} { Disable I/O check }
|
||||||
|
{$L+} { Local Symbols, Ignored IF D-, don't need cause of D- }
|
||||||
|
{$N-} { No Math-Co use }
|
||||||
|
{$P+} { Allow OpenString }
|
||||||
|
{$O+} { Use Overlays? }
|
||||||
|
{$Q-} { No overflow check }
|
||||||
|
{$R-} { No range check }
|
||||||
|
{$S-} { Don't Check stack usage }
|
||||||
|
{$V-} { Variable string Length allowed }
|
||||||
|
{$X+} { Allow extended syntax }
|
||||||
|
|
||||||
|
PROGRAM Renegade;
|
||||||
|
|
||||||
|
USES
|
||||||
|
OverLay,
|
||||||
|
{ OvrUMB,}
|
||||||
|
Crt,
|
||||||
|
Dos,
|
||||||
|
Boot,
|
||||||
|
Common,
|
||||||
|
Common1,
|
||||||
|
Events,
|
||||||
|
File0,
|
||||||
|
File7,
|
||||||
|
File13,
|
||||||
|
Logon,
|
||||||
|
Mail0,
|
||||||
|
Maint,
|
||||||
|
Menus,
|
||||||
|
Menus2,
|
||||||
|
MsgPack,
|
||||||
|
MyIO,
|
||||||
|
NewUsers,
|
||||||
|
OffLine,
|
||||||
|
TimeFunc,
|
||||||
|
WfCMenu;
|
||||||
|
|
||||||
|
{$O MsgPack } {$O Common1 } {$O Common2 } {$O Common3 } {$O Boot }
|
||||||
|
{$O WfcMenu } {$O Timefunc } {$O Sysop1 } {$O Sysop2 } {$O Offline }
|
||||||
|
{$O Sysop2j } {$O Sysop2a } {$O Sysop2b } {$O Sysop2c } {$O Sysop2d }
|
||||||
|
{$O Sysop2e } {$O Sysop2f } {$O Sysop2l } {$O Sysop2g } {$O Sysop2i }
|
||||||
|
{$O Sysop2h } {$O File4 } {$O Sysop2k } {$O Sysop3 } {$O Sysop4 }
|
||||||
|
{$O Sysop6 } {$O Sysop7 } {$O Sysop7m } {$O Sysop8 } {$O Sysop2m }
|
||||||
|
{$O Sysop9 } {$O Sysop10 } {$O Sysop11 } {$O Mail0 } {$O Mail1 }
|
||||||
|
{$O Email } {$O Mail2 } {$O Mail3 } {$O Vote } {$O Nodelist }
|
||||||
|
{$O Mail4 } {$O Arcview } {$O File0 } {$O File1 } {$O File2 }
|
||||||
|
{$O File5 } {$O File6 } {$O File8 } {$O MultNode } {$O Script }
|
||||||
|
{$O File9 } {$O File10 } {$O File11 } {$O File12 } {$O File13 }
|
||||||
|
{$O File14 } {$O Archive1 } {$O Archive2 } {$O Archive3 } {$O Logon }
|
||||||
|
{$O Maint } {$O NewUsers } {$O TimeBank } {$O Bulletin } {$O MiscUser }
|
||||||
|
{$O ShortMsg } {$O CUser } {$O Doors } {$O ExecBat } {$O Automsg }
|
||||||
|
{$O MyIO } {$O Menus2 } {$O Menus3 } {$O LineChat } {$O Stats }
|
||||||
|
{$O Events } {$O BBSList } {$O Common4 } {$O File7 } {$O SplitCha }
|
||||||
|
{$O Sysop2o } {$O Sysop5 } {$O SysOp12 } {$O OneLiner }
|
||||||
|
|
||||||
|
CONST
|
||||||
|
NeedToHangUp: Boolean = FALSE;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
ExitSave: Pointer;
|
||||||
|
GeneralF: FILE OF GeneralRecordType;
|
||||||
|
ByteFile: FILE OF Byte;
|
||||||
|
TextFile: Text;
|
||||||
|
S: Astr;
|
||||||
|
Counter: Byte;
|
||||||
|
Counter1: Integer;
|
||||||
|
|
||||||
|
PROCEDURE ErrorHandle;
|
||||||
|
VAR
|
||||||
|
TextFile: Text;
|
||||||
|
S: STRING[50];
|
||||||
|
BEGIN
|
||||||
|
ExitProc := ExitSave;
|
||||||
|
IF (ErrorAddr <> NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
CHDir(StartDir);
|
||||||
|
|
||||||
|
IF (General.Multinode) AND (ThisNode > 0) THEN
|
||||||
|
Assign(SysOpLogFile,TempDir+'TEMPLOG.'+IntToStr(ThisNode) )
|
||||||
|
ELSE
|
||||||
|
Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
|
||||||
|
Append(SysOpLogFile);
|
||||||
|
S := '^8*>>^7 Runtime error '+IntToStr(ExitCode)+' at '+DateStr+' '+TimeStr+ '^8 <<*^5'+' (Check ERROR.LOG)';
|
||||||
|
WriteLn(SysOpLogFile,S);
|
||||||
|
Flush(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
|
||||||
|
IF (TextRec(Trapfile).Mode = FMOutPut) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn(Trapfile,S);
|
||||||
|
Flush(Trapfile);
|
||||||
|
Close(Trapfile);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Assign(TextFile,'ERROR.LOG');
|
||||||
|
Append(TextFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
ReWrite(TextFile);
|
||||||
|
|
||||||
|
WriteLn(TextFile,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
|
||||||
|
WriteLn(TextFile,'Critical error Log file - Contains screen images at instant of error.');
|
||||||
|
WriteLn(TextFile,'The "²" character shows the cursor position at time of error.');
|
||||||
|
WriteLn(TextFile,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
|
||||||
|
WriteLn(TextFile);
|
||||||
|
WriteLn(TextFile);
|
||||||
|
WriteLn(TextFile,'¯>¯ error #'+IntToStr(ExitCode)+' at '+DateStr+' '+TimeStr+' version: '+General.Version);
|
||||||
|
|
||||||
|
IF (UserOn) THEN
|
||||||
|
BEGIN
|
||||||
|
Write(TextFile,'¯>¯ User "'+AllCaps(ThisUser.name)+' #'+IntToStr(UserNum)+'" was on ');
|
||||||
|
IF (ComPortSpeed > 0) THEN
|
||||||
|
WriteLn(TextFile,'at '+IntToStr(ActualSpeed)+ 'baud')
|
||||||
|
ELSE
|
||||||
|
WriteLn(TextFile,'Locally');
|
||||||
|
END;
|
||||||
|
Close(TextFile);
|
||||||
|
|
||||||
|
ScreenDump('ERROR.LOG');
|
||||||
|
|
||||||
|
Assign(TextFile,'CRITICAL.ERR');
|
||||||
|
ReWrite(TextFile);
|
||||||
|
Close(TextFile);
|
||||||
|
SetFAttr(TextFile,Dos.Hidden);
|
||||||
|
|
||||||
|
Print('^8System malfunction.');
|
||||||
|
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
Noder.Status := [];
|
||||||
|
Noder.User := 0;
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
|
||||||
|
Com_Flush_Send;
|
||||||
|
Dtr(FALSE);
|
||||||
|
Com_DeInstall;
|
||||||
|
|
||||||
|
Halt(ExitErrors);
|
||||||
|
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReadP;
|
||||||
|
VAR
|
||||||
|
d: astr;
|
||||||
|
Counter: Integer;
|
||||||
|
|
||||||
|
FUNCTION SC(s: astr; i: Integer): Char;
|
||||||
|
BEGIN
|
||||||
|
SC := UpCase(s[i]);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Reliable := FALSE;
|
||||||
|
Telnet := FALSE;
|
||||||
|
CallerIDNumber := '';
|
||||||
|
Counter := 0;
|
||||||
|
WHILE (Counter < ParamCount) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(Counter);
|
||||||
|
IF ((SC(ParamStr(Counter),1) = '-') OR (SC(ParamStr(Counter),1) = '/')) THEN
|
||||||
|
CASE SC(ParamStr(Counter),2) OF
|
||||||
|
'5' : TextMode(259);
|
||||||
|
'B' : AnswerBaud := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
'C' : Reliable := (Pos(AllCaps(Liner.Reliable),AllCaps(ParamStr(Counter))) > 0);
|
||||||
|
'D' : OvrUseEms := FALSE;
|
||||||
|
'E' : IF (Length(ParamStr(Counter)) >= 4) THEN
|
||||||
|
BEGIN
|
||||||
|
d := AllCaps(ParamStr(Counter));
|
||||||
|
CASE d[3] OF
|
||||||
|
'E' : ExitErrors := StrToInt(Copy(d,4,(Length(d) - 3)));
|
||||||
|
'N' : ExitNormal := StrToInt(Copy(d,4,(Length(d) - 3)));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'H' : SockHandle := Copy(ParamStr(Counter),3,255);
|
||||||
|
'I' : BEGIN
|
||||||
|
CASE SC(ParamStr(Counter),3) OF
|
||||||
|
'D' : CallerIDNumber := Copy(ParamStr(Counter),4,255);
|
||||||
|
'P' : CallerIDNumber := Copy(ParamStr(Counter),4,255);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'L' : LocalIOOnly := TRUE;
|
||||||
|
'M' : BEGIN
|
||||||
|
MakeQWKFor := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'N' : ThisNode := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
'P' : BEGIN
|
||||||
|
PackBasesOnly := TRUE;
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'Q' : QuitAfterDone := TRUE;
|
||||||
|
'S' : BEGIN
|
||||||
|
SortFilesOnly := TRUE;
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'F' : BEGIN
|
||||||
|
FileBBSOnly := TRUE;
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
IF (SC(ParamStr(Counter),3) <> 'C') THEN
|
||||||
|
HangUpTelnet := TRUE;
|
||||||
|
Telnet := TRUE;
|
||||||
|
END;
|
||||||
|
'U' : BEGIN
|
||||||
|
UpQWKFor := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'X' : ExtEventTime := StrToInt(Copy(ParamStr(Counter),3,255));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
AllowAbort := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
ClrScr;
|
||||||
|
TextColor(Yellow);
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
GetIntVec($14,Interrupt14);
|
||||||
|
{$ENDIF}
|
||||||
|
FileMode := 66;
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
FileModeReadWrite := FileMode;
|
||||||
|
{$ENDIF}
|
||||||
|
ExitSave := ExitProc;
|
||||||
|
ExitProc := @ErrorHandle;
|
||||||
|
|
||||||
|
DirectVideo := FALSE;
|
||||||
|
CheckSnow := FALSE;
|
||||||
|
|
||||||
|
UserOn := FALSE;
|
||||||
|
UserNum := 0;
|
||||||
|
|
||||||
|
GetDir(0,StartDir);
|
||||||
|
|
||||||
|
DatFilePath := GetEnv('RENEGADE');
|
||||||
|
IF (DatFilePath <> '') THEN
|
||||||
|
DatFilePath := BSlash(DatFilePath,TRUE);
|
||||||
|
Assign(ByteFile,DatFilePath+'RENEGADE.DAT');
|
||||||
|
Reset(ByteFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error opening RENEGADE.DAT.');
|
||||||
|
Halt;
|
||||||
|
END;
|
||||||
|
Counter := 0;
|
||||||
|
Seek(ByteFile,FileSize(ByteFile));
|
||||||
|
WHILE FileSize(ByteFile) < SizeOf(General) DO
|
||||||
|
Write(ByteFile,Counter);
|
||||||
|
Close(ByteFile);
|
||||||
|
|
||||||
|
Assign(GeneralF,DatFilePath+'RENEGADE.DAT');
|
||||||
|
Reset(GeneralF);
|
||||||
|
Read(GeneralF,General);
|
||||||
|
Close(GeneralF);
|
||||||
|
|
||||||
|
ReadP;
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
OvrFileMode := 0;
|
||||||
|
Write('Initializing RENEGADE.OVR ... ');
|
||||||
|
OvrInit('RENEGADE.OVR');
|
||||||
|
IF (OvrResult <> OvrOK) THEN
|
||||||
|
OvrInit(General.DataPath+'RENEGADE.OVR');
|
||||||
|
IF (OvrResult <> OvrOK) THEN
|
||||||
|
BEGIN
|
||||||
|
CASE OvrResult OF
|
||||||
|
OvrError : WriteLn('Program has no overlays.');
|
||||||
|
OvrNotFound : WriteLn('Overlay file not found.');
|
||||||
|
END;
|
||||||
|
Halt;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
WriteLn('Done.');
|
||||||
|
|
||||||
|
IF (General.UseEMS) AND (OvrUseEms) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
Write('Attempting to load overlays into XMS memory ... ');
|
||||||
|
|
||||||
|
{vrMovBufToUMB;}
|
||||||
|
|
||||||
|
IF (OvrResult <> OvrOK) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Failed.');
|
||||||
|
Write('Attempting to load overlays into EMS memory ... ');
|
||||||
|
OvrInitEMS;
|
||||||
|
IF (OvrResult = OvrOK) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Done.');
|
||||||
|
OverLayLocation := 1
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CASE OvrResult OF
|
||||||
|
OvrIOError : WriteLn('Overlay file I/O error.');
|
||||||
|
OvrNoEMSDriver : WriteLn('EMS driver not installed.');
|
||||||
|
OvrNoEMSMemory : WriteLn('Not enough EMS memory.');
|
||||||
|
END;
|
||||||
|
Halt;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Done.');
|
||||||
|
OverLayLocation := 2;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
WriteLn('Initial size of the overlay buffer is '+FormatNumber(OvrGetBuf)+' bytes.');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Init;
|
||||||
|
|
||||||
|
MaxDisplayRows := (Hi(WindMax) + 1);
|
||||||
|
MaxDisplayCols := (Lo(WindMax) + 1);
|
||||||
|
ScreenSize := 2 * MaxDisplayRows * MaxDisplayCols;
|
||||||
|
IF (ScreenSize > 8000) THEN
|
||||||
|
ScreenSize := 8000;
|
||||||
|
|
||||||
|
IF (FileBBSOnly) OR (PackBasesOnly) OR (SortFilesOnly) OR (MakeQWKFor > 0) OR (UpQWKFor > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
WFCMDefine;
|
||||||
|
TempPause := FALSE;
|
||||||
|
IF (MakeQWKFor > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
UserNum := MakeQWKFor;
|
||||||
|
LoadURec(ThisUser,MakeQWKFor);
|
||||||
|
NewFileDate := ThisUser.LastOn;
|
||||||
|
Downloadpacket;
|
||||||
|
SaveURec(ThisUser,MakeQWKFor);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (UpQWKFor > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
UserNum := UpQWKFor;
|
||||||
|
LoadURec(ThisUser,UpQWKFor);
|
||||||
|
Uploadpacket(TRUE);
|
||||||
|
SaveURec(ThisUser,UpQWKFor);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (PackBasesOnly) THEN
|
||||||
|
BEGIN
|
||||||
|
DoShowPackMessageAreas;
|
||||||
|
NL;
|
||||||
|
Print('^5Message areas packed.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (SortFilesOnly) THEN
|
||||||
|
Sort;
|
||||||
|
|
||||||
|
IF (FileBBSOnly) THEN
|
||||||
|
CheckFilesBBS;
|
||||||
|
|
||||||
|
Halt(0);
|
||||||
|
END;
|
||||||
|
|
||||||
|
GetMem(MemCmd,MaxCmds * SizeOf(MemCmdRec));
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
IF (NeedToHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
NeedToHangUp := FALSE;
|
||||||
|
DoPhoneHangUp(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
WFCMenus;
|
||||||
|
|
||||||
|
UserOn := FALSE;
|
||||||
|
UserNum := 0;
|
||||||
|
|
||||||
|
IF (NOT DoneDay) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
lStatus_Screen(100,'User logging in.',FALSE,S);
|
||||||
|
|
||||||
|
LastScreenSwap := 0;
|
||||||
|
|
||||||
|
IF (GetUser) THEN
|
||||||
|
NewUser;
|
||||||
|
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NumBatchDLFiles := 0;
|
||||||
|
NumBatchULFiles := 0;
|
||||||
|
BatchDLPoints := 0;
|
||||||
|
BatchDLSize := 0;
|
||||||
|
BatchDLTime := 0;
|
||||||
|
|
||||||
|
LogonMaint;
|
||||||
|
|
||||||
|
IF (NOT HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
NewFileDate := ThisUser.LastOn;
|
||||||
|
|
||||||
|
IF (MsgAreaAC(ThisUser.LastMsgArea)) THEN
|
||||||
|
MsgArea := ThisUser.LastMsgArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO NumMsgAreas DO
|
||||||
|
IF (MsgAreaAC(Counter)) THEN
|
||||||
|
BEGIN
|
||||||
|
MsgArea := Counter;
|
||||||
|
Counter := NumMsgAreas;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (FileAreaAC(ThisUser.LastFileArea)) THEN
|
||||||
|
FileArea := ThisUser.LastFileArea
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO NumFileAreas DO
|
||||||
|
IF (FileAreaAC(Counter)) THEN
|
||||||
|
BEGIN
|
||||||
|
FileArea := Counter;
|
||||||
|
Counter := NumFileAreas;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
NewCompTables;
|
||||||
|
|
||||||
|
MenuStackPtr := 0;
|
||||||
|
|
||||||
|
FOR Counter := 1 TO MaxMenus DO
|
||||||
|
MenuStack[Counter] := 0;
|
||||||
|
|
||||||
|
IF (Novice in ThisUser.Flags) THEN
|
||||||
|
CurHelpLevel := 2
|
||||||
|
ELSE
|
||||||
|
CurHelpLevel := 1;
|
||||||
|
|
||||||
|
GlobalCmds := 0;
|
||||||
|
NumCmds := 0;
|
||||||
|
CurMenu := 0;
|
||||||
|
FallBackMenu := 0;
|
||||||
|
|
||||||
|
IF (General.GlobalMenu <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := General.GlobalMenu;
|
||||||
|
LoadMenu;
|
||||||
|
GlobalCmds := NumCmds;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (ThisUser.UserStartMenu = 0) THEN
|
||||||
|
CurMenu := General.AllStartMenu
|
||||||
|
ELSE
|
||||||
|
CurMenu := ThisUser.UserStartMenu;
|
||||||
|
|
||||||
|
LoadMenu;
|
||||||
|
|
||||||
|
AutoExecCmd('FIRSTCMD');
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
WHILE (NOT HangUp) DO
|
||||||
|
MenuExec;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (QuitAfterDone) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (ExitErrorLevel = 0) THEN
|
||||||
|
ExitErrorLevel := ExitNormal;
|
||||||
|
HangUp := TRUE;
|
||||||
|
DoneDay := TRUE;
|
||||||
|
NeedToHangUp := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
LogOffMaint;
|
||||||
|
|
||||||
|
IF (General.Multinode) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(TextFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
IF Exist(General.LogsPath+'SYSOP.LOG') THEN
|
||||||
|
Append(TextFile)
|
||||||
|
ELSE
|
||||||
|
ReWrite(TextFile);
|
||||||
|
Reset(SysOpLogFile);
|
||||||
|
WHILE NOT EOF(SysOpLogFile) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(SysOpLogFile,S);
|
||||||
|
WriteLn(TextFile,S);
|
||||||
|
END;
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
Close(TextFile);
|
||||||
|
ReWrite(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (Com_Carrier) AND (NOT DoneDay) THEN
|
||||||
|
IF (InCom) THEN
|
||||||
|
NeedToHangUp := TRUE;
|
||||||
|
|
||||||
|
END;
|
||||||
|
|
||||||
|
UNTIL (DoneDay);
|
||||||
|
|
||||||
|
FreeMem(MemCmd,MaxCmds * SizeOf(MemCmdRec));
|
||||||
|
|
||||||
|
IF (MCIBuffer <> NIL) THEN
|
||||||
|
Dispose(MCIBuffer);
|
||||||
|
|
||||||
|
IF (MemEventArray[NumEvents] <> NIL) THEN
|
||||||
|
FOR Counter1 := 1 TO NumEvents DO
|
||||||
|
IF (MemEventArray[Counter1] <> NIL) THEN
|
||||||
|
Dispose(MemEventArray[Counter1]);
|
||||||
|
|
||||||
|
IF (NeedToHangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (HangUpTelnet) THEN
|
||||||
|
DoTelnetHangUp(TRUE);
|
||||||
|
IF (NOT HangUpTelnet) THEN
|
||||||
|
DoPhoneHangUp(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (General.Multinode) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(TextFile,General.LogsPath+'SYSOP.LOG');
|
||||||
|
IF Exist(General.LogsPath+'SYSOP.LOG') THEN
|
||||||
|
Append(TextFile)
|
||||||
|
ELSE
|
||||||
|
ReWrite(TextFile);
|
||||||
|
Reset(SysOpLogFile);
|
||||||
|
WHILE NOT EOF(SysOpLogFile) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(SysOpLogFile,S);
|
||||||
|
WriteLn(TextFile,S);
|
||||||
|
END;
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
Close(TextFile);
|
||||||
|
ReWrite(SysOpLogFile);
|
||||||
|
Close(SysOpLogFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (General.Multinode) THEN
|
||||||
|
Kill(TempDir+'TEMPLOG.'+IntToStr(ThisNode));
|
||||||
|
|
||||||
|
Window(1,1,MaxDisplayCols,MaxDisplayRows);
|
||||||
|
TextBackGround(0);
|
||||||
|
TextColor(7);
|
||||||
|
ClrScr;
|
||||||
|
TextColor(14);
|
||||||
|
|
||||||
|
IF (NewEchoMail) AND (ExitErrorLevel = 0) THEN
|
||||||
|
ExitErrorLevel := 2;
|
||||||
|
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
Noder.Status := [];
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
|
||||||
|
PurgeDir(TempDir,FALSE);
|
||||||
|
|
||||||
|
Com_DeInstall;
|
||||||
|
|
||||||
|
WriteLn('Exiting with errorlevel ',ExitErrorLevel);
|
||||||
|
Halt(ExitErrorLevel);
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
|
@ -0,0 +1,927 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
PROGRAM RGLNG;
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
StrPointerRec = RECORD
|
||||||
|
Pointer,
|
||||||
|
TextSize: LongInt;
|
||||||
|
END;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
RGStrFile: FILE;
|
||||||
|
StrPointerFile: FILE OF StrPointerRec;
|
||||||
|
StrPointer: StrPointerRec;
|
||||||
|
F: Text;
|
||||||
|
S: STRING;
|
||||||
|
RGStrNum: LongInt;
|
||||||
|
Done,
|
||||||
|
Found: Boolean;
|
||||||
|
|
||||||
|
FUNCTION AllCaps(S: STRING): STRING;
|
||||||
|
VAR
|
||||||
|
I: Integer;
|
||||||
|
BEGIN
|
||||||
|
FOR I := 1 TO Length(S) DO
|
||||||
|
IF (S[I] IN ['a'..'z']) THEN
|
||||||
|
S[I] := Chr(Ord(S[I]) - Ord('a')+Ord('A'));
|
||||||
|
AllCaps := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION SQOutSp(S: STRING): STRING;
|
||||||
|
BEGIN
|
||||||
|
WHILE (Pos(' ',S) > 0) DO
|
||||||
|
Delete(s,Pos(' ',S),1);
|
||||||
|
SQOutSp := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION Exist(FN: STRING): Boolean;
|
||||||
|
VAR
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
BEGIN
|
||||||
|
FindFirst(SQOutSp(FN),AnyFile,DirInfo);
|
||||||
|
Exist := (DOSError = 0);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CompileLanguageStrings;
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
Write('Compiling language strings ... ');
|
||||||
|
Found := TRUE;
|
||||||
|
Assign(StrPointerFile,'RGLNGPR.DAT');
|
||||||
|
ReWrite(StrPointerFile);
|
||||||
|
Assign(RGStrFile,'RGLNGTX.DAT');
|
||||||
|
ReWrite(RGStrFile,1);
|
||||||
|
Assign(F,'RGLNG.TXT');
|
||||||
|
Reset(F);
|
||||||
|
WHILE NOT EOF(F) AND (Found) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S <> '') AND (S[1] = '$') THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(S,1,1);
|
||||||
|
S := AllCaps(S);
|
||||||
|
RGStrNum := -1;
|
||||||
|
IF (S = 'ANONYMOUS_STRING') THEN
|
||||||
|
RGStrNum := 0
|
||||||
|
ELSE IF (S = 'ECHO_CHAR_FOR_PASSWORDS') THEN
|
||||||
|
RGStrNum := 1
|
||||||
|
ELSE IF (S = 'ENGAGE_CHAT') THEN
|
||||||
|
RGStrNum := 2
|
||||||
|
ELSE IF (S = 'END_CHAT') THEN
|
||||||
|
RGStrNum := 3
|
||||||
|
ELSE IF (S = 'SYSOP_WORKING') THEN
|
||||||
|
RGStrNum := 4
|
||||||
|
ELSE IF (S = 'PAUSE') THEN
|
||||||
|
RGStrNum := 5
|
||||||
|
ELSE IF (S = 'ENTER_MESSAGE_LINE_ONE') THEN
|
||||||
|
RGStrNum := 6
|
||||||
|
ELSE IF (S = 'ENTER_MESSAGE_LINE_TWO') THEN
|
||||||
|
RGStrNum := 7
|
||||||
|
ELSE IF (S = 'NEWSCAN_BEGIN') THEN
|
||||||
|
RGStrNum := 8
|
||||||
|
ELSE IF (S = 'NEWSCAN_DONE') THEN
|
||||||
|
RGStrNum := 9
|
||||||
|
ELSE IF (S = 'AUTO_MESSAGE_TITLE') THEN
|
||||||
|
RGStrNum := 10
|
||||||
|
ELSE IF (S = 'AUTO_MESSAGE_BORDER_CHARACTERS') THEN
|
||||||
|
RGStrNum := 11
|
||||||
|
ELSE IF (S = 'SYSOP_SHELLING_TO_DOS') THEN
|
||||||
|
RGStrNum := 12
|
||||||
|
ELSE IF (S = 'READ_MAIL') THEN
|
||||||
|
RGStrNum := 13
|
||||||
|
ELSE IF (S = 'PAGING_SYSOP') THEN
|
||||||
|
RGStrNum := 14
|
||||||
|
ELSE IF (S = 'CHAT_CALL') THEN
|
||||||
|
RGStrNum := 15
|
||||||
|
ELSE IF (S = 'BULLETIN_PROMPT') THEN
|
||||||
|
RGstrNum := 16
|
||||||
|
ELSE IF (S = 'PROTOCOL_PROMPT') THEN
|
||||||
|
RGStrNum := 17
|
||||||
|
ELSE IF (S = 'LIST_FILES') THEN
|
||||||
|
RGStrNum := 18
|
||||||
|
ELSE IF (S = 'SEARCH_FOR_NEW_FILES') THEN
|
||||||
|
RGStrNum := 19
|
||||||
|
ELSE IF (S = 'SEARCH_ALL_DIRS_FOR_FILE_MASK') THEN
|
||||||
|
RGStrNum := 20
|
||||||
|
ELSE IF (S = 'SEARCH_FOR_DESCRIPTIONS') THEN
|
||||||
|
RGStrNum := 21
|
||||||
|
ELSE IF (S = 'ENTER_THE_STRING_TO_SEARCH_FOR') THEN
|
||||||
|
RGStrNum := 22
|
||||||
|
ELSE IF (S = 'DOWNLOAD') THEN
|
||||||
|
RGStrNum := 23
|
||||||
|
ELSE IF (S = 'UPLOAD') THEN
|
||||||
|
RGStrNum := 24
|
||||||
|
ELSE IF (S = 'VIEW_INTERIOR_FILES') THEN
|
||||||
|
RGStrNum := 25
|
||||||
|
ELSE IF (S = 'INSUFFICIENT_FILE_CREDITS') THEN
|
||||||
|
RGStrNum := 26
|
||||||
|
ELSE IF (S = 'RATIO_IS_UNBALANCED') THEN
|
||||||
|
RGStrNum := 27
|
||||||
|
ELSE IF (S = 'ALL_FILES') THEN
|
||||||
|
RGStrNum := 28
|
||||||
|
ELSE IF (S = 'FILE_MASK') THEN
|
||||||
|
RGStrNum := 29
|
||||||
|
ELSE IF (S = 'FILE_ADDED_TO_BATCH_QUEUE') THEN
|
||||||
|
RGStrNum := 30
|
||||||
|
ELSE IF (S = 'BATCH_DOWNLOAD_FLAGGING') THEN
|
||||||
|
RGStrNum := 31
|
||||||
|
ELSE IF (S = 'READ_QUESTION_PROMPT') THEN
|
||||||
|
RGStrNum := 32
|
||||||
|
ELSE IF (S = 'SYSTEM_PASSWORD_PROMPT') THEN
|
||||||
|
RGStrNum := 33
|
||||||
|
ELSE IF (S = 'DEFAULT_MESSAGE_TO') THEN
|
||||||
|
RGStrNum := 34
|
||||||
|
ELSE IF (S = 'NEWSCAN_ALL') THEN
|
||||||
|
RGStrNum := 35
|
||||||
|
ELSE IF (S = 'NEWSCAN_DONE') THEN
|
||||||
|
RGStrNum := 36
|
||||||
|
ELSE IF (S = 'CHAT_REASON') THEN
|
||||||
|
RGStrNum := 37
|
||||||
|
ELSE IF (S = 'USER_DEFINED_QUESTION_ONE') THEN
|
||||||
|
RGStrNum := 38
|
||||||
|
ELSE IF (S = 'USER_DEFINED_QUESTION_TWO') THEN
|
||||||
|
RGStrNum := 39
|
||||||
|
ELSE IF (S = 'USER_DEFINED_QUESTION_THREE') THEN
|
||||||
|
RGStrNum := 40
|
||||||
|
ELSE IF (S = 'USER_DEFINED_QUESTION_EDITOR_ONE') THEN
|
||||||
|
RGStrNum := 41
|
||||||
|
ELSE IF (S = 'USER_DEFINED_QUESTION_EDITOR_TWO') THEN
|
||||||
|
RGStrNum := 42
|
||||||
|
ELSE IF (S = 'USER_DEFINED_QUESTION_EDITOR_THREE') THEN
|
||||||
|
RGStrNum := 43
|
||||||
|
ELSE IF (S = 'CONTINUE_PROMPT') THEN
|
||||||
|
RGStrNum := 44
|
||||||
|
ELSE IF (S = 'INVISIBLE_LOGIN') THEN
|
||||||
|
RGStrNum := 45
|
||||||
|
ELSE IF (S = 'CANT_EMAIL') THEN
|
||||||
|
RGStrNum := 46
|
||||||
|
ELSE IF (S = 'SEND_EMAIL') THEN
|
||||||
|
RGStrNum := 47
|
||||||
|
ELSE IF (S = 'SENDING_MASS_MAIL_TO') THEN
|
||||||
|
RGStrNum := 48
|
||||||
|
ELSE IF (S = 'SENDING_MASS_MAIL_TO_ALL_USERS') THEN
|
||||||
|
RGStrNum := 49
|
||||||
|
ELSE IF (S = 'NO_NETMAIL') THEN
|
||||||
|
RGStrNum := 50
|
||||||
|
ELSE IF (S = 'NETMAIL_PROMPT') THEN
|
||||||
|
RGStrNum := 51
|
||||||
|
ELSE IF (S = 'NO_MAIL_WAITING') THEN
|
||||||
|
RGStrNum := 52
|
||||||
|
ELSE IF (S = 'MUST_READ_MESSAGE') THEN
|
||||||
|
RGStrNum := 53
|
||||||
|
ELSE IF (S = 'SCAN_FOR_NEW_FILES') THEN
|
||||||
|
RGStrNum := 54
|
||||||
|
ELSE IF (S = 'NEW_SCAN_CHAR_FILE') THEN
|
||||||
|
RGStrNum := 55
|
||||||
|
ELSE IF (S = 'BULLETINS_PROMPT') THEN
|
||||||
|
RGStrNum := 56
|
||||||
|
ELSE IF (S = 'QUICK_LOGON') THEN
|
||||||
|
RGStrNum := 57
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_SELECT_HEADER') THEN
|
||||||
|
RGStrNum := 58
|
||||||
|
ELSE IF (S = 'FILE_AREA_SELECT_HEADER') THEN
|
||||||
|
RGStrNum := 59
|
||||||
|
ELSE IF (S = 'RECEIVE_EMAIL_HEADER') THEN
|
||||||
|
RGStrNum := 60
|
||||||
|
ELSE IF (S = 'VOTE_LIST_TOPICS_HEADER') THEN
|
||||||
|
RGStrNum := 61
|
||||||
|
ELSE IF (S = 'VOTE_TOPIC_RESULT_HEADER') THEN
|
||||||
|
RGStrNum := 62
|
||||||
|
ELSE IF (S = 'FILE_AREA_NAME_HEADER_NO_RATIO') THEN
|
||||||
|
RGStrNum := 63
|
||||||
|
ELSE IF (S = 'FILE_AREA_NAME_HEADER_RATIO') THEN
|
||||||
|
RGStrNum := 64
|
||||||
|
ELSE IF (S = 'SYSOP_CHAT_HELP') THEN
|
||||||
|
RGStrNum := 65
|
||||||
|
ELSE IF (S = 'NEW_SCAN_CHAR_MESSAGE') THEN
|
||||||
|
RGStrNum := 66
|
||||||
|
ELSE IF (S = 'FILE_AREA_SELECT_NO_FILES') THEN
|
||||||
|
RGStrNum := 67
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_SELECT_NO_FILES') THEN
|
||||||
|
RGStrNum := 68
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_LIST_PROMPT') THEN
|
||||||
|
RGStrNum := 69
|
||||||
|
ELSE IF (S = 'FILE_AREA_LIST_PROMPT') THEN
|
||||||
|
RGStrNum := 70
|
||||||
|
ELSE IF (S = 'FILE_MESSAGE_AREA_LIST_HELP') THEN
|
||||||
|
RGStrNum := 71
|
||||||
|
ELSE IF (S = 'FILE_AREA_CHANGE_PROMPT') THEN
|
||||||
|
RGStrNum := 72
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_CHANGE_PROMPT') THEN
|
||||||
|
RGStrNum := 73
|
||||||
|
ELSE IF (S = 'FILE_AREA_NEW_SCAN_TOGGLE_PROMPT') THEN
|
||||||
|
RGStrNum := 74
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_NEW_SCAN_TOGGLE_PROMPT') THEN
|
||||||
|
RGStrNum := 75
|
||||||
|
ELSE IF (S = 'FILE_AREA_MOVE_FILE_PROMPT') THEN
|
||||||
|
RGStrNum := 76
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_MOVE_MESSAGE_PROMPT') THEN
|
||||||
|
RGStrNum := 77
|
||||||
|
ELSE IF (S = 'FILE_AREA_CHANGE_MIN_MAX_ERROR') THEN
|
||||||
|
RGStrNum := 78
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_CHANGE_MIN_MAX_ERROR') THEN
|
||||||
|
RGStrNum := 79
|
||||||
|
ELSE IF (S = 'FILE_AREA_CHANGE_NO_AREA_ACCESS') THEN
|
||||||
|
RGStrNum := 80
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_CHANGE_NO_AREA_ACCESS') THEN
|
||||||
|
RGStrNum := 81
|
||||||
|
ELSE IF (S = 'FILE_AREA_CHANGE_LOWEST_AREA') THEN
|
||||||
|
RGStrNum := 82
|
||||||
|
ELSE IF (S = 'FILE_AREA_CHANGE_HIGHEST_AREA') THEN
|
||||||
|
RGStrNum := 83
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_CHANGE_LOWEST_AREA') THEN
|
||||||
|
RGStrNum := 84
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_CHANGE_HIGHEST_AREA') THEN
|
||||||
|
RGStrNum := 85
|
||||||
|
ELSE IF (S = 'FILE_AREA_NEW_SCAN_SCANNING_ALL_AREAS') THEN
|
||||||
|
RGStrNum := 86
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_NEW_SCAN_SCANNING_ALL_AREAS') THEN
|
||||||
|
RGStrNum := 87
|
||||||
|
ELSE IF (S = 'FILE_AREA_NEW_SCAN_NOT_SCANNING_ALL_AREAS') THEN
|
||||||
|
RGStrNum := 88
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_NEW_SCAN_NOT_SCANNING_ALL_AREAS') THEN
|
||||||
|
RGStrNum := 89
|
||||||
|
ELSE IF (S = 'FILE_AREA_NEW_SCAN_MIN_MAX_ERROR') THEN
|
||||||
|
RGStrNum := 90
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_NEW_SCAN_MIN_MAX_ERROR') THEN
|
||||||
|
RGStrNum := 91
|
||||||
|
ELSE IF (S = 'FILE_AREA_NEW_SCAN_AREA_ON_OFF') THEN
|
||||||
|
RGStrNum := 92
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_NEW_SCAN_AREA_ON_OFF') THEN
|
||||||
|
RGStrNum := 93
|
||||||
|
ELSE IF (S = 'MESSAGE_AREA_NEW_SCAN_AREA_NOT_REMOVED') THEN
|
||||||
|
RGStrNum := 94;
|
||||||
|
|
||||||
|
IF (RGStrNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error!');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'The following string definition is invalid:');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(' '+S);
|
||||||
|
Found := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
WITH StrPointer DO
|
||||||
|
BEGIN
|
||||||
|
Pointer := (FileSize(RGStrFile) + 1);
|
||||||
|
TextSize := 0;
|
||||||
|
END;
|
||||||
|
Seek(RGStrFile,FileSize(RGStrFile));
|
||||||
|
WHILE NOT EOF(F) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S[1] = '$') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(StrPointer.TextSize,(Length(S) + 1));
|
||||||
|
BlockWrite(RGStrFile,S,(Length(S) + 1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(StrPointerFile,RGStrNum);
|
||||||
|
Write(StrPointerFile,StrPointer);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(F);
|
||||||
|
Close(RGStrFile);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
IF (Found) THEN
|
||||||
|
WriteLn('Done!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Erase(StrPointerFile);
|
||||||
|
Erase(RGStrFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CompileMainStrings;
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
Write('Compiling main strings ... ');
|
||||||
|
Found := TRUE;
|
||||||
|
Assign(StrPointerFile,'RGMAINPR.DAT');
|
||||||
|
ReWrite(StrPointerFile);
|
||||||
|
Assign(RGStrFile,'RGMAINTX.DAT');
|
||||||
|
ReWrite(RGStrFile,1);
|
||||||
|
Assign(F,'RGMAIN.TXT');
|
||||||
|
Reset(F);
|
||||||
|
WHILE NOT EOF(F) AND (Found) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S <> '') AND (S[1] = '$') THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(S,1,1);
|
||||||
|
S := AllCaps(S);
|
||||||
|
RGStrNum := -1;
|
||||||
|
IF (S = 'BAUD_OVERRIDE_PW') THEN
|
||||||
|
RGStrNum := 0
|
||||||
|
ELSE IF (S = 'CALLER_LOGON') THEN
|
||||||
|
RGStrNum := 1
|
||||||
|
ELSE IF (S = 'LOGON_AS_NEW') THEN
|
||||||
|
RGStrNum := 2
|
||||||
|
ELSE IF (S = 'USER_LOGON_PASSWORD') THEN
|
||||||
|
RGStrNum := 3
|
||||||
|
ELSE IF (S = 'USER_LOGON_PHONE_NUMBER') THEN
|
||||||
|
RGStrNum := 4
|
||||||
|
ELSE IF (S = 'SYSOP_LOGON_PASSWORD') THEN
|
||||||
|
RGStrNum := 5
|
||||||
|
ELSE IF (S = 'FORGOT_PW_QUESTION') THEN
|
||||||
|
RGStrNum := 6
|
||||||
|
ELSE IF (S = 'VERIFY_BIRTH_DATE') THEN
|
||||||
|
RGStrNum := 7
|
||||||
|
ELSE IF (S = 'LOGON_WITHDRAW_BANK') THEN
|
||||||
|
RGStrNum := 8
|
||||||
|
ELSE IF (S = 'SHUTTLE_LOGON') THEN
|
||||||
|
RGStrNum := 9
|
||||||
|
ELSE IF (S = 'NEW_USER_PASSWORD') THEN
|
||||||
|
RGStrNum := 10;
|
||||||
|
IF (RGStrNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error!');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'The following string definition is invalid:');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(' '+S);
|
||||||
|
Found := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
WITH StrPointer DO
|
||||||
|
BEGIN
|
||||||
|
Pointer := (FileSize(RGStrFile) + 1);
|
||||||
|
TextSize := 0;
|
||||||
|
END;
|
||||||
|
Seek(RGStrFile,FileSize(RGStrFile));
|
||||||
|
WHILE NOT EOF(F) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S[1] = '$') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(StrPointer.TextSize,(Length(S) + 1));
|
||||||
|
BlockWrite(RGStrFile,S,(Length(S) + 1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(StrPointerFile,RGStrNum);
|
||||||
|
Write(StrPointerFile,StrPointer);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(F);
|
||||||
|
Close(RGStrFile);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
IF (Found) THEN
|
||||||
|
WriteLn('Done!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Erase(StrPointerFile);
|
||||||
|
Erase(RGStrFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CompileNoteStrings;
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
Write('Compiling Note strings ... ');
|
||||||
|
Found := TRUE;
|
||||||
|
Assign(StrPointerFile,'RGNOTEPR.DAT');
|
||||||
|
ReWrite(StrPointerFile);
|
||||||
|
Assign(RGStrFile,'RGNOTETX.DAT');
|
||||||
|
ReWrite(RGStrFile,1);
|
||||||
|
Assign(F,'RGNOTE.TXT');
|
||||||
|
Reset(F);
|
||||||
|
WHILE NOT EOF(F) AND (Found) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S <> '') AND (S[1] = '$') THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(S,1,1);
|
||||||
|
S := AllCaps(S);
|
||||||
|
RGStrNum := -1;
|
||||||
|
IF (S = 'INTERNAL_USE_ONLY') THEN
|
||||||
|
RGStrNum := 0
|
||||||
|
ELSE IF (S = 'ONLY_CHANGE_LOCALLY') THEN
|
||||||
|
RGStrNum := 1
|
||||||
|
ELSE IF (S = 'INVALID_MENU_NUMBER') THEN
|
||||||
|
RGStrNum := 2
|
||||||
|
ELSE IF (S = 'MINIMUM_BAUD_LOGON_PW') THEN
|
||||||
|
RGStrNum := 3
|
||||||
|
ELSE IF (S = 'MINIMUM_BAUD_LOGON_HIGH_LOW_TIME_PW') THEN
|
||||||
|
RGStrNum := 4
|
||||||
|
ELSE IF (S = 'MINIMUM_BAUD_LOGON_HIGH_LOW_TIME_NO_PW') THEN
|
||||||
|
RGStrNum := 5
|
||||||
|
ELSE IF (S = 'LOGON_EVENT_RESTRICTED_1') THEN
|
||||||
|
RGStrNum := 6
|
||||||
|
ELSE IF (S = 'LOGON_EVENT_RESTRICTED_2') THEN
|
||||||
|
RGStrNum := 7
|
||||||
|
ELSE IF (S = 'NAME_NOT_FOUND') THEN
|
||||||
|
RGStrNum := 8
|
||||||
|
ELSE IF (S = 'ILLEGAL_LOGON') THEN
|
||||||
|
RGStrNum := 9
|
||||||
|
ELSE IF (S = 'LOGON_NODE_ACS') THEN
|
||||||
|
RGStrNum := 10
|
||||||
|
ELSE IF (S = 'LOCKED_OUT') THEN
|
||||||
|
RGStrNum := 11
|
||||||
|
ELSE IF (S = 'LOGGED_ON_ANOTHER_NODE') THEN
|
||||||
|
RGStrNum := 12
|
||||||
|
ELSE IF (S = 'INCORRECT_BIRTH_DATE') THEN
|
||||||
|
RGStrNum := 13
|
||||||
|
ELSE IF (S = 'INSUFFICIENT_LOGON_CREDITS') THEN
|
||||||
|
RGStrNum := 14
|
||||||
|
ELSE IF (S = 'LOGON_ONCE_PER_DAY') THEN
|
||||||
|
RGStrNum := 15
|
||||||
|
ELSE IF (S = 'LOGON_CALLS_ALLOWED_PER_DAY') THEN
|
||||||
|
RGStrNum := 16
|
||||||
|
ELSE IF (S = 'LOGON_TIME_ALLOWED_PER_DAY_OR_CALL') THEN
|
||||||
|
RGStrNum := 17
|
||||||
|
ELSE IF (S = 'LOGON_MINUTES_LEFT_IN_BANK') THEN
|
||||||
|
RGStrNum := 18
|
||||||
|
ELSE IF (S = 'LOGON_MINUTES_LEFT_IN_BANK_TIME_LEFT') THEN
|
||||||
|
RGStrNum := 19
|
||||||
|
ELSE IF (S = 'LOGON_BANK_HANGUP') THEN
|
||||||
|
RGStrNum := 20
|
||||||
|
ELSE IF (S = 'LOGON_ATTEMPT_IEMSI_NEGOTIATION') THEN
|
||||||
|
RGStrNum := 21
|
||||||
|
ELSE IF (S = 'LOGON_IEMSI_NEGOTIATION_SUCCESS') THEN
|
||||||
|
RGStrNum := 22
|
||||||
|
ELSE IF (S = 'LOGON_IEMSI_NEGOTIATION_FAILED') THEN
|
||||||
|
RGStrNum := 23
|
||||||
|
ELSE IF (S = 'LOGON_ATTEMPT_DETECT_EMULATION') THEN
|
||||||
|
RGStrNum := 24
|
||||||
|
ELSE IF (S = 'LOGON_RIP_DETECTED') THEN
|
||||||
|
RGStrNum := 25
|
||||||
|
ELSE IF (S = 'LOGON_ANSI_DETECT_OTHER') THEN
|
||||||
|
RGStrNum := 26
|
||||||
|
ELSE IF (S = 'LOGON_ANSI_DETECT') THEN
|
||||||
|
RGStrNum := 27
|
||||||
|
ELSE IF (S = 'LOGON_AVATAR_DETECT_OTHER') THEN
|
||||||
|
RGStrNum := 28
|
||||||
|
ELSE IF (S = 'LOGON_AVATAR_DETECT') THEN
|
||||||
|
RGStrNum := 29
|
||||||
|
ELSE IF (S = 'LOGON_EMULATION_DETECTED') THEN
|
||||||
|
RGStrNum := 30
|
||||||
|
ELSE IF (S = 'SHUTTLE_LOGON_VALIDATION_STATUS') THEN
|
||||||
|
RGStrNum := 31
|
||||||
|
ELSE IF (S = 'LOGON_CLOSED_BBS') THEN
|
||||||
|
RGStrNum := 32
|
||||||
|
ELSE IF (S = 'NODE_ACTIVITY_WAITING_ONE') THEN
|
||||||
|
RGStrNum := 33
|
||||||
|
ELSE IF (S = 'NODE_ACTIVITY_WAITING_TWO') THEN
|
||||||
|
RGStrNum := 34
|
||||||
|
ELSE IF (S = 'NODE_ACTIVITY_LOGGING_ON') THEN
|
||||||
|
RGStrNum := 35
|
||||||
|
ELSE IF (S = 'NODE_ACTIVITY_NEW_USER_LOGGING_ON') THEN
|
||||||
|
RGStrNum := 36
|
||||||
|
ELSE IF (S = 'NODE_ACTIVITY_MISCELLANEOUS') THEN
|
||||||
|
RGStrNum := 37
|
||||||
|
ELSE IF (S = 'NEW_USER_PASSWORD_INVALID') THEN
|
||||||
|
RGStrNum := 38
|
||||||
|
ELSE IF (S = 'NEW_USER_PASSWORD_ATTEMPT_EXCEEDED') THEN
|
||||||
|
RGStrNum := 39
|
||||||
|
ELSE IF (S = 'NEW_USER_RECORD_SAVING') THEN
|
||||||
|
RGStrNum := 40
|
||||||
|
ELSE IF (S = 'NEW_USER_RECORD_SAVED') THEN
|
||||||
|
RGStrNum := 41
|
||||||
|
ELSE IF (S = 'NEW_USER_APPLICATION_LETTER') THEN
|
||||||
|
RGStrNum := 42
|
||||||
|
ELSE IF (S = 'NEW_USER_IN_RESPONSE_TO_SUBJ') THEN
|
||||||
|
RGStrNum := 43;
|
||||||
|
IF (RGStrNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error!');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'The following string definition is invalid:');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(' '+S);
|
||||||
|
Found := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
WITH StrPointer DO
|
||||||
|
BEGIN
|
||||||
|
Pointer := (FileSize(RGStrFile) + 1);
|
||||||
|
TextSize := 0;
|
||||||
|
END;
|
||||||
|
Seek(RGStrFile,FileSize(RGStrFile));
|
||||||
|
WHILE NOT EOF(F) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S[1] = '$') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(StrPointer.TextSize,(Length(S) + 1));
|
||||||
|
BlockWrite(RGStrFile,S,(Length(S) + 1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(StrPointerFile,RGStrNum);
|
||||||
|
Write(StrPointerFile,StrPointer);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(F);
|
||||||
|
Close(RGStrFile);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
IF (Found) THEN
|
||||||
|
WriteLn('Done!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Erase(StrPointerFile);
|
||||||
|
Erase(RGStrFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CompileSysOpStrings;
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
Write('Compiling sysop strings ... ');
|
||||||
|
Found := TRUE;
|
||||||
|
Assign(StrPointerFile,'RGSCFGPR.DAT');
|
||||||
|
ReWrite(StrPointerFile);
|
||||||
|
Assign(RGStrFile,'RGSCFGTX.DAT');
|
||||||
|
ReWrite(RGStrFile,1);
|
||||||
|
Assign(F,'RGSCFG.TXT');
|
||||||
|
Reset(F);
|
||||||
|
WHILE NOT EOF(F) AND (Found) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S <> '') AND (S[1] = '$') THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(S,1,1);
|
||||||
|
S := AllCaps(S);
|
||||||
|
RGStrNum := -1;
|
||||||
|
IF (S = 'SYSTEM_CONFIGURATION_MENU') THEN
|
||||||
|
RGStrNum := 0
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION') THEN
|
||||||
|
RGStrNum := 1
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_BBS_NAME') THEN
|
||||||
|
RGStrNum := 2
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_BBS_PHONE') THEN
|
||||||
|
RGStrNum := 3
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_TELNET_URL') THEN
|
||||||
|
RGStrNum := 4
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSOP_NAME') THEN
|
||||||
|
RGStrNum := 5
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSOP_CHAT_HOURS') THEN
|
||||||
|
RGStrNum := 6
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_MINIMUM_BAUD_HOURS') THEN
|
||||||
|
RGStrNum := 7
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_DOWNLOAD_HOURS') THEN
|
||||||
|
RGStrNum := 8
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_MINIMUM_BAUD_DOWNLOAD_HOURS') THEN
|
||||||
|
RGStrNum := 9
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSOP_PASSWORD_MENU') THEN
|
||||||
|
RGStrNum := 10
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSOP_PASSWORD') THEN
|
||||||
|
RGStrNum := 11
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_NEW_USER_PASSWORD') THEN
|
||||||
|
RGStrNum := 12
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_BAUD_OVERRIDE_PASSWORD') THEN
|
||||||
|
RGStrNum := 13
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_PRE_EVENT_TIME') THEN
|
||||||
|
RGStrNum := 14
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS') THEN
|
||||||
|
RGStrNum := 15
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS_GLOBAL') THEN
|
||||||
|
RGStrNum := 16
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS_START') THEN
|
||||||
|
RGStrNum := 17
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS_SHUTTLE') THEN
|
||||||
|
RGStrNum := 18
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS_NEW_USER') THEN
|
||||||
|
RGStrNum := 19
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS_MESSAGE_READ') THEN
|
||||||
|
RGStrNum := 20
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_SYSTEM_MENUS_FILE_LISTING') THEN
|
||||||
|
RGStrNum := 21
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_BULLETIN_PREFIX') THEN
|
||||||
|
RGStrNum := 22
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_LOCAL_SECURITY') THEN
|
||||||
|
RGStrNum := 23
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_DATA_PATH') THEN
|
||||||
|
RGStrNum := 24
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_MISC_PATH') THEN
|
||||||
|
RGStrNum := 25
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_MSG_PATH') THEN
|
||||||
|
RGStrNum := 26
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_NODELIST_PATH') THEN
|
||||||
|
RGStrNum := 27
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_LOG_PATH') THEN
|
||||||
|
RGStrNum := 28
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_TEMP_PATH') THEN
|
||||||
|
RGStrNum := 29
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_PROTOCOL_PATH') THEN
|
||||||
|
RGStrNum := 30
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_ARCHIVE_PATH') THEN
|
||||||
|
RGStrNum := 31
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_ATTACH_PATH') THEN
|
||||||
|
RGStrNum := 32
|
||||||
|
ELSE IF (S = 'MAIN_BBS_CONFIGURATION_STRING_PATH') THEN
|
||||||
|
RGStrNum := 33;
|
||||||
|
IF (RGStrNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error!');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'The following string definition is invalid:');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(' '+S);
|
||||||
|
Found := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
WITH StrPointer DO
|
||||||
|
BEGIN
|
||||||
|
Pointer := (FileSize(RGStrFile) + 1);
|
||||||
|
TextSize := 0;
|
||||||
|
END;
|
||||||
|
Seek(RGStrFile,FileSize(RGStrFile));
|
||||||
|
WHILE NOT EOF(F) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S[1] = '$') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(StrPointer.TextSize,(Length(S) + 1));
|
||||||
|
BlockWrite(RGStrFile,S,(Length(S) + 1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(StrPointerFile,RGStrNum);
|
||||||
|
Write(StrPointerFile,StrPointer);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(F);
|
||||||
|
Close(RGStrFile);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
IF (Found) THEN
|
||||||
|
WriteLn('Done!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Erase(StrPointerFile);
|
||||||
|
Erase(RGStrFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CompileFileAreaEditorStrings;
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
Write('Compiling file area editor strings ... ');
|
||||||
|
Found := TRUE;
|
||||||
|
Assign(StrPointerFile,'FAEPR.DAT');
|
||||||
|
ReWrite(StrPointerFile);
|
||||||
|
Assign(RGStrFile,'FAETX.DAT');
|
||||||
|
ReWrite(RGStrFile,1);
|
||||||
|
Assign(F,'FAELNG.TXT');
|
||||||
|
Reset(F);
|
||||||
|
WHILE NOT EOF(F) AND (Found) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S <> '') AND (S[1] = '$') THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(S,1,1);
|
||||||
|
S := AllCaps(S);
|
||||||
|
RGStrNum := -1;
|
||||||
|
IF (S = 'FILE_AREA_HEADER_TOGGLE_ONE') THEN
|
||||||
|
RGStrNum := 0
|
||||||
|
ELSE IF (S = 'FILE_AREA_HEADER_TOGGLE_TWO') THEN
|
||||||
|
RGStrNum := 1
|
||||||
|
ELSE IF (S = 'FILE_AREA_HEADER_NO_FILE_AREAS') THEN
|
||||||
|
RGStrNum := 2
|
||||||
|
ELSE IF (S = 'FILE_AREA_EDITOR_PROMPT') THEN
|
||||||
|
RGStrNum := 3
|
||||||
|
ELSE IF (S = 'FILE_AREA_EDITOR_HELP') THEN
|
||||||
|
RGStrNum := 4
|
||||||
|
ELSE IF (S = 'NO_FILE_AREAS') THEN
|
||||||
|
RGStrNum := 5
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_DRIVE_START') THEN
|
||||||
|
RGStrNum := 6
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_DRIVE_END') THEN
|
||||||
|
RGStrNum := 7
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_DRIVE_DRIVE') THEN
|
||||||
|
RGStrNum := 8
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_INVALID_ORDER') THEN
|
||||||
|
RGStrNum := 9
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_INVALID_DRIVE') THEN
|
||||||
|
RGStrNum := 10
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_UPDATING_DRIVE') THEN
|
||||||
|
RGStrNum := 11
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_UPDATING_DRIVE_DONE') THEN
|
||||||
|
RGStrNum := 12
|
||||||
|
ELSE IF (S = 'FILE_CHANGE_UPDATING_SYSOPLOG') THEN
|
||||||
|
RGStrNum := 13
|
||||||
|
ELSE IF (S = 'FILE_DELETE_PROMPT') THEN
|
||||||
|
RGStrNum := 14
|
||||||
|
ELSE IF (S = 'FILE_DELETE_DISPLAY_AREA') THEN
|
||||||
|
RGStrNum := 15
|
||||||
|
ELSE IF (S = 'FILE_DELETE_VERIFY_DELETE') THEN
|
||||||
|
RGStrNum := 16
|
||||||
|
ELSE IF (S = 'FILE_DELETE_NOTICE') THEN
|
||||||
|
RGStrNum := 17
|
||||||
|
ELSE IF (S = 'FILE_DELETE_SYSOPLOG') THEN
|
||||||
|
RGStrNum := 18
|
||||||
|
ELSE IF (S = 'FILE_DELETE_DATA_FILES') THEN
|
||||||
|
RGStrNum := 19
|
||||||
|
ELSE IF (S = 'FILE_DELETE_REMOVE_DL_DIRECTORY') THEN
|
||||||
|
RGStrNum := 20
|
||||||
|
ELSE IF (S = 'FILE_DELETE_REMOVE_UL_DIRECTORY') THEN
|
||||||
|
RGStrNum := 21
|
||||||
|
ELSE IF (S = 'FILE_INSERT_MAX_FILE_AREAS') THEN
|
||||||
|
RGStrNum := 22
|
||||||
|
ELSE IF (S = 'FILE_INSERT_PROMPT') THEN
|
||||||
|
RGStrNum := 23
|
||||||
|
ELSE IF (S = 'FILE_INSERT_AFTER_ERROR_PROMPT') THEN
|
||||||
|
RGStrNum := 24
|
||||||
|
ELSE IF (S = 'FILE_INSERT_CONFIRM_INSERT') THEN
|
||||||
|
RGStrNum := 25
|
||||||
|
ELSE IF (S = 'FILE_INSERT_NOTICE') THEN
|
||||||
|
RGStrNum := 26
|
||||||
|
ELSE IF (S = 'FILE_INSERT_SYSOPLOG') THEN
|
||||||
|
RGStrNum := 27
|
||||||
|
ELSE IF (S = 'FILE_MODIFY_PROMPT') THEN
|
||||||
|
RGStrNum := 28
|
||||||
|
ELSE IF (S = 'FILE_MODIFY_SYSOPLOG') THEN
|
||||||
|
RGStrNum := 29
|
||||||
|
ELSE IF (S = 'FILE_POSITION_NO_AREAS') THEN
|
||||||
|
RGStrNum := 30
|
||||||
|
ELSE IF (S = 'FILE_POSITION_PROMPT') THEN
|
||||||
|
RGStrNum := 31
|
||||||
|
ELSE IF (S = 'FILE_POSITION_NUMBERING') THEN
|
||||||
|
RGStrNum := 32
|
||||||
|
ELSE IF (S = 'FILE_POSITION_BEFORE_WHICH') THEN
|
||||||
|
RGStrNum := 33
|
||||||
|
ELSE IF (S = 'FILE_POSITION_NOTICE') THEN
|
||||||
|
RGStrNum := 34
|
||||||
|
ELSE IF (S = 'FILE_EDITING_AREA_HEADER') THEN
|
||||||
|
RGStrNum := 35
|
||||||
|
ELSE IF (S = 'FILE_INSERTING_AREA_HEADER') THEN
|
||||||
|
RGStrNum := 36
|
||||||
|
ELSE IF (S = 'FILE_EDITING_INSERTING_SCREEN') THEN
|
||||||
|
RGStrNum := 37
|
||||||
|
ELSE IF (S = 'FILE_EDITING_INSERTING_PROMPT') THEN
|
||||||
|
RGStrNum := 38
|
||||||
|
ELSE IF (S = 'FILE_AREA_NAME_CHANGE') THEN
|
||||||
|
RGStrNum := 39
|
||||||
|
ELSE IF (S = 'FILE_FILE_NAME_CHANGE') THEN
|
||||||
|
RGStrNum := 40
|
||||||
|
ELSE IF (S = 'FILE_DUPLICATE_FILE_NAME_ERROR') THEN
|
||||||
|
RGStrNum := 41
|
||||||
|
ELSE IF (S = 'FILE_USE_DUPLICATE_FILE_NAME') THEN
|
||||||
|
RGStrNum := 42
|
||||||
|
ELSE IF (S = 'FILE_OLD_DATA_FILES_PATH') THEN
|
||||||
|
RGStrNum := 43
|
||||||
|
ELSE IF (S = 'FILE_NEW_DATA_FILES_PATH') THEN
|
||||||
|
RGStrNum := 44
|
||||||
|
ELSE IF (S = 'FILE_RENAME_DATA_FILES') THEN
|
||||||
|
RGStrNum := 45
|
||||||
|
ELSE IF (S = 'FILE_DL_PATH') THEN
|
||||||
|
RGStrNum := 46
|
||||||
|
ELSE IF (S = 'FILE_SET_DL_PATH_TO_UL_PATH') THEN
|
||||||
|
RGStrNum := 47
|
||||||
|
ELSE IF (S = 'FILE_UL_PATH') THEN
|
||||||
|
RGStrNum := 48
|
||||||
|
ELSE IF (S = 'FILE_ACS') THEN
|
||||||
|
RGStrNum := 49
|
||||||
|
ELSE IF (S = 'FILE_DL_ACCESS') THEN
|
||||||
|
RGStrNum := 50
|
||||||
|
ELSE IF (S = 'FILE_UL_ACCESS') THEN
|
||||||
|
RGStrNum := 51
|
||||||
|
ELSE IF (S = 'FILE_MAX_FILES') THEN
|
||||||
|
RGStrNum := 52
|
||||||
|
ELSE IF (S = 'FILE_PASSWORD') THEN
|
||||||
|
RGStrNum := 53
|
||||||
|
ELSE IF (S = 'FILE_ARCHIVE_TYPE') THEN
|
||||||
|
RGStrNum := 54
|
||||||
|
ELSE IF (S = 'FILE_COMMENT_TYPE') THEN
|
||||||
|
RGStrNum := 55
|
||||||
|
ELSE IF (S = 'FILE_TOGGLE_FLAGS') THEN
|
||||||
|
RGStrNum := 56
|
||||||
|
ELSE IF (S = 'FILE_MOVE_DATA_FILES') THEN
|
||||||
|
RGStrNum := 57
|
||||||
|
ELSE IF (S = 'FILE_TOGGLE_HELP') THEN
|
||||||
|
RGStrNum := 58
|
||||||
|
ELSE IF (S = 'FILE_JUMP_TO') THEN
|
||||||
|
RGStrNum := 59
|
||||||
|
ELSE IF (S = 'FILE_FIRST_VALID_RECORD') THEN
|
||||||
|
RGStrNum := 60
|
||||||
|
ELSE IF (S = 'FILE_LAST_VALID_RECORD') THEN
|
||||||
|
RGStrNum := 61
|
||||||
|
ELSE IF (S = 'FILE_INSERT_EDIT_HELP') THEN
|
||||||
|
RGStrNum := 62
|
||||||
|
ELSE IF (S = 'FILE_INSERT_HELP') THEN
|
||||||
|
RGStrNum := 63
|
||||||
|
ELSE IF (S = 'FILE_EDIT_HELP') THEN
|
||||||
|
RGStrNum := 64
|
||||||
|
ELSE IF (S = 'CHECK_AREA_NAME_ERROR') THEN
|
||||||
|
RGStrNum := 65
|
||||||
|
ELSE IF (S = 'CHECK_FILE_NAME_ERROR') THEN
|
||||||
|
RGStrNum := 66
|
||||||
|
ELSE IF (S = 'CHECK_DL_PATH_ERROR') THEN
|
||||||
|
RGStrNum := 67
|
||||||
|
ELSE IF (S = 'CHECK_UL_PATH_ERROR') THEN
|
||||||
|
RGStrNum := 68
|
||||||
|
ELSE IF (S = 'CHECK_ARCHIVE_TYPE_ERROR') THEN
|
||||||
|
RGStrNum := 69
|
||||||
|
ELSE IF (S = 'CHECK_COMMENT_TYPE_ERROR') THEN
|
||||||
|
RGStrNum := 70;
|
||||||
|
IF (RGStrNum = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn('Error!');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn('The following string definition is invalid:');
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(' '+S);
|
||||||
|
Found := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Done := FALSE;
|
||||||
|
WITH StrPointer DO
|
||||||
|
BEGIN
|
||||||
|
Pointer := (FileSize(RGStrFile) + 1);
|
||||||
|
TextSize := 0;
|
||||||
|
END;
|
||||||
|
Seek(RGStrFile,FileSize(RGStrFile));
|
||||||
|
WHILE NOT EOF(F) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S[1] = '$') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(StrPointer.TextSize,(Length(S) + 1));
|
||||||
|
BlockWrite(RGStrFile,S,(Length(S) + 1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(StrPointerFile,RGStrNum);
|
||||||
|
Write(StrPointerFile,StrPointer);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(F);
|
||||||
|
Close(RGStrFile);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
IF (Found) THEN
|
||||||
|
WriteLn('Done!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Erase(StrPointerFile);
|
||||||
|
Erase(RGStrFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
CLrScr;
|
||||||
|
WriteLn('Renegade Language String Compiler Version 3.1');
|
||||||
|
Writeln('Copyright 2009 - The Renegade Developement Team');
|
||||||
|
IF (NOT Exist('RGLNG.TXT')) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'RGLNG.TXT does not exist!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT Exist('RGMAIN.TXT')) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'RGMAIN.TXT does not exists!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT Exist('RGNOTE.TXT')) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'RGNOTE.TXT does not exists!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT Exist('RGSCFG.TXT')) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'RGSCFG.TXT does not exists!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (NOT Exist('FAELNG.TXT')) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn;
|
||||||
|
WriteLn(^G^G^G'FAELNG.TXT does not exists!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
CompileLanguageStrings;
|
||||||
|
CompileMainStrings;
|
||||||
|
CompileNoteStrings;
|
||||||
|
CompileSysOpStrings;
|
||||||
|
CompileFileAreaEditorStrings;
|
||||||
|
END.
|
||||||
Binary file not shown.
|
|
@ -0,0 +1,103 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
PROGRAM RGQUOTE;
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
StrPointerRec = RECORD
|
||||||
|
Pointer,
|
||||||
|
TextSize: LongInt;
|
||||||
|
END;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
RGStrFile: FILE;
|
||||||
|
StrPointerFile: FILE OF StrPointerRec;
|
||||||
|
StrPointer: StrPointerRec;
|
||||||
|
F: Text;
|
||||||
|
S: STRING;
|
||||||
|
RGStrNum: LongInt;
|
||||||
|
Done,Found: Boolean;
|
||||||
|
|
||||||
|
FUNCTION AllCaps(S: STRING): STRING;
|
||||||
|
VAR
|
||||||
|
I: Integer;
|
||||||
|
BEGIN
|
||||||
|
FOR I := 1 TO Length(S) DO
|
||||||
|
IF (S[I] IN ['a'..'z']) THEN
|
||||||
|
S[I] := Chr(Ord(S[I]) - Ord('a')+Ord('A'));
|
||||||
|
AllCaps := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION Exist(FN: STRING): Boolean;
|
||||||
|
VAR
|
||||||
|
DirInfo: SearchRec;
|
||||||
|
BEGIN
|
||||||
|
FindFirst(FN,AnyFile,DirInfo);
|
||||||
|
Exist := (DosError = 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
CLrScr;
|
||||||
|
WriteLn('Renegade Quote String Compiler Version 1.0');
|
||||||
|
Writeln('Copyright 2006 - The Renegade Developement Team');
|
||||||
|
WriteLn;
|
||||||
|
IF (ParamCount < 1) THEN
|
||||||
|
Writeln(^G^G^G'Please specify a file name!')
|
||||||
|
ELSE IF (Pos('.',ParamStr(1)) = 0) THEN
|
||||||
|
WriteLn(^G^G^G'Please Specify a valid file name (Example: "Name.Ext")')
|
||||||
|
ELSE IF (Length(ParamStr(1)) > 12) THEN
|
||||||
|
Writeln(^G^G^G'The file name must not be longer then twelve characters!')
|
||||||
|
ELSE IF (NOT Exist(ParamStr(1))) THEN
|
||||||
|
WriteLn(^G^G^G'That file name was not found!')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := ParamStr(1);
|
||||||
|
Write('Compiling strings ... ');
|
||||||
|
Found := TRUE;
|
||||||
|
Assign(StrPointerFile,Copy(S,1,(Pos('.',S) - 1))+'.PTR');
|
||||||
|
ReWrite(StrPointerFile);
|
||||||
|
Assign(RGStrFile,Copy(S,1,(Pos('.',S) - 1))+'.DAT');
|
||||||
|
ReWrite(RGStrFile,1);
|
||||||
|
Assign(F,ParamStr(1));
|
||||||
|
Reset(F);
|
||||||
|
WHILE NOT EOF(F) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S <> '') AND (S[1] = '$') THEN
|
||||||
|
BEGIN
|
||||||
|
Delete(S,1,1);
|
||||||
|
S := AllCaps(S);
|
||||||
|
Done := FALSE;
|
||||||
|
WITH StrPointer DO
|
||||||
|
BEGIN
|
||||||
|
Pointer := (FileSize(RGStrFile) + 1);
|
||||||
|
TextSize := 0;
|
||||||
|
END;
|
||||||
|
Seek(RGStrFile,FileSize(RGStrFile));
|
||||||
|
WHILE NOT EOF(F) AND (NOT Done) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(F,S);
|
||||||
|
IF (S[1] = '$') THEN
|
||||||
|
Done := TRUE
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(StrPointer.TextSize,(Length(S) + 1));
|
||||||
|
BlockWrite(RGStrFile,S,(Length(S) + 1));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(StrPointerFile,FileSize(StrPointerFile));
|
||||||
|
Write(StrPointerFile,StrPointer);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(F);
|
||||||
|
Close(RGStrFile);
|
||||||
|
Close(StrPointerFile);
|
||||||
|
WriteLn('Done!')
|
||||||
|
END;
|
||||||
|
END.
|
||||||
Binary file not shown.
|
|
@ -0,0 +1,157 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
unit RPScreen;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
uses
|
||||||
|
Windows;
|
||||||
|
|
||||||
|
type
|
||||||
|
TScreenBuf = Array[1..25, 1..80] of TCharInfo; // REETODO Don't hardcode to 80x25
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RPBlockCursor;
|
||||||
|
procedure RPGotoXY(xy: Word);
|
||||||
|
procedure RPHideCursor;
|
||||||
|
procedure RPInsertCursor;
|
||||||
|
procedure RPRestoreScreen(var screenBuf: TScreenBuf);
|
||||||
|
procedure RPSaveScreen(var screenBuf: TScreenBuf);
|
||||||
|
function RPScreenSizeX: Word;
|
||||||
|
function RPScreenSizeY: Word;
|
||||||
|
procedure RPSetAttrAt(x, y, attr: Word);
|
||||||
|
procedure RPShowCursor;
|
||||||
|
function RPWhereXY: Word;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
var
|
||||||
|
StdOut: THandle;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
procedure RPBlockCursor;
|
||||||
|
var
|
||||||
|
CCI: TConsoleCursorInfo;
|
||||||
|
begin
|
||||||
|
CCI.bVisible := true;
|
||||||
|
CCI.dwSize := 15;
|
||||||
|
SetConsoleCursorInfo(StdOut, CCI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RPGotoXY(xy: Word);
|
||||||
|
var
|
||||||
|
Coord: TCoord;
|
||||||
|
begin
|
||||||
|
Coord.x := xy AND $00FF;
|
||||||
|
Coord.y := xy AND $FF00 SHR 8;
|
||||||
|
SetConsoleCursorPosition(StdOut, Coord);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RPHideCursor;
|
||||||
|
var
|
||||||
|
CCI: TConsoleCursorInfo;
|
||||||
|
begin
|
||||||
|
GetConsoleCursorInfo(StdOut, CCI);
|
||||||
|
CCI.bVisible := false;
|
||||||
|
SetConsoleCursorInfo(StdOut, CCI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RPInsertCursor;
|
||||||
|
var
|
||||||
|
CCI: TConsoleCursorInfo;
|
||||||
|
begin
|
||||||
|
CCI.bVisible := true;
|
||||||
|
CCI.dwSize := 99;
|
||||||
|
SetConsoleCursorInfo(StdOut, CCI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ REETODO Should detect screen size }
|
||||||
|
procedure RPRestoreScreen(var screenBuf: TScreenBuf);
|
||||||
|
var
|
||||||
|
BufSize : TCoord;
|
||||||
|
WritePos : TCoord;
|
||||||
|
DestRect : TSmallRect;
|
||||||
|
begin
|
||||||
|
BufSize.X := 80;
|
||||||
|
BufSize.Y := 25;
|
||||||
|
WritePos.X := 0;
|
||||||
|
WritePos.Y := 0;
|
||||||
|
DestRect.Left := 0;
|
||||||
|
DestRect.Top := 0;
|
||||||
|
DestRect.Right := 79;
|
||||||
|
DestRect.Bottom := 24;
|
||||||
|
WriteConsoleOutput(StdOut, @screenBuf[1][1], BufSize, WritePos, DestRect);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ REETODO Should detect screen size }
|
||||||
|
procedure RPSaveScreen(var screenBuf: TScreenBuf);
|
||||||
|
var
|
||||||
|
BufSize : TCoord;
|
||||||
|
ReadPos : TCoord;
|
||||||
|
SourceRect : TSmallRect;
|
||||||
|
begin
|
||||||
|
BufSize.X := 80;
|
||||||
|
BufSize.Y := 25;
|
||||||
|
ReadPos.X := 0;
|
||||||
|
ReadPos.Y := 0;
|
||||||
|
SourceRect.Left := 0;
|
||||||
|
SourceRect.Top := 0;
|
||||||
|
SourceRect.Right := 79;
|
||||||
|
SourceRect.Bottom := 24;
|
||||||
|
ReadConsoleOutput(StdOut, @screenBuf[1][1], BufSize, ReadPos, SourceRect);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RPScreenSizeX: Word;
|
||||||
|
var
|
||||||
|
CSBI: TConsoleScreenBufferInfo;
|
||||||
|
begin
|
||||||
|
GetConsoleScreenBufferInfo(StdOut, CSBI);
|
||||||
|
RPScreenSizeX := CSBI.srWindow.Right - CSBI.srWindow.Left + 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RPScreenSizeY: Word;
|
||||||
|
var
|
||||||
|
CSBI: TConsoleScreenBufferInfo;
|
||||||
|
begin
|
||||||
|
GetConsoleScreenBufferInfo(StdOut, CSBI);
|
||||||
|
RPScreenSizeY := CSBI.srWindow.Bottom - CSBI.srWindow.Top + 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RPSetAttrAt(x, y, attr: Word);
|
||||||
|
var
|
||||||
|
NumWritten: LongWord;
|
||||||
|
WriteCoord: TCoord;
|
||||||
|
begin
|
||||||
|
WriteCoord.X := x;
|
||||||
|
WriteCoord.Y := y;
|
||||||
|
WriteConsoleOutputAttribute(StdOut, @attr, 1, WriteCoord, NumWritten);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RPShowCursor;
|
||||||
|
var
|
||||||
|
CCI: TConsoleCursorInfo;
|
||||||
|
begin
|
||||||
|
GetConsoleCursorInfo(StdOut, CCI);
|
||||||
|
CCI.bVisible := true;
|
||||||
|
SetConsoleCursorInfo(StdOut, CCI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RPWhereXY: Word;
|
||||||
|
var
|
||||||
|
CSBI: TConsoleScreenBufferInfo;
|
||||||
|
begin
|
||||||
|
GetConsoleScreenBufferInfo(StdOut, CSBI);
|
||||||
|
RPWhereXY := CSBI.dwCursorPosition.x + (CSBI.dwCursorPosition.y SHL 8);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
BEGIN
|
||||||
|
StdOut := GetStdHandle(STD_OUTPUT_HANDLE);
|
||||||
|
{$ENDIF}
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,431 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT Script;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ReadQ(CONST FileN: AStr);
|
||||||
|
PROCEDURE ReadASW(UserN: Integer; FN: AStr);
|
||||||
|
PROCEDURE ReadASW1(MenuOption: Str50);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos,
|
||||||
|
Doors,
|
||||||
|
MiscUser,
|
||||||
|
SysOp2G,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE ReadQ(CONST FileN: AStr);
|
||||||
|
VAR
|
||||||
|
InFile,
|
||||||
|
OutFile,
|
||||||
|
OutFile1: Text;
|
||||||
|
C: Char;
|
||||||
|
OutP,
|
||||||
|
Lin,
|
||||||
|
S,
|
||||||
|
Mult,
|
||||||
|
Got,
|
||||||
|
LastInp,
|
||||||
|
InFileName,
|
||||||
|
OutFileName: AStr;
|
||||||
|
PS: PathStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
I,
|
||||||
|
X: Integer;
|
||||||
|
|
||||||
|
PROCEDURE GoToLabel(Got: AStr);
|
||||||
|
VAR
|
||||||
|
S: AStr;
|
||||||
|
BEGIN
|
||||||
|
Got := ':'+AllCaps(Got);
|
||||||
|
Reset(InFile);
|
||||||
|
REPEAT
|
||||||
|
ReadLn(InFile,S);
|
||||||
|
UNTIL (EOF(InFile)) OR (AllCaps(S) = Got);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DumpToFile;
|
||||||
|
VAR
|
||||||
|
NewOutFile: Text;
|
||||||
|
WriteOut: Boolean; { goes to false when passing OLD infoform }
|
||||||
|
BEGIN
|
||||||
|
Assign(NewOutFile,General.MiscPath+'INF'+IntToStr(ThisNode)+'.TMP');
|
||||||
|
ReWrite(NewOutFile);
|
||||||
|
Reset(OutFile);
|
||||||
|
WriteOut := TRUE;
|
||||||
|
WHILE (NOT EOF(OutFile)) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(OutFile,S);
|
||||||
|
IF (Pos('User: '+Caps(ThisUser.Name), S) > 0) THEN
|
||||||
|
WriteOut := FALSE
|
||||||
|
ELSE IF (NOT WriteOut) THEN
|
||||||
|
IF (Pos('User: ', S) > 0) THEN
|
||||||
|
WriteOut := TRUE;
|
||||||
|
IF (WriteOut) THEN
|
||||||
|
WriteLn(NewOutFile,S);
|
||||||
|
END;
|
||||||
|
Reset(OutFile1);
|
||||||
|
WHILE (NOT EOF(OutFile1)) DO
|
||||||
|
BEGIN
|
||||||
|
ReadLn(OutFile1,S);
|
||||||
|
WriteLn(NewOutFile,S);
|
||||||
|
END;
|
||||||
|
Close(OutFile1);
|
||||||
|
Close(OutFile);
|
||||||
|
Close(NewOutFile);
|
||||||
|
Kill(General.MiscPath+NS+'.ASW');
|
||||||
|
Erase(OutFile1);
|
||||||
|
ReName(NewOutFile,General.MiscPath+NS+'.ASW');
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
InFileName := FileN;
|
||||||
|
FSplit(InFileName,PS,NS,ES);
|
||||||
|
InFileName := PS+NS+'.INF';
|
||||||
|
IF (NOT Exist(InFileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
InFileName := General.MiscPath+NS+'.INF';
|
||||||
|
IF (NOT Exist(InFileName)) THEN
|
||||||
|
BEGIN
|
||||||
|
S := '* Infoform not found: '+FileN;
|
||||||
|
SysOpLog(S);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (OkAvatar) AND Exist(General.MiscPath+NS+'.INV') THEN
|
||||||
|
InFileName := General.MiscPath+NS+'.INV'
|
||||||
|
ELSE IF (OkAnsi) AND Exist(General.MiscPath+NS+'.INA') THEN
|
||||||
|
InFileName := General.MiscPath+NS+'.INA';
|
||||||
|
END
|
||||||
|
ELSE IF (OkAvatar) AND Exist(PS+NS+'.INV') THEN
|
||||||
|
InFileName := PS+NS+'.INV'
|
||||||
|
ELSE IF (OkAnsi) AND Exist(PS+NS+'.INA') THEN
|
||||||
|
InFileName := PS+NS+'.INA';
|
||||||
|
Assign(InFile,InFileName);
|
||||||
|
Reset(InFile);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('* Infoform not found: '+FileN);
|
||||||
|
SysOpLog(S);
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
FSplit(InFileName,PS,NS,ES);
|
||||||
|
OutFileName := General.MiscPath+NS+'.ASW';
|
||||||
|
Assign(OutFile1,General.MiscPath+'TMP'+IntToStr(ThisNode)+'.ASW');
|
||||||
|
ReWrite(OutFile1);
|
||||||
|
SysOpLog('* Answered InfoForm "'+FileN+'"');
|
||||||
|
Assign(OutFile,OutFileName);
|
||||||
|
WriteLn(OutFile1,'User: '+Caps(ThisUser.name));
|
||||||
|
WriteLn(OutFile1,'Date: '+Dat);
|
||||||
|
WriteLn(OutFile1);
|
||||||
|
NL;
|
||||||
|
PrintingFile := TRUE;
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
X := 0;
|
||||||
|
REPEAT
|
||||||
|
Inc(X);
|
||||||
|
Read(InFile,OutP[X]);
|
||||||
|
IF EOF(InFile) THEN {check again incase avatar parameter}
|
||||||
|
BEGIN
|
||||||
|
Inc(X);
|
||||||
|
Read(InFile,OutP[X]);
|
||||||
|
IF EOF(InFile) THEN
|
||||||
|
Dec(X);
|
||||||
|
END;
|
||||||
|
UNTIL ((OutP[X] = ^M) AND NOT (OutP[X - 1] IN [^V,^Y])) OR (X = 159) OR EOF(InFile) OR HangUp;
|
||||||
|
OutP[0] := Chr(X);
|
||||||
|
IF (Pos(^[,OutP) > 0) OR (Pos(^V,OutP) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CROff := TRUE;
|
||||||
|
CtrlJOff := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (OutP[X] = ^M) THEN
|
||||||
|
Dec(OutP[0]);
|
||||||
|
IF (OutP[1] = ^J) THEN
|
||||||
|
Delete(OutP,1,1);
|
||||||
|
END;
|
||||||
|
IF (Pos('*',OutP) <> 0) AND (OutP[1] <> ';') THEN
|
||||||
|
OutP := ';A'+OutP;
|
||||||
|
IF (Length(OutP) = 0) THEN
|
||||||
|
NL
|
||||||
|
ELSE
|
||||||
|
CASE OutP[1] OF
|
||||||
|
';' : BEGIN
|
||||||
|
IF (Pos('*',OutP) <> 0) THEN
|
||||||
|
IF (OutP[2] <> 'D') THEN
|
||||||
|
OutP := Copy(OutP,1,(Pos('*',OutP) - 1));
|
||||||
|
Lin := Copy(OutP,3,255);
|
||||||
|
I := (80 - Length(Lin));
|
||||||
|
S := Copy(OutP,1,2);
|
||||||
|
IF (S[1] = ';') THEN
|
||||||
|
CASE S[2] OF
|
||||||
|
'R','F','V','C','D','G','I','K','L','Q','S','T',';': I := 1; { DO nothing }
|
||||||
|
ELSE IF (Lin[1] = ';') THEN
|
||||||
|
Prompt(Copy(Lin,2,255))
|
||||||
|
ELSE
|
||||||
|
Prompt(Lin);
|
||||||
|
END;
|
||||||
|
S := #1#1#1;
|
||||||
|
CASE OutP[2] OF
|
||||||
|
'A' : InputL(S,I);
|
||||||
|
'B' : Input(S,I);
|
||||||
|
'C' : BEGIN
|
||||||
|
Mult := '';
|
||||||
|
I := 1;
|
||||||
|
S := Copy(OutP,Pos('"',OutP),(Length(OutP) - Pos('"',OutP)));
|
||||||
|
REPEAT
|
||||||
|
Mult := Mult + S[I];
|
||||||
|
Inc(I);
|
||||||
|
UNTIL (S[I] = '"') OR (I > Length(S));
|
||||||
|
Lin := Copy(OutP,(I + 3),(Length(S) - (I - 1)));
|
||||||
|
Prompt(Lin);
|
||||||
|
OneK(C,Mult,TRUE,TRUE);
|
||||||
|
S := C;
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
DoDoorFunc(OutP[3],Copy(OutP,4,(Length(OutP) - 3)));
|
||||||
|
S := #0#0#0;
|
||||||
|
END;
|
||||||
|
'F' : BEGIN
|
||||||
|
ChangeARFlags(Copy(OutP,3,255));
|
||||||
|
OutP := #0#0#0
|
||||||
|
END;
|
||||||
|
'G' : BEGIN
|
||||||
|
Got := Copy(OutP,3,(Length(OutP) - 2));
|
||||||
|
GoToLabel(Got);
|
||||||
|
S := #0#0#0;
|
||||||
|
END;
|
||||||
|
'S' : BEGIN
|
||||||
|
Delete(OutP,1,3);
|
||||||
|
IF AACS(Copy(OutP,1,(Pos('"',OutP) - 1))) THEN
|
||||||
|
BEGIN
|
||||||
|
Got := Copy(OutP,(Pos(',',OutP) + 1),255);
|
||||||
|
GoToLabel(Got);
|
||||||
|
END;
|
||||||
|
S := #0#0#0;
|
||||||
|
END;
|
||||||
|
'H' : HangUp := TRUE;
|
||||||
|
'I' : BEGIN
|
||||||
|
Mult := Copy(OutP,3,(Length(OutP) - 2));
|
||||||
|
I := Pos(',',Mult);
|
||||||
|
IF (I <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Got := Copy(Mult,(I + 1),(Length(Mult) - I));
|
||||||
|
Mult := Copy(Mult,1,(I - 1));
|
||||||
|
IF (AllCaps(LastInp) = AllCaps(Mult)) THEN
|
||||||
|
GoToLabel(Got);
|
||||||
|
END;
|
||||||
|
S := #1#1#1;
|
||||||
|
OutP := #0#0#0;
|
||||||
|
END;
|
||||||
|
'K' : BEGIN
|
||||||
|
Close(InFile);
|
||||||
|
Close(OutFile1);
|
||||||
|
Erase(OutFile1);
|
||||||
|
SysOpLog('* InfoForm aborted.');
|
||||||
|
PrintingFile := FALSE;
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
'L' : BEGIN
|
||||||
|
S := Copy(OutP,3,(Length(OutP) - 2));
|
||||||
|
WriteLn(OutFile1,MCI(S));
|
||||||
|
S := #0#0#0;
|
||||||
|
END;
|
||||||
|
'Q' : BEGIN
|
||||||
|
WHILE NOT EOF(InFile) DO
|
||||||
|
ReadLn(InFile,S);
|
||||||
|
S := #0#0#0;
|
||||||
|
END;
|
||||||
|
'R' : BEGIN
|
||||||
|
ChangeACFlags(Copy(OutP,3,255));
|
||||||
|
OutP := #0#0#0;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
S := Copy(OutP,3,(Length(OutP) - 2));
|
||||||
|
PrintF(S);
|
||||||
|
S := #0#0#0;
|
||||||
|
END;
|
||||||
|
'Y' : BEGIN
|
||||||
|
IF YN(0,TRUE) THEN
|
||||||
|
S := 'YES'
|
||||||
|
ELSE
|
||||||
|
S := 'NO';
|
||||||
|
IF (Lin[1] = ';') THEN
|
||||||
|
OutP := #0#0#0;
|
||||||
|
END;
|
||||||
|
'N' : BEGIN
|
||||||
|
IF YN(0,FALSE) THEN
|
||||||
|
S := 'YES'
|
||||||
|
ELSE
|
||||||
|
S := 'NO';
|
||||||
|
IF (Lin[1] = ';') THEN
|
||||||
|
OutP := #0#0#0
|
||||||
|
END;
|
||||||
|
'V' : IF (UpCase(OutP[3]) IN ['!'..'~']) THEN
|
||||||
|
AutoValidate(ThisUser,UserNum,UpCase(OutP[3]));
|
||||||
|
';' : S := #0#0#0;
|
||||||
|
END;
|
||||||
|
IF (S <> #1#1#1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (OutP <> #0#0#0) THEN
|
||||||
|
OutP := Lin + S;
|
||||||
|
LastInp := S;
|
||||||
|
END;
|
||||||
|
IF (S = #0#0#0) THEN
|
||||||
|
OutP := #0#0#0;
|
||||||
|
END;
|
||||||
|
':' : OutP := #0#0#0;
|
||||||
|
ELSE
|
||||||
|
PrintACR(OutP);
|
||||||
|
END;
|
||||||
|
IF (OutP <> #0#0#0) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Pos('%CL',OutP) <> 0) THEN
|
||||||
|
Delete(OutP,Pos('%CL',OutP),3);
|
||||||
|
WriteLn(OutFile1,MCI(OutP));
|
||||||
|
END;
|
||||||
|
UNTIL ((EOF(InFile)) OR (HangUp));
|
||||||
|
Close(OutFile1);
|
||||||
|
Close(InFile);
|
||||||
|
IF (HangUp) THEN
|
||||||
|
BEGIN
|
||||||
|
WriteLn(OutFile1);
|
||||||
|
WriteLn(OutFile1,'** HUNG UP **');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
DumpToFile;
|
||||||
|
PrintingFile := FALSE;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReadASW(UserN: Integer; FN: AStr);
|
||||||
|
VAR
|
||||||
|
QF: Text;
|
||||||
|
User: UserRecordType;
|
||||||
|
QS: AStr;
|
||||||
|
PS: PathStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
UserFound: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ExactMatch;
|
||||||
|
BEGIN
|
||||||
|
Reset(QF);
|
||||||
|
REPEAT
|
||||||
|
ReadLn(QF,QS);
|
||||||
|
IF (Pos('User: '+Caps(User.Name),QS) > 0) THEN
|
||||||
|
UserFound := TRUE;
|
||||||
|
IF (NOT Empty) THEN
|
||||||
|
WKey;
|
||||||
|
UNTIL (EOF(QF)) OR (UserFound) OR (Abort);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
IF ((UserN >= 1) AND (UserN <= (MaxUsers - 1))) THEN
|
||||||
|
LoadURec(User,UserN)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('Invalid user number.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FSplit(FN,PS,NS,ES);
|
||||||
|
FN := General.MiscPath+NS+'.ASW';
|
||||||
|
IF (NOT Exist(FN)) THEN
|
||||||
|
BEGIN
|
||||||
|
FN := General.DataPath+NS+'.ASW';
|
||||||
|
IF (NOT Exist(FN)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('Answers file not found.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Assign(QF,FN);
|
||||||
|
Reset(QF);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
Print('"'+FN+'": unable to open.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
UserFound := FALSE;
|
||||||
|
ExactMatch;
|
||||||
|
IF (NOT UserFound) AND (NOT Abort) THEN
|
||||||
|
Print('That user has not completed the questionnaire.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (CoSysOp) THEN
|
||||||
|
Print(QS);
|
||||||
|
REPEAT
|
||||||
|
WKey;
|
||||||
|
ReadLn(QF,QS);
|
||||||
|
IF (Copy(QS,1,6) <> 'Date: ') OR (CoSysOp) THEN
|
||||||
|
IF (Copy(QS,1,6) <> 'User: ') THEN
|
||||||
|
PrintACR(QS)
|
||||||
|
ELSE
|
||||||
|
UserFound := FALSE;
|
||||||
|
UNTIL EOF(QF) OR (NOT UserFound) OR (Abort) OR (HangUp);
|
||||||
|
END;
|
||||||
|
Close(QF);
|
||||||
|
END;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ReadASW1(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
PS: PathStr;
|
||||||
|
NS: NameStr;
|
||||||
|
ES: ExtStr;
|
||||||
|
UserN: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (MenuOption = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Prt('Enter filename: ');
|
||||||
|
MPL(8);
|
||||||
|
Input(MenuOption,8);
|
||||||
|
NL;
|
||||||
|
IF (MenuOption = '') THEN
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
FSplit(MenuOption,PS,NS,ES);
|
||||||
|
MenuOption := AllCaps(General.DataPath+NS+'.ASW');
|
||||||
|
IF (NOT Exist(MenuOption)) THEN
|
||||||
|
BEGIN
|
||||||
|
MenuOption := AllCaps(General.MiscPath+NS+'.ASW');
|
||||||
|
IF (NOT Exist(MenuOption)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('InfoForm answer file not found: "'+MenuOption+'"');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Enter the name of the user to view: ');
|
||||||
|
Prt(':');
|
||||||
|
LFindUserWS(UserN);
|
||||||
|
IF (UserN <> 0) THEN
|
||||||
|
ReadASW(UserN,MenuOption)
|
||||||
|
ELSE IF (CoSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
IF PYNQ('List entire answer file? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
PrintF(NS+'.ASW');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,79 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT ShortMsg;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ReadShortMessage;
|
||||||
|
PROCEDURE SendShortMessage(CONST UNum: Integer; CONST Message: AStr);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
PROCEDURE ReadShortMessage;
|
||||||
|
VAR
|
||||||
|
ShortMsgFile: FILE OF ShortMessageRecordType;
|
||||||
|
ShortMsg: ShortMessageRecordType;
|
||||||
|
RecNum: LongInt;
|
||||||
|
BEGIN
|
||||||
|
Assign(ShortMsgFile,General.DataPath+'SHORTMSG.DAT');
|
||||||
|
Reset(ShortMsgFile);
|
||||||
|
IF (IOResult = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
UserColor(1);
|
||||||
|
RecNum := 0;
|
||||||
|
WHILE (RecNum <= (FileSize(ShortMsgFile) - 1)) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ShortMsgFile,RecNum);
|
||||||
|
Read(ShortMsgFile,ShortMsg);
|
||||||
|
IF (ShortMsg.Destin = UserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Print(ShortMsg.Msg);
|
||||||
|
ShortMsg.Destin := -1;
|
||||||
|
Seek(ShortMsgFile,RecNum);
|
||||||
|
Write(ShortMsgFile,ShortMsg);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(ShortMsgFile);
|
||||||
|
UserColor(1);
|
||||||
|
END;
|
||||||
|
Exclude(ThisUser.Flags,SMW);
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SendShortMessage(CONST UNum: Integer; CONST Message: AStr);
|
||||||
|
VAR
|
||||||
|
ShortMsgFile: FILE OF ShortMessageRecordType;
|
||||||
|
ShortMsg: ShortMessageRecordType;
|
||||||
|
User: UserRecordType;
|
||||||
|
BEGIN
|
||||||
|
IF (UNum >= 1) AND (UNum <= (MaxUsers - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Assign(ShortMsgFile,General.DataPath+'SHORTMSG.DAT');
|
||||||
|
Reset(ShortMsgFile);
|
||||||
|
IF (IOResult = 2) THEN
|
||||||
|
ReWrite(ShortMsgFile);
|
||||||
|
Seek(ShortMsgFile,FileSize(ShortMsgFile));
|
||||||
|
WITH ShortMsg DO
|
||||||
|
BEGIN
|
||||||
|
Msg := Message;
|
||||||
|
Destin := UNum;
|
||||||
|
END;
|
||||||
|
Write(ShortMsgFile,ShortMsg);
|
||||||
|
Close(ShortMsgFile);
|
||||||
|
LoadURec(User,UNum);
|
||||||
|
Include(User.Flags,SMW);
|
||||||
|
SaveURec(User,UNum);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,59 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
UNIT SPAWNO;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
CONST
|
||||||
|
(* symbolic constants for specifying permissible swap locations *)
|
||||||
|
(* add/or together the desired destinations *)
|
||||||
|
Swap_Disk = 0;
|
||||||
|
Swap_XMS = 1;
|
||||||
|
Swap_EMS = 2;
|
||||||
|
Swap_Ext = 4;
|
||||||
|
Swap_All = $FF; (* swap to any available destination *)
|
||||||
|
|
||||||
|
(* error codes *)
|
||||||
|
ENotFound = 2;
|
||||||
|
ENoPath = 3;
|
||||||
|
EAccess = 5;
|
||||||
|
ENoMem = 8;
|
||||||
|
E2Big = 20;
|
||||||
|
EWriteFault = 29;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
Spawno_Error: Integer; (* error code when Spawn returns -1 *)
|
||||||
|
|
||||||
|
PROCEDURE Init_Spawno(Swap_Dirs: STRING; Swap_Types: Integer; Min_Res: Integer; Res_Stack: Integer);
|
||||||
|
(* Min_Res = minimum number of paragraphs to keep resident
|
||||||
|
Res_Stack = minimum paragraphs of stack to keep resident
|
||||||
|
(0 = no change)
|
||||||
|
*)
|
||||||
|
|
||||||
|
FUNCTION Spawn(ProgName: STRING; Arguments: STRING; EnvSeg: Integer): Integer;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{$L SPAWNTP.OBJ}
|
||||||
|
|
||||||
|
PROCEDURE Init_Spawno(Swap_Dirs: STRING; Swap_Types: Integer; Min_Res: Integer; Res_Stack: Integer); EXTERNAL;
|
||||||
|
|
||||||
|
FUNCTION Spawn(ProgName: STRING; Arguments: STRING; EnvSeg: Integer): Integer; EXTERNAL;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
PROCEDURE Init_Spawno(Swap_Dirs: STRING; Swap_Types: Integer; Min_Res: Integer; Res_Stack: Integer);
|
||||||
|
BEGIN
|
||||||
|
WriteLn('REETODO SPAWNO Init_Spawno'); Halt;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION Spawn(ProgName: STRING; Arguments: STRING; EnvSeg: Integer): Integer;
|
||||||
|
BEGIN
|
||||||
|
WriteLn('REETODO SPAWNO Spawn'); Halt;
|
||||||
|
END;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,457 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
UNIT STATS;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
Top10UserRecordArray = RECORD
|
||||||
|
UNum: SmallInt;
|
||||||
|
Info: Real;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Top20FileRecordArray = RECORD
|
||||||
|
DirNum,
|
||||||
|
DirRecNum: SmallInt;
|
||||||
|
Downloaded: LongInt;
|
||||||
|
END;
|
||||||
|
|
||||||
|
Top10UserArray = ARRAY [1..10] OF Top10UserRecordArray;
|
||||||
|
Top20FileArray = ARRAY [1..20] OF Top20FileRecordArray;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
Top10User: Top10UserArray;
|
||||||
|
Top20File: Top20FileArray;
|
||||||
|
|
||||||
|
PROCEDURE GetUserStats(MenuOption: Str50);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
File0,
|
||||||
|
File1,
|
||||||
|
File11;
|
||||||
|
|
||||||
|
FUNCTION MaxR(R,R1: Real): Real;
|
||||||
|
BEGIN
|
||||||
|
IF (R1 = 0.0) THEN
|
||||||
|
MaxR := R
|
||||||
|
ELSE
|
||||||
|
MaxR := R1;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION Center(S: AStr; Len: Byte; TF: Boolean): AStr;
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
StrLength: Byte;
|
||||||
|
Which_Way: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Which_Way := TF;
|
||||||
|
StrLength := Length(S);
|
||||||
|
FOR Counter := (StrLength + 1) TO Len DO
|
||||||
|
BEGIN
|
||||||
|
IF (Which_Way) THEN
|
||||||
|
BEGIN
|
||||||
|
S := ' ' + S;
|
||||||
|
Which_Way := FALSE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
S := S + ' ';
|
||||||
|
Which_Way := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Center := S;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitTop10UserArray(VAR Top10User: Top10UserArray);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO 10 DO
|
||||||
|
BEGIN
|
||||||
|
Top10User[Counter].UNum := -1;
|
||||||
|
Top10User[Counter].Info := 0.0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitTop20FileArray(VAR Top20User: Top20FileArray);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := 1 TO 20 DO
|
||||||
|
BEGIN
|
||||||
|
Top20File[Counter].DirNum := -1;
|
||||||
|
Top20File[Counter].DirRecNum := -1;
|
||||||
|
Top20File[Counter].Downloaded := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SortUserDecending(VAR Top10User: Top10UserArray; UNum: Integer; Info: Real);
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
IF (Info > 0.0) THEN
|
||||||
|
FOR Counter := 1 TO 10 DO
|
||||||
|
IF (Info >= Top10User[Counter].Info) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter1 := 10 DOWNTO (Counter + 1) DO
|
||||||
|
Top10User[Counter1] := Top10User[Counter1 - 1];
|
||||||
|
Top10User[Counter].UNum := UNum;
|
||||||
|
Top10User[Counter].Info := Info;
|
||||||
|
Counter := 10;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SortFileDecending(VAR Top20File: Top20FileArray; DirNum,DirRecNum: Integer; Downloaded: LongInt);
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
IF (Downloaded > 0) THEN
|
||||||
|
FOR Counter := 1 to 20 DO
|
||||||
|
IF (Downloaded >= Top20File[Counter].Downloaded) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR Counter1 := 20 DOWNTO (Counter + 1) DO
|
||||||
|
Top20File[Counter1] := Top20File[Counter1 - 1];
|
||||||
|
Top20File[Counter].DirNum := DirNum;
|
||||||
|
Top20File[Counter].DirRecNum := DirRecNum;
|
||||||
|
Top20File[Counter].Downloaded := Downloaded;
|
||||||
|
Counter := 20;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SearchTop10User(VAR Top10User: Top10UserArray; Cmd: Char; ExcludeUserNum: Integer);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
UNum: Integer;
|
||||||
|
Info: Real;
|
||||||
|
BEGIN
|
||||||
|
InitTop10UserArray(Top10User);
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Reset(UserFile);
|
||||||
|
UNum := 1;
|
||||||
|
WHILE (UNum <= (FileSize(UserFile) - 1)) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (ExcludeUserNum = 0) OR (UNum <> ExcludeUserNum) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(UserFile,UNum);
|
||||||
|
Read(UserFile,User);
|
||||||
|
IF (NOT (Deleted IN User.SFlags)) AND (NOT (LockedOut IN User.SFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : Info := User.TTimeOn;
|
||||||
|
'B' : Info := User.UK;
|
||||||
|
'C' : Info := User.DK;
|
||||||
|
'D' : Info := User.EmailSent;
|
||||||
|
'E' : Info := User.MsgPost;
|
||||||
|
'F' : Info := User.FeedBack;
|
||||||
|
'G' : Info := User.LoggedOn;
|
||||||
|
'H' : Info := User.Uploads;
|
||||||
|
'I' : Info := User.Downloads;
|
||||||
|
'J' : Info := User.FilePoints;
|
||||||
|
'K' : Info := (User.UK / MaxR(1.0,User.DK));
|
||||||
|
'L' : Info := (User.MsgPost / MaxR(1.0,User.LoggedOn));
|
||||||
|
END;
|
||||||
|
SortUserDecending(Top10User,UNum,Info);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(UNum);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SearchTop20AreaFileSpec(FArea: Integer; VAR Top20File: Top20FileArray);
|
||||||
|
VAR
|
||||||
|
F: FileInfoRecordType;
|
||||||
|
DirFileRecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (FileArea <> FArea) THEN
|
||||||
|
ChangeFileArea(FArea);
|
||||||
|
IF (FileArea = FArea) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNo(F,'*.*',DirFileRecNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(FileInfoFile,DirFileRecNum);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
IF (CanSee(F)) THEN
|
||||||
|
SortFileDecending(Top20File,FileArea,DirFileRecNum,F.Downloaded);
|
||||||
|
NRecNo(F,DirFileRecNum);
|
||||||
|
END;
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SearchTop20GlobalFileSpec(VAR Top20File: Top20FileArray);
|
||||||
|
VAR
|
||||||
|
FArea,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
BEGIN
|
||||||
|
InitTop20FileArray(Top20File);
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FArea := 1;
|
||||||
|
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
SearchTop20AreaFileSpec(FArea,Top20File);
|
||||||
|
WKey;
|
||||||
|
IF (Next) THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
END;
|
||||||
|
Inc(FArea);
|
||||||
|
END;
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayTop10UserArray(Top10User: Top10UserArray; Title,Header: AStr; Decimal,Width: Byte);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
TempStr: AStr;
|
||||||
|
Counter,
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^5'+Center('-=[ Top 10 '+Title+' ]=-',78,TRUE));
|
||||||
|
NL;
|
||||||
|
PrintACR('^5## User Name '+Center(Header,55,TRUE));
|
||||||
|
NL;
|
||||||
|
Counter := 1;
|
||||||
|
WHILE (Counter <= 10) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
User.Name := '';
|
||||||
|
IF (Top10User[Counter].UNum >= 1) THEN
|
||||||
|
LoadURec(User,Top10User[Counter].UNum);
|
||||||
|
TempStr := '^5'+PadRightInt(Counter,2)+
|
||||||
|
' '+
|
||||||
|
AOnOff(User.Name = ThisUser.Name,'^7','^0')+
|
||||||
|
User.Name+' ^1';
|
||||||
|
FOR Counter1 := (Length(User.Name) + 1) TO 35 DO
|
||||||
|
TempStr := TempStr + '.';
|
||||||
|
TempStr := TempStr + ' '+AOnOff((Top10User[Counter].Info > 0.0),'^4'
|
||||||
|
+PadRightStr(RealToStr(Top10User[Counter].Info,0,Decimal),Width),'');
|
||||||
|
PrintACR(TempStr);
|
||||||
|
WKey;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayTop20FileArray(Top20File: Top20FileArray);
|
||||||
|
VAR
|
||||||
|
F: FileInfoRecordType;
|
||||||
|
TempStr: AStr;
|
||||||
|
Counter,
|
||||||
|
SaveFileArea: Integer;
|
||||||
|
AddBatch: Boolean;
|
||||||
|
BEGIN
|
||||||
|
SaveFileArea := FileArea;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^5'+Center('-=[ Top 20 Files Downloaded ]=-',78,TRUE));
|
||||||
|
NL;
|
||||||
|
PrintACR('^5## Filename.Ext Number Downloads ## Filename.Ext Number Downloads');
|
||||||
|
NL;
|
||||||
|
FOR Counter := 1 to 10 DO
|
||||||
|
BEGIN
|
||||||
|
F.FileName := '';
|
||||||
|
IF (Counter <= 10) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Top20File[Counter].DirNum > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(Top20File[Counter].DirNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
Seek(FileInfoFile,Top20File[Counter].DirRecNum);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
TempStr := '^5'+PadRightInt(Counter,2);
|
||||||
|
TempStr := TempStr + '^0'+PadRightStr(F.FileName,15);
|
||||||
|
IF (Top20File[Counter].Downloaded > 0) THEN
|
||||||
|
TempStr := TempStr + '^4'+PadRightInt(Top20File[Counter].Downloaded,12)
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + ' ';
|
||||||
|
END;
|
||||||
|
TempStr := TempStr + ' ';
|
||||||
|
F.FileName := '';
|
||||||
|
IF ((Counter + 10) > 10) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Top20File[Counter + 10].DirNum > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(Top20File[Counter + 10].DirNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
Seek(FileInfoFile,Top20File[Counter + 10].DirRecNum);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
TempStr := TempStr + '^5'+PadRightInt(Counter + 10,2);
|
||||||
|
TempStr := TempStr + '^0'+PadRightStr(F.FileName,15);
|
||||||
|
IF (Top20File[Counter + 10].Downloaded > 0) THEN
|
||||||
|
TempStr := TempStr + '^4'+PadRightInt(Top20File[Counter + 10].Downloaded,12)
|
||||||
|
END;
|
||||||
|
PrintACR(TempStr);
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
(*
|
||||||
|
IF (PYNQ('Would you like to download one of these files? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Counter := -1;
|
||||||
|
NL;
|
||||||
|
InputIntegerWOC('Download which file',Counter,1,20);
|
||||||
|
IF (Counter <> -1) THEN
|
||||||
|
IF (Top20File[Counter].DirNum <> -1) AND (Top20File[Counter].DirRecNum <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
InitFileArea(Top20File[Counter].DirNum);
|
||||||
|
IF (BadDownloadPath) THEN
|
||||||
|
Exit;
|
||||||
|
Seek(FileInfoFile,Top20File[Counter].DirRecNum);
|
||||||
|
Read(FileInfoFile,F);
|
||||||
|
NL;
|
||||||
|
DLX(F,Top20File[Counter].DirRecNum,FALSE,Abort);
|
||||||
|
Close(FileInfoFile);
|
||||||
|
Close(ExtInfoFile);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
*)
|
||||||
|
FileArea := SaveFileArea;
|
||||||
|
LoadFileArea(FileArea);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE GetUserStats(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Title,
|
||||||
|
Header: AStr;
|
||||||
|
Decimal,
|
||||||
|
Width: Byte;
|
||||||
|
ExcludeUserNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
MenuOption := ALLCaps(MenuOption);
|
||||||
|
IF (MenuOption = '') OR (NOT (MenuOption[1] IN ['A'..'M'])) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Invalid menu option for user statistics, please inform the SysOp.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
SysOpLog('Invalid menu option for user statistics, valid options are A-M.');
|
||||||
|
END
|
||||||
|
ELSE IF (MenuOption[1] IN ['A'..'L']) THEN
|
||||||
|
BEGIN
|
||||||
|
ExcludeUserNum := 0;
|
||||||
|
IF (Pos(';',MenuOption) <> 0) THEN
|
||||||
|
ExcludeUserNum := StrToInt(Copy(MenuOption,(Pos(';',MenuOption) + 1),50));
|
||||||
|
SearchTop10User(Top10User,MenuOption[1],ExcludeUserNum);
|
||||||
|
CASE UpCase(MenuOption[1]) OF
|
||||||
|
'A' : BEGIN
|
||||||
|
Title := 'High Time Users';
|
||||||
|
Header := 'Minutes Online';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'B' : BEGIN
|
||||||
|
Title := 'File Kbyte Uploaders';
|
||||||
|
Header := 'Kbytes Uploaded';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'C' : BEGIN
|
||||||
|
Title := 'File Kbyte Downloaders';
|
||||||
|
Header := 'Kbytes Downloaded';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
Title := 'Private Message Senders';
|
||||||
|
Header := 'Private Messages Sent';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'E' : BEGIN
|
||||||
|
Title := 'Public Message Posters';
|
||||||
|
Header := 'Messages Posted';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'F' : BEGIN
|
||||||
|
Title := 'SysOp Feedback Senders';
|
||||||
|
Header := 'SysOp Feedback Sent';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'G' : BEGIN
|
||||||
|
Title := 'All Time Callers';
|
||||||
|
Header := 'Calls To The System';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'H' : BEGIN
|
||||||
|
Title := 'File Uploaders';
|
||||||
|
Header := 'Files Uploaded';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'I' : BEGIN
|
||||||
|
Title := 'File Downloaders';
|
||||||
|
Header := 'Files Downloaded';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
Title := 'File Points';
|
||||||
|
Header := 'File Points On Hand';
|
||||||
|
Decimal := 0;
|
||||||
|
Width := 10;
|
||||||
|
END;
|
||||||
|
'K' : BEGIN
|
||||||
|
Title := 'Upload/Download Ratios';
|
||||||
|
Header := 'KB Uploaded for Each KB Downloaded';
|
||||||
|
Decimal := 2;
|
||||||
|
Width := 12;
|
||||||
|
END;
|
||||||
|
'L' : BEGIN
|
||||||
|
Title := 'Post/Call Ratios';
|
||||||
|
Header := 'Public Messages Posted Each Call';
|
||||||
|
Decimal := 2;
|
||||||
|
Width := 12;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
DisplayTop10UserArray(Top10User,Title,Header,Decimal,Width);
|
||||||
|
END
|
||||||
|
ELSE IF (MenuOption[1] = 'M') THEN
|
||||||
|
BEGIN
|
||||||
|
SearchTop20GlobalFileSpec(Top20File);
|
||||||
|
DisplayTop20FileArray(Top20File);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,831 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp1;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ProtocolEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ProtocolEditor;
|
||||||
|
VAR
|
||||||
|
TempProtocol: ProtocolRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ToggleXBFlag(XBFlagT: ProtocolFlagType; VAR XBFlags: PRFlagSet);
|
||||||
|
BEGIN
|
||||||
|
IF (XBFlagT IN XBFlags) THEN
|
||||||
|
Exclude(XBFlags,XBFlagT)
|
||||||
|
ELSE
|
||||||
|
Include(XBFlags,XBFlagT);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleXBFlags(C: Char; VAR XBFlags: PRFlagSet; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempXBFlags: PRFlagSet;
|
||||||
|
BEGIN
|
||||||
|
TempXBFlags := XBFlags;
|
||||||
|
CASE C OF
|
||||||
|
'1' : ToggleXBFlag(ProtActive,XBFlags);
|
||||||
|
'2' : ToggleXBFlag(ProtIsBatch,XBFlags);
|
||||||
|
'3' : ToggleXBFlag(ProtIsResume,XBFlags);
|
||||||
|
'4' : ToggleXBFlag(ProtBiDirectional,XBFlags);
|
||||||
|
'5' : ToggleXBFlag(ProtReliable,XBFlags);
|
||||||
|
'6' : ToggleXBFlag(ProtXferOkCode,XBFlags);
|
||||||
|
END;
|
||||||
|
IF (XBFlags <> TempXBFlags) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitProtocolVars(VAR Protocol: ProtocolRecordType);
|
||||||
|
VAR
|
||||||
|
Counter: BYTE;
|
||||||
|
BEGIN
|
||||||
|
FillChar(Protocol,SizeOf(Protocol),0);
|
||||||
|
WITH Protocol DO
|
||||||
|
BEGIN
|
||||||
|
PRFlags := [ProtXferOkCode];
|
||||||
|
CKeys := '!';
|
||||||
|
Description := '<< New Protocol >>';
|
||||||
|
ACS := '';
|
||||||
|
TempLog := '';
|
||||||
|
DLoadLog := '';
|
||||||
|
ULoadLog := '';
|
||||||
|
DLCmd := '';
|
||||||
|
ULCmd := '';
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
BEGIN
|
||||||
|
DLCode[Counter] := '';
|
||||||
|
ULCode[Counter] := '';
|
||||||
|
END;
|
||||||
|
EnvCmd := '';
|
||||||
|
DLFList := '';
|
||||||
|
MaxChrs := 127;
|
||||||
|
TempLogPF := 0;
|
||||||
|
TempLogPS := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteProtocol(TempProtocol1: ProtocolRecordType; RecNumToDelete: SmallInt);
|
||||||
|
VAR
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumProtocols = 0) THEN
|
||||||
|
Messages(4,0,'protocols')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := -1;
|
||||||
|
InputIntegerWOC('%LFProtocol to delete?',RecNumToDelete,[NumbersOnly],1,NumProtocols);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumProtocols) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
Seek(ProtocolFile,(RecNumToDelete - 1));
|
||||||
|
Read(ProtocolFile,TempProtocol1);
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Print('%LFProtocol: ^5'+TempProtocol1.Description);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting protocol record ...');
|
||||||
|
Dec(RecNumToDelete);
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(ProtocolFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(ProtocolFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNum + 1));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
Seek(ProtocolFile,RecNum);
|
||||||
|
Write(ProtocolFile,Protocol);
|
||||||
|
END;
|
||||||
|
Seek(ProtocolFile,(FileSize(ProtocolFile) - 1));
|
||||||
|
Truncate(ProtocolFile);
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Dec(NumProtocols);
|
||||||
|
SysOpLog('* Deleted Protocol: ^5'+TempProtocol1.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION CmdOk(Protocol: ProtocolRecordType): Boolean;
|
||||||
|
VAR
|
||||||
|
Ok1: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Ok1 := TRUE;
|
||||||
|
WITH Protocol DO
|
||||||
|
IF (DLCmd = 'ASCII') OR (DLCmd = 'BATCH') OR (DLCmd = 'EDIT') OR
|
||||||
|
(DLCmd = 'NEXT') OR (DLCmd = 'QUIT') OR (ULCmd = 'ASCII') OR
|
||||||
|
(ULCmd = 'BATCH') OR (ULCmd = 'EDIT') OR (ULCmd = 'NEXT') OR
|
||||||
|
(ULCmd = 'QUIT') THEN
|
||||||
|
OK1 := FALSE;
|
||||||
|
CmdOk := Ok1;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION DLCodesEmpty(Protocol: ProtocolRecordType): Boolean;
|
||||||
|
VAR
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
DLCodesEmpty := TRUE;
|
||||||
|
FOR Counter1 := 1 TO 6 DO
|
||||||
|
IF (Protocol.DLCode[Counter1] <> '') THEN
|
||||||
|
DLCodesEmpty := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ULCodesEmpty(Protocol: ProtocolRecordType): Boolean;
|
||||||
|
VAR
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
ULCodesEmpty := TRUE;
|
||||||
|
FOR Counter1 := 1 TO 6 DO
|
||||||
|
IF (Protocol.ULCode[Counter1] <> '') THEN
|
||||||
|
ULCodesEmpty := FALSE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckProtocol(Protocol: ProtocolRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Protocol.Ckeys = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The command keys are invalid!^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
2 : IF (Protocol.Description = '<< New Protocol >>') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The description is invalid!^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
3 : IF (CmdOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFLags) AND (Protocol.TempLog <> '') AND
|
||||||
|
(Protocol.TempLogPF = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify the file name position if you utilize the Temp Log.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
4 : IF (CmdOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFLags) AND (Protocol.TempLog <> '') AND
|
||||||
|
(Protocol.TempLogPS = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify the status position if you utilize the Temp Log.');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
5 : IF (CmdOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFLags) AND (Protocol.TempLog <> '') AND
|
||||||
|
(DLCodesEmpty(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify <D>L codes if you utilize the Temp. Log.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
6 : IF (CMDOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFlags) AND (Protocol.DLoadLog <> '') AND
|
||||||
|
(Protocol.TempLog = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify a Temp. Log if you utilize the <D>L Log.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
7 : IF (CmdOk(Protocol)) AND (NOT (ProtIsBatch IN Protocol.PRFlags)) AND (Protocol.ULCmd <> '') AND
|
||||||
|
(ULCodesEmpty(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify <U>L Codes if you utilize the <U>L Command.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
8 : IF (CmdOk(Protocol)) AND (NOT (ProtIsBatch IN Protocol.PRFlags)) AND (Protocol.DLCmd <> '') AND
|
||||||
|
(DLCodesEmpty(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify <D>L Codes if you utilize the <D>L Command.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
9 : IF (CmdOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFlags) AND (Protocol.DLCmd <> '') AND
|
||||||
|
(Protocol.DLFList = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify a DL File List if you utilize the <D>L Command.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
10 : IF (CmdOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFlags) AND (Protocol.DLCmd <> '') AND
|
||||||
|
(Protocol.MaxChrs = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify the Max DOS Chars if you utilize the <D>L Command.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
11 : IF (Protocol.ULCmd = '') AND (Protocol.DLCmd = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify a <U>L or <D>L Command.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
12 : IF (CmdOk(Protocol)) AND (NOT (ProtIsBatch IN Protocol.PRFlags)) AND (Protocol.DLCmd = '') AND
|
||||||
|
(NOT DLCodesEmpty(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify a <D>L Command if you utilize <D>L Codes.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
13 : IF (CmdOk(Protocol)) AND (NOT (ProtIsBatch IN Protocol.PRFlags)) AND (Protocol.ULCmd = '') AND
|
||||||
|
(NOT ULCodesEmpty(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify a <U>L Command if you utilize <U>L Codes.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
14 : IF (CmdOk(Protocol)) AND (ProtIsBatch IN Protocol.PRFlags) AND (Protocol.TempLog = '') AND
|
||||||
|
(NOT DLCodesEmpty(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must specify a Temp Log if you utilize <D>L Codes.^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditProtocol(TempProtocol1: ProtocolRecordType; VAR Protocol: ProtocolRecordType; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr,
|
||||||
|
CmdStr: AStr;
|
||||||
|
Cmd2: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
OK: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH Protocol DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing protocol #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumProtocols))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting protocol #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumProtocols + 1));
|
||||||
|
NL;
|
||||||
|
PrintACR('^1!. Type/protocl: ^5'+
|
||||||
|
AOnOff(ProtActive IN PRFlags,'Active','INACTIVE')+' - '+
|
||||||
|
AOnOff(ProtIsBatch IN PRFlags,'Batch','Single')+
|
||||||
|
AOnOff(ProtIsResume IN PRFlags,' - Resume','')+
|
||||||
|
AOnOff(ProtBiDirectional IN PRFlags,' - Bidirectional','')+
|
||||||
|
AOnOff(ProtReliable IN PRFlags,' - Reliable only',''));
|
||||||
|
PrintACR('^11. Keys/descrip: ^5'+CKeys+'^1 / ^5'+AOnOff(Description = '','*None*',Description)+'^1');
|
||||||
|
PrintACR('^12. ACS required: ^5'+AOnOff(ACS = '','*None*',ACS)+'^1');
|
||||||
|
IF (CmdOk(Protocol)) AND (ProtIsBatch IN PRFLags) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^13. Temp. log : ^5'+AOnOff(TempLog = '','*None*',TempLog));
|
||||||
|
IF (Protocol.TempLog <> '') THEN
|
||||||
|
PrintACR('^1 : File name position: ^5'+IntToStr(TempLogPF)+
|
||||||
|
' ^1/ Status position: ^5'+IntToStr(TempLogPS));
|
||||||
|
END;
|
||||||
|
IF (CmdOk(Protocol)) AND (ProtIsBatch IN PRFLags) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^14. <U>L log : ^5'+AOnOff(ULoadLog = '','*None*',ULoadLog));
|
||||||
|
PrintACR('^1 <D>L log : ^5'+AOnOff(DLoadLog = '','*None*',DLoadLog));
|
||||||
|
END;
|
||||||
|
PrintACR('^15. <U>L command: ^5'+AOnOff(ULCmd = '','*None*',ULCmd));
|
||||||
|
PrintACR('^1 <D>L command: ^5'+AOnOff(DLCmd = '','*None*',DLCmd));
|
||||||
|
IF (ProtIsBatch IN PRFLags) AND (CMDOk(Protocol)) AND (Protocol.DLCmd <> '') THEN
|
||||||
|
PrintACR('^1 : DL File List: ^5'+AOnOff(DLFList = '','*None*',DLFList)+
|
||||||
|
' ^1/ Max DOS chars: ^5'+IntToStr(MaxChrs));
|
||||||
|
IF (CmdOk(Protocol)) THEN
|
||||||
|
PrintACR('^16. Codes mean : ^5'+AOnOff(ProtXferOkCode IN PRFlags,'Transfer Successful','Transfer Failed'));
|
||||||
|
IF (CmdOk(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := '^17. <U>L codes :';
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
TempStr := TempStr + PadLeftStr('^1 ('+IntToStr(Counter)+') "^5'+ULCode[Counter]+'^1" ',13);
|
||||||
|
PrintACR(TempStr);
|
||||||
|
TempStr := '^1 :';
|
||||||
|
FOR Counter := 4 TO 6 DO
|
||||||
|
TempStr := TempStr + PadLeftStr('^1 ('+IntToStr(Counter)+') "^5'+ULCode[Counter]+'^1" ',13);
|
||||||
|
PrintACR(TempStr);
|
||||||
|
TempStr := '^1 <D>L codes :';
|
||||||
|
FOR Counter := 1 TO 3 DO
|
||||||
|
TempStr := TempStr + PadLeftStr('^1 ('+IntToStr(Counter)+') "^5'+DLCode[Counter]+'^1" ',13);
|
||||||
|
PrintACR(TempStr);
|
||||||
|
TempStr := '^1 :';
|
||||||
|
FOR Counter := 4 TO 6 DO
|
||||||
|
TempStr := TempStr + PadLeftStr('^1 ('+IntToStr(Counter)+') "^5'+DLCode[Counter]+'^1" ',13);
|
||||||
|
PrintACR(TempStr);
|
||||||
|
END;
|
||||||
|
IF (CmdOk(Protocol)) THEN
|
||||||
|
PrintACR('^18. Environ. cmd: ^5'+AOnOff(EnvCmd = '','*None*',EnvCmd));
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := '!12345678'
|
||||||
|
ELSE
|
||||||
|
CmdStr := '!12345678[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'!' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Print('%LF^5Protocol types:^1');
|
||||||
|
Print('%LF^11. Protocol active : ^5'+ShowYesNo(ProtActive IN PRFlags));
|
||||||
|
Print('^12. Is batch protocol : ^5'+ShowYesNo(ProtIsBatch IN PRFlags));
|
||||||
|
Print('^13. Is resume protocol: ^5'+ShowYesNo(ProtIsResume IN PRFlags));
|
||||||
|
Print('^14. Is bidirectional : ^5'+ShowYesNo(ProtBiDirectional IN PRFlags));
|
||||||
|
Print('^15. For reliable only : ^5'+ShowYesNo(ProtReliable IN PRFlags));
|
||||||
|
LOneK('%LFNew protocol type? [^51^4-^55^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'12345',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['1'..'5']) THEN
|
||||||
|
ToggleXBFlags(Cmd1,PRFlags,Changed);
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'1' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
TempProtocol1.Ckeys := CKeys;
|
||||||
|
InputWN1('%LFNew command keys: ',CKeys,(SizeOf(Ckeys) - 1),[InterActiveEdit],Changed);
|
||||||
|
CheckProtocol(Protocol,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Ckeys := TempProtocol1.Ckeys;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
TempProtocol1.Description := Description;
|
||||||
|
InputWNWC('%LFNew description: ',Description,(SizeOf(Description) - 1),Changed);
|
||||||
|
CheckProtocol(Protocol,2,2,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Description := TempProtocol1.Description;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
END;
|
||||||
|
'2' : InputWN1('%LFNew ACS: ',ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed);
|
||||||
|
'3' : IF (CmdOk(Protocol)) AND (ProtIsBatch IN PRFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFIf you specify a Temporary Log file, you must also');
|
||||||
|
Print('specify the "File Name" position, "Status" position and');
|
||||||
|
Print('the corresponding Batch <D>L Codes.');
|
||||||
|
InputWN1('%LFNew temporary log: ',TempLog,(SizeOf(TempLog) - 1),[InterActiveEdit],Changed);
|
||||||
|
IF (Protocol.TempLog = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Protocol.TempLogPF := 0;
|
||||||
|
Protocol.TempLogPS := 0;
|
||||||
|
END;
|
||||||
|
IF (ProtIsBatch IN PRFLags) AND (CMDOk(Protocol)) AND (Protocol.TempLog <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
TempProtocol1.TempLogPF := TempLogPF;
|
||||||
|
InputByteWC('%LFNew file name log position',TempLogPF,[DisplayValue,NumbersOnly],0,127,Changed);
|
||||||
|
CheckProtocol(Protocol,3,3,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
TempLogPF := TempProtocol1.TempLogPF;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
TempProtocol1.TempLogPS := TempLogPS;
|
||||||
|
InputByteWC('%LFNew status log position',TempLogPS,[DisplayValue,NumbersOnly],0,127,Changed);
|
||||||
|
CheckProtocol(Protocol,4,4,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
TempLogPS := TempProtocol1.TempLogPS;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'4' : IF (CmdOk(Protocol)) AND (ProtIsBatch IN PRFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
LOneK('%LFFile transfer type? [^5U^4=^5Upload^4,^5D^4=^5Download^4,^5<CR>^4=^5Quit^4]: ',
|
||||||
|
Cmd1,^M'UD',TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'U' : BEGIN
|
||||||
|
Print('%LF^7The permanent batch upload log is not utilized by Renegade!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
Print('%LFIf you specify a permanent batch download log, you must also');
|
||||||
|
Print('specify a temporary log.');
|
||||||
|
InputWN1('%LFNew permanent download log: ',DLoadLog,(SizeOf(DloadLog) - 1),
|
||||||
|
[InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'5' : BEGIN
|
||||||
|
TempStr := #0;
|
||||||
|
LOneK('%LFFile transfer type? [^5U^4=^5Upload^4,^5D^4=^5Download^4,^5<CR>^4=^5Quit^4]: ',
|
||||||
|
Cmd1,^M'UD',TRUE,TRUE);
|
||||||
|
IF (Cmd1 <> ^M) THEN
|
||||||
|
BEGIN
|
||||||
|
LOneK('%LFFile transfer method? [^5E^4=^5External^4,^5I^4=^5Internal^4,^5O^4=^5Off^4,^5<CR>^4=^5Quit^4]: ',
|
||||||
|
Cmd2,^M'EIO',TRUE,TRUE);
|
||||||
|
CASE Cmd2 OF
|
||||||
|
'E' : CASE Cmd1 OF
|
||||||
|
'U' : BEGIN
|
||||||
|
TempStr := ULCmd;
|
||||||
|
IF (CmdOk(Protocol)) AND (NOT (ProtIsBatch IN PRFlags)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFIf you specify an external single upload protocol, you must also');
|
||||||
|
Print('specify single upload <U>L codes.');
|
||||||
|
END;
|
||||||
|
InputWN1('%LF^1New external upload protocol:%LF^4: ',TempStr,(SizeOf(DlCmd) - 1),
|
||||||
|
[InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
TempStr := DLCmd;
|
||||||
|
IF (CmdOk(Protocol)) THEN
|
||||||
|
IF (ProtIsBatch IN PRFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFIf you specify an external batch download protocol, you must');
|
||||||
|
Print('also specify a batch file list and the maximum DOS characters');
|
||||||
|
Print('allowed on the DOS commandline.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LFIf you specify an external single download protocol, you must also');
|
||||||
|
Print('specify single download <D>L codes.');
|
||||||
|
END;
|
||||||
|
InputWN1('%LF^1New external download protocol:%LF^4: ',TempStr,(SizeOf(DlCmd) - 1),
|
||||||
|
[InterActiveEdit],Changed);
|
||||||
|
IF (TempStr = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Protocol.DLFList := '';
|
||||||
|
Protocol.MaxChrs := 127;
|
||||||
|
END;
|
||||||
|
IF (CmdOk(Protocol)) AND (ProtIsBatch IN PRFlags) AND (TempStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
TempProtocol1.DLFList := DLFList;
|
||||||
|
InputWN1('%LFNew batch file list: ',DLFList,(SizeOf(DLFList) - 1),
|
||||||
|
[InterActiveEdit],Changed);
|
||||||
|
CheckProtocol(Protocol,9,9,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
DLFList := TempProtocol1.DLFList;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
TempProtocol1.MaxChrs := MaxChrs;
|
||||||
|
InputByteWC('%LFNew max DOS characters in commandline',MaxChrs,
|
||||||
|
[DisplayValue,NumbersOnly],0,127,Changed);
|
||||||
|
CheckProtocol(Protocol,10,10,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
MaxChrs := TempProtocol1.MaxChrs;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'I' : BEGIN
|
||||||
|
Print('%LF^5Internal protocol types:^1');
|
||||||
|
NL;
|
||||||
|
LCmds(40,3,'ASCII','');
|
||||||
|
LCmds(40,3,'BATCH','');
|
||||||
|
LCmds(40,3,'EDIT','');
|
||||||
|
LCmds(40,3,'NEXT','');
|
||||||
|
LCmds(40,3,'QUIT','');
|
||||||
|
LOneK('%LFNew internal protocol? [^5A^4,^5B^4,^5E^4,^5N^4,^5Q^4,^5<CR>^4=^5Quit^4]: ',
|
||||||
|
Cmd2,^M'ABENQ',TRUE,TRUE);
|
||||||
|
IF (Cmd2 <> ^M) THEN
|
||||||
|
CASE Cmd2 OF
|
||||||
|
'A' : TempStr := 'ASCII';
|
||||||
|
'B' : TempStr := 'BATCH';
|
||||||
|
'E' : TempStr := 'EDIT';
|
||||||
|
'N' : TempStr := 'NEXT';
|
||||||
|
'Q' : TempStr := 'QUIT';
|
||||||
|
END;
|
||||||
|
IF (Cmd2 <> ^M) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
Cmd2 := #0;
|
||||||
|
END;
|
||||||
|
'O' : IF PYNQ('%LFSet to NULL string? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := '';
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (TempStr <> #0) THEN
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'D' : DLCmd := TempStr;
|
||||||
|
'U' : ULCmd := TempStr;
|
||||||
|
END;
|
||||||
|
IF (NOT CmdOk(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
TempLog := '';
|
||||||
|
ULoadLog := '';
|
||||||
|
DLoadLog := '';
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
BEGIN
|
||||||
|
ULCode[Counter] := '';
|
||||||
|
DLCode[Counter] := '';
|
||||||
|
END;
|
||||||
|
EnvCmd := '';
|
||||||
|
DLFList := '';
|
||||||
|
MaxChrs := 127;
|
||||||
|
TempLogPF := 0;
|
||||||
|
TempLogPS := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Cmd2 := #0;
|
||||||
|
END;
|
||||||
|
'6' : IF (CmdOk(Protocol)) THEN
|
||||||
|
ToggleXBFlags('6',PRFlags,Changed);
|
||||||
|
'7' : IF (CmdOk(Protocol)) THEN
|
||||||
|
BEGIN
|
||||||
|
LOneK('%LFFile transfer type? [^5U^4=^5Upload^4,^5D^4=^5Download^4,^5<CR>^4=^5Quit^4]: ',
|
||||||
|
Cmd1,'UD'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'U' : BEGIN
|
||||||
|
IF (ProtIsBatch IN PRFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The batch upload codes are not utilized by Renegade!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^5New upload codes:^1');
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
InputWN1('%LFCode #'+IntToStr(Counter)+': ',ULCode[Counter],
|
||||||
|
(SizeOf(ULCode[Counter]) - 1),[InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
Print('%LF^5New download codes:^1');
|
||||||
|
FOR Counter := 1 TO 6 DO
|
||||||
|
InputWN1('%LFCode #'+IntToStr(Counter)+': ',DLCode[Counter],
|
||||||
|
(SizeOf(DlCode[Counter]) - 1),[InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'8' : IF (CmdOk(Protocol)) THEN
|
||||||
|
InputWN1('%LFNew environment setup commandline:%LF: ',EnvCmd,(SizeOf(EnvCmd) - 1),[InterActiveEdit],Changed);
|
||||||
|
'[' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit < NumProtocols) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputIntegerWOC('%LFJump to entry?',RecNumToEdit,[NumbersOnly],1,NumProtocols);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumProtocols) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> NumProtocols) THEN
|
||||||
|
RecNumToEdit := NumProtocols
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^31^1-^38^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertProtocol(TempProtocol1: ProtocolRecordType; RecNumToInsertBefore: SmallInt);
|
||||||
|
VAR
|
||||||
|
Cmd1: Char;
|
||||||
|
RecNum,
|
||||||
|
RecNumToEdit: SmallInt;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumProtocols = MaxProtocols) THEN
|
||||||
|
Messages(5,MaxProtocols,'protocols')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToInsertBefore := -1;
|
||||||
|
InputIntegerWOC('%LFProtocol to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumProtocols + 1));
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumProtocols + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
InitProtocolVars(TempProtocol1);
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE IF (RecNumToInsertBefore = (NumProtocols + 1)) THEN
|
||||||
|
RecNumToEdit := (NumProtocols + 1)
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditProtocol(TempProtocol1,TempProtocol1,Cmd1,RecNumToEdit,Changed,FALSE);
|
||||||
|
CheckProtocol(TempProtocol1,1,14,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting protocol? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting protocol record ...');
|
||||||
|
Seek(ProtocolFile,FileSize(ProtocolFile));
|
||||||
|
Write(ProtocolFile,Protocol);
|
||||||
|
Dec(RecNumToInsertBefore);
|
||||||
|
FOR RecNum := ((FileSize(ProtocolFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,RecNum);
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
Seek(ProtocolFile,(RecNum + 1));
|
||||||
|
Write(ProtocolFile,Protocol);
|
||||||
|
END;
|
||||||
|
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,RecNum);
|
||||||
|
Write(ProtocolFile,TempProtocol1);
|
||||||
|
Inc(NumProtocols);
|
||||||
|
SysOpLog('* Inserted protocol: ^5'+TempProtocol1.Description);
|
||||||
|
END;
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyProtocol(TempProtocol1: ProtocolRecordType; Cmd1: Char; RecNumToEdit: SmallInt);
|
||||||
|
VAR
|
||||||
|
SaveRecNumToEdit: Integer;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumProtocols = 0) THEN
|
||||||
|
Messages(4,0,'protocols')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := -1;
|
||||||
|
InputIntegerWOC('%LFProtocol to modify?',RecNumToEdit,[NumbersOnly],1,NumProtocols);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumProtocols) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := -1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNumToEdit - 1));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditProtocol(TempProtocol1,Protocol,Cmd1,RecNumToEdit,Changed,TRUE);
|
||||||
|
CheckProtocol(Protocol,1,14,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (OK) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(SaveRecNumToEdit - 1));
|
||||||
|
Write(ProtocolFile,Protocol);
|
||||||
|
Changed := FALSE;
|
||||||
|
SysOpLog('* Modified protocol: ^5'+Protocol.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PositionProtocol(TempProtocol1: ProtocolRecordType; RecNumToPosition: SmallInt);
|
||||||
|
VAR
|
||||||
|
RecNumToPositionBefore,
|
||||||
|
RecNum1,
|
||||||
|
RecNum2: SmallInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumProtocols = 0) THEN
|
||||||
|
Messages(4,0,'protocols')
|
||||||
|
ELSE IF (NumProtocols = 1) THEN
|
||||||
|
Messages(6,0,'protocols')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToPosition := -1;
|
||||||
|
InputIntegerWOC('%LFPosition which protocol?',RecNumToPosition,[NumbersOnly],1,NumProtocols);
|
||||||
|
IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumProtocols) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNumToPositionBefore := -1;
|
||||||
|
Print('%LFAccording to the current numbering system.');
|
||||||
|
InputIntegerWOC('%LFPosition before which protocol?',RecNumToPositionBefore,[NumbersOnly],1,(NumProtocols + 1));
|
||||||
|
IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumProtocols + 1)) AND
|
||||||
|
(RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Positioning protocol records ...');
|
||||||
|
IF (RecNumToPositionBefore > RecNumToPosition) THEN
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Dec(RecNumToPosition);
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
Seek(ProtocolFile,RecNumToPosition);
|
||||||
|
Read(ProtocolFile,TempProtocol1);
|
||||||
|
RecNum1 := RecNumToPosition;
|
||||||
|
IF (RecNumToPosition > RecNumToPositionBefore) THEN
|
||||||
|
RecNum2 := -1
|
||||||
|
ELSE
|
||||||
|
RecNum2 := 1;
|
||||||
|
WHILE (RecNum1 <> RecNumToPositionBefore) DO
|
||||||
|
BEGIN
|
||||||
|
IF ((RecNum1 + RecNum2) < FileSize(ProtocolFile)) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNum1 + RecNum2));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
Seek(ProtocolFile,RecNum1);
|
||||||
|
Write(ProtocolFile,Protocol);
|
||||||
|
END;
|
||||||
|
Inc(RecNum1,RecNum2);
|
||||||
|
END;
|
||||||
|
Seek(ProtocolFile,RecNumToPositionBefore);
|
||||||
|
Write(ProtocolFile,TempProtocol1);
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListProtocols(VAR RecNumToList1: Integer);
|
||||||
|
VAR
|
||||||
|
NumDone: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToList1 < 1) OR (RecNumToList1 > NumProtocols) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^0 ###^4:^3ACS ^4:^3Description');
|
||||||
|
PrintACR('^4 ===:==========:=============================================================');
|
||||||
|
Reset(ProtocolFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumProtocols)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ProtocolFile,(RecNumToList1 - 1));
|
||||||
|
Read(ProtocolFile,Protocol);
|
||||||
|
WITH Protocol DO
|
||||||
|
PrintACR(AOnOff((ProtActive IN PRFlags),'^5+','^1-')+
|
||||||
|
'^0'+PadRightInt(RecNumToList1,3)+
|
||||||
|
' ^9'+PadLeftStr(ACS,10)+
|
||||||
|
' ^1'+Description);
|
||||||
|
Inc(RecNumToList1);
|
||||||
|
Inc(Numdone);
|
||||||
|
END;
|
||||||
|
Close(ProtocolFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumProtocols = 0) THEN
|
||||||
|
Print('*** No protocols defined ***');
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
RecNumToList := 1;
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
ListProtocols(RecNumToList);
|
||||||
|
LOneK('%LFProtocol editor [^5?^4=^5Help^4]: ',Cmd,'QDIMP?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
^M : IF (RecNumToList < 1) OR (RecNumToList > NumProtocols) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
'D' : DeleteProtocol(TempProtocol,RecNumToList);
|
||||||
|
'I' : InsertProtocol(TempProtocol,RecNumToList);
|
||||||
|
'M' : ModifyProtocol(TempProtocol,Cmd,RecNumToList);
|
||||||
|
'P' : PositionProtocol(TempProtocol,RecNumToList);
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||||||
|
Print('^1(^3?^1)Help/First protocol');
|
||||||
|
LCmds(16,3,'Delete protocol','Insert protocol');
|
||||||
|
LCmds(16,3,'Modify protocol','Position protocol');
|
||||||
|
LCmds(16,3,'Quit','');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Cmd <> ^M) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,746 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp10;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE VotingEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
MiscUser;
|
||||||
|
|
||||||
|
PROCEDURE VotingEditor;
|
||||||
|
VAR
|
||||||
|
TempTopic: VotingRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Byte;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE InitTopicVars(VAR Topic: VotingRecordType);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,UserNum);
|
||||||
|
FillChar(Topic,SizeOf(Topic),0);
|
||||||
|
WITH Topic DO
|
||||||
|
BEGIN
|
||||||
|
Question1 := '<< New Voting Topic >>';
|
||||||
|
Question2 := '';
|
||||||
|
ACS := 'VV';
|
||||||
|
ChoiceNumber := 0;
|
||||||
|
NumVotedQuestion := 0;
|
||||||
|
CreatedBy := Caps(User.Name);
|
||||||
|
AddAnswersACS := General.AddChoice;
|
||||||
|
FOR Counter := 1 TO MaxChoices DO
|
||||||
|
WITH Answers[Counter] DO
|
||||||
|
BEGIN
|
||||||
|
Answer1 := '<< New Topic Choice >>';
|
||||||
|
Answer2 := '';
|
||||||
|
NumVotedAnswer := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteChoice(VAR Topic: VotingRecordType; RecNumToDelete: Byte; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum,
|
||||||
|
RecNum1: Byte;
|
||||||
|
UNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (Topic.ChoiceNumber < 1) THEN
|
||||||
|
Messages(4,0,'topic choices')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNum := 0;
|
||||||
|
InputByteWOC('%LFDelete which choice',RecNum,[Numbersonly],1,Topic.ChoiceNumber);
|
||||||
|
IF (RecNum >= 1) AND (RecNum <= Topic.ChoiceNumber) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(Topic.ChoiceNumber);
|
||||||
|
Dec(Topic.NumVotedQuestion,Topic.Answers[RecNum].NumVotedAnswer);
|
||||||
|
IF (RecNum < MaxChoices) THEN
|
||||||
|
FOR RecNum1 := RecNum TO Topic.ChoiceNumber DO
|
||||||
|
BEGIN
|
||||||
|
Topic.Answers[RecNum1].Answer1 := Topic.Answers[RecNum1 + 1].Answer1;
|
||||||
|
Topic.Answers[RecNum1].Answer2 := Topic.Answers[RecNum1 + 1].Answer2;
|
||||||
|
Topic.Answers[RecNum1].NumVotedAnswer := Topic.Answers[RecNum1 + 1].NumVotedAnswer;
|
||||||
|
END;
|
||||||
|
Reset(UserFile);
|
||||||
|
FOR UNum := 1 TO (FileSize(UserFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(UserFile,Unum);
|
||||||
|
Read(UserFile,User);
|
||||||
|
IF (User.Vote[RecNumToDelete] = RecNum) THEN
|
||||||
|
User.Vote[RecNumToDelete] := 0
|
||||||
|
ELSE IF (User.Vote[RecNumToDelete] > RecNum) THEN
|
||||||
|
Dec(User.Vote[RecNumToDelete]);
|
||||||
|
Seek(UserFile,UNum);
|
||||||
|
Write(UserFile,User);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
IF (ThisUser.Vote[RecNumToDelete] = RecNum) THEN
|
||||||
|
ThisUser.Vote[RecNumToDelete] := 0;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertChoice(VAR Topic: VotingRecordType; RecNumToEdit: Byte; VAR Changed: Boolean);
|
||||||
|
BEGIN
|
||||||
|
IF (Topic.ChoiceNumber >= MaxChoices) THEN
|
||||||
|
Messages(5,MaxChoices,'topic choices')
|
||||||
|
ELSE IF PYNQ('%LFAdd topic choice #'+IntToStr(Topic.ChoiceNumber + 1)+'? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
InputWNWC('%LFChoice: ',Topic.Answers[Topic.ChoiceNumber + 1].Answer1,65,Changed);
|
||||||
|
IF (Topic.Answers[Topic.ChoiceNumber + 1].Answer1 <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Topic.Answers[Topic.ChoiceNumber + 1].NumVotedAnswer := 0;
|
||||||
|
InputWNWC(PadLeftStr('',6)+': ',Topic.Answers[Topic.ChoiceNumber + 1].Answer2,65,Changed);
|
||||||
|
Inc(Topic.ChoiceNumber);
|
||||||
|
END;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckChoice(Topic: VotingRecordType; RecNum1: Byte; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Topic.Answers[RecNum1].Answer1 = '') OR (Topic.Answers[RecNum1].Answer1 = '<< New Topic Choice >>') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The answer is invalid!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyChoice(TempTopic1: VotingRecordType; VAR Topic: VotingRecordType; RecNumToEdit: Byte; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
Cmd1: Char;
|
||||||
|
RecNum: Byte;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (Topic.ChoiceNumber < 1) THEN
|
||||||
|
Messages(4,0,'topic choices')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNum := 0;
|
||||||
|
InputByteWOC('%LFModify which choice',RecNum,[Numbersonly],1,Topic.ChoiceNumber);
|
||||||
|
IF (RecNum >= 1) AND (RecNum <= Topic.ChoiceNumber) THEN
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5Topic choice #'+IntToStr(RecNum)+' of '+IntToStr(Topic.ChoiceNumber));
|
||||||
|
NL;
|
||||||
|
PrintACR('^11. Choice: ^5'+Topic.Answers[RecNum].Answer1);
|
||||||
|
IF (Topic.Answers[RecNum].Answer2 <> '') THEN
|
||||||
|
PrintACR('^1 : ^5'+Topic.Answers[RecNum].Answer2);
|
||||||
|
PrintACR('^12. Voters: ^5'+IntToStr(Topic.Answers[RecNum].NumVotedAnswer));
|
||||||
|
END;
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q12[]FJL?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'1' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
TempTopic1.Answers[RecNum].Answer1 := Topic.Answers[RecNum].Answer1;
|
||||||
|
Ok := TRUE;
|
||||||
|
InputWNWC('%LFNew choice: ',Topic.Answers[RecNum].Answer1,
|
||||||
|
(SizeOf(Topic.Answers[RecNum].Answer1) - 1),Changed);
|
||||||
|
CheckChoice(Topic,RecNum,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Topic.Answers[RecNum].Answer1 := TempTopic1.Answers[RecNum].Answer1;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
IF (Topic.Answers[RecNum].Answer1 <> '') THEN
|
||||||
|
InputWNWC(PadLeftStr('',10)+': ',Topic.Answers[Recnum].Answer2,
|
||||||
|
(SizeOf(Topic.Answers[RecNum].Answer2) - 1),Changed);
|
||||||
|
END;
|
||||||
|
'2' : InputIntegerWC('%LFNew number of voters',Topic.Answers[RecNum].NumVotedAnswer,[DisplayValue,NumbersOnly],0,
|
||||||
|
(MaxUsers - 1),Changed);
|
||||||
|
'[' : IF (RecNum > 1) THEN
|
||||||
|
Dec(RecNum)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNum < Topic.ChoiceNumber) THEN
|
||||||
|
Inc(RecNum)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNum <> 1) THEN
|
||||||
|
RecNum := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputByteWOC('%LFJump to entry',RecNum,[Numbersonly],1,Topic.ChoiceNumber);
|
||||||
|
IF (RecNum < 1) OR (RecNum > Topic.ChoiceNumber) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNum <> Topic.ChoiceNumber) THEN
|
||||||
|
RecNum := Topic.ChoiceNumber
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay screen');
|
||||||
|
Print('^31-2^1:Modify item');
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListChoices(VAR Topic: VotingRecordType; VAR RecNumToList1: Byte);
|
||||||
|
VAR
|
||||||
|
NumDone: Byte;
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToList1 < 1) OR (RecNumToList1 > Topic.ChoiceNumber) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^0##^4:^3Answer^4:^3Choice');
|
||||||
|
PrintACR('^4==:======:=====================================================================');
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= Topic.ChoiceNumber)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^0'+PadRightInt(RecNumToList1,2)+
|
||||||
|
' ^3'+PadRightInt(Topic.Answers[RecNumToList1].NumVotedAnswer,6)+
|
||||||
|
' ^5'+Topic.Answers[RecNumToList1].Answer1);
|
||||||
|
WKey;
|
||||||
|
Inc(RecNumToList1);
|
||||||
|
Inc(NumDone);
|
||||||
|
END;
|
||||||
|
IF (Topic.ChoiceNumber = 0) THEN
|
||||||
|
Print('*** No voting choices defined ***');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChoiceEditor(TempTopic1: VotingRecordType; VAR Topic: VotingRecordType; Cmd1: Char;
|
||||||
|
RecNumToEdit: Byte; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
RecNumToList1: Byte;
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
ListChoices(Topic,RecNumToList1);
|
||||||
|
LOneK('%LFTopic choice editor [^5?^4=^5Help^4]: ',Cmd1,'QDIM?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
^M : IF (RecNumToList1 < 1) OR (RecNumToList1 > Topic.ChoiceNumber) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
'D' : DeleteChoice(Topic,RecNumToEdit,Changed);
|
||||||
|
'I' : InsertChoice(Topic,RecNumToEdit,Changed);
|
||||||
|
'M' : ModifyChoice(TempTopic1,Topic,RecNumToEdit,Changed);
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||||||
|
Print('^1(^3?^1)Help/First topic choice');
|
||||||
|
LCmds(20,3,'Delete topic choice','Insert topic choice');
|
||||||
|
LCmds(20,3,'Modify topic choice','Quit');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Cmd1 <> ^M) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
UNTIL (Cmd1 = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteTopic(TempTopic1: VotingRecordType; RecNumToDelete: Byte);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumVotes = 0) THEN
|
||||||
|
Messages(4,0,'voting topics')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := 0;
|
||||||
|
InputByteWOC('%LFVoting topic to delete',RecNumToDelete,[NumbersOnly],1,NumVotes);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumVotes) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(VotingFile);
|
||||||
|
Seek(VotingFile,(RecNumToDelete - 1));
|
||||||
|
Read(VotingFile,TempTopic1);
|
||||||
|
Close(VotingFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Print('%LF^1Voting topic: ^5'+TempTopic1.Question1);
|
||||||
|
IF (TempTopic1.Question2 <> '') THEN
|
||||||
|
Print('^1'+PadLeftStr('',12)+': ^5'+TempTopic1.Question2);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting voting topic record ...');
|
||||||
|
Dec(RecNumToDelete);
|
||||||
|
Reset(VotingFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(VotingFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(VotingFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(VotingFile,(RecNum + 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
Seek(VotingFile,RecNum);
|
||||||
|
Write(VotingFile,Topic);
|
||||||
|
END;
|
||||||
|
Seek(VotingFile,(FileSize(VotingFile) - 1));
|
||||||
|
Truncate(VotingFile);
|
||||||
|
Close(VotingFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
SysOpLog('* Deleted topic: ^5'+TempTopic1.Question1);
|
||||||
|
IF (Topic.Question2 <> '') THEN
|
||||||
|
SysOpLog(PadLeftStr('',15)+': ^5'+TempTopic1.Question2);
|
||||||
|
Reset(UserFile);
|
||||||
|
FOR RecNum := 1 TO (FileSize(UserFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(UserFile,RecNum);
|
||||||
|
Read(UserFile,User);
|
||||||
|
Move(User.Vote[RecNumToDelete + 1],User.Vote[RecNumToDelete],(MaxVotes - RecNumToDelete));
|
||||||
|
User.Vote[25] := 0;
|
||||||
|
Seek(UserFile,RecNum);
|
||||||
|
Write(UserFile,User);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Move(ThisUser.Vote[RecNumToDelete + 1],ThisUser.Vote[RecNumToDelete],(MaxVotes - RecNumToDelete));
|
||||||
|
ThisUser.Vote[25] := 0;
|
||||||
|
Dec(NumVotes);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckTopic(Topic: VotingRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
Counter1: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Topic.Question1 = '') OR (Topic.Question1 = '<< New Voting Topic >>') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The question is invalid!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
2 : IF (Topic.ChoiceNumber = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You must setup choices for your topic!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditTopic(TempTopic1: VotingRecordType; VAR Topic: VotingRecordType; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit: Byte; VAR Changed: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
CmdStr: AStr;
|
||||||
|
Unum: Integer;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH Topic DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing voting topic #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumVotes))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting voting topic #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumVotes + 1));
|
||||||
|
NL;
|
||||||
|
PrintACR('^11. Topic : ^5'+Question1);
|
||||||
|
IF (Question2 <> '') THEN
|
||||||
|
PrintACR('^1'+PadLeftStr('',16)+': ^5'+Question2);
|
||||||
|
PrintACR('^12. Creator : ^5'+CreatedBy);
|
||||||
|
PrintACR('^13. ACS to vote : ^5'+AOnOff(ACS = '','*None*',ACS));
|
||||||
|
PrintACR('^14. ACS to add : ^5'+AOnOff(AddAnswersACS = '','*None*',AddAnswersACS));
|
||||||
|
PrintACR('^15. Total votes : ^5'+IntToStr(NumVotedQuestion));
|
||||||
|
Print('%LF^1[Choices on this topic: ^5'+IntToStr(ChoiceNumber)+'^1]');
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := '12345C'
|
||||||
|
ELSE
|
||||||
|
CmdStr := '12345C[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5C^4=^5Choice Editor^4,^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'1' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
TempTopic1.Question1 := Question1;
|
||||||
|
Ok := TRUE;
|
||||||
|
InputWNWC('%LFNew topic: ',Question1,(SizeOf(Question1) - 1),Changed);
|
||||||
|
CheckTopic(Topic,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Question1 := TempTopic1.Question1;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
IF (Question1 <> '') THEN
|
||||||
|
InputWNWC(PadLeftStr('',9)+': ',Question2,(SizeOf(Question2) - 1),Changed);
|
||||||
|
END;
|
||||||
|
'2' : BEGIN
|
||||||
|
Print('%LF^5New creator of this topic (1-'+IntToStr(MaxUsers - 1)+')?^1');
|
||||||
|
Print('%LFEnter User Number, Name, or Partial Search String.');
|
||||||
|
Prt(': ');
|
||||||
|
lFindUserWS(Unum);
|
||||||
|
IF (Unum < 1) THEN
|
||||||
|
PauseScr(FALSE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,UNum);
|
||||||
|
IF (CreatedBy <> Caps(User.Name)) THEN
|
||||||
|
IF (PYNQ('%LFSet the new creator name to '+Caps(User.Name)+'? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
CreatedBy := Caps(User.Name);
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'3' : InputWN1('%LFNew voting ACS: ',ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed);
|
||||||
|
'4' : IF PYNQ('%LFAllow other users to add choices? ',0,FALSE) THEN
|
||||||
|
AddAnswersACS := ACS
|
||||||
|
ELSE
|
||||||
|
AddAnswersACS := General.AddChoice;
|
||||||
|
'5' : InputIntegerWOC('%LFNew number of voters',NumVotedQuestion,[DisplayValue,NumbersOnly],0,(MaxUsers - 1));
|
||||||
|
'C' : ChoiceEditor(TempTopic1,Topic,Cmd1,RecNumToEdit,Changed);
|
||||||
|
'[' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit < NumVotes) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputByteWOC('%LFJump to entry',RecNumToEdit,[NumbersOnly],1,NumVotes);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumVotes) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> NumVotes) THEN
|
||||||
|
RecNumToEdit := NumVotes
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^31^1-^35^1,^3C^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertTopic(TempTopic1: VotingRecordType; Cmd1: Char; RecNumToInsertBefore: Byte);
|
||||||
|
VAR
|
||||||
|
RecNumToEdit: Byte;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumVotes = MaxVotes) THEN
|
||||||
|
Messages(5,MaxVotes,'voting topics')
|
||||||
|
ELSE IF (PYNQ('%LFAdd voting topic #'+IntToStr(NumVotes + 1)+'? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(VotingFile);
|
||||||
|
InitTopicVars(TempTopic1);
|
||||||
|
RecNumToInsertBefore := (FileSize(VotingFile) + 1);
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNumToedit := 1
|
||||||
|
ELSE IF (RecNumToInsertBefore = (NumVotes + 1)) THEN
|
||||||
|
RecNumToEdit := (NumVotes + 1)
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditTopic(TempTopic1,TempTopic1,Cmd1,RecNumToEdit,Changed,FALSE);
|
||||||
|
CheckTopic(TempTopic1,1,2,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting topic? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting voting topic record ...');
|
||||||
|
Seek(VotingFile,FileSize(VotingFile));
|
||||||
|
Write(VotingFile,TempTopic1);
|
||||||
|
Close(VotingFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Inc(NumVotes);
|
||||||
|
SysOpLog('* Inserted topic: ^5'+TempTopic1.Question1);
|
||||||
|
IF (TempTopic1.Question2 <> '') THEN
|
||||||
|
SysOpLog(PadLeftStr('',16)+': ^5'+TempTopic1.Question2);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyTopic(TempTopic1: VotingRecordType; Cmd1: Char; RecNumToEdit: Byte);
|
||||||
|
VAR
|
||||||
|
SaveRecNumToEdit: Byte;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumVotes = 0) THEN
|
||||||
|
Messages(4,0,'voting topics')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := 0;
|
||||||
|
InputByteWOC('%LFModify which topic',RecNumToEdit,[NumbersOnly],1,NumVotes);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumVotes) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := 0;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(VotingFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(VotingFile,(RecNumToEdit - 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditTopic(TempTopic1,Topic,Cmd1,RecNumToEdit,Changed,TRUE);
|
||||||
|
CheckTopic(Topic,1,2,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(VotingFile,(SaveRecNumToEdit - 1));
|
||||||
|
Write(VotingFile,Topic);
|
||||||
|
Changed := FALSE;
|
||||||
|
SysOpLog('* Modified topic: ^5'+Topic.Question1);
|
||||||
|
IF (Topic.Question2 <> '') THEN
|
||||||
|
SysOpLog(PadLeftStr('',16)+': ^5'+Topic.Question2);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(VotingFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ResetTopic(RecNumToReset: Byte);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum: Byte;
|
||||||
|
UNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumVotes = 0) THEN
|
||||||
|
Messages(4,0,'voting topics')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToReset := 0;
|
||||||
|
InputByteWOC('%LFReset which topic',RecNumToReset,[NumbersOnly],1,NumVotes);
|
||||||
|
IF (RecNumToReset >= 1) AND (RecNumToReset <= NumVotes) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(VotingFile);
|
||||||
|
Seek(VotingFile,(RecNumToReset - 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
Close(VotingFile);
|
||||||
|
Print('%LF^1Voting topic: ^5'+Topic.Question1);
|
||||||
|
IF (Topic.Question2 <> '') THEN
|
||||||
|
Print('^1'+PadLeftStr('',12)+': ^5'+Topic.Question2);
|
||||||
|
IF PYNQ('%LFAre you sure you want to reset it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Resetting voting topic record ...');
|
||||||
|
Reset(VotingFile);
|
||||||
|
Seek(VotingFile,(RecNumToReset - 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
Topic.NumVotedQuestion := 0;
|
||||||
|
FOR RecNum := 1 TO Topic.ChoiceNumber DO
|
||||||
|
Topic.Answers[RecNum].NumVotedAnswer := 0;
|
||||||
|
Seek(VotingFile,(RecNumToReset - 1));
|
||||||
|
Write(VotingFile,Topic);
|
||||||
|
Close(VotingFile);
|
||||||
|
Reset(UserFile);
|
||||||
|
FOR UNum := 1 TO (FileSize(UserFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(UserFile,Unum);
|
||||||
|
Read(UserFile,User);
|
||||||
|
User.Vote[RecNumToReset] := 0;
|
||||||
|
Seek(UserFile,UNum);
|
||||||
|
Write(UserFile,User);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
ThisUser.Vote[RecNumToReset] := 0;
|
||||||
|
SysOpLog('* Reset topic: ^5'+Topic.Question1);
|
||||||
|
IF (Topic.Question2 <> '') THEN
|
||||||
|
SysOpLog(PadLeftStr('',13)+': ^5'+Topic.Question2);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE RecalculateTopics;
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum,
|
||||||
|
RecNum1: Byte;
|
||||||
|
UNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumVotes = 0) THEN
|
||||||
|
Messages(4,0,'voting topics')
|
||||||
|
ELSE IF (PYNQ('%LFRecalculate all voting topics? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Recalculating all voting topics ...');
|
||||||
|
Reset(VotingFile);
|
||||||
|
FOR RecNum := 1 TO NumVotes DO
|
||||||
|
BEGIN
|
||||||
|
Reset(VotingFile);
|
||||||
|
Seek(VotingFile,(RecNum - 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
Topic.NumVotedQuestion := 0;
|
||||||
|
FOR RecNum1 := 1 TO Topic.ChoiceNumber DO
|
||||||
|
Topic.Answers[RecNum1].NumVotedAnswer := 0;
|
||||||
|
Seek(VotingFile,(RecNum - 1));
|
||||||
|
Write(VotingFile,Topic);
|
||||||
|
END;
|
||||||
|
Close(VotingFile);
|
||||||
|
Reset(VotingFile);
|
||||||
|
Reset(UserFile);
|
||||||
|
FOR UNum := 1 TO (FileSize(UserFile) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(UserFile,Unum);
|
||||||
|
Read(UserFile,User);
|
||||||
|
IF (Deleted IN User.SFlags) THEN
|
||||||
|
BEGIN
|
||||||
|
FOR RecNum := 1 TO MaxVotes DO
|
||||||
|
User.Vote[RecNum] := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
FOR RecNum := 1 TO NumVotes DO
|
||||||
|
IF (User.Vote[RecNum] <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(VotingFile,(RecNum - 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
Inc(Topic.NumVotedQuestion);
|
||||||
|
Inc(Topic.Answers[User.Vote[RecNum]].NumVotedAnswer);
|
||||||
|
Seek(VotingFile,(RecNum - 1));
|
||||||
|
Write(VotingFile,Topic);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Seek(UserFile,Unum);
|
||||||
|
Write(UserFile,User);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
Close(VotingFile);
|
||||||
|
SysOpLog('* Recalculated all voting topics.');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListTopics(VAR RecNumToList1: Byte);
|
||||||
|
VAR
|
||||||
|
NumDone: Byte;
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToList1 < 1) OR (RecNumToList1 > NumVotes) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^0##^4:^3Votes^4:^3Topic');
|
||||||
|
PrintACR('^4==:=====:======================================================================');
|
||||||
|
Reset(VotingFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumVotes)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(VotingFile,(RecNumToList1 - 1));
|
||||||
|
Read(VotingFile,Topic);
|
||||||
|
WITH Topic DO
|
||||||
|
PrintACR('^0'+PadRightInt(RecNumToList1,2)+
|
||||||
|
'^3'+PadRightInt(NumVotedQuestion,6)+
|
||||||
|
'^5 '+Question1);
|
||||||
|
WKey;
|
||||||
|
Inc(RecNumToList1);
|
||||||
|
Inc(NumDone);
|
||||||
|
END;
|
||||||
|
Close(VotingFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumVotes = 0) THEN
|
||||||
|
Print('*** No voting topics defined ***');
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
RecNumToList := 1;
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
ListTopics(RecNumToList);
|
||||||
|
LOneK('%LFVoting topic editor [^5?^4=^5Help^4]: ',Cmd,'QDIMRS?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
^M : IF (RecNumToList < 1) OR (RecNumToList > NumVotes) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
'D' : DeleteTopic(TempTopic,RecNumToList);
|
||||||
|
'I' : InsertTopic(TempTopic,Cmd,RecNumToList);
|
||||||
|
'M' : ModifyTopic(TempTopic,Cmd,RecNumToList);
|
||||||
|
'R' : ResetTopic(RecNumToList);
|
||||||
|
'S' : RecalculateTopics;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||||||
|
Print('^1(^3?^1)Help/First voting topic');
|
||||||
|
LCmds(20,3,'Delete voting topic','Insert voting topic');
|
||||||
|
LCmds(20,3,'Modify voting topic','Quit');
|
||||||
|
LCmds(20,3,'Reset voting topic','SRecalculate voting topics');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Cmd <> ^M) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,77 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp11;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ChangeUser;
|
||||||
|
PROCEDURE ShowLogs;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
TimeFunc,
|
||||||
|
MiscUser;
|
||||||
|
|
||||||
|
PROCEDURE ChangeUser;
|
||||||
|
VAR
|
||||||
|
UNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
Prt('Change to which User (1-'+IntToStr(MaxUsers - 1)+'): ');
|
||||||
|
FindUser(UNum);
|
||||||
|
IF (UNum >= 1) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveURec(ThisUser,UserNum);
|
||||||
|
LoadURec(ThisUser,UNum);
|
||||||
|
UserNum := UNum;
|
||||||
|
ChopTime := 0;
|
||||||
|
ExtraTime := 0;
|
||||||
|
FreeTime := 0;
|
||||||
|
IF (ComPortSpeed > 0) THEN
|
||||||
|
SysOpLog('---> ^7Switched accounts to: ^5'+Caps(ThisUser.Name));
|
||||||
|
Update_Screen;
|
||||||
|
NewCompTables;
|
||||||
|
LoadNode(ThisNode);
|
||||||
|
WITH NodeR DO
|
||||||
|
BEGIN
|
||||||
|
User := UserNum;
|
||||||
|
UserName := ThisUser.Name;
|
||||||
|
END;
|
||||||
|
SaveNode(ThisNode);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ShowLogs;
|
||||||
|
VAR
|
||||||
|
TempStr: Str10;
|
||||||
|
Day: Word;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('SysOp Logs available for up to '+IntToStr(General.BackSysOpLogs)+' days ago.');
|
||||||
|
Prt('Date (MM/DD/YYYY) or # days ago (0-'+IntToStr(General.BackSysOpLogs)+') [0]: ');
|
||||||
|
Input(TempStr,10);
|
||||||
|
IF (Length(TempStr) = 10) AND (DayNum(TempStr) > 0) THEN
|
||||||
|
Day := (DayNum(DateStr) - DayNum(TempStr))
|
||||||
|
ELSE
|
||||||
|
Day := StrToInt(TempStr);
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
IF (Day = 0) THEN
|
||||||
|
PrintF(General.LogsPath+'SYSOP.LOG')
|
||||||
|
ELSE
|
||||||
|
PrintF(General.LogsPath+'SYSOP'+IntToStr(Day)+'.LOG');
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
IF (NoFile) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('SysOp log not found.');
|
||||||
|
END;
|
||||||
|
IF (UserOn) THEN
|
||||||
|
SysOpLog('Viewed SysOp Log - '+AOnOff(Day = 0,'Today''s',IntToStr(Day)+' days ago'));
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,566 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
UNIT SysOp12;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
FUNCTION FindConference(Key: Char; VAR Conference: ConferenceRecordType): Boolean;
|
||||||
|
FUNCTION ShowConferences: AStr;
|
||||||
|
PROCEDURE ChangeConference(MenuOption: Str50);
|
||||||
|
PROCEDURE ConferenceEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
FUNCTION FindConference(Key: Char; VAR Conference: ConferenceRecordType): Boolean;
|
||||||
|
VAR
|
||||||
|
RecNumToList: Integer;
|
||||||
|
Found: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Found := FALSE;
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
RecNumToList := 1;
|
||||||
|
WHILE (RecNumToList <= NumConfKeys) AND (NOT Found) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(RecNumToList - 1));
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
IF (Key = Conference.Key) THEN
|
||||||
|
Found := TRUE;
|
||||||
|
Inc(RecNumToList);
|
||||||
|
END;
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
FindConference := Found;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ShowConferences: AStr;
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
TempStr := '';
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
RecNumToList := 1;
|
||||||
|
WHILE (RecNumToList <= NumConfKeys) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(RecNumToList - 1));
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
IF AACS(Conference.ACS) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr + Conference.Key;
|
||||||
|
IF (RecNumToList < NumConfKeys) THEN
|
||||||
|
TempStr := TempStr + ',';
|
||||||
|
END;
|
||||||
|
Inc(RecNumToList);
|
||||||
|
END;
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (TempStr[Length(TempStr)] = ',') THEN
|
||||||
|
Dec(TempStr[0]);
|
||||||
|
ShowConferences := TempStr;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayConferenceRecords(RecNumToList: Integer; DisplayListNum: Boolean);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
NumOnline: Byte;
|
||||||
|
BEGIN
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (DisplayListNum) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^0##^4:^3C^4:^3Name ^0##^4:^3C^4:^3Name');
|
||||||
|
PrintACR('^4==:=:============================== ==:=:==============================');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintACR(' ^3C^4:^3Name ^3C^4:^3Name');
|
||||||
|
PrintACR(' ^4=:============================== =:==============================');
|
||||||
|
END;
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
TempStr := '';
|
||||||
|
NumOnline := 0;
|
||||||
|
RecNumToList := 1;
|
||||||
|
WHILE (RecNumToList <= NumConfKeys) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(RecNumToList - 1));
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
IF (DisplayListNum) THEN
|
||||||
|
TempStr := TempStr + PadLeftStr('^0'+PadRightInt(RecNumToList,2)+
|
||||||
|
' ^3'+Conference.Key+
|
||||||
|
' ^5'+Conference.Name,37)
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + PadLeftStr(' ^3'+Conference.Key+
|
||||||
|
' ^5'+Conference.Name,34);
|
||||||
|
Inc(NumOnline);
|
||||||
|
IF (NumOnline = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintaCR(TempStr);
|
||||||
|
NumOnline := 0;
|
||||||
|
TempStr := '';
|
||||||
|
END;
|
||||||
|
Inc(RecNumToList);
|
||||||
|
END;
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
IF (NumOnline = 1) AND (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
PrintaCR(TempStr);
|
||||||
|
IF (NumConfKeys = 0) AND (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
Print('^7No conference records.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ChangeConference(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
OneKCmds: AStr;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
BEGIN
|
||||||
|
MenuOption := AllCaps(SQOutSp(MenuOption));
|
||||||
|
IF (MenuOption <> '') THEN
|
||||||
|
Cmd := MenuOption[1]
|
||||||
|
ELSE
|
||||||
|
Cmd := #0;
|
||||||
|
IF (Cmd <> #0) AND (Cmd <> '?') AND (NOT (Cmd IN ConfKeys)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%NLCommand error, operation aborted!');
|
||||||
|
SysOpLog('^7Change conference cmd error, invalid options: "'+Cmd+'".');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (Cmd = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('CONFLIST');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
DisplayConferenceRecords(RecNumToList,FALSE);
|
||||||
|
END
|
||||||
|
ELSE IF (Cmd IN ConfKeys) AND FindConference(Cmd,Conference) THEN
|
||||||
|
BEGIN
|
||||||
|
IF ((AACS(Conference.ACS))) THEN
|
||||||
|
BEGIN
|
||||||
|
CurrentConf := Cmd;
|
||||||
|
ThisUser.LastConf := CurrentConf;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
OneKCmds := '';
|
||||||
|
FOR Cmd := '@' TO 'Z' DO
|
||||||
|
IF (Cmd IN ConfKeys) THEN
|
||||||
|
OneKCmds := OneKCmds + Cmd;
|
||||||
|
Print('%LF^4Current conference: ^5%CT - %CN');
|
||||||
|
REPEAT
|
||||||
|
LOneK('%LFJoin which conference? (^5?^4=^5List^4,<^5CR^4>=^5Quit^4): ',Cmd,^M'?'+OneKCmds,TRUE,TRUE);
|
||||||
|
IF (Cmd = '?') THEN
|
||||||
|
BEGIN
|
||||||
|
PrintF('CONFLIST');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
DisplayConferenceRecords(RecNumToList,FALSE);
|
||||||
|
END
|
||||||
|
ELSE IF (Cmd IN ConfKeys) AND FindConference(Cmd,Conference) THEN
|
||||||
|
IF (NOT AACS(Conference.ACS)) THEN
|
||||||
|
Print('%LF^7You do not have the required access level for this conference!^1')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
CurrentConf := Cmd;
|
||||||
|
ThisUser.LastConf := CurrentConf;
|
||||||
|
PrintF('CONF'+Cmd);
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print('%LFJoined conference: ^5%CT - %CN');
|
||||||
|
Cmd := ^M;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
NewCompTables;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ConferenceEditor;
|
||||||
|
VAR
|
||||||
|
TempConference: ConferenceRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
|
||||||
|
PROCEDURE InitConferenceVars(VAR Conference: ConferenceRecordType);
|
||||||
|
BEGIN
|
||||||
|
FillChar(Conference,SizeOf(Conference),0);
|
||||||
|
WITH Conference DO
|
||||||
|
BEGIN
|
||||||
|
Key := ' ';
|
||||||
|
Name := '<< New Conference Record >>';
|
||||||
|
ACS := ''
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteConference(TempConference1: ConferenceRecordType; RecNumToDelete: SmallInt);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumConfKeys = 0) THEN
|
||||||
|
Messages(4,0,'conference records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := -1;
|
||||||
|
InputIntegerWOC('%LFConference record to delete?',RecNumToDelete,[NumbersOnly],1,NumConfKeys);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumConfKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
Seek(ConferenceFile,(RecNumToDelete - 1));
|
||||||
|
Read(ConferenceFile,TempConference1);
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (TempConference1.Key = '@') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You can not delete the general conference key!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LFConference record: ^5'+TempConference1.Name);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting conference record ...');
|
||||||
|
FOR RecNum := 1 TO (MaxUsers - 1) DO
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,RecNum);
|
||||||
|
IF (User.LastConf = TempConference1.Key) THEN
|
||||||
|
User.LastConf := '@';
|
||||||
|
SaveURec(User,RecNum);
|
||||||
|
END;
|
||||||
|
Exclude(ConfKeys,TempConference1.Key);
|
||||||
|
Dec(RecNumToDelete);
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(ConferenceFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(ConferenceFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(RecNum + 1));
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
Seek(ConferenceFile,RecNum);
|
||||||
|
Write(ConferenceFile,Conference);
|
||||||
|
END;
|
||||||
|
Seek(ConferenceFile,(FileSize(ConferenceFile) - 1));
|
||||||
|
Truncate(ConferenceFile);
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Dec(NumConfKeys);
|
||||||
|
SysOpLog('* Deleted conference: ^5'+TempConference1.Name);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckConference(Conference: ConferenceRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Conference.Name = '') OR (Conference.Name = '<< New Conference Record >>') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The description is invalid!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditConference(TempConference1: ConferenceRecordType; VAR Conference: ConferenceRecordType; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
CmdStr: AStr;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH Conference DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing conference record #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumConfKeys))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting conference record #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumConfKeys + 1));
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Key : ^5'+Key);
|
||||||
|
PrintACR('^1B. Description: ^5'+Name);
|
||||||
|
PrintACR('^1C. ACS : ^5'+AOnOff(ACS = '','*None*',ACS));
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := 'ABC'
|
||||||
|
ELSE
|
||||||
|
CmdStr := 'ABC[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'A' : BEGIN
|
||||||
|
Print('%LF^7You can not modify the conference key.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
'B' : REPEAT
|
||||||
|
TempConference1.Name := Conference.Name;
|
||||||
|
OK := TRUE;
|
||||||
|
InputWNWC('%LFNew description: ',Name,(SizeOf(Name) - 1),Changed);
|
||||||
|
CheckConference(Conference,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Conference.Name := TempConference1.Name;
|
||||||
|
UNTIL (OK) OR (HangUp);
|
||||||
|
'C' : InputWN1('%LFNew ACS: ',ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed);
|
||||||
|
'[' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit < NumConfKeys) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputIntegerWOC('%LFJump to entry',RecNumToEdit,[NumbersOnly],1,NumConfKeys);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumConfKeys) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> NumConfKeys) THEN
|
||||||
|
RecNumToEdit := NumConfKeys
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^3A^1-^3C^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertConference(TempConference1: ConferenceRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt);
|
||||||
|
VAR
|
||||||
|
OneKCmds: AStr;
|
||||||
|
RecNum,
|
||||||
|
RecNumToEdit: SmallInt;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumConfKeys = MaxConfKeys) THEN
|
||||||
|
Messages(5,MaxConfKeys,'conference records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToInsertBefore := -1;
|
||||||
|
InputIntegerWOC('%LFConference record to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumConfKeys + 1));
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumConfKeys + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
OneKCmds := '';
|
||||||
|
FOR Cmd1 := '@' TO 'Z' DO
|
||||||
|
IF (NOT (Cmd1 IN ConfKeys)) THEN
|
||||||
|
OneKCmds := OneKCmds + Cmd1;
|
||||||
|
LOneK('%LFChoose conference key [^5@^4-^5Z^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M+OneKCmds,TRUE,TRUE);
|
||||||
|
IF (Cmd1 <> ^M) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
InitConferenceVars(TempConference1);
|
||||||
|
TempConference1.Key := Cmd1;
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE IF (RecNumToInsertBefore = (NumConfKeys + 1)) THEN
|
||||||
|
RecNumToEdit := (NumConfKeys + 1)
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditConference(TempConference1,TempConference1,Cmd1,RecNumToEdit,Changed,FALSE);
|
||||||
|
CheckConference(TempConference1,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting conference record? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting conference record ...');
|
||||||
|
Include(ConfKeys,Cmd1);
|
||||||
|
Seek(ConferenceFile,FileSize(ConferenceFile));
|
||||||
|
Write(ConferenceFile,Conference);
|
||||||
|
Dec(RecNumToInsertBefore);
|
||||||
|
FOR RecNum := ((FileSize(ConferenceFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,RecNum);
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
Seek(ConferenceFile,(RecNum + 1));
|
||||||
|
Write(ConferenceFile,Conference);
|
||||||
|
END;
|
||||||
|
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,RecNum);
|
||||||
|
Write(ConferenceFile,TempConference1);
|
||||||
|
Inc(NumConfKeys);
|
||||||
|
SysOpLog('* Inserted conference: ^5'+TempConference1.Name);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyConference(TempConference1: ConferenceRecordType; Cmd1: Char; RecNumToEdit: SmallInt);
|
||||||
|
VAR
|
||||||
|
SaveRecNumToEdit: Integer;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumConfKeys = 0) THEN
|
||||||
|
Messages(4,0,'conference records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := -1;
|
||||||
|
InputIntegerWOC('%LFConference record to modify?',RecNumToEdit,[NumbersOnly],1,NumConfKeys);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumConfKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := -1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(RecNumToEdit - 1));
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditConference(TempConference1,Conference,Cmd1,RecNumToEdit,Changed,TRUE);
|
||||||
|
CheckConference(Conference,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (OK) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(SaveRecNumToEdit - 1));
|
||||||
|
Write(ConferenceFile,Conference);
|
||||||
|
Changed := FALSE;
|
||||||
|
SysOpLog('* Modified conference: ^5'+Conference.Name);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PositionConference(TempConference1: ConferenceRecordType; RecNumToPosition: SmallInt);
|
||||||
|
VAR
|
||||||
|
RecNumToPositionBefore,
|
||||||
|
RecNum1,
|
||||||
|
RecNum2: SmallInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumConfKeys = 0) THEN
|
||||||
|
Messages(4,0,'conference records')
|
||||||
|
ELSE IF (NumConfKeys = 1) THEN
|
||||||
|
Messages(6,0,'conference records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToPosition := -1;
|
||||||
|
InputIntegerWOC('%LFPosition which conference record?',RecNumToPosition,[NumbersOnly],1,NumConfKeys);
|
||||||
|
IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumConfKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNumToPositionBefore := -1;
|
||||||
|
Print('%LFAccording to the current numbering system.');
|
||||||
|
InputIntegerWOC('%LFPosition before which conference record?',RecNumToPositionBefore,
|
||||||
|
[NumbersOnly],1,(NumConfKeys + 1));
|
||||||
|
IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumConfKeys + 1)) AND
|
||||||
|
(RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Positioning conference records ...');
|
||||||
|
Reset(ConferenceFile);
|
||||||
|
IF (RecNumToPositionBefore > RecNumToPosition) THEN
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Dec(RecNumToPosition);
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Seek(ConferenceFile,RecNumToPosition);
|
||||||
|
Read(ConferenceFile,TempConference1);
|
||||||
|
RecNum1 := RecNumToPosition;
|
||||||
|
IF (RecNumToPosition > RecNumToPositionBefore) THEN
|
||||||
|
RecNum2 := -1
|
||||||
|
ELSE
|
||||||
|
RecNum2 := 1;
|
||||||
|
WHILE (RecNum1 <> RecNumToPositionBefore) DO
|
||||||
|
BEGIN
|
||||||
|
IF ((RecNum1 + RecNum2) < FileSize(ConferenceFile)) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ConferenceFile,(RecNum1 + RecNum2));
|
||||||
|
Read(ConferenceFile,Conference);
|
||||||
|
Seek(ConferenceFile,RecNum1);
|
||||||
|
Write(ConferenceFile,Conference);
|
||||||
|
END;
|
||||||
|
Inc(RecNum1,RecNum2);
|
||||||
|
END;
|
||||||
|
Seek(ConferenceFile,RecNumToPositionBefore);
|
||||||
|
Write(ConferenceFile,TempConference1);
|
||||||
|
Close(ConferenceFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
DisplayConferenceRecords(RecNumToList,TRUE);
|
||||||
|
LOneK('%LFConference editor [^5?^4=^5Help^4]: ',Cmd,'QDIMP?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'D' : DeleteConference(TempConference,RecNumToList);
|
||||||
|
'I' : InsertConference(TempConference,Cmd,RecNumToList);
|
||||||
|
'M' : ModifyConference(TempConference,Cmd,RecNumToList);
|
||||||
|
'P' : PositionConference(TempConference,RecNumToList);
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next Screen or redisplay screen');
|
||||||
|
Print('^1(^3?^1)Help/First conference');
|
||||||
|
LCmds(18,3,'Delete conference','Insert conference');
|
||||||
|
LCmds(18,3,'Modify conference','Position conference');
|
||||||
|
LCmds(18,3,'Quit','');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Cmd <> ^M) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,95 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE SystemConfigurationEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
SysOp2A,
|
||||||
|
SysOp2B,
|
||||||
|
SysOp2C,
|
||||||
|
SysOp2D,
|
||||||
|
SysOp2E,
|
||||||
|
SysOp2F,
|
||||||
|
SysOp2G,
|
||||||
|
SysOp2H,
|
||||||
|
SysOp2I,
|
||||||
|
SysOp2J,
|
||||||
|
SysOp2K,
|
||||||
|
SysOp2L,
|
||||||
|
SysOp2M,
|
||||||
|
SysOp2O,
|
||||||
|
Maint;
|
||||||
|
|
||||||
|
{
|
||||||
|
1. RGSysCfgStr(0,FALSE)
|
||||||
|
|
||||||
|
%CL^5System Configuration:^1
|
||||||
|
|
||||||
|
^1A. Main BBS Configuration B. Modem/Node Configuration
|
||||||
|
^1C. System ACS Settings D. System Variables
|
||||||
|
^1E. System Toggles F. File System Configuration
|
||||||
|
^1G. Subscription/Validation System H. Network Configuration
|
||||||
|
^1I. Offline Mail Configuration J. Color Configuration
|
||||||
|
^1K. Archive Configuration L. Credit System Configuration
|
||||||
|
^1M. New User Log-In Toggles
|
||||||
|
|
||||||
|
^11. Time allowed per %CD 2. Max calls per day
|
||||||
|
^13. UL/DL # files ratio 4. UL/DL K-bytes ratio
|
||||||
|
^15. Post/Call ratio 6. Max downloads per day
|
||||||
|
^17. Max download kbytes per day 8. Update System Averages
|
||||||
|
|
||||||
|
Enter selection [^5A^4-^5M^4,^51^4-^58^4,^5Q^4=^5Quit^4]: @
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
PROCEDURE SystemConfigurationEditor;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
SaveGeneral(TRUE);
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
RGSysCfgStr(0,FALSE);
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLM12345678'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : MainBBSConfiguration;
|
||||||
|
'B' : ModemConfiguration;
|
||||||
|
'C' : SystemACSSettings;
|
||||||
|
'D' : SystemGeneralVariables;
|
||||||
|
'E' : SystemFlaggedFunctions;
|
||||||
|
'F' : FileAreaConfiguration;
|
||||||
|
'G' : ValidationEditor;
|
||||||
|
'H' : NetworkConfiguration;
|
||||||
|
'I' : OffLineMailConfiguration;
|
||||||
|
'J' : ColorConfiguration;
|
||||||
|
'K' : ArchiveConfiguration;
|
||||||
|
'L' : CreditConfiguration;
|
||||||
|
'M' : NewUserTogglesConfiguration;
|
||||||
|
'1' : GetSecRange(1,TimeAllow);
|
||||||
|
'2' : GetSecRange(2,CallAllow);
|
||||||
|
'3' : GetSecRange(3,DLRatio);
|
||||||
|
'4' : GetSecRange(4,DLKratio);
|
||||||
|
'5' : GetSecRange(5,PostRatio);
|
||||||
|
'6' : GetSecRange(6,DLOneDay);
|
||||||
|
'7' : GetSecRange(7,DLKOneDay);
|
||||||
|
'8' : UpdateGeneral;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
SaveGeneral(FALSE);
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,427 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2A;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE MainBBSConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Common,
|
||||||
|
SysOp7,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
{
|
||||||
|
RGSysCfgStr(1,FALSE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration
|
||||||
|
%CL^5Main BBS Configuration:^1
|
||||||
|
|
||||||
|
^1A. BBS name/number : ^5%BN ^1(^5%BP^1)
|
||||||
|
^1B. Telnet Url : ^5%TN
|
||||||
|
^1C. SysOp's name : ^5%SN{15 ^1D. Renegade Version : ^5%VR
|
||||||
|
^1E. SysOp chat hours : ^5%CS ^1F. Minimum baud hours : ^5%BL
|
||||||
|
^1G. Regular DL hours : ^5%DH ^1H. Minimum baud DL hrs: ^5%BM
|
||||||
|
^1I. BBS Passwords : ^1J. Pre-event warning : ^5%ET seconds
|
||||||
|
^1K. System Menus : ^1L. Bulletin Prefix : ^5%PB
|
||||||
|
^1M. MultiNode support: ^5%MN ^1N. Network mode : ^5%NM
|
||||||
|
|
||||||
|
^10. Main data files dir. : ^5%PD
|
||||||
|
^11. Miscellaneous Files dir.: ^5%PM
|
||||||
|
^12. Message file storage dir: ^5%P1
|
||||||
|
^13. Nodelist (Version 7) dir: ^5%P2
|
||||||
|
^14. Log files/trap files dir: ^5%PL
|
||||||
|
^15. Temporary directory : ^5%PT
|
||||||
|
^16. Protocols directory : ^5%PP
|
||||||
|
^17. Archivers directory : ^5%P7
|
||||||
|
^18. File attach directory : ^5%PF
|
||||||
|
^19. RAM drive/MultiNode path: ^5%P3
|
||||||
|
|
||||||
|
Enter selection [^5A^4-^5N^4,^50^4-^59^4,^5Q^4=^5Quit^4]: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(2,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_BBS_Name
|
||||||
|
%LFNew BBS name: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(3,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_BBS_Phone
|
||||||
|
%LFNew BBS phone number: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(4,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Telnet_URL
|
||||||
|
%LF^4New Telnet Url:%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(5,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_SysOp_Name
|
||||||
|
%LFNew SysOp name: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGNoteStr(0,FALSE)
|
||||||
|
|
||||||
|
$Internal_Use_Only
|
||||||
|
%LF^7This is for internal use only.
|
||||||
|
%PA
|
||||||
|
$
|
||||||
|
|
||||||
|
RGNoteStr(1,FALSE)
|
||||||
|
|
||||||
|
$Only_Change_Locally
|
||||||
|
%LF^7This can only be changed locally.
|
||||||
|
%PA
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(6,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_SysOp_Chat_Hours
|
||||||
|
%LFDo you want to declare sysop chat hours? @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(7,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Minimum_Baud_Hours
|
||||||
|
%LFDo you want to declare hours people at the minimum baud can logon? @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(8,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Download_Hours
|
||||||
|
%LFDo you want to declare download hours? @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(9,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Minimum_Baud_Download_Hours
|
||||||
|
%LFDo you want to declare hours people at minimum baud can download? @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(10,FALSE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_SysOp_Password_Menu
|
||||||
|
%CL^5System Passwords:^1
|
||||||
|
|
||||||
|
^1A. SysOp password : ^5%P4
|
||||||
|
^1B. New user password : ^5%P5
|
||||||
|
^1C. Baud override password: ^5%P6
|
||||||
|
|
||||||
|
Enter selection [^5A^4-^5C^4,^5Q^4=^5Quit^4]: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(11,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_SysOp_Password
|
||||||
|
%LFNew SysOp password: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(12,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_New_User_Password
|
||||||
|
%LFNew new-user password: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(13,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Baud_Override_Password
|
||||||
|
%LFNew minimum baud rate override password: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(14,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Pre_Event_Time
|
||||||
|
%LFNew pre-event warning time@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(15,FALSE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus
|
||||||
|
%CL^5System Menus:^1
|
||||||
|
|
||||||
|
^11. Global : ^5%M1
|
||||||
|
^12. All Start : ^5%M2
|
||||||
|
^13. Shutle logon : ^5%M3
|
||||||
|
^14. New user info: ^5%M4
|
||||||
|
^15. Message Read : ^5%M5
|
||||||
|
^16. File List : ^5%M6
|
||||||
|
|
||||||
|
Enter selection [^51^4-^56^4,^5Q^4=^5Quit^4]: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(16,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus_Global
|
||||||
|
%LFMenu for global commands (0=None)@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(17,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus_Start
|
||||||
|
%LFMenu to start all users at@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(18,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus_Shuttle
|
||||||
|
%LFMenu for shuttle logon (0=None)@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(19,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus_New_User
|
||||||
|
%LFMenu for new user information@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(20,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus_Message_Read
|
||||||
|
%LFMenu for message read@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(21,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_System_Menus_File_Listing
|
||||||
|
%LFMenu for file listing@
|
||||||
|
$
|
||||||
|
|
||||||
|
RGNoteStr(2,FALSE)
|
||||||
|
|
||||||
|
$Invalid_Menu_Number
|
||||||
|
%LF^7Invalid menu number.
|
||||||
|
%PA
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(22,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Bulletin_Prefix
|
||||||
|
%LFDefault bulletin prefix: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGNoteStr(1,FALSE)
|
||||||
|
|
||||||
|
$Only_Change_Locally
|
||||||
|
%LF^7This can only be changed locally.
|
||||||
|
%PA
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(23,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Local_Security
|
||||||
|
%LFDo you want local security to remain on? @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(24,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Data_Path
|
||||||
|
%LF^4New data files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(25,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Misc_Path
|
||||||
|
%LF^4New miscellaneous files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(26,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Msg_Path
|
||||||
|
%LF^4New message files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(27,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_NodeList_Path
|
||||||
|
%LF^4New nodelist files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(28,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Log_Path
|
||||||
|
%LF^4New sysop log files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(29,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Temp_Path
|
||||||
|
%LF^4New temporary files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(30,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Protocol_Path
|
||||||
|
%LF^4New protocol files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(31,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Archive_Path
|
||||||
|
%LF^4New archive files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(32,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_Attach_Path
|
||||||
|
%LF^4New file attach files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
RGSysCfgStr(33,TRUE)
|
||||||
|
|
||||||
|
$Main_BBS_Configuration_MultNode_Path
|
||||||
|
%LF^4New multi-node files path (^5End with a ^4"^5\^4"):%LF^4: @
|
||||||
|
$
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
PROCEDURE GetTimeRange(CONST RGStrNum: LongInt; VAR LoTime,HiTime: SmallInt);
|
||||||
|
VAR
|
||||||
|
TempStr: Str5;
|
||||||
|
LowTime,
|
||||||
|
HighTime: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (PYNQ(RGSysCfgStr(RGStrNum,TRUE),0,FALSE))) THEN
|
||||||
|
BEGIN
|
||||||
|
LowTime := 0;
|
||||||
|
HighTime := 0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('All entries in 24 hour time. Hour: (0-23), Minute: (0-59)');
|
||||||
|
NL;
|
||||||
|
Prt('Starting time: ');
|
||||||
|
MPL(5);
|
||||||
|
InputFormatted('',TempStr,'##:##',TRUE);
|
||||||
|
IF (StrToInt(Copy(TempStr,1,2)) IN [0..23]) AND (StrToInt(Copy(TempStr,4,2)) IN [0..59]) THEN
|
||||||
|
LowTime := ((StrToInt(Copy(TempStr,1,2)) * 60) + StrToInt(Copy(TempStr,4,2)))
|
||||||
|
ELSE
|
||||||
|
LowTime := 0;
|
||||||
|
NL;
|
||||||
|
Prt('Ending time: ');
|
||||||
|
MPL(5);
|
||||||
|
InputFormatted('',TempStr,'##:##',TRUE);
|
||||||
|
IF (StrToInt(Copy(TempStr,1,2)) IN [0..23]) AND (StrToInt(Copy(TempStr,4,2)) IN [0..59]) THEN
|
||||||
|
HighTime := ((StrToInt(Copy(TempStr,1,2)) * 60) + StrToInt(Copy(TempStr,4,2)))
|
||||||
|
ELSE
|
||||||
|
HighTime := 0;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
Print('Hours: '+PHours('Always allowed',LowTime,HighTime));
|
||||||
|
NL;
|
||||||
|
IF PYNQ('Are you sure this is what you want? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
LoTime := LowTime;
|
||||||
|
HiTime := HighTime;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MainBBSConfiguration;
|
||||||
|
VAR
|
||||||
|
LineFile: FILE OF LineRec;
|
||||||
|
Cmd: Char;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Assign(LineFile,General.DataPath+'NODE'+IntToStr(ThisNode)+'.DAT');
|
||||||
|
Reset(LineFile);
|
||||||
|
Seek(LineFile,0);
|
||||||
|
Read(LineFile,Liner);
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
RGSysCfgStr(1,FALSE);
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLMN0123456789'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : BEGIN
|
||||||
|
InputWNWC(RGSysCfgStr(2,TRUE),BBSName,(SizeOf(BBSName) - 1),Changed);
|
||||||
|
InputFormatted(RGSysCfgStr(3,TRUE),BBSPhone,'###-###-####',FALSE);
|
||||||
|
END;
|
||||||
|
'B' : InputWN1(RGSysCfgStr(4,TRUE),Liner.NodeTelnetURL,(SizeOf(Liner.NodeTelnetURL) - 1),[InteractiveEdit],Changed);
|
||||||
|
'C' : InputWN1(RGSysCfgStr(5,TRUE),SysOpName,(SizeOf(SysOpName) - 1),[InterActiveEdit],Changed);
|
||||||
|
'D' : RGNoteStr(0,FALSE);
|
||||||
|
'E' : IF (InCom) THEN
|
||||||
|
RGNoteStr(1,FALSE)
|
||||||
|
ELSE
|
||||||
|
GetTimeRange(6,lLowTime,HiTime);
|
||||||
|
'F' : GetTimeRange(7,MinBaudLowTime,MinBaudHiTime);
|
||||||
|
'G' : GetTimeRange(8,DLLowTime,DLHiTime);
|
||||||
|
'H' : GetTimeRange(9,MinBaudDLLowTime,MinBaudDLHiTime);
|
||||||
|
'I' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
RGSysCfgStr(10,FALSE);
|
||||||
|
OneK(Cmd,^M'ABC',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : InputWN1(RGSysCfgStr(11,TRUE),SysOpPw,(SizeOf(SysOpPW) - 1),[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'B' : InputWN1(RGSysCfgStr(12,TRUE),NewUserPW,(SizeOf(SysOpPW) - 1),[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'C' : InputWN1(RGSysCfgStr(13,TRUE),MinBaudOverride,(SizeOf(SysOpPW) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = ^M) OR (HangUp);
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'J' : InputByteWOC(RGSysCfgStr(14,TRUE),EventWarningTime,[DisplayValue,NumbersOnly],0,255);
|
||||||
|
'K' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
RGSysCfgStr(15,FALSE);
|
||||||
|
OneK(Cmd,^M'123456Q',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'1' : FindMenu(RGSysCfgStr(16,TRUE),GlobalMenu,0,NumMenus,Changed);
|
||||||
|
'2' : FindMenu(RGSysCfgStr(17,TRUE),AllStartMenu,1,NumMenus,Changed);
|
||||||
|
'3' : FindMenu(RGSysCfgStr(18,TRUE),ShuttleLogonMenu,0,NumMenus,Changed);
|
||||||
|
'4' : FindMenu(RGSysCfgStr(19,TRUE),NewUserInformationMenu,1,NumMenus,Changed);
|
||||||
|
'5' : FindMenu(RGSysCfgStr(20,TRUE),MessageReadMenu,1,NumMenus,Changed);
|
||||||
|
'6' : FindMenu(RGSysCfgStr(21,TRUE),FileListingMenu,1,NumMenus,Changed);
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd IN [^M,'Q']) OR (HangUp);
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'L' : InputWN1(RGSysCfgStr(22,TRUE),BulletPrefix,(SizeOf(BulletPrefix) - 1),[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'M' : IF (InCom) THEN
|
||||||
|
RGNoteStr(1,FALSE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MultiNode := (NOT MultiNode);
|
||||||
|
SaveGeneral(FALSE);
|
||||||
|
ClrScr;
|
||||||
|
Writeln('Please restart Renegade.');
|
||||||
|
Halt;
|
||||||
|
END;
|
||||||
|
'N' : BEGIN
|
||||||
|
NetworkMode := (NOT NetworkMode);
|
||||||
|
IF (NetworkMode) THEN
|
||||||
|
LocalSec := TRUE
|
||||||
|
ELSE
|
||||||
|
LocalSec := PYNQ(RGSysCfgStr(23,TRUE),0,FALSE);
|
||||||
|
END;
|
||||||
|
'0' : InputPath(RGSysCfgStr(24,TRUE),DataPath,TRUE,FALSE,Changed);
|
||||||
|
'1' : InputPath(RGSysCfgStr(25,TRUE),MiscPath,TRUE,FALSE,Changed);
|
||||||
|
'2' : InputPath(RGSysCfgStr(26,TRUE),MsgPath,TRUE,FALSE,Changed);
|
||||||
|
'3' : InputPath(RGSysCfgStr(27,TRUE),NodePath,TRUE,FALSE,Changed);
|
||||||
|
'4' : InputPath(RGSysCfgStr(28,TRUE),LogsPath,TRUE,FALSE,Changed);
|
||||||
|
'5' : InputPath(RGSysCfgStr(29,TRUE),TempPath,FALSE,FALSE,Changed);
|
||||||
|
'6' : InputPath(RGSysCfgStr(30,TRUE),ProtPath,TRUE,FALSE,Changed);
|
||||||
|
'7' : InputPath(RGSysCfgStr(31,TRUE),ArcsPath,TRUE,FALSE,Changed);
|
||||||
|
'8' : InputPath(RGSysCfgStr(32,TRUE),FileAttachPath,TRUE,FALSE,Changed);
|
||||||
|
'9' : InputPath(RGSysCfgStr(33,TRUE),lMultPath,TRUE,FALSE,Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
Seek(LineFile,0);
|
||||||
|
Write(LineFile,Liner);
|
||||||
|
Close(LineFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,230 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,L+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2B;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ModemConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE ModemConfiguration;
|
||||||
|
VAR
|
||||||
|
LineFile: FILE OF LineRec;
|
||||||
|
Cmd: Char;
|
||||||
|
TempB: Byte;
|
||||||
|
Changed: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE ToggleMFlag(MFlagT: ModemFlagType; VAR MFlags: MFlagSet);
|
||||||
|
BEGIN
|
||||||
|
IF (MFlagT IN MFlags) THEN
|
||||||
|
Exclude(MFlags,MFlagT)
|
||||||
|
ELSE
|
||||||
|
Include(MFlags,MFlagT);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleMFlags(C: Char; VAR MFlags: MFlagSet; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
SaveMFlags: MFlagSet;
|
||||||
|
BEGIN
|
||||||
|
SaveMFlags := MFlags;
|
||||||
|
CASE C OF
|
||||||
|
'7' : ToggleMFlag(LockedPort,MFlags);
|
||||||
|
'8' : ToggleMFlag(XONXOFF,MFlags);
|
||||||
|
'9' : ToggleMFlag(CTSRTS,MFlags);
|
||||||
|
END;
|
||||||
|
IF (MFlags <> SaveMFlags) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE NewModemString(CONST DisplayStr: AStr; VAR InputStr: AStr; Len: Byte);
|
||||||
|
VAR
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^1Current modem '+DisplayStr+' string: "^5'+InputStr+'^1"');
|
||||||
|
Print('%LFUse: "|" for a carriage return');
|
||||||
|
Print(' "~" for a half-second delay');
|
||||||
|
Print(' "^" to toggle DTR off for 1/4 second');
|
||||||
|
InputWN1('%LF^1Enter new modem '+DisplayStr+' string:%LF^4: ',InputStr,Len,[InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION WhichBaud(B: Byte): AStr;
|
||||||
|
BEGIN
|
||||||
|
CASE B OF
|
||||||
|
1 : WhichBaud := 'CONNECT 300';
|
||||||
|
2 : WhichBaud := 'CONNECT 600';
|
||||||
|
3 : WhichBaud := 'CONNECT 1200';
|
||||||
|
4 : WhichBaud := 'CONNECT 2400';
|
||||||
|
5 : WhichBaud := 'CONNECT 4800';
|
||||||
|
6 : WhichBaud := 'CONNECT 7200';
|
||||||
|
7 : WhichBaud := 'CONNECT 9600';
|
||||||
|
8 : WhichBaud := 'CONNECT 12000';
|
||||||
|
9 : WhichBaud := 'CONNECT 14400';
|
||||||
|
10 : WhichBaud := 'CONNECT 16800';
|
||||||
|
11 : WhichBaud := 'CONNECT 19200';
|
||||||
|
12 : WhichBaud := 'CONNECT 21600';
|
||||||
|
13 : WhichBaud := 'CONNECT 24000';
|
||||||
|
14 : WhichBaud := 'CONNECT 26400';
|
||||||
|
15 : WhichBaud := 'CONNECT 28800';
|
||||||
|
16 : WhichBaud := 'CONNECT 31200';
|
||||||
|
17 : WhichBaud := 'CONNECT 33600';
|
||||||
|
18 : WhichBaud := 'CONNECT 38400';
|
||||||
|
19 : WhichBaud := 'CONNECT 57600';
|
||||||
|
20 : WhichBaud := 'CONNECT 115200';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Assign(LineFile,General.DataPath+'NODE'+IntToStr(ThisNode)+'.DAT');
|
||||||
|
Reset(LineFile);
|
||||||
|
Read(LineFile,Liner);
|
||||||
|
REPEAT
|
||||||
|
WITH Liner DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5Modem/Node Configuration:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^11. Maximum baud rate: ^5'+PadLeftInt(InitBaud,20)+
|
||||||
|
'^12. Port number : ^5'+IntToStr(ComPort));
|
||||||
|
PrintACR('^13. Modem init : ^5'+PadLeftStr(Init,20)+
|
||||||
|
'^14. Modem answer : ^5'+Answer);
|
||||||
|
PrintACR('^15. Modem HangUp : ^5'+PadLeftStr(HangUp,20)+
|
||||||
|
'^16. Modem offhook : ^5'+Offhook);
|
||||||
|
PrintACR('^17. COM port locking : ^5'+PadLeftStr(ShowOnOff(LockedPort IN MFlags),20)+
|
||||||
|
'^18. XON/XOFF flow : ^5'+ShowOnOff(XONXOFF IN MFlags));
|
||||||
|
PrintACR('^19. CTS/RTS flow : ^5'+PadLeftStr(ShowOnOff(CTSRTS IN MFlags),20)+
|
||||||
|
'^1A. ACS for this node: ^5'+LogonACS);
|
||||||
|
PrintACR('^1B. Drop file path : ^5'+PadLeftStr(DoorPath,20)+
|
||||||
|
'^1C. Answer on ring : ^5'+IntToStr(AnswerOnRing));
|
||||||
|
PrintACR('^1D. TeleConf Normal : ^5'+PadLeftStr(TeleConfNormal,20)+
|
||||||
|
'^1E. MultiRing only : ^5'+ShowOnOff(MultiRing));
|
||||||
|
PrintACR('^1F. TeleConf Anon : ^5'+PadLeftStr(TeleConfAnon,20));
|
||||||
|
PrintACR('^1G. TeleConf Global : ^5'+TeleConfGlobal);
|
||||||
|
PrintACR('^1H. TeleConf Private : ^5'+TeleConfPrivate);
|
||||||
|
PrintACR('^1I. IRQ string : ^5'+IRQ);
|
||||||
|
PrintACR('^1J. Address string : ^5'+Address);
|
||||||
|
PrintACR('^1R. Modem result codes');
|
||||||
|
Prt('%LFEnter selection [^51^4-^59^4,^5A^4-^5J^4,^5R^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'Q123456789ABCDEFGHIJR'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'1' : IF (InCom) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7This can only be changed locally.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^5Modem maximum baud rates:^1');
|
||||||
|
Print('%LF^1(^3A^1). 2400');
|
||||||
|
Print('^1(^3B^1). 9600');
|
||||||
|
Print('^1(^3C^1). 19200');
|
||||||
|
Print('^1(^3D^1). 38400');
|
||||||
|
Print('^1(^3E^1). 57600');
|
||||||
|
Print('^1(^3F^1). 115200');
|
||||||
|
LOneK('%LFModem speed? [^5A^4-^5F^4,^5<CR>^4=^5Quit^4]: ',Cmd,^M'ABCDEF',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : InitBaud := 2400;
|
||||||
|
'B' : InitBaud := 9600;
|
||||||
|
'C' : InitBaud := 19200;
|
||||||
|
'D' : InitBaud := 38400;
|
||||||
|
'E' : InitBaud := 57600;
|
||||||
|
'F' : InitBaud := 115200;
|
||||||
|
END;
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'2' : IF (InCom) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7This can only be changed locally.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempB := ComPort;
|
||||||
|
InputByteWC('%LFCom port',TempB,[DisplayValue,NumbersOnly],0,64,Changed);
|
||||||
|
IF (Changed) THEN
|
||||||
|
IF PYNQ('%LFAre you sure this is what you want? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Com_DeInstall;
|
||||||
|
ComPort := TempB;
|
||||||
|
Com_Install;
|
||||||
|
END;
|
||||||
|
IF (NOT LocalIOOnly) AND (ComPort = 0) THEN
|
||||||
|
LocalIOOnly := TRUE;
|
||||||
|
END;
|
||||||
|
'3' : NewModemString('init',Init,(SizeOf(Init) - 1));
|
||||||
|
'4' : NewModemString('answer',Answer,(SizeOf(Answer) - 1));
|
||||||
|
'5' : NewModemString('hangup',HangUp,(SizeOf(HangUp) - 1));
|
||||||
|
'6' : NewModemString('offhook',Offhook,(SizeOf(Offhook) - 1));
|
||||||
|
'7' : ToggleMFlags('7',MFlags,Changed);
|
||||||
|
'8' : ToggleMFlags('8',MFlags,Changed);
|
||||||
|
'9' : ToggleMFlags('9',MFlags,Changed);
|
||||||
|
'A' : InputWN1('%LFNew ACS: ',LogonACS,(SizeOf(LogonACS) - 1),[InterActiveEdit],Changed);
|
||||||
|
'B' : InputPath('%LF^1Enter path to write door interface files to (^5End with a ^1"^5\^1"):%LF^4: ',
|
||||||
|
DoorPath,TRUE,FALSE,Changed);
|
||||||
|
'C' : InputByteWOC('%LFAnswer after ring number',AnswerOnRing,[DisplayValue,NumbersOnly],0,255);
|
||||||
|
'E' : MultiRing := NOT MultiRing;
|
||||||
|
'D' : InputWN1('%LF^1Enter new teleconference string:%LF^4: ',TeleConfNormal,(SizeOf(TeleConfNormal) - 1),
|
||||||
|
[ColorsAllowed,InterActiveEdit],Changed);
|
||||||
|
'F' : InputWN1('%LF^1Enter new teleconference string:%LF^4: ',TeleConfAnon,(SizeOf(TeleConfAnon) - 1),
|
||||||
|
[ColorsAllowed,InterActiveEdit],Changed);
|
||||||
|
'G' : InputWN1('%LF^1Enter new teleconference string:%LF^4: ',TeleConfGlobal,(SizeOf(TeleConfGlobal) - 1),
|
||||||
|
[ColorsAllowed,InterActiveEdit],Changed);
|
||||||
|
'H' : InputWN1('%LF^1Enter new teleconference string:%LF^4: ',TeleConfPrivate,(SizeOf(TeleConfPrivate) - 1),
|
||||||
|
[ColorsAllowed,InterActiveEdit],Changed);
|
||||||
|
'I' : InputWN1('%LFIRQ for %E MCI code: ',IRQ,(SizeOf(IRQ) - 1),[InterActiveEdit],Changed);
|
||||||
|
'J' : InputWN1('%LFAddress for %C MCI code: ',Address,(SizeOf(Address) - 1),[InterActiveEdit],Changed);
|
||||||
|
'R' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5Modem configuration - Result Codes');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. NO CARRIER : ^5'+PadLeftStr(NOCARRIER,21)+'^1B. RELIABLE : ^5'+RELIABLE);
|
||||||
|
PrintACR('^1C. OK : ^5'+PadLeftStr(OK,21)+'^1D. RING : ^5'+RING);
|
||||||
|
PrintACR('^1E. CALLER ID : ^5'+PadLeftStr(CALLERID,21)+
|
||||||
|
'^1F. ID/User note : ^5'+ShowOnOff(UseCallerID));
|
||||||
|
FOR TempB := 1 TO MaxResultCodes DO
|
||||||
|
IF (NOT Odd(TempB)) THEN
|
||||||
|
Print('^1'+Chr(TempB + 70)+'. '+PadLeftStr(WhichBaud(TempB),14)+': ^5'+Connect[TempB])
|
||||||
|
ELSE
|
||||||
|
Prompt(PadLeftStr('^1'+Chr(TempB + 70)+'. '+PadLeftStr(WhichBaud(TempB),14)+': ^5'+Connect[TempB],40));
|
||||||
|
LOneK('%LFEnter selection [^5A^4-^5Z^4,^5<CR>^4=^5Quit^4]: ',Cmd,^M'ABCDEFGHIJKLMNOPQRSTUVWXYZ',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : InputWN1('%LFEnter NO CARRIER string: ',NOCARRIER,(SizeOf(NOCARRIER) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'B' : InputWN1('%LFEnter RELIABLE string: ',RELIABLE,(SizeOf(RELIABLE) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'C' : InputWN1('%LFEnter OK string: ',OK,(SizeOf(OK) - 1),[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'D' : InputWN1('%LFEnter RING string: ',RING,(SizeOf(RING) - 1),[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'E' : InputWN1('%LFEnter Caller ID string: ',CALLERID,(SizeOf(CALLERID) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'F' : UseCallerID := NOT UseCallerID;
|
||||||
|
'G'..'Z' :
|
||||||
|
BEGIN
|
||||||
|
TempB := (Ord(Cmd) - 70);
|
||||||
|
IF (TempB IN [1..MaxResultCodes]) THEN
|
||||||
|
InputWN1('%LFEnter '+WhichBaud(TempB)+' string: ',Connect[TempB],(SizeOf(Connect[1]) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = ^M);
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
Seek(LineFile,0);
|
||||||
|
Write(LineFile,Liner);
|
||||||
|
Close(LineFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,124 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2C;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE SystemACSSettings;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE SystemACSSettings;
|
||||||
|
VAR
|
||||||
|
TempACS: ACString;
|
||||||
|
Cmd: Char;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
CLS;
|
||||||
|
Print('^5System ACS Settings:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Full SysOp : ^5'+PadLeftStr(SOp,18)+
|
||||||
|
'^1B. Full Co-SysOp : ^5'+CSOp);
|
||||||
|
PrintACR('^1C. Msg Area SysOp : ^5'+PadLeftStr(MSOp,18)+
|
||||||
|
'^1D. File Area SysOp : ^5'+FSOp);
|
||||||
|
PrintACR('^1E. Change a vote : ^5'+PadLeftStr(ChangeVote,18)+
|
||||||
|
'^1F. Add voting choice: ^5'+AddChoice);
|
||||||
|
PrintACR('^1G. Post public : ^5'+PadLeftStr(NormPubPost,18)+
|
||||||
|
'^1H. Send e-mail : ^5'+NormPrivPost);
|
||||||
|
PrintACR('^1I. See anon pub post: ^5'+PadLeftStr(AnonPubRead,18)+
|
||||||
|
'^1J. See anon E-mail : ^5'+AnonPrivRead);
|
||||||
|
PrintACR('^1K. Global Anon post : ^5'+PadLeftStr(AnonPubPost,18)+
|
||||||
|
'^1L. E-mail anon : ^5'+AnonPrivPost);
|
||||||
|
PrintACR('^1M. See unval. files : ^5'+PadLeftStr(SeeUnVal,18)+
|
||||||
|
'^1N. DL unval. files : ^5'+DLUnVal);
|
||||||
|
PrintACR('^1O. No UL/DL ratio : ^5'+PadLeftStr(NoDLRatio,18)+
|
||||||
|
'^1P. No PostCall ratio: ^5'+NoPostRatio);
|
||||||
|
PrintACR('^1R. No DL credits chk: ^5'+PadLeftStr(NoFileCredits,18)+
|
||||||
|
'^1S. ULs auto-credited: ^5'+ULValReq);
|
||||||
|
PrintACR('^1T. MCI in TeleConf : ^5'+PadLeftStr(TeleConfMCI,18)+
|
||||||
|
'^1U. Chat at any hour : ^5'+OverRideChat);
|
||||||
|
PrintACR('^1V. Send Netmail : ^5'+PadLeftStr(NetMailACS,18)+
|
||||||
|
'^1W. "Invisible" Mode : ^5'+Invisible);
|
||||||
|
PrintACR('^1X. Mail file attach : ^5'+PadLeftStr(FileAttachACS,18)+
|
||||||
|
'^1Y. SysOp PW at logon: ^5'+SPW);
|
||||||
|
PrintACR('^1Z. Last On Add : ^5'+PadLeftStr(LastOnDatACS,18));
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
NL;
|
||||||
|
Prt('Enter selection [^5A^4-^5P^4,^5R^4-^5Z^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLMNOPRSTUVWXYZ'^M,TRUE,TRUE);
|
||||||
|
IF (Cmd IN ['A'..'P','R'..'Z']) THEN
|
||||||
|
BEGIN
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : TempACS := SOp;
|
||||||
|
'B' : TempACS := CSOp;
|
||||||
|
'C' : TempACS := MSOp;
|
||||||
|
'D' : TempACS := FSOp;
|
||||||
|
'E' : TempACS := ChangeVote;
|
||||||
|
'F' : TempACS := AddChoice;
|
||||||
|
'G' : TempACS := NormPubPost;
|
||||||
|
'H' : TempACS := NormPrivPost;
|
||||||
|
'I' : TempACS := AnonPubRead;
|
||||||
|
'J' : TempACS := AnonPrivRead;
|
||||||
|
'K' : TempACS := AnonPubPost;
|
||||||
|
'L' : TempACS := AnonPrivPost;
|
||||||
|
'M' : TempACS := SeeUnVal;
|
||||||
|
'N' : TempACS := DLUnVal;
|
||||||
|
'O' : TempACS := NoDLRatio;
|
||||||
|
'P' : TempACS := NoPostRatio;
|
||||||
|
'R' : TempACS := NoFileCredits;
|
||||||
|
'S' : TempACS := ULValReq;
|
||||||
|
'T' : TempACS := TeleConfMCI;
|
||||||
|
'U' : TempACS := OverRideChat;
|
||||||
|
'V' : TempACS := NetMailACS;
|
||||||
|
'W' : TempACS := Invisible;
|
||||||
|
'X' : TempACS := FileAttachACS;
|
||||||
|
'Y' : TempACS := SPW;
|
||||||
|
'Z' : TempACS := LastOnDatACS;
|
||||||
|
END;
|
||||||
|
InputWN1('%LFNew ACS: ',TempACS,(SizeOf(ACString) - 1),[InterActiveEdit],Changed);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : SOp := TempACS;
|
||||||
|
'B' : CSOp := TempACS;
|
||||||
|
'C' : MSOp := TempACS;
|
||||||
|
'D' : FSOp := TempACS;
|
||||||
|
'E' : ChangeVote := TempACS;
|
||||||
|
'F' : AddChoice := TempACS;
|
||||||
|
'G' : NormPubPost := TempACS;
|
||||||
|
'H' : NormPrivPost := TempACS;
|
||||||
|
'I' : AnonPubRead := TempACS;
|
||||||
|
'J' : AnonPrivRead := TempACS;
|
||||||
|
'K' : AnonPubPost := TempACS;
|
||||||
|
'L' : AnonPrivPost := TempACS;
|
||||||
|
'M' : SeeUnVal := TempACS;
|
||||||
|
'N' : DLUnVal := TempACS;
|
||||||
|
'O' : NoDLRatio := TempACS;
|
||||||
|
'P' : NoPostRatio := TempACS;
|
||||||
|
'R' : NoFileCredits := TempACS;
|
||||||
|
'S' : ULValReq := TempACS;
|
||||||
|
'T' : TeleConfMCI := TempACS;
|
||||||
|
'U' : OverRideChat := TempACS;
|
||||||
|
'V' : NetMailACS := TempACS;
|
||||||
|
'W' : Invisible := TempACS;
|
||||||
|
'X' : FileAttachACS := TempACS;
|
||||||
|
'Y' : SPW := TempACS;
|
||||||
|
'Z' : LastOnDatACS := TempACS;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,348 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2D;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE SystemGeneralVariables;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE SystemGeneralVariables;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
TempB,
|
||||||
|
MinByte,
|
||||||
|
MaxByte: Byte;
|
||||||
|
TempI,
|
||||||
|
MinInt,
|
||||||
|
MaxInt: SmallInt;
|
||||||
|
TempL,
|
||||||
|
MinLongInt,
|
||||||
|
MaxLongInt: LongInt;
|
||||||
|
|
||||||
|
FUNCTION DisplaySwapTo(SwapTo: Byte): Str4;
|
||||||
|
BEGIN
|
||||||
|
CASE SwapTo OF
|
||||||
|
0 : DisplaySwapTo := 'Disk';
|
||||||
|
1 : DisplaySwapTo := 'XMS';
|
||||||
|
2 : DisplaySwapTo := 'EMS';
|
||||||
|
4 : DisplaySwapTo := 'EXT';
|
||||||
|
255 : DisplaySwapTo := 'Any';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayMacroo(CONST S: AStr; MaxLen: Byte);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
TempStr := '';
|
||||||
|
Prompt('^5"^1');
|
||||||
|
FOR Counter := 1 TO Length(S) DO
|
||||||
|
IF (S[Counter] >= ' ') THEN
|
||||||
|
TempStr := TempStr + S[Counter]
|
||||||
|
ELSE
|
||||||
|
TempStr := TempStr + '^3^'+Chr(Ord(S[Counter]) + 64)+'^1';
|
||||||
|
Prompt(PadLeftStr(TempStr,MaxLen)+'^5"');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MMacroo(MacroNum: Byte);
|
||||||
|
VAR
|
||||||
|
S: AStr;
|
||||||
|
C: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
Print('%CL^5Enter new F'+IntToStr(MacroNum + 1)+' macro now.');
|
||||||
|
Print('^5Enter ^Z to end recording. 100 character limit.%LF');
|
||||||
|
S := '';
|
||||||
|
Counter := 1;
|
||||||
|
REPEAT
|
||||||
|
C := Char(GetKey);
|
||||||
|
IF (C = ^H) THEN
|
||||||
|
BEGIN
|
||||||
|
C := #0;
|
||||||
|
IF (Counter >= 2) THEN
|
||||||
|
BEGIN
|
||||||
|
BackSpace;
|
||||||
|
Dec(Counter);
|
||||||
|
IF (S[Counter] < #32) THEN
|
||||||
|
BackSpace;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Counter <= 100) AND (C <> #0) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (C IN [#32..#255]) THEN
|
||||||
|
BEGIN
|
||||||
|
OutKey(C);
|
||||||
|
S[Counter] := C;
|
||||||
|
Inc(Counter);
|
||||||
|
END
|
||||||
|
ELSE IF (C IN [^A,^B,^C,^D,^E,^F,^G,^H,^I,^J,^K,^L,^M,^N,^P,^Q,^R,^S,^T,^U,^V,^W,^X,^Y,#27,#28,#29,#30,#31]) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (C = ^M) THEN
|
||||||
|
NL
|
||||||
|
ELSE
|
||||||
|
Prompt('^3^'+Chr(Ord(C) + 64)+'^1');
|
||||||
|
S[Counter] := C;
|
||||||
|
Inc(Counter);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL ((C = ^Z) OR (HangUp));
|
||||||
|
S[0] := Chr(Counter - 1);
|
||||||
|
Print('%LF%LF^3Your F'+IntToStr(MacroNum + 1)+' macro is now:%LF');
|
||||||
|
DisplayMacroo(S,160);
|
||||||
|
Com_Flush_Recv;
|
||||||
|
IF (NOT PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
Print('%LFMacro not saved.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
General.Macro[MacroNum] := S;
|
||||||
|
Print('%LFMacro saved.');
|
||||||
|
END;
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5System Variables:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Max private sent per call: ^5'+PadLeftInt(MaxPrivPost,6)+
|
||||||
|
'^1 B. Max feedback sent per call: ^5'+PadLeftInt(MaxFBack,6));
|
||||||
|
PrintACR('^1C. Max public posts per call: ^5'+PadLeftInt(MaxPubPost,6)+
|
||||||
|
'^1 D. Max chat attempts per call: ^5'+PadLeftInt(MaxChat,6));
|
||||||
|
PrintACR('^1E. Normal max mail waiting : ^5'+PadLeftInt(MaxWaiting,6)+
|
||||||
|
'^1 F. CoSysOp max mail waiting : ^5'+PadLeftInt(CSMaxWaiting,6));
|
||||||
|
PrintACR('^1G. Max mass mail list : ^5'+PadLeftInt(MaxMassMailList,6)+
|
||||||
|
'^1 H. Logins before bday check : ^5'+PadLeftInt(BirthDateCheck,6));
|
||||||
|
PrintACR('^1I. Swap shell should use : ^5'+PadLeftStr(DisplaySwapTo(SwapTo),6)+
|
||||||
|
'^1 J. Number of logon attempts : ^5'+PadLeftInt(MaxLogonTries,6));
|
||||||
|
PrintACR('^1K. Password change in days : ^5'+PadLeftInt(PasswordChange,6)+
|
||||||
|
'^1 L. SysOp chat color : ^5'+PadLeftInt(SysOpColor,6));
|
||||||
|
PrintACR('^1M. User chat color : ^5'+PadLeftInt(UserColor,6)+
|
||||||
|
'^1 N. Min. space for posts : ^5'+PadLeftInt(MinSpaceForPost,6));
|
||||||
|
PrintACR('^1O. Min. space for uploads : ^5'+PadLeftInt(MinSpaceForUpload,6)+
|
||||||
|
'^1 P. Back SysOp Log keep days : ^5'+PadLeftInt(BackSysOpLogs,6));
|
||||||
|
PrintACR('^1R. Blank WFC menu minutes : ^5'+PadLeftInt(WFCBlankTime,6)+
|
||||||
|
'^1 S. Alert beep delay : ^5'+PadLeftInt(AlertBeep,6));
|
||||||
|
PrintACR('^1T. Number of system callers : ^5'+PadLeftInt(CallerNum,6)+
|
||||||
|
'^1 U. Minimum logon baud rate : ^5'+PadLeftInt(MinimumBaud,6));
|
||||||
|
PrintACR('^1V. Minimum D/L baud rate : ^5'+PadLeftInt(MinimumDLBaud,6)+
|
||||||
|
'^1 W. Sec''s between Time Slices : ^5'+PadLeftInt(SliceTimer,6));
|
||||||
|
PrintACR('^1X. TB max time allowed : ^5'+PadLeftInt(MaxDepositEver,6)+
|
||||||
|
'^1 Y. TB max per day deposit : ^5'+PadLeftInt(MaxDepositPerDay,6));
|
||||||
|
PrintACR('^1Z. TB max per day withdrawal: ^5'+PadLeftInt(MaxWithDrawalPerDay,6));
|
||||||
|
NL;
|
||||||
|
FOR TempB := 0 TO 9 DO
|
||||||
|
BEGIN
|
||||||
|
Prompt('^1'+IntToStr(TempB)+'. F'+IntToStr(TempB + 1)+' Macro :^5');
|
||||||
|
DisplayMacroo(Macro[TempB],21);
|
||||||
|
IF Odd(TempB) THEN
|
||||||
|
NL
|
||||||
|
ELSE
|
||||||
|
Prompt(' ');
|
||||||
|
END;
|
||||||
|
Prt('%LFEnter selection [^5A^4-^5P^4,^5R^4-^5Z^4,^50^4-^59^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLMNOPRSTUVWXYZ1234567890'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'0'..'9' :
|
||||||
|
MMacroo(Ord(Cmd) - Ord('0'));
|
||||||
|
'I' : BEGIN
|
||||||
|
Print('%LF^5Swap locations:^1');
|
||||||
|
Print('%LF^1(^3D^1)isk');
|
||||||
|
Print('^1(^3E^1)MS');
|
||||||
|
Print('^1(^3X^1)MS');
|
||||||
|
Print('^1(^3N^1)on XMS Extended');
|
||||||
|
Print('^1(^3A^1)ny');
|
||||||
|
lOneK('%LFSwap to which? [^5D^4,^5E^4,^5X^4,^5N^4,^5A^4,^5<CR>^4=^5Quit^4]: ',Cmd,'DEXNA'^M,TRUE,TRUE);
|
||||||
|
CASE Pos(Cmd,'DXENA') OF
|
||||||
|
1..3 : SwapTo := (Pos(Cmd,'DXE') - 1);
|
||||||
|
4 : SwapTo := 4;
|
||||||
|
5 : SwapTo := 255;
|
||||||
|
END;
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'A'..'H','J'..'P','R'..'Z' :
|
||||||
|
BEGIN
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxPrivPost;
|
||||||
|
END;
|
||||||
|
'B' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxFBack;
|
||||||
|
END;
|
||||||
|
'C' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxPubPost;
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxChat;
|
||||||
|
END;
|
||||||
|
'E' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxWaiting;
|
||||||
|
END;
|
||||||
|
'F' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := CSMaxWaiting;
|
||||||
|
END;
|
||||||
|
'G' : BEGIN
|
||||||
|
MinByte := 2;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxMassMailList;
|
||||||
|
END;
|
||||||
|
'H' : BEGIN
|
||||||
|
MinInt := 0;
|
||||||
|
MaxInt := 365;
|
||||||
|
TempI := BirthDateCheck;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := MaxLogonTries;
|
||||||
|
END;
|
||||||
|
'K' : BEGIN
|
||||||
|
MinInt := 0;
|
||||||
|
MaxInt := 32767;
|
||||||
|
TempI := PasswordChange;
|
||||||
|
END;
|
||||||
|
'L' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 9;
|
||||||
|
TempB := SysOpColor;
|
||||||
|
END;
|
||||||
|
'M' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 9;
|
||||||
|
TempB := UserColor;
|
||||||
|
END;
|
||||||
|
'N' : BEGIN
|
||||||
|
MinInt := 1;
|
||||||
|
MaxInt := 32767;
|
||||||
|
TempI := MinSpaceForPost;
|
||||||
|
END;
|
||||||
|
'O' : BEGIN
|
||||||
|
MinInt := 1;
|
||||||
|
MaxInt := 32767;
|
||||||
|
TempI := MinSpaceForUpload;
|
||||||
|
END;
|
||||||
|
'P' : BEGIN
|
||||||
|
MinByte := 1;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := BackSysOpLogs;
|
||||||
|
END;
|
||||||
|
'R' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 60;
|
||||||
|
TempB := WFCBlankTime;
|
||||||
|
END;
|
||||||
|
'S' : BEGIN
|
||||||
|
MinByte := 0;
|
||||||
|
MaxByte := 60;
|
||||||
|
TempB := AlertBeep;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
MinLongInt := 0;
|
||||||
|
MaxLongInt := 2147483647;
|
||||||
|
TempL := CallerNum;
|
||||||
|
END;
|
||||||
|
'U' : BEGIN
|
||||||
|
MinLongInt := 0;
|
||||||
|
MaxLongInt := 115200;
|
||||||
|
TempL := MinimumBaud;
|
||||||
|
END;
|
||||||
|
'V' : BEGIN
|
||||||
|
MinLongInt := 0;
|
||||||
|
MaxLongInt := 115200;
|
||||||
|
TempL := MinimumDLBaud;
|
||||||
|
END;
|
||||||
|
'W' : BEGIN
|
||||||
|
MinByte := 1;
|
||||||
|
MaxByte := 255;
|
||||||
|
TempB := SliceTimer;
|
||||||
|
END;
|
||||||
|
'X' : BEGIN
|
||||||
|
MinLongInt := 0;
|
||||||
|
MaxLongInt := 6000;
|
||||||
|
TempL := MaxDepositEver;
|
||||||
|
END;
|
||||||
|
'Y' : BEGIN
|
||||||
|
MinLongInt := 0;
|
||||||
|
MaxLongInt := 6000;
|
||||||
|
TempL := MaxDepositPerDay;
|
||||||
|
END;
|
||||||
|
'Z' : BEGIN
|
||||||
|
MinLongInt := 0;
|
||||||
|
MaxLongInt := 6000;
|
||||||
|
TempL := MaxWithdrawalPerDay
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
CASE Cmd OF
|
||||||
|
'H','K','N'..'O' :
|
||||||
|
InputIntegerWOC('%LFNew value',TempI,[NumbersOnly],MinInt,MaxInt);
|
||||||
|
'T'..'V','X'..'Z' :
|
||||||
|
InputLongIntWOC('%LFNew value',TempL,[DisplayValue,NumbersOnly],MinLongInt,MaxLongInt);
|
||||||
|
ELSE
|
||||||
|
InputByteWOC('%LFNew value',TempB,[NumbersOnly],MinByte,MaxByte);
|
||||||
|
END;
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : MaxPrivPost := TempB;
|
||||||
|
'B' : MaxFBack := TempB;
|
||||||
|
'C' : MaxPubPost := TempB;
|
||||||
|
'D' : MaxChat := TempB;
|
||||||
|
'E' : MaxWaiting := TempB;
|
||||||
|
'F' : CSMaxWaiting := TempB; (* Not Hooked Up *)
|
||||||
|
'G' : MaxMassMailList := TempB;
|
||||||
|
'H' : BEGIN
|
||||||
|
BirthDateCheck := TempI;
|
||||||
|
(*
|
||||||
|
IF (BirthDateCheck = 0) THEN
|
||||||
|
NewUserToggles[9] := 0
|
||||||
|
ELSE
|
||||||
|
NewUserToggles[9] := 2;
|
||||||
|
*)
|
||||||
|
END;
|
||||||
|
'J' : MaxLogonTries := TempB;
|
||||||
|
'K' : PasswordChange := TempI;
|
||||||
|
'L' : SysOpColor := TempB;
|
||||||
|
'M' : UserColor := TempB;
|
||||||
|
'N' : MinSpaceForPost := TempI;
|
||||||
|
'O' : MinSpaceForUpload := TempI;
|
||||||
|
'P' : BackSysOpLogs := TempB;
|
||||||
|
'R' : WFCBlankTime := TempB;
|
||||||
|
'S' : AlertBeep := TempB;
|
||||||
|
'T' : CallerNum := TempL;
|
||||||
|
'U' : MinimumBaud := TempL;
|
||||||
|
'V' : MinimumDLBaud := TempL;
|
||||||
|
'W' : SliceTimer := TempB;
|
||||||
|
'X' : MaxDepositEver := TempL;
|
||||||
|
'Y' : MaxDepositPerDay := TempL;
|
||||||
|
'Z' : MaxWithDrawalPerDay := TempL;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,159 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
{ System Configuration - System Flagged Functions }
|
||||||
|
|
||||||
|
(* 1. Add checking for deleted users or forwarded mail to option 1 *)
|
||||||
|
|
||||||
|
UNIT SysOp2E;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE SystemFlaggedFunctions;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Crt,
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE SystemFlaggedFunctions;
|
||||||
|
VAR
|
||||||
|
Cmd,
|
||||||
|
Cmd1: Char;
|
||||||
|
LowNum,
|
||||||
|
HiNum,
|
||||||
|
TempInt: SmallInt;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5System Flagged Functions:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Handles allowed on system: ^5'+ShowOnOff(AllowAlias)+
|
||||||
|
'^1 B. Phone number in logon : ^5'+ShowOnOff(PhonePW));
|
||||||
|
PrintACR('^1C. Local security protection: ^5'+ShowOnOff(LocalSec)+
|
||||||
|
'^1 D. Use EMS for overlay file : ^5'+ShowOnOff(UseEMS));
|
||||||
|
PrintACR('^1E. Global activity trapping : ^5'+ShowOnOff(GlobalTrap)+
|
||||||
|
'^1 F. Auto chat buffer open : ^5'+ShowOnOff(AutoChatOpen));
|
||||||
|
PrintACR('^1G. AutoMessage in logon : ^5'+ShowOnOff(AutoMInLogon)+
|
||||||
|
'^1 H. Bulletins in logon : ^5'+ShowOnOff(BullInLogon));
|
||||||
|
PrintACR('^1I. User info in logon : ^5'+ShowOnOff(YourInfoInLogon)+
|
||||||
|
'^1 J. Strip color off SysOp Log : ^5'+ShowOnOff(StripCLog));
|
||||||
|
PrintACR('^1K. Offhook in local logon : ^5'+ShowOnOff(OffHookLocalLogon)+
|
||||||
|
'^1 L. Trap Teleconferencing : ^5'+ShowOnOff(TrapTeleConf));
|
||||||
|
PrintACR('^1M. Compress file/msg numbers: ^5'+ShowOnOff(CompressBases)+
|
||||||
|
' ^1 N. Use BIOS for video output : ^5'+ShowOnOff(UseBIOS));
|
||||||
|
PrintACR('^1O. Use IEMSI handshakes : ^5'+ShowOnOff(UseIEMSI)+
|
||||||
|
'^1 P. Refuse new users : ^5'+ShowOnOff(ClosedSystem));
|
||||||
|
PrintACR('^1R. Swap shell function : ^5'+ShowOnOff(SwapShell)+
|
||||||
|
'^1 S. Use shuttle logon : ^5'+ShowOnOff(ShuttleLog));
|
||||||
|
PrintACR('^1T. Chat call paging : ^5'+ShowOnOff(ChatCall)+
|
||||||
|
'^1 U. Time limits are per call : ^5'+ShowOnOff(PerCall));
|
||||||
|
PrintACR('^1V. SysOp Password checking : ^5'+ShowOnOff(SysOpPWord)+
|
||||||
|
'^1 W. Random quote in logon : ^5'+ShowOnOff(LogonQuote));
|
||||||
|
PrintACR('^1X. User add quote in logon : ^5'+ShowOnOff(UserAddQuote)+
|
||||||
|
'^1 Y. Use message area lightbar : ^5'+ShowOnOff(UseMsgAreaLightBar));
|
||||||
|
PrintACR('^1Z. Use file area lightbar : ^5'+ShowOnOff(UseFileAreaLightBar));
|
||||||
|
PrintACR('');
|
||||||
|
PrintACR('^11. New user message sent to : ^5'+AOnOff((NewApp = -1),'Off',PadLeftInt(NewApp,5)));
|
||||||
|
PrintACR('^12. Mins before TimeOut bell : ^5'+AOnOff((TimeOutBell = -1),'Off',PadLeftInt(TimeOutBell,3)));
|
||||||
|
PrintACR('^13. Mins before TimeOut : ^5'+AOnOff((TimeOut = -1),'Off',PadLeftInt(TimeOut,3)));
|
||||||
|
Prt('%LFEnter selection [^5A^4-^5P^4,^5R^4-^5Z^4,^51^4-^53^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLMNOPRSTUVWXYZ123'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : AllowAlias := NOT AllowAlias;
|
||||||
|
'B' : BEGIN
|
||||||
|
PhonePW := NOT PhonePW;
|
||||||
|
IF (PhonePW) THEN
|
||||||
|
NewUserToggles[7] := 8
|
||||||
|
ELSE
|
||||||
|
NewUserToggles[7] := 0;
|
||||||
|
END;
|
||||||
|
'C' : LocalSec := NOT LocalSec;
|
||||||
|
'D' : BEGIN
|
||||||
|
UseEMS := NOT UseEMS;
|
||||||
|
IF (UseEMS) THEN
|
||||||
|
OvrUseEMS := TRUE
|
||||||
|
ELSE
|
||||||
|
OvrUseEMS := FALSE;
|
||||||
|
END;
|
||||||
|
'E' : GlobalTrap := NOT GlobalTrap;
|
||||||
|
'F' : AutoChatOpen := NOT AutoChatOpen;
|
||||||
|
'G' : AutoMInLogon := NOT AutoMInLogon;
|
||||||
|
'H' : BullInLogon := NOT BullInLogon;
|
||||||
|
'I' : YourInfoInLogon := NOT YourInfoInLogon;
|
||||||
|
'J' : StripCLog := NOT StripCLog;
|
||||||
|
'K' : OffHookLocalLogon := NOT OffHookLocalLogon;
|
||||||
|
'L' : TrapTeleConf := NOT TrapTeleConf;
|
||||||
|
'M' : BEGIN
|
||||||
|
CompressBases := NOT CompressBases;
|
||||||
|
IF (CompressBases) THEN
|
||||||
|
Print('%LFCompressing file/message areas ...')
|
||||||
|
ELSE
|
||||||
|
Print('%LFDe-compressing file/message areas ...');
|
||||||
|
NewCompTables;
|
||||||
|
END;
|
||||||
|
'N' : BEGIN
|
||||||
|
UseBIOS := NOT UseBIOS;
|
||||||
|
DirectVideo := NOT UseBIOS;
|
||||||
|
END;
|
||||||
|
'O' : UseIEMSI := NOT UseIEMSI;
|
||||||
|
'P' : ClosedSystem := NOT ClosedSystem;
|
||||||
|
'R' : SwapShell := NOT SwapShell;
|
||||||
|
'S' : ShuttleLog := NOT ShuttleLog;
|
||||||
|
'T' : ChatCall := NOT ChatCall;
|
||||||
|
'U' : PerCall := NOT PerCall;
|
||||||
|
'V' : SysOpPWord := NOT SysOpPWord;
|
||||||
|
'W' : LogonQuote := NOT LogonQuote;
|
||||||
|
'X' : UserAddQuote := NOT UserAddQuote;
|
||||||
|
'Y' : UseMsgAreaLightBar := NOT UseMsgAreaLightBar;
|
||||||
|
'Z' : UseFileAreaLightBar := NOT UseFileAreaLightBar;
|
||||||
|
'1'..'3' :
|
||||||
|
BEGIN
|
||||||
|
Prt('%LFSelect option [^5E^4=^5Enable^4,^5D^4=^5Disable^4,^5<CR>^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd1,^M'ED',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['E','D']) THEN
|
||||||
|
BEGIN
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'E' : BEGIN
|
||||||
|
CASE Cmd OF
|
||||||
|
'1' : BEGIN
|
||||||
|
LowNum := 1;
|
||||||
|
HiNum := (MaxUsers - 1);
|
||||||
|
TempInt := NewApp;
|
||||||
|
END;
|
||||||
|
'2' : BEGIN
|
||||||
|
LowNum := 1;
|
||||||
|
HiNum := 20;
|
||||||
|
TempInt := TimeOutBell;
|
||||||
|
END;
|
||||||
|
'3' : BEGIN
|
||||||
|
LowNum := 1;
|
||||||
|
HiNum := 20;
|
||||||
|
TempInt := TimeOut;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
InputIntegerWOC('%LFEnter value for this function',TempInt,[NumbersOnly],LowNum,HiNum);
|
||||||
|
END;
|
||||||
|
'D' : TempInt := -1;
|
||||||
|
END;
|
||||||
|
CASE Cmd OF
|
||||||
|
'1' : NewApp := TempInt;
|
||||||
|
'2' : TimeOutBell := TempInt;
|
||||||
|
'3' : TimeOut := TempInt;
|
||||||
|
END;
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,78 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2F;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE FileAreaConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE FileAreaConfiguration;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5File Area Configuration:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Upload/download ratio system : ^5'+ShowOnOff(ULDLRatio));
|
||||||
|
PrintACR('^1B. File point system : ^5'+ShowOnOff(FileCreditRatio));
|
||||||
|
PrintACR('^1C. Daily download limits : ^5'+ShowOnOff(DailyLimits));
|
||||||
|
PrintACR('^1D. Test and convert uploads : ^5'+ShowOnOff(TestUploads));
|
||||||
|
PrintACR('^1E. File point rewarding system : ^5'+ShowOnOff(RewardSystem));
|
||||||
|
PrintACR('^1F. Search for/Use FILE_ID.DIZ : ^5'+ShowOnOff(FileDiz));
|
||||||
|
PrintACR('^1G. Recompress like archives : ^5'+ShowOnOff(Recompress));
|
||||||
|
PrintACR('^1H. Credit reward compensation ratio: ^5'+IntToStr(RewardRatio)+'%');
|
||||||
|
PrintACR('^1I. File point compensation ratio : ^5'+IntToStr(FileCreditComp)+' to 1');
|
||||||
|
PrintACR('^1J. Area file size per 1 file point : ^5'+IntToStr(FileCreditCompBaseSize)+'k');
|
||||||
|
PrintACR('^1K. Upload time refund percent : ^5'+IntToStr(ULRefund)+'%');
|
||||||
|
PrintACR('^1L. "To-SysOp" file area : ^5'+AOnOff(ToSysOpDir = 0,'*None*',IntToStr(ToSysOpDir)));
|
||||||
|
PrintACR('^1M. Auto-validate ALL files ULed? : ^5'+ShowYesNo(ValidateAllFiles));
|
||||||
|
PrintACR('^1N. Max k-bytes allowed in temp dir : ^5'+IntToStr(MaxInTemp));
|
||||||
|
PrintACR('^1O. Min k-bytes to save for resume : ^5'+IntToStr(MinResume));
|
||||||
|
PrintACR('^1P. Max batch download files : ^5'+IntToStr(MaxBatchDLFiles));
|
||||||
|
PrintACR('^1R. Max batch upload files : ^5'+IntToStr(MaxBatchUlFiles));
|
||||||
|
PrintACR('^1S. UL duplicate file search : ^5'+ShowOnOff(SearchDup));
|
||||||
|
PrintACR('^1T. Force batch download at login : ^5'+ShowOnOff(ForceBatchDL));
|
||||||
|
PrintACR('^1U. Force batch upload at login : ^5'+ShowOnOff(ForceBatchUL));
|
||||||
|
NL;
|
||||||
|
Prt('Enter selection [^5A^4-^5P^4,^5R^4-^5U^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLMNOPRSTU'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : ULDLRatio := NOT ULDLRatio;
|
||||||
|
'B' : FileCreditRatio := NOT FileCreditRatio;
|
||||||
|
'C' : DailyLimits := NOT DailyLimits;
|
||||||
|
'D' : TestUploads := NOT TestUploads;
|
||||||
|
'E' : RewardSystem := NOT RewardSystem;
|
||||||
|
'F' : FileDiz := NOT FileDiz;
|
||||||
|
'G' : Recompress := NOT Recompress;
|
||||||
|
'H' : InputIntegerWOC('%LFNew percentage of file credits to reward',RewardRatio,[DisplayValue,NumbersOnly],0,100);
|
||||||
|
'I' : InputByteWOC('%LFNew file point compensation ratio',FileCreditComp,[DisplayValue,Numbersonly],0,100);
|
||||||
|
'J' : InputByteWOC('%LFNew area file size per 1 file Point',FileCreditCompBaseSize,[DisplayValue,NumbersOnly],0,255);
|
||||||
|
'K' : InputByteWOC('%LFNew upload time refund percent',ULRefund,[DisplayValue,NumbersOnly],0,100);
|
||||||
|
'L' : InputIntegerWOC('%LFNew "To-SysOp" file area (0=None)',ToSysOpDir,[DisplayValue,NumbersOnly],0,NumFileAreas);
|
||||||
|
'M' : ValidateAllFiles := NOT ValidateAllFiles;
|
||||||
|
'N' : InputLongIntWOC('%LFNew max k-bytes',MaxInTemp,[DisplayValue,NumbersOnly],0,2097151);
|
||||||
|
'O' : InputLongIntWOC('%LFNew min resume k-bytes',MinResume,[DisplayValue,NumbersOnly],0,2097151);
|
||||||
|
'P' : InputByteWOC('%LFNew max batch download files',MaxBatchDLFiles,[DisplayValue,NumbersOnly],1,255);
|
||||||
|
'R' : InputByteWOC('%LFNew max batch upload files',MaxBatchULFiles,[DisplayValue,NumbersOnly],1,255);
|
||||||
|
'S' : SearchDup := NOT SearchDup;
|
||||||
|
'T' : ForceBatchDL := NOT ForceBatchDL;
|
||||||
|
'U' : ForceBatchUL := NOT ForceBatchUL;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,884 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2G;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE AutoVal(VAR User: UserRecordType; UNum: Integer);
|
||||||
|
PROCEDURE AutoValidate(VAR User: UserRecordType; UNum: Integer; Level: Char);
|
||||||
|
PROCEDURE AutoValidationCmd(MenuOption: Str50);
|
||||||
|
PROCEDURE ValidationEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
ShortMsg,
|
||||||
|
SysOp7,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
CONST
|
||||||
|
Settings: FlagSet = [RLogon,
|
||||||
|
RChat,
|
||||||
|
RValidate,
|
||||||
|
RUserList,
|
||||||
|
RAMsg,
|
||||||
|
RPostAN,
|
||||||
|
RPost,
|
||||||
|
REmail,
|
||||||
|
RVoting,
|
||||||
|
RMsg,
|
||||||
|
FNoDLRatio,
|
||||||
|
FNoPostRatio,
|
||||||
|
FNoCredits,
|
||||||
|
FNoDeletion];
|
||||||
|
|
||||||
|
FUNCTION ARMatch(SoftAR: Boolean; UserAR,NewAR: ARFlagSet): Boolean;
|
||||||
|
VAR
|
||||||
|
SaveUserAR: ARFlagSet;
|
||||||
|
Match: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Match := FALSE;
|
||||||
|
SaveUserAR := UserAR;
|
||||||
|
IF (SoftAR) THEN
|
||||||
|
UserAR := (UserAR + NewAR)
|
||||||
|
ELSE
|
||||||
|
UserAR := NewAR;
|
||||||
|
IF (SaveUserAR = UserAR) THEN
|
||||||
|
Match := TRUE;
|
||||||
|
ARMatch := Match;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION ACMatch(SoftAC: Boolean; UserAC,NewAC: FlagSet): Boolean;
|
||||||
|
VAR
|
||||||
|
SaveUserAC: FlagSet;
|
||||||
|
Match: Boolean;
|
||||||
|
BEGIN
|
||||||
|
Match := FALSE;
|
||||||
|
SaveUserAC := UserAC;
|
||||||
|
IF (NOT SoftAC) THEN
|
||||||
|
UserAC := (UserAC - Settings);
|
||||||
|
UserAC := (UserAC + (NewAC * Settings));
|
||||||
|
IF (SaveUserAC = UserAC) THEN
|
||||||
|
Match := TRUE;
|
||||||
|
ACMatch := Match;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayValidationRecords(VAR RecNumToList1: Integer);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
NumDone,
|
||||||
|
NumOnline: Byte;
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToList1 < 1) OR (RecNumToList1 > NumValKeys) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
TempStr := '';
|
||||||
|
NumOnline := 0;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^0##^4:^3K^4:^3Description ^0##^4:^3K^4:^3Description');
|
||||||
|
PrintACR('^4==:=:============================== ==:=:==============================');
|
||||||
|
Reset(ValidationFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumValKeys)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNumToList1 - 1));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
TempStr := TempStr + '^0'+PadLeftStr(PadRightInt(RecNumToList1,2)+
|
||||||
|
' ^3'+Validation.Key+
|
||||||
|
' ^5'+Validation.Description,37);
|
||||||
|
Inc(NumOnline);
|
||||||
|
IF (NumOnline = 2) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintaCR(TempStr);
|
||||||
|
NumOnline := 0;
|
||||||
|
Inc(NumDone);
|
||||||
|
TempStr := '';
|
||||||
|
END;
|
||||||
|
Inc(RecNumToList1);
|
||||||
|
END;
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumOnline = 1) AND (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
PrintaCR(TempStr);
|
||||||
|
IF (NumValKeys = 0) AND (NOT Abort) AND (NOT HangUp) THEN
|
||||||
|
Print('^7No validation records.');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE AutoValidate(VAR User: UserRecordType; UNum: Integer; Level: Char);
|
||||||
|
VAR
|
||||||
|
RecNum,
|
||||||
|
RecNum1: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NOT (Level IN ValKeys)) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('^7Validation error, invalid level: "'+Level+'"!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Reset(ValidationFile);
|
||||||
|
RecNum1 := -1;
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= NumValKeys) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNum - 1));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
IF (Validation.Key = Level) THEN
|
||||||
|
RecNum1 := RecNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (Validation.Expiration = 0) AND (Validation.ExpireTo <> ' ') OR
|
||||||
|
(Validation.Expiration <> 0) AND (Validation.ExpireTo = ' ') THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('^7Validation error, expiration data invalid: "'+Level+'"!');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE IF (Validation.ExpireTo <> ' ') AND (NOT (Validation.ExpireTo IN ValKeys)) THEN
|
||||||
|
BEGIN
|
||||||
|
SysOpLog('^7Validation error, expire to level "'+Validation.ExpireTo+'" does not exists!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
User.Subscription := Level;
|
||||||
|
User.TLToday := General.TimeAllow[Validation.NewSL] - (General.TimeAllow[User.SL] - User.TLToday);
|
||||||
|
User.SL := Validation.NewSL;
|
||||||
|
User.DSL := Validation.NewDSL;
|
||||||
|
User.UserStartMenu := Validation.NewMenu;
|
||||||
|
IF (Validation.Expiration > 0) THEN
|
||||||
|
User.Expiration := (GetPackDateTime + (Validation.Expiration * 86400))
|
||||||
|
ELSE
|
||||||
|
User.Expiration := 0;
|
||||||
|
Inc(User.FilePoints,Validation.NewFP);
|
||||||
|
Inc(User.lCredit,Validation.NewCredit);
|
||||||
|
IF (Validation.ExpireTo IN [' ','!'..'~']) THEN
|
||||||
|
User.ExpireTo := Validation.ExpireTo;
|
||||||
|
IF (Validation.SoftAR) THEN
|
||||||
|
User.AR := (User.AR + Validation.NewAR)
|
||||||
|
ELSE
|
||||||
|
User.AR := Validation.NewAR;
|
||||||
|
IF (NOT Validation.SoftAC) THEN
|
||||||
|
User.Flags := (User.Flags - Settings);
|
||||||
|
User.Flags := (User.Flags + (Validation.NewAC * Settings));
|
||||||
|
SaveURec(User,UNum);
|
||||||
|
IF (UNum = UserNum) THEN
|
||||||
|
NewCompTables;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE AutoVal(VAR User: UserRecordType; UNum: Integer);
|
||||||
|
VAR
|
||||||
|
TempAR: ARFlagSet;
|
||||||
|
TempAC: FlagSet;
|
||||||
|
Level: Char;
|
||||||
|
CmdKeys: AStr;
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
RecNumToList: Integer;
|
||||||
|
BEGIN
|
||||||
|
CmdKeys := '';
|
||||||
|
FOR Level := '!' TO '~' DO
|
||||||
|
IF (Level IN ValKeys) THEN
|
||||||
|
CmdKeys := CmdKeys + Level;
|
||||||
|
RecNumToList := 1;
|
||||||
|
Level := '?';
|
||||||
|
REPEAT
|
||||||
|
IF (Level = '?') THEN
|
||||||
|
DisplayValidationRecords(RecNumToList);
|
||||||
|
Prt('%LFValidation level? (^5!^4-^5P^4,^5R^4-^5p^4,^5r^4-^5~^4) [^5?^4=^5First^4,^5<CR>^4=^5Next^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK1(Level,'Q'+CmdKeys+'?'^M,TRUE,TRUE);
|
||||||
|
IF (Level <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Level = ^M) THEN
|
||||||
|
BEGIN
|
||||||
|
Level := '?';
|
||||||
|
IF (RecNumToList < 1) OR (RecNumToList > NumValKeys) THEN
|
||||||
|
RecNumToList := 1
|
||||||
|
END
|
||||||
|
ELSE IF (Level = '?') THEN
|
||||||
|
RecNumToList := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Level IN ValKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ValidationFile);
|
||||||
|
RecNum1 := -1;
|
||||||
|
RecNum:= 1;
|
||||||
|
WHILE (RecNum <= NumValKeys) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNum - 1));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
IF (Validation.Key = Level) THEN
|
||||||
|
RecNum1 := RecNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(ValidationFile);
|
||||||
|
IF (Validation.Expiration = 0) AND (Validation.ExpireTo <> ' ') OR
|
||||||
|
(Validation.Expiration <> 0) AND (Validation.ExpireTo = ' ') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The expiration days/expire to level is invalid!^1');
|
||||||
|
Level := #0;
|
||||||
|
END
|
||||||
|
ELSE IF (Validation.ExpireTo <> ' ') AND (NOT (Validation.ExpireTo IN ValKeys)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The expiration level does not exist for level: "'+Level+'"!^1');
|
||||||
|
Level := #0;
|
||||||
|
END
|
||||||
|
ELSE IF (User.SL = Validation.NewSL) AND (User.DSL = Validation.NewDSL) AND
|
||||||
|
ARMatch(Validation.SoftAR,User.AR,Validation.NewAR) AND
|
||||||
|
ACMatch(Validation.SoftAC,User.Flags,Validation.NewAC) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7This user is already validated at level "'+Level+'"!^1');
|
||||||
|
Level := #0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^1Description: ^5'+Validation.Description);
|
||||||
|
Print('%LF^1 < Old Settings > < New Settings >');
|
||||||
|
Print('%LF^1Sub: ^5'+PadLeftStr(User.Subscription,30)+'^1Sub: ^5'+Level);
|
||||||
|
Print('^1SL : ^5'+PadLeftInt(User.SL,30)+'^1SL : ^5'+IntToStr(Validation.NewSL));
|
||||||
|
Print('^1DSL: ^5'+PadLeftInt(User.DSL,30)+'^1DSL: ^5'+IntToStr(Validation.NewDSL));
|
||||||
|
TempAR := User.AR;
|
||||||
|
IF (Validation.SoftAR) THEN
|
||||||
|
TempAR := (TempAR + Validation.NewAR)
|
||||||
|
ELSE
|
||||||
|
TempAR := Validation.NewAR;
|
||||||
|
Print('^1AR : ^5'+PadLeftStr(DisplayARFlags(User.AR,'5','1'),30)+'^1AR : ^5'+DisplayArFlags(TempAR,'5','1'));
|
||||||
|
TempAC := User.Flags;
|
||||||
|
IF (NOT Validation.SoftAC) THEN
|
||||||
|
TempAC := (TempAC - Settings);
|
||||||
|
TempAC := (TempAC + (Validation.NewAC * Settings));
|
||||||
|
Print('^1AC : ^5'+PadLeftStr(DisplayACFlags(User.Flags,'5','1'),30)+'^1AC : ^5'+DisplayACFlags(TempAC,'5','1'));
|
||||||
|
Print('^1FP : ^5'+PadLeftInt(User.FilePoints,30)+'^1FP : ^5'+IntToStr(User.FilePoints + Validation.NewFP));
|
||||||
|
Print('^1Crd: ^5'+PadLeftInt(User.lCredit,30)+'^1Crd: ^5'+IntToStr(User.lCredit + Validation.NewCredit));
|
||||||
|
Print('^1Mnu: ^5'+PadLeftInt(User.UserStartMenu,30)+'^1Mnu: ^5'+IntToStr(Validation.NewMenu));
|
||||||
|
Print('^1ExD: ^5'+PadLeftStr(AOnOff((User.Expiration > 0),ToDate8(PD2Date(User.Expiration)),'Never'),30)+
|
||||||
|
'^1ExD: ^5'+AOnOff((Validation.Expiration > 0),
|
||||||
|
ToDate8(PD2Date(GetPackDateTime + (Validation.Expiration * 86400))),
|
||||||
|
'Never'));
|
||||||
|
Print('^1ExS: ^5'+PadLeftStr(AOnOff(User.ExpireTo = ' ','No Change',User.ExpireTo),30)+
|
||||||
|
'^1ExS: ^5'+AOnOff(Validation.ExpireTo = ' ','No Change',Validation.ExpireTo));
|
||||||
|
IF (NOT PYNQ('%LFContinue validating user at this level? ',0,FALSE)) THEN
|
||||||
|
Level := #0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Level IN ValKeys) OR (Level = 'Q') OR (HangUp);
|
||||||
|
IF (Level IN ValKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
AutoValidate(User,UNum,Level);
|
||||||
|
Print('%LFThis user was validated using validation level "'+Level+'".');
|
||||||
|
SendShortMessage(UNum,Validation.UserMsg);
|
||||||
|
LoadURec(User,UNum);
|
||||||
|
SysOpLog('Validated '+Caps(User.Name)+' with validation level "'+Level+'".');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE AutoValidationCmd(MenuOption: Str50);
|
||||||
|
VAR
|
||||||
|
Level: Char;
|
||||||
|
PW,
|
||||||
|
TempPW: Str20;
|
||||||
|
RecNum,
|
||||||
|
RecNum1: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (MenuOption = '') OR (Pos(';',MenuOption) = 0) OR
|
||||||
|
(Copy(MenuOption,(Pos(';',MenuOption) + 1),1) = '') OR
|
||||||
|
(Copy(MenuOption,1,(Pos(';',MenuOption) - 1)) = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Command error, operation aborted!^1');
|
||||||
|
SysOpLog('^7Auto-validation command error, invalid options!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
PW := AllCaps(Copy(MenuOption,1,(Pos(';',MenuOption) - 1)));
|
||||||
|
MenuOption := Copy(MenuOption,(Pos(';',MenuOption) + 1),1);
|
||||||
|
Level := MenuOption[1];
|
||||||
|
IF (NOT (Level IN ValKeys)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Command error, operation aborted!^1');
|
||||||
|
SysOpLog('^7Auto-validation command error, level not found: '+Level+'!');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Reset(ValidationFile);
|
||||||
|
RecNum1 := -1;
|
||||||
|
RecNum:= 1;
|
||||||
|
WHILE (RecNum <= NumValKeys) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNum - 1));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
IF (Validation.Key = Level) THEN
|
||||||
|
RecNum1 := RecNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (Validation.Expiration = 0) AND (Validation.ExpireTo <> ' ') OR
|
||||||
|
(Validation.Expiration <> 0) AND (Validation.ExpireTo = ' ') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Command error, operation aborted!^1');
|
||||||
|
SysOpLog('^7Auto-validation command error, expiration data invalid: "'+Level+'"!');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE IF (Validation.ExpireTo <> ' ') AND (NOT (Validation.ExpireTo IN ValKeys)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Command error, operation aborted!^1');
|
||||||
|
SysOpLog('^7Auto-validation command error, expire to level "'+Validation.ExpireTo+'" does not exists!');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE IF (ThisUser.SL = Validation.NewSL) AND (ThisUser.DSL = Validation.NewDSL) AND
|
||||||
|
ARMatch(Validation.SoftAR,ThisUser.AR,Validation.NewAR) AND
|
||||||
|
ACMatch(Validation.SoftAC,ThisUser.Flags,Validation.NewAC) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You have already been validated at this access level!^1');
|
||||||
|
SysOpLog('User error, previously validated at level: "'+Level+'".');
|
||||||
|
Exit;
|
||||||
|
END
|
||||||
|
ELSE IF (ThisUser.SL > Validation.NewSL) OR (ThisUser.DSL > Validation.NewDSL) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7This option would lower your access level!^1');
|
||||||
|
SysOpLog('User error, access would be lowered to level: "'+Level+'".');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
Print('%LFPress <ENTER> to abort.');
|
||||||
|
Prt('%LFPassword: ');
|
||||||
|
GetPassword(TempPW,20);
|
||||||
|
IF (TempPW = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFAborted.');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
IF (TempPW <> PW) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Incorrect password entered!^1');
|
||||||
|
SysOpLog('User error, invalid password entered: "'+TempPW+'"');
|
||||||
|
Exit;
|
||||||
|
END;
|
||||||
|
AutoValidate(ThisUser,UserNum,Level);
|
||||||
|
lStatus_Screen(100,'This user has auto-validated '
|
||||||
|
+AOnOff(ThisUser.Sex = 'M','himself','herself')+' with level: "'+Level+'".',FALSE,TempPW);
|
||||||
|
PrintF('AUTOVAL');
|
||||||
|
IF (NoFile) THEN
|
||||||
|
Print('%LF'+Validation.UserMsg);
|
||||||
|
SysOpLog('This user has auto-validated '+AOnOff(ThisUser.Sex = 'M','himself','herself')+' with level: "'+Level+'".');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ValidationEditor;
|
||||||
|
VAR
|
||||||
|
TempValidation: ValidationRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE InitValidateVars(VAR Validation: ValidationRecordType);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,0);
|
||||||
|
FillChar(Validation,SizeOf(Validation),0);
|
||||||
|
WITH Validation DO
|
||||||
|
BEGIN
|
||||||
|
Key := ' ';
|
||||||
|
ExpireTo := ' ';
|
||||||
|
Description := '<< New Validation Record >>';
|
||||||
|
UserMsg := 'You have been validated, enjoy the system!';
|
||||||
|
NewSL := User.SL;
|
||||||
|
NewDSL := User.DSL;
|
||||||
|
NewMenu := 0;
|
||||||
|
Expiration := 0;
|
||||||
|
NewFP := 0;
|
||||||
|
NewCredit := 0;
|
||||||
|
SoftAR := TRUE;
|
||||||
|
SoftAC := TRUE;
|
||||||
|
NewAR := [];
|
||||||
|
NewAC := [];
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteValidationLevel(TempValidation1: ValidationRecordType; RecNumToDelete: SmallInt);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumValKeys = 0) THEN
|
||||||
|
Messages(4,0,'validation records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := -1;
|
||||||
|
InputIntegerWOC('%LFValidation record to delete?',RecNumToDelete,[NumbersOnly],1,NumValKeys);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumValKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ValidationFile);
|
||||||
|
Seek(ValidationFile,(RecNumToDelete - 1));
|
||||||
|
Read(ValidationFile,TempValidation1);
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (TempValidation1.Key = '!') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFYou can not delete the new user validation key.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LFValidation: ^5'+TempValidation1.Description);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting validation record ...');
|
||||||
|
FOR RecNum := 1 TO (MaxUsers - 1) DO
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,RecNum);
|
||||||
|
IF (User.ExpireTo = TempValidation1.Key) THEN
|
||||||
|
BEGIN
|
||||||
|
User.ExpireTo := ' ';
|
||||||
|
User.Expiration := 0;
|
||||||
|
END;
|
||||||
|
SaveURec(User,RecNum);
|
||||||
|
END;
|
||||||
|
Exclude(ValKeys,TempValidation1.Key);
|
||||||
|
Dec(RecNumToDelete);
|
||||||
|
Reset(ValidationFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(ValidationFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(ValidationFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNum + 1));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
Seek(ValidationFile,RecNum);
|
||||||
|
Write(ValidationFile,Validation);
|
||||||
|
END;
|
||||||
|
Seek(ValidationFile,(FileSize(ValidationFile) - 1));
|
||||||
|
Truncate(ValidationFile);
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Dec(NumValKeys);
|
||||||
|
SysOpLog('* Deleted validation record: ^5'+TempValidation1.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckValidationLevel(Validation: ValidationRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Validation.Description = '') OR (Validation.Description = '<< New Validation Record >>') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The description is invalid!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditValidationLevel(TempValidation1: ValidationRecordType; VAR Validation: ValidationRecordType; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
CmdStr,
|
||||||
|
OneKCmds: AStr;
|
||||||
|
Cmd2: Char;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
Ok,
|
||||||
|
SaveUpgrade: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH Validation DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing validation record #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumValKeys))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting validation record #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumValKeys + 1));
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Key : ^5'+Key);
|
||||||
|
PrintACR('^1B. Description: ^5'+Description);
|
||||||
|
PrintACR('^1C. User msg : ^5'+AOnOff(UserMsg = '','*None*',UserMsg));
|
||||||
|
PrintACR('^1D. New SL : ^5'+IntToStr(NewSL));
|
||||||
|
PrintACR('^1E. New DSL : ^5'+IntToStr(NewDSL));
|
||||||
|
PrintACR('^1G. AR : Flags: ^5'+DisplayARFlags(NewAR,'5','1')+
|
||||||
|
' ^1Upgrade: ^5'+AOnOff(SoftAR,'Soft','Hard'));
|
||||||
|
PrintACR('^1H. AC : Flags: ^5'+DisplayACFlags(NewAC,'5','1')+
|
||||||
|
' ^1Upgrade: ^5'+AOnOff(SoftAC,'Soft','Hard'));
|
||||||
|
PrintACR('^1I. New points : ^5'+IntToStr(NewFP));
|
||||||
|
PrintACR('^1K. New credit : ^5'+IntToStr(NewCredit));
|
||||||
|
PrintACR('^1M. Start menu : ^5'+IntToStr(NewMenu));
|
||||||
|
PrintACR('^1N. Expiration : Days: ^5'+AOnOff((Expiration > 0),IntToStr(Expiration),'No Expiration')+
|
||||||
|
' ^1Level: ^5'+AOnOff((ExpireTo IN ['!'..'~']),ExpireTo,'No Change'));
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := 'ABCDEGHIKMN'
|
||||||
|
ELSE
|
||||||
|
CmdStr := 'ABCDEGHIKMN[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'A' : BEGIN
|
||||||
|
Print('%LF^7You can not modify the validation key.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
'B' : IF (Validation.Key = '!') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You can not modify the new user description.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
REPEAT
|
||||||
|
TempValidation1.Description := Description;
|
||||||
|
Ok := TRUE;
|
||||||
|
InputWN1('%LFNew description: ',Description,(SizeOf(Description) - 1),[InterActiveEdit],Changed);
|
||||||
|
CheckValidationLevel(Validation,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Description := TempValidation1.Description;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
'C' : InputWN1('%LF^1New user message:%LF^4:',UserMsg,(SizeOf(UserMsg) - 1),[InterActiveEdit],Changed);
|
||||||
|
'D' : BEGIN
|
||||||
|
LoadURec(User,0);
|
||||||
|
REPEAT
|
||||||
|
InputByteWC('%LFEnter new SL',NewSL,[DisplayValue,NumbersOnly],User.SL,255,Changed);
|
||||||
|
UNTIL (NewSL >= User.SL) OR (HangUp);
|
||||||
|
END;
|
||||||
|
'E' : BEGIN
|
||||||
|
LoadURec(User,0);
|
||||||
|
REPEAT
|
||||||
|
InputByteWC('%LFEnter new DSL',NewDSL,[DisplayValue,NumbersOnly],User.DSL,255,Changed);
|
||||||
|
UNTIL (NewDSL >= User.DSL) OR (HangUp);
|
||||||
|
END;
|
||||||
|
'G' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Prt('%LFToggle which AR flag? ('+DisplayARFlags(NewAR,'5','4')+'^4)'+
|
||||||
|
' [^5*^4=^5All^4,^5?^4=^5Help^4,^5<CR>^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd1,^M'ABCDEFGHIJKLMNOPQRSTUVWXYZ*?',TRUE,TRUE);
|
||||||
|
IF (Cmd1 = '?') THEN
|
||||||
|
PrintF('ARFLAGS')
|
||||||
|
ELSE IF (Cmd1 IN ['A'..'Z']) THEN
|
||||||
|
ToggleARFlag(Cmd1,NewAR,Changed)
|
||||||
|
ELSE IF (Cmd1 = '*') THEN
|
||||||
|
FOR Cmd2 := 'A' TO 'Z' DO
|
||||||
|
ToggleARFlag(Cmd2,NewAr,Changed);
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
SaveUpgrade := SoftAR;
|
||||||
|
SoftAR := NOT PYNQ('%LFShould the AR upgrade be hard? ',0,FALSE);
|
||||||
|
IF (SaveUpgrade <> SoftAR) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'H' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Prt('%LFToggle which AC flag? ('+DisplayACFlags(NewAC,'5','4')+'^4)'+
|
||||||
|
' [^5?^4=^5Help^4,^5<CR>^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd1,^M'LCVUA*PEKM1234?',TRUE,TRUE);
|
||||||
|
IF (Cmd1 = '?') THEN
|
||||||
|
PrintF('ACFLAGS')
|
||||||
|
ELSE IF (Cmd1 <> ^M) THEN
|
||||||
|
ToggleACFlags(Cmd1,NewAC,Changed);
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
SaveUpgrade := SoftAC;
|
||||||
|
SoftAC := NOT PYNQ('%LFShould the AC upgrade be hard? ',0,FALSE);
|
||||||
|
IF (SaveUpgrade <> SoftAC) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'I' : InputLongIntWC('%LFEnter additional file points',NewFP,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'K' : InputLongIntWC('%LFEnter additional credit',NewCredit,[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'M' : FindMenu('%LFEnter start menu (^50^4=^5Default^4)',NewMenu,0,NumMenus,Changed);
|
||||||
|
'N' : IF (Validation.Key = '!') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7You can not modify the new user expiration days or level.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
InputWordWC('%LFEnter days until expiration',Expiration,[DisplayValue,NumbersOnly],0,65535,Changed);
|
||||||
|
OneKCmds := '';
|
||||||
|
FOR Cmd2 := '!' TO '~' DO
|
||||||
|
IF (Cmd2 IN ValKeys) THEN
|
||||||
|
IF (NOT (Cmd2 = Key)) THEN
|
||||||
|
OneKCmds := OneKCmds + Cmd2;
|
||||||
|
Prt('%LFEnter expiration level (^5!^4-^5P^4,^5R^4-^5p^4,^5r^4-^5~^4) [^5<Space>^4=^5No Change^4]: ');
|
||||||
|
OneK1(Cmd1,^M' '+OneKCmds,TRUE,TRUE);
|
||||||
|
IF (Cmd1 = ' ') OR (Cmd1 IN ValKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Cmd1 <> ExpireTo) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
ExpireTo := Cmd1;
|
||||||
|
END;
|
||||||
|
IF (Expiration = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
ExpireTo := ' ';
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
IF (ExpireTo = ' ') THEN
|
||||||
|
BEGIN
|
||||||
|
Expiration := 0;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Cmd2 := #0;
|
||||||
|
END;
|
||||||
|
'[' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit < NumValKeys) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputIntegerWOC('%LFJump to entry',RecNumToEdit,[NumbersOnly],1,NumValKeys);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumValKeys) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> NumValKeys) THEN
|
||||||
|
RecNumToEdit := NumValKeys
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^3A^1-^3E^1,^3G^1-^3I^1,^3K^1,^3M^1-^3N^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertValidationLevel(TempValidation1: ValidationRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt);
|
||||||
|
VAR
|
||||||
|
OneKCmds: AStr;
|
||||||
|
RecNum,
|
||||||
|
RecNumToEdit: SmallInt;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumValKeys = MaxValKeys) THEN
|
||||||
|
Messages(5,MaxValKeys,'validation records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToInsertBefore := -1;
|
||||||
|
InputIntegerWOC('%LFValidation record to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumValKeys + 1));
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumValKeys + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
OneKCmds := '';
|
||||||
|
FOR Cmd1 := '!' TO '~' DO
|
||||||
|
IF (NOT (Cmd1 IN ValKeys)) AND (NOT (Cmd1 = 'Q')) AND (NOT (Cmd1 = 'q')) THEN
|
||||||
|
OneKCmds := OneKCmds + Cmd1;
|
||||||
|
Prt('%LFChoose validation key (^5!^4-^5P^4,^5R^4-^5p^4,^5r^4-^5~^4) [^5<CR>^4=^5Quit^4]: ');
|
||||||
|
OneK1(Cmd1,^M+OneKCmds,TRUE,TRUE);
|
||||||
|
IF (Cmd1 <> ^M) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(ValidationFile);
|
||||||
|
InitValidateVars(TempValidation1);
|
||||||
|
TempValidation1.Key := Cmd1;
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE IF (RecNumToInsertBefore = (NumValKeys + 1)) THEN
|
||||||
|
RecNumToEdit := (NumValKeys + 1)
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditValidationLevel(TempValidation1,TempValidation1,Cmd1,RecNumToEdit,Changed,FALSE);
|
||||||
|
CheckValidationLevel(TempValidation1,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting validation record? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Include(ValKeys,Cmd1);
|
||||||
|
Print('%LF[> Inserting validation record ...');
|
||||||
|
Seek(ValidationFile,FileSize(ValidationFile));
|
||||||
|
Write(ValidationFile,Validation);
|
||||||
|
Dec(RecNumToInsertBefore);
|
||||||
|
FOR RecNum := ((FileSize(ValidationFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,RecNum);
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
Seek(ValidationFile,(RecNum + 1));
|
||||||
|
Write(ValidationFile,Validation);
|
||||||
|
END;
|
||||||
|
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,RecNum);
|
||||||
|
Write(ValidationFile,TempValidation1);
|
||||||
|
Inc(NumValKeys);
|
||||||
|
SysOpLog('* Inserted validation record: ^5'+TempValidation1.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyValidationLevel(TempValidation1: ValidationRecordType; Cmd1: Char; RecNumToEdit: SmallInt);
|
||||||
|
VAR
|
||||||
|
SaveRecNumToEdit: Integer;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumValKeys = 0) THEN
|
||||||
|
Messages(4,0,'validation records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := -1;
|
||||||
|
InputIntegerWOC('%LFValidation record to modify?',RecNumToEdit,[NumbersOnly],1,NumValKeys);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumValKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := -1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(ValidationFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNumToEdit - 1));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditValidationLevel(TempValidation1,Validation,Cmd1,RecNumToEdit,Changed,TRUE);
|
||||||
|
CheckValidationLevel(Validation,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (OK) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(SaveRecNumToEdit - 1));
|
||||||
|
Write(ValidationFile,Validation);
|
||||||
|
Changed := FALSE;
|
||||||
|
SysOpLog('* Modified validation record: ^5'+Validation.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PositionValidationLevel(TempValidation1: ValidationRecordType; RecNumToPosition: SmallInt);
|
||||||
|
VAR
|
||||||
|
RecNumToPositionBefore,
|
||||||
|
RecNum1,
|
||||||
|
RecNum2: SmallInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumValKeys = 0) THEN
|
||||||
|
Messages(4,0,'validation records')
|
||||||
|
ELSE IF (NumValKeys = 1) THEN
|
||||||
|
Messages(6,0,'validation records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToPosition := -1;
|
||||||
|
InputIntegerWOC('%LFPosition which validation record?',RecNumToPosition,[NumbersOnly],1,NumValKeys);
|
||||||
|
IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumValKeys) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFAccording to the current numbering system.');
|
||||||
|
RecNumToPositionBefore := -1;
|
||||||
|
InputIntegerWOC('%LFPosition before which validation record?',RecNumToPositionBefore,[NumbersOnly],1,(NumValKeys + 1));
|
||||||
|
IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumValKeys + 1)) AND
|
||||||
|
(RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Positioning validation records ...');
|
||||||
|
Reset(ValidationFile);
|
||||||
|
IF (RecNumToPositionBefore > RecNumToPosition) THEN
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Dec(RecNumToPosition);
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Seek(ValidationFile,RecNumToPosition);
|
||||||
|
Read(ValidationFile,TempValidation1);
|
||||||
|
RecNum1 := RecNumToPosition;
|
||||||
|
IF (RecNumToPosition > RecNumToPositionBefore) THEN
|
||||||
|
RecNum2 := -1
|
||||||
|
ELSE
|
||||||
|
RecNum2 := 1;
|
||||||
|
WHILE (RecNum1 <> RecNumToPositionBefore) DO
|
||||||
|
BEGIN
|
||||||
|
IF ((RecNum1 + RecNum2) < FileSize(ValidationFile)) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(ValidationFile,(RecNum1 + RecNum2));
|
||||||
|
Read(ValidationFile,Validation);
|
||||||
|
Seek(ValidationFile,RecNum1);
|
||||||
|
Write(ValidationFile,Validation);
|
||||||
|
END;
|
||||||
|
Inc(RecNum1,RecNum2);
|
||||||
|
END;
|
||||||
|
Seek(ValidationFile,RecNumToPositionBefore);
|
||||||
|
Write(ValidationFile,TempValidation1);
|
||||||
|
Close(ValidationFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
RecNumToList := 1;
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
DisplayValidationRecords(RecNumToList);
|
||||||
|
LOneK('%LFValidation editor [^5?^4=^5Help^4]: ',Cmd,'QDIMP?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
^M : IF (RecNumToList < 1) OR (RecNumToList > NumValKeys) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
'D' : DeleteValidationLevel(TempValidation,RecNumToList);
|
||||||
|
'I' : InsertValidationLevel(TempValidation,Cmd,RecNumToList);
|
||||||
|
'M' : ModifyValidationLevel(TempValidation,Cmd,RecNumToList);
|
||||||
|
'P' : PositionValidationLevel(TempValidation,RecNumToList);
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay screen');
|
||||||
|
Print('^1(^3?^1)Help/First validation level');
|
||||||
|
LCmds(24,3,'Delete validation level','Insert validation level');
|
||||||
|
LCmds(24,3,'Modify validation level','Position validation level');
|
||||||
|
LCmds(24,3,'Quit','');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Cmd <> ^M) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,135 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2H;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE NetworkConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
NodeList;
|
||||||
|
|
||||||
|
PROCEDURE NetworkConfiguration;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5Network Configuration:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Net addresses');
|
||||||
|
PrintACR('^1B. Origin line : ^5'+Origin);
|
||||||
|
NL;
|
||||||
|
PrintACR('^1C. Strip IFNA kludge lines : ^5'+ShowYesNo(SKludge)+
|
||||||
|
'^1 1. Color of standard text : ^'+IntToStr(Text_Color)+IntToStr(Text_Color));
|
||||||
|
PrintACR('^1D. Strip SEEN-BY lines : ^5'+ShowYesNo(SSeenBy)+
|
||||||
|
'^1 2. Color of quoted text : ^'+IntToStr(Quote_Color)+IntToStr(Quote_Color));
|
||||||
|
PrintACR('^1E. Strip origin lines : ^5'+ShowYesNo(SOrigin)+
|
||||||
|
'^1 3. Color of tear line : ^'+IntToStr(Tear_Color)+IntToStr(Tear_Color));
|
||||||
|
PrintACR('^1F. Add tear/origin line : ^5'+ShowYesNo(AddTear)+
|
||||||
|
'^1 4. Color of origin line : ^'+IntToStr(Origin_Color)+IntToStr(Origin_Color));
|
||||||
|
NL;
|
||||||
|
PrintACR('^1G. Default Echomail path : ^5'+DefEchoPath);
|
||||||
|
PrintACR('^1H. Netmail path : ^5'+NetMailPath);
|
||||||
|
PrintACR('^1I. Netmail attributes : ^5'+NetMail_Attr(NetAttribute));
|
||||||
|
PrintACR('^1J. UUCP gate address : ^5'+PadLeftStr('^5'+IntToStr(AKA[20].Zone)+':'+IntToStr(AKA[20].Net)+
|
||||||
|
'/'+IntToStr(AKA[20].Node)+'.'+IntToStr(AKA[20].Point),20));
|
||||||
|
Prt('%LFEnter selection [^5A^4-^5J^4,^51^4-^54^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHIJ1234'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5Network Addresses:^1');
|
||||||
|
NL;
|
||||||
|
FOR Counter := 0 TO 19 DO
|
||||||
|
BEGIN
|
||||||
|
Prompt('^1'+Chr(Counter + 65)+'. Address #'+PadLeftInt(Counter,2)+' : '+
|
||||||
|
PadLeftStr('^5'+IntToStr(AKA[Counter].Zone)+
|
||||||
|
':'+IntToStr(AKA[Counter].Net)+
|
||||||
|
'/'+IntToStr(AKA[Counter].Node)+
|
||||||
|
'.'+IntToStr(AKA[Counter].Point),20));
|
||||||
|
IF (Odd(Counter)) THEN
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
LOneK('%LFEnter selection [^5A^4-^5T^4,^5<CR>^4=^5Quit^4]: ',Cmd,^M'ABCDEFGHIJKLMNOPQRST',TRUE,TRUE);
|
||||||
|
IF (Cmd IN ['A'..'T']) THEN
|
||||||
|
GetNewAddr('%LFEnter new network address (^5Z^4:^5N^4/^5N^4.^5P^4 format): ',30,
|
||||||
|
AKA[(Ord(Cmd) - 65)].Zone,
|
||||||
|
AKA[(Ord(Cmd) - 65)].Net,
|
||||||
|
AKA[(Ord(Cmd) - 65)].Node,
|
||||||
|
AKA[(Ord(Cmd) - 65)].Point);
|
||||||
|
UNTIL (Cmd = ^M) OR (HangUp);
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'B' : InputWN1('%LF^1Enter new origin line:%LF^4: ',Origin,50,[],Changed);
|
||||||
|
'C' : SKludge := NOT SKludge;
|
||||||
|
'D' : SSeenBy := NOT SSeenBy;
|
||||||
|
'E' : SOrigin := NOT SOrigin;
|
||||||
|
'F' : AddTear := NOT AddTear;
|
||||||
|
'G' : InputPath('%LF^1Enter new default echomail path (^5End with a ^1"^5\^1"):%LF^4:',DefEchoPath,TRUE,FALSE,Changed);
|
||||||
|
'H' : InputPath('%LF^1Enter new netmail path (^5End with a ^1"^5\^1"):%LF^4:',NetMailPath,TRUE,FALSE,Changed);
|
||||||
|
'I' : BEGIN
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
Print('%LF^1Netmail attributes: ^5'+NetMail_Attr(NetAttribute)+'^1');
|
||||||
|
LOneK('%LFToggle attributes (CHIKLP) [?]Help [Q]uit: ',Cmd,'QPCKHIL?',TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'C','H','I','K','L','P' :
|
||||||
|
ToggleNetAttrS(Cmd,NetAttribute);
|
||||||
|
'?' : BEGIN
|
||||||
|
NL;
|
||||||
|
LCmds(22,3,'Crash mail','Hold');
|
||||||
|
LCmds(22,3,'In-Transit','Kill-Sent');
|
||||||
|
LCmds(22,3,'Local','Private');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
|
||||||
|
Cmd := #0;
|
||||||
|
END;
|
||||||
|
'J' : GetNewAddr('%LFEnter new UUCP Gate Address (^5Z^4:^5N^4/^5N^4.^5P^4 format): ',30,
|
||||||
|
AKA[20].Zone,
|
||||||
|
AKA[20].Net,
|
||||||
|
AKA[20].Node,
|
||||||
|
AKA[20].Point);
|
||||||
|
'1' : BEGIN
|
||||||
|
Prompt('%LF^5Colors: ');
|
||||||
|
ShowColors;
|
||||||
|
InputByteWC('%LFNew standard text color',Text_Color,[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
END;
|
||||||
|
'2' : BEGIN
|
||||||
|
Prompt('%LF^5Colors: ');
|
||||||
|
ShowColors;
|
||||||
|
InputByteWC('%LFNew quoted text color',Quote_Color,[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
END;
|
||||||
|
'3' : BEGIN
|
||||||
|
Prompt('%LF^5Colors: ');
|
||||||
|
ShowColors;
|
||||||
|
InputByteWC('%LFNew tear line color',Tear_Color,[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
END;
|
||||||
|
'4' : BEGIN
|
||||||
|
Prompt('%LF^5Colors: ');
|
||||||
|
ShowColors;
|
||||||
|
InputByteWC('%LFNew origin line color',Origin_Color,[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,61 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2I;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE OfflineMailConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE OfflineMailConfiguration;
|
||||||
|
VAR
|
||||||
|
Cmd: CHAR;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Print('%CL^5Offline Mail Configuration:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. QWK/REP Packet name : ^5'+PacketName);
|
||||||
|
PrintACR('^1B. Welcome screen name : ^5'+QWKWelcome);
|
||||||
|
PrintACR('^1C. News file name : ^5'+QWKNews);
|
||||||
|
PrintACR('^1D. Goodbye file name : ^5'+QWKGoodbye);
|
||||||
|
PrintACR('^1E. Local QWK/REP path : ^5'+QWKLocalPath);
|
||||||
|
PrintACR('^1F. Ignore time for DL : ^5'+ShowOnOff(QWKTimeIgnore));
|
||||||
|
PrintACR('^1G. Max total messages : ^5'+IntToStr(MaxQWKTotal));
|
||||||
|
PrintACR('^1H. Max msgs per base : ^5'+IntToStr(MaxQWKBase));
|
||||||
|
PrintACR('^1I. ACS for Network .REP: ^5'+QWKNetworkACS);
|
||||||
|
Prt('%LFEnter selection [^5A^4-^5I^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHI'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : InputWN1('%LFQWK Packet name: ',PacketName,(SizeOf(PacketName) - 1),[InterActiveEdit],Changed);
|
||||||
|
'B' : InputWN1('%LF^1Welcome screen file d:\path\name (^5Do not enter ^1"^5.EXT^1"):%LF^4: ',
|
||||||
|
QWKWelcome,(SizeOf(QWKWelcome) - 1),
|
||||||
|
[UpperOnly,InterActiveEdit],Changed);
|
||||||
|
'C' : InputWN1('%LF^1News file d:\path\name (^5Do not enter ^1"^5.EXT^1"):%LF^4: ',QWKNews,(SizeOf(QWKNews) - 1),
|
||||||
|
[UpperOnly,InterActiveEdit],Changed);
|
||||||
|
'D' : InputWN1('%LF^1Goodbye file d:\path\name (^5Do not enter ^1"^5.EXT^1"):%LF^4: ',
|
||||||
|
QWKGoodbye,(SizeOf(QWKGoodBye) - 1),
|
||||||
|
[UpperOnly,InterActiveEdit],Changed);
|
||||||
|
'E' : InputPath('%LF^1Enter local QWK reader path (^5End with a ^1"^5\^1"):%LF^4:',QWKLocalPath,TRUE,FALSE,Changed);
|
||||||
|
'F' : QWKTimeIgnore := NOT QWKTimeIgnore;
|
||||||
|
'G' : InputWordWOC('%LFMaximum total messages in a QWK packet',MaxQWKTotal,[DisplayValue,NumbersOnly],0,65535);
|
||||||
|
'H' : InputWordWOC('%LFMaximum messages per base in a packet',MaxQWKBase,[DisplayValue,NumbersOnly],0,65535);
|
||||||
|
'I' : InputWN1('%LFNew ACS: ',QWKNetworkACS,(SizeOf(QWKNetworkACS) - 1),[InterActiveEdit],Changed);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,823 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2J;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE ColorConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
File11,
|
||||||
|
File1,
|
||||||
|
Mail4,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE ColorConfiguration;
|
||||||
|
CONST
|
||||||
|
ColorName: ARRAY[0..7] OF STRING[7] = ('Black','Blue','Green','Cyan','Red','Magenta','Yellow','White');
|
||||||
|
VAR
|
||||||
|
TempScheme: SchemeRec;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
FUNCTION DisplayColorStr(Color: Byte): AStr;
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
BEGIN
|
||||||
|
TempStr := ColorName[Color AND 7]+' on '+ColorName[(Color SHR 4) AND 7];
|
||||||
|
IF ((Color AND 8) <> 0) THEN
|
||||||
|
TempStr := 'Bright '+TempStr;
|
||||||
|
IF ((Color AND 128) <> 0) THEN
|
||||||
|
TempStr := 'Blinking '+TempStr;
|
||||||
|
DisplayColorStr := TempStr;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION GetColor: Byte;
|
||||||
|
VAR
|
||||||
|
NewColor,
|
||||||
|
SaveOldColor,
|
||||||
|
TempColor,
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
SetC(7);
|
||||||
|
NL;
|
||||||
|
FOR Counter := 0 TO 7 DO
|
||||||
|
BEGIN
|
||||||
|
SetC(7);
|
||||||
|
Prompt(IntToStr(Counter)+'. ');
|
||||||
|
SetC(Counter);
|
||||||
|
Prompt(PadLeftStr(ColorName[Counter],12));
|
||||||
|
SetC(7);
|
||||||
|
Prompt(PadRightInt((Counter + 8),2)+'. ');
|
||||||
|
SetC(Counter + 8);
|
||||||
|
Print(PadLeftStr(ColorName[Counter]+'!',9));
|
||||||
|
END;
|
||||||
|
InputByteWOC('%LFForeground',TempColor,[Numbersonly],0,15); (* Suppress Error *)
|
||||||
|
IF (TempColor IN [0..15]) THEN
|
||||||
|
NewColor := TempColor
|
||||||
|
ELSE
|
||||||
|
NewColor := 7;
|
||||||
|
NL;
|
||||||
|
FOR Counter := 0 TO 7 DO
|
||||||
|
BEGIN
|
||||||
|
SetC(7);
|
||||||
|
Prompt(IntToStr(Counter)+'. ');
|
||||||
|
SetC(Counter);
|
||||||
|
Print(PadLeftStr(ColorName[Counter],12));
|
||||||
|
END;
|
||||||
|
InputByteWOC('%LFBackground',TempColor,[NumbersOnly],0,7); (* Suppress Error *)
|
||||||
|
IF (TempColor IN [0..7]) THEN
|
||||||
|
NewColor := NewColor OR TempColor SHL 4;
|
||||||
|
IF PYNQ('%LFBlinking? ',0,FALSE) THEN
|
||||||
|
NewColor := NewColor OR 128;
|
||||||
|
SetC(7);
|
||||||
|
Prompt('%LFExample: ');
|
||||||
|
SetC(NewColor);
|
||||||
|
Print(DisplayColorStr(NewColor));
|
||||||
|
SetC(7);
|
||||||
|
GetColor := NewColor;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE SystemColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter,
|
||||||
|
NewColor: Byte;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
CLS;
|
||||||
|
NL;
|
||||||
|
FOR Counter := 1 TO 10 DO
|
||||||
|
BEGIN
|
||||||
|
SetC(7);
|
||||||
|
Prompt(PadRightInt((Counter - 1),2)+'. System color '+PadRightInt((Counter - 1),2)+': ');
|
||||||
|
SetC(TempScheme1.Color[Counter]);
|
||||||
|
Print(DisplayColorStr(Scheme.Color[Counter]));
|
||||||
|
END;
|
||||||
|
LOneK('%LFSystem color to change [^50^4-^59^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'0123456789',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['0'..'9']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) - Ord('0') + 1] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FileColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
F: FileInfoRecordType;
|
||||||
|
NewColor: Byte;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
FileAreaNameDisplayed := FALSE;
|
||||||
|
DisplayFileAreaHeader;
|
||||||
|
WITH F DO
|
||||||
|
BEGIN
|
||||||
|
FileName := 'RENEGADE.ZIP';
|
||||||
|
Description := 'Latest version of Renegade!';
|
||||||
|
FilePoints := 0;
|
||||||
|
Downloaded := 0;
|
||||||
|
FileSize := 2743;
|
||||||
|
OwnerNum := 1;
|
||||||
|
OwnerName:= 'Exodus';
|
||||||
|
FileDate := Date2Pd(DateStr);
|
||||||
|
VPointer := -1;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [];
|
||||||
|
END;
|
||||||
|
lDisplay_File(F,1,'',FALSE);
|
||||||
|
PrintACR(PadLeftStr('',28)+'This is the latest version available');
|
||||||
|
PrintACR(PadLeftStr('',28)+'Uploaded by: Exodus');
|
||||||
|
WITH F DO
|
||||||
|
BEGIN
|
||||||
|
FileName := 'RG .ZIP';
|
||||||
|
Description := 'Latest Renegade upgrade.';
|
||||||
|
FilePoints := 0;
|
||||||
|
Downloaded := 0;
|
||||||
|
FileSize := 2158;
|
||||||
|
OwnerNum := 2;
|
||||||
|
OwnerName := 'Nuclear';
|
||||||
|
FileDate := Date2PD(DateStr);
|
||||||
|
VPointer := -1;
|
||||||
|
VTextSize := 0;
|
||||||
|
FIFlags := [];
|
||||||
|
END;
|
||||||
|
lDisplay_File(F,2,'RENEGADE',FALSE);
|
||||||
|
PrintACR(PadLeftStr('',28)+'This is the latest upgrade available');
|
||||||
|
PrintACR(PadLeftStr('',28)+'Uploaded by: Nuclear');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'A Border','B File Name field','C Pts Field');
|
||||||
|
LCmds3(20,3,'D Size field','E Desc Field','F Area field');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'G File name','H File Points','I File size');
|
||||||
|
LCmds3(20,3,'J File desc','K Extended','L Status flags');
|
||||||
|
LCmds(20,3,'M Uploader','N Search Match');
|
||||||
|
LOneK('%LFFile color to change [^5A^4-^5N^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKLMN',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['A'..'N']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) - 54] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MsgColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
NewColor: Byte;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS; { starts at color 28 }
|
||||||
|
PrintACR(' ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄ¿');
|
||||||
|
PrintACR(' ³ Msg# ³ Sender ³ Receiver ³ '+
|
||||||
|
'Subject ³! Posted ³');
|
||||||
|
PrintACR(' ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÙ');
|
||||||
|
PrintACR('''* "2# Exodus $Nuclear %Re: Renegade &01/01/93');
|
||||||
|
PrintACR('''> "3# Nuclear $Exodus %RG Update &01/01/93');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'A Border','B Msg Num field','C Sender Field');
|
||||||
|
LCmds3(20,3,'D Receiver field','E Subject Field','F Date field');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'G Msg Num','H Msg Sender','I Msg Receiver');
|
||||||
|
LCmds3(20,3,'J Subject','K Msg Date','L Status flags');
|
||||||
|
LOneK('%LFMessage color to change [^5A^4-^5L^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKL',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['A'..'L']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) - 37] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FileAreaColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
NewColor: Byte;
|
||||||
|
FArea,
|
||||||
|
NumFAreas: Integer;
|
||||||
|
SaveConfSystem: Boolean;
|
||||||
|
BEGIN
|
||||||
|
SaveConfSystem := ConfSystem;
|
||||||
|
ConfSystem := FALSE;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Farea := 1;
|
||||||
|
NumFAreas := 0;
|
||||||
|
LFileAreaList(FArea,NumFAreas,10,TRUE); { starts at 45 }
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'A Border','B Base Num field','C Base Name Field');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'D Scan Indicator','E Base Number','F Base Name');
|
||||||
|
LOneK('%LFFile area color to change [^5A^4-^5F^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEF',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['A'..'F']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) - 20] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
ConfSystem := SaveConfSystem;
|
||||||
|
IF (SaveConfSystem) THEN
|
||||||
|
NewCompTables;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MsgAreaColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
NewColor: Byte;
|
||||||
|
MArea,
|
||||||
|
NumMAreas: Integer;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
MArea := 1;
|
||||||
|
NumMAreas := 0;
|
||||||
|
MessageAreaList(MArea,NumMAreas,5,TRUE); { starts at 55 }
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'A Border','B Base Num field','C Base Name Field');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'D Scan Indicator','E Base Number','F Base Name');
|
||||||
|
LOneK('%LFMessage area color to change [^5A^4-^5F^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEF',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['A'..'F']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) - 10] := NewColor;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE QWKColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
NewColor: Byte;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS; { starts at 115 }
|
||||||
|
Print(Centre('|The QWKÿSystem is now gathering mail.'));
|
||||||
|
NL;
|
||||||
|
PrintACR('sÚÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄ¿');
|
||||||
|
PrintACR('s³t Num s³u Message base name s³v Short s³w Echo s³x Total '+
|
||||||
|
's³y New s³z Your s³{ Size s³');
|
||||||
|
PrintACR('sÀÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÙ');
|
||||||
|
PrintACR(' }1 ~General GENERAL €No <13>530 ‚328 ƒ13 „103k');
|
||||||
|
PrintACR(' }2 ~Not so general NSGEN €No <13>854 ‚ 86 ƒ15 „43k');
|
||||||
|
PrintACR(' }3 ~Vague VAGUE €No <13>985 ‚148 ƒ8 „74k');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'A Border','B Base num field','C Base name field');
|
||||||
|
LCmds3(20,3,'D Short field','E Echo field','F Total field');
|
||||||
|
LCmds3(20,3,'G New field','H Your field','I Size field');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'J Title','K Base Number','L Base name');
|
||||||
|
LCmds3(20,3,'M Short','N Echo flag','O Total Msgs');
|
||||||
|
LCmds3(20,3,'P New Msgs','R Your Msgs','S Msgs size');
|
||||||
|
LOneK('%LFQWK color to change [^5A^4-^5S^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKLMNOPRS'^M,TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['A'..'P','R'..'S']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
IF (Cmd1 < 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) + 50] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) + 49] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EmailColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
NewColor: Byte;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS; { starts at 135 }
|
||||||
|
PrintACR('‡ÚÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
|
||||||
|
PrintACR('‡³ˆ Num ‡³‰ Date/Time ‡³Š Sender ‡³‹ Subject ‡³');
|
||||||
|
PrintACR('‡ÀÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
|
||||||
|
PrintACR(' Œ1 <13>01 Jan 1993 01:00a ŽExodus <13>Renegade');
|
||||||
|
PrintACR(' Œ1 <13>01 Jan 1993 01:00a ŽNuclear <13>Upgrades');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'A Border','B Number field','C Date/Time field');
|
||||||
|
LCmds(20,3,'D Sender field','E Subject field');
|
||||||
|
NL;
|
||||||
|
LCmds3(20,3,'F Number','G Date/Time','H Sender');
|
||||||
|
LCmds(20,3,'I Subject','');
|
||||||
|
LOneK('%LFEmail color to change [^5A^4-^5I^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'QABCDEFGHI',TRUE,TRUE);
|
||||||
|
IF (Cmd1 IN ['A'..'I']) THEN
|
||||||
|
BEGIN
|
||||||
|
NewColor := GetColor;
|
||||||
|
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TempScheme1.Color[Ord(Cmd1) + 70] := NewColor;
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitSchemeVars(VAR Scheme: SchemeRec);
|
||||||
|
BEGIN
|
||||||
|
WITH Scheme DO
|
||||||
|
BEGIN
|
||||||
|
Description := '<< New Color Scheme >>';
|
||||||
|
FillChar(Color,SizeOf(Color),7);
|
||||||
|
Color[1] := 15;
|
||||||
|
Color[2] := 3;
|
||||||
|
Color[3] := 13;
|
||||||
|
Color[4] := 11;
|
||||||
|
Color[5] := 9;
|
||||||
|
Color[6] := 14;
|
||||||
|
Color[7] := 31;
|
||||||
|
Color[8] := 4;
|
||||||
|
Color[9] := 132;
|
||||||
|
Color[10] := 10;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteScheme(TempScheme1: SchemeRec; RecNumToDelete: SmallInt);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumSchemes = 0) THEN
|
||||||
|
Messages(4,0,'color schemes')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := -1;
|
||||||
|
InputIntegerWOC('%LFColor scheme to delete',RecNumToDelete,[NumbersOnly],1,NumSchemes);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumSchemes) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(SchemeFile);
|
||||||
|
Seek(SchemeFile,(RecNumToDelete - 1));
|
||||||
|
Read(SchemeFile,TempScheme1);
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Print('%LFColor scheme: ^5'+TempScheme1.Description);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting color scheme record ...');
|
||||||
|
Dec(RecNumToDelete);
|
||||||
|
Reset(SchemeFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(SchemeFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(SchemeFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,(RecNum + 1));
|
||||||
|
Read(SchemeFile,Scheme);
|
||||||
|
Seek(SchemeFile,RecNum);
|
||||||
|
Write(SchemeFile,Scheme);
|
||||||
|
END;
|
||||||
|
Seek(SchemeFile,(FileSize(SchemeFile) - 1));
|
||||||
|
Truncate(SchemeFile);
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Dec(NumSchemes);
|
||||||
|
SysOpLog('* Deleted color scheme: ^5'+TempScheme1.Description);
|
||||||
|
Inc(RecNumToDelete);
|
||||||
|
Print('%LFUpdating user records ...');
|
||||||
|
Reset(UserFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum < FileSize(UserFile)) DO
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,RecNum);
|
||||||
|
IF (User.ColorScheme = RecNumToDelete) THEN
|
||||||
|
BEGIN
|
||||||
|
User.ColorScheme := 1;
|
||||||
|
SaveURec(User,RecNum);
|
||||||
|
END
|
||||||
|
ELSE IF (User.ColorScheme > RecNumTodelete) THEN
|
||||||
|
BEGIN
|
||||||
|
Dec(User.ColorScheme);
|
||||||
|
SaveURec(User,RecNum);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckScheme(Scheme: SchemeRec; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Scheme.Description = '') OR (Scheme.Description = '<< New Color Scheme >>') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The description is invalid!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditScheme(TempScheme1: SchemeRec; VAR Scheme: SchemeRec; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
CmdStr: AStr;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH Scheme DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing color scheme #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumSchemes))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting color scheme #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumSchemes + 1));
|
||||||
|
NL;
|
||||||
|
PrintACR('^11. Description : ^5'+Scheme.Description);
|
||||||
|
Prompt('^12. System colors : ');
|
||||||
|
ShowColors;
|
||||||
|
PrintACR('^13. File listings');
|
||||||
|
PrintACR('^14. Message listings');
|
||||||
|
PrintACR('^15. File area listings');
|
||||||
|
PrintACR('^16. Message area listings');
|
||||||
|
PrintACR('^17. Offline mail screen');
|
||||||
|
PrintACR('^18. Private mail listing');
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := '12345678'
|
||||||
|
ELSE
|
||||||
|
CmdStr := '12345678[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr++^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'1' : REPEAT
|
||||||
|
TempScheme1.Description := Description;
|
||||||
|
Ok := TRUE;
|
||||||
|
InputWN1('%LFNew description: ',Description,(SizeOf(Description) - 1),[InterActiveEdit],Changed);
|
||||||
|
CheckScheme(Scheme,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Description := TempScheme1.Description;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
'2' : SystemColors(Scheme,Cmd1,Changed);
|
||||||
|
'3' : FileColors(Scheme,Cmd1,Changed);
|
||||||
|
'4' : MsgColors(Scheme,Cmd1,Changed);
|
||||||
|
'5' : FileAreaColors(Scheme,Cmd1,Changed);
|
||||||
|
'6' : MsgAreaColors(Scheme,Cmd1,Changed);
|
||||||
|
'7' : QWKColors(Scheme,Cmd1,Changed);
|
||||||
|
'8' : EmailColors(Scheme,Cmd1,Changed);
|
||||||
|
'[' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit < NumSchemes) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputIntegerWOC('%LFJump to entry?',RecNumToEdit,[NumbersOnly],1,NumSchemes);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumSchemes) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> NumSchemes) THEN
|
||||||
|
RecNumToEdit := NumSchemes
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^31^1-^38^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToInsertBefore: SmallInt);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNum,
|
||||||
|
RecNumToEdit: SmallInt;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumSchemes = MaxSchemes) THEN
|
||||||
|
Messages(5,MaxSchemes,'color schemes')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToInsertBefore := -1;
|
||||||
|
InputIntegerWOC('%LFColor scheme to insert before',RecNumToInsertBefore,[NumbersOnly],1,(NumSchemes + 1));
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumSchemes + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(SchemeFile);
|
||||||
|
InitSchemeVars(TempScheme1);
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE IF (RecNumToInsertBefore = (NumSchemes + 1)) THEN
|
||||||
|
RecNumToEdit := (NumSchemes + 1)
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditScheme(TempScheme1,TempScheme1,Cmd1,RecNumToEdit,Changed,FALSE);
|
||||||
|
CheckScheme(TempScheme1,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting color scheme? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting color scheme record ...');
|
||||||
|
Seek(SchemeFile,FileSize(SchemeFile));
|
||||||
|
Write(SchemeFile,Scheme);
|
||||||
|
Dec(RecNumToInsertBefore);
|
||||||
|
FOR RecNum := ((FileSize(SchemeFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,RecNum);
|
||||||
|
Read(SchemeFile,Scheme);
|
||||||
|
Seek(SchemeFile,(RecNum + 1));
|
||||||
|
Write(SchemeFile,Scheme);
|
||||||
|
END;
|
||||||
|
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,RecNum);
|
||||||
|
Write(SchemeFile,TempScheme1);
|
||||||
|
Inc(NumSchemes);
|
||||||
|
SysOpLog('* Inserted color scheme: ^5'+TempScheme1.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Inc(RecNumToInsertBefore);
|
||||||
|
Print('%LFUpdating user records ...');
|
||||||
|
Reset(UserFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum < FileSize(UserFile)) DO
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,RecNum);
|
||||||
|
IF (User.ColorScheme >= RecNumToInsertBefore) THEN
|
||||||
|
BEGIN
|
||||||
|
Inc(User.ColorScheme);
|
||||||
|
SaveURec(User,RecNum);
|
||||||
|
END;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToEdit: SmallInt);
|
||||||
|
VAR
|
||||||
|
SaveRecNumToEdit: Integer;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumSchemes = 0) THEN
|
||||||
|
Messages(4,0,'color schemes')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := -1;
|
||||||
|
InputIntegerWOC('%LFColor scheme to modify',RecNumToEdit,[NumbersOnly],1,NumSchemes);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumSchemes) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := -1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(SchemeFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,(RecNumToEdit - 1));
|
||||||
|
Read(SchemeFile,Scheme);
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditScheme(TempScheme1,Scheme,Cmd1,RecNumToEdit,Changed,TRUE);
|
||||||
|
CheckScheme(Scheme,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,(SaveRecNumToEdit - 1));
|
||||||
|
Write(SchemeFile,Scheme);
|
||||||
|
SysOpLog('* Modified color scheme: ^5'+Scheme.Description);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PositionScheme(TempScheme1: SchemeRec);
|
||||||
|
VAR
|
||||||
|
User: UserRecordType;
|
||||||
|
RecNumToPosition,
|
||||||
|
RecNumToPositionBefore,
|
||||||
|
RecNum1,
|
||||||
|
RecNum2: SmallInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumSchemes = 0) THEN
|
||||||
|
Messages(4,0,'color schemes')
|
||||||
|
ELSE IF (NumSchemes = 1) THEN
|
||||||
|
Messages(6,0,'color schemes')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToPosition := -1;
|
||||||
|
InputIntegerWOC('%LFPosition which color scheme',RecNumToPosition,[NumbersOnly],1,NumSchemes);
|
||||||
|
IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumSchemes) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFAccording to the current numbering system.');
|
||||||
|
RecNumToPositionBefore := -1;
|
||||||
|
InputIntegerWOC('%LFPosition before which color scheme',RecNumToPositionBefore,[NumbersOnly],1,(NumSchemes + 1));
|
||||||
|
IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumSchemes + 1)) AND
|
||||||
|
(RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Positioning color scheme record ...');
|
||||||
|
Reset(SchemeFile);
|
||||||
|
IF (RecNumToPositionBefore > RecNumToPosition) THEN
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Dec(RecNumToPosition);
|
||||||
|
Dec(RecNumToPositionBefore);
|
||||||
|
Seek(SchemeFile,RecNumToPosition);
|
||||||
|
Read(SchemeFile,TempScheme1);
|
||||||
|
RecNum1 := RecNumToPosition;
|
||||||
|
IF (RecNumToPosition > RecNumToPositionBefore) THEN
|
||||||
|
RecNum2 := -1
|
||||||
|
ELSE
|
||||||
|
RecNum2 := 1;
|
||||||
|
WHILE (RecNum1 <> RecNumToPositionBefore) DO
|
||||||
|
BEGIN
|
||||||
|
IF ((RecNum1 + RecNum2) < FileSize(SchemeFile)) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,(RecNum1 + RecNum2));
|
||||||
|
Read(SchemeFile,Scheme);
|
||||||
|
Seek(SchemeFile,RecNum1);
|
||||||
|
Write(SchemeFile,Scheme);
|
||||||
|
END;
|
||||||
|
Inc(RecNum1,RecNum2);
|
||||||
|
END;
|
||||||
|
Seek(SchemeFile,RecNumToPositionBefore);
|
||||||
|
Write(SchemeFile,TempScheme1);
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Inc(RecNumToPosition);
|
||||||
|
Inc(RecNumToPositionBefore);
|
||||||
|
Print('%LFUpdating user records ...');
|
||||||
|
Reset(UserFile);
|
||||||
|
RecNum1 := 1;
|
||||||
|
WHILE (RecNum1 < FileSize(UserFile)) DO
|
||||||
|
BEGIN
|
||||||
|
LoadURec(User,RecNum1);
|
||||||
|
IF (User.ColorScheme = RecNumToPosition) THEN
|
||||||
|
BEGIN
|
||||||
|
User.ColorScheme := RecNumToPositionBefore;
|
||||||
|
SaveURec(User,RecNum1);
|
||||||
|
END
|
||||||
|
ELSE IF (User.ColorScheme = RecNumToPositionBefore) THEN
|
||||||
|
BEGIN
|
||||||
|
User.ColorScheme := RecNumToPosition;
|
||||||
|
SaveURec(User,RecNum1);
|
||||||
|
END;
|
||||||
|
Inc(RecNum1);
|
||||||
|
END;
|
||||||
|
Close(UserFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListSchemes(VAR RecNumToList1: Integer);
|
||||||
|
VAR
|
||||||
|
NumDone: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToList1 < 1) OR (RecNumToList1 > NumSchemes) THEN
|
||||||
|
RecNumToList1 := 1;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^0###^4:^3'+PadLeftStr('Description',30)+'^4:^3Colors');
|
||||||
|
PrintACR('^4===:==============================:============================');
|
||||||
|
Reset(SchemeFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumSchemes)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(SchemeFile,(RecNumToList1 - 1));
|
||||||
|
Read(SchemeFile,Scheme);
|
||||||
|
WITH Scheme DO
|
||||||
|
Prompt('^0'+PadRightInt(RecNumToList1,3)+
|
||||||
|
' ^5'+PadLeftStr(Description,30)+
|
||||||
|
' ');
|
||||||
|
ShowColors;
|
||||||
|
Inc(RecNumToList1);
|
||||||
|
Inc(NumDone);
|
||||||
|
END;
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumSchemes = 0) THEN
|
||||||
|
Print('*** No color schemes defined ***');
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
RecNumToList := 1;
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
ListSchemes(RecNumToList);
|
||||||
|
LOneK('%LFColor scheme editor [^5?^4=^5Help^4]: ',Cmd,'QDIMP?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
^M : IF (RecNumToList < 1) OR (RecNumToList > NumSchemes) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
'D' : DeleteScheme(TempScheme,RecNumToList);
|
||||||
|
'I' : InsertScheme(TempScheme,Cmd,RecNumToList);
|
||||||
|
'M' : ModifyScheme(TempScheme,Cmd,RecNumToList);
|
||||||
|
'P' : PositionScheme(TempScheme);
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||||||
|
Print('^1(^3?^1)Help/First color scheme');
|
||||||
|
LCmds(20,3,'Delete color scheme','Insert color scheme');
|
||||||
|
LCmds(20,3,'Modify color scheme','Position color scheme');
|
||||||
|
LCmds(20,3,'Quit','');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (CMD <> ^M) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
IF (ThisUser.ColorScheme < 1) OR (ThisUser.ColorScheme > FileSize(SchemeFile)) THEN
|
||||||
|
ThisUser.ColorScheme := 1;
|
||||||
|
Reset(SchemeFile);
|
||||||
|
Seek(SchemeFile,(ThisUser.ColorScheme - 1));
|
||||||
|
Read(SchemeFile,Scheme);
|
||||||
|
Close(SchemeFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,363 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2K;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE DisplayArcs;
|
||||||
|
PROCEDURE DisplayCmt;
|
||||||
|
PROCEDURE ArchiveConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
|
||||||
|
PROCEDURE DisplayArcs;
|
||||||
|
VAR
|
||||||
|
RecNumToList: Byte;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
PrintACR('^0 ##^4:^3Ext^4:^3Compression cmdline ^4:^3Decompression cmdline ^4:^3Success Code');
|
||||||
|
PrintACR('^4 ==:===:=========================:=========================:============');
|
||||||
|
RecNumToList := 1;
|
||||||
|
WHILE (RecNumToList <= NumArcs) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
WITH General.FileArcInfo[RecNumToList] DO
|
||||||
|
PrintACR(AOnOff(Active,'^5+','^1-')+
|
||||||
|
'^0'+PadRightInt(RecNumToList,2)+
|
||||||
|
' ^3'+PadLeftStr(Ext,3)+
|
||||||
|
' ^5'+PadLeftStr(ArcLine,25)+
|
||||||
|
' '+PadLeftStr(UnArcLine,25)+
|
||||||
|
' '+AOnOff(SuccLevel <> - 1,IntToStr(SuccLevel),'-1 (ignores)'));
|
||||||
|
Inc(RecNumToList);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DisplayCmt;
|
||||||
|
VAR
|
||||||
|
RecNumToList: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR RecNumToList := 1 TO 3 DO
|
||||||
|
PrintACR('^1'+IntToStr(RecNumToList)+'. Archive comment file: ^5'+
|
||||||
|
AOnOff(General.FileArcComment[RecNumToList] <> '',
|
||||||
|
General.FileArcComment[RecNumToList],'*None*'));
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ArchiveConfiguration;
|
||||||
|
VAR
|
||||||
|
TempArchive: FileArcInfoRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList: Byte;
|
||||||
|
Changed : Boolean;
|
||||||
|
|
||||||
|
FUNCTION DisplayArcStr(S: AStr): AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (S <> '') THEN
|
||||||
|
DisplayArcStr := S
|
||||||
|
ELSE
|
||||||
|
DisplayArcStr := '*None*';
|
||||||
|
IF (S[1] = '/') THEN
|
||||||
|
BEGIN
|
||||||
|
S := '"'+S+'" - ';
|
||||||
|
CASE s[3] OF
|
||||||
|
'1' : DisplayArcStr := S + '*Internal* ZIP viewer';
|
||||||
|
'2' : DisplayArcStr := S + '*Internal* ARC/PAK viewer';
|
||||||
|
'3' : DisplayArcStr := S + '*Internal* ZOO viewer';
|
||||||
|
'4' : DisplayArcStr := S + '*Internal* LZH viewer';
|
||||||
|
'5' : DisplayArcStr := S + '*Internal* ARJ viewer';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitArchiveVars(VAR Archive: FileArcInfoRecordType);
|
||||||
|
BEGIN
|
||||||
|
FillChar(Archive,SizeOf(Archive),0);
|
||||||
|
WITH Archive DO
|
||||||
|
BEGIN
|
||||||
|
Active := FALSE;
|
||||||
|
Ext := 'AAA';
|
||||||
|
ListLine := '';
|
||||||
|
ArcLine := '';
|
||||||
|
UnArcLine := '';
|
||||||
|
TestLine := '';
|
||||||
|
CmtLine := '';
|
||||||
|
SuccLevel := -1;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteArchive(TempArchive1: FileArcInfoRecordType; RecNumToDelete: Byte);
|
||||||
|
VAR
|
||||||
|
RecNum: Byte;
|
||||||
|
BEGIN
|
||||||
|
IF (NumArcs = 0) THEN
|
||||||
|
Messages(4,0,'archive records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := 0;
|
||||||
|
InputByteWOC('%LFArchive to delete?',RecNumToDelete,[NumbersOnly],1,NumArcs);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumArcs) THEN
|
||||||
|
BEGIN
|
||||||
|
TempArchive1 := General.FileArcInfo[RecNumToDelete];
|
||||||
|
Print('%LFArchive: ^5'+TempArchive1.Ext);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting archive record ...');
|
||||||
|
FOR RecNum := RecNumToDelete TO (NumArcs - 1) DO
|
||||||
|
General.FileArcInfo[RecNum] := General.FileArcInfo[RecNum + 1];
|
||||||
|
General.FileArcInfo[NumArcs].Ext := '';
|
||||||
|
Dec(NumArcs);
|
||||||
|
SysOpLog('* Deleted archive: ^5'+TempArchive1.Ext);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckArchive(Archive: FileArcInfoRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : IF (Archive.Ext = '') OR (Archive.Ext = 'AAA') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The archive extension is invalid!^1');
|
||||||
|
OK := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditArchive(TempArchive1: FileArcInfoRecordType; VAR Archive: FileArcInfoRecordType; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit: Byte; VAR Changed1: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
CmdStr: AStr;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH Archive DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing archive #'+IntToStr(RecNumToEdit)+
|
||||||
|
' of '+IntToStr(NumArcs))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting archive #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumArcs + 1));
|
||||||
|
NL;
|
||||||
|
PrintACR('^11. Active : ^5'+ShowYesNo(Active));
|
||||||
|
PrintACR('^12. Extension name : ^5'+Ext);
|
||||||
|
PrintACR('^13. Interior list method : ^5'+DisplayArcStr(ListLine));
|
||||||
|
PrintACR('^14. Compression cmdline : ^5'+DisplayArcStr(ArcLine));
|
||||||
|
PrintACR('^15. Decompression cmdline : ^5'+DisplayArcStr(UnArcLine));
|
||||||
|
PrintACR('^16. File testing cmdline : ^5'+DisplayArcStr(TestLine));
|
||||||
|
PrintACR('^17. Add comment cmdline : ^5'+DisplayArcStr(CmtLine));
|
||||||
|
PrintACR('^18. Errorlevel for success : ^5'++AOnOff(SuccLevel <> - 1,IntToStr(SuccLevel),'-1 (ignores)'));
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := '12345678'
|
||||||
|
ELSE
|
||||||
|
CmdStr := '12345678[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'1' : BEGIN
|
||||||
|
Active := NOT Active;
|
||||||
|
Changed1 := TRUE;
|
||||||
|
END;
|
||||||
|
'2' : REPEAT
|
||||||
|
TempArchive1.Ext := Ext;
|
||||||
|
Ok := TRUE;
|
||||||
|
InputWN1('%LFNew extension: ',Ext,(SizeOf(Ext) - 1),[InterActiveEdit,UpperOnly],Changed1);
|
||||||
|
CheckArchive(Archive,1,1,Ok);
|
||||||
|
IF (NOT Ok) THEN
|
||||||
|
Ext := TempArchive1.Ext;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
'3' : InputWN1('%LFNew interior list method: ',ListLine,(SizeOf(ListLine) - 1),[InterActiveEdit],Changed1);
|
||||||
|
'4' : InputWN1('%LFNew compression command line: ',ArcLine,(SizeOf(ArcLine) - 1),[InterActiveEdit],Changed1);
|
||||||
|
'5' : InputWN1('%LFNew decompression command line: ',UnArcLine,(SizeOf(UnArcLine) - 1),
|
||||||
|
[InterActiveEdit],Changed1);
|
||||||
|
'6' : InputWN1('%LFNew file testing command line: ',TestLine,(SizeOf(TestLine) - 1),
|
||||||
|
[InterActiveEdit],Changed1);
|
||||||
|
'7' : InputWN1('%LFNew add comment command line: ',CmtLine,(SizeOf(CmtLine) - 1),[InterActiveEdit],Changed1);
|
||||||
|
'8' : InputIntegerWC('%LFNew errorlevel for success',SuccLevel,[DisplayValue,NumbersOnly],-1,255,Changed1);
|
||||||
|
'[' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit < NumArcs) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputByteWOC('%LFJump to entry?',RecNumToEdit,[NumbersOnly],1,NumArcs);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumArcs) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> NumArcs) THEN
|
||||||
|
RecNumToEdit := NumArcs
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^31^1-^38^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertArchive(TempArchive1: FileArcInfoRecordType; Cmd1: Char; RecNumToInsertBefore: Byte);
|
||||||
|
VAR
|
||||||
|
RecNum,
|
||||||
|
RecNumToEdit: Byte;
|
||||||
|
Ok,
|
||||||
|
Changed1: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumArcs = MaxArcs) THEN
|
||||||
|
Messages(5,MaxArcs,'archive records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToInsertBefore := 0;
|
||||||
|
InputByteWOC('%LFArchive to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumArcs + 1));
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumArcs + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
InitArchiveVars(TempArchive1);
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE IF (RecNumToInsertBefore = (NumArcs + 1)) THEN
|
||||||
|
RecNumToEdit := (NumArcs + 1)
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditArchive(TempArchive1,TempArchive1,Cmd1,RecNumToEdit,Changed1,FALSE);
|
||||||
|
CheckArchive(TempArchive1,1,2,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting archive? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting archive record ...');
|
||||||
|
IF (RecNumToInsertBefore <> (NumArcs + 1)) THEN
|
||||||
|
FOR RecNum := (NumArcs + 1) DOWNTO (RecNumToInsertBefore + 1) DO
|
||||||
|
General.FileArcInfo[RecNum] := General.FileArcInfo[RecNum - 1];
|
||||||
|
General.FileArcInfo[RecNumToInsertBefore] := TempArchive1;
|
||||||
|
Inc(NumArcs);
|
||||||
|
SysOpLog('* Inserted archive: ^5'+TempArchive1.Ext);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyArchive(TempArchive1: FileArcInfoRecordType; Cmd1: Char; RecNumToEdit: Byte);
|
||||||
|
VAR
|
||||||
|
Archive: FileArcInfoRecordType;
|
||||||
|
SaveRecNumToEdit: Byte;
|
||||||
|
OK,
|
||||||
|
Changed1: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumArcs = 0) THEN
|
||||||
|
Messages(4,0,'archive records')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := 0;
|
||||||
|
InputByteWOC('%LFArchive to modify?',RecNumToEdit,[NumbersOnly],1,NumArcs);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumArcs) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := 0;
|
||||||
|
Cmd1 := #0;
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Archive := General.FileArcInfo[RecNumToEdit];
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed1 := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditArchive(TempArchive1,Archive,Cmd1,RecNumToEdit,Changed1,TRUE);
|
||||||
|
CheckArchive(Archive,1,2,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
IF (Changed1) THEN
|
||||||
|
BEGIN
|
||||||
|
General.FileArcInfo[SaveRecNumToEdit] := Archive;
|
||||||
|
Changed1 := FALSE;
|
||||||
|
SysOpLog('* Modified archive: ^5'+Archive.Ext);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
CLS;
|
||||||
|
DisplayArcs;
|
||||||
|
NL;
|
||||||
|
DisplayCmt;
|
||||||
|
END;
|
||||||
|
LOneK('%LFArchive editor [^5?^4=^5Help^4]: ',Cmd,'QDIM123?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'D' : DeleteArchive(TempArchive,RecNumToList);
|
||||||
|
'I' : InsertArchive(TempArchive,Cmd,RecNumToList);
|
||||||
|
'M' : ModifyArchive(TempArchive,Cmd,RecNumToList);
|
||||||
|
'1'..'3' :
|
||||||
|
BEGIN
|
||||||
|
Changed := FALSE;
|
||||||
|
InputWNWC('%LFNew comment file #'+IntToStr(Ord(Cmd) - 48)+': ',General.FileArcComment[Ord(Cmd) - 48],40,Changed);
|
||||||
|
IF (Changed) THEN
|
||||||
|
SysOpLog('* Modified comment: ^5'+IntToStr(Ord(Cmd) - 48)+'.');
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||||||
|
Print('^1(^3?^1)Help/First archive');
|
||||||
|
Print('^31^1-^33^1:Modify Item');
|
||||||
|
LCmds(16,3,'Delete archive','Insert archive');
|
||||||
|
LCmds(16,3,'Modify archive','Quit');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,48 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2L;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE CreditConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE CreditConfiguration;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
Print('^5Credit System Configuration:');
|
||||||
|
NL;
|
||||||
|
PrintACR('^1A. Charge/minute : ^5'+IntToStr(CreditMinute));
|
||||||
|
PrintACR('^1B. Message post : ^5'+IntToStr(CreditPost));
|
||||||
|
PrintACR('^1C. Email sent : ^5'+IntToStr(CreditEmail));
|
||||||
|
PrintACR('^1D. Free time at logon : ^5'+IntToStr(CreditFreeTime));
|
||||||
|
PrintACR('^1E. Internet mail cost : ^5'+IntToStr(CreditInternetMail));
|
||||||
|
Prt('%LFEnter selection [^5A^4-^5E^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDE'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : InputIntegerWOC('%LFCredits charged per minute online',CreditMinute,[NumbersOnly],0,32767);
|
||||||
|
'B' : InputIntegerWOC('%LFCredits charged per message post',CreditPost,[NumbersOnly],0,32767);
|
||||||
|
'C' : InputIntegerWOC('%LFCredits charged per email sent',CreditEmail,[Numbersonly],0,32767);
|
||||||
|
'D' : InputIntegerWOC('%LFMinutes to give users w/o credits at logon',CreditFreeTime,[NumbersOnly],0,32767);
|
||||||
|
'E' : InputIntegerWOC('%LFCost for Internet mail messages',CreditInternetMail,[NumbersOnly],0,32767);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,134 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2M;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE NewUserTogglesConfiguration;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE NewUserTogglesConfiguration;
|
||||||
|
VAR
|
||||||
|
TempStr: STRING[70];
|
||||||
|
Cmd: CHAR;
|
||||||
|
TempB: BYTE;
|
||||||
|
Changed: Boolean;
|
||||||
|
|
||||||
|
FUNCTION Toggle(NUToggle,CUSerNum: BYTE): BYTE;
|
||||||
|
BEGIN
|
||||||
|
IF (NUToggle = 0) THEN
|
||||||
|
Toggle := CUserNum
|
||||||
|
ELSE
|
||||||
|
Toggle := 0;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
CLS;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
WITH General DO
|
||||||
|
BEGIN
|
||||||
|
Print('^5New User Question Toggles Configuration:');
|
||||||
|
NL;
|
||||||
|
NewUserToggles[1] := 7;
|
||||||
|
PrintACR('^1A. Ask what the REAL NAME is : ^5'+ShowYesNo(NewUserToggles[2] <> 0));
|
||||||
|
PrintACR('^1B. Ask which COUNTRY from : ^5'+ShowYesNo(NewUserToggles[3] <> 0));
|
||||||
|
PrintACR('^1C. Ask what the ADDRESS is : ^5'+ShowYesNo(NewUserToggles[4] <> 0));
|
||||||
|
PrintACR('^1D. Ask what the CITY, STATE is : ^5'+ShowYesNo(NewUserToggles[5] <> 0));
|
||||||
|
PrintACR('^1E. Ask what the ZIP CODE is : ^5'+ShowYesNo(NewUserToggles[6] <> 0));
|
||||||
|
PrintACR('^1F. Ask what the PHONE NUMBER is : ^5'+ShowYesNo(NewUserToggles[7] <> 0));
|
||||||
|
PrintACR('^1G. Ask which Gender (Male/Female) : ^5'+ShowYesNo(NewUserToggles[8] <> 0));
|
||||||
|
PrintACR('^1H. Ask what the BIRTHDAY is : ^5'+ShowYesNo(NewUserToggles[9] <> 0));
|
||||||
|
PrintACR('^1I. Ask SysOp Question #1 : ^5'+ShowYesNo(NewUserToggles[10] <> 0));
|
||||||
|
PrintACR('^1J. Ask SysOp Question #2 : ^5'+ShowYesNo(NewUserToggles[11] <> 0));
|
||||||
|
PrintACR('^1K. Ask SysOp Question #3 : ^5'+ShowYesNo(NewUserToggles[12] <> 0));
|
||||||
|
PrintACR('^1L. Ask EMULATION that is required : ^5'+ShowYesNo(NewUserToggles[13] <> 0));
|
||||||
|
PrintACR('^1M. Ask SCREEN SIZE that is required : ^5'+ShowYesNo(NewUserToggles[14] <> 0));
|
||||||
|
PrintACR('^1N. Ask if Msg SCREEN CLEARING is needed: ^5'+ShowYesNo(NewUserToggles[15] <> 0));
|
||||||
|
PrintACR('^1O. Ask if SCREEN PAUSES are needed : ^5'+ShowYesNo(NewUserToggles[16] <> 0));
|
||||||
|
PrintACR('^1P. Ask if HOTKEYS are needed : ^5'+ShowYesNo(NewUserToggles[17] <> 0));
|
||||||
|
PrintACR('^1R. Ask if EXPERT MODE is needed : ^5'+ShowYesNo(NewUserToggles[18] <> 0));
|
||||||
|
NewUserToggles[19] := 9;
|
||||||
|
PrintACR('^1S. Ask FORGOT PW question : ^5'+ShowYesNo(NewUserToggles[20] <> 0));
|
||||||
|
IF (RGMainStr(6, TRUE) <> '') THEN
|
||||||
|
{PrintACR('^1 ('+ForgotPWQuestion+')');} PrintACR('^1 ('+ RGMainStr(6,TRUE) + ')');
|
||||||
|
END;
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
Prt('%LFEnter selection [^5A^4-^5P^4,^5R^4-^5S^4,^5Q^4=^5Quit^4]: ');
|
||||||
|
OneK(Cmd,'QABCDEFGHIJKLMNOPRS'^M,TRUE,TRUE);
|
||||||
|
WITH General DO
|
||||||
|
CASE Cmd OF
|
||||||
|
'A' : NewUserToggles[2] := Toggle(NewUserToggles[2],10);
|
||||||
|
'B' : NewUserToggles[3] := Toggle(NewUserToggles[3],23);
|
||||||
|
'C' : NewUserToggles[4] := Toggle(NewUserToggles[4],1);
|
||||||
|
'D' : NewUserToggles[5] := Toggle(NewUserToggles[5],4);
|
||||||
|
'E' : NewUserToggles[6] := Toggle(NewUserToggles[6],14);
|
||||||
|
'F' : BEGIN
|
||||||
|
NewUserToggles[7] := Toggle(NewUserToggles[7],8);
|
||||||
|
IF (NewUserToggles[7] <> 0) THEN
|
||||||
|
General.PhonePW := TRUE
|
||||||
|
ELSE
|
||||||
|
General.PhonePW := FALSE;
|
||||||
|
END;
|
||||||
|
'G' : NewUserToggles[8] := Toggle(NewUserToggles[8],12);
|
||||||
|
'H' : BEGIN
|
||||||
|
NewUserToggles[9] := Toggle(NewUserToggles[9],2);
|
||||||
|
(*
|
||||||
|
IF (NewUserToggles[9] = 0) THEN
|
||||||
|
General.BirthDateCheck := 0
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
Prt('Logins before birthday check (0-255): ');
|
||||||
|
Ini(TempB);
|
||||||
|
IF (TempB < 0) OR (TempB > 255) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('Invalid Range!');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
UNTIL (TempB >= 0) AND (TempB <= 255) OR (HangUp);
|
||||||
|
General.BirthDateCheck := TempB;
|
||||||
|
END;
|
||||||
|
*)
|
||||||
|
END;
|
||||||
|
'I' : NewUserToggles[10] := Toggle(NewUserToggles[10],5);
|
||||||
|
'J' : NewUserToggles[11] := Toggle(NewUserToggles[11],6);
|
||||||
|
'K' : NewUserToggles[12] := Toggle(NewUserToggles[12],13);
|
||||||
|
'L' : NewUserToggles[13] := Toggle(NewUserToggles[13],3);
|
||||||
|
'M' : NewUserToggles[14] := Toggle(NewUserToggles[14],11);
|
||||||
|
'N' : NewUserToggles[15] := Toggle(NewUserToggles[15],29);
|
||||||
|
'O' : NewUserToggles[16] := Toggle(NewUserToggles[16],24);
|
||||||
|
'P' : NewUserToggles[17] := Toggle(NewUserToggles[17],25);
|
||||||
|
'R' : NewUserToggles[18] := Toggle(NewUserToggles[18],28);
|
||||||
|
'S' : BEGIN
|
||||||
|
NewUserToggles[20] := Toggle(NewUserToggles[20],30);
|
||||||
|
(*)IF (NewUserToggles[20] = 0) THEN
|
||||||
|
ForgotPWQuestion := ''
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
TempStr := General.ForgotPWQuestion;
|
||||||
|
REPEAT
|
||||||
|
InputWN1('%LFEnter question to ask user if they forget thier password:%LF: ',TempStr,70,
|
||||||
|
[InterActiveEdit],Changed);
|
||||||
|
UNTIL (TempStr <> '') OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
ForgotPWQuestion := TempStr;
|
||||||
|
END; *)
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,98 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp2O;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE GetSecRange(CONST DisplayType: LongInt; VAR Sec: SecurityRangeType);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
PROCEDURE GetSecRange(CONST DisplayType: LongInt; VAR Sec: SecurityRangeType);
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
Counter: Byte;
|
||||||
|
DisplayValue,
|
||||||
|
FromValue,
|
||||||
|
ToValue: SmallInt;
|
||||||
|
NewValue: LongInt;
|
||||||
|
|
||||||
|
PROCEDURE ShowSecRange(Start: Byte);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
LineNum,
|
||||||
|
Counter1: Byte;
|
||||||
|
SecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
LineNum := 0;
|
||||||
|
REPEAT
|
||||||
|
TempStr := '';
|
||||||
|
FOR Counter1 := 0 TO 7 DO
|
||||||
|
BEGIN
|
||||||
|
SecNum := Start + LineNum + Counter1 * 20;
|
||||||
|
IF (SecNum <= 255) THEN
|
||||||
|
BEGIN
|
||||||
|
TempStr := TempStr + '^1'+PadLeftInt(SecNum,3)+':^5'+PadLeftInt(Sec[SecNum],5);
|
||||||
|
IF (Counter1 <> 7) THEN
|
||||||
|
TempStr := TempStr + ' ';
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
PrintACR(TempStr);
|
||||||
|
Inc(LineNum);
|
||||||
|
UNTIL (LineNum > 19) OR (Abort) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
DisplayValue := 0;
|
||||||
|
REPEAT
|
||||||
|
CLS;
|
||||||
|
CASE DisplayType OF
|
||||||
|
1 : Print('^5Time limitations:^1');
|
||||||
|
2 : Print('^5Call allowance per day:^1');
|
||||||
|
3 : Print('^5UL/DL # files ratio (# files can DL per UL):^1');
|
||||||
|
4 : Print('^5UL/DL K-bytes ratio (#k can DL per 1k UL):^1');
|
||||||
|
5 : Print('^5Post/Call ratio (posts per 100 calls) to have Z ACS flag set:^1');
|
||||||
|
6 : Print('^5Maximum number of downloads in one day:^1');
|
||||||
|
7 : Print('^5Maximum amount of downloads (in kbytes) in one day:^1');
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
ShowSecRange(DisplayValue);
|
||||||
|
LOneK('%LFRange settings [^5S^4=^5Set^4,^5T^4=^5Toggle^4,^5Q^4=^5Quit^4]: ',Cmd,'QST'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
'S' : BEGIN
|
||||||
|
FromValue := -1;
|
||||||
|
InputIntegerWOC('%LFFrom?',FromValue,[NumbersOnly],0,255);
|
||||||
|
IF (FromValue >= 0) AND (FromValue <= 255) THEN
|
||||||
|
BEGIN
|
||||||
|
ToValue := -1;
|
||||||
|
InputIntegerWOC('%LFTo?',ToValue,[NumbersOnly],0,255);
|
||||||
|
IF (ToValue >= 0) AND (ToValue <= 255) THEN
|
||||||
|
BEGIN
|
||||||
|
NewValue := -1;
|
||||||
|
InputLongIntWOC('%LFValue to set?',NewValue,[NumbersOnly],0,32767);
|
||||||
|
IF (NewValue >= 0) AND (NewValue <= 32767) THEN
|
||||||
|
FOR Counter := FromValue TO ToValue DO
|
||||||
|
Sec[Counter] := NewValue;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'T' : IF (DisplayValue = 0) THEN
|
||||||
|
DisplayValue := 160
|
||||||
|
ELSE
|
||||||
|
DisplayValue := 0;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,563 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-}
|
||||||
|
|
||||||
|
UNIT SysOp4;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE TEdit1;
|
||||||
|
PROCEDURE TEdit(CONST FSpec: AStr);
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
PROCEDURE TEdit1;
|
||||||
|
VAR
|
||||||
|
FSpec: AStr;
|
||||||
|
Dir: DirStr;
|
||||||
|
Name: NameStr;
|
||||||
|
Ext: ExtStr;
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Prt('File name: ');
|
||||||
|
IF (FileSysOp) THEN
|
||||||
|
BEGIN
|
||||||
|
MPL(50);
|
||||||
|
Input(FSpec,50);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MPL(12);
|
||||||
|
Input(FSpec,12);
|
||||||
|
FSplit(FSpec,Dir,Name,Ext);
|
||||||
|
FSpec := Name+Ext;
|
||||||
|
END;
|
||||||
|
TEdit(FSpec);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE TEdit(CONST FSpec: AStr);
|
||||||
|
TYPE
|
||||||
|
StrPtr = ^StrRec;
|
||||||
|
|
||||||
|
StrRec = RECORD
|
||||||
|
S: AStr;
|
||||||
|
Next,
|
||||||
|
Last: StrPtr;
|
||||||
|
END;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
TopHeap: ^Byte;
|
||||||
|
Fil: Text;
|
||||||
|
Cur,
|
||||||
|
Nex,
|
||||||
|
Las,
|
||||||
|
Top,
|
||||||
|
Bottom,
|
||||||
|
Used: StrPtr;
|
||||||
|
S: AStr;
|
||||||
|
TotalLines,
|
||||||
|
CurLine,
|
||||||
|
I: Integer;
|
||||||
|
Done,
|
||||||
|
AllRead: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE InLi(VAR S1: AStr);
|
||||||
|
VAR
|
||||||
|
C,
|
||||||
|
C1: Char;
|
||||||
|
Cp,
|
||||||
|
Rp,
|
||||||
|
CV,
|
||||||
|
CC: Integer;
|
||||||
|
|
||||||
|
PROCEDURE BKSpc;
|
||||||
|
BEGIN
|
||||||
|
IF (Cp > 1) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (S1[Cp - 2] = '^') AND (S1[Cp - 1] IN ['0'..'9']) THEN
|
||||||
|
BEGIN
|
||||||
|
UserColor(1);
|
||||||
|
Dec(Cp);
|
||||||
|
END
|
||||||
|
ELSE IF (S1[Cp - 1] = #8) THEN
|
||||||
|
BEGIN
|
||||||
|
Prompt(' ');
|
||||||
|
Inc(Rp);
|
||||||
|
END
|
||||||
|
ELSE IF (S1[Cp - 1] <> #10) THEN
|
||||||
|
BEGIN
|
||||||
|
Prompt(#8+' '+#8);
|
||||||
|
Dec(Rp);
|
||||||
|
END;
|
||||||
|
Dec(Cp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Rp := 1;
|
||||||
|
Cp := 1;
|
||||||
|
S1 := '';
|
||||||
|
IF (LastLineStr <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Prompt(LastLineStr);
|
||||||
|
S1 := LastLineStr;
|
||||||
|
LastLineStr := '';
|
||||||
|
Cp := (Length(S1) + 1);
|
||||||
|
Rp := Cp;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
C := Char(GetKey);
|
||||||
|
CASE C of
|
||||||
|
#32..#255 :
|
||||||
|
IF (Cp < StrLen) AND (Rp < ThisUser.LineLen) THEN
|
||||||
|
BEGIN
|
||||||
|
S1[Cp] := C;
|
||||||
|
Inc(Cp);
|
||||||
|
Inc(Rp);
|
||||||
|
OutKey(C);
|
||||||
|
END;
|
||||||
|
^H : BKSpc;
|
||||||
|
^S : BEGIN
|
||||||
|
CV := (5 - (Cp MOD 5));
|
||||||
|
IF ((Cp + CV) < StrLen) AND ((Rp + CV) < ThisUser.LineLen) THEN
|
||||||
|
FOR CC := 1 TO CV DO
|
||||||
|
BEGIN
|
||||||
|
Prompt(' ');
|
||||||
|
S1[Cp] := ' ';
|
||||||
|
Inc(Rp);
|
||||||
|
Inc(Cp);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
^P : IF (OkANSI OR OkAvatar) AND (Cp < (StrLen - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
C1 := Char(GetKey);
|
||||||
|
IF (C1 IN ['0'..'9']) THEN
|
||||||
|
BEGIN
|
||||||
|
S1[Cp] := '^';
|
||||||
|
Inc(Cp);
|
||||||
|
S1[Cp] := C1;
|
||||||
|
Inc(Cp);
|
||||||
|
UserColor(Ord(S1[Cp - 1]));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
^X : BEGIN
|
||||||
|
Cp := 1;
|
||||||
|
FOR CV := 1 TO (Rp - 1) DO
|
||||||
|
Prompt(#8+' '+#8);
|
||||||
|
UserColor(1);
|
||||||
|
Rp := 1;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL ((C = ^M) OR (Rp = ThisUser.LineLen) OR (HangUp));
|
||||||
|
S1[0] := Chr(Cp - 1);
|
||||||
|
IF (C <> ^M ) THEN
|
||||||
|
BEGIN
|
||||||
|
CV := (Cp - 1);
|
||||||
|
WHILE (CV > 1) AND (S1[CV] <> ' ') AND ((S1[CV] <> ^H) OR (S1[CV - 1] = '^')) DO
|
||||||
|
Dec(CV);
|
||||||
|
IF (CV > (Rp DIV 2)) AND (CV <> (Cp - 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
LastLineStr := Copy(S1,(CV + 1),(Cp - CV));
|
||||||
|
FOR CC := (Cp - 2) DOWNTO CV DO
|
||||||
|
Prompt(^H);
|
||||||
|
FOR CC := (Cp - 2) DOWNTO CV DO
|
||||||
|
Prompt(' ');
|
||||||
|
S1[0] := Chr(CV - 1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
NL;
|
||||||
|
END;
|
||||||
|
|
||||||
|
FUNCTION NewPtr(VAR x: StrPtr): Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (Used <> NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
x := Used;
|
||||||
|
Used := Used^.Next;
|
||||||
|
NewPtr := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (MaxAvail > 2048) THEN
|
||||||
|
BEGIN
|
||||||
|
New(x);
|
||||||
|
NewPtr := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
NewPtr := FALSE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE OldPtr(VAR x: StrPtr);
|
||||||
|
BEGIN
|
||||||
|
x^.Next := Used;
|
||||||
|
Used := x;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PLine(Cl: Integer; VAR Cp: StrPtr);
|
||||||
|
VAR
|
||||||
|
S1: AStr;
|
||||||
|
BEGIN
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Cp = NIL) THEN
|
||||||
|
S1 := ' ^5'+'[^3'+'END^5'+']'
|
||||||
|
ELSE
|
||||||
|
S1 := PadRightInt(Cl,4)+': '+Cp^.S;
|
||||||
|
PrintACR(S1);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE PL;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
PLine(CurLine,Cur);
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Mark(TopHeap);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
// REETODO Prepare to leak memory...
|
||||||
|
{$ENDIF}
|
||||||
|
Used := NIL;
|
||||||
|
Top := NIL;
|
||||||
|
Bottom := NIL;
|
||||||
|
AllRead := TRUE;
|
||||||
|
IF (FSpec = '') THEN
|
||||||
|
BEGIN
|
||||||
|
Print('Aborted.');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
TotalLines := 0;
|
||||||
|
New(Cur);
|
||||||
|
Cur^.Last := NIL;
|
||||||
|
Cur^.S := '';
|
||||||
|
NL;
|
||||||
|
Assign(Fil,FSpec);
|
||||||
|
Reset(Fil);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
ReWrite(Fil);
|
||||||
|
IF (IOResult <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('Error reading file.');
|
||||||
|
Abort := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Close(Fil);
|
||||||
|
Erase(Fil);
|
||||||
|
Print('New file.');
|
||||||
|
TotalLines := 0;
|
||||||
|
Cur := NIL;
|
||||||
|
Top := Cur;
|
||||||
|
Bottom := Cur;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Abort := NOT NewPtr(Nex);
|
||||||
|
Top := Nex;
|
||||||
|
Print('^1Loading...');
|
||||||
|
WHILE ((NOT EOF(Fil)) AND (NOT Abort)) DO
|
||||||
|
BEGIN
|
||||||
|
Inc(TotalLines);
|
||||||
|
Cur^.Next := Nex;
|
||||||
|
Nex^.Last := Cur;
|
||||||
|
Cur := Nex;
|
||||||
|
ReadLn(Fil,S);
|
||||||
|
Cur^.S := S;
|
||||||
|
Abort := NOT NewPtr(Nex);
|
||||||
|
END;
|
||||||
|
Close(Fil);
|
||||||
|
Cur^.Next := NIL;
|
||||||
|
IF (TotalLines = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Cur := NIL;
|
||||||
|
Top := NIL;
|
||||||
|
END;
|
||||||
|
Bottom := Cur;
|
||||||
|
IF (Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print(^G^G'|12WARNING: |10Not all of file read.^3');
|
||||||
|
NL;
|
||||||
|
AllRead := FALSE;
|
||||||
|
END;
|
||||||
|
Abort := FALSE;
|
||||||
|
END;
|
||||||
|
IF (NOT Abort) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('Total lines: '+IntToStr(TotalLines));
|
||||||
|
Cur := Top;
|
||||||
|
IF (Top <> NIL) THEN
|
||||||
|
Top^.Last := NIL;
|
||||||
|
CurLine := 1;
|
||||||
|
Done := FALSE;
|
||||||
|
PL;
|
||||||
|
REPEAT
|
||||||
|
Prt(':');
|
||||||
|
Input(S,10);
|
||||||
|
IF (S = '') THEN
|
||||||
|
S := '+';
|
||||||
|
IF (StrToInt(S) > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
I := StrToInt(S);
|
||||||
|
IF ((I > 0) AND (I <= TotalLines)) THEN
|
||||||
|
BEGIN
|
||||||
|
WHILE (I <> CurLine) DO
|
||||||
|
IF (I < CurLine) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Cur = NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
Cur := Bottom;
|
||||||
|
CurLine := TotalLines;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Dec(CurLine);
|
||||||
|
Cur := Cur^.Last;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Inc(CurLine);
|
||||||
|
Cur := Cur^.Next;
|
||||||
|
END;
|
||||||
|
PL;
|
||||||
|
END;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
CASE S[1] of
|
||||||
|
'?' : BEGIN
|
||||||
|
LCmds(14,3,'+Forward line','-Back line');
|
||||||
|
LCmds(14,3,'Top','Bottom');
|
||||||
|
LCmds(14,3,'Print line','List');
|
||||||
|
LCmds(14,3,'Insert lines','Delete line');
|
||||||
|
LCmds(14,3,'Replace line','Clear all');
|
||||||
|
LCmds(14,3,'Quit (Abort)','Save');
|
||||||
|
LCmds(14,3,'*Center line','!Memory Available');
|
||||||
|
END;
|
||||||
|
'!' : Print('Heap space available: '+IntToStr(MemAvail));
|
||||||
|
'*' : IF (Cur <> NIL) THEN
|
||||||
|
Cur^.S := #2+Cur^.S;
|
||||||
|
'+' : IF (Cur <> NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
I := StrToInt(Copy(S,2,9));
|
||||||
|
IF (I = 0) THEN
|
||||||
|
I := 1;
|
||||||
|
WHILE (Cur <> NIL) AND (I > 0) DO
|
||||||
|
BEGIN
|
||||||
|
Cur := Cur^.Next;
|
||||||
|
Inc(CurLine);
|
||||||
|
Dec(I);
|
||||||
|
END;
|
||||||
|
PL;
|
||||||
|
END;
|
||||||
|
'-' : BEGIN
|
||||||
|
I := StrToInt(Copy(S,2,9));
|
||||||
|
IF (I = 0) THEN
|
||||||
|
I := 1;
|
||||||
|
IF (Cur = NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
Cur := Bottom;
|
||||||
|
CurLine := TotalLines;
|
||||||
|
Dec(I);
|
||||||
|
END;
|
||||||
|
IF (Cur <> NIL) THEN
|
||||||
|
IF (Cur^.Last <> NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
WHILE ((Cur^.Last <> NIL) AND (I > 0)) DO
|
||||||
|
BEGIN
|
||||||
|
Cur := Cur^.Last;
|
||||||
|
Dec(CurLine);
|
||||||
|
Dec(I);
|
||||||
|
END;
|
||||||
|
PL;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'B' : BEGIN
|
||||||
|
Cur := NIL;
|
||||||
|
CurLine := (TotalLines + 1);
|
||||||
|
PL;
|
||||||
|
END;
|
||||||
|
'C' : IF PYNQ('Clear workspace? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
TotalLines := 0;
|
||||||
|
CurLine := 1;
|
||||||
|
Cur := NIL;
|
||||||
|
Top := NIL;
|
||||||
|
Bottom := NIL;
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Release(TopHeap);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
// REETODO Likely going to leak memory right about now
|
||||||
|
{$ENDIF}
|
||||||
|
END;
|
||||||
|
'D' : BEGIN
|
||||||
|
I := StrToInt(Copy(S,2,9));
|
||||||
|
IF (I = 0) THEN
|
||||||
|
I := 1;
|
||||||
|
WHILE (Cur <> NIL) AND (I > 0) DO
|
||||||
|
BEGIN
|
||||||
|
Las := Cur^.Last;
|
||||||
|
Nex := Cur^.Next;
|
||||||
|
IF (Las <> NIL) THEN
|
||||||
|
Las^.Next := Nex;
|
||||||
|
IF (Nex <> NIL) THEN
|
||||||
|
Nex^.Last := Las;
|
||||||
|
OldPtr(Cur);
|
||||||
|
IF (Bottom = Cur) THEN
|
||||||
|
Bottom := Las;
|
||||||
|
IF (Top = Cur) THEN
|
||||||
|
Top := Nex;
|
||||||
|
Cur := Nex;
|
||||||
|
Dec(TotalLines);
|
||||||
|
Dec(I);
|
||||||
|
END;
|
||||||
|
PL;
|
||||||
|
END;
|
||||||
|
'I' : BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
LastLineStr := '';
|
||||||
|
NL;
|
||||||
|
Print(' Enter "." on a separate line to exit insert mode.');
|
||||||
|
IF (OkANSI OR OkAvatar) THEN
|
||||||
|
Print('^2 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ^1');
|
||||||
|
Dec(ThisUser.LineLen,6);
|
||||||
|
S := '';
|
||||||
|
WHILE (S <> '.') AND (S <> '.'+#1) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Prompt(PadRightInt(CurLine,4)+': ');
|
||||||
|
InLi(S);
|
||||||
|
IF (S <> '.') AND (S <> '.'+#1) THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := NOT NewPtr(Nex);
|
||||||
|
IF (Abort) THEN
|
||||||
|
Print('Out of space.')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Nex^.S := S;
|
||||||
|
IF (Top = Cur) THEN
|
||||||
|
IF (Cur = NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
Nex^.Last := NIL;
|
||||||
|
Nex^.Next := NIL;
|
||||||
|
Top := Nex;
|
||||||
|
Bottom := Nex;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Nex^.Next := Cur;
|
||||||
|
Cur^.Last := Nex;
|
||||||
|
Top := Nex;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (Cur = NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
Bottom^.Next := Nex;
|
||||||
|
Nex^.Last := Bottom;
|
||||||
|
Nex^.Next := NIL;
|
||||||
|
Bottom := Nex;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Las := Cur^.Last;
|
||||||
|
Nex^.Last := Las;
|
||||||
|
Nex^.Next := Cur;
|
||||||
|
Cur^.Last := Nex;
|
||||||
|
Las^.Next := Nex;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(CurLine);
|
||||||
|
Inc(TotalLines);
|
||||||
|
END
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Inc(ThisUser.LineLen,6);
|
||||||
|
END;
|
||||||
|
'L' : BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
Nex := Cur;
|
||||||
|
I := CurLine;
|
||||||
|
WHILE (Nex <> NIL) AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
PLine(I,Nex);
|
||||||
|
Nex := Nex^.Next;
|
||||||
|
Inc(I);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'P' : PL;
|
||||||
|
'R' : IF (Cur <> NIL) THEN
|
||||||
|
BEGIN
|
||||||
|
PL;
|
||||||
|
Prompt(PadRightInt(CurLine,4)+': ');
|
||||||
|
InLi(S);
|
||||||
|
Cur^.S := S;
|
||||||
|
END;
|
||||||
|
'Q' : Done := TRUE;
|
||||||
|
'S' : BEGIN
|
||||||
|
IF (NOT AllRead) THEN
|
||||||
|
BEGIN
|
||||||
|
UserColor(5);
|
||||||
|
Prompt('Not all of file read. ');
|
||||||
|
AllRead := PYNQ('Save anyway? ',0,FALSE);
|
||||||
|
END;
|
||||||
|
IF (AllRead) THEN
|
||||||
|
BEGIN
|
||||||
|
Done := TRUE;
|
||||||
|
Print('Saving ...');
|
||||||
|
SysOpLog('Saved "'+FSpec+'"');
|
||||||
|
ReWrite(Fil);
|
||||||
|
I := 0;
|
||||||
|
Cur := Top;
|
||||||
|
WHILE (Cur <> NIL) DO
|
||||||
|
BEGIN
|
||||||
|
WriteLn(Fil,Cur^.S);
|
||||||
|
Cur := Cur^.Next;
|
||||||
|
Dec(I);
|
||||||
|
END;
|
||||||
|
|
||||||
|
IF (I = 0) THEN
|
||||||
|
WriteLn(Fil);
|
||||||
|
|
||||||
|
Close(Fil);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
'T' : BEGIN
|
||||||
|
Cur := Top;
|
||||||
|
CurLine := 1;
|
||||||
|
PL;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL ((Done) OR (HangUp));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Release(TopHeap);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
// REETODO Likely going to leak memory right about now
|
||||||
|
{$ENDIF}
|
||||||
|
PrintingFile := FALSE;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
|
|
@ -0,0 +1,553 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||||||
|
|
||||||
|
UNIT SysOp5;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
PROCEDURE HistoryEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common,
|
||||||
|
TimeFunc;
|
||||||
|
|
||||||
|
PROCEDURE HistoryEditor;
|
||||||
|
CONST
|
||||||
|
MaxHistoryDates = 32767;
|
||||||
|
VAR
|
||||||
|
HistoryFile: FILE OF HistoryRecordType;
|
||||||
|
History: HistoryRecordType;
|
||||||
|
TempHistory: HistoryRecordType;
|
||||||
|
Cmd: Char;
|
||||||
|
RecNumToList,
|
||||||
|
NumHistoryDates: Integer;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
PROCEDURE InitHistoryVars(VAR History: HistoryRecordType);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FillChar(History,SizeOf(History),0);
|
||||||
|
WITH History DO
|
||||||
|
BEGIN
|
||||||
|
Date := 0;
|
||||||
|
FOR Counter := 0 TO 20 DO
|
||||||
|
UserBaud[Counter] := 0;
|
||||||
|
Active := 0;
|
||||||
|
Callers := 0;
|
||||||
|
NewUsers := 0;
|
||||||
|
Posts := 0;
|
||||||
|
EMail := 0;
|
||||||
|
FeedBack := 0;
|
||||||
|
Errors := 0;
|
||||||
|
Uploads := 0;
|
||||||
|
Downloads := 0;
|
||||||
|
UK := 0;
|
||||||
|
Dk := 0;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE LocateHistoryDate(DisplayStr: AStr; TempHistory1: HistoryRecordType; VAR DateToLocate: Str10;
|
||||||
|
VAR RecNum1: SmallInt; ShowErr,Searching: Boolean);
|
||||||
|
VAR
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
RecNum1 := -1;
|
||||||
|
InputFormatted(DisplayStr,DateToLocate,'##-##-####',TRUE);
|
||||||
|
IF (DateToLocate <> '') AND (Length(DateToLocate) = 10) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (Searching) THEN
|
||||||
|
Reset(HistoryFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= FileSize(HistoryFile)) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,(RecNum - 1));
|
||||||
|
Read(HistoryFile,TempHistory1);
|
||||||
|
IF (PD2Date(TempHistory1.Date) = DateToLocate) THEN
|
||||||
|
RecNum1 := RecNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
IF (Searching) THEN
|
||||||
|
Close(HistoryFile);
|
||||||
|
IF (ShowErr) AND (RecNum1 = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The date entered is invalid!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteHistoryRecord(TempHistory1: HistoryRecordType; RecNumToDelete: SmallInt);
|
||||||
|
VAR
|
||||||
|
DateToDelete: Str10;
|
||||||
|
RecNum: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (NumHistoryDates = 0) THEN
|
||||||
|
Messages(4,0,'history dates')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LocateHistoryDate('%LFHistory date to delete: ',TempHistory1,DateToDelete,RecNumToDelete,TRUE,TRUE);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumHistoryDates) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(HistoryFile);
|
||||||
|
Seek(HistoryFile,(RecNumToDelete - 1));
|
||||||
|
Read(HistoryFile,TempHistory1);
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (PD2Date(TempHistory1.Date) = DateStr) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The current history date can not be deleted!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LFHistory date: ^5'+PD2Date(TempHistory1.Date));
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting history record ...');
|
||||||
|
Dec(RecNumToDelete);
|
||||||
|
Reset(HistoryFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(HistoryFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(HistoryFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,(RecNum + 1));
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
Seek(HistoryFile,RecNum);
|
||||||
|
Write(HistoryFile,History);
|
||||||
|
END;
|
||||||
|
Seek(HistoryFile,(FileSize(HistoryFile) - 1));
|
||||||
|
Truncate(HistoryFile);
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
Dec(NumHistoryDates);
|
||||||
|
SysOpLog('* Deleted history date: ^5'+Pd2Date(TempHistory1.Date));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE CheckHistoryRecord(History: HistoryRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||||||
|
VAR
|
||||||
|
Counter: Byte;
|
||||||
|
BEGIN
|
||||||
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||||||
|
CASE Counter OF
|
||||||
|
1 : ;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE EditHistoryRecord(TempHistory1: HistoryRecordType; VAR History: HistoryRecordType; VAR Cmd1: Char;
|
||||||
|
VAR RecNumToEdit,SaveRecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean);
|
||||||
|
VAR
|
||||||
|
CmdStr,
|
||||||
|
TempStr1: AStr;
|
||||||
|
DateToLocate: Str10;
|
||||||
|
RecNum: SmallInt;
|
||||||
|
Ok: Boolean;
|
||||||
|
BEGIN
|
||||||
|
WITH History DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (Editing) THEN
|
||||||
|
PrintACR('^5Editing history record #'+IntToStr((NumHistoryDates + 1) - RecNumToEdit)+
|
||||||
|
' of '+IntToStr(NumHistoryDates))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5Inserting history record #'+IntToStr((NumHistoryDates + 1) - RecNumToEdit)+
|
||||||
|
' of '+IntToStr(NumHistoryDates + 1));
|
||||||
|
NL;
|
||||||
|
IF (Callers > 0) THEN
|
||||||
|
TempStr1 := IntToStr(Active DIV Callers)
|
||||||
|
ELSE
|
||||||
|
TempStr1 := '0';
|
||||||
|
PrintACR('^1A. Date : ^5'+PD2Date(Date)+AOnOff(RecNumToEdit = NumHistoryDates,' (Today)',''));
|
||||||
|
PrintACR('^1B. Minutes Active: ^5'+FormatNumber(Active));
|
||||||
|
PrintACR('^1C. Calls : ^5'+FormatNumber(Callers));
|
||||||
|
PrintACR('^1D. Percent Active: ^5'+SQOutSp(CTP(Active,1440)));
|
||||||
|
PrintACR('^1E. New Users : ^5'+FormatNumber(NewUsers));
|
||||||
|
PrintACR('^1G. Time/User : ^5'+TempStr1);
|
||||||
|
PrintACR('^1H. Public Posts : ^5'+FormatNumber(Posts));
|
||||||
|
PrintACR('^1I. Private Posts : ^5'+FormatNumber(EMail));
|
||||||
|
PrintACR('^1K. SysOp FeedBack: ^5'+FormatNumber(FeedBack));
|
||||||
|
PrintACR('^1M. Errors : ^5'+FormatNumber(Errors));
|
||||||
|
PrintACR('^1N. Uploads : ^5'+FormatNumber(Uploads));
|
||||||
|
PrintACR('^1O. Upload K : ^5'+FormatNumber(UK));
|
||||||
|
PrintACR('^1P. DownLoads : ^5'+FormatNumber(DownLoads));
|
||||||
|
PrintACR('^1R. Download K : ^5'+FormatNumber(DK));
|
||||||
|
PrintACR('^1S. Baud Rates');
|
||||||
|
END;
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
CmdStr := 'ABCDEGHIKMNOPRS'
|
||||||
|
ELSE
|
||||||
|
CmdStr := 'ABCDEGHIKMNOPRS[]FJL';
|
||||||
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'A' : IF (PD2Date(Date) = DateStr) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The current history date can not be changed!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
LocateHistoryDate('%LFNew history date: ',TempHistory1,DateToLocate,RecNum,FALSE,FALSE);
|
||||||
|
IF (DateToLocate <> '') AND (NOT (DateToLocate = PD2Date(History.Date))) THEN
|
||||||
|
BEGIN
|
||||||
|
IF (RecNum <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The date entered is invalid!^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (DayNum(DateToLocate) > DayNum(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7The date can not be changed to a future date!^1');
|
||||||
|
Ok := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (DateToLocate <> '') THEN
|
||||||
|
BEGIN
|
||||||
|
Date := Date2PD(DateToLocate);
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Ok) OR (HangUp);
|
||||||
|
END;
|
||||||
|
'B' : InputLongIntWC('%LFNew minutes active for this date',Active,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'C' : InputLongIntWC('%LFNew number of system callers for this date',Callers,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'D' : BEGIN
|
||||||
|
Print('%LF^7This is for internal use only.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
'E' : InputLongIntWC('%LFNew new user''s for this date',NewUsers,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'G' : BEGIN
|
||||||
|
Print('%LF^7This is for internal use only.');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END;
|
||||||
|
'H' : InputLongIntWC('%LFNew public message post''s this date',Posts,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'I' : InputLongIntWC('%LFNew private message post''s this date',Email,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'K' : InputLongIntWC('%LFNew sysop feedback sent this date',FeedBack,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'M' : InputLongIntWC('%LFNew system error''s this date',Errors,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'N' : InputLongIntWC('%LFNew user upload''s for this date',Uploads,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'O' : InputLongIntWC('%LFNew user kbytes uploaded this date',UK,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'P' : InputLongIntWC('%LFNew user download''s this date',Downloads,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'R' : InputLongIntWC('%LFNew user kbytes downloaded this date',DK,
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
'S' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
Print('%CL^5User Baud Rates');
|
||||||
|
Print('%LF'+PadLeftStr('^1A. Telnet/Other: ^5'+FormatNumber(UserBaud[0]),32)+
|
||||||
|
'^1B. 300 Baud : ^5'+IntToStr(UserBaud[1]));
|
||||||
|
Print(PadLeftStr('^1C. 600 Baud : ^5'+IntToStr(UserBaud[2]),32)+
|
||||||
|
'^1D. 1200 Baud : ^5'+FormatNumber(UserBaud[3]));
|
||||||
|
Print(PadLeftStr('^1E. 2400 Baud : ^5'+FormatNumber(UserBaud[4]),32)+
|
||||||
|
'^1F. 4800 Baud : ^5'+FormatNumber(UserBaud[5]));
|
||||||
|
Print(PadLeftStr('^1G. 7200 Baud : ^5'+FormatNumber(UserBaud[6]),32)+
|
||||||
|
'^1H. 9600 Baud : ^5'+FormatNumber(UserBaud[7]));
|
||||||
|
Print(PadLeftStr('^1I. 12000 Baud : ^5'+FormatNumber(UserBaud[8]),32)+
|
||||||
|
'^1J. 14400 Baud : ^5'+FormatNumber(UserBaud[9]));
|
||||||
|
Print(PadLeftStr('^1K. 16800 Baud : ^5'+FormatNumber(UserBaud[10]),32)+
|
||||||
|
'^1L. 19200 Baud : ^5'+FormatNumber(UserBaud[11]));
|
||||||
|
Print(PadLeftStr('^1M. 21600 Baud : ^5'+FormatNumber(UserBaud[12]),32)+
|
||||||
|
'^1N. 24000 Baud : ^5'+FormatNumber(UserBaud[13]));
|
||||||
|
Print(PadLeftStr('^1O. 26400 Baud : ^5'+FormatNumber(UserBaud[14]),32)+
|
||||||
|
'^1P. 28800 Baud : ^5'+FormatNumber(UserBaud[15]));
|
||||||
|
Print(PadLeftStr('^1Q. 31200 Baud : ^5'+FormatNumber(UserBaud[16]),32)+
|
||||||
|
'^1R. 33600 Baud : ^5'+FormatNumber(UserBaud[17]));
|
||||||
|
Print(PadLeftStr('^1S. 38400 Baud : ^5'+FormatNumber(UserBaud[18]),32)+
|
||||||
|
'^1T. 57600 Baud : ^5'+FormatNumber(UserBaud[19]));
|
||||||
|
Print(PadLeftStr('^1U. 115200 Baud : ^5'+FormatNumber(UserBaud[20]),32));
|
||||||
|
LOneK('%LFModify menu [^5A^4-^5U^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKLMNOPQRSTU',TRUE,TRUE);
|
||||||
|
IF (Cmd1 <> ^M) THEN
|
||||||
|
InputLongIntWC('%LFNew value',UserBaud[Ord(Cmd1) - 65],
|
||||||
|
[DisplayValue,NumbersOnly],0,2147483647,Changed);
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToEdit > 1) THEN
|
||||||
|
Dec(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'[' : IF (RecNumToEdit < NumHistoryDates) THEN
|
||||||
|
Inc(RecNumToEdit)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToEdit <> NumHistoryDates) THEN
|
||||||
|
RecNumToEdit := NumHistoryDates
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
RecNumToEdit := -1;
|
||||||
|
InputIntegerWOC('%LFJump to entry?',RecNumToEdit,[NumbersOnly],1,NumHistoryDates);
|
||||||
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumHistoryDates) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
Cmd1 := #0;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
RecNumToEdit := ((NumHistoryDates - RecNumToEdit) + 1);
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToEdit <> 1) THEN
|
||||||
|
RecNumToEdit := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||||||
|
Print('^3A^1-^3E^1,^3G^1-^3I^1,^3K^1,^3M^1-^3P^1,^3R^1-^3S^1:Modify item');
|
||||||
|
IF (NOT Editing) THEN
|
||||||
|
LCmds(20,3,'Quit and save','')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||||||
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertHistoryRecord(TempHistory1: HistoryRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt);
|
||||||
|
VAR
|
||||||
|
DateToInsert,
|
||||||
|
DateToInsertBefore: Str10;
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
SaveRecNumToEdit: SmallInt;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumHistoryDates = MaxHistoryDates) THEN
|
||||||
|
Messages(5,MaxHistoryDates,'history dates')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LocateHistoryDate('%LFHistory date to insert before: ',TempHistory1,DateToInsertBefore,RecNumToInsertBefore,TRUE,TRUE);
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumHistoryDates + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
LocateHistoryDate('%LFNew history date to insert: ',TempHistory1,DateToInsert,RecNum1,FALSE,TRUE);
|
||||||
|
IF (RecNum1 <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Duplicate date entered!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE IF (DayNum(DateToInsert) > DayNum(DateStr)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF^7Future dates can not be entered!^1');
|
||||||
|
PauseScr(FALSE);
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
IF (DayNum(DateToInsert) > DayNum(DateToInsertBefore)) THEN
|
||||||
|
Inc(RecNumToInsertBefore);
|
||||||
|
Reset(HistoryFile);
|
||||||
|
InitHistoryVars(TempHistory1);
|
||||||
|
TempHistory1.Date := Date2PD(DateToInsert);
|
||||||
|
IF (RecNumToInsertBefore = 1) THEN
|
||||||
|
RecNum1 := 0
|
||||||
|
ELSE IF (RecNumToInsertBefore = NumHistoryDates) THEN
|
||||||
|
RecNum1 := (RecNumToInsertBefore - 1)
|
||||||
|
ELSE
|
||||||
|
RecNum1 := RecNumToInsertBefore;
|
||||||
|
REPEAT
|
||||||
|
OK := TRUE;
|
||||||
|
EditHistoryRecord(TempHistory1,TempHistory1,Cmd1,RecNum1,SaveRecNumToEdit,Changed,FALSE);
|
||||||
|
CheckHistoryRecord(TempHistory1,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
IF (NOT PYNQ('%LFContinue inserting history date? ',0,TRUE)) THEN
|
||||||
|
Abort := TRUE;
|
||||||
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||||||
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting history record ...');
|
||||||
|
Seek(HistoryFile,FileSize(HistoryFile));
|
||||||
|
Write(HistoryFile,History);
|
||||||
|
Dec(RecNumToInsertBefore);
|
||||||
|
FOR RecNum := ((FileSize(HistoryFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,RecNum);
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
Seek(HistoryFile,(RecNum + 1));
|
||||||
|
Write(HistoryFile,History);
|
||||||
|
END;
|
||||||
|
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,RecNum);
|
||||||
|
Write(HistoryFile,TempHistory1);
|
||||||
|
Inc(NumHistoryDates);
|
||||||
|
SysOpLog('* Inserted history date: ^5'+PD2Date(TempHistory1.Date));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyHistoryRecord(TempHistory1: HistoryRecordType; Cmd1: Char; RecNumToEdit: SmallInt);
|
||||||
|
VAR
|
||||||
|
DateToEdit: Str10;
|
||||||
|
SaveRecNumToEdit: SmallInt;
|
||||||
|
Ok,
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumHistoryDates = 0) THEN
|
||||||
|
Messages(4,0,'history dates')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
LocateHistoryDate('%LFHistory date to modify: ',TempHistory1,DateToEdit,RecNumToEdit,TRUE,TRUE);
|
||||||
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumHistoryDates) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToEdit := -1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(HistoryFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,(RecNumToEdit - 1));
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
SaveRecNumToEdit := RecNumToEdit;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
REPEAT
|
||||||
|
Ok := TRUE;
|
||||||
|
EditHistoryRecord(TempHistory1,History,Cmd1,RecNumToEdit,SaveRecNumToEdit,Changed,TRUE);
|
||||||
|
CheckHistoryRecord(History,1,1,Ok);
|
||||||
|
IF (NOT OK) THEN
|
||||||
|
BEGIN
|
||||||
|
PauseScr(FALSE);
|
||||||
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||||||
|
RecNumToEdit := SaveRecNumToEdit;
|
||||||
|
END;
|
||||||
|
UNTIL (OK) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,(SaveRecNumToEdit - 1));
|
||||||
|
Write(HistoryFile,History);
|
||||||
|
Changed := FALSE;
|
||||||
|
SysOpLog('* Modified history date: ^5'+PD2Date(History.Date));
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ListHistoryDates(VAR RecNumToList1: Integer);
|
||||||
|
VAR
|
||||||
|
TempStr: AStr;
|
||||||
|
NumDone: Integer;
|
||||||
|
BEGIN
|
||||||
|
IF (RecNumToList1 < 1) OR (RecNumToList1 > NumHistoryDates) THEN
|
||||||
|
RecNumToList1 := NumHistoryDates;
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^3 ^4:^3Mins ^4:^3 ^4:^3 ^4:^3#New^4:^3Tim/^4:^3Pub ^4:^3Priv^4:^3Feed^4:^3 ^4:^3'+
|
||||||
|
' ^4:^3 ^4:^3 ^4:^3');
|
||||||
|
PrintACR('^3 Date ^4:^3Activ^4:^3Call^4:^3%Activ^4:^3User^4:^3User^4:^3Post^4:^3Post'+
|
||||||
|
'^4:^3Back^4:^3Errs^4:^3#ULs^4:^3UL-k ^4:^3#DLs^4:^3DL-k');
|
||||||
|
PrintACR('^4========:=====:====:======:====:====:====:====:====:====:====:=====:====:=====');
|
||||||
|
Reset(HistoryFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 6)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumHistoryDates)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(HistoryFile,(RecNumToList1 - 1));
|
||||||
|
Read(HistoryFile,History);
|
||||||
|
WITH History DO
|
||||||
|
BEGIN
|
||||||
|
IF (Callers > 0) THEN
|
||||||
|
TempStr := PadRightInt(Active DIV Callers,4)
|
||||||
|
ELSE
|
||||||
|
TempStr := ' ';
|
||||||
|
PrintACR('^1'+AOnOff((RecNumToList1 = NumHistoryDates),'Today''s ',ToDate8(PD2Date(Date)))+
|
||||||
|
' '+PadRightInt(Active,5)+
|
||||||
|
' '+PadRightInt(Callers,4)+
|
||||||
|
' '+CTP(Active,1440)+
|
||||||
|
' '+PadRightInt(NewUsers,4)+
|
||||||
|
' '+TempStr+
|
||||||
|
' '+PadRightInt(Posts,4)+
|
||||||
|
' '+PadRightInt(EMail,4)+
|
||||||
|
' '+PadRightInt(FeedBack,4)+
|
||||||
|
' '+PadRightInt(Errors,4)+
|
||||||
|
' '+PadRightInt(Uploads,4)+
|
||||||
|
' '+PadRightInt(UK,5)+
|
||||||
|
' '+PadRightInt(DownLoads,4)+
|
||||||
|
' '+PadRightInt(DK,5));
|
||||||
|
END;
|
||||||
|
Dec(RecNumToList1);
|
||||||
|
Inc(NumDone);
|
||||||
|
END;
|
||||||
|
Close(HistoryFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
IF (NumHistoryDates = 0) THEN
|
||||||
|
Print('*** No history dates defined ***');
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
Assign(HistoryFile,General.DataPath+'HISTORY.DAT');
|
||||||
|
Reset(HistoryFile);
|
||||||
|
NumHistoryDates := FileSize(HistoryFile);
|
||||||
|
Close(HistoryFile);
|
||||||
|
RecNumToList := NumHistoryDates;
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
ListHistoryDates(RecNumToList);
|
||||||
|
LOneK('%LFHistory editor [^5?^4=^5Help^4]: ',Cmd,'QDIM?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
^M : IF (RecNumToList < 1) OR (RecNumToList > NumHistoryDates) THEN
|
||||||
|
RecNumToList := NumHistoryDates;
|
||||||
|
'D' : DeleteHistoryRecord(TempHistory,RecNumToList);
|
||||||
|
'I' : InsertHistoryRecord(TempHistory,Cmd,RecNumToList);
|
||||||
|
'M' : ModifyHistoryRecord(TempHistory,Cmd,RecNumToList);
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||||||
|
Print('^1(^3?^1)Help/First history date');
|
||||||
|
LCmds(20,3,'Delete history date','Insert history date');
|
||||||
|
LCmds(20,3,'Modify history date','Quit');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (Cmd <> ^M) THEN
|
||||||
|
RecNumToList := NumHistoryDates;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,665 @@
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$I DEFINES.INC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$A+,B+,D+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
|
||||||
|
UNIT SysOp7;
|
||||||
|
|
||||||
|
INTERFACE
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common;
|
||||||
|
|
||||||
|
PROCEDURE FindMenu(DisplayStr: AStr;
|
||||||
|
VAR MenuNum: Byte;
|
||||||
|
LowMenuNum,
|
||||||
|
HighMenuNum: Byte;
|
||||||
|
VAR Changed: Boolean);
|
||||||
|
PROCEDURE MenuEditor;
|
||||||
|
|
||||||
|
IMPLEMENTATION
|
||||||
|
|
||||||
|
USES
|
||||||
|
Common5,
|
||||||
|
Menus2,
|
||||||
|
SysOp7M;
|
||||||
|
|
||||||
|
PROCEDURE DisplayMenus(VAR RecNumToList1: Integer; DisplayListNum: Boolean);
|
||||||
|
VAR
|
||||||
|
NumDone: Byte;
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
AllowContinue := TRUE;
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
CLS;
|
||||||
|
IF (DisplayListNum) THEN
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^0###^4:^3Menu #^4:^3Menu name');
|
||||||
|
PrintACR('^4===:======:====================================================================');
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
PrintACR('^0Menu #^4:^3Menu name');
|
||||||
|
PrintACR('^4======:====================================================================');
|
||||||
|
END;
|
||||||
|
Reset(MenuFile);
|
||||||
|
NumDone := 0;
|
||||||
|
WHILE (NumDone < (PageLength - 7)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumMenus)
|
||||||
|
AND (NOT Abort) AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[RecNumToList1]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
WITH MenuR DO
|
||||||
|
BEGIN
|
||||||
|
IF (DisplayListNum) THEN
|
||||||
|
PrintACR('^0'+PadRightInt(RecNumToList1,3)+
|
||||||
|
' ^5'+PadRightInt(MenuNum,6)+
|
||||||
|
' ^3'+PadLeftStr(LDesc[1],68))
|
||||||
|
ELSE
|
||||||
|
PrintACR('^5'+PadRightInt(MenuNum,6)+
|
||||||
|
' ^3'+PadLeftStr(LDesc[1],68));
|
||||||
|
END;
|
||||||
|
Inc(RecNumToList1);
|
||||||
|
Inc(NumDone);
|
||||||
|
END;
|
||||||
|
Close(MenuFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
AllowContinue := FALSE;
|
||||||
|
IF (NumMenus = 0) THEN
|
||||||
|
Print('*** No menus defined ***');
|
||||||
|
IF (DisplayListNum) THEN
|
||||||
|
PrintACR('%LF^1[Users start at menu number: ^5'+IntToStr(General.AllStartMenu)+'^1]');
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE FindMenu(DisplayStr: AStr;
|
||||||
|
VAR MenuNum: Byte;
|
||||||
|
LowMenuNum,
|
||||||
|
HighMenuNum: Byte;
|
||||||
|
VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempMenuR: MenuRec;
|
||||||
|
InputStr: AStr;
|
||||||
|
SaveMenuNum: Byte;
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
RecNumToList: Integer;
|
||||||
|
BEGIN
|
||||||
|
SaveMenuNum := MenuNum;
|
||||||
|
RecNumToList := 1;
|
||||||
|
InputStr := '?';
|
||||||
|
REPEAT
|
||||||
|
IF (InputStr = '?') THEN
|
||||||
|
DisplayMenus(RecNumToList,FALSE);
|
||||||
|
Prt(DisplayStr+' (^5'+IntToStr(LowMenuNum)+'^4-^5'+IntToStr(HighMenuNum)+'^4)'+
|
||||||
|
' [^5?^4=^5First^4,^5<CR>^4=^5Next^4,^5Q^4=^5Quit^4): ');
|
||||||
|
MPL(Length(IntToStr(NumMenus)));
|
||||||
|
ScanInput(InputStr,'Q?'^M);
|
||||||
|
IF (InputStr = '-') THEN
|
||||||
|
InputStr := 'Q';
|
||||||
|
IF (InputStr <> 'Q') THEN
|
||||||
|
BEGIN
|
||||||
|
IF (InputStr = ^M) THEN
|
||||||
|
BEGIN
|
||||||
|
InputStr := '?';
|
||||||
|
IF (RecNumToList < 1) OR (RecNumToList > NumMenus) THEN
|
||||||
|
RecNumToList := 1
|
||||||
|
END
|
||||||
|
ELSE IF (InputStr = '?') THEN
|
||||||
|
RecNumToList := 1
|
||||||
|
ELSE IF (StrToInt(InputStr) < LowMenuNum) OR (StrToInt(InputStr) > HighMenuNum) THEN
|
||||||
|
Print('%LF^7The range must be from '+IntToStr(LowMenuNum)+' to '+IntToStr(HighMenuNum)+'!^1')
|
||||||
|
ELSE IF (InputStr = '0') AND (LowMenuNum = 0) THEN
|
||||||
|
BEGIN
|
||||||
|
MenuNum := StrToInt(InputStr);
|
||||||
|
InputStr := 'Q';
|
||||||
|
Changed := TRUE;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNum1 := -1;
|
||||||
|
RecNum := 1;
|
||||||
|
|
||||||
|
Reset(MenuFile);
|
||||||
|
|
||||||
|
WHILE (RecNum <= NumMenus) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[RecNum]);
|
||||||
|
Read(MenuFile,TempMenuR);
|
||||||
|
IF (StrToInt(InputStr) = TempMenuR.MenuNum) THEN
|
||||||
|
RecNum1 := TempMenuR.MenuNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
|
||||||
|
Close(MenuFile);
|
||||||
|
|
||||||
|
IF (RecNum1 = -1) THEN
|
||||||
|
BEGIN
|
||||||
|
RGNoteStr(2,FALSE);
|
||||||
|
MenuNum := SaveMenuNum;
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
MenuNum := StrToInt(InputStr);
|
||||||
|
InputStr := 'Q';
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (InputStr = 'Q') OR (HangUp);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE MenuEditor;
|
||||||
|
VAR
|
||||||
|
Cmd: Char;
|
||||||
|
SaveCurMenu: Byte;
|
||||||
|
RecNumToList: Integer;
|
||||||
|
SaveTempPause: Boolean;
|
||||||
|
|
||||||
|
FUNCTION DisplayMenuFlags(MenuFlags: MenuFlagSet; C1,C2: Char): AStr;
|
||||||
|
VAR
|
||||||
|
MenuFlagT: MenuFlagType;
|
||||||
|
TempS: AStr;
|
||||||
|
BEGIN
|
||||||
|
TempS := '';
|
||||||
|
FOR MenuFlagT := ClrScrBefore TO NoGlobalUsed DO
|
||||||
|
IF (MenuFlagT IN MenuFlags) THEN
|
||||||
|
TempS := TempS + '^'+C1+Copy('CDTNPAF12345',(Ord(MenuFlagT) + 1),1)
|
||||||
|
ELSE
|
||||||
|
TempS := TempS + '^'+C2+'-';
|
||||||
|
DisplayMenuFlags := TempS;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleMenuFlag(MenuFlagT: MenuFlagType; VAR MenuFlags: MenuFlagSet);
|
||||||
|
BEGIN
|
||||||
|
IF (MenuFlagT IN MenuFlags) THEN
|
||||||
|
Exclude(MenuFlags,MenuFlagT)
|
||||||
|
ELSE
|
||||||
|
Include(MenuFlags,MenuFlagT);
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ToggleMenuFlags(C: Char; VAR MenuFlags: MenuFlagSet; VAR Changed: Boolean);
|
||||||
|
VAR
|
||||||
|
TempMenuFlags: MenuFlagSet;
|
||||||
|
BEGIN
|
||||||
|
TempMenuFlags := MenuFlags;
|
||||||
|
CASE C OF
|
||||||
|
'C' : ToggleMenuFlag(ClrScrBefore,MenuFlags);
|
||||||
|
'D' : ToggleMenuFlag(DontCenter,MenuFlags);
|
||||||
|
'T' : ToggleMenuFlag(NoMenuTitle,MenuFlags);
|
||||||
|
'N' : ToggleMenuFlag(NoMenuPrompt,MenuFlags);
|
||||||
|
'P' : ToggleMenuFlag(ForcePause,MenuFlags);
|
||||||
|
'A' : ToggleMenuFlag(AutoTime,MenuFlags);
|
||||||
|
'F' : ToggleMenuFlag(ForceLine,MenuFlags);
|
||||||
|
'1' : ToggleMenuFlag(NoGenericAnsi,MenuFlags);
|
||||||
|
'2' : ToggleMenuFlag(NoGenericAvatar,MenuFlags);
|
||||||
|
'3' : ToggleMenuFlag(NoGenericRIP,MenuFlags);
|
||||||
|
'4' : ToggleMenuFlag(NoGlobalDisplayed,MenuFlags);
|
||||||
|
'5' : ToggleMenuFlag(NoGlobalUsed,MenuFlags);
|
||||||
|
END;
|
||||||
|
IF (MenuFlags <> TempMenuFlags) THEN
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InitMenuVars(VAR MenuR: MenuRec);
|
||||||
|
BEGIN
|
||||||
|
FillChar(MenuR,SizeOf(MenuR),0);
|
||||||
|
WITH MenuR DO
|
||||||
|
BEGIN
|
||||||
|
LDesc[1] := '<< New Menu >>';
|
||||||
|
LDesc[2] := '';
|
||||||
|
LDesc[3] := '';
|
||||||
|
ACS := '';
|
||||||
|
NodeActivityDesc := '';
|
||||||
|
Menu := TRUE;
|
||||||
|
MenuFlags := [AutoTime];
|
||||||
|
LongMenu := '';
|
||||||
|
MenuNum := 0;
|
||||||
|
MenuPrompt := 'Command? ';
|
||||||
|
Password := '';
|
||||||
|
FallBack := 0;
|
||||||
|
Directive := '';
|
||||||
|
ForceHelpLevel := 0;
|
||||||
|
GenCols := 4;
|
||||||
|
GCol[1] := 4;
|
||||||
|
GCol[2] := 3;
|
||||||
|
GCol[3] := 5;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE DeleteMenu;
|
||||||
|
VAR
|
||||||
|
RecNumToDelete,
|
||||||
|
RecNum: SmallInt;
|
||||||
|
DeleteOk: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumMenus = 0) THEN
|
||||||
|
Messages(4,0,'menus')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToDelete := -1;
|
||||||
|
InputIntegerWOC('%LFMenu number to delete?',RecNumToDelete,[NumbersOnly],1,NumMenus);
|
||||||
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumMenus) THEN
|
||||||
|
BEGIN
|
||||||
|
Reset(MenuFile);
|
||||||
|
Seek(MenuFile,MenuRecNumArray[RecNumToDelete]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
Close(MenuFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
DeleteOK := TRUE;
|
||||||
|
IF (MenuR.MenuNum = General.AllStartMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFYou can not delete the menu new users start at.');
|
||||||
|
DeleteOK := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (MenuR.MenuNum = General.NewUserInformationMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFYou can not delete the new user information menu.');
|
||||||
|
DeleteOK := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (MenuR.MenuNum = General.FileListingMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFYou can not delete the file listing menu.');
|
||||||
|
DeleteOK := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (MenuR.MenuNum = General.MessageReadMenu) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFYou can not delete the message read menu.');
|
||||||
|
DeleteOK := FALSE;
|
||||||
|
END
|
||||||
|
ELSE IF (CmdNumArray[RecNumToDelete] <> 0) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LFThis menu is not empty.');
|
||||||
|
DeleteOK := FALSE;
|
||||||
|
END;
|
||||||
|
IF (NOT DeleteOK) THEN
|
||||||
|
PauseScr(FALSE)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Print('%LFMenu: ^5'+MenuR.LDesc[1]);
|
||||||
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Deleting menu record ...');
|
||||||
|
SysOpLog('* Deleted menu: ^5'+MenuR.LDesc[1]);
|
||||||
|
RecNumToDelete := MenuRecNumArray[RecNumToDelete]; { Convert To Real Record Number }
|
||||||
|
Reset(MenuFile);
|
||||||
|
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(MenuFile) - 2)) THEN
|
||||||
|
FOR RecNum := RecNumToDelete TO (FileSize(MenuFile) - 2) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,(RecNum + 1));
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
Seek(MenuFile,RecNum);
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
END;
|
||||||
|
Seek(MenuFile,(FileSize(MenuFile) - 1));
|
||||||
|
Truncate(MenuFile);
|
||||||
|
LoadMenuPointers;
|
||||||
|
Close(MenuFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE InsertMenu;
|
||||||
|
VAR
|
||||||
|
RecNumToInsertBefore,
|
||||||
|
NewMenuNum,
|
||||||
|
RecNum: SmallInt;
|
||||||
|
BEGIN
|
||||||
|
IF (NumMenus = MaxMenus) THEN
|
||||||
|
Messages(5,MaxMenus,'menus')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToInsertBefore := -1;
|
||||||
|
InputIntegerWOC('%LFMenu number to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumMenus + 1));
|
||||||
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumMenus + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
Print('%LF[> Inserting menu record ...');
|
||||||
|
SysOpLog('* Inserted 1 menu.');
|
||||||
|
IF (RecNumToInsertBefore = (NumMenus + 1)) THEN
|
||||||
|
MenuRecNumArray[RecNumToInsertBefore] := (MenuRecNumArray[NumMenus] + CmdNumArray[NumMenus] + 1);
|
||||||
|
RecNumToInsertBefore := MenuRecNumArray[RecNumToInsertBefore]; {Convert To Real Record Number }
|
||||||
|
NewMenuNum := 0;
|
||||||
|
Reset(MenuFile);
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (RecNum <= NumMenus) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[RecNum]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
IF (MenuR.MenuNum > NewMenuNum) THEN
|
||||||
|
NewMenuNum := MenuR.MenuNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
FOR RecNum := 1 TO 1 DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,FileSize(MenuFile));
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
END;
|
||||||
|
FOR RecNum := ((FileSize(MenuFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,RecNum);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
Seek(MenuFile,(RecNum + 1));
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
END;
|
||||||
|
InitMenuVars(MenuR);
|
||||||
|
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,RecNum);
|
||||||
|
MenuR.MenuNum := (NewMenuNum + 1);
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
END;
|
||||||
|
LoadMenuPointers;
|
||||||
|
Close(MenuFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
PROCEDURE ModifyMenu;
|
||||||
|
VAR
|
||||||
|
TempMenuR: MenuRec;
|
||||||
|
Cmd1: Char;
|
||||||
|
SaveMenuNum: Byte;
|
||||||
|
RecNum,
|
||||||
|
RecNum1,
|
||||||
|
RecNumToModify,
|
||||||
|
SaveRecNumToModify: SmallInt;
|
||||||
|
Changed: Boolean;
|
||||||
|
BEGIN
|
||||||
|
IF (NumMenus = 0) THEN
|
||||||
|
Messages(4,0,'menus')
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
RecNumToModify := -1;
|
||||||
|
InputIntegerWOC('%LFMenu number to modify?',RecNumToModify,[NumbersOnly],1,NumMenus);
|
||||||
|
IF (RecNumToModify >= 1) AND (RecNumToModify <= NumMenus) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveRecNumToModify := -1;
|
||||||
|
Cmd1 := #0;
|
||||||
|
Reset(MenuFile);
|
||||||
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||||||
|
BEGIN
|
||||||
|
IF (SaveRecNumToModify <> RecNumToModify) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[RecNumToModify]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
SaveRecNumToModify := RecNumToModify;
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
WITH MenuR DO
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd1 <> '?') THEN
|
||||||
|
BEGIN
|
||||||
|
Abort := FALSE;
|
||||||
|
Next := FALSE;
|
||||||
|
MCIAllowed := FALSE;
|
||||||
|
CLS;
|
||||||
|
PrintACR('^5Menu #'+IntToStr(RecNumToModify)+' of '+IntToStr(NumMenus));
|
||||||
|
NL;
|
||||||
|
PrintACR('^11. Menu number : ^5'+IntToStr(MenuNum));
|
||||||
|
PrintACR('^12. Menu titles : ^5'+LDesc[1]);
|
||||||
|
IF (LDesc[2] <> '') THEN
|
||||||
|
PrintACR('^1 Menu title #2 : ^5'+LDesc[2]);
|
||||||
|
IF (LDesc[3] <> '') THEN
|
||||||
|
PrintACR('^1 Menu title #3 : ^5'+LDesc[3]);
|
||||||
|
PrintACR('^13. Help files : ^5'+AOnOff((Directive = ''),'*Generic*',Directive)+'/'+
|
||||||
|
AOnOff((LongMenu = ''),'*Generic*',LongMenu));
|
||||||
|
PrintACR('^14. Menu prompt : ^5'+MenuPrompt);
|
||||||
|
PrintACR('^15. ACS required : ^5"'+ACS+'"');
|
||||||
|
PrintACR('^16. Password : ^5'+AOnOff((Password = ''),'*None*',Password));
|
||||||
|
PrintACR('^17. Fallback menu : ^5'+IntToStr(FallBack));
|
||||||
|
PrintACR('^18. Forced ?-level: ^5'+AOnOff((ForceHelpLevel=0),'*None*',IntToStr(ForceHelpLevel)));
|
||||||
|
PrintACR('^19. Generic info : ^5'+IntToStr(GenCols)+' cols - '+IntToStr(GCol[1])+'/'+IntToStr(GCol[2])+
|
||||||
|
'/'+IntToStr(GCol[3]));
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
PrintACR('^1N. Node activity : ^5'+NodeActivityDesc);
|
||||||
|
PrintACR('^1T. Flags : ^5'+DisplayMenuFlags(MenuFlags,'5','1'));
|
||||||
|
MCIAllowed := TRUE;
|
||||||
|
Print('%LF^1[Commands on this menu: ^5'+IntToStr(CmdNumArray[RecNumToModify])+'^1]');
|
||||||
|
IF (NumMenus = 0) THEN
|
||||||
|
Print('*** No menus defined ***');
|
||||||
|
END;
|
||||||
|
IF (General.MultiNode) THEN
|
||||||
|
LOneK('%LFModify menu [^5C^4=^5Command Editor^4,^5?^4=^5Help^4]: ',Cmd1,'Q123456789CNT[]FJL?'^M,TRUE,TRUE)
|
||||||
|
ELSE
|
||||||
|
LOneK('%LFModify menu [^5C^4=^5Command Editor^4,^5?^4=^5Help^4]: ',Cmd1,'Q123456789CT[]FJL?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'1' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
SaveMenuNum := MenuNum;
|
||||||
|
RecNum1 := -1;
|
||||||
|
InputByteWC('%LFNew menu number',MenuNum,[DisplayValue,NumbersOnly],1,(NumMenus + 1),Changed);
|
||||||
|
IF (MenuNum <> SaveMenuNum) AND (MenuNum >= 1) AND (MenuNum <= (NumMenus + 1)) THEN
|
||||||
|
BEGIN
|
||||||
|
RecNum := 1;
|
||||||
|
WHILE (Recnum <= NumMenus) AND (RecNum1 = -1) DO
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[RecNum]);
|
||||||
|
Read(MenuFile,TempMenuR);
|
||||||
|
IF (MenuNum = TempMenuR.MenuNum) THEN
|
||||||
|
RecNum1 := TempMenuR.MenuNum;
|
||||||
|
Inc(RecNum);
|
||||||
|
END;
|
||||||
|
IF (RecNum1 <> -1) THEN
|
||||||
|
BEGIN
|
||||||
|
NL;
|
||||||
|
Print('^7Duplicate menu number!^1');
|
||||||
|
MenuNum := SaveMenuNum;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (RecNum1 = -1) OR (HangUp);
|
||||||
|
Changed := TRUE;
|
||||||
|
END;
|
||||||
|
'2' : BEGIN
|
||||||
|
InputWNWC('%LFNew menu title #1: ',LDesc[1],
|
||||||
|
(SizeOf(LDesc[1]) - 1),Changed);
|
||||||
|
IF (LDesc[1] <> '') THEN
|
||||||
|
InputWNWC('New menu title #2: ',LDesc[2],
|
||||||
|
(SizeOf(LDesc[2]) - 1),Changed);
|
||||||
|
IF (LDesc[2] <> '') THEN
|
||||||
|
InputWNWC('New menu title #3: ',LDesc[3],
|
||||||
|
(SizeOf(LDesc[3]) - 1),Changed);
|
||||||
|
END;
|
||||||
|
'3' : BEGIN
|
||||||
|
InputWN1('%LFNew file displayed for help: ',Directive,(SizeOf(Directive) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
InputWN1('%LFNew file displayed for extended help: ',LongMenu,(SizeOf(LongMenu) - 1),
|
||||||
|
[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
END;
|
||||||
|
'4' : InputWNWC('%LFNew menu prompt: ',MenuPrompt,(SizeOf(MenuPrompt) - 1),Changed);
|
||||||
|
'5' : InputWN1('%LFNew menu ACS: ',ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed);
|
||||||
|
'6' : InputWN1('%LFNew password: ',Password,(SizeOf(Password) - 1),[InterActiveEdit,UpperOnly],Changed);
|
||||||
|
'7' : BEGIN
|
||||||
|
SaveMenuNum := FallBack;
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
Close(MenuFile);
|
||||||
|
FindMenu('%LFNew fallback menu (^50^4=^5None^4)',SaveMenuNum,0,NumMenus,Changed);
|
||||||
|
Reset(MenuFile);
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
IF (Changed) THEN
|
||||||
|
FallBack := SaveMenuNum;
|
||||||
|
END;
|
||||||
|
'8' : InputByteWC('%LFNew forced menu help-level (0=None)',ForceHelpLevel,
|
||||||
|
[DisplayValue,NumbersOnly],0,3,Changed);
|
||||||
|
'9' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
NL;
|
||||||
|
PrintACR('^1C. Generic columns : ^5'+IntToStr(GenCols));
|
||||||
|
PrintACR('^11. Bracket color : ^5'+IntToStr(GCol[1]));
|
||||||
|
PrintACR('^12. Command color : ^5'+IntToStr(GCol[2]));
|
||||||
|
PrintACR('^13. Description color: ^5'+IntToStr(GCol[3]));
|
||||||
|
PrintACR('^1S. Show menu');
|
||||||
|
LOneK('%LFSelect (CS,1-3,Q=Quit): ',Cmd1,'QCS123'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'S' : BEGIN
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
CurMenu := MenuR.MenuNum;
|
||||||
|
LoadMenu;
|
||||||
|
Reset(MenuFile);
|
||||||
|
GenericMenu(2);
|
||||||
|
NL;
|
||||||
|
PauseSCR(FALSE);
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Read(MenuFile,MenuR);
|
||||||
|
END;
|
||||||
|
'C' : InputByteWC('%LFNew number of generic columns',GenCols,
|
||||||
|
[DisplayValue,NumbersOnly],0,7,Changed);
|
||||||
|
'1' : InputByteWC('%LFNew bracket color',GCol[1],[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
'2' : InputByteWC('%LFNew command color',GCol[2],[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
'3' : InputByteWC('%LFNew description color',GCol[3],[DisplayValue,NumbersOnly],0,9,Changed);
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 IN ['Q',^M]) OR (HangUp);
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'C' : BEGIN
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
Changed := FALSE;
|
||||||
|
END;
|
||||||
|
CommandEditor(RecNumToModify,MenuNum,LDesc[1]);
|
||||||
|
SaveRecNumToModify := -1;
|
||||||
|
END;
|
||||||
|
'N' : IF (General.MultiNode) THEN
|
||||||
|
InputWNWC('%LF^1New node activity description:%LF^4: ',NodeActivityDesc,
|
||||||
|
(SizeOf(NodeActivityDesc) - 1),Changed);
|
||||||
|
'T' : BEGIN
|
||||||
|
REPEAT
|
||||||
|
LOneK('%LFToggle which flag? ('+DisplayMenuFlags(MenuFlags,'5','4')+'^4)'+
|
||||||
|
' [^5?^4=^5Help^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'CDTNPAF12345?',TRUE,TRUE);
|
||||||
|
CASE Cmd1 OF
|
||||||
|
'C','D','T','N','P','A','F','1'..'5' :
|
||||||
|
ToggleMenuFlags(Cmd1,MenuFlags,Changed);
|
||||||
|
'?' : BEGIN
|
||||||
|
NL;
|
||||||
|
LCmds(21,3,'Clear screen','Don''t center titles');
|
||||||
|
LCmds(21,3,'No menu prompt','Pause before display');
|
||||||
|
LCmds(21,3,'Auto Time display','Force line input');
|
||||||
|
LCmds(21,3,'Titles not displayed','1 No ANS prompt');
|
||||||
|
LCmds(21,3,'2 No AVT prompt','3 No RIP prompt');
|
||||||
|
LCmds(21,3,'4 No Global disp','5 No global use');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'[' : IF (RecNumToModify > 1) THEN
|
||||||
|
Dec(RecNumToModify)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
']' : IF (RecNumToModify < NumMenus) THEN
|
||||||
|
Inc(RecNumToModify)
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'F' : IF (RecNumToModify <> 1) THEN
|
||||||
|
RecNumToModify := 1
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(2,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'J' : BEGIN
|
||||||
|
InputIntegerWOC('%LFJump to entry?',RecNumToModify,[NumbersOnly],1,NumMenus);
|
||||||
|
IF (RecNumToModify < 1) AND (RecNumToModify > NumMenus) THEN
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'L' : IF (RecNumToModify <> NumMenus) THEN
|
||||||
|
RecNumToModify := NumMenus
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
Messages(3,0,'');
|
||||||
|
Cmd1 := #0;
|
||||||
|
END;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay screen');
|
||||||
|
Print('^31-9,C,N,T^1:Modify item');
|
||||||
|
LCmds(16,3,'[Back entry',']Forward entry');
|
||||||
|
LCmds(16,3,'Command Editor','First entry in list');
|
||||||
|
LCmds(16,3,'Jump to entry','Last entry in list');
|
||||||
|
LCmds(16,3,'Quit and save','');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
UNTIL (Pos(Cmd1,'QC[]FJL') <> 0) OR (HangUp);
|
||||||
|
IF (Changed) THEN
|
||||||
|
BEGIN
|
||||||
|
Seek(MenuFile,MenuRecNumArray[SaveRecNumToModify]);
|
||||||
|
Write(MenuFile,MenuR);
|
||||||
|
Changed := FALSE;
|
||||||
|
SysOpLog('* Modified menu: ^5'+Menur.LDesc[1]);
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
Close(MenuFile);
|
||||||
|
LastError := IOResult;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
LoadMenuPointers;
|
||||||
|
SaveTempPause := TempPause;
|
||||||
|
TempPause := FALSE;
|
||||||
|
RecNumToList := 1;
|
||||||
|
Cmd := #0;
|
||||||
|
REPEAT
|
||||||
|
IF (Cmd <> '?') THEN
|
||||||
|
DisplayMenus(RecNumToList,TRUE);
|
||||||
|
LOneK('%LFMenu editor [^5?^4=^5Help^4]: ',Cmd,'QDIM?'^M,TRUE,TRUE);
|
||||||
|
CASE Cmd OF
|
||||||
|
^M : IF (RecNumToList < 1) OR (RecNumToList > NumMenus) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
'D' : DeleteMenu;
|
||||||
|
'I' : InsertMenu;
|
||||||
|
'M' : ModifyMenu;
|
||||||
|
'?' : BEGIN
|
||||||
|
Print('%LF^1<^3CR^1>Redisplay screen');
|
||||||
|
LCmds(12,3,'Delete menu','Insert menu');
|
||||||
|
LCmds(12,3,'Modify menu','Quit');
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
IF (CMD <> ^M) THEN
|
||||||
|
RecNumToList := 1;
|
||||||
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||||||
|
TempPause := SaveTempPause;
|
||||||
|
LastError := IOResult;
|
||||||
|
LoadMenuPointers;
|
||||||
|
IF (UserOn) THEN
|
||||||
|
BEGIN
|
||||||
|
SaveCurMenu := CurMenu;
|
||||||
|
NumCmds := 0;
|
||||||
|
GlobalCmds := 0;
|
||||||
|
IF (General.GlobalMenu > 0) THEN
|
||||||
|
BEGIN
|
||||||
|
CurMenu := General.GlobalMenu;
|
||||||
|
LoadMenu;
|
||||||
|
GlobalCmds := NumCmds;
|
||||||
|
END;
|
||||||
|
CurMenu := SaveCurMenu;
|
||||||
|
LoadMenu;
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
END.
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue