commit 6abf234adea72dc112623b5cf96532f4f0178f3f Author: sikofitt Date: Sat Mar 5 11:28:50 2016 -0800 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..aa4d92e --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +*.CFG +*.CMD +*.old +*.OLD +*.TXT +*.TPU +*.tpu +*.ppu +*.PPU +*.VPI +*.vpi +SOURCE/ELECOM/ +SOURCE/UNUSED/ + diff --git a/README.md b/README.md new file mode 100644 index 0000000..89e80b2 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# Renegade BBS diff --git a/SOURCE/ARCHIVE1.PAS b/SOURCE/ARCHIVE1.PAS new file mode 100644 index 0000000..3cdba8c --- /dev/null +++ b/SOURCE/ARCHIVE1.PAS @@ -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. diff --git a/SOURCE/ARCHIVE2.PAS b/SOURCE/ARCHIVE2.PAS new file mode 100644 index 0000000..045ec4f --- /dev/null +++ b/SOURCE/ARCHIVE2.PAS @@ -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 - 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. diff --git a/SOURCE/ARCHIVE3.PAS b/SOURCE/ARCHIVE3.PAS new file mode 100644 index 0000000..49af8b8 --- /dev/null +++ b/SOURCE/ARCHIVE3.PAS @@ -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. diff --git a/SOURCE/ARCVIEW.PAS b/SOURCE/ARCVIEW.PAS new file mode 100644 index 0000000..c5b8518 --- /dev/null +++ b/SOURCE/ARCVIEW.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/AUTOMSG.PAS b/SOURCE/AUTOMSG.PAS new file mode 100644 index 0000000..15d9c10 --- /dev/null +++ b/SOURCE/AUTOMSG.PAS @@ -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. diff --git a/SOURCE/BBSLIST.PAS b/SOURCE/BBSLIST.PAS new file mode 100644 index 0000000..774caae --- /dev/null +++ b/SOURCE/BBSLIST.PAS @@ -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. diff --git a/SOURCE/BOOT.PAS b/SOURCE/BOOT.PAS new file mode 100644 index 0000000..f3c2cf0 --- /dev/null +++ b/SOURCE/BOOT.PAS @@ -0,0 +1,1078 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Boot; + +INTERFACE + +PROCEDURE initp1; +PROCEDURE init; + +IMPLEMENTATION + +USES + Crt, + Dos, + Common, + MyIo, + MiscUser, + TimeFunc; + +PROCEDURE initp1; +VAR + LineFile: FILE OF LineRec; + F: FILE OF Byte; + User: UserRecordType; + X: Byte; + Counter: Integer; + + PROCEDURE FindBadPaths; + CONST + AnyDone: Boolean = FALSE; + VAR + BootFile: Text; + DirName, + DirDesc, + S2: AStr; + Counter: Byte; + BEGIN + InField_Out_FGrd := 7; + Infield_Out_BkGd := 0; + Infield_Inp_FGrd := 7; + Infield_Inp_BkGd := 0; + IF Exist('1STBOOT') THEN + BEGIN + General.DataPath := StartDir+'\DATA\'; + General.MiscPath := StartDir+'\MISC\'; + General.LogsPath := StartDir+'\LOGS\'; + General.MsgPath := StartDir+'\MSGS\'; + General.NodePath := ''; + General.TempPath := StartDir+'\TEMP\'; + General.ProtPath := StartDir+'\PROT\'; + General.ArcsPath := StartDir+'\ARCS\'; + General.FileAttachPath := StartDir+'\FATTACH\'; + General.lMultPath := StartDir+'\STRING\'; + SaveGeneral(FALSE); + Assign(BootFile,StartDir+'1STBOOT'); + Erase(BootFile); + END; + FOR Counter := 1 TO 8 DO + BEGIN + CASE Counter OF + 1 : BEGIN + DirDesc := 'DATA'; + DirName := General.DataPath; + END; + 2 : BEGIN + DirDesc := 'MSGS'; + DirName := General.MsgPath; + END; + 3 : BEGIN + DirDesc := 'FATTACH'; + DirName := General.FileAttachPath; + END; + 4 : BEGIN + DirDesc := 'MISC'; + DirName := General.MiscPath; + END; + 5 : BEGIN + DirDesc := 'LOGS'; + DirName := General.LogsPath; + END; + 6 : BEGIN + DirDesc := 'ARC'; + DirName := General.ArcsPath; + END; + 7 : BEGIN + DirDesc := 'PROT'; + DirName := General.ProtPath; + END; + 8 : BEGIN + DirDesc := 'STRING'; + DirName := General.lMultPath; + END; + END; + IF (NOT ExistDir(DirName)) THEN + BEGIN + AnyDone := TRUE; + WriteLn(DirDesc+' path is currently '+DirName); + WriteLn('This path is bad or missing.'); + REPEAT + WriteLn; + S2 := DirName; + Write('New '+DirDesc+' path: '); + InField(S2,40); + S2 := AllCaps(SQOutSp(S2)); + IF (DirName = S2) OR (S2 = '') THEN + BEGIN + NL; + WriteLn('Illegal pathname error'); + Halt(ExitErrors); + END + ELSE + BEGIN + IF (S2 <> '') THEN + S2 := BSlash(S2,TRUE); + IF (ExistDir(S2)) THEN + CASE Counter OF + 1 : General.DataPath := S2; + 2 : General.MsgPath := S2; + 3 : General.FileAttachPath := S2; + 4 : General.MiscPath := S2; + 5 : General.LogsPath := S2; + 6 : General.ArcsPath := S2; + 7 : General.ProtPath := S2; + 8 : General.lMultPath := S2; + END + ELSE + BEGIN + WriteLn; + WriteLn('That path does not exist!'); + END; + END; + UNTIL (ExistDir(S2)); + END; + END; + IF (AnyDone) THEN + SaveGeneral(FALSE); + END; + +BEGIN + FindBadPaths; + + TextColor(Yellow); + Write('Opening and checking NODE'+IntToStr(ThisNode)+'.DAT ... '); + Assign(LineFile,General.DataPath+'NODE'+IntToStr(ThisNode)+'.DAT'); + Reset(LineFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(LineFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file NODE'+IntToStr(ThisNode)+'.DAT ... '); + ReWrite(LineFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing NODE'+IntToStr(ThisNode)+'.DAT records ... '); + END; + FillChar(Liner,SizeOf(Liner),0); + WITH Liner DO + BEGIN + InitBaud := 19200; + Comport := 1; + MFlags := [CTSRTS]; + Init := 'ATV1S0=0M0E0H0|'; + Answer := 'ATA|'; + HangUp := '^ATH0|'; + Offhook := 'ATH1|'; + DoorPath := ''; + TeleConfNormal := '^4[%UN] ^9'; + TeleConfAnon := '^4[^9??^4] ^9'; + TeleConfGlobal := '^4[%UN ^0GLOBAL^4] ^9'; + TeleConfPrivate := '^4[%UN ^0PRIVATE^4] ^9'; + Ok := 'OK'; + Ring := 'RING'; + Reliable := '/ARQ'; + CallerID := 'NMBR = '; + NoCarrier := 'NO CARRIER'; + Connect[1] := 'CONNECT'; + Connect[2] := 'CONNECT 600'; + Connect[3] := 'CONNECT 1200'; + Connect[4] := 'CONNECT 2400'; + Connect[5] := 'CONNECT 4800'; + Connect[6] := 'CONNECT 7200'; + Connect[7] := 'CONNECT 9600'; + Connect[8] := 'CONNECT 12000'; + Connect[9] := 'CONNECT 14400'; + Connect[10] := 'CONNECT 16800'; + Connect[11] := 'CONNECT 19200'; + Connect[12] := 'CONNECT 21600'; + Connect[13] := 'CONNECT 24000'; + Connect[14] := 'CONNECT 26400'; + Connect[15] := 'CONNECT 28800'; + Connect[16] := 'CONNECT 31200'; + Connect[17] := 'CONNECT 33600'; + Connect[18] := 'CONNECT 38400'; + Connect[19] := 'CONNECT 57600'; + Connect[20] := 'CONNECT 115200'; + Connect[21] := ''; + Connect[22] := ''; + UseCallerID := FALSE; + LogonACS := ''; + IRQ := '4'; + Address := '3F8'; + AnswerOnRing := 1; + MultiRing := FALSE; + NodeTelnetUrl := ''; + END; + Write(LineFile,Liner); + END; + Close(LineFile); + LastError := IOResult; + WriteLn('Done.'); + + Assign(F,General.DataPath+'NODE'+IntToStr(ThisNode)+'.DAT'); + Reset(F); + X := 0; + Seek(F,FileSize(F)); + WHILE (FileSize(F) < SizeOf(LineRec)) DO + Write(F,X); + Close(F); + Reset(LineFile); + Read(LineFile,Liner); + Close(LineFile); + + IF (Liner.Comport = 0) THEN + LocalIOOnly := TRUE; + + TempDir := Copy(General.TempPath,1,Length(General.TempPath) - 1)+IntToStr(ThisNode)+'\'; + IF (NOT ExistDir(TempDir)) THEN + MkDir(Copy(TempDir,1,Length(TempDir) - 1)); + IF (NOT ExistDir(TempDir+'QWK\')) THEN + MkDir(TempDir+'QWK'); + IF (NOT ExistDir(TempDir+'ARC\')) THEN + MkDir(TempDir+'ARC'); + IF (NOT ExistDir(TempDir+'UP\')) THEN + MkDir(TempDir+'UP'); + IF (NOT ExistDir(TempDir+'CD\')) THEN + MkDir(TempDir+'CD'); + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + WriteLn('Error creating directories: '+TempDir); + Delay(1000); + END; + + Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG'); + Append(SysOpLogFile); + LastError := IOResult; + IF (LastError = 2) THEN + ReWrite(SysOpLogFile); + Close(SysOpLogFile); + + Assign(NodeFile,General.DataPath+'MULTNODE.DAT'); + IF (General.MultiNode) THEN + BEGIN + Reset(NodeFile); + LastError := IOResult; + IF (LastError = 2) THEN + ReWrite(NodeFile); + IF (FileSize(NodeFile) < ThisNode) THEN + BEGIN + Seek(NodeFile,FileSize(NodeFile)); + 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; + WHILE (FileSize(NodeFile) < ThisNode) DO + Write(NodeFile,NodeR); + END; + Close(NodeFile); + Assign(SysOpLogFile,TempDir+'TEMPLOG.'+IntToStr(ThisNode)) + END + ELSE + Assign(SysOpLogFile,General.LogsPath+'SYSOP.LOG'); + + Append(SysOpLogFile); + LastError := IOResult; + IF (LastError = 2) THEN + ReWrite(SysOpLogFile); + Close(SysOpLogFile); + + Assign(SysOpLogFile1,General.LogsPath+'SLOGXXXX.LOG'); + SL1(''); + SL1(''); + SL1('^7--> ^5Renegade '+General.Version+' Node '+IntToStr(ThisNode)+' Loaded on '+dat+'^7 <--'); + + Assign(UserFile,General.DataPath+'USERS.DAT'); + + IF ((MaxUsers - 1) >= 1) THEN + LoadURec(ThisUser,1) + ELSE + Exclude(ThisUser.SFLags,SLogSeparate); + + Assign(UserIDXFile,General.DataPath+'USERS.IDX'); + Reset(UserIDXFile); + LastError := IOResult; + IF (LastError = 2) OR (MaxIDXRec = -1) THEN + BEGIN + IF (LastError = 0) THEN + Close(UserIDXFile); + Write('Regenerating corrupted User index: 0%'); + kill(General.DataPath+'USERS.IDX'); + General.NumUsers := 0; + ReWrite(UserIDXFile); + Reset(UserFile); + FOR Counter := 1 TO (MaxUsers - 1) DO + BEGIN + LoadURec(User,Counter); + IF (Counter MOD 25 = 0) THEN + Write(^H^H^H^H,(Counter / FileSize(UserFile) * 100):3:0,'%'); + IF (NOT (Deleted IN User.SFLags)) THEN + Inc(lTodayNumUsers); + InsertIndex(User.Name,Counter,FALSE,(Deleted IN User.SFLags)); + InsertIndex(User.realname,Counter,TRUE,(Deleted IN User.SFLags)); + END; + Close(UserFile); + Close(UserIDXFile); + WriteLn; + SaveGeneral(FALSE); + LastError := IOResult; + END + ELSE + Close(UserIDXFile); + + Assign(EventFile,General.DataPath+'EVENTS.DAT'); + Reset(EventFile); + LastError := IOResult; + IF (LastError = 2) THEN + BEGIN + WriteLn('Bad or missing EVENTS.DAT - creating...'); + ReWrite(EventFile); + NumEvents := 1; + New(MemEventArray[1]); + WITH MemEventArray[1]^ DO + BEGIN + EventDescription := '<< New Event >>'; + EventDayOfMonth := 0; + EventDays := []; + EventStartTime := 0; + EventFinishTime := 0; + EventQualMsg := ''; + EventNotQualMsg := ''; + EventPreTime := 0; + EventNode := 0; + EventLastDate := 0; + EventErrorLevel := 0; + EventShellPath := ''; + LoBaud := 300; + HiBaud := 115200; + EventACS := 's10'; + MaxTimeAllowed := 60; + SetARflag := '@'; + ClearARflag := '@'; + EFlags := [EventIsExternal,EventIsShell]; + END; + Write(EventFile,MemEventArray[1]^); + END + ELSE + BEGIN + NumEvents := 0; + IF NOT EOF(EventFile) THEN + REPEAT + Inc(NumEvents); + New(MemEventArray[NumEvents]); + Read(EventFile,MemEventArray[NumEvents]^); + IF (IOResult <> 0) THEN + BEGIN + SysOpLog('Warning: Bad events file format.'); + Break; + END; + UNTIL (EOF(EventFile)); + END; + Close(EventFile); + LastError := IOResult; + + (* Done - 01/04/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking MEMAIL.DAT ... '); + Assign(EmailFile,General.DataPath+'MEMAIL.DAT'); + Reset(EmailFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(EmailFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file MEMAIL.DAT ... '); + ReWrite(EmailFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing MEMAIL.DAT records ... '); + END; + FillChar(MemMsgArea,SizeOf(MemMsgArea),0); + WITH MemMsgArea DO + BEGIN + Name := 'Private Messages'; + FileName := 'EMAIL'; + MsgPath := ''; + ACS := '^'; + PostACS := ''; + MCIACS := ''; + SysOpACS := General.MSoP; + MaxMsgs := 65535; + Anonymous := ATNo; + Password := ''; + MAFlags := []; + MAType := 0; + Origin := ''; + Text_Color := General.Text_Color; + Quote_Color := General.Quote_Color; + Tear_Color := General.Tear_Color; + Origin_Color := General.Origin_Color; + MessageReadMenu := 0; + QuoteStart := '|03Quoting message from |11@F |03to |11@T'; + QuoteEnd := '|03on |11@D|03.'; + PrePostFile := ''; + AKA := 0; + QWKIndex := 0; + END; + Write(EmailFile,MemMsgArea); + END; + Close(EmailFile); + LastError := IOResult; + WriteLn('Done.'); + + (* Done - 01/04/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking MBASES.DAT ... '); + Assign(MsgAreaFile,General.DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(MsgAreaFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file MBASES.DAT ... '); + ReWrite(MsgAreaFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing MBASES.DAT records ... '); + END; + FillChar(MemMsgArea,SizeOf(MemMsgArea),0); + WITH MemMsgArea DO + BEGIN + Name := '<< New Message Area >>'; + FileName := 'NEWBOARD'; + MsgPath := ''; + ACS := ''; + PostACS := ''; + MCIACS := ''; + SysOpACS := ''; + MaxMsgs := 100; + Anonymous := ATNo; + Password := ''; + MAFlags := []; + MAType := 0; + Origin := ''; + Text_Color := General.Text_Color; + Quote_Color := General.Quote_Color; + Tear_Color := General.Tear_Color; + Origin_Color := General.Origin_Color; + MessageReadMenu := 0; + QuoteStart := '|03Quoting message from |11@F |03to |11@T'; + QuoteEnd := '|03on |11@D|03.'; + PrePostFile := ''; + AKA := 0; + QWKIndex := (FileSize(MsgAreaFile) + 1); + END; + Write(MsgAreaFile,MemMsgArea); + END; + NumMsgAreas := FileSize(MsgAreaFile); + Close(MsgAreaFile); + LastError := IOResult; + WriteLn('Done.'); + + (* Done - 08/11/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking CONFRENC.DAT ... '); + Assign(ConferenceFile,General.DataPath+'CONFRENC.DAT'); + Reset(ConferenceFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(ConferenceFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file CONFRENC.DAT ... '); + ReWrite(ConferenceFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing CONFRENC.DAT records ... '); + END; + FillChar(Conference,SizeOf(Conference),0); + WITH Conference DO + BEGIN + Key := '@'; + Name := 'General'; + ACS := ''; + END; + Write(ConferenceFile,Conference); + END; + NumConfKeys := FileSize(ConferenceFile); + ConfKeys := []; + Counter := 1; + WHILE (Counter <= NumConfKeys) DO + BEGIN + Seek(ConferenceFile,(Counter - 1)); + Read(ConferenceFile,Conference); + Include(ConfKeys,Conference.Key); + Inc(Counter); + END; + Close(ConferenceFile); + LastError := IOResult; + WriteLn('Done.'); + + (* Done - 01/04/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking FBASES.DAT ... '); + Assign(FileAreaFile,General.DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(FileAreaFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file FBASES.DAT ... '); + ReWrite(FileAreaFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing FBASES.DAT records ... '); + END; + FillChar(MemFileArea,SizeOf(MemFileArea),0); + WITH MemFileArea DO + BEGIN + AreaName := '<< New File Area >>'; + FileName := 'NEWDIR'; + DLPath := StartDir[1]+':\'; + ULPath := DLPath; + MaxFiles := 2000; + Password := ''; + ArcType := 0; + CmtType := 0; + ACS := ''; + ULACS := ''; + DLACS := ''; + FAFlags := []; + END; + Write(FileAreaFile,MemFileArea); + END; + NumFileAreas := FileSize(FileAreaFile); + Close(FileAreaFile); + LastError := IOResult; + WriteLn('Done.'); + + (* Done - 01/04/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking PROTOCOL.DAT ... '); + Assign(ProtocolFile,General.DataPath+'PROTOCOL.DAT'); + Reset(ProtocolFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(ProtocolFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file PROTOCOL.DAT ... '); + ReWrite(ProtocolFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing PROTOCOL.DAT records ... '); + END; + 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; + Write(ProtocolFile,Protocol); + END; + NumProtocols := FileSize(ProtocolFile); + Close(ProtocolFile); + LastError := IOResult; + WriteLn('Done.'); + + (* Done - 01/04/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking SCHEME.DAT ... '); + Assign(SchemeFile,General.DataPath+'SCHEME.DAT'); + Reset(SchemeFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(SchemeFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file SCHEME.DAT ... '); + ReWrite(SchemeFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing SCHEME.DAT records ... '); + END; + FillChar(Scheme,SizeOf(Scheme),0); + WITH Scheme DO + BEGIN + Description := 'Default Color Scheme'; + FillChar(Color,SizeOf(Color),7); + Color[1] := 15; + Color[2] := 7; + Color[3] := 13; + Color[4] := 11; + Color[5] := 9; + Color[6] := 14; + Color[7] := 31; + Color[8] := 12; + Color[9] := 142; + Color[10] := 10; + END; + Write(SchemeFile,Scheme); + END; + NumSchemes := FileSize(SchemeFile); + Close(SchemeFile); + LastError := IOResult; + WriteLn('Done.'); + + (* Done - 01/04/08 - Lee Palmer *) + TextColor(Yellow); + Write('Opening and checking VOTING.DAT ... '); + Assign(VotingFile,General.DataPath+'VOTING.DAT'); + Reset(VotingFile); + LastError := IOResult; + IF (LastError = 2) THEN + BEGIN + TextColor(Red); + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file VOTING.DAT ... '); + ReWrite(VotingFile); + END; + NumVotes := FileSize(VotingFile); + Close(VotingFile); + LastError := IOResult; + WriteLn('Done.'); + + TextColor(Yellow); + Write('Opening and checking VALIDATE.DAT ... '); + Assign(ValidationFile,General.DataPath+'VALIDATE.DAT'); + Reset(ValidationFile); + LastError := IOResult; + IF (LastError = 2) OR (FileSize(ValidationFile) = 0) THEN + BEGIN + TextColor(Red); + IF (LastError = 2) THEN + BEGIN + WriteLn('File missing!'); + TextColor(Yellow); + Write('Creating missing file VALIDATE.DAT ... '); + ReWrite(ValidationFile); + END + ELSE + BEGIN + WriteLn('Records missing!'); + TextColor(Yellow); + Write('Inserting missing VALIDATE.DAT records ... '); + END; + LoadURec(User,0); + FillChar(Validation,SizeOf(Validation),0); + WITH Validation DO + BEGIN + Key := '!'; + ExpireTo := ' '; + Description := 'New user validation'; + 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; + Write(ValidationFile,Validation); + END; + NumValKeys := FileSize(ValidationFile); + ValKeys := []; + Counter := 1; + WHILE (Counter <= NumValKeys) DO + BEGIN + Seek(ValidationFile,(Counter - 1)); + Read(ValidationFile,Validation); + Include(ValKeys,Validation.Key); + Inc(Counter); + END; + Close(ValidationFile); + LastError := IOResult; + WriteLn('Done.'); + + NumArcs := 1; + WHILE (NumArcs <= MaxArcs) AND (General.FileArcInfo[NumArcs].Ext <> '') DO + Inc(NumArcs); + Dec(NumArcs); + + FOR Counter := 1 TO MaxMenus DO + MenuRecNumArray[Counter] := 0; + FOR Counter := 1 TO MaxMenus DO + CmdNumArray[Counter] := 0; + NumMenus := 0; + NumCmds := 0; + Assign(MenuFile,General.DataPath+'MENUS.DAT'); + Reset(MenuFile); + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + Print('System Error: MENUS.DAT file is missing!'); + Halt; + END + ELSE + BEGIN + Counter := 0; + WHILE NOT EOF(MenuFile) DO + BEGIN + Read(MenuFile,MenuR); + IF (MenuR.Menu = TRUE) THEN + BEGIN + Inc(NumMenus); + MenuRecNumArray[NumMenus] := Counter; + IF (NumMenus > 1) THEN + CmdNumArray[NumMenus - 1] := NumCmds; + NumCmds := 0; + END + ELSE + Inc(NumCmds); + Inc(Counter); + END; + CmdNumArray[NumMenus] := NumCmds; + Close(MenuFile); + END; + + CFO := FALSE; + +END; + +FUNCTION SchareLoaded: Boolean; +VAR + T_Al: Byte; +BEGIN +{$IFDEF MSDOS} + ASM + Mov Ah,10h + Mov Al,0h + Int 2fh + Mov T_Al,Al + END; +{$ENDIF} +{$IFDEF WIN32} + T_Al := $FF; +{$ENDIF} + SchareLoaded := (T_Al = $FF); +END; + +PROCEDURE FindTaskerType; +VAR + D5, + DOS_Major, + DOS_Minor, + Os2Vers: Word; + DVOk, + OS2Ok, + WinOk, + WinNTOk: Boolean; + +{$IFDEF MSDOS} + FUNCTION TrueDosVer(VAR WinNTOk: Boolean): Word; + VAR + Regs: Registers; + BEGIN + WITH Regs DO + BEGIN + Ax := $3306; + MsDos(Regs); + IF (Bx = $3205) THEN + WinNTOk := TRUE + ELSE + WinNTOk := FALSE; + TrueDosVer := Bl; + END; + END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION TrueDosVer(VAR WinNTOk: Boolean): Word; + BEGIN + WinNtOK := TRUE; + TrueDosVer := 5; + END; +{$ENDIF} + +{$IFDEF MSDOS} + FUNCTION DosVer(VAR Minor,OS2Ver: Word): Word; + VAR + Regs: Registers; + BEGIN + OS2Ver := 0; + WITH Regs DO + BEGIN + Ax := $3000; + MsDos(Regs); + DosVer := Al; + Minor := Ah; + IF (Al = $0A) THEN + OS2Ver := 1 + ELSE IF (Al = $14) THEN + OS2Ver := 2; + END; + END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION DosVer(VAR Minor,OS2Ver: Word): Word; + BEGIN + Minor := 0; + OS2Ver := 0; + DosVer := 5; + END; +{$ENDIF} + +{$IFDEF MSDOS} + FUNCTION Win3_Check_On: Boolean; + VAR + Regs: Registers; + BEGIN + WITH Regs DO + BEGIN + AX := $1600; + Intr($2F,Regs); { $00 no Win 2.x or 3.x } + IF (AL IN [$00,$01,$80,$FF]) THEN { $01 Win/386 2.x running } + Win3_Check_On := FALSE { $80 obsolete XMS installed } + ELSE { $FF Win/386 2.x running } + Win3_Check_On := TRUE; + END; + END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION Win3_Check_On: Boolean; + BEGIN + Win3_Check_On := FALSE; + END; +{$ENDIF} + +{$IFDEF MSDOS} + FUNCTION DV_Check_On: Boolean; + VAR + Regs: Registers; + BEGIN + DV_Check_On := FALSE; + WITH Regs DO + BEGIN + Ax := $2B01; + Cx := $4445; + Dx := $5351; + Intr($21,Regs); + END; + IF (Regs.AL = $FF) THEN + DV_Check_On := FALSE + ELSE + DV_Check_On := TRUE; + END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION DV_Check_On: Boolean; + BEGIN + DV_Check_On := FALSE; + END; +{$ENDIF} + +BEGIN + D5 := 0; + Tasker := None; + DVOk := FALSE; + OS2Ok := FALSE; + WinOk := FALSE; + WinNTOk := FALSE; { This could also be just plain old Dos 5.0+ } + DOS_Major := DosVer(DOS_Minor,Os2Vers); + IF (Os2Vers IN [1,2]) THEN + OS2Ok := TRUE + ELSE + DVOk := DV_Check_On; + IF (NOT DVOk) AND (NOT OS2Ok) THEN + BEGIN + WinOk := Win3_Check_On; + IF (NOT WinOk) THEN + CASE Dos_Major of + 5..9 : D5 := TrueDosVer(WinNTOk); + END; + END; + IF (DVOk) THEN + Tasker := DV + ELSE IF (WinOk) THEN + Tasker := Win + ELSE IF (OS2Ok) THEN + Tasker := OS2 + ELSE IF (WinNTOk) THEN + Tasker := Win32 + ELSE IF (D5 >= 5) THEN + Tasker := Dos5N; +END; + +PROCEDURE init; +VAR + Node: Byte; +BEGIN + IF (DateStr = '01-01-1980') THEN + BEGIN + ClrScr; + TextColor(Yellow); + WriteLn('Please set the operating system date & time.'); + Halt(ExitErrors); + END; + + FindTaskerType; + + IF (General.MultiNode) AND (NOT SchareLoaded) THEN + BEGIN + ClrScr; + TextColor(Yellow); + WriteLn('WARNING: SHARE.EXE should be loaded for MultiNode operation.'); + Delay(1000); + END; + + HangUp := FALSE; + InCom := FALSE; + OutCom := FALSE; + Echo := TRUE; + DoneDay := FALSE; + CheckBreak := FALSE; + SLogging := TRUE; + Trapping := FALSE; + ReadingMail := FALSE; + SysOpOn := FALSE; + BeepEnd := FALSE; + WantOut := TRUE; + InChat := FALSE; + LIL := 0; + + ThisUser.PageLen := 24; (* Is this needed ??? *) + + Buf := ''; + ChatCall := FALSE; + LastAuthor := 0; + LastLineStr := ''; + ChatReason := ''; + + DirectVideo := NOT General.UseBIOS; + + IF (General.NetworkMode) AND (ThisNode = 0) THEN + BEGIN + LocalIOOnly := TRUE; + Node := 1; + WHILE (Node <= MaxNodes) AND (ThisNode = 0) DO + BEGIN + LoadNode(Node); + IF (NOT (NActive IN NodeR.Status)) THEN + ThisNode := Node; + Inc(Node); + END; + IF (ThisNode = 0) THEN + ThisNode := Node; + END; + + IF (ThisNode > 255) THEN + ThisNode := 1; + + IF (General.MultiNode) AND (ThisNode = 0) THEN + BEGIN + ClrScr; + WriteLn('WARNING: No node number specified. Defaulting to node 1.'); + ThisNode := 1; + Delay(1000); + END + ELSE IF (ThisNode = 0) THEN + ThisNode := 1; + + initp1; + + 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); + +END; + +END. diff --git a/SOURCE/BULLETIN.PAS b/SOURCE/BULLETIN.PAS new file mode 100644 index 0000000..38d1d69 --- /dev/null +++ b/SOURCE/BULLETIN.PAS @@ -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<>^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 + ' (=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. diff --git a/SOURCE/COMMON.PAS b/SOURCE/COMMON.PAS new file mode 100644 index 0000000..e49a2e1 --- /dev/null +++ b/SOURCE/COMMON.PAS @@ -0,0 +1,5076 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D-,E-,F+,I-,L-,N+,O-,R-,S-,V-} + +UNIT Common; + +INTERFACE + +USES + Crt, + Dos, + MyIO, + TimeFunc; + +{$I RECORDS.PAS} + +CONST + StrLen = 119; + +TYPE + MCIFunctionType = FUNCTION(CONST s: AStr; Data1, Data2: Pointer): STRING; + + MemMenuRec = RECORD { Menu Record } + LDesc: ARRAY[1..3] OF STRING[100]; { menu name } + ACS: ACString; { access requirements } + NodeActivityDesc: STRING[50]; + MenuFlags: MenuFlagSet; { menu status variables } + LongMenu: STRING[12]; { displayed IN place OF long menu } + MenuNum: Byte; { menu number } + MenuPrompt: STRING[120]; { menu Prompt } + Password: STRING[20]; { password required } + FallBack: Byte; { fallback menu } + Directive: STRING[12]; + ForceHelpLevel: Byte; { forced help Level FOR menu } + GenCols: Byte; { generic menus: # OF columns } + GCol: ARRAY[1..3] OF Byte; { generic menus: colors } + END; + + MemCmdRec = RECORD { Command records } + LDesc: STRING[100]; { long command description } + ACS: ACString; { access requirements } + NodeActivityDesc: STRING[50]; + CmdFlags: CmdFlagSet; { command status variables } + SDesc: STRING[35]; { short command description } + CKeys: STRING[14]; { command-execution keys } + CmdKeys: STRING[2]; { command keys: type OF command } + Options: STRING[50]; { MString: command data } + END; + + LightBarRecordType = RECORD + XPos, + YPos: Byte; + CmdToExec: SmallInt; + CmdToShow: STRING[40]; + END; + + States = + (Waiting, + Bracket, + Get_Args, + Get_Param, + Eat_Semi, + In_Param, + GetAvCmd, + GetAvAttr, + GetAvRLE1, + GetAvRLE2, + GetAvX, + GetAvY); + + StorageType = + (Disk, + CD, + Copied); + + TransferFlagType = + (lIsAddDLBatch, + IsFileAttach, + IsUnlisted, + IsTempArc, + IsQWK, + IsNoFilePoints, + IsNoRatio, + IsCheckRatio, + IsCDRom, + IsPaused, + IsAutoLogOff, + IsKeyboardAbort, + IsTransferOk); + + TransferFlagSet = SET OF TransferFlagType; + + BatchDLRecordType = RECORD + BDLFileName: Str52; + BDLOwnerName: Str36; + BDLStorage: StorageType; + BDLUserNum, + BDLSection, + BDLPoints, + BDLUploader: SmallInt; + BDLFSize, + BDLTime: LongInt; + BDLFlags: TransferFlagSet; + END; + + BatchULRecordType = RECORD + BULFileName: Str12; + BULUserNum, + BULSection: SmallInt; + BULDescription: Str50; + BULVPointer: LongInt; + BULVTextSize: SmallInt; + END; + + ExtendedDescriptionArray = ARRAY [1..99] OF Str50; + + IEMSIRecord = RECORD + UserName, + Handle: STRING[36]; + CityState: STRING[30]; + Ph: STRING[12]; + PW: STRING[20]; + BDate: STRING[10]; + END; + + StrPointerRec = RECORD + Pointer, + TextSize: LongInt; + END; + + MemCmdPointer = ^MemCmdArray; + MemCmdArray = ARRAY [1..MaxCmds] OF MemCmdRec; + + MCIBufferType = ARRAY [1..MaxConfigurable] OF Char; + MCIBufferPtr = ^MCIBufferType; + + Multitasker = + (None, (* Dos 5 thu 9 *) + DV, + Win, + OS2, + Win32, + DOS5N); + + InputFlagType = + (UpperOnly, { Uppercase only } + ColorsAllowed, { Colors allowed } + NoLineFeed, { Linefeeds OFF - no linefeed after pressed } + ReDisplay, { Display old IF no change } + CapWords, { Capitalize characters } + InterActiveEdit, { Interactive editing } + NumbersOnly, + DisplayValue, + NegativeAllowed); { Numbers only } + + InputFlagSet = SET OF InputFlagType; + + ValidationKeyType = SET OF '!'..'~'; (* Remove q and Q *) + + ConferenceKeyType = SET OF '@'..'Z'; + + CompArrayType = ARRAY[0..1] OF SMALLINT; + +CONST + MCIBuffer: MCIBufferPtr = NIL; + DieLater: Boolean = FALSE; { IF TRUE, Renegade locks up } + F_HOME = 18176; { 256 * Scan Code } + F_UP = 18432; + F_PGUP = 18688; + F_LEFT = 19200; + F_RIGHT = 19712; + F_END = 20224; + F_DOWN = 20480; + F_PGDN = 20736; + F_INS = 20992; + F_DEL = 21248; + F_CTRLLEFT = 29440; + F_CTRLRIGHT = 29696; + NoCallInitTime = (30 * 60); { thirty minutes between modem inits } + Tasker: Multitasker = None; + LastScreenSwap: LongInt = 0; + ParamArr: ARRAY [1..5] OF Word = (0,0,0,0,0); + Params: Word = 0; { number OF parameters } + NextState: States = Waiting; { Next state FOR the parser } + TempSysOp: Boolean = FALSE; { is temporary sysop? } + Reverse: Boolean = FALSE; { TRUE IF Text attributes are reversed } + TimeLock: Boolean = FALSE; { IF TRUE, DO NOT HangUp due TO time! } + SaveX: Byte = 0; { FOR ANSI driver} + SaveY: Byte = 0; { FOR ANSI driver} + TempPause: Boolean = TRUE; { is Pause on OR off? Set at prompts, OneK, used everywhere } + OfflineMail: Boolean = FALSE; { are we IN the offline mail system? } + MultiNodeChat: Boolean = FALSE; { are we IN MultiNode chat?} + ChatChannel: Integer = 0; { What chat channel are we IN? } + DisplayingMenu: Boolean = FALSE; { are we displaying a menu? } + InVisEdit: Boolean = FALSE; { are we IN the visual editor? } + MenuAborted: Boolean = FALSE; { was the menu Aborted? } + AllowAbort: Boolean = TRUE; { are Aborts allowed? } + MCIAllowed: Boolean = TRUE; { is mci allowed? } + ColorAllowed: Boolean = TRUE; { is color allowed? } + Echo: Boolean = TRUE; { is Text being echoed? (FALSE=use echo Chr)} + HangUp: Boolean = TRUE; { is User offline now? } + TimedOut: Boolean = FALSE; { has he timed out? } + NoFile: Boolean = TRUE; { did last pfl() FILE NOT Exist? } + SLogging: Boolean = TRUE; { are we outputting TO the SysOp log? } + SysOpOn: Boolean = TRUE; { is SysOp logged onto the WFC menu? } + WantOut: Boolean = TRUE; { output Text locally? } + WColor: Boolean = TRUE; { IN chat: was last key pressed by SysOp? } + BadDLPath: Boolean = FALSE; { is the current DL path BAD? } + BadUlPath: Boolean = FALSE; { is the current UL path BAD? } + BeepEnd: Boolean = FALSE; { whether TO beep after caller logs off } + FileAreaNameDisplayed: Boolean = FALSE; { was FILE area name printed yet? } + CFO: Boolean = FALSE; { is chat FILE open? } + InChat: Boolean = FALSE; { are we IN chat Mode? } + ChatCall: Boolean = FALSE; { is the chat call "noise" on? } + ContList: Boolean = FALSE; { continuous message listing Mode on? } + CROff: Boolean = FALSE; { are CRs turned off? } + CtrlJOff: Boolean = FALSE; { turn color TO #1 after ^Js?? } + DoneAfterNext: Boolean = FALSE; { offhook AND Exit after Next logoff? } + DoneDay: Boolean = FALSE; { are we done now? ready TO drop TO DOS?} + DOSANSIOn: Boolean = FALSE; { output chrs TO DOS FOR ANSI codes?!!? } + FastLogon: Boolean = FALSE; { IF a FAST LOGON is requested } + HungUp: Boolean = FALSE; { did User drop carrier? } + InCom: Boolean = FALSE; { accepting input from com? } + InWFCMenu: Boolean = FALSE; { are we IN the WFC menu? } + LastCommandGood: Boolean = FALSE;{ was last command a REAL command? } + LastCommandOvr: Boolean = FALSE; { override Pause? (NO Pause?) } + LocalIOOnly: Boolean = FALSE; { local I/O ONLY? } + MakeQWKFor: Integer = 0; { make a qwk packet ONLY? } + UpQWKFor: Integer = 0; { upload a qwk packet ONLY? } + RoomNumber: Integer = 0; { Room OF teleconference } + PackBasesOnly: Boolean = FALSE; { pack message bases ONLY? } + SortFilesOnly: Boolean = FALSE; { sort FILE bases ONLY? } + FileBBSOnly: Boolean = FALSE; + NewMenuToLoad: Boolean = FALSE; { menu command returns TRUE IF new menu TO load } + OvrUseEMS: Boolean = TRUE; + OverLayLocation: Byte = 0; { 0=Normal, 1=EMS, 2=XMS } + OutCom: Boolean = FALSE; { outputting TO com? } + DirFileopen1: Boolean = TRUE; { whether DirFile has been opened before } + ExtFileOpen1: Boolean = TRUE; + PrintingFile: Boolean = FALSE; { are we printing a FILE? } + AllowContinue: Boolean = FALSE; { Allow Continue prompts? } + QuitAfterDone: Boolean = FALSE; { quit after Next User logs off? } + Reading_A_Msg: Boolean = FALSE; { is User reading a message? } + ReadingMail: Boolean = FALSE; { reading private mail? } + ShutUpChatCall: Boolean = FALSE; { was chat call "SHUT UP" FOR this call? } + Trapping: Boolean = FALSE; { are we Trapping users Text? } + UserOn: Boolean = FALSE; { is there a User on right now? } + WasNewUser: Boolean = FALSE; { did a NEW User log on? } + Write_Msg: Boolean = FALSE; { is User writing a message? } + NewEchoMail: Boolean = FALSE; { has new echomail been entered? } + TimeWarn: Boolean = FALSE; { has User been warned OF time shortage? } + TellUserEvent: Byte = 0; { has User been told about the up-coming event? } + ExitErrors: Byte = 1; { errorLEVEL FOR Critical error Exit } + ExitNormal: Byte = 0; { errorLEVEL FOR Normal Exit } + TodayCallers: Integer = 0; { new system callers } + lTodaynumUsers: Integer = 0; { new number OF users } + ThisNode: Byte = 0; { node number } + AnswerBaud: LongInt = 0; { baud rate TO answer the phone at } + ExtEventTime: Word = 0; { # minutes before External event } + IsInvisible: Boolean = FALSE; { Run IN invisible Mode? } + SaveNDescription: STRING[50] = 'Miscellaneous'; + SaveNAvail: Boolean = FALSE; + LastWFCX: Byte = 1; + LastWFCY: Byte = 1; + ANSIDetected: Boolean = FALSE; +{ Added June 21, 2013 //sk5 } + PauseIsNull : Boolean = FALSE; { Added for null pause } + BuildDate : Array [1..5] of Word = ( 5, 27, 2013, 9, 19 ); { Build date MM, DD, YYYY, HR, MIN } + +VAR + LightBarArray: ARRAY[1..50] OF LightBarRecordType; + LightBarCmd, + LightBarCounter: Byte; + LightBarFirstCmd: Boolean; + + Telnet: Boolean; + HangUpTelnet: Boolean; + + DatFilePath: STRING[40]; + Interrupt14: Pointer; { far ptr TO interrupt 14 } +{$IFDEF MSDOS} + Ticks: LongInt ABSOLUTE $0040:$006C; +{$ENDIF} + IEMSIRec: IEMSIRecord; + FossilPort: Word; + SockHandle: STRING; { Telnet Handle } + CallerIDNumber: STRING[40]; { Caller ID STRING obtained from modem } + ActualSpeed: LongInt; { Actual connect rate } + Reliable: Boolean; { error correcting connection? } + ComPortSpeed: LongInt; { com port rate } + LastError: Integer; { Results from last IOResult, when needed } + + General: GeneralRecordType; { configuration information } + + DirInfo: SearchRec; + + { LastCallers } + LastCallerFile : FILE OF LastCallerRec; + LastCallers : LastCallerRec; + + { Today's History } + HistoryFile : FILE OF HistoryRecordType; + HistoryRec : HistoryRecordType; + + { Voting Variables } + VotingFile: FILE OF VotingRecordType; + Topic: VotingRecordType; + NumVotes: Byte; + + BBSListFile: FILE OF BBSListRecordType; { bbslist.dat } + + { Conference Variables } + ConferenceFile: FILE OF ConferenceRecordType; { CONFRENC.DAT } + Conference: ConferenceRecordType; { Conferences } + ConfKeys: ConferenceKeyType; + NumConfKeys: Integer; + CurrentConf: Char; { Current conference tag } + ConfSystem: Boolean; { is the conference system enabled? } + + { Validation Variables } + ValidationFile: FILE OF ValidationRecordType; + Validation: ValidationRecordType; + NumValKeys: Byte; + ValKeys: ValidationKeyType; + + NumArcs: Byte; + + NodeFile: FILE OF NodeRecordType; { multi node FILE } + NodeR: NodeRecordType; + NodeChatLastRec: LongInt; { last record IN group chat FILE Read } + + Liner: LineRec; + + SysOpLogFile, { SYSOP.LOG } + SysOpLogFile1, { SLOGxxxx.LOG } + TrapFile, { TRAP*.MSG } + ChatFile: Text; { CHAT*.MSG } + + + { User Variables } + UserFile: FILE OF UserRecordType; { User.LST } + UserIDXFile: FILE OF UserIDXRec; { User.IDX } + ThisUser: UserRecordType; { User's account records } + + { Color Scheme Variables } + SchemeFile: FILE OF SchemeRec; { SCHEME.DAT } + Scheme: SchemeRec; + NumSchemes: Integer; + + { Event Variables } + EventFile: FILE OF EventRecordType; + MemEventArray: ARRAY [1..MaxEvents] OF ^EventRecordType; + Event: EventRecordType; + NumEvents: Integer; { # OF events } + + { Protocol Variables } + ProtocolFile: FILE OF ProtocolRecordType; { PROTOCOL.DAT } + Protocol: ProtocolRecordType; { protocol IN memory } + NumProtocols: Integer; + + { File Variables } + FileAreaFile: FILE OF FileAreaRecordType; { FBASES.DAT } + MemFileArea, + TempMemFileArea: FileAreaRecordType; { File area and temporary file area in memory } + FileInfoFile: FILE OF FileInfoRecordType; { *.DIR } + ExtInfoFile: FILE; { *.EXT } + FileInfo: FileInfoRecordType; + ExtendedArray: ExtendedDescriptionArray; + NewFilesF: Text; { For NEWFILES.DAT in the qwk system } + FileArea, { File base User is in } + NumFileAreas, { Max number OF FILE bases } + ReadFileArea, { current uboard # IN memory } + LowFileArea, + HighFileArea: Integer; + NewScanFileArea: Boolean; { New scan this base? } + + { Batch Download Variables } + BatchDLFile: FILE OF BatchDLRecordType; + BatchDL: BatchDLRecordType; + NumBatchDLFiles: Byte; { # files IN DL batch queue } + BatchDLSize, + BatchDLPoints, + BatchDLTime: LongInt; { } + + { Batch Upload Variables } + BatchULFile: FILE OF BatchULRecordType; + BatchULF: FILE; + BatchUL: BatchULRecordType; + NumBatchULFiles: Byte; { # files IN UL batch queue } + + { Message Variables } + EmailFile: FILE OF MessageAreaRecordType; + MsgAreaFile: FILE OF MessageAreaRecordType; { MBASES.DAT } + MemMsgArea: MessageAreaRecordType; { MsgArea IN memory } + MsgHdrF: FILE OF MHeaderRec; { *.HDR } + MsgTxtF: FILE; { *.DAT } + LastReadRecord: ScanRec; + LastAuthor, { Author # OF the last message } + NumMsgAreas, { Max number OF msg bases } + MsgArea, + ReadMsgArea, + LowMsgArea, + HighMsgArea: Integer; + Msg_On: Word; { current message being Read } + + { Menu Variables } + MenuFile: FILE OF MenuRec; + MenuR: MenuRec; + MemMenu: MemMenuRec; { menu information } + MemCmd: MemCmdPointer; { Command information } + MenuRecNumArray: ARRAY [1..MaxMenus] OF Integer; + CmdNumArray: ARRAY [1..MaxMenus] OF Byte; + MenuStack: ARRAY [1..MaxMenus] OF Byte; { menu stack } + MenuKeys: AStr; { keys TO Abort menu display WITH } + NumMenus, + NumCmds, + GlobalCmds, + MenuStackPtr, + FallBackMenu, + CurMenu, + CurHelpLevel: Byte; + + Buf: STRING[255]; { macro buffer } + MLC: STRING[255]; { multiline FOR chat } + + ChatReason, { last chat reason } + LastLineStr, { "last-line" STRING FOR Word-wrapping } + StartDir: AStr; { Directory BBS was executed from } + + TempDir, { Temporary Directory base name } + InResponseTo: STRING[40]; { reason FOR reply } + + LastDIRFileName: Str12; { last filename FOR recno/nrecno } + + CurrentColor, { current ANSI color } + ExiterrorLevel, { errorLEVEL TO Exit WITH } + TShuttleLogon, { type OF special Shuttle Logon command } + TFilePrompt, { type OF special FILE Prompt command } + TReadPrompt, { type OF special Read Prompt command } + + PublicPostsToday, { posts made by User this call } + FeedBackPostsToday, { feedback sent by User this call } + PrivatePostsToday: Byte; { E-mail sent by User this call } + + LastDIRRecNum, { last record # FOR recno/nrecno } + ChatAttempts, { number chat attempts made by User } + LIL, { lines on screen since last PauseScr() } + + PublicReadThisCall, { # public messages has Read this call } + + UserNum: Integer; { User's User number } + + Rate: Word; { cps FOR FILE transfers } + + NewFileDate, { NewScan Pointer date } + + DownloadsToday, { download sent TO User this call } + UploadsToday, { uploads sent by User this call } + DownloadKBytesToday, { download k by User this call } + UploadKBytesToday, { upload k by User this call } + + CreditsLastUpdated, { Time Credits last updated } + TimeOn, { time User logged on } + LastBeep, + LastKeyHit, + ChopTime, { time TO chop off FOR system events } + ExtraTime, { extra time - given by F7/F8, etc } + CreditTime, { credit time adjustment } + FreeTime: LongInt; { free time } + + BlankMenuNow, { is the wfcmenu blanked out? } + Abort, + Next, { global Abort AND Next } + RQArea, + FQArea, + MQArea, + VQArea: Boolean; + +{$IFDEF WIN32} +procedure Sound(hz: Word; duration: Word); +function Ticks: LongInt; +{$ENDIF} +FUNCTION GetC(c: Byte): STRING; +PROCEDURE ShowColors; +FUNCTION CheckDriveSpace(S,Path: AStr; MinSpace: Integer): Boolean; +FUNCTION StripLeadSpace(S: STRING): STRING; +FUNCTION StripTrailSpace(S: STRING): STRING; +FUNCTION SemiCmd(S: AStr; B: Byte): STRING; +FUNCTION ExistDrive(Drive: Char): Boolean; +PROCEDURE RenameFile(DisplayStr: AStr; OldFileName,NewFileName: AStr; VAR ReNameOk: Boolean); +FUNCTION GetFileSize(FileName: AStr): LongInt; +PROCEDURE GetFileDateTime(CONST FileName: AStr; VAR FileTime: LongInt); +PROCEDURE SetFileDateTime(CONST FileName: AStr; FileTime: LongInt); +FUNCTION PHours(CONST DisplayStr: AStr; LoTime,HiTime: Integer): AStr; +FUNCTION RGSysCfgStr(StrNum: LongInt; PassValue: Boolean): AStr; +FUNCTION RGNoteStr(StrNum: LongInt; PassValue: Boolean): AStr; +FUNCTION RGMainStr(StrNum: LongInt; PassValue: Boolean): AStr; +FUNCTION lRGLNGStr(StrNum: LongInt; PassValue: Boolean): AStr; +PROCEDURE GetPassword(VAR PW: AStr; Len: Byte); +PROCEDURE MakeDir(VAR Path: PathStr; AskMakeDir: Boolean); +PROCEDURE Messages(Msg,MaxRecs: Integer; AreaName: AStr); +PROCEDURE DisplayBuffer(MCIFunction: MCIFunctionType; Data1, Data2:Pointer); +FUNCTION ReadBuffer(FileName: AStr): Boolean; +FUNCTION chinkey: Char; +FUNCTION FormatNumber(L: LongInt): STRING; +FUNCTION ConvertBytes(BytesToConvert: LongInt; OneChar: Boolean): STRING; +FUNCTION ConvertKB(KBToConvert: LongInt; OneChar: Boolean): STRING; +PROCEDURE WriteWFC(c: Char); +FUNCTION AccountBalance: LongInt; +PROCEDURE AdjustBalance(Adjustment: LongInt); +PROCEDURE BackErase(Len: Byte); +FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt; +FUNCTION CRC32(s: AStr): LongInt; +FUNCTION FunctionalMCI(CONST s: AStr; FileName,InternalFileName: AStr): STRING; +FUNCTION MCI(CONST s: STRING): STRING; +FUNCTION Plural(InString: STRING; Number: Byte): STRING; +FUNCTION FormattedTime(TimeUsed: LongInt): STRING; +FUNCTION SearchUser(Uname: Str36; RealNameOK: Boolean): Integer; +PROCEDURE PauseScr(IsCont: Boolean); +PROCEDURE Com_Send_Str(CONST InString: AStr); +PROCEDURE dophoneHangup(ShowIt: Boolean); +PROCEDURE DoTelnetHangUp(ShowIt: Boolean); +PROCEDURE DoPhoneOffHook(ShowIt: Boolean); +PROCEDURE InputPath(CONST DisplayStr: AStr; VAR DirPath: Str40; CreateDir,AllowExit: Boolean; VAR Changed: Boolean); +FUNCTION StripName(InString: STRING): STRING; +PROCEDURE PurgeDir(s: AStr; SubDirs: Boolean); +PROCEDURE DOSANSI(CONST c: Char); +FUNCTION HiMsg: Word; +FUNCTION OnNode(UserNumber: Integer): Byte; +FUNCTION MaxUsers: Integer; +PROCEDURE Kill(CONST FileName: AStr); +PROCEDURE ScreenDump(CONST FileName: AStr); +PROCEDURE ScanInput(VAR s: AStr; CONST Allowed: AStr); +PROCEDURE Com_Flush_Recv; +PROCEDURE Com_Flush_Send; +PROCEDURE Com_Purge_Send; +FUNCTION Com_Carrier: Boolean; +FUNCTION Com_Recv: Char; +FUNCTION Com_IsRecv_Empty: Boolean; +FUNCTION Com_IsSend_Empty: Boolean; +PROCEDURE Com_Send(c: Char); +PROCEDURE Com_Set_Speed(Speed: LongInt); +PROCEDURE Com_DeInstall; +PROCEDURE Com_Install; +PROCEDURE CheckHangup; +PROCEDURE SerialOut(s: STRING); +FUNCTION Empty:Boolean; +PROCEDURE DTR(Status: Boolean); +PROCEDURE BackSpace; +PROCEDURE DoBackSpace(Start,Finish: Byte); +FUNCTION LennMCI(CONST InString: STRING): Integer; +FUNCTION MsgSysOp: Boolean; +FUNCTION FileSysOp: Boolean; +FUNCTION CoSysOp: Boolean; +FUNCTION SysOp: Boolean; +FUNCTION Timer: LongInt; +PROCEDURE TeleConfCheck; +FUNCTION Substitute(Src: STRING; CONST old,New: STRING): STRING; +PROCEDURE NewCompTables; +FUNCTION OkANSI: Boolean; +FUNCTION OkAvatar: Boolean; +FUNCTION OkRIP: Boolean; +FUNCTION OkVT100: Boolean; +FUNCTION NSL: LongInt; +FUNCTION AgeUser(CONST BirthDate: LongInt): Word; +FUNCTION AllCaps(Instring: STRING): STRING; +FUNCTION Caps(Instring: STRING): STRING; +PROCEDURE Update_Screen; +FUNCTION PageLength: Word; +PROCEDURE lStatus_Screen(WhichScreen: Byte; Message: AStr; OneKey: Boolean; VAR Answer: AStr); +FUNCTION CInKey: Char; +FUNCTION CheckPW: Boolean; +FUNCTION StripColor(CONST InString: STRING): STRING; +PROCEDURE sl1(s: AStr); +PROCEDURE SysOpLog(s: AStr); +FUNCTION StrToInt(S: Str11): LongInt; +FUNCTION RealToStr(R: Real; W,D: Byte): STRING; +FUNCTION ValueR(S: AStr): REAL; +PROCEDURE ShellDos(MakeBatch: Boolean; CONST Command: AStr; VAR ResultCode: Integer); +PROCEDURE SysOpShell; +PROCEDURE RedrawForANSI; +PROCEDURE Star(InString: AStr); +FUNCTION GetKey: Word; +PROCEDURE SetC(C: Byte); +PROCEDURE UserColor(Color: Byte); +PROCEDURE Prompt(CONST InString: STRING); +FUNCTION SQOutSp(InString: STRING): STRING; +FUNCTION ExtractDriveNumber(s: AStr): Byte; +FUNCTION PadLeftStr(InString: STRING; MaxLen: Byte): STRING; +FUNCTION PadRightStr(InString: STRING; MaxLen: Byte): STRING; +FUNCTION PadLeftInt(L: LongInt; MaxLen: Byte): STRING; +FUNCTION PadRightInt(L: LongInt; MaxLen: Byte): STRING; +PROCEDURE Print(CONST InString: STRING); +PROCEDURE NL; +PROCEDURE Prt(CONST Instring: STRING); +PROCEDURE MPL(MaxLen: Byte); +FUNCTION CTP(t,b: LongInt): STRING; +PROCEDURE TLeft; +PROCEDURE LoadNode(NodeNumber: Byte); +PROCEDURE Update_Node(NActivityDesc: AStr; SaveVars: Boolean); +FUNCTION MaxNodes: Byte; +FUNCTION MaxChatRec: LongInt; +PROCEDURE SaveNode(NodeNumber: Byte); +PROCEDURE LoadURec(VAR User: UserRecordType; UserNumber: Integer); +PROCEDURE SaveURec(User: UserRecordType; UserNumber:Integer); +FUNCTION MaxIDXRec: Integer; +FUNCTION InKey: Word; +PROCEDURE OutKey(c: Char); +PROCEDURE CLS; +PROCEDURE Wait(b: Boolean); +FUNCTION DisplayARFlags(AR: ARFlagSet; C1,C2: Char): AStr; +PROCEDURE ToggleARFlag(Flag: Char; VAR AR: ARFlagSet; VAR Changed: Boolean); +FUNCTION DisplayACFlags(Flags: FlagSet; C1,C2: Char): AStr; +PROCEDURE ToggleACFlag(Flag: FlagType; VAR Flags: FlagSet); +PROCEDURE ToggleACFlags(Flag: Char; VAR Flags: FlagSet; VAR Changed: Boolean); +PROCEDURE ToggleStatusFlag(Flag: StatusFlagType; VAR SUFlags: StatusFlagSet); +PROCEDURE ToggleStatusFlags(Flag: Char; VAR SUFlags: StatusFlagSet); +FUNCTION TACCH(Flag: Char): FlagType; +PROCEDURE LCmds(Len,c: Byte; c1,c2: AStr); +PROCEDURE LCmds3(Len,c: Byte; c1,c2,c3: AStr); +PROCEDURE InitTrapFile; +FUNCTION AOnOff(b: Boolean; CONST s1,s2: AStr): STRING; +FUNCTION ShowOnOff(b: Boolean): STRING; +FUNCTION ShowYesNo(b: Boolean): STRING; +FUNCTION YN(Len: Byte; DYNY: Boolean): Boolean; +FUNCTION PYNQ(CONST InString: AStr; MaxLen: Byte; DYNY: Boolean): 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 InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean); +PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; v: STRING; Abortable: Boolean); +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); +PROCEDURE OneK(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean); +PROCEDURE OneK1(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean); +PROCEDURE LOneK(DisplayStr: AStr; VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean); +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); +FUNCTION Centre(InString: AStr): STRING; +PROCEDURE WKey; +PROCEDURE PrintMain(CONST ss: STRING); +PROCEDURE PrintACR(InString: STRING); +PROCEDURE SaveGeneral(X: Boolean); +PROCEDURE pfl(FN: AStr); +PROCEDURE PrintFile(FileName: AStr); +FUNCTION BSlash(InString: AStr; b: Boolean): AStr; +FUNCTION Exist(FileName: AStr): Boolean; +FUNCTION ExistDir(Path: PathStr): Boolean; +PROCEDURE PrintF(FileName: AStr); +PROCEDURE SKey1(VAR c: Char); +FUNCTION VerLine(B: Byte): STRING; +FUNCTION AACS1(User: UserRecordType; UNum: Integer; S: ACString): Boolean; +FUNCTION AACS(s: ACString): Boolean; +FUNCTION DiskKBFree(DrivePath: AStr): LongInt; +FUNCTION IntToStr(L: LongInt): STRING; + +IMPLEMENTATION + +USES + Common1, + Common2, + Common3, + Common4, + Events, + File0, + File11, + Mail0, + MultNode, +{$IFDEF MSDOS} + SpawnO, +{$ENDIF} + SysOp12, + Vote +{$IFDEF WIN32} + ,VPSysLow + ,VPUtils + ,Windows +{$ENDIF} + ; + +{$IFDEF WIN32} +procedure Sound(hz: Word; duration: Word); +begin + Windows.Beep(hz, duration); +end; + +function Ticks: LongInt; +begin + Ticks := GetTimeMSec div 55; +end; +{$ENDIF} + +{$IFDEF MSDOS} +FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt; EXTERNAL; +{$L CRC32.OBJ } +{$ENDIF} +{$IFDEF WIN32} +CONST + CRC_32_TAB : array[0..255] of LongInt = ( + $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, + $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, + $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, + $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de, + $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856, + $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, + $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, + $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, + $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, + $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a, + $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, + $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924, + $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, + $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, + $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e, + $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, + $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, + $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950, + $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, + $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, + $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a, + $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, + $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010, + $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, + $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, + $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, + $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, + $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, + $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344, + $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, + $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, + $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, + $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, + $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c, + $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, + $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236, + $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, + $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, + $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c, + $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713, + $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, + $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242, + $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, + $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c, + $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278, + $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, + $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66, + $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, + $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, + $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8, + $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, + $2d02ef8d); +FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt; +VAR + i: Integer; + Octet: ^Byte; +BEGIN + Octet := @buffer; + for i := 1 to Len do + begin + CRC := CRC_32_TAB[Byte(Crc XOR LongInt(Octet^))] XOR ((Crc SHR 8) AND $00FFFFFF); + Inc(Octet); + end; + UpdateCRC32 := CRC; +END; +{$ENDIF} + +FUNCTION CheckPW: Boolean; +BEGIN + CheckPW := Common1.CheckPW; +END; + +PROCEDURE NewCompTables; +BEGIN + Common1.NewCompTables; +END; + +PROCEDURE Wait(B: Boolean); +BEGIN + Common1.Wait(B); +END; + +PROCEDURE InitTrapFile; +BEGIN + Common1.InitTrapFile; +END; + +PROCEDURE Local_Input1(VAR S: STRING; MaxLen: Byte; LowerCase: Boolean); +BEGIN + Common1.Local_Input1(S,MaxLen,LowerCase); +END; + +PROCEDURE Local_Input(VAR S: STRING; MaxLen: Byte); +BEGIN + Common1.Local_Input(S,MaxLen); +END; + +PROCEDURE Local_InputL(VAR S: STRING; MaxLen: Byte); +BEGIN + Common1.Local_InputL(S,MaxLen); +END; + +PROCEDURE Local_OneK(VAR C: Char; S: STRING); +BEGIN + Common1.Local_OneK(C,S); +END; + +PROCEDURE SysOpShell; +BEGIN + Common1.SysOpShell; +END; + +PROCEDURE RedrawForANSI; +BEGIN + Common1.RedrawForANSI; +END; + +PROCEDURE SKey1(VAR C: Char); +BEGIN + Common2.SKey1(C); +END; + +PROCEDURE SaveGeneral(X: Boolean); +BEGIN + Common2.SaveGeneral(X); +END; + +PROCEDURE Update_Screen; +BEGIN + Common2.Update_Screen; +END; + +PROCEDURE lStatus_Screen(WhichScreen: Byte; Message: AStr; OneKey: Boolean; VAR Answer:AStr); +BEGIN + Common2.lStatus_Screen(WhichScreen,Message,OneKey,Answer); +END; + +PROCEDURE TLeft; +BEGIN + Common2.TLeft; +END; + +PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean); +BEGIN + Common3.InputLongIntWC(S,L,InputFlags,LowNum,HighNum,Changed); +END; + +PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt); +BEGIN + Common3.InputLongIntWOC(S,L,InputFlags,LowNum,HighNum); +END; + +PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); +BEGIN + Common3.InputWordWC(S,W,InputFlags,LowNum,HighNum,Changed); +END; + +PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word); +BEGIN + Common3.InputWordWOC(S,W,InputFlags,LowNum,HighNum); +END; + +PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); +BEGIN + Common3.InputIntegerWC(S,I,InputFlags,LowNum,HighNum,Changed); +END; + +PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer); +BEGIN + Common3.InputIntegerWOC(S,I,Inputflags,LowNum,HighNum); +END; + +PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean); +BEGIN + Common3.InputByteWC(S,B,InputFlags,LowNum,HighNum,Changed); +END; + +PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte); +BEGIN + Common3.InputByteWOC(S,B,InputFlags,LowNum,HighNum) +END; + +PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean); +BEGIN + Common3.InputDefault(S,v,MaxLen,InputFlags,LineFeed); +END; + +PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; v: STRING; Abortable: Boolean); +BEGIN + Common3.InputFormatted(DisplayStr,InputStr,v,Abortable); +END; + +PROCEDURE InputWN1(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; InputFlags: InputFlagSet; VAR Changed: Boolean); +BEGIN + Common3.InputWN1(DisplayStr,InputStr,MaxLen,InputFlags,Changed); +END; + +PROCEDURE InputWNWC(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; VAR Changed: Boolean); +BEGIN + Common3.InputWNWC(DisplayStr,InputStr,MaxLen,Changed); +END; + +PROCEDURE InputMain(VAR s: STRING; MaxLen: Byte; InputFlags: InputFlagSet); +BEGIN + Common3.InputMain(s,MaxLen,InputFlags); +END; + +PROCEDURE InputWC(VAR s: STRING; MaxLen: Byte); +BEGIN + Common3.InputWC(s,MaxLen); +END; + +PROCEDURE Input(VAR s: STRING; MaxLen: Byte); +BEGIN + Common3.Input(s,MaxLen); +END; + +PROCEDURE InputL(VAR s: STRING; MaxLen: Byte); +BEGIN + Common3.InputL(s,MaxLen); +END; + +PROCEDURE InputCaps(VAR s: STRING; MaxLen: Byte); +BEGIN + Common3.InputCaps(s,MaxLen); +END; + +PROCEDURE Com_Flush_Recv; +BEGIN + Common4.Com_Flush_Recv; +END; + +PROCEDURE Com_Flush_Send; +BEGIN + Common4.Com_Flush_Send; +END; + +PROCEDURE Com_Purge_Send; +BEGIN + Common4.Com_Purge_Send; +END; + +FUNCTION Com_Carrier: Boolean; +BEGIN + Com_Carrier := Common4.Com_Carrier; +END; + +FUNCTION Com_Recv: Char; +BEGIN + Com_Recv := Common4.Com_Recv; +END; + +FUNCTION Com_IsRecv_Empty: Boolean; +BEGIN + Com_IsRecv_Empty := Common4.Com_IsRecv_Empty; +END; + +FUNCTION Com_IsSend_Empty: Boolean; +BEGIN + Com_IsSend_Empty := Common4.Com_IsSend_Empty; +END; + +PROCEDURE Com_Send(c: Char); +BEGIN + Common4.Com_Send(c); +END; + +PROCEDURE Com_Set_Speed(Speed: LongInt); +BEGIN + Common4.Com_Set_Speed(Speed); +END; + +PROCEDURE Com_DeInstall; +BEGIN + Common4.Com_DeInstall; +END; + +PROCEDURE Com_Install; +BEGIN + Common4.Com_Install; +END; + +PROCEDURE CheckHangup; +BEGIN + Common4.checkhangup; +END; + +PROCEDURE SerialOut(s: STRING); +BEGIN + Common4.SerialOut(s); +END; + +FUNCTION Empty: Boolean; BEGIN + Empty := Common4.Empty; +END; + +PROCEDURE DTR(Status: Boolean); +BEGIN + Common4.DTR(Status); +END; + +PROCEDURE ShowColors; +VAR + Counter: Byte; +BEGIN + FOR Counter := 1 TO 10 DO + BEGIN + SetC(Scheme.Color[Counter]); + Prompt(IntToStr(Counter - 1)); + SetC(7); + Prompt(' '); + END; + NL; +END; + +FUNCTION CheckDriveSpace(S,Path: AStr; MinSpace: Integer): Boolean; +VAR + Drive: Char; + MinSpaceOk: Boolean; +BEGIN + MinSpaceOk := TRUE; + IF (DiskKBFree(Path) <= MinSpace) THEN + BEGIN + NL; + Star('Insufficient disk space.'); + Drive := Chr(ExtractDriveNumber(Path) + 64); + IF (Drive = '@') THEN + SysOpLog('^8--->^3 '+S+' failure: Main BBS drive full.') + ELSE + SysOpLog('^8--->^3 '+S+' failure: '+Drive+' Drive full.'); + MinSpaceOk := FALSE; + END; + CheckDriveSpace := MinSpaceOk; +END; + + +FUNCTION StripLeadSpace(S: STRING): STRING; +BEGIN + WHILE (S[1] = ' ') DO + Delete(S,1,1); + StripLeadSpace := S; +END; + +FUNCTION StripTrailSpace(S: STRING): STRING; +BEGIN + WHILE (S[1] = ' ') DO + Delete(S,1,1); + StripTrailSpace := S; +END; + +FUNCTION SemiCmd(S: AStr; B: Byte): STRING; +VAR + i, + p: Byte; +BEGIN + i := 1; + WHILE (i < B) AND (s <> '') DO + BEGIN + p := Pos(';',s); + IF (p <> 0) THEN + s := Copy(s,(p + 1),(Length(s) - p)) + ELSE + s := ''; + Inc(i); + END; + WHILE (Pos(';',s) <> 0) DO + s := Copy(s,1,(Pos(';',s) - 1)); + SemiCmd := s; +END; + +FUNCTION ExistDrive(Drive: Char): Boolean; +VAR + Found: Boolean; +BEGIN + ChDir(Drive+':'); + IF (IOResult <> 0) THEN + Found := FALSE + ELSE + BEGIN + ChDir(StartDir); + Found := TRUE; + END; + ExistDrive := Found; +END; + +PROCEDURE RenameFile(DisplayStr: AStr; OldFileName,NewFileName: AStr; VAR RenameOk: Boolean); +VAR + F: FILE; +BEGIN + Print(DisplayStr); + IF (NOT Exist(OldFileName)) THEN + BEGIN + NL; + Print('"'+OldFileName+'" does not exist, can not rename file.'); + ReNameOk := FALSE; + END + ELSE IF (Exist(NewFileName)) THEN + BEGIN + NL; + Print('"'+NewFileName+'" exists, file can not be renamed to "'+OldFileName+'".'); + ReNameOk := FALSE; + END + ELSE + BEGIN + Assign(F,OldFileName); + ReName(F,NewFileName); + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + NL; + Print('Error renaming file '+OldFileName+'.'); + ReNameOK := FALSE; + END; + END; +END; + +FUNCTION GetFileSize(FileName: AStr): LongInt; +VAR + DirInfo1: SearchRec; + FSize: LongInt; +BEGIN + FindFirst(FileName,AnyFile - Directory - VolumeID - DOS.Hidden - SysFile,DirInfo1); + IF (DosError <> 0) THEN + FSize := -1 + ELSE + FSize := DirInfo1.Size; + GetFileSize := FSize; +END; + +PROCEDURE GetFileDateTime(CONST FileName: AStr; VAR FileTime: LongInt); +VAR + F: FILE; +BEGIN + FileTime := 0; + IF Exist(SQOutSp(FileName)) THEN + BEGIN + Assign(F,SQOutSp(FileName)); + Reset(F); + GetFTime(F,FileTime); + Close(F); + LastError := IOResult; + END; +END; + +PROCEDURE SetFileDateTime(CONST FileName: AStr; FileTime: LongInt); +VAR + F: FILE; +BEGIN + IF Exist(SQOutSp(FileName)) THEN + BEGIN + Assign(F,SQOutSp(FileName)); + Reset(F); + SetFTime(F,FileTime); + Close(F); + LastError := IOResult; + END; +END; + +FUNCTION PHours(CONST DisplayStr: AStr; LoTime,HiTime: Integer): AStr; +BEGIN + IF (LoTime <> HiTime) THEN + PHours := ZeroPad(IntToStr(LoTime DIV 60))+':'+ZeroPad(IntToStr(LoTime MOD 60))+'....'+ + ZeroPad(IntToStr(HiTime DIV 60))+':'+ZeroPad(IntToStr(HiTime MOD 60)) + ELSE + PHours := DisplayStr; +END; + +FUNCTION RGSysCfgStr(StrNum: LongInt; PassValue: Boolean): AStr; +VAR + StrPointerFile: FILE OF StrPointerRec; + StrPointer: StrPointerRec; + RGStrFile: FILE; + S: STRING; + TotLoad: LongInt; +BEGIN + Assign(StrPointerFile,General.LMultPath+'RGSCFGPR.DAT'); + Reset(StrPointerFile); + Seek(StrPointerFile,StrNum); + Read(StrPointerFile,StrPointer); + Close(StrPointerFile); + LastError := IOResult; + TotLoad := 0; + Assign(RGStrFile,General.LMultPath+'RGSCFGTX.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 (PassValue) THEN + BEGIN + IF (S[Length(s)] = '@') THEN + Dec(S[0]); + END + ELSE + BEGIN + IF (S[Length(S)] = '@') THEN + BEGIN + Dec(S[0]); + Prt(S); + END + ELSE + PrintACR(S); + END; + UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp); + Close(RGStrFile); + LastError := IOResult; + RGSysCfgStr := S; +END; + +FUNCTION RGNoteStr(StrNum: LongInt; PassValue: Boolean): AStr; +VAR + StrPointerFile: FILE OF StrPointerRec; + StrPointer: StrPointerRec; + RGStrFile: FILE; + S: STRING; + TotLoad: LongInt; +BEGIN + Assign(StrPointerFile,General.LMultPath+'RGNOTEPR.DAT'); + Reset(StrPointerFile); + Seek(StrPointerFile,StrNum); + Read(StrPointerFile,StrPointer); + Close(StrPointerFile); + LastError := IOResult; + TotLoad := 0; + Assign(RGStrFile,General.LMultPath+'RGNOTETX.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 (PassValue) THEN + BEGIN + IF (S[Length(s)] = '@') THEN + Dec(S[0]); + END + ELSE + BEGIN + IF (S[Length(S)] = '@') THEN + BEGIN + Dec(S[0]); + Prt(S); + END + ELSE + PrintACR(S); + END; + UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp); + Close(RGStrFile); + LastError := IOResult; + RGNoteStr := S; +END; + +FUNCTION RGMainStr(StrNum: LongInt; PassValue: Boolean): AStr; +VAR + StrPointerFile: FILE OF StrPointerRec; + StrPointer: StrPointerRec; + RGStrFile: FILE; + S: STRING; + TotLoad: LongInt; +BEGIN + Assign(StrPointerFile,General.LMultPath+'RGMAINPR.DAT'); + Reset(StrPointerFile); + Seek(StrPointerFile,StrNum); + Read(StrPointerFile,StrPointer); + Close(StrPointerFile); + LastError := IOResult; + TotLoad := 0; + Assign(RGStrFile,General.LMultPath+'RGMAINTX.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 (PassValue) THEN + BEGIN + IF (S[Length(s)] = '@') THEN + Dec(S[0]); + END + ELSE + BEGIN + IF (S[Length(S)] = '@') THEN + BEGIN + Dec(S[0]); + Prt(S); + END + ELSE + PrintACR(S); + END; + UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp); + Close(RGStrFile); + LastError := IOResult; + RGMainStr := S; +END; + +FUNCTION lRGLngStr(StrNum: LongInt; PassValue: Boolean): AStr; +VAR + StrPointerFile: FILE OF StrPointerRec; + StrPointer: StrPointerRec; + RGStrFile: FILE; + S: STRING; + TotLoad: LongInt; +BEGIN + Assign(StrPointerFile,General.LMultPath+'RGLNGPR.DAT'); + Reset(StrPointerFile); + Seek(StrPointerFile,StrNum); + Read(StrPointerFile,StrPointer); + Close(StrPointerFile); + LastError := IOResult; + TotLoad := 0; + Assign(RGStrFile,General.LMultPath+'RGLNGTX.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 (PassValue) THEN + BEGIN + IF (S[Length(s)] = '@') THEN + Dec(S[0]); + END + ELSE + BEGIN + IF (S[Length(S)] = '@') THEN + BEGIN + Dec(S[0]); + Prt(S); + END + ELSE + PrintACR(S); + END; + UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp); + Close(RGStrFile); + LastError := IOResult; + lRGLNGStr := S; +END; + +PROCEDURE GetPassword(VAR PW: AStr; Len: Byte); +BEGIN + PW := ''; + Echo := FALSE; + Input(PW,Len); + Echo := TRUE; +END; + +PROCEDURE MakeDir(VAR Path: PathStr; AskMakeDir: Boolean); +VAR + CurDir: PathStr; + Counter: Byte; +BEGIN + IF (Path = '') THEN + BEGIN + NL; + Print('^7A valid path must be specified!^1'); + END + ELSE IF (NOT (Path[1] IN ['A'..'Z'])) OR (Length(Path) < 3) OR + (NOT (Path[2] = ':')) OR (NOT (Path[3] = '\')) THEN + BEGIN + NL; + Print('^7Invalid drive specification: "'+Path+'"^1'); + END + ELSE + BEGIN + GetDir(0,CurDir); + ChDir(Path[1]+':'); + IF (IOResult <> 0) THEN + BEGIN + NL; + Print('^7Drive does not exist: "'+Path[1]+'"^1'); + END + ELSE + ChDir(CurDir); + END; + + Path := BSlash(Path,TRUE); + IF (Length(Path) > 3) AND (NOT ExistDir(Path)) THEN + BEGIN + NL; + IF (NOT AskMakeDir) OR PYNQ('Directory does not exist, create it? ',0,FALSE) THEN + BEGIN + Counter := 2; + WHILE (Counter <= Length(Path)) DO + BEGIN + IF (Path[Counter] = '\') THEN + BEGIN + IF (Path[Counter - 1] <> ':') THEN + BEGIN + IF (NOT ExistDir(Copy(Path,1,(Counter - 1)))) THEN + BEGIN + MkDir(Copy(Path,1,(Counter - 1))); + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + NL; + Print('^7Error creating directory!^1'); + SysOpLog('^7Error creating directory: '+Copy(Path,1,(Counter - 1))); + PauseScr(FALSE); + END; + END; + END; + END; + Inc(Counter); + END; + END; + END; + +END; + +PROCEDURE Messages(Msg,MaxRecs: Integer; AreaName: AStr); +VAR + MsgStr: AStr; +BEGIN + MsgStr := ''; + NL; + CASE Msg OF + 1 : MsgStr := '^7Invalid record number!^1'; + 2 : MsgStr := '^7You are at the first valid record!^1'; + 3 : MsgStr := '^7You are at the last valid record!^1'; + 4 : MsgStr := '^7No '+AreaName+' exist!^1'; + 5 : MsgStr := '^7No more then '+IntToStr(MaxRecs)+' '+AreaName+' can exist!^1'; + 6 : MsgStr := '^7No '+AreaName+' to position!^1'; + 7 : MsgStr := '^7Invalid drive!^1'; + 8 : MsgStr := '^7Invalid record number order!^1'; + END; + PrintACR('^1'+MsgStr); + PauseScr(FALSE); +END; + + +FUNCTION ReadBuffer(FileName: AStr): Boolean; +VAR + BufferFile: FILE; + MCIBufferSize, + NumRead: Integer; +BEGIN + IF (MCIBuffer = NIL) THEN + New(MCIBuffer); + + ReadBuffer := FALSE; + + IF ((Pos('\',FileName) = 0) AND (Pos(':', FileName) = 0)) THEN + FileName := General.MiscPath+FileName; + + IF (Pos('.',FileName) = 0) THEN + BEGIN + IF (OkRIP) AND Exist(FileName+'.RIP') THEN + FileName := FileName+'.RIP' + ELSE IF (OkAvatar) AND Exist(FileName+'.AVT') THEN + FileName := FileName+'.AVT' + ELSE IF (OkANSI) AND Exist(FileName+'.ANS') THEN + FileName := FileName+'.ANS' + ELSE IF (Exist(FileName+'.ASC')) THEN + FileName := FileName+'.ASC'; + END; + + IF (NOT Exist(FileName)) THEN + Exit; + + Assign(BufferFile,FileName); + Reset(BufferFile,1); + + IF (IOResult <> 0) THEN + Exit; + + IF (FileSize(BufferFile) < MaxConfigurable) THEN + MCIBufferSize := FileSize(BufferFile) + ELSE + MCIBufferSize := MaxConfigurable; + + FillChar(MCIBuffer^,SizeOf(MCIBuffer^),0); + + BlockRead(BufferFile,MCIBuffer^,MCIBufferSize,NumRead); + + IF (NumRead <> MCIBufferSize) THEN + Exit; + + Close(BufferFile); + ReadBuffer := TRUE; +END; + +PROCEDURE DisplayBuffer(MCIFunction: MCIFunctionType; Data1,Data2: Pointer); +VAR + TempStr: STRING; + cs: AStr; + Justify: Byte; {0=Right, 1=Left, 2=Center} + Counter, + X2: Integer; +BEGIN + Counter := 1; + WHILE (Counter <= MaxConfigurable) AND (MCIBuffer^[Counter] <> #0) DO + BEGIN + TempStr := ''; + WHILE (Counter <= MaxConfigurable) AND (MCIBuffer^[Counter] <> #13) DO + IF (MCIBuffer^[Counter] = '~') AND (Counter + 2 <= MaxConfigurable) THEN + BEGIN + cs := MCIFunction(MCIBuffer^[Counter + 1] + MCIBuffer^[Counter + 2],Data1,Data2); + IF (cs = MCIBuffer^[Counter + 1] + MCIBuffer^[Counter + 2]) THEN + BEGIN + TempStr := TempStr + '~'; + Inc(Counter); + Continue; + END; + Inc(Counter,3); + IF ((Counter + 1) <= MaxConfigurable) AND (MCIBuffer^[Counter] IN ['#','{','}']) THEN + BEGIN + IF (MCIBuffer^[Counter] = '}') THEN + Justify := 0 + ELSE IF (MCIBuffer^[Counter] = '{') THEN + Justify := 1 + ELSE + Justify := 2; + IF (MCIBuffer^[Counter + 1] IN ['0'..'9']) THEN + BEGIN + X2 := Ord(MCIBuffer^[Counter + 1]) - 48; + Inc(Counter, 2); + IF (MCIBuffer^[Counter] IN ['0'..'9']) THEN + BEGIN + X2 := X2 * 10 + Ord(MCIBuffer^[Counter]) - 48; + Inc(Counter,1); + END; + IF (X2 > 0) THEN + CASE Justify OF + 0 : cs := PadRightStr(cs,X2); + 1 : cs := PadLeftStr(cs,X2); + 2 : WHILE (Length(cs) < X2) DO + BEGIN + cs := ' ' + cs; + IF (Length(cs) < X2) THEN + cs := cs + ' '; + END; + END; + END; + END; + IF ((Length(cs) + Length(TempStr)) <= 255) THEN + BEGIN + Move(cs[1],TempStr[Length(TempStr)+1],Length(cs)); + Inc(TempStr[0],Length(cs)); + END + ELSE + IF (Length(TempStr) < 255) THEN + BEGIN + Move(cs[1],TempStr[Length(TempStr) + 1],(255 - Length(TempStr))); + TempStr[0] := #255; + END; + END + ELSE + BEGIN + Inc(TempStr[0]); + TempStr[Length(TempStr)] := MCIBuffer^[Counter]; + Inc(Counter); + END; + + IF (Counter <= MaxConfigurable) AND (MCIBuffer^[Counter] = #13) THEN + Inc(Counter,2); + CROff := TRUE; + PrintACR(TempStr); + END; +END; + +FUNCTION Chinkey: Char; +VAR + C: Char; +BEGIN + C := #0; + Chinkey := #0; + IF (KeyPressed) THEN + BEGIN + C := ReadKey; + IF (NOT WColor) THEN + UserColor(General.SysOpColor); + WColor := TRUE; + IF (C = #0) THEN + IF (KeyPressed) THEN + BEGIN + C := ReadKey; + SKey1(C); + IF (C = #31) OR (C = #46) THEN + C := #1 + ELSE IF (Buf <> '') THEN + BEGIN + C := Buf[1]; + Buf := Copy(Buf,2,(Length(Buf) - 1)); + END + ELSE + C := #0 + END; + Chinkey := C; + END + ELSE IF ((NOT Com_IsRecv_Empty) AND (InCom)) THEN + BEGIN + C := CInKey; + IF (WColor) THEN + UserColor(General.UserColor); + WColor := FALSE; + Chinkey := C; + END; +END; + +FUNCTION FormatNumber(L: LongInt): STRING; +VAR + S: STRING; + StrLen, + Counter: Byte; +BEGIN + S := ''; + Str(L,S); + StrLen := Length(S); + Counter := 0; + WHILE (StrLen > 1) DO + BEGIN + Inc(Counter); + IF (Counter = 3) THEN + BEGIN + Insert(',',S,StrLen); + Counter := 0; + END; + Dec(StrLen); + END; + FormatNumber := S; +END; + +FUNCTION ConvertBytes(BytesToConvert: LongInt; OneChar: Boolean): STRING; +CONST + InByte = 1; + InKilo = 1024; + InMega = 1048576; + InGiga = 1073741824; +VAR + InSize, + InMod: LongInt; + InTypes: Str5; +BEGIN + InMod := 0; + InTypes := ''; + IF (BytesToConvert < 0) THEN + Exit; + IF (BytesToConvert < InKilo) THEN {Bytes Convertion} + BEGIN + InSize := BytesToConvert; + InTypes := 'Bytes'; + END + ELSE IF (BytesToConvert < InMega) THEN {Kilo Convertion} + BEGIN + InSize := (BytesToConvert DIV InKilo); + InMod := Trunc(((BytesToConvert Mod InKilo) / InKilo) * 10.0); + InTypes := 'KB'; + END + ELSE IF (BytesToConvert < InGiga) THEN {Mega Convertion} + BEGIN + InSize := (BytesToConvert DIV InMega); + InMod := Trunc(((BytesToConvert Mod InMega) / InMega) * 10.0); + InTypes := 'MB'; + END + ELSE IF ((BytesToConvert - 1) > InGiga) THEN {GigaByte Conversion} + BEGIN + InSize := (BytesToConvert DIV InGiga); + InMod := Trunc(((BytesToConvert Mod InGiga) / InGiga) * 10.0); + InTypes := 'GB'; + END; + IF (InMod = 0) THEN + ConvertBytes := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize)+' ') + +AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes) + ELSE + ConvertBytes := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize))+'.' + +AOnOff(OneChar,IntToStr(InMod),IntToStr(InMod)+' ') + +AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes); +END; + +FUNCTION ConvertKB(KBToConvert: LongInt; OneChar: Boolean): STRING; +CONST + InKilo = 1; + InMega = 1024; + InGiga = 1048576; + InTera = 1073741824; +VAR + InSize, + InMod: LongInt; + InTypes: Str5; +BEGIN + InMod := 0; + InTypes := ''; + IF (KBToConvert < 0) THEN + Exit; + IF (KBToConvert < InMega) THEN {KILO Convertion} + BEGIN + InSize := KBToConvert; + InTypes := 'KB'; + END + ELSE IF (KBToConvert < InGiga) THEN {MEGA Convertion} + BEGIN + InSize := (KBToConvert DIV InMega); + InMod := Trunc(((KBToConvert Mod InMega) / InMega) * 10.0); + InTypes := 'MB'; + END + ELSE IF (KBToConvert < InTera) THEN {Giga Convertion} + BEGIN + InSize := (KBToConvert DIV InGiga); + InMod := Trunc(((KBToConvert Mod InGiga) / InGiga) * 10.0); + InTypes := 'GB'; + END + ELSE IF ((KBToConvert - 1) > InTera) THEN {TeraByte Conversion} + BEGIN + InSize := (KBToConvert DIV InTera); + InMod := Trunc(((KBToConvert Mod InTera) / InTera) * 10.0); + InTypes := 'TB'; + END; + IF (InMod = 0) THEN + ConvertKB := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize)+' ') + +AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes) + ELSE + ConvertKB := AOnOff(OneChar,IntToStr(InSize),FormatNumber(InSize))+'.' + +AOnOff(OneChar,IntToStr(InMod),IntToStr(InMod)+' ') + +AOnOff(OneChar,Char(Ord(InTypes[1]) + 32),InTypes); +END; + +PROCEDURE WriteWFC(c: Char); +VAR + LastAttr: Byte; +BEGIN + IF (BlankMenuNow) THEN + Exit; + Window(23,11,78,15); + GotoXY(LastWFCX,LastWFCY); + LastAttr := TextAttr; + TextAttr := 7; + Write(c); + TextAttr := LastAttr; + LastWFCX := WhereX; + LastWFCY := WhereY; + Window(1,1,MaxDisplayCols,MaxDisplayRows); +END; + +FUNCTION AccountBalance: LongInt; +BEGIN + AccountBalance := (ThisUser.lCredit - ThisUser.Debit); +END; + +PROCEDURE AdjustBalance(Adjustment: LongInt); +BEGIN + IF (Adjustment > 0) THEN + Inc(ThisUser.Debit,Adjustment) { Add TO debits } + ELSE + Dec(ThisUser.lCredit,Adjustment); { Add TO credits } +END; + +FUNCTION CRC32(S: AStr): LongInt; +BEGIN + CRC32 := NOT (UpdateCRC32($FFFFFFFF,S[1],Length(S))); +END; + +PROCEDURE Kill(CONST FileName: AStr); +VAR + F: FILE; +BEGIN + Assign(F,FileName); + Erase(F); + LastError := IOResult; +END; + +PROCEDURE BackSpace; +BEGIN + IF (OutCom) THEN + SerialOut(^H' '^H); + IF (WantOut) THEN + Write(^H' '^H); +END; + +PROCEDURE DoBackSpace(Start,Finish: Byte); +VAR + Counter: Byte; +BEGIN + FOR Counter := Start TO Finish DO + BEGIN + IF (OutCom) THEN + SerialOut(^H' '^H); + IF (WantOut) THEN + Write(^H' '^H); + END; +END; + +FUNCTION Substitute(Src: STRING; CONST old,New: STRING): STRING; +VAR + p, + Diff, + LastP: Integer; +BEGIN + IF (old <> New) THEN + BEGIN + LastP := 0; + Diff := Length(New) - Length(old); + REPEAT + p := Pos(old,Copy(Src,LastP,255)); + IF (p > 0) THEN + BEGIN + IF (Diff <> 0) THEN + BEGIN + Move(Src[p + Length(old)],Src[p + Length(New)],(Length(Src) - p)); + Inc(Src[0],Diff); + END; + Move(New[1],Src[p],Length(New)); + LastP := p + Length(New); + END; + UNTIL (p = 0); + END; + Substitute := Src; +END; + +PROCEDURE DOSANSI(CONST c:Char); +VAR + i:Word; +label Command; + +BEGIN + IF (c = #27) AND (NextState IN [Waiting..In_Param]) THEN + BEGIN + NextState := Bracket; + Exit; + END; + + IF (c = ^V) AND (NextState = Waiting) THEN + BEGIN + NextState := GetAvCmd; + Exit; + END; + + IF (c = ^y) AND (NextState = Waiting) THEN + BEGIN + NextState := GetAvRLE1; + Exit; + END; + + CASE NextState OF + Waiting : IF (c = #9) THEN + GotoXY((WhereX + 8),WhereY) + ELSE + Write(c); + GetAvRLE1: + BEGIN + ParamArr[1] := Ord(c); + NextState := GetAvRLE2; + END; + GetAvRLE2: + BEGIN + FOR i := 1 TO Ord(c) DO + Write(Chr(ParamArr[1])); + NextState := Waiting; + END; + GetAvAttr: + BEGIN + TextAttr := Ord(c) AND $7f; + NextState := Waiting; + END; + GetAvY: + BEGIN + ParamArr[1] := Ord(c); + NextState := GetAvX; + END; + GetAvX: + BEGIN + GotoXY(Ord(c),ParamArr[1]); + NextState := Waiting; + END; + GetAvCmd: CASE c OF + ^A : NextState := GetAvAttr; + ^B : BEGIN + TextAttr := TextAttr OR $80; + NextState := Waiting; + END; + ^C : BEGIN + GotoXY(WhereX,(WhereY - 1)); + NextState := Waiting; + END; + ^d : BEGIN + GotoXY(WhereX,(WhereY + 1)); + NextState := Waiting; + END; + ^E : BEGIN + GotoXY((WhereX - 1),WhereY); + NextState := Waiting; + END; + ^F : + BEGIN + GotoXY((WhereX + 1),WhereY); + NextState := Waiting; + END; + ^G : + BEGIN + ClrEOL; + NextState := Waiting; + END; + ^H : NextState := GetAvY; + ELSE + NextState := Waiting; + END; + Bracket : + BEGIN + IF c <> '[' THEN + BEGIN + NextState := Waiting; + Write(c); + END + ELSE + BEGIN + Params := 1; + FillChar(ParamArr,5,0); + NextState := Get_Args; + END; + END; + Get_Args,Get_Param,Eat_Semi : + BEGIN + IF (NextState = Eat_Semi) AND (c = ';') THEN + BEGIN + IF (Params < 5) THEN + Inc(Params); + NextState := Get_Param; + Exit; + END; + CASE c OF + '0'..'9' : + BEGIN + ParamArr[Params] := Ord(c) - 48; + NextState := In_Param; + END; + ';' : + BEGIN + IF (Params < 5) THEN + Inc(Params); + NextState := Get_Param; + END; + ELSE + goto Command; + END {CASE c} ; + END; + In_Param : { last Char was a digit } + BEGIN + { looking FOR more digits, a semicolon, OR a command Char } + CASE c OF + '0'..'9' : + BEGIN + ParamArr[Params] := ParamArr[Params] * 10 + Ord(c) - 48; + NextState := In_Param; + Exit; + END; + ';' : + BEGIN + IF (Params < 5) THEN + Inc(Params); + NextState := Eat_Semi; + Exit; + END; + END {CASE c} ; + Command: + NextState := Waiting; + CASE c OF + { Note: the order OF commands is optimized FOR execution speed } + 'm' : {sgr} + BEGIN + FOR i := 1 TO Params DO + BEGIN + IF (Reverse) THEN + TextAttr := TextAttr SHR 4 + TextAttr SHL 4; + CASE ParamArr[i] OF + 0 : + BEGIN + Reverse := FALSE; + TextAttr := 7; + END; + 1 : TextAttr := TextAttr AND $FF OR $08; + 2 : TextAttr := TextAttr AND $F7 OR $00; + 4 : TextAttr := TextAttr AND $F8 OR $01; + 5 : TextAttr := TextAttr OR $80; + 7 : IF NOT Reverse THEN + BEGIN + { + TextAttr := TextAttr SHR 4 + TextAttr SHL 4; + } + Reverse := TRUE; + END; + 22 : TextAttr := TextAttr AND $F7 OR $00; + 24 : TextAttr := TextAttr AND $F8 OR $04; + 25 : TextAttr := TextAttr AND $7F OR $00; + 27 : IF Reverse THEN + BEGIN + Reverse := FALSE; + { + TextAttr := TextAttr SHR 4 + TextAttr SHL 4; + } + END; + 30 : TextAttr := TextAttr AND $F8 OR $00; + 31 : TextAttr := TextAttr AND $F8 OR $04; + 32 : TextAttr := TextAttr AND $F8 OR $02; + 33 : TextAttr := TextAttr AND $F8 OR $06; + 34 : TextAttr := TextAttr AND $F8 OR $01; + 35 : TextAttr := TextAttr AND $F8 OR $05; + 36 : TextAttr := TextAttr AND $F8 OR $03; + 37 : TextAttr := TextAttr AND $F8 OR $07; + 40 : TextAttr := TextAttr AND $8F OR $00; + 41 : TextAttr := TextAttr AND $8F OR $40; + 42 : TextAttr := TextAttr AND $8F OR $20; + 43 : TextAttr := TextAttr AND $8F OR $60; + 44 : TextAttr := TextAttr AND $8F OR $10; + 45 : TextAttr := TextAttr AND $8F OR $50; + 46 : TextAttr := TextAttr AND $8F OR $30; + 47 : TextAttr := TextAttr AND $8F OR $70; + END {CASE} ; + { fixup FOR reverse } + IF (Reverse) THEN + TextAttr := TextAttr SHR 4 + TextAttr SHL 4; + END; + END; + 'A' : {cuu} + BEGIN + IF (ParamArr[1] = 0) THEN + ParamArr[1] := 1; + {IF (WhereY - ParamArr[1] >= 1) + THEN} GotoXY(WhereX,(WhereY - ParamArr[1])) + {ELSE GotoXY(WhereX, 1);} + END; + 'B' : {cud} + BEGIN + IF ParamArr[1] = 0 THEN ParamArr[1] := 1; + {IF (WhereY + ParamArr[1] <= Hi(WindMax) - Hi(WindMin) + 1) + THEN }GotoXY(WhereX, WhereY + ParamArr[1]) + {ELSE GotoXY(WhereX, Hi(WindMax) - Hi(WindMin) + 1);} + END; + 'C' : {cuf} + BEGIN + IF ParamArr[1] = 0 THEN ParamArr[1] := 1; + {IF (WhereX + ParamArr[1] <= Lo(WindMax) - Lo(WindMin) + 1) + THEN} GotoXY(WhereX + ParamArr[1], WhereY) + {ELSE GotoXY(Lo(WindMax) - Lo(WindMin) + 1, WhereY);} + END; + 'D' : {cub} + BEGIN + IF (ParamArr[1] = 0) THEN ParamArr[1] := 1; + {IF (WhereX - ParamArr[1] >= 1) + THEN} GotoXY(WhereX - ParamArr[1], WhereY) + {ELSE GotoXY(1, WhereY);} + END; + 'H', 'f' : {cup,hvp} + BEGIN + IF (ParamArr[1] = 0) THEN ParamArr[1] := 1; + IF (ParamArr[2] = 0) THEN ParamArr[2] := 1; + + {IF (ParamArr[2] > Lo(WindMax) + 1) + THEN ParamArr[2] := Lo(WindMax) - Lo(WindMin) + 1; + IF (ParamArr[1] > Hi(WindMax) + 1) + THEN ParamArr[1] := Hi(WindMax) - Hi(WindMin) + 1;} + GotoXY(ParamArr[2], ParamArr[1]) ; + END; + 'J' : IF (ParamArr[1] = 2) THEN ClrScr + ELSE + FOR i := WhereY TO 25 DO delline; { some terms use others! } + 'K' : ClrEOL; + 'L' : IF (ParamArr[1] = 0) THEN + insline + ELSE + FOR i := 1 TO ParamArr[1] DO insline; { must NOT Move cursor } + 'M' : IF (ParamArr[1] = 0) THEN + delline + ELSE + FOR i := 1 TO ParamArr[1] DO delline; { must NOT Move cursor } + 'P' : {dc } + BEGIN + END; + 's' : {scp} + BEGIN + SaveX := WhereX; + SaveY := WhereY; + END; + 'u' : {rcp} GotoXY(SaveX,SaveY); + '@':; { Some unknown code appears TO DO nothing } + ELSE + Write(c); + END {CASE c} ; + END; + END {CASE NextState} ; +END {AnsiWrite} ; + +PROCEDURE ShellDos(MakeBatch: Boolean; CONST Command: AStr; VAR ResultCode: Integer); +VAR + BatFile: Text; + FName, + s: AStr; +BEGIN + IF (NOT MakeBatch) THEN + FName := Command + ELSE + BEGIN + FName := 'TEMP'+IntToStr(ThisNode)+'.BAT'; + Assign(BatFile,FName); + ReWrite(BatFile); + WriteLn(BatFile,Command); + Close(BatFile); + LastError := IOResult; + END; + + IF (FName <> '') THEN + FName := ' /c '+FName; + + Com_Flush_Send; + + Com_DeInstall; + + CursorOn(TRUE); + + SwapVectors; + +{$IFDEF MSDOS} + IF (General.SwapShell) THEN + BEGIN + s := GetEnv('TEMP'); + IF (s = '') THEN + s := StartDir; + Init_SpawNo(s,General.SwapTo,20,10); + ResultCode := Spawn(GetEnv('COMSPEC'),FName,0); + END; +{$ENDIF} +{$IFDEF WIN32} + ResultCode := -1; +{$ENDIF} + + IF (NOT General.SwapShell) OR (ResultCode = -1) THEN + BEGIN + Exec(GetEnv('COMSPEC'),FName); + ResultCode := Lo(DOSExitCode); + LastError := IOResult; + END; + + SwapVectors; + + IF (MakeBatch) THEN + Kill(FName); + + Com_Install; + + IF (NOT LocalIOOnly) AND NOT (lockedport IN Liner.mflags) THEN + Com_Set_Speed(ComPortSpeed); + + Update_Screen; + + TextAttr := CurrentColor; + + LastKeyHit := Timer; +END; + +FUNCTION LennMCI(CONST InString: STRING): Integer; +VAR + TempStr: STRING; + Counter, + StrLen: Byte; +BEGIN + StrLen := Length(InString); + Counter := 0; + WHILE (Counter < Length(InString)) DO + BEGIN + Inc(Counter); + CASE InString[Counter] OF + ^S : BEGIN + Dec(StrLen,2); + Inc(Counter); + END; + '^' : IF (Length(InString) > Counter) AND (InString[Counter + 1] IN ['0'..'9']) THEN + BEGIN + Dec(StrLen,2); + Inc(Counter); + END; + '|' : IF (Length(InString) > (Counter + 1)) AND (InString[Counter + 1] IN ['0'..'9']) AND + (Instring[Counter + 2] IN ['0'..'9']) THEN + BEGIN + Dec(StrLen,3); + Inc(Counter); + END; + '%' : IF (MCIAllowed) AND (Length(InString) > (Counter + 1)) THEN + BEGIN + TempStr := AllCaps(MCI('%' + InString[Counter + 1] + InString[Counter + 2])); + IF (Copy(TempStr,1,3) <> '%' + UpCase(InString[Counter + 1]) + UpCase(InString[Counter + 2])) THEN + Inc(StrLen,Length(TempStr) - 3); + END; + END; + END; + LennMCI := StrLen; +END; + +{$V-} +PROCEDURE LCmds3(Len,c: Byte; c1,c2,c3: AStr); +VAR + s: AStr; +BEGIN + s := ''; + s := s+'^1(^'+Chr(c + Ord('0'))+c1[1]+'^1)'+PadLeftStr(Copy(c1,2,LennMCI(c1)-1),Len-1); + IF (c2 <> '') THEN + s := s+'^1(^'+Chr(c + Ord('0')) + c2[1]+'^1)'+PadLeftStr(Copy(c2,2,LennMCI(c2)-1),Len-1); + IF (c3 <> '') THEN + s := s+'^1(^'+Chr(c + Ord('0')) + c3[1]+'^1)'+Copy(c3,2,LennMCI(c3)-1); + PrintACR(s); +END; + +PROCEDURE LCmds(Len,c: Byte; c1,c2: AStr); +VAR + s: AStr; +BEGIN + s := Copy(c1,2,LennMCI(c1) - 1); + IF (c2 <> '') THEN + s := PadLeftStr(s,Len - 1); + Prompt('^1(^' + IntToStr(c) + c1[1] + '^1)' + s); + IF (c2 <> '') THEN + Prompt('^1(^' + IntToStr(c) + c2[1] + '^1)' + Copy(c2,2,LennMCI(c2) - 1)); + NL; +END; + +FUNCTION MsgSysOp: Boolean; +BEGIN + MsgSysOp := (CoSysOp) OR (AACS(General.MSOP)) OR (AACS(MemMsgArea.SysOpACS)); +END; + +FUNCTION FileSysOp: Boolean; +BEGIN + FileSysOp := ((CoSysOp) OR (AACS(General.FSOP))); +END; + +FUNCTION CoSysOp: Boolean; +BEGIN + CoSysOp := ((SysOp) OR (AACS(General.CSOP))); +END; + +FUNCTION SysOp: Boolean; +BEGIN + SysOp := (AACS(General.SOP)); +END; + +FUNCTION Timer: LongInt; +BEGIN + Timer := ((Ticks * 5) DIV 91); { 2.5 times faster than Ticks DIV 18.2 } +END; + +FUNCTION OkVT100: Boolean; +BEGIN + OkVT100 := (VT100 IN ThisUser.Flags); +END; + +FUNCTION OkANSI: Boolean; +BEGIN + OkANSI := (ANSI IN ThisUser.Flags); +END; + +FUNCTION OkRIP: Boolean; +BEGIN + OkRIP := (RIP IN ThisUser.SFlags); +END; + +FUNCTION OkAvatar: Boolean; +BEGIN + OkAvatar := (Avatar IN ThisUser.Flags); +END; + +FUNCTION NSL: LongInt; +VAR + BeenOn: LongInt; +BEGIN + IF ((UserOn) OR (NOT InWFCMenu)) THEN + BEGIN + BeenOn := (GetPackDateTime - TimeOn); + NSL := ((LongInt(ThisUser.TLToday) * 60 + ExtraTime + FreeTime) - (BeenOn + ChopTime + CreditTime)); + END + ELSE + NSL := 3600; +END; + +FUNCTION StripColor(CONST InString: STRING): STRING; +VAR + TempStr: STRING; + Counter: Byte; +BEGIN + TempStr := ''; + Counter := 0; + WHILE (Counter < Length(InString)) DO + BEGIN + Inc(Counter); + CASE InString[Counter] OF + ^S : Inc(Counter); + '^' : IF (InString[Counter + 1] IN ['0'..'9']) THEN + Inc(Counter) + ELSE + TempStr := TempStr + '^'; + '|' : IF (InString[Counter + 1] IN ['0'..'9']) AND (InString[Counter + 2] IN ['0'..'9']) THEN + Inc(Counter,2) + ELSE + TempStr := TempStr + '|'; + ELSE + TempStr := TempStr + InString[Counter]; + END; + END; + StripColor := TempStr; +END; + +PROCEDURE sl1(s: AStr); +BEGIN + IF (SLogging) THEN + BEGIN + S := S + '^1'; + + IF (General.StripCLog) THEN + s := StripColor(s); + + Append(SysOpLogFile); + IF (IOResult = 0) THEN + BEGIN + WriteLn(SysOpLogFile,s); + Close(SysOpLogFile); + LastError := IOResult; + END; + + IF (SLogSeparate IN ThisUser.SFlags) THEN + BEGIN + Append(SysOpLogFile1); + IF (IOResult = 0) THEN + BEGIN + WriteLn(SysOpLogFile1,s); + Close(SysOpLogFile1); + LastError := IOResult; + END; + END; + + END; +END; + +PROCEDURE SysOpLog(s:AStr); +BEGIN + sl1(' '+s); +END; + +FUNCTION StrToInt(S: Str11): LongInt; +VAR + I: Integer; + L: LongInt; +BEGIN + Val(S,L,I); + IF (I > 0) THEN + BEGIN + S[0] := Chr(I - 1); + Val(S,L,I) + END; + IF (S = '') THEN + StrToInt := 0 + ELSE + StrToInt := L; +END; + +FUNCTION RealToStr(R: Real; W,D: Byte): STRING; +VAR + S: STRING[11]; +BEGIN + Str(R:W:D,S); + RealToStr := S; +END; + +FUNCTION ValueR(S: AStr): REAL; +VAR + Code: Integer; + R: REAL; +BEGIN + Val(S,R,Code); + IF (Code <> 0) THEN + BEGIN + S := Copy(S,1,(Code - 1)); + Val(S,R,Code) + END; + ValueR := R; + IF (S = '') THEN + ValueR := 0; +END; + +FUNCTION AgeUser(CONST BirthDate: LongInt): Word; +VAR + DT1, + DT2: DateTime; + Year: Word; +BEGIN + PackToDate(DT1,BirthDate); + GetDateTime(DT2); + Year := (DT2.Year - DT1.Year); + IF (DT2.Month < DT1.Month) THEN + Dec(Year); + IF (DT2.Month = DT1.Month) AND (DT2.Day < DT1.Day) THEN + Dec(Year); + AgeUser := Year; +END; + +FUNCTION AllCaps(InString: STRING): STRING; +VAR + Counter: Byte; +BEGIN + FOR Counter := 1 TO Length(InString) DO + IF (InString[Counter] IN ['a'..'z']) THEN + InString[Counter] := Chr(Ord(InString[Counter]) - Ord('a')+Ord('A')); + AllCaps := InString; +END; + +FUNCTION Caps(Instring: STRING): STRING; +VAR + Counter: Integer; { must be Integer } +BEGIN + IF (InString[1] IN ['a'..'z']) THEN + Dec(InString[1],32); + FOR Counter := 2 TO Length(Instring) DO + IF (InString[Counter - 1] IN ['a'..'z','A'..'Z']) THEN + IF (InString[Counter] IN ['A'..'Z']) THEN + Inc(InString[Counter],32) + ELSE + ELSE + IF (InString[Counter] IN ['a'..'z']) THEN + Dec(InString[Counter],32); + Caps := InString; +END; + +FUNCTION GetC(c: Byte): STRING; +CONST + xclr: ARRAY [0..7] OF Char = ('0','4','2','6','1','5','3','7'); +VAR + s: STRING[10]; + b: Boolean; + + PROCEDURE adto(ss: str8); + BEGIN + IF (s[Length(s)] <> ';') AND (s[Length(s)] <> '[') THEN + s := s + ';'; + s := s + ss; + b := TRUE; + END; + +BEGIN + b := FALSE; + IF ((CurrentColor AND (NOT c)) AND $88) <> 0 THEN + BEGIN + s := #27+'[0'; + CurrentColor := $07; + END + ELSE + s := #27+'['; + IF (c AND 7 <> CurrentColor AND 7) THEN + adto('3'+xclr[c AND 7]); + IF (c AND $70 <> CurrentColor AND $70) THEN + adto('4'+xclr[(c SHR 4) AND 7]); + IF (c AND 128 <> 0) THEN + adto('5'); + IF (c AND 8 <> 0) THEN + adto('1'); + IF (NOT b) THEN + adto('3'+xclr[c AND 7]); + s := s + 'm'; + GetC := s; +END; + +PROCEDURE SetC(C: Byte); +BEGIN + IF (NOT (OkANSI OR OkAvatar)) THEN + BEGIN + TextAttr := 7; + Exit; + END; + IF (C <> CurrentColor) THEN + BEGIN + IF (NOT (Color IN ThisUser.Flags)) THEN + IF ((C AND 8) = 8) THEN + C := 15 + ELSE + C := 7; + IF (OutCom) THEN + IF (OkAvatar) THEN + SerialOut(^V^A+Chr(C AND $7f)) + ELSE + SerialOut(GetC(C)); + TextAttr := C; + CurrentColor := C; + END; +END; + +PROCEDURE UserColor(Color: Byte); +BEGIN + IF (Color IN [0..9]) THEN + IF (OkANSI OR OkAvatar) THEN + SetC(Scheme.Color[Color + 1]); +END; + +FUNCTION SQOutSp(InString: STRING): STRING; +BEGIN + WHILE (Pos(' ',InString) > 0) DO + Delete(InString,Pos(' ',InString),1); + SQOutSp := InString; +END; + +FUNCTION ExtractDriveNumber(s: AStr): Byte; +BEGIN + s := FExpand(s); + ExtractDriveNumber := (Ord(s[1]) - 64); +END; + +FUNCTION PadLeftStr(InString: STRING; MaxLen: Byte): STRING; +VAR + StrLen, + Counter: Byte; +BEGIN + StrLen := LennMCI(InString); + IF (StrLen > MaxLen) THEN + WHILE (StrLen > MaxLen) DO + BEGIN + InString[0] := Chr(MaxLen + (Length(InString) - StrLen)); + StrLen := LennMCI(InString); + END + ELSE + FOR Counter := StrLen TO (MaxLen - 1) DO + InString := InString + ' '; + PadLeftStr := Instring; +END; + +FUNCTION PadRightStr(InString: STRING; MaxLen: Byte): STRING; +VAR + StrLen, + Counter: Byte; +BEGIN + StrLen := LennMCI(InString); + FOR Counter := StrLen TO (MaxLen - 1) DO + InString := ' ' + InString; + IF (StrLen > MaxLen) THEN + InString[0] := Chr(MaxLen + (Length(InString) - StrLen)); + PadRightStr := Instring; +END; + +FUNCTION PadLeftInt(L: LongInt; MaxLen: Byte): STRING; +BEGIN + PadLeftInt := PadLeftStr(IntToStr(L),MaxLen); +END; + +FUNCTION PadRightInt(L: LongInt; MaxLen: Byte): STRING; +BEGIN + PadRightInt := PadRightStr(IntToStr(L),MaxLen); +END; + +PROCEDURE Prompt(CONST InString: STRING); +VAR + SaveAllowAbort: Boolean; +BEGIN + SaveAllowAbort := AllowAbort; + AllowAbort := FALSE; + PrintMain(InString); + AllowAbort := SaveAllowAbort; +END; + +PROCEDURE Print(CONST Instring: STRING); +BEGIN + Prompt(InString+^M^J); +END; + +PROCEDURE NL; +BEGIN + Prompt(^M^J); +END; + +PROCEDURE Prt(CONST Instring: STRING); +BEGIN + UserColor(4); + Prompt(Instring); + UserColor(3); +END; + +PROCEDURE MPL(MaxLen: Byte); +VAR + Counter, + SaveWhereX : Byte; +BEGIN + IF (OkANSI OR OkAvatar) THEN + BEGIN + UserColor(6); + SaveWhereX := WhereX; + IF (OutCom) THEN + FOR Counter := 1 TO MaxLen DO + Com_Send(' '); + IF (WantOut) THEN + FOR Counter := 1 TO MaxLen DO + Write(' '); + GotoXY(SaveWhereX,WhereY); + IF (OutCom) THEN + IF (OkAvatar) THEN + SerialOut(^y+^H+Chr(MaxLen)) + ELSE + SerialOut(#27+'['+IntToStr(MaxLen)+'D'); + END; +END; + +FUNCTION InKey: Word; +VAR + c: Char; + l: LongInt; +BEGIN + c := #0; + InKey := 0; + CheckHangup; + IF (KeyPressed) THEN + BEGIN + c := ReadKey; + IF (c = #0) AND (KeyPressed) THEN + BEGIN + c := ReadKey; + SKey1(c); + IF (c = #31) OR (C = #46) THEN + c := #1 + ELSE + BEGIN + InKey := (Ord(c) * 256); { Return scan code IN MSB } + Exit; + END; + END; + IF (Buf <> '') THEN + BEGIN + c := Buf[1]; + Buf := Copy(Buf,2,255); + END; + InKey := Ord(c); + END + ELSE IF (InCom) THEN + BEGIN + c := CInKey; + IF (c = #27) THEN + BEGIN + IF (Empty) THEN + Delay(100); + IF (c = #27) AND (NOT Empty) THEN + BEGIN + c := CInKey; + IF (c = '[') OR (c = 'O') THEN + BEGIN + l := (Ticks + 4); + c := #0; + WHILE (l > Ticks) AND (c = #0) DO + c := CInKey; + END; + CASE Char(c) OF + 'A' : InKey := F_UP; {UpArrow} + 'B' : InKey := F_DOWN; {DownArrow} + 'C' : InKey := F_RIGHT; {RightArrow} + 'D' : InKey := F_LEFT; {LeftArrow} + 'H' : InKey := F_HOME; {Home} + 'K' : InKey := F_END; {END - PROCOMM+} + 'R' : InKey := F_END; {END - GT} + '4' : BEGIN + InKey := F_END; + c := CInKey; + END; + 'r' : InKey := F_PGUP; {PgUp} + 'q' : InKey := F_PGDN; {PgDn} + 'n' : InKey := F_INS; {Ins} + END; + Exit; + END; + END; + IF (c = #127) THEN + InKey := F_DEL + ELSE + InKey := Ord(c); + END; +END; + +PROCEDURE OutTrap(c: Char); +BEGIN + IF (c <> ^G) THEN + Write(TrapFile,c); + IF (IOResult <> 0) THEN + BEGIN + SysOpLog('Error writing to trap file.'); + Trapping := FALSE; + END; +END; + +PROCEDURE OutKey(c: Char); +VAR + S: Str1; +BEGIN + IF (NOT Echo) THEN + IF (General.LocalSec) AND (c IN [#32..#255]) THEN + BEGIN + s := lRGLNGStr(1,TRUE); {FString.EchoC;} + c := s[1]; + END; + IF (c IN [#27,^V,^y]) THEN + DOSANSIOn := TRUE; + IF (WantOut) AND (DOSANSIOn) AND (NextState <> Waiting) THEN + BEGIN + DOSANSI(c); + IF (OutCom) THEN + Com_Send(c); + Exit; + END + ELSE IF (c <> ^J) AND (c <> ^L) THEN + IF (WantOut) AND (NOT DOSANSIOn) AND NOT ((c = ^G) AND InCom) THEN + Write(c) + ELSE IF (WantOut) AND NOT ((c = ^G) AND InCom) THEN + DOSANSI(c); + + IF (NOT Echo) AND (c IN [#32..#255]) THEN + BEGIN + S := lRGLNGStr(1,TRUE); {FString.EchoC;} + c := S[1]; + END; + + CASE c OF + ^J : BEGIN + IF (NOT InChat) AND (NOT Write_Msg) AND (NOT CtrlJOff) AND (NOT DOSANSIOn) THEN + BEGIN + IF (((CurrentColor SHR 4) AND 7) > 0) OR (CurrentColor AND 128 = 128) THEN + SetC(Scheme.Color[1]) + END + ELSE + LIL := 1; + IF (Trapping) THEN + OutTrap(c); + IF (WantOut) THEN + Write(^J); + IF (OutCom) THEN + Com_Send(^J); + Inc(LIL); + IF (LIL >= PageLength) THEN + BEGIN + LIL := 1; + IF (TempPause) THEN + PauseScr(TRUE); + END; + END; + ^L : BEGIN + IF (WantOut) THEN + ClrScr; + IF (OutCom) THEN + Com_Send(^L); + LIL := 1; + END; + ELSE + BEGIN + IF (OutCom) THEN + Com_Send(c); + IF (Trapping) THEN + OutTrap(c); + END; + END; +END; + +FUNCTION PageLength: Word; +BEGIN + IF (InCom) THEN + PageLength := ThisUser.PageLen + ELSE IF (General.WindowOn) AND NOT (InWFCMenu) THEN + PageLength := (MaxDisplayRows - 2) + ELSE + PageLength := MaxDisplayRows; +END; + +PROCEDURE TeleConfCheck; +VAR + f: FILE; + s: STRING; + Counter: Byte; + SaveMCIAlllowed: Boolean; + { Only check IF we're bored AND NOT slicing } +BEGIN + IF (MaxChatRec > NodeChatLastRec) THEN + BEGIN + FOR Counter := 1 TO (LennMCI(MLC) + 5) DO + BackSpace; + Assign(f,General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP'); + Reset(f,1); + Seek(f,NodeChatLastRec); + WHILE NOT EOF(f) DO + BEGIN + BlockRead(f,s[0],1); + BlockRead(f,s[1],Ord(s[0])); + MultiNodeChat := FALSE; {avoid recursive calls during Pause!} + SaveMCIAlllowed := MCIAllowed; + MCIAllowed := FALSE; + Print(s); + MCIAllowed := SaveMCIAlllowed; + MultiNodeChat := TRUE; + END; + Close(f); + LastError := IOResult; + NodeChatLastRec := MaxChatRec; + Prompt('^3'+MLC); + END; +END; + +FUNCTION GetKey: Word; +CONST + LastTimeSlice: LongInt = 0; + LastCheckTimeSlice: LongInt = 0; +VAR +{$IFDEF MSDOS} + Killme: Pointer ABSOLUTE $0040 :$F000; +{$ENDIF} + Tf: Boolean; + I: Integer; + C: Word; + TempTimer: LongInt; +BEGIN + IF (DieLater) THEN +{$IFDEF MSDOS} + ASM + Call Killme + END; +{$ENDIF} +{$IFDEF WIN32} + Halt; +{$ENDIF} + LIL := 1; + IF (Buf <> '') THEN + BEGIN + C := Ord(Buf[1]); + Buf := Copy(Buf,2,255); + END + ELSE + BEGIN + IF (NOT Empty) THEN + BEGIN + IF (InChat) THEN + C := Ord(Chinkey) + ELSE + C := InKey; + END + ELSE + BEGIN + Tf := FALSE; + LastKeyHit := Timer; + C := 0; + WHILE ((C = 0) AND (NOT HangUp)) DO + BEGIN + TempTimer := Timer; + IF (LastScreenSwap > 0) THEN + BEGIN + IF ((TempTimer - LastScreenSwap) < 0) THEN + LastScreenSwap := ((Timer - LastScreenSwap) + 86400); + IF ((TempTimer - LastScreenSwap) > 10) THEN + Update_Screen; + END; + IF (Alert IN ThisUser.Flags) OR ((NOT ShutUpChatCall) AND (General.ChatCall) AND (ChatReason <> '')) THEN + BEGIN + IF ((TempTimer - LastBeep) < 0) THEN + LastBeep := ((TempTimer - LastBeep) + 86400); + IF ((Alert IN ThisUser.Flags) AND ((TempTimer - LastBeep) >= General.Alertbeep)) OR + ((ChatReason <> '') AND (SysOpAvailable) AND ((TempTimer - LastBeep) >= 5)) THEN + BEGIN + FOR I := 1 TO 100 DO + BEGIN +{$IFDEF MSDOS} + Sound(500 + (I * 10)); + Delay(2); + Sound(100 + (I * 10)); + Delay(2); + NoSound; +{$ENDIF} +{$IFDEF WIN32} + Sound(500, 200); + Sound(1500, 200); +{$ENDIF} + END; + LastBeep := TempTimer; + END; + END; + IF ((TempTimer - LastKeyHit) < 0) THEN + LastKeyHit := ((TempTimer - LastKeyHit) + 86400); + IF (General.TimeOut <> - 1) AND ((TempTimer - LastKeyHit) > (General.TimeOut * 60)) AND (NOT TimedOut) + AND (ComPortSpeed <> 0) THEN + BEGIN + TimedOut := TRUE; + PrintF('TIMEOUT'); + IF (NoFile) THEN + Print(^M^J^M^J'Time out - disconnecting.'^M^J^M^J); + HangUp := TRUE; + SysOpLog('Inactivity timeout at '+TimeStr); + END; + IF (General.TimeOutBell <> - 1) AND ((TempTimer - LastKeyHit) > (General.TimeOutBell * 60)) AND + (NOT Tf) THEN + BEGIN + Tf := TRUE; + OutKey(^G); + Delay(100); + OutKey(^G); + END; + IF (Empty) THEN + BEGIN + IF (ABS((Ticks - LastTimeSlice)) >= General.Slicetimer) THEN + BEGIN +{$IFDEF MSDOS} + CASE Tasker OF + None : ASM + int 28h + END; + DV : ASM + Mov ax, 1000h + int 15h + END; + Win,Win32,DOS5N : ASM (* Added Win32 & DOS5N *) + Mov ax, 1680h + int 2Fh + END; + Os2 : ASM + Push dx + XOR dx, dx + Mov ax, 0 + Sti + Hlt + Db 035h, 0Cah + Pop dx + END; + END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} + LastTimeSlice := Ticks; + END + ELSE IF (MultiNodeChat) AND (NOT InChat) AND (ABS(Ticks - LastCheckTimeSlice) > 9) THEN + BEGIN + LastCheckTimeSlice := Ticks; + TeleConfCheck; + LIL := 1; + END; + END; + IF (InChat) THEN + C := Ord(Chinkey) + ELSE + C := InKey; + END; + IF (UserOn) AND ((GetPackDateTime - CreditsLastUpdated) > 60) AND NOT (FNoCredits IN ThisUser.Flags) THEN + BEGIN + Inc(ThisUser.Debit,General.Creditminute * ((GetPackDateTime - CreditsLastUpdated) DIV 60)); + CreditsLastUpdated := GetPackDateTime; + END; + END; + END; + GetKey := C; +END; + +PROCEDURE CLS; +BEGIN + IF (OkANSI OR OkVT100) THEN + SerialOut(^[+'[1;1H'+^[+'[2J') + ELSE + OutKey(^L); + IF (WantOut) THEN + ClrScr; + IF (Trapping) THEN + OutTrap(^L); + UserColor(1); + LIL := 1; +END; + +FUNCTION DisplayARFlags(AR: ARFlagSet; C1,C2: Char): AStr; +VAR + Flag: Char; + TempStr: AStr; +BEGIN + TempStr := ''; + FOR Flag := 'A' TO 'Z' DO + IF Flag IN AR THEN + TempStr := TempStr + '^'+C1+Flag + ELSE + TempStr := TempStr + '^'+C2+'-'; + DisplayArFlags := TempStr; +END; + +PROCEDURE ToggleARFlag(Flag: Char; VAR AR: ARFlagSet; VAR Changed: Boolean); +VAR + SaveAR: ARFlagSet; +BEGIN + SaveAR := AR; + IF (Flag IN ['A'..'Z']) THEN + IF (Flag IN AR) THEN + Exclude(AR,Flag) + ELSE + Include(AR,Flag); + IF (SaveAR <> AR) THEN + Changed := TRUE; +END; + +FUNCTION DisplayACFlags(Flags: FlagSet; C1,C2: Char): AStr; +VAR + Flag: FlagType; + TempS: AStr; +BEGIN + TempS := ''; + FOR Flag := RLogon TO RMsg DO + IF (Flag IN Flags) THEN + TempS := TempS + '^'+C1+Copy('LCVUA*PEKM',(Ord(Flag) + 1),1) + ELSE + TempS := TempS + '^'+C2+'-'; + TempS := TempS + '^'+C2+'/'; + FOR Flag := FNoDLRatio TO FNoDeletion DO + IF (Flag IN Flags) THEN + TempS := TempS + '^'+C1+Copy('1234',(Ord(Flag) - 19),1) + ELSE + TempS := TempS + '^'+C2+'-'; + DisplayACFlags := TempS; +END; + +PROCEDURE ToggleACFlag(Flag: FlagType; VAR Flags: FlagSet); +BEGIN + IF (Flag IN Flags) THEN + Exclude(Flags,Flag) + ELSE + Include(Flags,Flag); +END; + +PROCEDURE ToggleACFlags(Flag: Char; VAR Flags: FlagSet; VAR Changed: Boolean); +VAR + SaveFlags: FlagSet; +BEGIN + SaveFlags := Flags; + CASE Flag OF + 'L' : ToggleACFlag(RLogon,Flags); + 'C' : ToggleACFlag(RChat,Flags); + 'V' : ToggleACFlag(RValidate,Flags); + 'U' : ToggleACFlag(RUserList,Flags); + 'A' : ToggleACFlag(RAMsg,Flags); + '*' : ToggleACFlag(RPostAn,Flags); + 'P' : ToggleACFlag(RPost,Flags); + 'E' : ToggleACFlag(REmail,Flags); + 'K' : ToggleACFlag(RVoting,Flags); + 'M' : ToggleACFlag(RMsg,Flags); + '1' : ToggleACFlag(FNoDLRatio,Flags); + '2' : ToggleACFlag(FNoPostRatio,Flags); + '3' : ToggleACFlag(FNoCredits,Flags); + '4' : ToggleACFlag(FNoDeletion,Flags); + END; + IF (SaveFlags <> Flags) THEN + Changed := TRUE; +END; + +PROCEDURE ToggleStatusFlag(Flag: StatusFlagType; VAR SUFlags: StatusFlagSet); +BEGIN + IF (Flag IN SUFlags) THEN + Exclude(SUFlags,Flag) + ELSE + Include(SUFlags,Flag); +END; + +PROCEDURE ToggleStatusFlags(Flag: Char; VAR SUFlags: StatusFlagSet); +BEGIN + CASE Flag OF + 'A' : ToggleStatusFlag(LockedOut,SUFlags); + 'B' : ToggleStatusFlag(Deleted,SUFlags); + 'C' : ToggleStatusFlag(TrapActivity,SUFlags); + 'D' : ToggleStatusFlag(TrapSeparate,SUFlags); + 'E' : ToggleStatusFlag(ChatAuto,SUFlags); + 'F' : ToggleStatusFlag(ChatSeparate,SUFlags); + 'G' : ToggleStatusFlag(SLogSeparate,SUFlags); + 'H' : ToggleStatusFlag(CLSMsg,SUFlags); + 'I' : ToggleStatusFlag(RIP,SUFlags); + 'J' : ToggleStatusFlag(FSEditor,SUFlags); + 'K' : ToggleStatusFlag(AutoDetect,SUFlags); + END; +END; + +FUNCTION TACCH(Flag: Char): FlagType; +BEGIN + CASE Flag OF + 'L': TACCH := RLogon; + 'C': TACCH := RChat; + 'V': TACCH := RValidate; + 'U': TACCH := RUserList; + 'A': TACCH := RAMsg; + '*': TACCH := RPostAN; + 'P': TACCH := RPost; + 'E': TACCH := REmail; + 'K': TACCH := RVoting; + 'M': TACCH := RMsg; + '1': TACCH := FNoDLRatio; + '2': TACCH := FNoPostRatio; + '3': TACCH := FNoCredits; + '4': TACCH := FNoDeletion; + END; +END; + +{$IFDEF MSDOS} +FUNCTION AOnOff(b: Boolean; CONST s1,s2:AStr): STRING; ASSEMBLER; +ASM + PUSH ds + Test b, 1 + JZ @@1 + LDS si, s1 + JMP @@2 + @@1: LDS si, s2 + @@2: LES di, @Result + XOR Ch, Ch + MOV cl, Byte ptr ds:[si] + MOV Byte ptr es:[di], cl + Inc di + Inc si + CLD + REP MOVSB + POP ds +END; +{$ENDIF} +{$IFDEF WIN32} +FUNCTION AOnOff(b: Boolean; CONST s1,s2:AStr): STRING; +BEGIN + if (b) then + AOnOff := s1 + else + AOnOff := s2; +END; +{$ENDIF} + +FUNCTION ShowOnOff(b: Boolean): STRING; +BEGIN + IF (b) THEN + ShowOnOff := 'On ' + ELSE + ShowOnOff := 'Off'; +END; + +FUNCTION ShowYesNo(b: Boolean): STRING; +BEGIN + IF (b) THEN + ShowYesNo := 'Yes' + ELSE + ShowYesNo := 'No '; +END; + +FUNCTION YN(Len: Byte; DYNY: Boolean): Boolean; +VAR + Cmd: Char; +BEGIN + IF (NOT HangUp) THEN + BEGIN + UserColor(3); + Prompt(SQOutSp(ShowYesNo(DYNY))); + REPEAT + Cmd := UpCase(Char(GetKey)); + UNTIL (Cmd IN ['Y','N',^M]) OR (HangUp); + IF (DYNY) AND (Cmd <> 'N') THEN + Cmd := 'Y'; + IF (DYNY) AND (Cmd = 'N') THEN + Prompt(#8#8#8'^3No ') + ELSE IF (NOT DYNY) AND (Cmd = 'Y') THEN + Prompt(#8#8'^3Yes'); + IF (Cmd = 'N') AND (Len <> 0) THEN + DoBackSpace(1,Len) + ELSE + NL; + UserColor(1); + YN := (Cmd = 'Y') AND (NOT HangUp); + END; +END; + +FUNCTION PYNQ(CONST InString: AStr; MaxLen: Byte; DYNY: Boolean): Boolean; +BEGIN + UserColor(7); + Prompt(InString); + PYNQ := YN(MaxLen,DYNY); +END; + +PROCEDURE OneK(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean); +BEGIN + MPL(1); + TempPause := (Pause IN ThisUser.Flags); + REPEAT + C := UpCase(Char(GetKey)); + UNTIL (Pos(C,ValidKeys) > 0) OR (HangUp); + IF (HangUp) THEN + C := ValidKeys[1]; + IF (DisplayKey) THEN + OutKey(C); + IF (Trapping) THEN + OutTrap(C); + UserColor(1); + IF (LineFeed) THEN + NL; +END; + +PROCEDURE OneK1(VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean); +BEGIN + MPL(1); + TempPause := (Pause IN ThisUser.Flags); + REPEAT + C := Char(GetKey); + IF (C = 'q') THEN + C := UpCase(C); + UNTIL (Pos(C,ValidKeys) > 0) OR (HangUp); + IF (HangUp) THEN + C := ValidKeys[1]; + IF (DisplayKey) THEN + OutKey(C); + IF (Trapping) THEN + OutTrap(C); + UserColor(1); + IF (LineFeed) THEN + NL; +END; + +PROCEDURE LOneK(DisplayStr: AStr; VAR C: Char; ValidKeys: AStr; DisplayKey,LineFeed: Boolean); +BEGIN + Prt(DisplayStr); + MPL(1); + TempPause := (Pause IN ThisUser.Flags); + REPEAT + C := UpCase(Char(GetKey)); + UNTIL (Pos(C,ValidKeys) > 0) OR (HangUp); + IF (HangUp) THEN + C := ValidKeys[1]; + IF (DisplayKey) THEN + OutKey(C); + IF (Trapping) THEN + OutTrap(C); + UserColor(1); + IF (LineFeed) THEN + NL; +END; + +FUNCTION Centre(InString: AStr): STRING; +VAR + StrLen, + Counter: Integer; +BEGIN + StrLen := LennMCI(Instring); + IF (StrLen < ThisUser.LineLen) THEN + BEGIN + Counter := ((ThisUser.LineLen - StrLen) DIV 2); + Move(Instring[1],Instring[Counter + 1],Length(Instring)); + Inc(Instring[0],Counter); + FillChar(InString[1],Counter,#32); + END; + Centre := InString; +END; + +PROCEDURE WKey; +VAR + Cmd: Char; +BEGIN + IF (NOT AllowAbort) OR (Abort) OR (HangUp) OR (Empty) THEN + Exit; + Cmd := Char(GetKey); + IF (DisplayingMenu) AND (Pos(UpCase(Cmd),MenuKeys) > 0) THEN + BEGIN + MenuAborted := TRUE; + Abort := TRUE; + Buf := Buf + UpCase(Cmd); + END + ELSE + CASE UpCase(Cmd) OF + ' ',^C,^X,^K : + Abort := TRUE; + 'N',^N : + IF (Reading_A_Msg) THEN + BEGIN + Abort := TRUE; + Next := TRUE; + END; + 'P',^S : + Cmd := Char(GetKey); + ELSE IF (Reading_A_Msg) OR (PrintingFile) THEN + IF (Cmd <> #0) THEN + Buf := Buf + Cmd; + END; + IF (Abort) THEN + BEGIN + Com_Purge_Send; + NL; + END; +END; + +PROCEDURE PrintMain(CONST ss:STRING); +VAR + i, + X: Word; + X2: Byte; + c: Char; + cs: STRING; + s: STRING; + Justify: Byte; +BEGIN + IF (Abort) AND (AllowAbort) THEN + Exit; + IF (HangUp) THEN + BEGIN + Abort := TRUE; + Exit; + END; + + IF (NOT MCIAllowed) THEN + s := ss + ELSE + BEGIN + s := ''; + FOR i := 1 TO Length(ss) DO + IF (ss[i] = '%') AND (i + 2 <= Length(ss)) THEN + BEGIN + cs := MCI(Copy(ss,i,3)); { faster than adding } + IF (cs = Copy(ss,i,3)) THEN + BEGIN + s := s + '%'; + Continue; + END; + Inc(i,2); + IF (Length(ss) >= i + 2) AND (ss[i + 1] IN ['#','{','}']) THEN + BEGIN + IF (ss[i + 1] = '}') THEN + Justify := 0 + ELSE IF (ss[i + 1] = '{') THEN + Justify := 1 + ELSE + Justify := 2; + IF (ss[i + 2] IN ['0'..'9']) THEN + BEGIN + X2 := Ord(ss[i + 2]) - 48; + Inc(i, 2); + IF (ss[i + 1] IN ['0'..'9']) THEN + BEGIN + X2 := X2 * 10 + Ord(ss[i + 1]) - 48; + Inc(i, 1); + END; + IF (X2 > 0) THEN + CASE Justify OF + 0 : cs := PadRightStr(cs,X2); + 1 : cs := PadLeftStr(cs,X2); + 2 : WHILE (Length(cs) < X2) DO + BEGIN + cs := ' ' + cs; + IF (Length(cs) < X2) THEN + cs := cs + ' '; + END; + END; + END; + END; + { s := s + cs; } + IF (Length(cs) + Length(s) <= 255) THEN + BEGIN + Move(cs[1],s[Length(s)+1],Length(cs)); + Inc(s[0],Length(cs)); + END + ELSE + IF (Length(s) < 255) THEN + BEGIN + Move(cs[1],s[Length(s)+1],(255 - Length(s))); + s[0] := #255; + END; + END + ELSE + IF (Length(s) < 255) THEN { s := s + ss[i]; } + BEGIN + Inc(s[0]); + s[Length(s)] := ss[i]; + END; + END; + + IF NOT (OkANSI OR OkAvatar) THEN + s := StripColor(s); + + i := 1; + IF ((NOT Abort) OR (NOT AllowAbort)) AND (NOT HangUp) THEN { can't change IN loop } + WHILE (i <= Length(s)) DO + BEGIN + CASE s[i] OF + '%' : IF MCIAllowed AND (i + 1 < Length(s)) THEN + BEGIN + IF (UpCase(s[i + 1]) = 'P') AND (UpCase(s[i + 2]) = 'A') THEN { %PA Pause } + BEGIN + Inc(i,2); + PauseScr(FALSE) + END + ELSE IF (UpCase(s[i + 1]) = 'P') AND (UpCase(s[i + 2]) = 'E') THEN { %PE Null Pause } + BEGIN + Inc(i,2); + PauseIsNull := TRUE; + PauseScr(FALSE); + PauseIsNull := FALSE; + END + ELSE IF (UpCase(s[i + 1]) = 'D') THEN + IF (UpCase(s[i + 2]) = 'E') THEN { %DE Delay } + BEGIN + Inc(i,2); + OutKey(' '); OutKey(#8); { guard against +++ } + Delay(800); + END + ELSE IF ((UpCase(s[i + 2]) = 'F') AND (NOT PrintingFile)) THEN { %DF File Include } + BEGIN + cs := ''; Inc(i, 3); + WHILE (i < Length(s)) AND (s[i] <> '%') DO + BEGIN + cs := cs + s[i]; + Inc(i); + END; + PrintF(StripName(cs)); + END + ELSE + ELSE + OutKey('%'); + END + ELSE + OutKey('%'); + ^S:IF (i < Length(s)) AND (NextState = Waiting) THEN BEGIN + IF (Ord(s[i + 1]) <= 200) THEN SetC(Scheme.Color[Ord(s[i + 1])]); Inc(i); + END + ELSE OutKey(''); + '|':IF (ColorAllowed) AND (i + 1 < Length(s)) AND + (s[i + 1] IN ['0'..'9']) AND (s[i + 2] IN ['0'..'9']) + THEN + BEGIN + X := StrToInt(Copy(s,i + 1,2)); + CASE X OF + 0..15:SetC(CurrentColor - (CurrentColor MOD 16) + X); + 16..23:SetC(((X - 16) * 16) + (CurrentColor MOD 16)); + END; + Inc(i,2); + END + ELSE + OutKey('|'); + #9:FOR X := 1 TO 5 DO + OutKey(' '); + '^':IF (ColorAllowed) AND (i < Length(s)) AND (s[i+1] IN ['0'..'9']) THEN + BEGIN + Inc(i); + UserColor(Ord(s[i]) - 48); + END + ELSE + OutKey('^'); + ELSE + OutKey(s[i]); + END; + Inc(i); + X2 := i; + WHILE (X2 < Length(s)) AND + NOT (s[X2] IN [^S,'^','|','%',^G,^L,^V,^y,^J,^[]) + DO + Inc(X2); + + IF (X2 > i) THEN + BEGIN + cs[0] := Chr(X2 - i); + Move(s[i], cs[1], X2 - i); { twice as fast as Copy(s,i,x2-i); } + i := X2; + + IF (Trapping) THEN + Write(TrapFile,cs); + + IF (WantOut) THEN + IF (NOT DOSANSIOn) THEN + Write(cs) + ELSE + FOR X2 := 1 TO Length(cs) DO + DOSANSI(cs[X2]); + + SerialOut(cs); + END; + END; + WKey; +END; + +PROCEDURE PrintACR(InString: STRING); +VAR + TurnOff: Boolean; +BEGIN + IF (AllowAbort) AND (Abort) THEN + Exit; + Abort := FALSE; + TurnOff := (InString[Length(Instring)] = #29); + IF (TurnOff) THEN + Dec(InString[0]); + CheckHangup; + IF (NOT CROff) AND NOT (TurnOff) THEN + InString := InString + ^M^J; + PrintMain(InString); + IF (Abort) THEN + BEGIN + CurrentColor := (255 - CurrentColor); + UserColor(1); + END; + CROff := FALSE; +END; + +PROCEDURE pfl(FN: AStr); +VAR + fil: Text; + ls: STRING[255]; + ps: Byte; + c: Char; + SaveTempPause, + ToggleBack, + SaveAllowAbort: Boolean; +BEGIN + PrintingFile := TRUE; + SaveAllowAbort := AllowAbort; + AllowAbort := TRUE; + Abort := FALSE; + Next := FALSE; + ToggleBack := FALSE; + SaveTempPause := TempPause; + FN := AllCaps(FN); + IF (General.WindowOn) AND (Pos('.AN',FN) > 0) OR (Pos('.AV',FN) > 0) THEN + BEGIN + TempPause := FALSE; + ToggleBack := TRUE; + ToggleWindow(FALSE); + IF (OkRIP) THEN + SerialOut('!|*|'); + END; + IF (Pos('.RI',FN) > 0) THEN + TempPause := FALSE; + IF (NOT HangUp) THEN + BEGIN + Assign(fil,SQOutSp(FN)); + Reset(fil); + IF (IOResult <> 0) THEN + NoFile := TRUE + ELSE + BEGIN + Abort := FALSE; + Next := FALSE; + WHILE (NOT EOF(fil)) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + ps := 0; + REPEAT + Inc(ps); + Read(fil,ls[ps]); + IF EOF(fil) THEN {check again incase avatar parameter} + BEGIN + Inc(ps); + Read(fil,ls[ps]); + IF EOF(fil) THEN + Dec(ps); + END; + UNTIL ((ls[ps] = ^J) AND (NextState IN [Waiting..In_Param])) OR (ps = 255) OR EOF(fil); + ls[0] := Chr(ps); + CROff := TRUE; + CtrlJOff := ToggleBack; + PrintACR(ls); + END; + Close(fil); + END; + NoFile := FALSE; + END; + AllowAbort := SaveAllowAbort; + PrintingFile := FALSE; + CtrlJOff := FALSE; + IF (ToggleBack) THEN + ToggleWindow(TRUE); + RedrawForANSI; + IF (NOT TempPause) THEN + LIL := 0; + TempPause := SaveTempPause; +END; + +FUNCTION BSlash(InString: AStr; b: Boolean): AStr; +BEGIN + IF (b) THEN + BEGIN + WHILE (Copy(InString,(Length(InString) - 1),2) = '\\') DO + InString := Copy(Instring,1,(Length(InString) - 2)); + IF (Copy(InString,Length(InString),1) <> '\') THEN + InString := InString + '\'; + END + ELSE + WHILE (InString[Length(InString)] = '\') DO + Dec(InString[0]); + BSlash := Instring; +END; + +FUNCTION Exist(FileName: AStr): Boolean; +VAR + DirInfo1: SearchRec; +BEGIN + FindFirst(SQOutSp(FileName),AnyFile,DirInfo1); + Exist := (DOSError = 0); +END; + +FUNCTION ExistDir(Path: PathStr): Boolean; +VAR + DirInfo1: SearchRec; +BEGIN + Path := AllCaps(BSlash(Path,FALSE)); + FindFirst(Path,AnyFile,DirInfo1); + ExistDir := (DOSError = 0) AND (DirInfo1.Attr AND $10 = $10); +END; + +PROCEDURE PrintFile(FileName: AStr); +VAR + s: AStr; + dayofweek: Byte; + i: Integer; +BEGIN + FileName := AllCaps(FileName); + s := FileName; + IF (Copy(FileName,Length(FileName) - 3,4) = '.ANS') THEN + BEGIN + IF (Exist(Copy(FileName,1,Length(FileName) - 4)+'.AN1')) THEN + REPEAT + i := Random(10); + IF (i = 0) THEN + FileName := Copy(FileName,1,Length(FileName) - 4)+'.ANS' + ELSE + FileName := Copy(FileName,1,Length(FileName) - 4)+'.AN'+IntToStr(i); + UNTIL (Exist(FileName)); + END + ELSE IF (Copy(FileName,Length(FileName) - 3,4) = '.AVT') THEN + BEGIN + IF (Exist(Copy(FileName,1,Length(FileName) - 4)+'.AV1')) THEN + REPEAT + i := Random(10); + IF (i = 0) THEN + FileName := Copy(FileName,1,Length(FileName) - 4)+'.AVT' + ELSE + FileName := Copy(FileName,1,Length(FileName) - 4)+'.AV'+IntToStr(i); + UNTIL (Exist(FileName)); + END + ELSE IF (Copy(FileName,Length(FileName) - 3,4) = '.RIP') THEN + BEGIN + IF (Exist(Copy(FileName,1,Length(FileName) - 4)+'.RI1')) THEN + REPEAT + i := Random(10); + IF (i = 0) THEN + FileName := Copy(FileName,1,Length(FileName) - 4)+'.RIP' + ELSE + FileName := Copy(FileName,1,Length(FileName) - 4)+'.RI'+IntToStr(i); + UNTIL (Exist(FileName)); + END; + GetDayOfWeek(DayOfWeek); + s := FileName; + s[Length(s) - 1] := Chr(DayOfWeek + 48); + IF (Exist(s)) THEN + FileName := s; + pfl(FileName); +END; + +PROCEDURE PrintF(FileName: AStr); +VAR + FFN, + Path: PathStr; + Name: NameStr; + Ext: ExtStr; + + j: Integer; (* doesn't seem to do anything *) + +BEGIN + NoFile := TRUE; + FileName := SQOutSp(FileName); + IF (FileName = '') THEN + Exit; + + IF (Pos('\',FileName) <> 0) THEN (* ??? *) + j := 1 + ELSE + BEGIN + j := 2; + FSplit(FExpand(FileName),Path,Name,Ext); + IF (NOT Exist(General.MiscPath+Name+'.*')) THEN + Exit; + END; + + FFN := FileName; + IF ((Pos('\',FileName) = 0) AND (Pos(':',FileName) = 0)) THEN + FFN := General.MiscPath+FFN; + FFN := FExpand(FFN); + IF (Pos('.',FileName) <> 0) THEN + PrintFile(FFN) + ELSE + BEGIN + IF (OkRIP) AND Exist(FFN+'.RIP') THEN + PrintFile(FFN+'.RIP'); + IF (NoFile) AND (OkAvatar) AND Exist(FFN+'.AVT') THEN + PrintFile(FFN+'.AVT'); + IF (NoFile) AND (OkANSI) AND Exist(FFN+'.ANS') THEN + PrintFile(FFN+'.ANS'); + IF (NoFile) AND (Exist(FFN+'.ASC')) THEN + PrintFile(FFN+'.ASC'); + END; +END; + +FUNCTION VerLine(B: Byte): STRING; +BEGIN + CASE B OF + 1 : VerLine := '|09The |14Renegade Bulletin Board System|09, Version |15'+General.Version; + 2 : VerLine := '|09Brought to you by |10The Renegade Development Team|09.'; + 3 : VerLine := '|09Copyright (c) |151991-2009|09'; + END; +END; + +FUNCTION AACS1(User: UserRecordType; UNum: Integer; s: ACString): Boolean; +VAR + s1, + s2: AStr; + c, + c1, + c2: Char; + i, + p1, + p2, + j: Integer; + b: Boolean; + + PROCEDURE GetRest; + VAR + incre: Byte; + BEGIN + s1 := c; + p1 := i; + incre := 0; + IF ((i <> 1) AND (s[i - 1] = '!')) THEN + BEGIN + s1 := '!' + s1; + Dec(p1); + END; + IF (c IN ['N','C','E','F','G','I','J','M','O','R','V','Z']) THEN + BEGIN + s1 := s1 + s[i + 1]; + Inc(i); + IF c IN ['N'] THEN + WHILE s[i + 1 + incre] IN ['0'..'9'] DO + BEGIN + Inc (incre); + s1 := s1 + s[i +1 +incre]; + END; + END + ELSE + BEGIN + j := i + 1; + WHILE (j <= Length(s)) AND (s[j] IN ['0'..'9']) DO + BEGIN + s1 := s1 + s[j]; + Inc(j); + END; + i := (j - 1); + END; + p2 := i; + END; + + FUNCTION ArgStat(s: AStr): Boolean; + VAR + VS: AStr; + c: Char; + DayOfWeek: Byte; + RecNum1, + RecNum, + VSI: Integer; + Hour, + Minute, + Second, + Sec100: Word; + BoolState, + ACS: Boolean; + BEGIN + BoolState := (s[1] <> '!'); + IF (NOT BoolState) THEN + s := Copy(s,2,(Length(s) - 1)); + VS := Copy(s,2,(Length(s) - 1)); + VSI := StrToInt(VS); + CASE s[1] OF + 'A' : ACS := (AgeUser(User.BirthDate) >= VSI); + 'B' : ACS := ((ActualSpeed >= (VSI * 100)) AND (VSI > 0)) OR (ComPortSpeed = 0); + 'C' : BEGIN + ACS := (CurrentConf = VS); + C := VS[1]; + IF (NOT ConfSystem) AND (C IN ConfKeys) THEN + BEGIN + IF FindConference(C,Conference) THEN + ACS := AACS1(ThisUser,UserNum,Conference.ACS) + ELSE + ACS := FALSE; + END; + END; + 'D' : ACS := (User.DSL >= VSI) OR (TempSysOp); + 'E' : CASE UpCase(VS[1]) OF + 'A' : ACS := OkANSI; + 'N' : ACS := NOT (OkANSI OR OkAvatar OR OkVT100); + 'V' : ACS := OkAvatar; + 'R' : ACS := OkRIP; + '1' : ACS := OkVT100; + END; + 'F' : ACS := (UpCase(VS[1]) IN User.AR); + 'G' : ACS := (User.Sex = UpCase(VS[1])); + 'H' : BEGIN + GetTime(Hour,Minute,Second,Sec100); + ACS := (Hour = VSI); + END; + 'I' : ACS := IsInvisible; + 'J' : ACS := (Novice IN User.Flags); + 'K' : ACS := (ReadMsgArea = VSI); + 'L' : ACS := (ReadFileArea = VSI); + 'M' : ACS := (UnVotedTopics = 0); + 'N' : ACS := (ThisNode = VSI); + 'O' : ACS := SysOpAvailable; + 'P' : ACS := ((User.lCredit - User.Debit) >= VSI); + 'R' : ACS := (TACCH(UpCase(VS[1])) IN User.Flags); + 'S' : ACS := (User.SL >= VSI) OR (TempSysOp); + 'T' : ACS := (NSL DIV 60 >= VSI); + 'U' : ACS := (UNum = VSI); + 'V' : 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 = '!') THEN + RecNum1 := RecNum; + Inc(RecNum); + END; + Close(ValidationFile); + ACS := (RecNum1 <> -1) AND (User.SL > Validation.NewSL); + END; + 'W' : BEGIN + GetDayOfWeek(DayOfWeek); + ACS := (DayOfWeek = Ord(s[2]) - 48); + END; + 'X' : ACS := (((User.Expiration DIV 86400) - (GetPackDateTime DIV 86400)) <= VSI) AND (User.Expiration > 0); + 'Y' : ACS := (Timer DIV 60 >= VSI); + 'Z' : IF (FNoPostRatio IN User.Flags) THEN + ACS := TRUE + ELSE IF (General.PostRatio[User.SL] > 0) AND (User.LoggedOn > 100 / General.PostRatio[User.SL]) THEN + ACS := ((User.MsgPost / User.LoggedOn * 100) >= General.PostRatio[User.SL]) + ELSE + ACS := TRUE; + END; + IF (NOT BoolState) THEN + ACS := NOT ACS; + ArgStat := ACS; + END; + +BEGIN + i := 0; + s := AllCaps(s); + WHILE (i < Length(s)) DO + BEGIN + Inc(i); + c := s[i]; + IF (c IN ['A'..'Z']) AND (i <> Length(s)) THEN + BEGIN + GetRest; + b := ArgStat(s1); + Delete(s,p1,Length(s1)); + IF (b) THEN + s2 := '^' + ELSE + s2 := '%'; + Insert(s2,s,p1); + Dec(i,(Length(s1) - 1)); + END; + END; + s := '(' + s + ')'; + WHILE (Pos('&', s) <> 0) DO + Delete(s,Pos('&',s),1); + WHILE (Pos('^^', s) <> 0) DO + Delete(s,Pos('^^',s),1); + WHILE (Pos('(', s) <> 0) DO + BEGIN + i := 1; + WHILE ((s[i] <> ')') AND (i <= Length(s))) DO + BEGIN + IF (s[i] = '(') THEN + p1 := i; + Inc(i); + END; + p2 := i; + s1 := Copy(s,(p1 + 1),((p2 - p1) - 1)); + WHILE (Pos('|',s1) <> 0) DO + BEGIN + i := Pos('|',s1); + c1 := s1[i - 1]; + c2 := s1[i + 1]; + s2 := '%'; + IF ((c1 IN ['%','^']) AND (c2 IN ['%','^'])) THEN + BEGIN + IF ((c1 = '^') OR (c2 = '^')) THEN + s2 := '^'; + Delete(s1,(i - 1),3); + Insert(s2,s1,(i - 1)); + END + ELSE + Delete(s1,i,1); + END; + WHILE (Pos('%%',s1) <> 0) DO + Delete(s1,Pos('%%',s1),1); {leave only "%"} + WHILE (Pos('^^', s1) <> 0) DO + Delete(s1,Pos('^^',s1),1); {leave only "^"} + WHILE (Pos('%^', s1) <> 0) DO + Delete(s1,Pos('%^',s1)+1,1); {leave only "%"} + WHILE (Pos('^%', s1) <> 0) DO + Delete(s1,Pos('^%',s1),1); {leave only "%"} + Delete(s,p1,((p2 - p1) + 1)); + Insert(s1,s,p1); + END; + AACS1 := (Pos('%',s) = 0); +END; + +FUNCTION AACS(s: ACString): Boolean; +BEGIN + AACS := AACS1(ThisUser,UserNum,s); +END; + +PROCEDURE LoadNode(NodeNumber: Byte); +BEGIN + IF (General.MultiNode) THEN + BEGIN + Reset(NodeFile); + IF (NodeNumber >= 1) AND (NodeNumber <= FileSize(NodeFile)) AND (IOResult = 0) THEN + BEGIN + Seek(NodeFile,(NodeNumber - 1)); + Read(NodeFile,NodeR); + END; + Close(NodeFile); + LastError := IOResult; + END; +END; + +PROCEDURE Update_Node(NActivityDesc: AStr; SaveVars: Boolean); +BEGIN + IF (General.MultiNode) THEN + BEGIN + LoadNode(ThisNode); + IF (SaveVars) THEN + BEGIN + SaveNDescription := NodeR.ActivityDesc; + NodeR.ActivityDesc := NActivityDesc + END + ELSE + NodeR.ActivityDesc := SaveNDescription; + (* + IF (UserOn) THEN + BEGIN + *) + NodeR.User := UserNum; + NodeR.UserName := ThisUser.Name; + NodeR.Sex := ThisUser.Sex; + NodeR.Age := AgeUser(ThisUser.BirthDate); + NodeR.CityState := ThisUser.CityState; + NodeR.LogonTime := TimeOn; + NodeR.Channel := ChatChannel; + (* + END; + *) + SaveNode(ThisNode); + END; +END; + +FUNCTION MaxChatRec: LongInt; +VAR + DirInfo1: SearchRec; +BEGIN + FindFirst(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP',AnyFile,DirInfo1); + IF (DOSError = 0) THEN + MaxChatRec := DirInfo1.Size + ELSE + MaxChatRec := 0; +END; + +FUNCTION MaxNodes: Byte; +VAR + DirInfo1: SearchRec; +BEGIN + FindFirst(General.DataPath+'MULTNODE.DAT',AnyFile,DirInfo1); + IF (DOSError = 0) THEN + MaxNodes := (DirInfo1.Size DIV SizeOf(NodeRecordType)) + ELSE + MaxNodes := 0; +END; + +PROCEDURE SaveNode(NodeNumber: Byte); +BEGIN + IF (General.MultiNode) THEN + BEGIN + Reset(NodeFile); + IF (NodeNumber >= 1) AND (NodeNumber <= FileSize(NodeFile)) AND (IOResult = 0) THEN + BEGIN + Seek(NodeFile,(NodeNumber - 1)); + Write(NodeFile,NodeR); + END; + Close(NodeFile); + LastError := IOResult; + END; +END; + +PROCEDURE LoadURec(VAR User: UserRecordType; UserNumber: Integer); +VAR + FO: Boolean; +BEGIN + FO := (FileRec(UserFile).Mode <> FMClosed); + IF (NOT FO) THEN + BEGIN + Reset(UserFile); + IF (IOResult <> 0) THEN + BEGIN + SysOpLog('Error opening USERS.DAT.'); + Exit; + END; + END; + + IF (UserNumber <> UserNum) OR (NOT UserOn) THEN + BEGIN + Seek(UserFile,UserNumber); + Read(UserFile,User); + END + ELSE + User := ThisUser; + + IF (NOT FO) THEN + Close(UserFile); + + LastError := IOResult; +END; + +PROCEDURE SaveURec(User: UserRecordType; UserNumber: Integer); +VAR + FO: Boolean; + NodeNumber: Byte; +BEGIN + FO := (FileRec(UserFile).Mode <> FMClosed); + IF (NOT FO) THEN + BEGIN + Reset(UserFile); + IF (IOResult <> 0) THEN + BEGIN + SysOpLog('Error opening USERS.DAT.'); + Exit; + END; + END; + + Seek(UserFile,UserNumber); + Write(UserFile,User); + + IF (NOT FO) THEN + Close(UserFile); + + IF (UserNumber = UserNum) THEN + ThisUser := User + ELSE + BEGIN + IF (General.MultiNode) THEN + BEGIN + NodeNumber := OnNode(UserNumber); + IF (NodeNumber > 0) THEN + BEGIN + LoadNode(NodeNumber); + Include(NodeR.Status,NUpdate); + SaveNode(NodeNumber); + END; + END; + END; + LastError := IOResult; +END; + +FUNCTION MaxUsers: Integer; +VAR + DirInfo1: SearchRec; +BEGIN + FindFirst(General.DataPath+'USERS.DAT',AnyFile,DirInfo1); + IF (DOSError = 0) THEN + MaxUsers := (DirInfo1.Size DIV SizeOf(UserRecordType)) + ELSE + MaxUsers := 0; +END; + +FUNCTION MaxIDXRec: Integer; +VAR + DirInfo1: SearchRec; +BEGIN + FindFirst(General.DataPath+'USERS.IDX',AnyFile,DirInfo1); + IF (DOSError = 0) THEN + MaxIDXRec := (DirInfo1.Size DIV SizeOf(UserIDXRec)) + ELSE + MaxIDXRec := 0; + IF (NOT UserOn) AND (DirInfo1.Size MOD SizeOf(UserIDXRec) <> 0) THEN + MaxIDXRec := -1; { UserOn is so it'll only show during boot up } +END; + +FUNCTION HiMsg: Word; +VAR + DirInfo1: SearchRec; +BEGIN + FindFirst(General.MsgPath+MemMsgArea.FileName+'.HDR',AnyFile,DirInfo1); + IF (DOSError = 0) THEN + HiMsg := (DirInfo1.Size DIV SizeOf(MHeaderRec)) + ELSE + HiMsg := 0; +END; + +PROCEDURE ScanInput(VAR S: AStr; CONST Allowed: AStr); +VAR + SaveS: AStr; + c: Char; + Counter: Byte; + GotCmd: Boolean; +BEGIN + GotCmd := FALSE; + s := ''; + REPEAT + c := UpCase(Char(GetKey)); + 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) THEN + GotCmd := TRUE; + IF (Length(s) < Length(SaveS)) THEN + BackSpace; + IF (Length(s) > Length(SaveS)) THEN + Prompt(s[Length(s)]); + UNTIL (GotCmd) OR (HangUp); + UserColor(1); + NL; +END; + +PROCEDURE ScreenDump(CONST FileName: AStr); +VAR + ScreenFile: Text; + TempStr: AStr; + c: Char; + XPos, + YPos: Byte; + VidSeg: Word; +BEGIN + Assign(ScreenFile,FileName); + Append(ScreenFile); + IF (IOResult = 2) THEN + ReWrite(ScreenFile); + IF (MonitorType = 7) THEN + VidSeg := $B000 + ELSE + VidSeg := $B800; + FOR YPos := 1 TO MaxDisplayRows DO + BEGIN + TempStr := ''; + FOR XPos := 1 TO MaxDisplayCols DO + BEGIN +{$IFDEF MSDOS} + c := Chr(Mem[VidSeg:(160 * (YPos - 1) + 2 * (XPos - 1))]); +{$ENDIF} +{$IFDEF WIN32} + c := SysReadCharAt(XPos - 1, YPos - 1); +{$ENDIF} + IF (c = #0) THEN + c := #32; + IF ((XPos = WhereX) AND (YPos = WhereY)) THEN + c := #178; + TempStr := TempStr + c; + END; + WHILE (TempStr[Length(TempStr)] = ' ') DO + Dec(TempStr[0]); + WriteLn(ScreenFile,TempStr); + END; + Close(ScreenFile); + LastError := IOResult; +END; + +PROCEDURE InputPath(CONST DisplayStr: AStr; VAR DirPath: Str40; CreateDir,AllowExit: Boolean; VAR Changed: Boolean); +VAR + TempDirPath: Str40; + CurDir: PathStr; + Counter: Byte; +BEGIN + REPEAT + TempDirPath := DirPath; + Changed := FALSE; + InputWN1(DisplayStr,TempDirPath,39,[UpperOnly,InterActiveEdit],Changed); + TempDirPath := SQOutSp(TempDirPath); + + IF (Length(TempDirPath) = 1) THEN + TempDirPath := TempDirPath + ':\' + ELSE IF (Length(TempDirPath) = 2) AND (TempDirPath[2] = ':') THEN + TempDirPath := TempDirPath + '\'; + + IF (AllowExit) AND (TempDirPath = '') THEN + BEGIN + NL; + Print('Aborted!'); + END + ELSE IF (TempDirPath = '') THEN + BEGIN + NL; + Print('^7A valid path must be specified!^1'); + END + ELSE IF (NOT (TempDirPath[1] IN ['A'..'Z'])) OR (Length(TempDirPath) < 3) OR + (NOT (TempDirPath[2] = ':')) OR (NOT (TempDirPath[3] = '\')) THEN + BEGIN + NL; + Print('^7Invalid drive specification: "'+Copy(TempDirPath,1,3)+'"^1'); + TempDirPath := ''; + END + ELSE + BEGIN + GetDir(0,CurDir); + ChDir(TempDirPath[1]+':'); + IF (IOResult <> 0) THEN + BEGIN + NL; + Print('^7Drive does not exist: "'+Copy(TempDirPath,1,3)+'"^1'); + TempDirPath := ''; + END + ELSE + BEGIN + ChDir(CurDir); + IF (CreateDir) THEN + BEGIN + TempDirPath := BSlash(TempDirPath,TRUE); + IF (Length(TempDirPath) > 3) AND (NOT ExistDir(TempDirPath)) THEN + BEGIN + NL; + IF PYNQ('Directory does not exist, create it? ',0,FALSE) THEN + BEGIN + Counter := 2; + WHILE (Counter <= Length(TempDirPath)) DO + BEGIN + IF (TempDirPath[Counter] = '\') THEN + BEGIN + IF (TempDirPath[Counter - 1] <> ':') THEN + BEGIN + IF (NOT ExistDir(Copy(TempDirPath,1,(Counter - 1)))) THEN + BEGIN + MkDir(Copy(TempDirPath,1,(Counter - 1))); + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + NL; + Print('Error creating directory: '+Copy(TempDirPath,1,(Counter - 1))); + SysOpLog('^7Error creating directory: '+Copy(TempDirPath,1,(Counter - 1))); + TempDirPath := ''; + END; + END; + END; + END; + Inc(Counter); + END; + END; + END; + END; + END; + END; + UNTIL (TempDirPath <> '') OR (AllowExit) OR (HangUp); + IF (TempDirPath <> '') THEN + TempDirPath := BSlash(TempDirPath,TRUE); + IF (TempDirPath <> DirPath) THEN + Changed := TRUE; + DirPath := TempDirPath; +END; + +FUNCTION OnNode(UserNumber: Integer): Byte; +VAR + NodeNumber: Byte; +BEGIN + OnNode := 0; + IF (General.MultiNode) AND (UserNumber > 0) THEN + FOR NodeNumber := 1 TO MaxNodes DO + BEGIN + LoadNode(NodeNumber); + IF (NodeR.User = UserNumber) THEN + BEGIN + OnNode := NodeNumber; + Exit; + END; + END; +END; + +PROCEDURE PurgeDir(s: AStr; SubDirs: Boolean); +VAR + (* + DirInfo1: SearchRec; + *) + odir: STRING[80]; +BEGIN + s := FExpand(s); + WHILE (s[Length(s)] = '\') DO + Dec(s[0]); + GetDir(ExtractDriveNumber(s),odir); + ChDir(s); + IF (IOResult <> 0) THEN + BEGIN + ChDir(odir); + Exit; + END; + FindFirst('*.*',AnyFile - Directory - VolumeID,DirInfo); (* Directory & VolumnID added *) + WHILE (DOSError = 0) DO + BEGIN + Kill(FExpand(DirInfo.Name)); + FindNext(DirInfo); + END; + ChDir(odir); + IF (SubDirs) THEN + RmDir(s); + LastError := IOResult; + ChDir(StartDir); +END; + +FUNCTION StripName(InString: STRING): STRING; +VAR + StrLen: Byte; +BEGIN + StrLen := Length(InString); + WHILE (StrLen > 0) AND (Pos(InString[StrLen],':\/') = 0) DO + Dec(StrLen); + Delete(InString,1,StrLen); + StripName := InString; +END; + +PROCEDURE Star(InString: AStr); +BEGIN + IF (OkANSI OR OkAvatar) THEN + Prompt('^4� ') + ELSE + Prompt('* '); + IF (InString[Length(InString)] = #29) THEN + Dec(InString[0]) + ELSE + InString := InString + ^M^J; + Prompt('^3'+InString+'^1'); +END; + +FUNCTION ctp(t,b: LongInt): STRING; +VAR + s: AStr; + n: LongInt; +BEGIN + IF ((t = 0) OR (b = 0)) THEN + n := 0 + ELSE + n := (t * 100) DIV b; + Str(n:6,s); + ctp := s; +END; + +FUNCTION CInKey: Char; +BEGIN + IF (NOT LocalIOOnly) AND (NOT Com_IsRecv_Empty) THEN + CInKey := Com_Recv + ELSE + CInKey := #0; +END; + +PROCEDURE Com_Send_Str(CONST InString: AStr); +VAR + Counter: Byte; +BEGIN + FOR Counter := 1 TO Length(InString) DO + CASE InString[Counter] OF + '~' : Delay(250); + '|' : BEGIN + Com_Send(^M); + IF (InWFCMenu) THEN + WriteWFC(^M); + END; + '^' : BEGIN + DTR(FALSE); + Delay(250); + DTR(TRUE); + END; + ELSE + BEGIN + Com_Send(InString[Counter]); + Delay(2); + IF (InWFCMenu) THEN + WriteWFC(InString[Counter]); + END; + END; +END; + +PROCEDURE DoTelnetHangUp(ShowIt: Boolean); +BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN + IF (ShowIt) AND (NOT BlankMenuNow) THEN + BEGIN + TextColor(15); + TextBackGround(1); + GotoXY(32,17); + Prt('Hanging up node..'); + END; + Com_Flush_Recv; + DTR(FALSE); + END; + IF (ShowIt) AND (SysOpOn) AND (NOT BlankMenuNow) THEN + BEGIN + TextColor(15); + TextBackGround(1); + GotoXY(1,17); + ClrEOL; + END; +END; + +PROCEDURE dophoneHangup(ShowIt: Boolean); +VAR + c: Char; + Try: Integer; + SaveTimer: LongInt; +BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN + IF (ShowIt) AND (NOT BlankMenuNow) THEN + BEGIN + TextColor(15); + TextBackGround(1); + GotoXY(32,17); + Write('Hanging up phone...'); + END; + Try := 0; + WHILE (Try < 3) AND (NOT KeyPressed) DO + BEGIN + Com_Flush_Recv; + Com_Send_Str(Liner.HangUp); + SaveTimer := Timer; + WHILE (ABS(Timer - SaveTimer) <= 2) AND (Com_Carrier) DO + BEGIN + c := CInKey; + IF (c > #0) AND (InWFCMenu) THEN + WriteWFC(c); + END; + Inc(Try); + END; + END; + IF (ShowIt) AND (SysOpOn) AND (NOT BlankMenuNow) THEN + BEGIN + TextColor(15); + TextBackGround(1); + GotoXY(1,17); + ClrEOL; + END; +END; + +PROCEDURE DoPhoneOffHook(ShowIt: Boolean); +VAR + TempStr: AStr; + c: Char; + Done: Boolean; + SaveTimer: LongInt; +BEGIN + IF (ShowIt) AND (NOT BlankMenuNow) AND (SysOpOn) THEN + BEGIN + TextColor(15); + TextBackGround(1); + GotoXY(33,17); + Write('Phone off hook'); + END; + Com_Flush_Recv; + Com_Send_Str(Liner.OffHook); + SaveTimer := Timer; + REPEAT + c := CInKey; + IF (c > #0) THEN + BEGIN + IF (InWFCMenu) THEN + WriteWFC(c); + IF (Length(TempStr) >= 160) THEN + Delete(TempStr,1,120); + TempStr := TempStr + c; + IF (Pos(Liner.OK,TempStr) > 0) THEN + Done := TRUE; + END; + UNTIL (ABS(Timer - SaveTimer) > 2) OR (Done) OR (KeyPressed); + Com_Flush_Recv; +END; + +PROCEDURE PauseScr(IsCont: Boolean); +VAR + Cmd: Char; + SaveCurCo, + Counter: Byte; + SaveMCIAllowed: Boolean; +BEGIN + SaveCurCo := CurrentColor; + SaveMCIAllowed := MCIAllowed; + MCIAllowed := TRUE; +{$IFDEF MSDOS} + NoSound; +{$ENDIF} + IF (NOT AllowContinue) AND NOT (PrintingFile AND AllowAbort) THEN + IsCont := FALSE; + IF (IsCont) THEN + { Prompt(FString.Continue) } + lRGLngStr(44,FALSE) + ELSE + BEGIN + IF NOT (PauseIsNull) THEN + { Prompt({FString.lPause); } + lRGLngStr(5,FALSE); + END; + LIL := 1; + IF (IsCont) THEN + BEGIN + REPEAT + Cmd := UpCase(Char(GetKey)); + CASE Cmd OF + 'C' : IF (IsCont) THEN + TempPause := FALSE; + 'N' : Abort := TRUE; + END; + UNTIL (Cmd IN ['Y','N','Q','C',^M]) OR (HangUp); + END + ELSE + Cmd := Char(GetKey); + IF (IsCont) THEN + FOR Counter := 1 TO LennMCI(lRGLngStr(44,TRUE){FString.Continue}) DO + BackSpace + ELSE + FOR Counter := 1 TO LennMCI(lRGLNGStr(5,TRUE){FString.lPause}) DO + BackSpace; + IF (Abort) THEN + NL; + IF (NOT HangUp) THEN + SetC(SaveCurCo); + MCIAllowed := SaveMCIAllowed; +END; + +FUNCTION SearchUser(Uname: Str36; RealNameOK: Boolean): Integer; +VAR + UserIDX: UserIDXRec; + Current: Integer; + Done: Boolean; +BEGIN + SearchUser := 0; + Reset(UserIDXFile); + IF (IOResult <> 0) THEN + BEGIN + SysOpLog('Error opening USERS.IDX.'); + Exit; + END; + + WHILE (Uname[Length(Uname)] = ' ') DO + Dec(Uname[0]); + + Uname := AllCaps(Uname); + + Current := 0; + Done := FALSE; + + IF (FileSize(UserIDXFile) > 0) THEN + REPEAT + Seek(UserIDXFile,Current); + Read(UserIDXFile,UserIDX); + IF (Uname < UserIDX.Name) THEN + Current := UserIDX.Left + ELSE IF (Uname > UserIDX.Name) THEN + Current := UserIDX.Right + ELSE + Done := TRUE; + UNTIL (Current = -1) OR (Done); + Close(UserIDXFile); + + IF (Done) AND (RealNameOK OR NOT UserIDX.RealName) AND (NOT UserIDX.Deleted) THEN + SearchUser := UserIDX.Number; + + LastError := IOResult; +END; + +FUNCTION Plural(InString: STRING; Number: Byte): STRING; +BEGIN + IF (Number <> 1) THEN + Plural := InString + 's' + ELSE + Plural := InString; +END; + +FUNCTION FormattedTime(TimeUsed: LongInt): STRING; +VAR + s: AStr; +BEGIN + s := ''; + IF (TimeUsed > 3600) THEN + BEGIN + s := IntToStr(TimeUsed DIV 3600)+' '+Plural('Hour',TimeUsed DIV 3600) + ' '; + TimeUsed := (TimeUsed MOD 3600); + END; + IF (TimeUsed > 60) THEN + BEGIN + s := s + IntToStr(TimeUsed DIV 60)+' '+Plural('Minute',TimeUsed DIV 60) + ' '; + TimeUsed := (TimeUsed MOD 60); + END; + IF (TimeUsed > 0) THEN + s := s + IntToStr(TimeUsed)+' '+Plural('Second',TimeUsed); + IF (s = '') THEN + s := 'no time'; + WHILE (s[Length(s)] = ' ') DO + Dec(s[0]); + FormattedTime := s; +END; + +FUNCTION FunctionalMCI(CONST S: AStr; FileName,InternalFileName: AStr): STRING; +VAR + Temp: STRING; + Add: AStr; + Index: Byte; +BEGIN + Temp := ''; + FOR Index := 1 TO Length(S) DO + IF (S[Index] = '%') THEN + BEGIN + CASE UpCase(S[Index + 1]) OF + 'A' : Add := AOnOff(LocalIOOnly,'0',IntToStr(ActualSpeed)); + 'B' : Add := IntToStr(ComPortSpeed); + 'C' : Add := Liner.Address; + 'D' : Add := FunctionalMCI(Protocol.DLFList,'',''); + 'E' : Add := Liner.IRQ; + 'F' : Add := SQOutSp(FileName); + 'G' : Add := AOnOff((OkAvatar OR OkANSI),'1','0'); + 'H' : Add := SockHandle; + 'I' : BEGIN + IF (S[Index + 2] = 'P') THEN + BEGIN + Add := ThisUser.CallerID; + Inc(Index,1); + END + ELSE + BEGIN + Add := InternalFileName; + END; + END; + 'K' : BEGIN + LoadFileArea(FileArea); + IF (FADirDLPath IN MemFileArea.FAFlags) THEN + Add := MemFileArea.DLPath+MemFileArea.FileName+'.DIR' + ELSE + Add := General.DataPath+MemFileArea.FileName+'.DIR'; + END; + 'L' : Add := FunctionalMCI(Protocol.TempLog,'',''); + 'M' : Add := StartDir; + 'N' : Add := IntToStr(ThisNode); + 'O' : Add := Liner.DoorPath; + 'P' : Add := IntToStr(Liner.ComPort); + 'R' : Add := ThisUser.RealName; + 'T' : Add := IntToStr(NSL DIV 60); + 'U' : Add := ThisUser.Name; + '#' : Add := IntToStr(UserNum); + '1' : Add := Copy(Caps(ThisUser.RealName),1,Pos(' ',ThisUser.RealName) - 1); + '2' : IF (Pos(' ', ThisUser.RealName) = 0) THEN + Add := Caps(ThisUser.RealName) + ELSE + Add := Copy(Caps(ThisUser.RealName),Pos(' ',ThisUser.RealName) + 1,255); + ELSE + Add := '%' + S[Index + 1]; + END; + Temp := Temp + Add; + Inc(Index); + END + ELSE + Temp := Temp + S[Index]; + FunctionalMCI := Temp; +END; + +FUNCTION MCI(CONST S: STRING): STRING; +VAR + Temp: STRING; + Add: AStr; + Index: Byte; + I: Integer; +BEGIN + Temp := ''; + FOR Index := 1 TO Length(S) DO + IF (S[Index] = '%') AND (Index + 1 < Length(S)) THEN + BEGIN + Add := '%' + S[Index + 1] + S[Index + 2]; + WITH ThisUser DO + CASE UpCase(S[Index + 1]) OF + 'A' : CASE UpCase(S[Index + 2]) OF + '1' : Add := IntToStr(LowFileArea); + '2' : Add := IntToStr(HighFileArea); + '3' : Add := IntToStr(LowMsgArea); + '4' : Add := IntToStr(HighMsgArea); + 'B' : Add := FormatNumber(lCredit - Debit); + 'C' : Add := Copy(Ph,1,3); + 'D' : Add := Street; + 'O' : BEGIN + IF (PrintingFile) OR (Reading_A_Msg) THEN + AllowAbort := FALSE; + Add := ''; + END; + END; + 'B' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := IntToStr(ActualSpeed); + 'L' : Add := PHours('Always allowed',General.MinBaudLowTime,General.MinBaudHiTime); + 'M' : Add := PHours('Always allowed',General.MinBaudDLLowTime,General.MinBaudDLHiTime); + 'N' : Add := General.BBSName; + 'P' : Add := General.BBSPhone; + END; + 'C' : CASE UpCase(S[Index + 2]) OF + 'A' : Add := FormatNumber(General.CallAllow[SL]); + 'D' : Add := AOnOff(General.PerCall,'call','day '); + 'L' : Add := ^L; + 'M' : Add := IntToStr(Msg_On); + 'N' : IF FindConference(CurrentConf,Conference) THEN + Add := Conference.Name + ELSE + Add:= ''; + 'R' : Add := FormatNumber(lCredit); + 'S' : Add := PHours('Always allowed',General.lLowTime,General.HiTime); + 'T' : Add := CurrentConf; + '+' : BEGIN + Add := ''; + CursorOn(TRUE); + END; + '-' : BEGIN + Add := ''; + CursorOn(FALSE); + END; + END; + 'D' : CASE UpCase(S[Index + 2]) OF + '1'..'3' : + Add := UsrDefStr[Ord(S[Index + 2]) - 48]; + 'A' : Add := DateStr; + 'B' : Add := FormatNumber(Debit); + 'D' : Add := FormatNumber(General.DlOneDay[SL]); + 'H' : Add := PHours('Always allowed',General.DLLowTime,General.DLHiTime); + 'K' : Add := FormatNumber(DK); + 'L' : Add := FormatNumber(Downloads); + 'S' : Add := IntToStr(DSL); + 'T' : BEGIN + IF (Timer > 64800) THEN + Add := 'evening' + ELSE IF (Timer > 43200) THEN + Add := 'afternoon' + ELSE + Add := 'morning' + END; + END; + 'E' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := AOnOff((Expiration = 0),'Never',ToDate8(PD2Date(Expiration))); + 'S' : Add := FormatNumber(EmailSent); + 'T' : Add := IntToStr(General.EventWarningTime); + 'W' : Add := FormatNumber(Waiting); + 'X' : IF (Expiration > 0) THEN + Add := IntToStr((Expiration DIV 86400) - (GetPackDateTime DIV 86400)) + ELSE + Add := 'Never'; + END; + 'F' : CASE UpCase(S[Index + 2]) OF + '#' : Add := IntToStr(CompFileArea(FileArea,0)); + 'B' : BEGIN + LoadFileArea(FileArea); + Add := MemFileArea.AreaName; + END; + 'D' : Add := ToDate8(PD2Date(FirstOn)); + 'K' : Add := FormatNumber(DiskFree(ExtractDriveNumber(MemFileArea.ULPath)) DIV 1024); + 'N' : Add := Copy(RealName,1,(Pos(' ', RealName) - 1)); + 'P' : Add := FormatNumber(FilePoints); + 'S' : Add := AOnOff(NewScanFileArea,'','not '); + 'T' : Add := IntToStr(NumFileAreas); + END; + 'G' : CASE UpCase(S[Index + 2]) OF + 'N' : AOnOff((Sex = 'M'),'Mr.','Ms.'); + END; + 'H' : CASE UpCase(S[Index + 2]) OF + '1' : Add := CTim(General.lLowTime); (* Verify All CTim *) + '2' : Add := CTim(General.HiTime); + '3' : Add := CTim(General.MinBaudLowTime); + '4' : Add := CTim(General.MinBaudHiTime); + '5' : Add := CTim(General.DLLowTime); + '6' : Add := CTim(General.DLHiTime); + '7' : Add := CTim(General.MinBaudDLLowTime); + '8' : add := CTim(General.MinBaudDLHiTime); + 'M' : Add := IntToStr(HiMsg); + END; + 'I' : CASE UpCase(S[Index + 2]) OF + 'L' : Add := IntToStr(Illegal); + 'P' : Add := ThisUser.CallerID; + END; + 'K' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := FormatNumber(General.DLKOneday[SL]); + 'R' : IF (DK > 0) THEN + Str((UK / DK):3:3,Add) + ELSE + Add := '0'; + END; + 'L' : CASE UpCase(S[Index + 2]) OF + 'C' : Add := ToDate8(PD2Date(LastOn)); + 'F' : Add := ^M^J; + 'N' : BEGIN + I := Length(RealName); + WHILE ((RealName[i] <> ' ') AND (i > 1)) DO + Dec(i); + Add := Copy(Caps(RealName),(i + 1),255); + END; + 'O' : Add := CityState; + END; + 'M' : CASE UpCase(S[Index + 2]) OF + '#' : Add := IntToStr(CompMsgArea(MsgArea,0)); + '1' : Add := IntToStr(General.GlobalMenu); + '2' : Add := IntToStr(General.AllStartMenu); + '3' : Add := IntToStr(General.ShuttleLogonMenu); + '4' : Add := IntToStr(General.NewUserInformationMenu); + '5' : Add := IntToStr(General.MessageReadMenu); + '6' : Add := IntToStr(General.FileListingMenu); + '7' : Add := IntToStr(General.MinimumBaud); + 'B' : BEGIN + i := ReadMsgArea; + IF (i <> MsgArea) THEN + LoadMsgArea(MsgArea); + Add := MemMsgArea.Name; + END; + 'L' : Add := IntToStr(NSL DIV 60); + 'N' : Add := ShowOnOff(General.MultiNode); + 'O' : Add := IntToStr((GetPackDateTime - TimeOn) DIV 60); + 'R' : Add := IntToStr(HiMsg - Msg_On); + 'S' : Add := AOnOff(LastReadRecord.NewScan,'','not '); + 'T' : Add := IntToStr(NumMsgAreas); + END; + 'N' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := IntToStr(ThisNode); + 'L' : Add := ''; + 'M' : Add := ShowOnOff(General.NetworkMode); + 'R' : IF (Downloads > 0) THEN + Str((Uploads / Downloads):3:3,Add) + ELSE + Add := '0'; + END; + 'O' : CASE UpCase(S[Index + 2]) OF + '1' : IF (RIP IN SFlags) THEN + Add := 'RIP' + ELSE IF (Avatar IN Flags) THEN + Add := 'Avatar' + ELSE IF (ANSI IN Flags) THEN + Add := 'ANSI' + ELSE IF (VT100 IN Flags) THEN + Add := 'VT-100' + ELSE + Add := 'None'; + '2' : Add := IntToStr(LineLen)+'x'+IntToStr(PageLen); + '3' : Add := ShowOnOff(ClsMsg IN SFlags); + '4' : Add := ShowOnOff(FSEditor IN SFlags); + '5' : Add := ShowOnOff(Pause IN Flags); + '6' : Add := ShowOnOff(HotKey IN Flags); + '7' : Add := ShowOnOff(NOT (Novice IN Flags)); + '8' : IF (ForUsr > 0) THEN + Add := 'Forwarded - '+IntToStr(ForUsr) + ELSE IF (Nomail IN Flags) THEN + Add := 'Closed' + ELSE + Add := 'Open'; + '9' : Add := ShowOnOff(Color IN Flags); + 'S' : BEGIN + CASE Tasker OF + None : Add := 'DOS'; + DV : Add := 'DV'; + Win : Add := 'Windows'; + OS2 : Add := 'OS/2'; + Win32 : Add := 'Windows 32bit'; + Dos5N : Add := 'DOS/N'; + END; + END; + END; + 'P' : CASE UpCase(S[Index + 2]) OF + '1' : Add := General.MsgPath; + '2' : Add := General.NodePath; + '3' : Add := General.LMultPath; + '4' : Add := General.SysOpPW; + '5' : Add := General.NewUserPW; + '6' : Add := General.MinBaudOverride; + '7' : Add := General.ArcsPath; + 'B' : Add := General.BulletPrefix; + 'C' : IF (LoggedOn > 0) THEN + Str((MsgPost / LoggedOn) * 100:3:2,Add) + ELSE + Add := '0'; + 'D' : Add := General.DataPath; + 'F' : Add := General.FileAttachPath; + 'L' : Add := General.LogsPath; + 'M' : Add := General.MiscPath; + 'N' : Add := Ph; + 'O' : BEGIN + IF (PrintingFile) OR (Reading_A_Msg) THEN + TempPause := FALSE; + Add := ''; + END; + 'P' : Add := General.ProtPath; + 'S' : Add := FormatNumber(MsgPost); + 'T' : Add := General.TempPath; + END; + 'Q' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := IntToStr(NumBatchDLFiles); + 'U' : Add := IntToStr(NumBatchULFiles); + END; + 'R' : CASE UpCase(S[Index + 2]) OF + 'N' : Add := Caps(RealName); + END; + 'S' : CASE UpCase(S[Index + 2]) OF + '1' : Add := lRGLngStr(41,TRUE); {FString.UserDefEd[Ord(S[Index + 2]) - 48]; } + '2' : Add := lRGLngStr(42,TRUE); {FString.UserDefEd[Ord(S[Index + 2]) - 48]; } + '3' : Add := lRGLngStr(43,TRUE); {FString.UserDefEd[Ord(S[Index + 2]) - 48]; } + 'A' : Add := AOnOff((SysOpAvailable), 'available','unavailable' ); + 'C' : Add := FormatNumber(General.CallerNum); + 'D' : Add := IntToStr(General.TotalDloads); + 'L' : Add := IntToStr(SL); + 'M' : Add := IntToStr(General.TotalUsage); + 'N' : Add := General.SysopName; + 'P' : Add := IntToStr(General.TotalPosts); + 'U' : Add := IntToStr(General.TotalUloads); + 'X' : Add := AOnOff((Sex = 'M'),'Male','Female'); + END; + 'T' : CASE UpCase(S[Index + 2]) OF + '1' : Add := FormatNumber(General.TimeAllow[SL]); + 'A' : Add := FormatNumber(TimeBankAdd); + 'B' : Add := FormatNumber(TimeBank); + 'C' : Add := FormatNumber(LoggedOn); + 'D' : Add := FormatNumber(DLToday); + 'G' : Add := GetTagLine; + 'I' : Add := TimeStr; + 'K' : Add := ConvertBytes(DLKToday * 1024,FALSE); + 'L' : Add := CTim(NSL); + 'N' : Add := Liner.NodeTelnetURL; + 'O' : Add := IntToStr(General.TimeAllow[SL] - TLToday); + 'S' : BEGIN + Assign(HistoryFile, General.DataPath+'HISTORY.DAT'); + {$I-} Reset(HistoryFile); {$I+} + IF (IOResult <> 0) THEN + BEGIN + Add := 'Error With HISTORY.DAT, Inform ' + General.SysOpName + '!'; + END + ELSE + BEGIN + Seek(HistoryFile, (FileSize(HistoryFile)-1)); + Read(HistoryFile, HistoryRec); + Add := IntToStr(HistoryRec.Callers); + Close(HistoryFile); + END; + END; + 'T' : Add := FormatNumber(TTimeOn); + 'U' : Add := IntToStr(General.NumUsers); + END; + 'U' : CASE UpCase(S[Index + 2]) OF + 'A' : Add := IntToStr(AgeUser(BirthDate)); + 'B' : Add := ToDate8(PD2Date(BirthDate)); + 'C' : Add := IntToStr(OnToday); + 'F' : Add := FormatNumber(Feedback); + 'K' : Add := FormatNumber(UK); + 'L' : Add := FormatNumber(Uploads); + 'M' : Add := IntToStr(MaxUsers - 1); + 'N' : Add := Caps(Name); + 'U' : Add := IntToStr(UserNum); + END; + 'V' : CASE UpCase(S[Index + 2]) OF + 'R' : Add := General.Version; + END; + 'Z' : CASE UpCase(S[Index + 2]) OF + 'P' : Add := ZipCode; + END; + END; + Temp := Temp + Add; + Inc(Index,2); + END + ELSE + Temp := Temp + S[Index]; + MCI := Temp; +END; + +PROCEDURE BackErase(Len: Byte); +VAR + Counter: Byte; +BEGIN + IF (OkANSI) OR (OkVT100) THEN + SerialOut(^[+'['+IntToStr(Len)+'D'+^[+'[K') + ELSE IF (OkAvatar) THEN + BEGIN + FOR Counter := 1 TO Len DO + Com_Send(^H); + SerialOut(^V^G); + END + ELSE + FOR Counter := 1 TO Len DO + BEGIN + Com_Send(^H); + Com_Send(' '); + Com_Send(^H); + END; + GotoXY((WhereX - Len),WhereY); + ClrEOL; +END; + +FUNCTION DiskKBFree(DrivePath: AStr): LongInt; +VAR + F: TEXT; +{$IFDEF MSDOS} + Regs: Registers; +{$ENDIF} + S, + S1: STRING; + Counter: Integer; + C, + C1, + C2: Comp; +BEGIN + C2 := 0.0; (* RGCMD *) + SwapVectors; + Exec(GetEnv('RGCMD'),' /C DIR '+DrivePath[1]+': > FREE.TXT'); + SwapVectors; + IF (EXIST('FREE.TXT')) THEN + BEGIN + Assign(F,'FREE.TXT'); + Reset(F); + WHILE NOT EOF(F) DO + BEGIN + ReadLn(F,S); + IF (Pos('bytes free',s) <> 0) THEN + BEGIN + WHILE (S[1] = ' ') DO + Delete(S,1,1); + Delete(S,1,Pos(')',s)); + WHILE (S[1] = ' ') DO + Delete(S,1,1); + S := COPY(S,1,Pos(' ',S) - 1); + S1 := ''; + FOR Counter := 1 TO Length(S) DO + IF (S[Counter] <> ',') THEN + S1 := S1 + S[Counter]; + END; + END; + Close(F); + Erase(F); + Val(S1,C2,Counter); + END + ELSE + BEGIN +{$IFDEF MSDOS} + FillChar(Regs,SizeOf(Regs),#0); + Regs.Ah := $36; + Regs.Dl := ExtractDriveNumber(DrivePath); + Intr($21,Regs); + C := (1.0 * Regs.Ax); + C1 := ((1.0 * Regs.Cx) * C); + C2 := ((1.0 * Regs.Bx) * C1); +{$ENDIF} +{$IFDEF WIN32} + C2 := DiskFree(ExtractDriveNumber(DrivePath)); +{$ENDIF} + END; + DiskKBFree := Round(C2 / 1024.0); +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := S; +END; + +PROCEDURE MyDelay(WaitFor: LongInt); +VAR + CheckMS: LongInt; +BEGIN + CheckMS := (Ticks + WaitFor); + REPEAT + UNTIL (Ticks > CheckMS); +END; + +END. diff --git a/SOURCE/COMMON1.PAS b/SOURCE/COMMON1.PAS new file mode 100644 index 0000000..e939aae --- /dev/null +++ b/SOURCE/COMMON1.PAS @@ -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. + diff --git a/SOURCE/COMMON2.PAS b/SOURCE/COMMON2.PAS new file mode 100644 index 0000000..2e6d117 --- /dev/null +++ b/SOURCE/COMMON2.PAS @@ -0,0 +1,1313 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} + +UNIT Common2; + +INTERFACE + +USES + Common, + MyIO; + +PROCEDURE SKey1(VAR C: Char); +PROCEDURE SaveGeneral(x: Boolean); +PROCEDURE TLeft; +PROCEDURE ChangeUserDataWindow; +PROCEDURE lStatus_Screen(WhichScreen: Byte; CONST Message: AStr; OneKey: Boolean; VAR Answer: AStr); +PROCEDURE Update_Screen; +PROCEDURE ToggleWindow(ShowIt: Boolean); + +IMPLEMENTATION + +USES + Crt, + Dos, + TimeFunc, + LineChat, + SysOp2G, + SysOp3, + SplitCha +{$IFDEF WIN32} + ,VPSysLow + ,Windows +{$ENDIF} + ; + +CONST + SYSKEY_LENGTH = 1269; + + SYSKEY: ARRAY [1..1269] OF Char = ( + #3 ,#16,'�',#26,'M','�','�',#24,'�',#17,#25,#23,#11,'R','e','n','e', + 'g','a','d','e',' ','B','u','l','l','e','t','i','n',' ','B','o','a', + 'r','d',' ','S','y','s','t','e','m',#25,#23,#3 ,#16,'�',#24,'�',#26, + '%','�','�',#26,'&','�','�',#24,'�',' ',#14,'A','L','T','+','B',' ', + #15,':',' ',#7 ,'T','o','g','g','l','e',' ','"','B','e','e','p','-', + 'a','f','t','e','r','-','e','n','d','"',#25,#5 ,#3 ,'�',' ',#14,'A', + 'L','T','+','N',' ',#15,':',' ',#7 ,'S','w','i','t','c','h',' ','t', + 'o',' ','n','e','x','t',' ','S','y','s','O','p',' ','w','i','n','d', + 'o','w',#25,#2 ,#3 ,'�',#24,'�',' ',#14,'A','L','T','+','C',' ',#15, + ':',' ',#7 ,'E','n','t','e','r','/','E','x','i','t',' ','c','h','a', + 't',' ','m','o','d','e',#25,#8 ,#3 ,'�',' ',#14,'A','L','T','+','O', + ' ',#15,':',' ',#7 ,'C','o','n','f','e','r','e','n','c','e',' ','S', + 'y','s','t','e','m',' ','t','o','g','g','l','e',#25,#5 ,#3 ,'�',#24, + '�',' ',#14,'A','L','T','+','D',' ',#15,':',' ',#7 ,'D','u','m','p', + ' ','s','c','r','e','e','n',' ','t','o',' ','f','i','l','e',#25,#9 , + #3 ,'�',' ',#14,'A','L','T','+','P',' ',#15,':',' ',#7 ,'P','r','i', + 'n','t',' ','f','i','l','e',' ','t','o',' ','t','h','e',' ','u','s', + 'e','r',#25,#7 ,#3 ,'�',#24,'�',' ',#14,'A','L','T','+','E',' ',#15, + ':',' ',#7 ,'E','d','i','t',' ','C','u','r','r','e','n','t',' ','U', + 's','e','r',#25,#11,#3 ,'�',' ',#14,'A','L','T','+','Q',' ',#15,':', + ' ',#7 ,'T','u','r','n',' ','o','f','f',' ','c','h','a','t',' ','p', + 'a','g','i','n','g',#25,#9 ,#3 ,'�',#24,'�',' ',#14,'A','L','T','+', + 'F',' ',#15,':',' ',#7 ,'G','e','n','e','r','a','t','e',' ','f','a', + 'k','e',' ','l','i','n','e',' ','n','o','i','s','e',#25,#4 ,#3 ,'�', + ' ',#14,'A','L','T','+','R',' ',#15,':',' ',#7 ,'S','h','o','w',' ', + 'c','h','a','t',' ','r','e','q','u','e','s','t',' ','r','e','a','s', + 'o','n',#25,#5 ,#3 ,'�',#24,'�',' ',#14,'A','L','T','+','G',' ',#15, + ':',' ',#7 ,'T','r','a','p','/','c','h','a','t','-','c','a','p','t', + 'u','r','i','n','g',' ','t','o','g','g','l','e','s',' ',' ',#3 ,'�', + ' ',#14,'A','L','T','+','S',' ',#15,':',' ',#7 ,'S','y','s','O','p', + ' ','W','i','n','d','o','w',' ','o','n','/','o','f','f',#25,#10,#3 , + '�',#24,'�',' ',#14,'A','L','T','+','H',' ',#15,':',' ',#7 ,'H','a', + 'n','g','u','p',' ','u','s','e','r',' ','i','m','m','e','d','i','a', + 't','e','l','y',#25,#5 ,#3 ,'�',' ',#14,'A','L','T','+','T',' ',#15, + ':',' ',#7 ,'T','o','p','/','B','o','t','t','o','m',' ','S','y','s', + 'O','p',' ','w','i','n','d','o','w',#25,#6 ,#3 ,'�',#24,'�',' ',#14, + 'A','L','T','+','I',' ',#15,':',' ',#7 ,'T','o','g','g','l','e',' ', + 'u','s','e','r',' ','i','n','p','u','t',#25,#11,#3 ,'�',' ',#14,'A', + 'L','T','+','U',' ',#15,':',' ',#7 ,'T','o','g','g','l','e',' ','u', + 's','e','r',' ','s','c','r','e','e','n',#25,#11,#3 ,'�',#24,'�',' ', + #14,'A','L','T','+','J',' ',#15,':',' ',#7 ,'J','u','m','p',' ','t', + 'o',' ','t','h','e',' ','O','S',#25,#14,#3 ,'�',' ',#14,'A','L','T', + '+','V',' ',#15,':',' ',#7 ,'A','u','t','o','-','v','a','l','i','d', + 'a','t','e',' ','u','s','e','r',#25,#11,#3 ,'�',#24,'�',' ',#14,'A', + 'L','T','+','K',' ',#15,':',' ',#7 ,'K','i','l','l',' ','u','s','e', + 'r',' ','w','/','H','A','N','G','U','P','#',' ','f','i','l','e',#25, + #4 ,#3 ,'�',' ',#14,'A','L','T','+','W',' ',#15,':',' ',#7 ,'E','d', + 'i','t',' ','U','s','e','r',' ','w','i','t','h','o','u','t',' ','n', + 'o','t','i','c','e',#25,#5 ,#3 ,'�',#24,'�',' ',#14,'A','L','T','+', + 'L',' ',#15,':',' ',#7 ,'T','o','g','g','l','e',' ','l','o','c','a', + 'l',' ','s','c','r','e','e','n',' ','d','i','s','p','l','a','y',' ', + ' ',#3 ,'�',' ',#14,'A','L','T','+','Z',' ',#15,':',' ',#7 ,'W','a', + 'k','e',' ','u','p',' ','a',' ','s','l','e','e','p','i','n','g',' ', + 'u','s','e','r',#25,#6 ,#3 ,'�',#24,'�',' ',#14,'A','L','T','+','M', + ' ',#15,':',' ',#7 ,'M','a','k','e','/','T','a','k','e',' ','T','e', + 'm','p',' ','S','y','s','O','p',' ','A','c','c','e','s','s',' ',' ', + #3 ,'�',' ',#14,'A','L','T','-','#',' ',#15,':',' ',#7 ,'E','x','e', + 'c','u','t','e',' ','G','L','O','B','A','T','#','.','B','A','T',#25, + #10,#3 ,'�',#24,'�',' ',#14,'A','L','T','+','+',' ',#15,':',' ',#7 , + 'G','i','v','e',' ','5',' ','m','i','n','u','t','e','s',' ','t','o', + ' ','u','s','e','r',#25,#6 ,#3 ,'�',' ',#14,'A','L','T','+','-',' ', + #15,':',' ',#7 ,'T','a','k','e',' ','5',' ','m','i','n','u','t','e', + 's',' ','f','r','o','m',' ','u','s','e','r',#25,#5 ,#3 ,'�',#24,'�', + #26,'%','�','�',#26,'&','�','�',#24,'�',' ',#14,'C','T','R','L','+', + 'H','O','M','E',' ',#15,':',' ',#7 ,'T','h','i','s',' ','h','e','l', + 'p',' ','s','c','r','e','e','n',#25,#10,#14,'C','T','R','L','+','S', + 'Y','S','R','Q',' ',#15,':',' ',#7 ,'F','a','k','e',' ','s','y','s', + 't','e','m',' ','e','r','r','o','r',#25,#7 ,#3 ,'�',#24,'�',' ',#14, + 'S','C','R','L','C','K',#25,#3 ,#15,':',' ',#7 ,'T','o','g','g','l', + 'e',' ','c','h','a','t',' ','a','v','a','i','l','a','b','i','l','i', + 't','y',#25,#2 ,#14,'A','L','T','+','F','1','-','F','5',' ',' ',#15, + ':',' ',#7 ,'S','y','s','O','p',' ','W','i','n','d','o','w',' ','1', + ' ','-',' ','5',#25,#6 ,#3 ,'�',#24,'�',#26,'M','�','�',#24,#24,#24, + #24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24, + #24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24); + + WIN1_LENGTH = 51; + + WIN1: ARRAY [1..51] OF Char = ( + #15,#23,#25,#27,'A','R',':',#25,#27,'N','S','L',':',#25,#4 ,'T','i', + 'm','e',':',#25,#6 ,#24,#25,#27,'A','C',':',#25,#15,'B','a','u','d', + ':',#25,#6 ,'D','S','L',':',#25,#4 ,'N','o','d','e',':',#25,#6 ,#24); + + WIN2_LENGTH = 42; + + WIN2: ARRAY [1..42] OF Char = ( + #15,#23,#25,#27,'P','H',':',#25,#18,'F','O',':',#25,#10,'T','e','r', + 'm',':',#25,#10,#24,#25,#27,'B','D',':',#25,#18,'L','O',':',#25,#10, + 'E','d','i','t',':',#25,#10,#24); + + WIN3_LENGTH = 80; + + WIN3: ARRAY [1..80] OF Char = ( + #15,#23,' ','T','C',':',#25, #6,'C','T',':',#25, #6,'P','P',':',#25, + #6,'F','S',':',#25, #6,'D','L',':',#25,#14,'F','R',':',#25, #5,'T', + 'i','m','e',':',#25, #6,#24,' ','T','T',':',#25, #6,'B','L',':',#25, + #6,'E','S',':',#25, #6,'T','B',':',#25, #6,'U','L',':',#25,#14,'P', + 'R',':',#25, #5,'N','o','d','e',':',#25, #6,#24); + + WIN4_LENGTH = 96; + + WIN4: ARRAY [1..96] OF Char = ( + #8 ,#23,' ',#15,'T','o','d','a','y',#39,'s',' ',#8 ,'�',' ',' ',#15, + 'C','a','l','l','s',':',#25,#7 ,'E','m','a','i','l',':',#25,#7 ,'D', + 'L',':',#25,#17,'N','e','w','u','s','e','r','s',':',#25,#9 ,#24,#25, + #2 ,'S','t','a','t','s',' ',#8 ,'�',' ',' ',#15,'P','o','s','t','s', + ':',#25,#7 ,'F','e','e','d','b',':',#25,#7 ,'U','L',':',#25,#17,'A', + 'c','t','i','v','i','t','y',':',#25,#9 ,#24); + + WIN5_LENGTH = 113; + + WIN5: ARRAY [1..113] OF Char = ( + #8 ,#23,' ',#15,'S','y','s','t','e','m',' ',' ',#8 ,'�',' ',' ',#15, + 'C','a','l','l','s',':',#25,#7 ,'D','L',':',#25,#7 ,'D','a','y','s', + ' ',':',#25,#6 ,'U','s','e','r','s',':',#25,#6 ,'D','i','s','k','f', + 'r','e','e',':',#25,#7 ,#24,' ',' ','S','t','a','t','s',' ',' ',#8 , + '�',' ',' ',#15,'P','o','s','t','s',':',#25,#7 ,'U','L',':',#25,#7 , + 'H','o','u','r','s',':',#25,#6 ,'M','a','i','l',' ',':',#25,#6 ,'O', + 'v','e','r','l','a','y','s',':',#25,#7 ,#24); + +{$IFDEF MSDOS} +PROCEDURE BiosScroll(up: Boolean); ASSEMBLER; +ASM + Mov cx,0 + Mov dh,MaxDisplayRows + Mov dl,MaxDisplayCols + Mov bh,7 + Mov al,2 + Cmp up,1 + Je @Up + Mov ah,7 + Jmp @go + @up: + Mov ah,6 + @Go: + Int 10h +END; +{$ENDIF} +{$IFDEF WIN32} +PROCEDURE BiosScroll(up: Boolean); +BEGIN + if (up) then + begin + SysScrollUp(0, 0, MaxDisplayCols-1, MaxDisplayRows-1, 2, 7); + end else + begin + SysScrollDn(0, 0, MaxDisplayCols-1, MaxDisplayRows-1, 2, 7); + end; +END; +{$ENDIF} + +PROCEDURE CPR(c1,c2: Byte); +VAR + Flag: FlagType; +BEGIN + FOR Flag := RLogon TO RMsg DO + BEGIN + IF (Flag IN ThisUser.Flags) THEN + TextAttr := c1 + ELSE + TextAttr := c2; + Write(Copy('LCVUA*PEKM',(Ord(Flag) + 1),1)); + END; + FOR Flag := FNoDLRatio TO FNoDeletion DO + BEGIN + IF (Flag IN ThisUser.Flags) THEN + TextAttr := c1 + ELSE + TextAttr := c2; + Write(Copy('1234',(Ord(Flag) - 19),1)); + END; +END; + +PROCEDURE Clear_Status_Box; +BEGIN + IF (General.IsTopWindow) THEN + Window(1,1,MaxDisplayCols,2) + ELSE + Window(1,(MaxDisplayRows - 1),MaxDisplayCols,MaxDisplayRows); + ClrScr; + Window(1,1,MaxDisplayCols,MaxDisplayRows); +END; + +PROCEDURE ToggleWindow(ShowIt: Boolean); +VAR + SaveWhereX, + SaveWhereY, + SaveTextAttr: Byte; +BEGIN + SaveWhereX := WhereX; + SaveWhereY := WhereY; + SaveTextattr := TextAttr; + TextAttr := 7; + IF (General.WindowOn) THEN + BEGIN + Clear_Status_Box; + IF (General.IsTopWindow) THEN + BEGIN + GoToXY(1, MaxDisplayRows); + Write(^J^J); + END; + END + ELSE + BEGIN + IF (General.IsTopWindow AND (SaveWhereY <= (MaxDisplayRows - 2))) THEN + BiosScroll(FALSE) + ELSE IF (NOT General.IsTopWindow AND (SaveWhereY > (MaxDisplayRows - 2))) THEN + BEGIN + BiosScroll(TRUE); + Dec(SaveWhereY,2) + END + ELSE IF (General.IsTopWindow) THEN + Dec(SaveWhereY,2); + END; + General.WindowOn := NOT General.WindowOn; + IF (ShowIt) THEN + Update_Screen; + GoToXY(SaveWhereX,SaveWhereY); + TextAttr := SaveTextAttr; +END; + +PROCEDURE lStatus_Screen(WhichScreen: Byte; CONST Message: AStr; OneKey: Boolean; VAR Answer: AStr); +VAR + HistoryFile: FILE OF HistoryRecordType; + History: HistoryRecordType; + User: UserRecordType; + C: Char; + FirstRow, + SecondRow, + SaveWhereX, + SaveWhereY, + SaveTextAttr: Byte; + SaveWindowOn: Boolean; +BEGIN + IF ((InWFCMenu OR (NOT General.WindowOn)) AND (WhichScreen < 99)) OR + (General.NetworkMode AND NOT CoSysOp) THEN + Exit; + SaveWindowOn := General.WindowOn; + IF (NOT General.WindowOn) THEN + ToggleWindow(FALSE); + TLeft; + SaveWhereX := WhereX; + SaveWhereY := WhereY; + SaveTextAttr := TextAttr; + Window(1,1,MaxDisplayCols,MaxDisplayRows); + IF (General.IsTopWindow) THEN + FirstRow := 1 + ELSE + FirstRow := (MaxDisplayRows - 1); + SecondRow := (FirstRow + 1); + TextAttr := 120; + LastScreenSwap := 0; + CursorOn(FALSE); + Clear_Status_Box; + IF (WhichScreen < 99) THEN + General.CurWindow := WhichScreen; + CASE WhichScreen OF + 1 : WITH ThisUser DO + BEGIN +{$IFDEF MSDOS} + Update_Logo(Win1,ScreenAddr[(FirstRow - 1) * 160],WIN1_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win1, 1, FirstRow, WIN1_LENGTH); +{$ENDIF} + GoToXY(02,FirstRow); + Write(Caps(Name)); + GoToXY(33,FirstRow); + FOR C := 'A' TO 'Z' DO + BEGIN + IF (C IN AR) THEN + TextAttr := 116 + ELSE + TextAttr := 120; + Write(C); + END; + TextAttr := 120; + GoToXY(65,FirstRow); + IF (TempSysOp) THEN + BEGIN + TextAttr := 244; + Write(255); + TextAttr := 120; + END + ELSE + Write(SL); + GoToXY(75,FirstRow); + Write(NSL DIV 60); + GoToXY(02,SecondRow); + Write(RealName+' #'+IntToStr(UserNum)); + GoToXY(33,SecondRow); + CPR(116,120); + TextAttr := 120; + GoToXY(54,SecondRow); + Write(ActualSpeed); + GoToXY(65,SecondRow); + IF (TempSysOp) THEN + BEGIN + TextAttr := 244; + Write(255); + TextAttr := 120; + END + ELSE + Write(DSL); + GoToXY(75,SecondRow); + Write(ThisNode); + END; + 2 : WITH ThisUser DO + BEGIN +{$IFDEF MSDOS} + Update_Logo(Win2,ScreenAddr[(FirstRow - 1) * 160],WIN2_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win2, 1, FirstRow, WIN2_LENGTH); +{$ENDIF} + GoToXY(02,FirstRow); + Write(Street); + GoToXY(33,FirstRow); + Write(Ph); + GoToXY(55,FirstRow); + Write(ToDate8(PD2Date(Firston))); + GoToXY(71,FirstRow); + IF (OKRIP) THEN + Write('RIP') + ELSE IF (OKAvatar) THEN + Write('AVATAR') + ELSE IF (OkANSI) THEN + Write('ANSI') + ELSE IF (OkVT100) THEN + Write('VT-100') + ELSE + Write('NONE'); + GoToXY(02,SecondRow); + Write(PadLeftStr(Citystate+' '+Zipcode,26)); + GoToXY(33,SecondRow); + Write(ToDate8(PD2Date(BirthDate)),', '); + Write(Sex+' ',AgeUser(ThisUser.BirthDate)); + GoToXY(55,SecondRow); + Write(ToDate8(PD2Date(Laston))); + GoToXY(71,SecondRow); + IF (FSEditor IN SFlags) THEN + Write('FullScrn') + ELSE + Write('Regular'); + END; + 3 : WITH ThisUser DO + BEGIN +{$IFDEF MSDOS} + Update_Logo(Win3,ScreenAddr[(FirstRow - 1) * 160],WIN3_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win3, 1, FirstRow, WIN3_LENGTH); +{$ENDIF} + GoToXY(06,FirstRow); + Write(Loggedon); + GoToXY(16,FirstRow); + Write(OnToday); + GoToXY(26,FirstRow); + Write(MsgPost); + GoToXY(36,FirstRow); + Write(Feedback); + GoToXY(46,FirstRow); + Write(IntToStr(Downloads)+'/'+ConvertKB(DK,FALSE)); + GoToXY(64,FirstRow); + IF (Downloads > 0) THEN + Write((Uploads / Downloads) * 100:3:0,'%') + ELSE + Write(0); + GoToXY(75,FirstRow); + Write(NSL DIV 60); + GoToXY(06,SecondRow); + Write(TTimeon); + GoToXY(16,SecondRow); + Write(ThisUser.lCredit - ThisUser.Debit); + GoToXY(26,SecondRow); + Write(EmailSent); + GoToXY(36,SecondRow); + Write(TimeBank); + GoToXY(46,SecondRow); + Write(IntToStr(Uploads)+'/'+ConvertKB(UK,FALSE)); + GoToXY(64,SecondRow); + IF (Loggedon > 0) THEN + Write((Msgpost / Loggedon) * 100:3:0,'%') + ELSE + Write(0); + GoToXY(75,SecondRow); + Write(ThisNode); + END; + 4 : BEGIN + Assign(HistoryFile,General.DataPath+'HISTORY.DAT'); + Reset(HistoryFile); + IF (IOResult = 2) THEN + ReWrite(HistoryFile) + ELSE + BEGIN + Seek(HistoryFile,FileSize(HistoryFile) - 1); + Read(HistoryFile,History); + END; + Close(HistoryFile); + WITH History DO + BEGIN +{$IFDEF MSDOS} + Update_Logo(Win4,ScreenAddr[(FirstRow - 1) * 160],WIN4_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win4, 1, FirstRow, WIN4_LENGTH); +{$ENDIF} + GoToXY(20,FirstRow); + Write(Callers); + GoToXY(34,FirstRow); + Write(Email); + GoToXY(45,FirstRow); + Write(IntToStr(Downloads)+'/'+ConvertKB(DK,FALSE)); + GoToXY(72,FirstRow); + Write(NewUsers); + GoToXY(20,SecondRow); + Write(Posts); + GoToXY(34,SecondRow); + Write(Feedback); + GoToXY(45,SecondRow); + Write(IntToStr(Uploads)+'/'+ConvertKB(UK,FALSE)); + IF (Active > 9999) THEN + Active := 9999; + GoToXY(72,SecondRow); + Write(Active,' min'); + END; + END; + 5 : WITH History DO + BEGIN +{$IFDEF MSDOS} + Update_Logo(Win5,ScreenAddr[(FirstRow - 1) * 160],WIN5_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win5, 1, FirstRow, WIN5_LENGTH); +{$ENDIF} + GoToXY(20,FirstRow); + Write(General.CallerNum); + GoToXY(31,FirstRow); + Write(General.TotalDloads + Downloads); + GoToXY(45,FirstRow); + Write(General.DaysOnline + 1); + GoToXY(58,FirstRow); + Write(General.NumUsers); + GoToXY(74,FirstRow); + Write(ConvertKB(DiskKbFree(StartDir),FALSE)); + GoToXY(20,SecondRow); + Write(General.TotalPosts + Posts); + GoToXY(31,SecondRow); + Write(General.TotalUloads + Uploads); + GoToXY(45,SecondRow); + Write((General.TotalUsage + Active) DIV 60); + LoadURec(User,1); + GoToXY(58,SecondRow); + IF (User.Waiting > 0) THEN + TextAttr := 244; + Write(User.Waiting); + TextAttr := 120; + GoToXY(74,SecondRow); + CASE OverlayLocation OF + 0 : Write('Disk'); + 1 : Write('EMS'); + 2 : Write('XMS'); + END; + END; + 100 : + BEGIN + GoToXY((MaxDisplayCols - Length(Message)) DIV 2,FirstRow); + Write(Message); + LastScreenSwap := Timer; + END; + 99 : + BEGIN + GoToXY(1,FirstRow); + Write(Message); + IF (OneKey) THEN + Answer := UpCase(ReadKey) + ELSE + BEGIN + GoToXY(2,(FirstRow + 1)); + Write('> '); + Local_Input1(Answer,MaxDisplayCols - 4,FALSE); + END; + END; + END; + IF (General.IsTopWindow) THEN + Window(1,3,MaxDisplayCols,MaxDisplayRows) + ELSE + Window(1,1,MaxDisplayCols,MaxDisplayRows - 2); + CursorOn(TRUE); + IF (NOT SaveWindowOn) THEN + ToggleWindow(FALSE); + GoToXY(SaveWhereX,SaveWhereY); + TextAttr := SaveTextAttr; +END; + +PROCEDURE Update_Screen; +VAR + Answer: AStr; +BEGIN + lStatus_Screen(General.CurWindow,'',FALSE,Answer); +END; + +PROCEDURE SKey1(VAR C: Char); +VAR + S: AStr; + C1: Char; + SaveWhereX, + SaveWhereY, + SaveTextAttr: Byte; + RetCode, + i: Integer; + SaveTimer: LongInt; + SaveInChat: Boolean; +BEGIN + IF (General.NetworkMode AND (NOT CoSysOp OR InWFCMenu)) THEN + Exit; + SaveWhereX := WhereX; + SaveWhereY := WhereY; + SaveTextAttr := TextAttr; + CASE Ord(C) OF + 120..129 : + BEGIN {ALT-1 TO ALT-0} + GetDir(0,S); + ChDir(StartDir); + SaveScreen(Wind); + ClrScr; + SaveTimer := Timer; + i := (Ord(C) - 119); + IF (i = 10) THEN + i := 0; + ShellDOS(FALSE,'GLOBAT'+Chr(i + 48),RetCode); + Com_Flush_Recv; + FreeTime := ((FreeTime + Timer) - SaveTimer); + RemoveWindow(Wind); + GoToXY(SaveWhereX,SaveWhereY); + ChDir(S); + END; + 104..108 : + lStatus_Screen(((Ord(C) - 104) + 1),'',FALSE,S); { ALT F1-F5 } + 114 : RunError(255); { CTRL-PRTSC } + 36 : BEGIN + SaveScreen(Wind); + SysOpShell; { ALT-J } + RemoveWindow(Wind); + END; + 32 : BEGIN { ALT-D } + lStatus_Screen(99,'Dump screen to what file: ',FALSE,S); + IF (S <> '') THEN + ScreenDump(S); + Update_Screen; + END; + 59..68 : + Buf := General.Macro[Ord(C) - 59]; { F1 - F10 } + END; + IF (NOT InWFCMenu) THEN + BEGIN + CASE Ord(C) OF + 119 : BEGIN { CTRL-HOME } + SaveScreen(Wind); +{$IFDEF MSDOS} + Update_Logo(SYSKEY,ScreenAddr[0],SYSKEY_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(SYSKEY, 1, 1, SYSKEY_LENGTH); +{$ENDIF} + CursorOn(FALSE); + C := ReadKey; + IF (C = #0) THEN + C := ReadKey; + CursorOn(TRUE); + RemoveWindow(Wind); + GoToXY(SaveWhereX,SaveWhereY); + Update_Screen; + END; + 34 : BEGIN { ALT-G } + lStatus_Screen(99,'Log options - [T]rap activity [C]hat buffering',TRUE,S); + C1 := S[1]; + WITH ThisUser DO + CASE C1 OF + 'C' : BEGIN + lStatus_Screen(99,'Auto Chat buffering - [O]ff [S]eparate [M]ain (Chat.LOG)',TRUE,S); + C1 := S[1]; + IF (C1 IN ['O','S','M']) THEN + ChatFileLog(FALSE); + CASE C1 OF + 'O' : BEGIN + Exclude(ThisUser.SFlags,ChatAuto); + Exclude(ThisUser.SFlags,ChatSeparate); + END; + 'S' : BEGIN + Include(ThisUser.SFlags,ChatAuto); + Include(ThisUser.SFlags,ChatSeparate); + END; + 'M' : BEGIN + Include(ThisUser.SFlags,ChatAuto); + Exclude(ThisUser.SFlags,ChatSeparate); + END; + END; + IF (C1 IN ['S','M']) THEN + ChatFileLog(TRUE); + END; + 'T' : BEGIN + lStatus_Screen(99,'Activity Trapping - [O]ff [S]eperate [M]ain (TRAP.LOG)',TRUE,S); + C1 := S[1]; + IF (C1 IN ['O','S','M']) THEN + IF (Trapping) THEN + BEGIN + Close(TrapFile); + Trapping := FALSE; + END; + CASE C1 OF + 'O' : BEGIN + Exclude(ThisUser.SFlags,TrapActivity); + Exclude(ThisUser.SFlags,TrapSeparate); + END; + 'S' : BEGIN + Include(ThisUser.SFlags,TrapActivity); + Include(ThisUser.SFlags,TrapSeparate); + END; + 'M' : BEGIN + Include(ThisUser.SFlags,TrapActivity); + Exclude(ThisUser.SFlags,TrapSeparate); + END; + END; + IF (C1 IN ['S','M']) THEN + InitTrapFile; + END; + END; + Update_Screen; + END; + 20 : BEGIN { ALT-T } + IF (General.WindowOn) THEN + BiosScroll(General.IsTopWindow); + General.IsTopWindow := NOT General.IsTopWindow; + Update_Screen; + END; + 31 : IF (NOT InChat) THEN { ALT-S } { ALT-A } + SysOpSplitChat + ELSE + BEGIN + InChat := FALSE; + ChatReason := ''; + END; + + 47 : IF (UserOn) THEN + BEGIN { ALT-V } + S[1] := #0; + lStatus_Screen(99,'Enter the validation level (!-~) for this user.',TRUE,S); + IF (S[1] IN ['!'..'~']) THEN + BEGIN + AutoValidate(ThisUser,UserNum,S[1]); + lStatus_Screen(100,'This user has been validated.',FALSE,S); + END + ELSE + Update_Screen; + END; + 18 : IF (UserOn) THEN + BEGIN { ALT-E } + Wait(TRUE); + SaveScreen(Wind); + ChangeUserDataWindow; + RemoveWindow(Wind); + Update_Screen; + Wait(FALSE); + END; + 17 : IF (UserOn) THEN + BEGIN + SaveScreen(Wind); + ChangeUserDataWindow; { ALT-W } + RemoveWindow(Wind); + Update_Screen; + END; + 49 : IF (UserOn) THEN { ALT-N } + BEGIN + i := ((General.CurWindow MOD 5) + 1); + lStatus_Screen(i,'',FALSE,S); + END; + 23 : IF (ComPortSpeed > 0) AND (NOT Com_Carrier) THEN { ALT-I } + lStatus_Screen(100,'No carrier detected!',FALSE,S) + ELSE IF (ComPortSpeed > 0) THEN + BEGIN + IF (OutCom) THEN + IF (InCom) THEN + InCom := FALSE + ELSE IF (Com_Carrier) THEN + InCom := TRUE; + IF (InCom) THEN + lStatus_Screen(100,'User keyboard ON.',FALSE,S) + ELSE + lStatus_Screen(100,'User keyboard OFF.',FALSE,S); + Com_Flush_Recv; + END; + 16 : BEGIN { ALT-Q } + ChatCall := FALSE; + ChatReason := ''; + Exclude(ThisUser.Flags,Alert); + Update_Screen; + END; + 35 : HangUp := TRUE; { ALT-H } + 24 : BEGIN { ALT-O } + ConfSystem := (NOT ConfSystem); + IF (ConfSystem) THEN + lStatus_Screen(100,'The conference system has been turned ON.',FALSE,S) + ELSE + lStatus_Screen(100,'The conference system has been turned OFF.',FALSE,S); + NewCompTables; + END; + 130 : BEGIN { ALT-MINUS } + SaveInChat := InChat; + InChat := TRUE; + Dec(ThisUser.TLToday,5); + TLeft; + InChat := SaveInChat; + END; + 131 : BEGIN { ALT-PLUS } + SaveInChat := InChat; + InChat := TRUE; + Inc(ThisUser.TLToday,5); + TimeWarn := FALSE; + TLeft; + InChat := SaveInChat; + END; + 50 : IF (UserOn) THEN { ALT-M } + BEGIN + TempSysOp := NOT TempSysOp; + IF (TempSysOp) THEN + lStatus_Screen(100,'Temporary SysOp access granted.',FALSE,S) + ELSE + lStatus_Screen(100,'Normal access restored',FALSE,S); + NewCompTables; + END; + + 30 : ToggleWindow(TRUE); { ALT-A } + + 46 : IF (NOT InChat) THEN { ALT-C } + SysOpLineChat + ELSE + BEGIN + InChat := FALSE; + ChatReason := ''; + END; + + 72, { Arrow up } + 75, { Arrow left } + 77, { Arrow Right } + 80 : IF ((InChat) OR (Write_Msg)) THEN { Arrow Down } + BEGIN + IF (OKAvatar) THEN + Buf := Buf + ^V + ELSE + Buf := Buf + ^[+'['; + CASE Ord(C) OF + 72 : IF (OKAvatar) THEN + Buf := Buf + ^C + ELSE + Buf := Buf + 'A'; + 75 : IF (OKAvatar) THEN + Buf := Buf + ^E + ELSE + Buf := Buf + 'D'; + 77 : IF (OKAvatar) THEN + Buf := Buf + ^F + ELSE + Buf := Buf + 'C'; + 80 : IF (OKAvatar) THEN + Buf := Buf + ^D + ELSE + Buf := Buf + 'B'; + END; + END; + 22 : IF (ComPortSpeed > 0) AND (OutCom) THEN { ALT-U } + BEGIN + lStatus_Screen(100,'User screen and keyboard OFF',FALSE,S); + OutCom := FALSE; + InCom := FALSE; + END + ELSE IF (ComPortSpeed > 0) AND (Com_Carrier) THEN + BEGIN + lStatus_Screen(100,'User screen and keyboard ON',FALSE,S); + OutCom := TRUE; + InCom := TRUE; + END; + 37 : BEGIN { ALT-K } + lStatus_Screen(99,'Display what HangUp file (HANGUPxx) :',FALSE,S); + IF (S <> '') THEN + BEGIN + NL; + NL; + InCom := FALSE; + PrintF('HangUp'+S); + SysOpLog('Displayed HangUp file HangUp'+S); + HangUp := TRUE; + END; + Update_Screen; + END; + 48 : BEGIN { ALT-B } + BeepEnd := NOT BeepEnd; + lStatus_Screen(100,'SysOp next '+ShowOnOff(BeepEnd),FALSE,S); + SaveInChat := InChat; + InChat := TRUE; + TLeft; + InChat := SaveInChat; + END; + 38 : IF (WantOut) THEN { ALT-L } + BEGIN + TextColor(11); + TextBackGround(0); + Window(1,1,MaxDisplayCols,MaxDisplayRows); + ClrScr; + WantOut := FALSE; + CursorOn(FALSE); + END + ELSE + BEGIN + WantOut := TRUE; + CursorOn(TRUE); + WriteLn('Local display on.'); + Update_Screen; + END; + 44 : BEGIN { ALT-Z } + lStatus_Screen(100,'Waking up user ...',FALSE,S); + REPEAT + OutKey(^G); + Delay(500); +{$IFDEF MSDOS} + ASM + Int 28h + END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} + CheckHangUp; + UNTIL ((NOT Empty) OR (HangUp)); + Update_Screen; + END; + 19 : lStatus_Screen(100,'Chat request: '+ChatReason,FALSE,S);{ ALT-R } + 25 : BEGIN { ALT-P } + lStatus_Screen(99,'Print what file: ',FALSE,S); + IF (S <> '') THEN + BEGIN + NL; + NL; + PrintF(S); + SysOpLog('Displayed file '+S); + END; + Update_Screen; + END; + 33 : BEGIN { ALT-F } + Randomize; + S := ''; + FOR i := 1 TO Random(50) DO + BEGIN + C1 := Chr(Random(255)); + IF NOT (C1 IN [#3,'^','@']) THEN + S := S + C1; + END; + Prompt(S); + END; + END; + END; + { any processed keys no longer used should be here } + IF (Ord(C) IN [16..20,22..25,30,32..38,44,47..50,104..108,114,119..131]) THEN + C := #0; + TextAttr := SaveTextAttr; +END; + +PROCEDURE SaveGeneral(x: Boolean); +VAR + GeneralF: FILE OF GeneralRecordType; + SaveCurWindow: Byte; + SaveWindowOn, + SaveIsTopWindow: Boolean; +BEGIN + Assign(GeneralF,DatFilePath+'RENEGADE.DAT'); + Reset(GeneralF); + IF (x) THEN + BEGIN + SaveWindowOn := General.WindowOn; + SaveIsTopWindow := General.IsTopWindow; + SaveCurWindow := General.CurWindow; + Read(GeneralF,General); + General.WindowOn := SaveWindowOn; + General.IsTopWindow := SaveIsTopWindow; + General.CurWindow := SaveCurWindow; + Inc(General.CallerNum,TodayCallers); + TodayCallers := 0; + Inc(General.NumUsers,lTodayNumUsers); + lTodayNumUsers := 0; + Seek(GeneralF,0); + END; + Write(GeneralF,General); + Close(GeneralF); + LastError := IOResult; +END; + +PROCEDURE TLeft; +VAR + SaveWhereX, + SaveWhereY, + SaveCurrentColor: Integer; +BEGIN + IF (TimedOut) OR (TimeLock) THEN + Exit; + SaveCurrentColor := CurrentColor; + IF ((NSL <= 0) AND (ChopTime <> 0)) THEN + BEGIN + SysOpLog('Logged user off for system event'); + NL; + NL; + Print('^G^7Shutting down for System Event.'^G); + NL; + HangUp := TRUE; + END; + IF (NOT InChat) AND NOT (FNoCredits IN ThisUser.Flags) AND (General.CreditMinute > 0) AND (UserOn) AND (CreditTime > 0) AND + (AccountBalance > ((NSL DIV 60) + 1) * General.CreditMinute) AND (NOT HangUp) THEN + BEGIN + CreditTime := 0; + IF (AccountBalance < ((NSL DIV 60) + 1) * General.CreditMinute) THEN + Inc(CreditTime, NSL - (AccountBalance DIV General.CreditMinute) * 60); + END; + IF (NOT InChat) AND NOT (FNoCredits IN ThisUser.Flags) AND (General.CreditMinute > 0) AND (UserOn) AND + (AccountBalance < (NSL DIV 60) * General.CreditMinute) AND + (NOT InVisEdit) AND (NOT HangUp) THEN + BEGIN + Print(^M^J^G^G'^8Note: ^9Your online time has been adjusted due to insufficient account balance.'); + Inc(CreditTime, NSL - (AccountBalance DIV General.CreditMinute) * 60); + END; + IF (NOT TimeWarn) AND (NOT InChat) AND (NSL < 180) AND (UserOn) AND (NOT InVisEdit) AND (NOT HangUp) THEN + BEGIN + Print(^M^J^G^G'^8Warning: ^9You have less than '+IntToStr(NSL DIV 60 + 1)+' '+ + Plural('minute',NSL DIV 60 + 1)+' remaining online!'^M^J); + SetC(SaveCurrentColor); + TimeWarn := TRUE; + END; + IF (NOT InChat) AND (NSL <= 0) AND (UserOn) AND (NOT HangUp) THEN + BEGIN + NL; + TimedOut := TRUE; + PrintF('NOTLEFT'); + IF (NoFile) THEN + Print('^7You have used up all of your time.'); + NL; + HangUp := TRUE; + END; + CheckHangUp; + IF (WantOut) AND (General.WindowOn) AND (General.CurWindow = 1) AND (NOT InWFCMenu) AND NOT + (General.NetworkMode AND NOT CoSysOp) AND (LastScreenSwap = 0) THEN + BEGIN + TextAttr := 120; + SaveWhereX := WhereX; + SaveWhereY := WhereY; + Window(1,1,MaxDisplayCols,MaxDisplayRows); + IF (General.IsTopWindow) THEN + GoToXY(75, 1) + ELSE + GoToXY(75,(MaxDisplayRows - 1)); + Write(NSL DIV 60,' '); + IF (General.IsTopWindow) THEN + Window(1,3,MaxDisplayCols,MaxDisplayRows) + ELSE + Window(1,1,MaxDisplayCols,(MaxDisplayRows - 2)); + GoToXY(SaveWhereX,SaveWhereY); + TextAttr := SaveCurrentColor; + END; +END; + +PROCEDURE gp(i,j: Integer); +VAR + x: Byte; +BEGIN + CASE j OF + 0 : GoToXY(58,8); + 1 : GoToXY(20,7); + 2 : GoToXY(20,8); + 3 : GoToXY(20,9); + 4 : GoToXY(20,10); + 5 : GoToXY(36,7); + 6 : GoToXY(36,8); + END; + IF (j IN [1..4]) THEN + x := 5 + ELSE + x := 3; + IF (i = 2) THEN + Inc(x); + IF (i > 0) THEN + GoToXY((WhereX + x),WhereY); +END; + +PROCEDURE ChangeUserDataWindow; +VAR + S: STRING[39]; + C: Char; + SaveWhereX, + SaveWhereY, + SaveTextAttr: Byte; + oo, + i: Integer; + Changed, + Done, + Done1: Boolean; + + PROCEDURE Shd(i: Integer; b: Boolean); + VAR + C1: Char; + Counter: Byte; + BEGIN + gp(0,i); + IF (b) THEN + TextColor(14) + ELSE + TextColor(9); + CASE i OF + 1 : Write('SL :'); + 2 : Write('DSL :'); + 3 : Write('BL :'); + 4 : Write('Note:'); + 5 : Write('AR:'); + 6 : Write('AC:'); + END; + IF (b) THEN + BEGIN + TextColor(0); + TextBackGround(7); + END + ELSE + TextColor(14); + Write(' '); + WITH ThisUser DO + CASE i OF + 0 : IF (b) THEN + Write('횯one�') + ELSE + BEGIN + TextColor(9); + Write('�'); + TextColor(11); + Write('Done'); + TextColor(9); + Write('�'); + END; + 1 : Write(PadLeftInt(SL,3)); + 2 : Write(PadLeftInt(DSL,3)); + 3 : Write(PadLeftInt(AccountBalance,5)); + 4 : Write(PadLeftStr(Note,39)); + 5 : FOR C1 := 'A' TO 'Z' DO + BEGIN + IF (C1 IN AR) THEN + TextColor(4) + ELSE IF (b) THEN + TextColor(0) + ELSE + TextColor(7); + Write(C1); + END; + 6 : IF (b) THEN + CPR($07,$70) + ELSE + CPR($70,$07); + END; + Write(' '); + TextBackGround(0); + CursorOn(i IN [1..4]); + IF (b) THEN + BEGIN + GoToXY(26,12); + TextColor(14); + FOR Counter := 1 TO 41 DO + Write(' '); + GoToXY(26,12); + CASE i OF + 0 : Write('Done'); + 1 : Write('Security Level (0-255)'); + 2 : Write('Download Security Level (0-255)'); + 3 : Write('Account balance'); + 4 : Write('SysOp Note for this user'); + 5 : Write('Access flags ("!" to toggle all)'); + 6 : Write('Restrictions & special ("!" to clear)'); + END; + END; + END; + + PROCEDURE ddwind; + VAR + Counter: Byte; + BEGIN + CursorOn(FALSE); + TextColor(9); + Box(1,18,6,68,13); + Window(19,7,67,12); + ClrScr; + Box(1,18,6,68,11); + Window(19,7,67,10); + Window(1,1,MaxDisplayCols,MaxDisplayRows); + GoToXY(20,12); + TextColor(9); + Write('Desc:'); + FOR Counter := 0 TO 6 DO + Shd(Counter,FALSE); + Shd(oo,TRUE); + END; + +BEGIN + SaveURec(ThisUser,UserNum); + Infield_Out_Fgrd := 0; + Infield_Out_Bkgd := 7; + InField_Inp_Fgrd := 0; + InField_Inp_Bkgd := 7; + Infield_Arrow_Exit := TRUE; + Infield_Arrow_Exited := FALSE; + SaveWhereX := WhereX; + SaveWhereY := WhereY; + SaveTextAttr := TextAttr; + TextAttr := 7; + oo := 1; + ddwind; + Done := FALSE; + REPEAT + Infield_Arrow_Exited := FALSE; + CASE oo OF + 0 : BEGIN + Done1 := FALSE; + Shd(oo,TRUE); + REPEAT + C := ReadKey; + CASE UpCase(C) OF + ^M : BEGIN + Done := TRUE; + Done1 := TRUE; + END; + #0 : BEGIN + C := ReadKey; + CASE Ord(C) OF + 80,72 : {arrow down, up} + BEGIN + Infield_Arrow_Exited := TRUE; + Infield_Last_Arrow := Ord(C); + Done1 := TRUE; + END; + END; + END; + END; + UNTIL (Done1); + END; + 1 : BEGIN + S := IntToStr(ThisUser.SL); + InField1(26,7,S,3); + IF (StrToInt(S) <> ThisUser.SL) THEN + IF (StrToInt(S) >= 0) AND (StrToInt(S) <= 255) THEN + BEGIN + ThisUser.SL := StrToInt(S); + Inc(ThisUser.TLToday,General.TimeAllow[ThisUser.SL] - General.TimeAllow[ThisUser.SL]); + END; + END; + 2 : BEGIN + S := IntToStr(ThisUser.DSL); + InField1(26,8,S,3); + IF (StrToInt(S) <> ThisUser.DSL) THEN + IF (StrToInt(S) >= 0) AND (StrToInt(S) <= 255) THEN + ThisUser.DSL := StrToInt(S); + END; + 3 : BEGIN + S := IntToStr(AccountBalance); + InField1(26,9,S,5); + AdjustBalance(AccountBalance - StrToInt(S)); + END; + 4 : BEGIN + S := ThisUser.Note; + InField1(26,10,S,39); + ThisUser.Note := S; + END; + 5 : BEGIN + Done1 := FALSE; + REPEAT + C := UpCase(ReadKey); + CASE C OF + #13 : Done1 := TRUE; + #0 : BEGIN + C := ReadKey; + CASE Ord(C) OF + 80,72: {arrow down,up} + BEGIN + Infield_Arrow_Exited := TRUE; + Infield_Last_Arrow := Ord(C); + Done1 := TRUE; + END; + END; + END; + '!' : BEGIN + FOR C := 'A' TO 'Z' DO + ToggleARFlag(C,ThisUser.AR,Changed); + Shd(oo,TRUE); + END; + 'A'..'Z' : + BEGIN + ToggleARFlag(C,ThisUser.AR,Changed); + Shd(oo,TRUE); + END; + END; + UNTIL (Done1); + END; + 6 : BEGIN + S := 'LCVUA*PEKM1234'; + Done1 := FALSE; + REPEAT + C := UpCase(ReadKey); + IF (C = #13) THEN + Done1 := TRUE + ELSE IF (C = #0) THEN + BEGIN + C := ReadKey; + CASE Ord(C) OF + 80,72: {arrow down,up} + BEGIN + Infield_Arrow_Exited := TRUE; + Infield_Last_Arrow := Ord(C); + Done1 := TRUE; + END; + END; + END + ELSE IF (Pos(C,S) <> 0) THEN + BEGIN + ToggleACFlags(C,ThisUser.Flags,Changed); + Shd(oo,TRUE); + END + ELSE + BEGIN + IF (C = '!') THEN + FOR i := 1 TO Length(S) DO + ToggleACFlags(S[i],ThisUser.Flags,Changed); + Shd(oo,TRUE); + END; + UNTIL (Done1); + END; + END; + IF (NOT Infield_Arrow_Exited) THEN + BEGIN + Infield_Arrow_Exited := TRUE; + Infield_Last_Arrow := 80; {arrow down} + END; + IF (Infield_Arrow_Exited) THEN + CASE Infield_Last_Arrow OF + 80,72 : + BEGIN {arrow down,up} + Shd(oo,FALSE); + IF (Infield_Last_Arrow = 80) THEN + BEGIN {arrow down} + Inc(oo); + IF (oo > 6) THEN + oo := 0; + END + ELSE + BEGIN + Dec(oo); + IF (oo < 0) THEN + oo := 6; + END; + Shd(oo,TRUE); + END; + END; + UNTIL (Done); + GoToXY(SaveWhereX,SaveWhereY); + TextAttr := SaveTextAttr; + CursorOn(TRUE); + NewCompTables; + SaveURec(ThisUser,UserNum); +END; + +END. + diff --git a/SOURCE/COMMON3.PAS b/SOURCE/COMMON3.PAS new file mode 100644 index 0000000..e321e61 --- /dev/null +++ b/SOURCE/COMMON3.PAS @@ -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. diff --git a/SOURCE/COMMON4.PAS b/SOURCE/COMMON4.PAS new file mode 100644 index 0000000..71938cf --- /dev/null +++ b/SOURCE/COMMON4.PAS @@ -0,0 +1,1051 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} + +(* +AH = 01h Transmit character with wait +Parameters: +Entry: AL = Character +DX = Port number +Exit: AX = Port status (see function 03h) +AL contains the character to be sent. If there is room in the transmit +buffer the return will be immediate, otherwise it will wait until there +is room to store the character in the transmit buffer. On return, AX is +set as in a status request (see function 03h). + +AH = 04h Initialize driver +Parameters: +Entry: DX = port number +( BX = 4F50h +| ES:CX = ^C flag address --- optional ) +Exit: AX = 1954h if successful +| BL = maximum function number supported +| (not counting functions 7Eh and above) +| BH = rev of FOSSIL doc supported +This is used to tell the driver to begin operations, and to check that +the driver is installed. This function should be called before any other +communications calls are made. At this point all interrupts involved in +supporting the comm port (specified in DX) should be set up for handling +by the FOSSIL, then enabled. If BX contains 4F50h, then the address +specified in ES:CX is that of a ^C flag byte in the application program, +to be incremented when ^C is detected in the keyboard service routines. +This is an optional service and only need be supported on machines where +the keyboard service can't (or won't) perform an INT 1Bh or INT 23h when +| a Control-C is entered. DTR is raised by this call. The baud rate must +| NOT be changed by this call. +NOTE: Should an additional call to this service occur (2 Inits or Init, +Read,Init, etc.) the driver should reset all buffers, flow control, etc. +to the INIT state and return SUCCESS. + +AH = 07h Return timer tick parameters +Parameters: +Entry: None +Exit: AL = Timer tick interrupt number +AH = Ticks per second on interrupt number in AL +DX = Approximate number of milliseconds per tick +This is used to determine the parameters of the timer tick on any given +machine. Three numbers are returned: +AL = Timer tick interrupt number +AH = Ticks per second on interrupt number shown in AL +DX = Milliseconds per tick (approximate) +Applications can use this for critical timing (granularity of less than +one second) or to set up code (such as a watchdog) that is executed on +every timer tick. See function 16h (add/delete function from timer tick) +for the preferred way of actually installing such code. + +AH = 08h Flush output buffer +Parameters: +Entry: DX = Port number +Exit: None +This is used to force any pending output. It does not return until all +pending output has been sent. You should use this call with care. Flow +control (documented below) can make your system hang on this call in a +tight uninterruptible loop under the right circumstances. + +AH = 0Dh Keyboard read without wait +Parameters: +Entry: None +Exit: AX = IBM-style scan code (Character available) += FFFFh (Character not available) +Return in AX the next character (non-destructive read ahead) from the +keyboard; if nothing is currently in the keyboard buffer, return FFFFh in +AX. Use IBM-style function key mapping in the high order byte. Scan +codes for non-"function" keys are not specifically required, but may be +included. Function keys return 00h in AL and the "scan code" in AH. + +AH = 0Eh Keyboard read with wait +Parameters: +Entry: None +Exit: AX = IBM-style scan codeReturn in AX the next character from the keyboard; wait if no character +is available. Keyboard mapping should be the same as function 0Dh. + +AH = 0Fh Enable or disable flow control +Parameters: +Entry: AL = Bit mask describing requested flow control +DX = Port number +Exit: None +TRANSMIT flow control allows the "other end" to restrain the transmitter +when you are over-running it. RECEIVE flow control tells the FOSSIL to +attempt to DO just that if it is being overwhelmed. +Two kinds of basic flow control are supported: +Bit 0 = 1 Xon/Xoff on transmit +Bit 1 = 1 CTS/RTS (CTS on transmit, RTS on receive) +Bit 2 Reserved +| Bit 3 = 1 Xon/Xoff on Receive +Flow control is enabled, or disabled, by setting the appropriate bits in +AL for the types of flow control we want to ENABLE (value = 1), and/or +DISABLE (value = 0), and calling this function. Bit 2 is reserved for +DSR/DTR, but is not currently supported in any implementation. +Enabling transmit Xon/Xoff will cause the FOSSIL to stop transmitting +upon receiving an Xoff. The FOSSIL will resume transmitting when an Xon +is received. +Enabling CTS/RTS will cause the FOSSIL to cease transmitting when CTS is +lowered. Transmission will resume when CTS is raised. The FOSSIL will +drop RTS when the receive buffer reaches a predetermined percentage full +The FOSSIL will raise RTS when the receive buffer empties below the +predetermined percentage full. The point(s) at which this occurs is +left to the individual FOSSIL implementor. +| Enabling receive Xon/Xoff will cause the FOSSIL to send a Xoff when the +| receive buffer reaches a pre-determined percentage full. An Xon will be +| sent when the receive buffer empties below the pre-determined percentage +| full. The point(s) at which this occurs is left to the individual FOSSIL +| implementor. +Applications using this function should set all bits ON in the high +nibble of AL as well. There is a compatible (but not identical) FOSSIL +driver implementation that uses the high nibble as a control mask. If +your application sets the high nibble to all ones, it will always work, +regardless of the method used by any given driver. + +AH = 10h Extended Control-C / Control-K checking and transmit on/off +Parameters: +Entry: AL = Bit mask (see below) +DX = Port number +Exit: AX = 0001h - Control-C/K has been received += 0000h - Control-C/K has not been received +This is used for BBS operation, primarily. A bit mask is passed in AL +with the following flags: +Bit 0 Enable/disable Control-C / Control-K checking +Bit 1 Disable/enable the transmitter +The Enable (bit 0 = 1) and Disable (Bit 0 = 0) Control-C/Control-K check +function is meant primarily for BBS use. When the checking is enabled, a +Control-C or Control-K received from the communications port will set a +flag internal to the FOSSIL driver, but will not be stored in the input +buffer. The next use of this function will return the value of this flag +in register AX then clear the flag for the next occurrence. The returned +value is used by the BBS software to determine whether output should be +halted or not. +The Disable (Bit 1 = 1) and Enable (Bit 1 = 0) Transmitter function lets +the application restrain the asynchronous driver from output in much the +same way as XON/XOFF would. + +AH = 11h Set current cursor location. +Parameters: +Entry: DH = Row (line) +DL = Column +Exit: None +This function looks exactly like like INT 10h, subfunction 2, on the IBM +PC. The cursor location is passed in DX: row in DH and column in DL. The +function treats the screen as a coordinate system whose origin (0,0) is +the upper left hand corner of the screen. + +AH = 12h Read current cursor location. +Parameters: +Entry: None +Exit: DH = Row (line) +DL = Column +Looks exactly like INT 10h, subfunction 3, on the IBM PC. The current +cursor location (using the same coordinate system as function 16h) is +passed back in DX. + +AH = 13h Single character ANSI write to screen. +Parameters: +Entry: AL = Character to display +Exit: None +The character in AL is sent to the screen by the fastest method possible +that allows ANSI processing to occur (if available). This routine should +not be used in such a way that DOS output (which is not re-entrant) can +not be employed by some FOSSIL driver to perform the function (in fact, +on the IBM PC that is likely to be how it's done). On some systems such +as the DEC Rainbow this will be a very fast method of screen writing. + +AH = 14h Enable or disable watchdog processing +Parameters: +Entry: AL = 01h - Enable watchdog += 00h - Disable watchdog +DX = Port number +Exit: None +When watchdog is enabled, the state of the carrier detect (CD) line on +the comm port specified in DX should be constantly monitored. Should the +state of that line become FALSE (carrier lost), the system should be re- +booted, to enable the BBS (or other application) to start up again. This +monitor is not affected by Init/Uninit etc. + +AH = 15h Write character to screen using BIOS support routines +Parameters: +Entry: AL = Character to display +Exit: None +The character in AL is sent to the screen using BIOS-level Input/Output +routines. This differs from function 13h in that DOS I/O CAN NOT be used, +as this function might be called from driver level. + +AH = 16h Insert or delete a function from the timer tick chain +Parameter: +Entry: AL = 01h - Add a function += 00h - Delete a function +| ES = Segment of function +DX = Offset of function +Exit: AX = 0000h - Operation successful += FFFFh - Operation unsuccessful +This function is used to allow a central authority to manage the timer +interrupts, so that as code is loaded and unloaded, the integrity of the +"chain" is not compromised. Rather than using the traditional method of +saving the old contents of the timer vector, storing the address of your +routine there, and executing a far call to the "old" routine when yours +is done, instead you call this function. It manages a list of such entry +points and calls them on a timer tick (interrupt) using a FAR call. All +the usual cautions about making DOS calls apply (that is, DON'T!). +This makes it possible for a program to get in and out of the tick chain +without having to know whether another program has also done so since it +first insinuated itself. At least 4 entries should be available in the +driver's table (including one to be used by Watchdog if implemented that +way). + +AH = 17h Reboot system +Parameters: +Entry: AL = 00h - "Cold boot" += 01h - "Warm boot" +Perform the old 3-finger salute. Used in extreme emergency by code that +can't seem to find a "clean" way out of the trouble it has gotten itself +into. Hopefully it won't happen while you're computing something in the +other half of a DoubleDOS system. If your machine can make a distinction +between a "cold" (power-up, self-test and boot) and a "warm" (just boot) +bootstrap, your FOSSIL should support the flag in AL. Otherwise just DO +whatever bootstrap is possible. + +| AH = 18h Read block (transfer from FOSSIL to user buffer) +| Parameters: +| Entry: CX = Maximum number of characters to transfer +| DX = Port number +| ES = Segment of user buffer +| DI = Offset into ES of user buffer +| Exit: AX = Number of characters actually transferred +| A "no-wait" block read of 0 to FFFFh characters from the FOSSIL inbound +| ring buffer to the calling routine's buffer. ES:DI are left unchanged by +| the call; the count of bytes actually transferred will be returned in AX. + +| AH = 1Ah Break begin or end +| Parameters: +| Entry: AL = 01h - Start sending 'break' += 00h - Stop sending 'break' +| DX = port number +| Exit: None +| Send a break signal to the modem. If AL=01h the driver will commence the +| transmission of a break. If AL=00h the driver will end the break. This +| is useful for communications with devices that can only go into 'command +| mode' when a BREAK is received. Note: the application is responsible for +| the timing of the BREAK. Also, if the FOSSIL has been restrained by an +| Xoff received from the modem, the flag will be cleared. An Init or Un- +| Init will stop an in-progress BREAK. + +| AH = 1Bh Return information about the driver +| Parameters: +| Entry: CX = Size of user info buffer in bytes +| DX = Port number +| ES = Segment of user info buffer +| DI = Offset into ES of user info buffer +| Exit: AX = Number of bytes actually transferred +| Transfer information about the driver and its current status to the user +| for use in determining, at the application level, limits of the driver. +| Designed to assist "generic" applications to adjust to "foreign" gear. +| The data structure currently returned by the driver is as follows (sorry +| but you'll have to live with assembly syntax): +| info equ $ ; define begin of structure +| strsiz dw info_size ; size of the structure in bytes +| majver db curr_fossil ; FOSSIL spec driver conforms to +| minver db curr_rev ; rev level of this specific driver +| ident dd id_string ; "FAR" pointer to ASCII ID string +| ibufr dw ibsize ; size of the input buffer (bytes) +| ifree dw ? ; number of bytes left in buffer +| obufr dw obsize ; size of the output buffer (bytes) +| ofree dw ? ; number of bytes left in the buffer +| swidth db screen_width ; width of screen on this adapter +| sheight db screen_height ; height of screen " " +| baud db ? ; ACTUAL baud rate, computer to modem +| info_size equ $-info +| The ident string should be null-terminated, and NOT contain a newline. +| The baud rate byte contains the bits that Function 00h would use to set +| the port to that speed. +| The fields related to a particular port (buffer size, space left in the +| buffer, baud rate) will be undefined if port FFh or an invalid port is +| contained in DX.| Additional information will always be passed after these, so that, for +| example, offset "sheight" will never change with FOSSIL revision changes. + +| The functions below are not necessarily FOSSIL related. However, because +| dispatchers that support them are hooked on Interrupt 14H, it behooves +| the FOSSIL developer to support them as well to avoid fragmenting memory +| with several dispatchers. + +| AH = 7Eh Install an "external application" function +| Parameters: +| Entry: AL = Code assigned to external application +| DX = Offset of application entry point +| ES = Segment of application entry point +| Exit: AX = 1954h +| BL = Code assigned to application (same as input AL) +| BH = 01h - Installation was successful +| = 00h - Installation failed +| This call is used by external application code (special screen drivers, +| modem code, database code, etc) to link into the INT 14h service for use +| by multiple applications. The "error return" (BH=0 with AX=1954h) should +| mean that another application layer has already been installed at that +| particular code. Codes 80h through BFh should be supported. +| External application codes 80h-83h are reserved by FOSSIL developers for +| re-organizing FOSSIL services by type (comm, screen, keyboard, system). +| Installed application code will be entered, via a FAR call, from the INT +| 14H dispatcher whenever it is entered with AH=(application code). +| If the value returned in AX from this function is not 1954h, the service +| code that is trying to be installed should bring up its own INT 14h code +| that can service INT 14h functions 7h-BFh (80h-BFh are "applications"). + +| AH = 7Fh Remove an "external application" function +| Parameters: +| Entry: AL = Code assigned to external application +| DX = Offset of application entry point +| ES = Segment of application entry point +| Exit: AX = 1954h +| BL = Code assigned to application (same as input AL) +| BH = 01h - Removal was successful +| = 00h - Removal failed +| Removes an application's entry into the table. Usually so it can remove +| itself from memory. Error return means ES:DX did not match or that there +| is no entry at the slot described by AL. +| An application that wants to remove itself from memory can issue the 7F +| function to remove itself from the table, then, if it is successful, get +| out of memory. If it had to install itself with an INT 14h dispatcher it +| may back itself out, provided no other applications have been installed +| on top of it (using its dispatcher). +*) + +UNIT Common4; + +INTERFACE + +PROCEDURE Com_Flush_Recv; +PROCEDURE Com_Flush_Send; +PROCEDURE Com_Purge_Send; +FUNCTION Com_Carrier: Boolean; +FUNCTION Com_Recv: Char; +FUNCTION Com_IsRecv_Empty: Boolean; +FUNCTION Com_IsSend_Empty: Boolean; +PROCEDURE Com_Send(c: Char); +PROCEDURE Com_Set_Speed(Speed: LongInt); +PROCEDURE Com_DeInstall; +PROCEDURE Com_Install; +PROCEDURE CheckHangup; +PROCEDURE SerialOut(S: STRING); +FUNCTION Empty: Boolean; +PROCEDURE DTR(Status: Boolean); + +IMPLEMENTATION + +USES + Crt, + Common +{$IFDEF WIN32} + ,EleNorm +{$ENDIF} + ; + +{$IFDEF WIN32} +VAR + DidClose: Boolean = false; + DidInit: Boolean = false; +{$ENDIF} + +(* +AH = 0Ah Purge input buffer +Parameters: + Entry: DX = Port number + Exit: None +This is used to purge any pending input. Any input data which is still +in the buffer is discarded. +*) + +PROCEDURE Com_Flush_Recv; +BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN +{$IFDEF MSDOS} + ASM + Cmp InWfcMenu,1 + Je @TheEnd + Mov AH,0Ah + Mov DX,FossilPort + Int 14h + @TheEnd: + END; +{$ENDIF} +{$IFDEF WIN32} + if (InWfcMenu) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_PurgeInBuffer; // REENOTE Is this right? Function says flush not purge +{$ENDIF} + END + ELSE WHILE NOT (Com_IsRecv_Empty) DO + WriteWFC(CInKey); +END; + +PROCEDURE Com_Flush_Send; +VAR + SaveTimer: LongInt; +BEGIN + SaveTimer := (Timer + 5); + WHILE (SaveTimer > Timer) AND (OutCom AND Com_Carrier) AND (NOT Com_IsSend_Empty) DO; +END; + +(* +AH = 09h Purge output buffer +Parameters: + Entry: DX = Port number + Exit: None +This is used to purge any pending output. Any output data remaining in +the output buffer (not transmitted yet) is discarded. +*) + +PROCEDURE Com_Purge_Send; +BEGIN +{$IFDEF MSDOS} + ASM + Cmp LocalIOOnly,1 + Je @TheEnd + Mov AH,09h + Mov DX,FossilPort + Int 14h + @TheEnd: + END; +{$ENDIF} +{$IFDEF WIN32} + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_PurgeOutBuffer; +{$ENDIF} +END; + +(* +AH = 03h Request status +Parameters: + Entry: DX = Port number + Exit: AX = Status bit mask (see below) +Returns with the line and modem status in AX. Status bits returned are: +In AH: +Bit 0 = RDA - input data is available in buffer +Bit 1 = OVRN - the input buffer has been overrun. All characters received + after the buffer is full should be discarded. +Bit 5 = THRE - room is available in output buffer +Bit 6 = TSRE - output buffer is empty +In AL: +Bit 3 = Always 1 (always return with this bit set to 1) +Bit 7 = DCD - carrier detect +This can be used by the application to determine whether carrier detect +(CD) is set, signifying the presence/absence of a remote connection, as +well as monitoring both the input and output buffer status. Bit 3 of AL +is always returned set to enable programs to use it as a carrier detect +bit on hardwired (null modem) links. +*) + +FUNCTION Com_Carrier: Boolean; +VAR + Dummy: Byte; +BEGIN + Dummy := 0; (* New *) +{$IFDEF MSDOS} + ASM + Cmp LocalIOOnly,1 + Je @TheEnd + Mov AH,03h + Mov DX,FossilPort + Int 14h + Mov Dummy,AL + @TheEnd: + END; + Com_Carrier := (Dummy AND $80) = $80; +{$ENDIF} +{$IFDEF WIN32} + Com_Carrier := false; + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + Com_Carrier := EleNorm.Com_Carrier; +{$ENDIF} +END; + +(* +AH = 0Ch Non-destructive read-ahead +Parameters: + Entry: DX = Port number + Exit: AH = 00h - Character is +AL = Next character available +AX = FFFFh - Character is not available +Return in AL the next character in the receive buffer. If the receive +buffer is empty, return FFFFh. The character returned remains in +the receive buffer. Some applications call this "peek". + +AH = 02h Receive character with wait +Parameters: + Entry: DX = Port number + Exit: AH = 00h +AL = Input character +If there is a character available in the receive buffer, returns with +the next character in AL. It will wait until a character is received if +none is available. +*) + +FUNCTION Com_Recv: Char; +CONST + NotAvil = $FFFF; +VAR + Dummy: Byte; + T_RecvChar: Boolean; +{$IFDEF WIN32} + Ch: Char; +{$ENDIF} +BEGIN + Com_Recv := #0; + T_RecvChar := FALSE; +{$IFDEF MSDOS} + ASM + Cmp LocalIOOnly,1 + Je @TheEnd + Mov AH,0ch + Mov DX,FossilPort + Int 14h + Cmp AX,NotAvil + Je @TheEnd + Mov AH,02h + Mov DX,FossilPort + Int 14h + Mov Dummy,AL + Mov T_RecvChar,1 + @TheEnd: + END; + IF (T_RecvChar) THEN + Com_Recv := Char(Dummy); +{$ENDIF} +{$IFDEF WIN32} + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + if Not(EleNorm.Com_CharAvail) then Exit; + + // Get character from buffer + Ch := EleNorm.Com_GetChar; + if (Ch = #10) then + begin + // Translate bare LF to CR + Com_Recv := #13; + end else + begin + Com_Recv := Ch; + end; + + // If this char is CR, check if the next char is LF (so we can discard it) + if (Ch = #13) and (EleNorm.Com_CharAvail) then + begin + Ch := EleNorm.Com_PeekChar; + if (Ch = #10) then EleNorm.Com_GetChar; // Discard that LF + end; +{$ENDIF} +END; + +(* +AH = 03h Request status +Parameters: + Entry: DX = Port number + Exit: AX = Status bit mask (see below) +Returns with the line and modem status in AX. Status bits returned are: +In AH: +Bit 0 = RDA - input data is available in buffer +Bit 1 = OVRN - the input buffer has been overrun. All characters received + after the buffer is full should be discarded. +Bit 5 = THRE - room is available in output buffer +Bit 6 = TSRE - output buffer is empty +In AL: +Bit 3 = Always 1 (always return with this bit set to 1) +Bit 7 = DCD - carrier detect +This can be used by the application to determine whether carrier detect +(CD) is set, signifying the presence/absence of a remote connection, as +well as monitoring both the input and output buffer status. Bit 3 of AL +is always returned set to enable programs to use it as a carrier detect +bit on hardwired (null modem) links. +*) + +FUNCTION Com_IsRecv_Empty: Boolean; +VAR + Dummy: Byte; +BEGIN + Dummy := 0; (* New *) +{$IFDEF MSDOS} + ASM + Cmp LocalIOOnly,1 + Je @TheEnd + Mov AH,03h + Mov DX,FossilPort + Int 14h + Mov Dummy,AH + @TheEnd: + END; + Com_IsRecv_Empty := NOT ((Dummy AND $01) = $01); +{$ENDIF} +{$IFDEF WIN32} + Com_IsRecv_Empty := true; + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + Com_IsRecv_Empty := Not(EleNorm.Com_CharAvail); +{$ENDIF} +END; + +(* +AH = 03h Request status +Parameters: + Entry: DX = Port number + Exit: AX = Status bit mask (see below) +Returns with the line and modem status in AX. Status bits returned are: +In AH: +Bit 0 = RDA - input data is available in buffer +Bit 1 = OVRN - the input buffer has been overrun. All characters received + after the buffer is full should be discarded. +Bit 5 = THRE - room is available in output buffer +Bit 6 = TSRE - output buffer is empty +In AL: +Bit 3 = Always 1 (always return with this bit set to 1) +Bit 7 = DCD - carrier detect +This can be used by the application to determine whether carrier detect +(CD) is set, signifying the presence/absence of a remote connection, as +well as monitoring both the input and output buffer status. Bit 3 of AL +is always returned set to enable programs to use it as a carrier detect +bit on hardwired (null modem) links. +*) + +FUNCTION Com_IsSend_Empty: Boolean; +VAR + Dummy: Byte; +{$IFDEF WIN32} + InFree, OutFree, InUsed, OutUsed: LongInt; +{$ENDIF} +BEGIN + Dummy := 0; (* New *) +{$IFDEF MSDOS} + ASM + Cmp LocalIOOnly,1 + Je @TheEnd + Mov AH,03h + Mov DX,FossilPort + Int 14h + Mov Dummy,AH + @TheEnd: + END; + Com_IsSend_Empty := ((Dummy AND $40) = $40); +{$ENDIF} +{$IFDEF WIN32} + Com_IsSend_Empty := false; + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed); + Com_IsSend_Empty := (OutUsed = 0); +{$ENDIF} +END; + +(* +AH = 0Bh Transmit no wait +Parameters: + Entry: DX = Port number + Exit: AX = 0001h - Character was accepted + = 0000h - Character was not accepted +This is exactly the same as the "regular" transmit call, except that if +the driver is unable to buffer the character (the buffer is full), a +value of 0000h is returned in AX. If the driver accepts the character +(room is available), 0001h is returned in AX. +*) + +PROCEDURE Com_Send(C: Char); +BEGIN +{$IFDEF MSDOS} + ASM + Cmp LocalIOOnly,1 + Je @TheEnd + Mov AH,0Bh + Mov DX,FossilPort + Mov AL,C (* Should this be Byte(C) *) + Int 14h + @TheEnd: + END; +{$ENDIF} +{$IFDEF WIN32} + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_SendChar(C); +{$ENDIF} +END; + +(* +AH = 00h Set baud rate +Parameters: + Entry: AL = Baud rate code + DX = Port number + Exit: AX = Port status (see function 03h) This works the same as + the equivalent IBM PC BIOS call, except that it ONLY + selects a baud rate. This is passed in the high order + 3 bits of AL as follows: + 010 = 300 baud + 011 = 600 '' + 100 = 1200 '' + 101 = 2400 '' + 110 = 4800 '' + 111 = 9600 '' + 000 = 19200 '' (Replaces old 110 baud mask) + 001 = 38400 '' (Replaces old 150 baud mask) +The low order 5 bits can be implemented or not by the FOSSIL, but in all +cases, if the low order bits of AL are 00011, the result should be that +the communications device should be set to eight data bits, one stop bit +and no parity. This setting is a MINIMUM REQUIREMENT of Fido, Opus and +SEAdog. For purposes of completeness, here are the IBM PC "compatible" +bit settings: + +Bits 4-3 define parity: 0 0 no parity +1 0 no parity +0 1 odd parity +1 1 even parity +Bit 2 defines stop bits: 0 1 stop bit; +1 1.5 bits for 5-bit char; +2 for othersBits 1-0 character length: 0 0 5 bits +0 1 6 bits +1 0 7 bits +1 1 8 bits +*) +(* + If n > 76800 then {115200 } + regs.al:=regs.al or $80 + else + If n > 57600 then { 76800 } + regs.al:=regs.al or $60 + else + case w of + 300 : regs.al:=regs.al or $40; + 600 : regs.al:=regs.al or $60; + 1200 : regs.al:=regs.al or $80; + 2400 : regs.al:=regs.al or $A0; + 4800 : regs.al:=regs.al or $C0; + 9600 : regs.al:=regs.al or $E0; + 9601..19200: regs.al:=regs.al or $00; + 19201..38400: regs.al:=regs.al or $20; + 38401..57600: regs.al:=regs.al or $40; + end; +*) + +PROCEDURE Com_Set_Speed(Speed: LongInt); +VAR + T_AL: Byte; +BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN + CASE Speed OF + 300 : T_AL := 64; + 600 : T_AL := 96; + 1200 : T_AL := 128; + 2400 : T_AL := 160; + 4800 : T_AL := 192; + 9600 : T_AL := 224; + 19200 : T_AL := 0; + ELSE + T_AL := 32; + END; + Inc(T_AL,3); +{$IFDEF MSDOS} + ASM + Mov AH,00h + Mov AL,T_AL + Mov DX,FossilPort + Int 14h + END; +{$ENDIF} +{$IFDEF WIN32} + // REENOTE Telnet can't set speed +{$ENDIF} + END; +END; + +(* +AH = 05h Deinitialize driver +Parameters: + Entry: DX = Port number + Exit: None +This is used to tell the driver that comm port operations are ended. The +function should be called when no more comm port functions will be used +on the port specified in DX. DTR is NOT affected by this call. +*) + +PROCEDURE Com_DeInstall; +BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN +{$IFDEF MSDOS} + ASM + Mov AH,05h + Mov DX,FossilPort + Int 14h + END; +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if Not(DidClose) then + begin + EleNorm.Com_Close; + DidClose := true; + end; + EleNorm.Com_ShutDown; +{$ENDIF} + END; +END; + +PROCEDURE Com_Install; + +{$IFDEF MSDOS} + FUNCTION DriverInstalled: Word; ASSEMBLER; + ASM + Mov AH,5 + Mov DX,FossilPort + PushF + Call Interrupt14 + Mov AH,4 + PushF + Call Interrupt14 + END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION DriverInstalled: Word; + BEGIN + // REENOTE Never gets called in Win32 + END; +{$ENDIF} + +BEGIN + FossilPort := (Liner.Comport - 1); + IF (LocalIOOnly) THEN + Exit; +{$IFDEF MSDOS} + IF (DriverInstalled <> $1954) THEN + BEGIN + ClrScr; + WriteLn('Renegade requires a FOSSIL driver.'); + Halt; + END + ELSE + ASM + Xor AL,AL + Mov BL,Liner.MFlags + And BL,00000100b + Jz @Label1 + Mov AL,2 + @Label1: + And BL,00000010b + Jz @Label2 + Add AL,9 + @Label2: + Mov DX,FossilPort + Mov AH,$F + PushF + Call Interrupt14 + END; +{$ENDIF} +{$IFDEF WIN32} + if (DidInit) then Exit; + if (DidClose) then Exit; + DidInit := true; + EleNorm.Com_StartUp(2); + EleNorm.Com_SetDontClose(false); + EleNorm.Com_OpenQuick(answerbaud); // REENOTE Should come up with a better solution, this works for now though +{$ENDIF} + Com_Set_Speed(Liner.InitBaud); +END; + +{$IFDEF MSDOS} +PROCEDURE CheckHangup; ASSEMBLER; +ASM + Cmp LocalIOOnly,1 + Je @GetOut + Cmp OutCom,1 (* Should this be 0 *) + Jne @GetOut + Mov DX,FossilPort + Mov AH,3 + PushF + Call Interrupt14 + And AL,10000000b {test} + Jnz @GetOut + Mov HangUp,1 + @GetOut: +END; +{$ENDIF} +{$IFDEF WIN32} +PROCEDURE CheckHangup; +BEGIN + if (LocalIOOnly) then Exit; + if Not(OutCom) then Exit; + + if Not(Com_Carrier) then + begin + HangUp := true; + HungUp := true; + end; +END; +{$ENDIF} + +(* +AH = 19h Write block (transfer from user buffer to FOSSIL) +Parameters: + Entry: CX = Maximum number of characters to transfer + DX = Port number + ES = Segment of user buffer + DI = Offset into ES of user buffer + Exit: AX = Number of characters actually transferred + A "no-wait" block move of 0 to FFFFh characters from the calling + program's buffer into the FOSSIL outbound ring buffer. ES:DI are left + unchanged by the call; the count of bytes actually transferred will be + returned in AX. +*) + +PROCEDURE SerialOut(S: STRING); +VAR + T_DI, + T_CX, + T_ES, + T_AX: Word; +BEGIN + IF (OutCom) THEN + BEGIN +{$IFDEF MSDOS} + REPEAT + T_DI := OFS(S[1]); + T_CX := Length(S); + T_ES := Seg(S[1]); + ASM + Mov AH,19h + Mov DI,T_DI + Mov CX,T_CX + Mov DX,FossilPort + Mov ES,T_ES + Int 14h + Mov T_AX,AX + END; + Move(S[T_AX + 1],S[1],Length(S) - T_AX); + Dec(S[0],T_AX); + UNTIL (S = ''); +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_SendString(S); +{$ENDIF} + END; +END; + +(* +AH = 03h Request status +Parameters: + Entry: DX = Port number + Exit: AX = Status bit mask (see below) +Returns with the line and modem status in AX. Status bits returned are: +In AH: +Bit 0 = RDA - input data is available in buffer +Bit 1 = OVRN - the input buffer has been overrun. All characters received + after the buffer is full should be discarded. +Bit 5 = THRE - room is available in output buffer +Bit 6 = TSRE - output buffer is empty +In AL: +Bit 3 = Always 1 (always return with this bit set to 1) +Bit 7 = DCD - carrier detect +This can be used by the application to determine whether carrier detect +(CD) is set, signifying the presence/absence of a remote connection, as +well as monitoring both the input and output buffer status. Bit 3 of AL +is always returned set to enable programs to use it as a carrier detect +bit on hardwired (null modem) links. +*) + +FUNCTION Empty: Boolean; +VAR + T_AH: Byte; +BEGIN + Empty := NOT KeyPressed; + IF (InCom) AND (NOT KeyPressed) THEN + BEGIN +{$IFDEF MSDOS} + ASM + Mov DX,FossilPort + Mov AH,03h + Int 14h + Mov T_AH,AH + END; + Empty := NOT (T_AH AND 1 = 1); +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + Empty := Not(EleNorm.Com_CharAvail); +{$ENDIF} + END; +END; + +(* +AH = 06h Raise/lower DTR +Parameters: + Entry: DX = Port number + AL = DTR state to be set (01h = Raise, 00h = Lower) + Exit: None +This function is used to control the DTR line to the modem. AL = 00h means +lower DTR (disable the modem), and AL = 01h means to raise DTR (enable the +modem). No other function (except Init) should alter DTR. +*) + +PROCEDURE DTR(Status: Boolean); +VAR + T_AL: Byte; +BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN + T_AL := Byte(Status); +{$IFDEF MSDOS} + ASM + Mov AH,06h + Mov DX,FossilPort + Mov AL,T_AL + Int 14h + END; +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + if Not(Status) then + begin + EleNorm.Com_Close; + DidClose := true; + end; +{$ENDIF} + END; +END; + +END. diff --git a/SOURCE/COMMON5.PAS b/SOURCE/COMMON5.PAS new file mode 100644 index 0000000..76af9f8 --- /dev/null +++ b/SOURCE/COMMON5.PAS @@ -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. + diff --git a/SOURCE/CUSER.PAS b/SOURCE/CUSER.PAS new file mode 100644 index 0000000..7169ffc --- /dev/null +++ b/SOURCE/CUSER.PAS @@ -0,0 +1,1029 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT CUser; + +INTERFACE + +USES + Common; + +PROCEDURE CStuff(Which,How: Byte; VAR User: UserRecordType); + +IMPLEMENTATION + +USES + Dos, + Archive1, + TimeFunc, + MiscUser; + +VAR + CallFromArea: Integer; + +PROCEDURE CStuff(Which,How: Byte; VAR User: UserRecordType); +VAR + Try: Byte; + Done, + Done1: Boolean; + + PROCEDURE FindArea; + VAR + Cmd: Char; + BEGIN + Print('Are you calling from:'); + NL; + Print('(1) United States'); + Print('(2) Canada'); + Print('(3) Other country'); + NL; + Prt('Select (1-3): '); + OneK(Cmd,'123',TRUE,TRUE); + CallFromArea := (Ord(Cmd) - 48); + Done1 := TRUE; + END; + + PROCEDURE ConfigureQWK; + VAR + ArcExt: Str3; + AType: Byte; + BEGIN + IF (User.DefArcType < 1) OR (User.DefArcType > MaxArcs) THEN + User.DefArcType := 1; + Print('Current archive type: ^5'+General.FileArcInfo[User.DefArcType].Ext); + NL; + REPEAT + Prt('Archive type to use? (?=List): '); + MPL(3); + Input(ArcExt,3); + IF (ArcExt = '?') THEN + BEGIN + NL; + ListArcTypes; + NL; + END; + UNTIL (ArcExt <> '?') OR (HangUp); + IF (StrToInt(ArcExt) <> 0) THEN + AType := StrToInt(ArcExt) + ELSE + AType := ArcType('F.'+ArcExt); + IF (AType > 0) AND (AType < MaxArcs) THEN + User.DefArcType := AType; + Done1 := TRUE; + NL; + User.GetOwnQWK := PYNQ('Do you want your own replies in your QWK packet? ',0,FALSE); + NL; + User.ScanFilesQWK := PYNQ('Would you like a new files listing in your QWK packet? ',0,FALSE); + NL; + User.PrivateQWK := PYNQ('Do you want your private mail in your QWK packet? ',0,FALSE); + NL; + END; + + PROCEDURE DoAddress; + VAR + TempStreet: Str30; + BEGIN + Print('Enter your street address:'); + Prt(': '); + MPL((SizeOf(User.Street) - 1)); + IF (How = 3) THEN + InputL(TempStreet,(SizeOf(User.Street) - 1)) + ELSE + InputCaps(TempStreet,(SizeOf(User.Street) - 1)); + IF (TempStreet <> '') THEN + BEGIN + IF (How = 2) THEN + SysOpLog('Changed address from '+User.Street+' to '+TempStreet); + User.Street := TempStreet; + Done1 := TRUE; + END; + END; + + PROCEDURE DoAge; + VAR + TempDate: Str10; + TempDay, + TempMonth, + TempYear, + CurYear: Word; + Redo: Boolean; + BEGIN + GetYear(CurYear); + IF (How = 1) AND (IEMSIRec.BDate <> '') THEN + BEGIN + Buf := IEMSIRec.BDate; + IEMSIRec.BDate := ''; + END; + REPEAT + Redo := False; + Print('Enter your date of birth (mm/dd/yyyy):'); + Prt(': '); + InputFormatted('',TempDate,'##/##/####',(How = 3)); + IF (TempDate <> '') THEN + BEGIN + TempMonth := StrToInt(Copy(TempDate,1,2)); + TempDay := StrToInt(Copy(TempDate,4,2)); + TempYear := StrToInt(Copy(TempDate,7,4)); + IF (TempMonth = 0) OR (TempDay = 0) OR (TempYear = 0) THEN + ReDo := TRUE; + IF (TempMonth > 12) THEN + Redo := TRUE; + IF (TempMonth IN [1,3,5,7,8,10,12]) AND (TempDay > 31) THEN + Redo := TRUE; + IF (TempMonth IN [4,6,9,11]) AND (TempDay > 30) THEN + Redo := TRUE; + IF (TempMonth = 2) AND ((TempYear MOD 4) <> 0) AND (TempDay > 28) THEN + Redo := TRUE; + IF (TempMonth = 2) AND ((TempYear MOD 4) = 0) AND (TempDay > 29) THEN + Redo := TRUE; + IF (TempYear >= CurYear) THEN + Redo := TRUE; + IF (TempYear < (CurYear - 100)) THEN + Redo := TRUE; + IF (Redo) THEN + BEGIN + NL; + Print('^7You entered an invalid date of birth!^1'); + NL; + END; + END; + UNTIL (NOT Redo) OR (HangUp); + IF (TempDate <> '') THEN + BEGIN + IF (How = 2) THEN + SysOpLog('Changed birthdate from '+PD2Date(User.BirthDate)+' to '+TempDate); + User.BirthDate := Date2PD(TempDate); + END; + Done1 := TRUE; + END; + + PROCEDURE DoCityState; + VAR + s, + s1, + s2: AStr; + BEGIN + CASE How OF + 2 : FindArea; + 3 : CallFromArea := 1; + END; + IF (CallFromArea <> 3) THEN + BEGIN + IF (How = 3) THEN + BEGIN + Print('Enter new city & state abbreviation:'); + Prt(': '); + MPL((SizeOf(User.CityState) - 1)); + InputL(s,(SizeOf(User.CityState) - 1)); + IF (s <> '') THEN + User.CityState := s; + Done1 := TRUE; + Exit; + END; + + Print('Enter only your city:'); + Prt(': '); + MPL(((SizeOf(User.CityState) - 1) - 4)); + InputCaps(s,((SizeOf(User.CityState) - 1) - 4)); + IF (Pos(',',s) <> 0) THEN + BEGIN + NL; + Print('^7Enter only your city name.^1'); + Exit; + END; + NL; + IF (Length(s) < 3) THEN + Exit; + Prompt('Enter your '+AOnOff((CallFromArea = 1),'state','province')+' abbreviation: '); + MPL(2); + Input(s1,2); + User.CityState := s+', '+s1; + Done1 := TRUE; + END + ELSE + BEGIN + Print('First enter your city name only:'); + Prt(': '); + MPL(26); + InputCaps(s1,26); + IF (Length(s1) < 2) THEN + Exit; + NL; + Print('Now enter your country name:'); + Prt(': '); + MPL(26); + InputCaps(s2,26); + IF (Length(s2) < 2) THEN + Exit; + s := s1+', '+s2; + IF (Length(s) > 30) THEN + BEGIN + Print('^7Max total Length is 30 characters!^1'); + Exit; + END; + IF (How = 2) AND (User.CityState <> s) THEN + SysOpLog('Changed city/state from '+User.CityState+' to '+s); + User.CityState := s; + Done1 := TRUE; + END; + END; + + PROCEDURE DoUserDef(QuestionNum: Byte); + VAR + UserDefQues: STRING[80]; + s: Str35; + BEGIN + CASE QuestionNum OF + 1 : UserDefQues := lRGLngStr(38,TRUE); {'Is ALL of your information REAL & CORRECT? (Yes/No)'} + 2 : UserDefQues := lRGLngStr(39,TRUE); {'Do you run a Telnet BBS? (If so, type in address below)'} + 3 : UserDefQues := lRGLngStr(40,TRUE); {'What BBS or Web Site did you hear about this BBS? (Specific Please)'} + END; + IF (UserDefQues = '') THEN + BEGIN + User.UsrDefStr[QuestionNum] := ''; + Done1 := TRUE; + Exit; + END; + Print(UserDefQues); + Prt(': '); + MPL((SizeOf(User.UsrDefStr[QuestionNum]) - 1)); + InputL(s,(SizeOf(User.UsrDefStr[QuestionNum]) - 1)); + IF (s <> '') THEN + BEGIN + User.UsrDefStr[QuestionNum] := s; + Done1 := TRUE; + END; + END; + + PROCEDURE DoName; + VAR + TextFile: Text; + s, + s1, + s2: AStr; + UNum: Integer; + BEGIN + IF (How = 1) THEN + IF (General.AllowAlias) AND (IEMSIRec.Handle <> '') THEN + BEGIN + Buf := IEMSIRec.Handle; + IEMSIRec.Handle := ''; + END + ELSE IF (IEMSIRec.UserName <> '') THEN + BEGIN + Buf := IEMSIRec.UserName; + IEMSIRec.UserName := ''; + END; + IF (General.AllowAlias) THEN + BEGIN + Print('Enter your handle, or your real first & last'); + Print('names if you don''t want to use one.') + END + ELSE + BEGIN + Print('Enter your first & last Name.'); + Print('Handles are not allowed.'); + END; + Prt(': '); + MPL((SizeOf(User.Name) - 1)); + Input(s,(SizeOf(User.Name) -1)); + Done1 := FALSE; + WHILE (s[1] IN [' ','0'..'9']) AND (Length(s) > 0) do + Delete(s,1,1); + WHILE (s[Length(s)] = ' ') do + Dec(s[0]); + IF ((Pos(' ',s) = 0) AND (How <> 3) AND NOT (General.AllowAlias)) THEN + BEGIN + NL; + Print('Enter your first and last Name!'); + s := ''; + END; + IF (s <> '') THEN + BEGIN + Done1 := TRUE; + UNum := SearchUser(s,TRUE); + IF (UNum > 0) AND (UNum <> UserNum) THEN + BEGIN + Done1 := FALSE; + NL; + Print('^7That name is in use.^1'); + END; + END; + Assign(TextFile,General.MiscPath+'TRASHCAN.TXT'); + Reset(TextFile); + IF (IOResult = 0) THEN + BEGIN + s2 := ' '+s+' '; + WHILE NOT EOF(TextFile) do + BEGIN + ReadLn(TextFile,s1); + IF (s1[Length(s1)] = #1) THEN + s1[Length(s1)] := ' ' + ELSE + s1 := s1 + ' '; + s1 := ' ' + s1; + S1 := AllCaps(S1); + IF (Pos(s1,s2) <> 0) THEN + Done1 := FALSE; + END; + Close(TextFile); + LastError := IOResult; + END; + IF (NOT Done1) AND (NOT HangUp) THEN + BEGIN + NL; + Print(^G'^7Sorry, can''t use that name.^1'); + Inc(Try); + sl1('Unacceptable Name : '+s); + END; + IF (Try >= 3) AND (How = 1) THEN + HangUp := TRUE; + + IF ((Done) AND (How = 1) AND (NOT General.AllowAlias)) THEN + User.RealName := Caps(s); + + IF (Done1) THEN + BEGIN + IF (How = 2) AND (UserNum > -1) THEN { Don't do index on unregged users! } + BEGIN + SysOpLog('Changed name from '+User.Name+' to '+s); + InsertIndex(User.Name,UserNum,FALSE,TRUE); + User.Name := s; + InsertIndex(User.Name,UserNum,FALSE,FALSE); + END + ELSE + User.Name := s; + END; + END; + + PROCEDURE DoPhone; + VAR + TempPhone: AStr; + BEGIN + CASE How OF + 1 : BEGIN + IF (IEMSIRec.Ph <> '') THEN + BEGIN + Buf := IEMSIRec.Ph; + IEMSIRec.Ph := ''; + END; + END; + 2 : FindArea; + 3 : CallFromArea := 1; + END; + Print('Enter your phone number:'); + Prt(': '); + IF (((How = 1) AND (CallFromArea = 3)) OR (How = 3)) THEN + BEGIN + MPL(12); + Input(TempPhone,12); + IF (Length(TempPhone) > 5) THEN + BEGIN + User.Ph := TempPhone; + Done1 := TRUE; + END; + END + ELSE + BEGIN + InputFormatted('',TempPhone,'(###)###-####',FALSE); + TempPhone[5] := '-'; + TempPhone := Copy(TempPhone,2,(Length(TempPhone) - 1)); + IF (How = 2) AND (User.Ph <> TempPhone) THEN + SysOpLog('Changed phone from '+User.Ph+' to '+TempPhone); + User.Ph := TempPhone; + Done1 := TRUE; + END; + END; + + PROCEDURE DoPW; + VAR + s, + s2: STRING[20]; + SavePW: LongInt; + BEGIN + IF (How = 1) AND (IEMSIRec.PW <> '') THEN + BEGIN + Buf := IEMSIRec.PW; + IEMSIRec.PW := ''; + END; + SavePW := User.PW; + IF (How = 2) THEN + BEGIN + Print('^5Enter your current password:'); + NL; + Prompt('Password: ^5'); + GetPassword(s,20); + IF (CRC32(s) <> User.PW) THEN + BEGIN + NL; + Print('Wrong!'); + NL; + Exit; + END; + END; + REPEAT + REPEAT + Print('Enter your desired password for future access.'); + Print('It should be 4 to 20 characters in length.'); + NL; + Prompt('Password: '); + MPL(20); + GetPassword(s,20); + NL; + IF (Length(s) < 4) THEN + BEGIN + Print('^7Must be at least 4 characters long!^1'); + NL; + END + ELSE IF (Length(s) > 20) THEN + BEGIN + Print('^7Must be no more than 20 characters long.^1'); + NL; + END + ELSE IF (How = 3) AND (CRC32(s) = SavePW) THEN + BEGIN + Print('^7Must be different from your old password!^1'); + NL; + s := ''; + END + ELSE IF (s = ThisUser.Name) OR (s = ThisUser.RealName) THEN + BEGIN + Print('^7You cannot use that password!^1'); + NL; + s := ''; + END; + UNTIL (((Length(s) > 3) AND (Length(s) < 21)) OR (HangUp)); + Print('Enter your password again for verification:'); + NL; + Prompt('Password: '); + MPL(20); + GetPassword(s2,20); + IF (s2 <> s) THEN + BEGIN + NL; + Print('^7Passwords do not match!^1'); + NL; + END; + UNTIL ((s2 = s) OR (HangUp)); + IF (HangUp) AND (How = 3) THEN + User.PW := SavePW + ELSE + User.PW := CRC32(s); + User.PasswordChanged := DayNum(DateStr); + IF (How = 2) THEN + BEGIN + NL; + Print('Password changed.'); + SysOpLog('Changed password.'); + END; + Done1 := TRUE; + END; + + PROCEDURE DoForgotPW; + VAR + s: AStr; + BEGIN + IF (How IN [1..2]) THEN + BEGIN + REPEAT + s := ''; + Print('This question will be asked should you ever forget your password.'); + NL; + Print(General.forgotpwquestion); + Prt(': '); + MPL(40); + Input(s,40); + UNTIL (s <> '') OR (HangUp); + User.ForgotPWAnswer := s; + Done1 := TRUE; + END; + END; + + PROCEDURE DoRealName; + VAR + TempRealName: AStr; + UNum: Integer; + BEGIN + IF (How = 1) THEN + IF (NOT General.AllowAlias) THEN + BEGIN + User.RealName := Caps(User.Name); + Done1 := TRUE; + Exit; + END + ELSE IF (IEMSIRec.UserName <> '') THEN + BEGIN + Buf := IEMSIRec.UserName; + IEMSIRec.UserName := ''; + END; + Print('Enter your real first & last name:'); + Prt(': '); + MPL((SizeOf(User.RealName) - 1)); + IF (How = 3) THEN + InputL(TempRealName,(SizeOf(User.RealName) - 1)) + ELSE + InputCaps(TempRealName,(SizeOf(User.RealName) - 1)); + WHILE (TempRealName[1] IN [' ','0'..'9']) AND (Length(TempRealName) > 0) do + Delete(TempRealName,1,1); + WHILE (TempRealName[Length(TempRealName)] = ' ') do + Dec(TempRealName[0]); + IF (Pos(' ',TempRealName) = 0) AND (How <> 3) THEN + BEGIN + NL; + Print('Enter your first and last name!'); + TempRealName := ''; + END; + IF (TempRealName <> '') THEN + BEGIN + Done1 := TRUE; + UNum := SearchUser(TempRealName,TRUE); + IF (UNum > 0) AND (UNum <> UserNum) THEN + BEGIN + Done1 := FALSE; + NL; + Print('^7That name is in use.^1'); + END; + END; + IF (Done1) THEN + BEGIN + IF (How = 2) AND (UserNum > -1) THEN { don't do index on unregged users! } + BEGIN + SysOpLog('Changed real name from '+User.RealName+' to '+TempRealName); + InsertIndex(User.RealName,UserNum,TRUE,TRUE); + User.RealName := TempRealName; + InsertIndex(User.RealName,UserNum,TRUE,FALSE); + END + ELSE + User.RealName := TempRealName; + Done1 := TRUE; + END; + END; + + PROCEDURE DoScreen; + BEGIN + InputByteWOC('How wide is your screen',User.LineLen,[DisplayValue,NumbersOnly],32,132); + InputByteWOC('%LFHow many lines per page',User.PageLen,[DisplayValue,NumbersOnly],4,50); + Done1 := TRUE; + END; + + PROCEDURE DoSex; + VAR + Cmd: Char; + BEGIN + IF (How = 3) THEN + BEGIN + Prt('New gender (M,F): '); + OneK(Cmd,'MF '^M,TRUE,TRUE); + IF (Cmd IN ['M','F']) THEN + User.Sex := Cmd; + END + ELSE + BEGIN + User.Sex := #0; + Prt('Your gender (M,F)? '); + OneK(User.Sex,'MF',TRUE,TRUE); + END; + Done1 := TRUE; + END; + + PROCEDURE DoZIPCode; + VAR + TempZipCode: Str10; + BEGIN + IF (How = 3) THEN + BEGIN + FindArea; + NL; + END; + CASE CallFromArea OF + 1 : BEGIN + Print('Enter your zipcode (#####-####):'); + Prt(': '); + InputFormatted('',TempZipCode,'#####-####',(How = 3)); + IF (TempZipCode <> '') THEN + User.ZipCode := TempZipCode; + Done1 := TRUE; + END; + 2 : BEGIN + Print('Enter your postal code (LNLNLN format)'); + Prt(': '); + InputFormatted('',TempZipCode,'@#@#@#',(How = 3)); + IF (TempZipCode <> '') THEN + User.ZipCode := TempZipCode; + Done1 := TRUE + END; + 3 : BEGIN + Print('Enter your postal code:'); + Prt(': '); + MPL((SizeOf(User.ZipCode) - 1)); + Input(TempZipCode,(SizeOf(User.ZipCode) - 1)); + IF (Length(TempZipCode) > 2) THEN + BEGIN + User.ZipCode := TempZipCode; + Done1 := TRUE; + END; + END; + END; + END; + + PROCEDURE ForwardMail; + VAR + User1: UserRecordType; + Unum: Integer; + BEGIN + NL; + Print('^5If you forward your mail, all email sent to your account^1'); + Print('^5will be redirected to that person.^1'); + NL; + Print('Enter User Number, Name, or Partial Search String.'); + Prt(': '); + lFindUserWS(UNum); + IF (UNum < 1) OR (UNum > (MaxUsers - 1)) THEN + User.ForUsr := 0 + ELSE + BEGIN + LoadURec(User1,UNum); + IF (User.Name = User1.Name) OR (LockedOut IN User1.SFlags) OR + (Deleted IN User1.SFlags) OR (NoMail IN User1.Flags) THEN + BEGIN + NL; + Print('^7You can not forward mail to that user!^1'); + END + ELSE + BEGIN + User.ForUsr := UNum; + NL; + Print('Forwarding mail to: ^5'+Caps(User1.Name)+' #'+IntToStr(UNum)+'^1'); + SysOpLog('Forwarding mail to: ^5'+Caps(User1.Name)+' #'+IntToStr(UNum)); + END; + END; + IF (How = 3) THEN + PauseSCr(FALSE); + END; + + PROCEDURE MailBox; + BEGIN + IF (NoMail IN User.Flags) THEN + BEGIN + Exclude(User.Flags,NoMail); + Print('Mail box is now open.'); + IF (How = 3) THEN + PauseScr(FALSE); + SysOpLog('Mail box is now open.'); + END + ELSE IF (User.ForUsr <> 0) THEN + BEGIN + User.ForUsr := 0; + Print('Mail is no longer being forwarded.'); + IF (How = 3) THEN + PauseSCr(FALSE); + SysOpLog('Mail forwarding ended.'); + END + ELSE + BEGIN + IF PYNQ('Do you want to close your mail box? ',0,FALSE) THEN + BEGIN + Include(User.Flags,NoMail); + NL; + Print('Mail box is now closed.'); + IF (How = 3) THEN + PauseSCr(FALSE); + SysOpLog('Mail box is now closed.'); + END + ELSE + BEGIN + NL; + IF PYNQ('Do you want to forward your mail? ',0,FALSE) THEN + ForwardMail; + END; + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_ANSI; + VAR + Cmd: Char; + BEGIN + PrintF('TERMINAL'); + Print('Which terminal emulation do you support?'); + NL; + Print('(1) None'); + Print('(2) ANSI'); + Print('(3) Avatar'); + Print('(4) VT-100'); + Print('(5) RIP Graphics'); + NL; + Prt('Select (1-5): '); + OneK(Cmd,'12345',TRUE,TRUE); + Exclude(User.Flags,ANSI); + Exclude(User.Flags,Avatar); + Exclude(User.Flags,VT100); + Exclude(User.SFlags,RIP); + CASE Cmd OF + '2' : Include(User.Flags,ANSI); + '3' : BEGIN + Include(User.Flags,Avatar); + NL; + IF PYNQ('Does your terminal program support ANSI fallback? ',0,TRUE) THEN + Include(User.Flags,ANSI); + END; + '4' : Include(User.Flags,VT100); + '5' : BEGIN + Include(User.Flags,ANSI); + Include(User.SFlags,RIP); + END; + END; + IF (ANSI IN User.Flags) OR (Avatar IN User.Flags) OR (VT100 IN User.Flags) THEN + Include(User.SFlags,FSEditor) + ELSE + Exclude(User.SFlags,FSEditor); + NL; + IF (PYNQ('Would you like this to be auto-detected in the future? ',0,TRUE)) THEN + Include(User.SFlags,AutoDetect) + ELSE + Exclude(User.SFlags,AutoDetect); + Done1 := TRUE; + END; + + PROCEDURE Toggle_Color; + BEGIN + IF (Color IN User.Flags) THEN + BEGIN + Exclude(User.Flags,Color); + Print('ANSI Color disabled.'); + END + ELSE + BEGIN + Include(User.Flags,Color); + Print('ANSI Color enabled.'); + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_Pause; + BEGIN + IF (Pause IN User.Flags) THEN + BEGIN + Exclude(User.Flags,Pause); + Print('Pause on screen disabled'); + END + ELSE + BEGIN + Include(User.Flags,Pause); + Print('Pause on screen enabled'); + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_Editor; + BEGIN + Done1 := TRUE; + IF (NOT (ANSI IN User.Flags)) AND (NOT (Avatar IN User.Flags)) THEN + BEGIN + Print('You must use ANSI to use the full screen editor.'); + Exclude(User.SFlags,FSEditor); + Exit; + END; + IF (FSEditor IN User.SFlags) THEN + BEGIN + Exclude(User.SFlags,FSEditor); + Print('Full screen editor disabled.'); + END + ELSE + BEGIN + Include(User.SFlags,FSEditor); + Print('Full screen editor enabled.'); + END; + END; + + PROCEDURE Toggle_Input; + BEGIN + IF (HotKey IN User.Flags) THEN + BEGIN + Exclude(User.Flags,HotKey); + Print('Full line input.'); + END + ELSE + BEGIN + Include(User.Flags,HotKey); + Print('Hot key input.'); + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_CLSMsg; + BEGIN + IF (CLSMsg IN User.SFlags) THEN + BEGIN + Exclude(User.SFlags,CLSMsg); + Print('Screen clearing off.'); + END + ELSE + BEGIN + Include(User.SFlags,CLSMsg); + Print('Screen clearing on.'); + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_Expert; + BEGIN + IF (Novice IN User.Flags) THEN + BEGIN + Exclude(User.Flags,Novice); + CurHelpLevel := 1; + Print('Expert mode on.'); + END + ELSE + BEGIN + Include(User.Flags,Novice); + CurHelpLevel := 2; + Print('Expert mode off.'); + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_File_Area_LightBar; + BEGIN + IF (NOT General.UseFileAreaLightBar) THEN + BEGIN + NL; + Print('File area lightbar support is not available.'); + END + ELSE + BEGIN + IF (FileAreaLightBar IN ThisUser.SFlags) THEN + BEGIN + Exclude(ThisUser.SFlags,FileAreaLightBar); + Print('File area lightbar support is now off.'); + END + ELSE + BEGIN + Include(ThisUser.SFlags,FileAreaLightBar); + Print('File area lightbar support is now on.'); + END; + END; + Done1 := TRUE; + END; + + PROCEDURE Toggle_Message_Area_LightBar; + BEGIN + IF (NOT General.UseMsgAreaLightBar) THEN + BEGIN + NL; + Print('Message area lightbar support is not available.'); + END + ELSE + BEGIN + IF (MsgAreaLightBar IN ThisUser.SFlags) THEN + BEGIN + Exclude(ThisUser.SFlags,MsgAreaLightBar); + Print('Message area lightbar support is now off.'); + END + ELSE + BEGIN + Include(ThisUser.SFlags,MsgAreaLightBar); + Print('Message area lightbar support is now on.'); + END; + END; + Done1 := TRUE; + END; + + PROCEDURE CHColors; + VAR + AScheme: SchemeRec; + i, + Onlin: SmallInt; + BEGIN + Reset(SchemeFile); + CLS; + Abort := FALSE; + Next := FALSE; + PrintACR('Available Color schemes:'); + NL; + i := 1; + Onlin := 0; + Seek(SchemeFile,0); + WHILE (FilePos(SchemeFile) < FileSize(SchemeFile)) AND (NOT Abort) AND (NOT HangUp) do + BEGIN + Read(SchemeFile,AScheme); + Inc(Onlin); + Prompt(PadLeftInt(i,2)+'. ^3'+PadLeftStr(AScheme.Description,35)); + IF (OnLin = 2) THEN + BEGIN + NL; + Onlin := 0; + END; + WKey; + Inc(i); + END; + Abort := FALSE; + Next := FALSE; + NL; + InputIntegerWOC('%LFSelect a color scheme',i,[NumbersOnly],1,FileSize(SchemeFile)); + IF (i >= 1) AND (i <= FileSize(SchemeFile)) THEN + BEGIN + ThisUser.ColorScheme := i; + Seek(SchemeFile,(i - 1)); + Read(SchemeFile,Scheme); + Done1 := TRUE; + END; + Close(SchemeFile); + LastError := IOResult; + END; + + PROCEDURE CheckWantPause; + BEGIN + IF PYNQ('Pause after each screen? ',0,TRUE) THEN + Include(User.Flags,Pause) + ELSE + Exclude(User.Flags,Pause); + Done1 := TRUE; + END; + + PROCEDURE CheckWantInput; + BEGIN + IF PYNQ('Do you want to use Hot Keys? ',0,TRUE) THEN + Include(User.Flags,HotKey) + ELSE + Exclude(User.Flags,HotKey); + Done1 := TRUE; + END; + + PROCEDURE CheckWantExpert; + BEGIN + IF PYNQ('Do you want to be in expert mode? ',0,FALSE) THEN + Exclude(User.Flags,Novice) + ELSE + Include(User.Flags,Novice); + Done1 := TRUE; + END; + + PROCEDURE CheckWantCLSMsg; + BEGIN + IF PYNQ('Clear screen before each message read? ',0,TRUE) THEN + Include(User.SFlags,CLSMsg) + ELSE + Exclude(User.SFlags,CLSMsg); + Done1 := TRUE; + END; + + PROCEDURE WW(www: Byte); + BEGIN + NL; + CASE www OF + 1 : DoAddress; + 2 : DoAge; + 3 : Toggle_ANSI; + 4 : DoCityState; + 5 : DoUserDef(1); + 6 : DoUserDef(2); + 7 : DoName; + 8 : DoPhone; + 9 : DoPW; + 10 : DoRealName; + 11 : DoScreen; + 12 : DoSex; + 13 : DoUserDef(3); + 14 : DoZIPCode; + 15 : MailBox; + 16 : Toggle_ANSI; + 17 : Toggle_Color; + 18 : Toggle_Pause; + 19 : Toggle_Input; + 20 : Toggle_CLSMsg; + 21 : CHColors; + 22 : Toggle_Expert; + 23 : FindArea; + 24 : CheckWantPause; + 25 : CheckWantInput; + 26 : Toggle_Editor; + 27 : ConfigureQWK; + 28 : CheckWantExpert; + 29 : CheckWantCLSMsg; + 30 : DoForgotPW; + 31 : Toggle_File_Area_LightBar; + 32 : Toggle_Message_Area_LightBar; + END; + END; + +BEGIN + Try := 0; + Done1 := FALSE; + CASE How OF + 1 : REPEAT + WW(Which) + UNTIL (Done1) OR (HangUp); + 2,3 : + BEGIN + WW(Which); + IF (NOT Done1) THEN + Print('Function aborted!'); + END; + END; +END; + +END. diff --git a/SOURCE/DOORS.PAS b/SOURCE/DOORS.PAS new file mode 100644 index 0000000..f1a0c43 --- /dev/null +++ b/SOURCE/DOORS.PAS @@ -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. diff --git a/SOURCE/EMAIL.PAS b/SOURCE/EMAIL.PAS new file mode 100644 index 0000000..28ca179 --- /dev/null +++ b/SOURCE/EMAIL.PAS @@ -0,0 +1,1109 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT EMail; + +INTERFACE + +USES + Common; + +PROCEDURE SSMail(MenuOption: Str50); +PROCEDURE SMail(MassMail: Boolean); +PROCEDURE SEMail(UNum: Integer; ReplyHeader: MHeaderRec); +PROCEDURE AutoReply(ReplyHeader: MHeaderRec); +PROCEDURE ReadMail; +PROCEDURE ShowEmail; + +IMPLEMENTATION + +USES + Dos, + Common5, + File6, + Mail0, + Mail1, + Mail3, + SysOp2G, + SysOp3, + ShortMsg, + TimeFunc, + NodeList, + MiscUser; + +PROCEDURE SSMail(MenuOption: Str50); +VAR + MHeader: MHeaderRec; +BEGIN + InResponseTo := ''; + IF (Pos(';',MenuOption) = 0) AND (MenuOption <> '') THEN + InResponseTo := #1'FeedBack' + ELSE IF (MenuOption <> '') THEN + IF (MenuOption[Pos(';', MenuOption) + 1] = '\') THEN + InResponseTo := '\'+#1+Copy(MenuOption,(Pos(';',MenuOption) + 2),255) + ELSE + InResponseTo := #1+Copy(MenuOption,(Pos(';',MenuOption) + 1),255); + IF (StrToInt(MenuOption) < 1) THEN + SMail(FALSE) + ELSE + BEGIN + MHeader.Status := []; + SEMail(StrToInt(MenuOption),MHeader); + END; +END; + +PROCEDURE SMail(MassMail: Boolean); +VAR + MaxMailListArray: ARRAY [1..255] OF Integer; + User: UserRecordType; + MHeader: MHeaderRec; + SysOpName: STRING[36]; + MassACS: ACString; + Cmd: Char; + Counter, + NumMassMailList: Byte; + UNum: Integer; + SaveEmailSent, + Fee: Word; + EmailOK: Boolean; + + PROCEDURE CheckItOut(VAR UNum1: Integer; ShowIt: Boolean); + VAR + User1: UserRecordType; + ForUsrUNum, + SaveUNum1, + UNum2: Integer; + BEGIN + SaveUnum1 := UNum1; + IF ((UNum1 < 1) OR (UNum1 > (MaxUsers - 1))) THEN + BEGIN + UNum1 := 0; + Exit; + END; + LoadURec(User,UNum1); + IF (User.Waiting >= General.MaxWaiting) OR (NoMail IN User.Flags) AND (NOT CoSysOp) THEN + BEGIN + UNum1 := 0; + { Print(FString.CantEmail); } + lRGLngStr(46,FALSE); + Exit; + END; + ForUsrUNum := User.ForUsr; + IF (ForUsrUNum < 1) OR (ForUsrUNum > (MaxUsers - 1)) THEN + ForUsrUNum := 0; + IF (ForUsrUNum <> 0) THEN + BEGIN + LoadURec(User1,ForUsrUNum); + IF (ShowIt) THEN + Print('[> '+Caps(User.Name)+' #'+IntToStr(UNum1)+': message forwarded to '+Caps(User1.Name)+'.'); + UNum1 := ForUsrUNum; + END; + IF (ShowIt) THEN + FOR UNum2 := 1 TO NumMassMailList DO + IF (MaxMailListArray[UNum2] = UNum1) THEN + BEGIN + IF (ShowIt) THEN + Print('[> '+Caps(User.Name)+' #'+IntToStr(UNum1)+': Can''t send more than once.'); + UNum1 := 0; + Exit; + END; + IF (SaveUNum1 <> UNum1) THEN + IF ((SaveUNum1 >= 1) AND (SaveUNum1 <= (MaxUsers - 1))) THEN + LoadURec(User,SaveUNum1); + END; + + PROCEDURE SendIt(UNum1: Integer); + BEGIN + CheckItOut(UNum1,FALSE); + IF (UNum1 = 0) OR (UNum1 = UserNum) THEN + Exit; + IF ((UNum1 >= 1) AND (UNum1 <= (MaxUsers - 1))) THEN + BEGIN + LoadURec(User,UNum1); + IF (UNum1 = 1) THEN + BEGIN + Inc(ThisUser.FeedBack); + + IF (FeedBackPostsToday < 255) THEN + Inc(FeedBackPostsToday); + + END + ELSE + BEGIN + Inc(ThisUser.EmailSent); + AdjustBalance(General.CreditEmail); + + IF (PrivatePostsToday < 255) THEN + Inc(PrivatePostsToday); + + END; + Inc(User.Waiting); + SaveURec(User,UNum1); + END; + WITH MHeader.MTO DO + BEGIN + UserNum := UNum1; + A1S := AllCaps(User.Name); + Real := AllCaps(User.RealName); + Name := AllCaps(User.Name); + END; + SaveHeader((HiMsg + 1),MHeader); + END; + + PROCEDURE DoIt(Cmd1: Char); + VAR + UNum1: Integer; + BEGIN + InitMsgArea(-1); + FillChar(MHeader,SizeOf(MHeader),0); + MHeader.MTO.A1S := 'Mass private message'; + MHeader.MTO.Real := MHeader.MTO.A1S; + IF (NOT InputMessage(FALSE,TRUE,'',MHeader,'',78,500)) THEN + Exit; + CASE Cmd1 OF + '1' : BEGIN + { Print(FString.MassEmail); } + lRGLngStr(48,FALSE); + SysOpLog('Mass-private message sent to: (by ACS "'+MassACS+'")'); + FOR UNum1 := 1 TO (MaxUsers - 1) DO + BEGIN + LoadURec(User,UNum1); + IF (AACS1(User,UNum1,MassACS)) AND (UNum1 <> UserNum) AND (NOT (Deleted IN User.SFlags)) + AND (NOT (LockedOut IN User.SFlags)) THEN + BEGIN + SendIt(UNum1); + SysOpLog(' '+Caps(User.Name)); + Print(' '+Caps(User.Name)); + END; + END; + END; + '2' : BEGIN + { Print(FString.MassEmailAll); } + lRGLngStr(49,FALSE); + SysOpLog('Mass-private message sent to ALL USERS.'); + FOR UNum1 := 1 TO (MaxUsers - 1) DO + BEGIN + LoadURec(User,UNum1); + IF (UNum1 <> UserNum) AND (NOT (Deleted IN User.SFlags)) + AND (NOT (LockedOut IN User.SFlags)) THEN + SendIt(UNum1); + END; + END; + '3' : BEGIN + { Print(FString.MassEmail); } + lRGLngStr(48,FALSE); + SysOpLog('Mass-private message sent to:'); + FOR UNum1 := 1 TO NumMassMailList DO + BEGIN + SendIt(MaxMailListArray[UNum1]); + SysOpLog(' '+Caps(User.Name)); + Print(' '+Caps(User.Name)); + END; + END; + END; + END; + +BEGIN + EmailOK := TRUE; + + IF ((REmail IN ThisUser.Flags) OR (NOT AACS(General.NormPrivPost))) AND (NOT CoSysOp) THEN + BEGIN + NL; + Print('^7Your access privledges do not include sending private messages!^1'); + EmailOk := FALSE; + END + ELSE IF ((PrivatePostsToday >= General.MaxPrivPost) AND (NOT CoSysOp)) THEN + BEGIN + NL; + Print('^7You have already sent the maximum private messages allowed per day!^1'); + EmailOk := FALSE; + END + ELSE IF (AccountBalance < General.CreditEmail) AND (General.CreditEmail > 0) AND (NOT (FNoCredits IN ThisUser.Flags)) THEN + BEGIN + NL; + Print('^7Insufficient account balance to send private messages!^1'); + EmailOk := FALSE; + END; + + IF (NOT EmailOk) THEN + BEGIN + IF (InWFCMenu) THEN + PauseScr(FALSE); + Exit; + END; + + IF (NOT MassMail) THEN + BEGIN + IF (AACS(General.NetMailACS)) AND PYNQ(lRGLngStr(51,TRUE){FString.IsNetMail},0,FALSE) THEN + BEGIN + + PrintF('NETMHELP'); + + SysOpName := ''; + + WITH MHeader.From DO + GetNetAddress(SysOpName,Zone,Net,Node,Point,Fee,FALSE); + + IF (SysOpName = '') THEN + Exit; + + MHeader.From.Name := SysOpName; + + MHeader.Status := [NetMail]; + + SaveEmailSent := ThisUser.EmailSent; + + SEMail(0,MHeader); + + IF (ThisUser.EmailSent > SaveEmailSent) THEN + Inc(ThisUser.Debit,Fee); + + END + ELSE + BEGIN + + { Print(FString.SendEMail); } + lRGLngStr(47,FALSE); + NL; + Print('Enter User Number, Name, or Partial Search String.'); + Prt(': '); + lFindUserWS(UNum); + IF (UNum < 1) THEN + BEGIN + NL; + PauseScr(FALSE); + END + ELSE + BEGIN + MHeader.Status := []; + SEMail(UNum,MHeader); + END; + END; + END + ELSE + BEGIN + InResponseTo := ''; + NumMassMailList := 0; + FillChar(MaxMailListArray,SizeOf(MaxMailListArray),0); + NL; + Print('Mass private message: Send message to multiple users.'); + IF (NOT CoSysOp) THEN + Cmd := '3' + ELSE + BEGIN + NL; + Print('(1) Send to users with a certain ACS.'); + Print('(2) Send to all system users.'); + Print('(3) Send private messages to a list of users.'); + NL; + Prt('Your choice [^51^4-^53^4,^5Q^4=^5Quit^4]: '); + OneK(Cmd,'Q123',TRUE,TRUE); + END; + CASE Cmd OF + '1' : BEGIN + NL; + Prt('Enter ACS: '); + MPL((SizeOf(ACString) - 1)); + InputL(MassACS,(SizeOf(ACString) - 1)); + IF (MassACS <> '') THEN + BEGIN + NL; + Print('Users marked by ACS "'+MassACS+'":'); + Abort := FALSE; + Next := FALSE; + Reset(UserFile); + UNum := 1; + WHILE (UNum <= (MaxUsers - 1)) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadURec(User,UNum); + IF (AACS1(User,UNum,MassACS)) AND (UNum <> UserNum) AND (NOT (Deleted IN User.SFlags)) + AND (NOT (LockedOut IN User.SFlags)) THEN + BEGIN + PrintACR(' '+Caps(User.Name)); + Inc(NumMassMailList); + END; + Inc(UNum); + WKey; + END; + Close(UserFile); + END; + END; + '2' : BEGIN + NL; + Print('All users marked for mass-private messages.'); + Abort := FALSE; + Next := FALSE; + Reset(UserFile); + UNum := 1; + WHILE (UNum <= (MaxUsers - 1)) AND (NOT Abort) AND (NOT HangUp) DO (* Was X - 1 *) + BEGIN + LoadURec(User,UNum); + IF (UNum <> UserNum) AND (NOT (Deleted IN User.SFlags)) AND (NOT (LockedOut IN User.SFlags)) THEN + BEGIN + PrintACR(' '+Caps(User.Name)); + Inc(NumMassMailList); + END; + Inc(UNum); + WKey; + END; + Close(UserFile); + END; + '3' : BEGIN + NL; + Print('You can send mass private messages to ' + +AOnOff(CoSysOp,'255',IntToStr(General.MaxMassMailList))+' user''s'); + Print('Enter a blank line to stop entering names.'); + UNum := 1; + WHILE (UNum <> 0) AND (NumMassMailList < General.MaxMassMailList) OR (UNum <> 0) AND (NumMassMailList < 255) + AND (CoSysOp) DO + BEGIN + NL; + Print('Enter User Number, Name, or Partial Search String.'); + Prt(': '); + lFindUserWS(UNum); + FOR Counter := 1 TO NumMassMailList DO + IF (MaxMailListArray[Counter] = UNum) THEN + UNum := 0; + IF (UNum = UserNum) THEN + UNum := 0; + IF (UNum > 0) THEN + BEGIN + LoadURec(User,UNum); + IF (LockedOut IN User.SFlags) OR (Deleted IN User.SFlags) THEN + UNum := 0 + ELSE + BEGIN + Inc(NumMassMailList); + MaxMailListArray[NumMassMailList] := UNum; + END; + END; + END; + IF (NumMassMailList > 0) THEN + BEGIN + NL; + Print('Users marked:'); + Abort := FALSE; + Next := FALSE; + Reset(UserFile); + UNum := 1; + WHILE (UNum <= NumMassMailList) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadURec(User,MaxMailListArray[UNum]); + PrintACR(' '+Caps(User.Name)); + Inc(UNum); + WKey; + END; + Close(UserFile); + END; + END; + END; + IF (Cmd <> 'Q') THEN + BEGIN + NL; + Print('Total users listed: '+IntToStr(NumMassMailList)); + IF (NumMassMailList > 0) THEN + BEGIN + NL; + IF PYNQ('Send mass-private messages to the above list? ',0,FALSE) THEN + DoIt(Cmd); + END; + END; + END; + SaveURec(ThisUser,UserNum); +END; + +PROCEDURE SEMail(UNum: Integer; ReplyHeader: MHeaderRec); +VAR + User: UserRecordType; + MHeader: MHeaderRec; + Counter, + Counter1: Byte; + SaveReadMsgArea: Integer; + EmailOk: Boolean; +BEGIN + + IF (NOT (NetMail IN ReplyHeader.Status)) THEN + BEGIN + + IF (UNum < 1) OR (UNum > (MaxUsers - 1)) THEN + Exit; + + LoadURec(User,UNum); + + MHeader.Status := []; + + EmailOk := TRUE; + + IF ((REmail IN ThisUser.Flags) OR (NOT AACS(General.NormPrivPost))) AND (NOT CoSysOp) THEN + BEGIN + NL; + Print('^7Your access privledges do not include sending private messages!^1'); + EmailOk := FALSE; + END + ELSE IF (AccountBalance < General.CreditEmail) AND (General.CreditEmail > 0) AND (NOT (FNoCredits IN ThisUser.Flags)) THEN + BEGIN + NL; + Print('^7Insufficient account balance to send private messages!^1'); + EmailOk := FALSE; + END + ELSE IF (PrivatePostsToday >= General.MaxPrivPost) AND (NOT CoSysOp) THEN + BEGIN + NL; + Print('^7You have already sent the maximum private messages allowed per day!^1'); + EmailOk := FALSE; + END + ELSE IF ((UNum = 1) AND (FeedbackPostsToday >= General.MaxFBack) AND (NOT CoSysOp)) THEN + BEGIN + NL; + Print('^7You have already sent the maximum allowed feedback per day!^1'); + EmailOk := FALSE; + END + ELSE IF (User.Waiting >= General.MaxWaiting) AND (NOT CoSysOp) THEN + BEGIN + NL; + Print('^7The mailbox for this user is full!^1'); + EmailOk := FALSE; + END + ELSE IF (NoMail IN User.Flags) AND (NOT CoSysOp) THEN + BEGIN + NL; + Print('^7The mailbox for this user is closed!^1'); + EmailOk := FALSE; + END; + + IF (NOT EmailOk) THEN + BEGIN + IF (INWFCMenu) THEN + PauseScr(FALSE); + Exit; + END; + + IF ((User.ForUsr < 1) OR (User.ForUsr > (MaxUsers - 1))) THEN + User.ForUsr := 0; + + IF (User.ForUsr > 0) THEN + BEGIN + UNum := User.ForUsr; + LoadURec(User,UNum); + IF (CoSysOp) THEN + BEGIN + NL; + IF (NOT PYNQ('Send private message to '+Caps(User.Name)+'? ',0,FALSE)) THEN + Exit; + END; + END; + END + ELSE + BEGIN + + IF (NOT AACS(General.NetMailACS)) THEN + BEGIN + { Print(FString.NoNetMail); } + lRGLngStr(50,FALSE); + PauseScr(FALSE); + Exit; + END; + + User.Name := ReplyHeader.From.Name; + User.RealName := ReplyHeader.From.Name; + UNum := 0; + MHeader.Status := [NetMail]; + + END; + + SaveReadMsgArea := ReadMsgArea; + + InitMsgArea(-1); + + WITH MHeader.MTO DO + BEGIN + UserNum := UNum; + A1S := AllCaps(User.Name); + Real := AllCaps(User.RealName); + Name := AllCaps(User.Name); + END; + + IF (InputMessage(FALSE,TRUE,'',MHeader,'',78,500)) THEN + BEGIN + + IF (NetMail IN ReplyHeader.Status) THEN + BEGIN + Include(MHeader.Status,NetMail); + + MHeader.NetAttribute := General.NetAttribute * [Intransit,Private,Crash,KillSent,Hold,Local]; + + ChangeFlags(MHeader); + + Counter1 := 0; + Counter := 0; + WHILE (Counter <= 19) AND (Counter1 = 0) DO + BEGIN + IF (General.AKA[Counter].Zone = ReplyHeader.From.Zone) AND (General.AKA[Counter].Zone <> 0) THEN + Counter1 := Counter; + Inc(Counter); + END; + + IF (CoSysop) AND (General.AKA[Counter1].Zone <> ReplyHeader.From.Zone) THEN + BEGIN + FOR Counter := 0 TO 19 DO + IF (General.AKA[Counter].Net > 0) THEN + BEGIN + PrintACR(PadLeftInt((Counter + 1),2)+'. '+ + IntToStr(General.AKA[Counter].Zone)+':'+ + IntToStr(General.AKA[Counter].Net)+'/'+ + IntToStr(General.AKA[Counter].Node)+ + AOnOff((General.AKA[Counter].Point > 0),'.'+IntToStr(General.AKA[Counter].Point),'')); + END; + InputByteWOC('%LFUse which AKA',Counter,[NumbersOnly],1,20); + IF (Counter >= 1) OR (Counter <= 20) THEN + Counter1 := (Counter - 1); + END; + + WITH MHeader.From DO + BEGIN + Zone := General.AKA[Counter1].Zone; + Net := General.AKA[Counter1].Net; + Node := General.AKA[Counter1].Node; + Point := General.AKA[Counter1].Point; + END; + + WITH MHeader.MTO DO + BEGIN + Zone := ReplyHeader.From.Zone; + Net := ReplyHeader.From.Net; + Node := ReplyHeader.From.Node; + Point := ReplyHeader.From.Point; + END; + + END; + + IF (UNum = 1) THEN + BEGIN + Inc(ThisUser.FeedBack); + + IF (FeedBackPostsToday < 255) THEN + Inc(FeedbackPostsToday); + + END + ELSE + BEGIN + Inc(ThisUser.EmailSent); + AdjustBalance(General.CreditEmail); + + IF (PrivatePostsToday < 255) THEN + Inc(PrivatePostsToday); + END; + + IF (UNum >= 1) AND (UNum <= (MaxUsers - 1)) THEN + BEGIN + LoadURec(User,UNum); + Inc(User.Waiting); + SaveURec(User,UNum); + END; + + SaveHeader((HiMsg + 1),MHeader); + + IF (UserOn) THEN + SysOpLog(AOnOff((NetMail IN MHeader.Status),'Netmail','Private message')+' sent to ^5'+Caps(User.Name)+'.'); + + Print('^1'+AOnOff((NetMail IN MHeader.Status),'Netmail','Private message')+' sent to ^5'+Caps(User.Name)+'^1.'); + + Update_Screen; + END; + + InitMsgArea(SaveReadMsgArea); + + SaveURec(ThisUser,UserNum); +END; + +PROCEDURE AutoReply(ReplyHeader: MHeaderRec); +VAR + SysOpName: Str36; + Fee: Word; + TotPrivMsg: LongInt; +BEGIN + + IF AACS(General.NetMailACS) AND (NOT (NetMail IN ReplyHeader.Status)) AND + PYNQ(lRGLngStr(51,TRUE){FString.IsNetMail},0,FALSE) THEN + BEGIN + ReplyHeader.Status := [NetMail]; + LastAuthor := 0; + SysOpName := UseName(ReplyHeader.From.Anon, + AOnOff(MARealName IN MemMsgArea.MAFlags, + ReplyHeader.From.Real, + ReplyHeader.From.A1S)); + WITH ReplyHeader.From DO + GetNetAddress(SysOpName,Zone,Net,Node,Point,Fee,FALSE); + IF (SysOpName = '') THEN + Exit; + ReplyHeader.From.Name := SysOpName; + END; + + TotPrivMsg := (ThisUser.EmailSent + ThisUser.FeedBack); + + IF (LastAuthor = 0) AND (NOT (NetMail IN ReplyHeader.Status)) THEN + BEGIN + LastAuthor := SearchUser(ReplyHeader.From.A1S,TRUE); + IF (LastAuthor = 0) THEN + Print('^7That user does not have an account on this BBS!^1') + ELSE + SEMail(LastAuthor,ReplyHeader); + END + ELSE + BEGIN + SEMail(LastAuthor,ReplyHeader); + IF ((ThisUser.EmailSent + ThisUser.FeedBack) > TotPrivMsg) THEN + IF (NetMail IN ReplyHeader.Status) THEN + BEGIN + WITH ReplyHeader.From DO + GetNetAddress(SysOpName,Zone,Net,Node,Point,Fee,TRUE); + Inc(ThisUser.Debit,Fee) + END + ELSE + SendShortMessage(ReplyHeader.From.UserNum, + Caps(ThisUser.Name)+' replied to "'+AOnOff((ReplyHeader.FileAttached > 0), + StripName(ReplyHeader.Subject),ReplyHeader.Subject)+'" on '+DateStr+' '+TimeStr+'.'); + END; +END; + +PROCEDURE ReadMail; +TYPE + MessageArrayType = ARRAY [1..255] OF SmallWord; +VAR + MessageArray: MessageArrayType; + User: UserRecordType; + MHeader: MHeaderRec; + InputStr: AStr; + Cmd: Char; + SNum, + MNum: Byte; + UNum, + SaveReadMsgArea: Integer; + DeleteOk, + ReplyOk: Boolean; + + PROCEDURE RemoveCurrent(VAR SNum1,MNum1: Byte; VAR MessageArray1: MessageArrayType); + VAR + MsgNum: Byte; + BEGIN + Dec(MNum1); + FOR MsgNum := SNum1 TO MNum1 DO + MessageArray1[MsgNum] := MessageArray1[MsgNum + 1]; + IF (SNum1 > MNum1) THEN + SNum1 := MNum1; + END; + + PROCEDURE ReScan(VAR MNum1: Byte; VAR MessageArray1: MessageArrayType); + VAR + MsgNum: Word; + BEGIN + FillChar(MessageArray1,SizeOf(MessageArray1),0); + MNum1 := 0; + MsgNum := 1; + WHILE (MsgNum <= HiMsg) DO + BEGIN + LoadHeader(MsgNum,MHeader); + IF (MHeader.MTO.UserNum = UserNum) AND (NOT (MDeleted IN MHeader.Status)) THEN + BEGIN + Inc(MNum1); + MessageArray1[MNum1] := MsgNum; + END; + Inc(MsgNum); + END; + ThisUser.Waiting := 0; + SaveURec(ThisUser,UserNum); + END; + + PROCEDURE ListYourEmail(VAR SNum1: Byte; MNum1: Byte; MessageArray1: MessageArrayType); + VAR + DT: DateTime; + TempStr: AStr; + j, + NumDone: Byte; + BEGIN + IF (SNum1 < 1) OR (SNum1 > MNum1) THEN + SNum1 := 1; + Abort := FALSE; + Next := FALSE; + (* + CLS; + PrintACR('뉅컴컴컫컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴커'); + PrintACR('눛� Num 눛� Date/Time 눛� Sender 눛� Subject 눛'); + PrintACR('눩컴컴컨컴컴컴컴컴컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴켸'); + *) + lRGLngStr(60,FALSE); + NumDone := 1; + WHILE (NumDone < (PageLength - 5)) AND (SNum1 >= 1) AND (SNum1 <= MNum) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadHeader(MessageArray1[SNum1],MHeader); + TempStr := '�'+PadRightInt(SNum1,5); + IF (MHeader.From.Anon IN [1,2]) THEN + TempStr := TempStr + ' �[Unknown] ' + ELSE + BEGIN + PackToDate(DT,MHeader.Date); + j := DT.Hour; + IF (j > 12) THEN + Dec(j,12); + IF (j = 0) THEN + j := 12; + TempStr := TempStr + ' �'+ZeroPad(IntToStr(DT.Day))+ + ' '+Copy(MonthString[DT.Month],1,3)+ + ' '+IntToStr(DT.Year)+ + ' '+ZeroPad(IntToStr(j))+ + ':'+ZeroPad(IntToStr(DT.Min))+ + AOnOff((DT.Hour >= 12),'p','a'); + END; + TempStr := TempStr + ' �'+PadLeftStr(UseName(MHeader.From.Anon,MHeader.From.A1S),23); + IF (MHeader.FileAttached = 0) THEN + TempStr := TempStr + ' �'+Copy(MHeader.Subject,1,25) + ELSE + TempStr := TempStr + ' �'+StripName(Copy(MHeader.Subject,1,25)); + PrintACR(TempStr); + WKey; + Inc(SNum1); + Inc(NumDone); + END; + END; + +BEGIN + ReadingMail := TRUE; + SaveReadMsgArea := ReadMsgArea; + InitMsgArea(-1); + ReScan(MNum,MessageArray); + IF (MNum = 0) THEN + lRGLngStr(52,FALSE) { Print(FString.NoMailWaiting); } + ELSE + BEGIN + Abort := FALSE; + Next := FALSE; + SNum := 1; + Cmd := 'L'; + REPEAT + + REPEAT + IF (Cmd = 'L') THEN + ListYourEmail(SNum,MNum,MessageArray); + NL; + Prt('Select message (^51^4-^5'+IntToStr(MNum)+'^4) [^5?^4=^5First^4,^5^4=^5Next^4,^5Q^4=^5Quit^4)]: '); + MPL(Length(IntToStr(MNum))); + ScanInput(InputStr,'Q?'^M); + Cmd := InputStr[1]; + IF (Cmd = 'Q') THEN + SNum := 0 + ELSE + BEGIN + IF (Cmd IN ['-',^M]) THEN + Cmd := 'L' + ELSE IF (Cmd = '?') THEN + BEGIN + SNum := 1; + Cmd := 'L'; + END + ELSE + BEGIN + SNum := StrToInt(InputStr); + IF (SNum >= 1) AND (SNum <= MNum) THEN + Cmd := 'Q' + ELSE + BEGIN + NL; + Print('^7The range must be from 1 to '+IntToStr(MNum)+'^1'); + PauseScr(FALSE); + SNum := 1; + Cmd := 'L'; + END; + END; + END; + UNTIL (Cmd = 'Q') OR (HangUp); + + IF (SNum >= 1) AND (SNum <= MNum) AND (NOT HangUp) THEN + BEGIN + Cmd := #0; + REPEAT + LoadHeader(MessageArray[SNum],MHeader); + IF (Cmd <> '?') THEN + BEGIN + CLS; + ReadMsg(MessageArray[SNum],SNum,MNum); + END; + { Prt(FString.ReadingEmail); } + LOneK(lRGLngStr(13,TRUE),Cmd,'Q-ADFGLNRSUVXZM?'^M,TRUE,TRUE); + CASE Cmd OF + '-' : IF (SNum > 1) THEN + Dec(SNum) + ELSE + SNum := MNum; + 'A' : ; + 'D' : BEGIN + DeleteOk := TRUE; + IF (MHeader.FileAttached > 0) THEN + IF (CheckBatchDL(MHeader.Subject)) THEN + BEGIN + NL; + Print('If you delete this message, you will not be able to download'); + Print('the attached file currently in your batch queue.'); + NL; + IF NOT PYNQ('Continue with deletion? ',0,FALSE) THEN + DeleteOk := FALSE; + END; + IF (DeleteOk) THEN + BEGIN + Include(MHeader.Status,MDeleted); + SaveHeader(MessageArray[SNum],MHeader); + IF (MHeader.FileAttached = 1) THEN + Kill(MHeader.Subject); + + IF (NOT (NetMail IN Mheader.Status)) AND + (MHeader.From.UserNum >= 1) AND + (MHeader.From.UserNum >= (MaxUsers - 1)) THEN + SendShortMessage(MHeader.From.UserNum,Caps(ThisUser.Name)+' read "'+StripName(MHeader.Subject)+ + '" on '+DateStr+' '+TimeStr+'.'); + RemoveCurrent(SNum,MNum,MessageArray); + END; + END; + 'F' : ForwardMessage(MessageArray[SNum]); + 'G' : InputByteWOC('%LFGoto message',SNum,[NumbersOnly],1,MNum); + 'M' : IF (NOT MsgSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE + BEGIN + MoveMsg(MessageArray[SNum]); + LoadHeader(MessageArray[SNum],MHeader); + IF (MDeleted IN MHeader.Status) THEN + RemoveCurrent(SNum,MNum,MessageArray); + END; + 'R' : BEGIN + ReplyOk := TRUE; + IF (MHeader.From.Anon IN [1,2]) THEN + CASE MHeader.From.Anon OF + 1 : ReplyOk := AACS(General.AnonPrivRead); + 2 : ReplyOk := AACS(General.CSOP); + END; + IF (NOT ReplyOk) THEN + Print('%LF^7You can not reply to an anonymous message!^1%LF%PA') + ELSE + BEGIN + DumpQuote(MHeader); + AutoReply(MHeader); + DeleteOk := TRUE; + NL; + IF (NOT PYNQ('Delete original message? ',0,TRUE)) THEN + DeleteOk := FALSE; + IF (DeleteOk) AND (MHeader.FileAttached > 0) THEN + IF (CheckBatchDL(MHeader.Subject)) THEN + BEGIN + NL; + Print('If you delete this message, you will not be able to download the attached'); + Print('file currently in your batch queue.'); + NL; + IF NOT PYNQ('Continue with deletion? ',0,FALSE) THEN + DeleteOk := FALSE; + END; + IF (DeleteOk) THEN + BEGIN + Include(MHeader.Status,MDeleted); + IF (MHeader.FileAttached = 1) THEN + Kill(MHeader.Subject); + SaveHeader(MessageArray[SNum],MHeader); + RemoveCurrent(SNum,MNum,MessageArray); + END; + END; + END; + 'S' : IF (NOT CoSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('%LF^7The sender of this message does not have an account on this BBS!^1%LF%PA') + ELSE + BEGIN + LoadURec(User,LastAuthor); + ShowUserInfo(1,LastAuthor,User); + NL; + PauseScr(FALSE); + END; + 'U' : IF (NOT CoSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('%LF^7The sender of this message does not have an account on this BBS!^1%LF%PA') + ELSE IF (CheckPW) THEN + UserEditor(LastAuthor); + 'V' : IF (NOT CoSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('%LF^7The sender of this message does not have an account on this BBS!^1%LF%PA') + ELSE + BEGIN + LoadURec(User,LastAuthor); + AutoVal(User,LastAuthor); + END; + 'X' : IF (NOT CoSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE + ExtractMsgToFile(MessageArray[SNum],MHeader); + 'Z' : IF (NOT MsgSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE + BEGIN + DeleteOk := TRUE; + IF (MHeader.FileAttached > 0) THEN + IF CheckBatchDL(MHeader.Subject) THEN + BEGIN + NL; + Print('If you zap this message, you will not be able to download the attached'); + Print('file currently in your batch queue.'); + NL; + IF NOT PYNQ('Continue with zapping? ',0,FALSE) THEN + DeleteOk := FALSE; + END; + IF (DeleteOk) THEN + BEGIN + Include(MHeader.Status,MDeleted); + SaveHeader(MessageArray[SNum],MHeader); + IF (MHeader.FileAttached = 1) THEN + Kill(MHeader.Subject); + RemoveCurrent(SNum,MNum,MessageArray); + END; + END; + '?' : BEGIN + NL; + LCmds(17,3,'-Read previous','Again'); + LCmds(17,3,'Delete message','Forward messages'); + LCmds(17,3,'Goto message','List messages'); + LCmds(17,3,'Move message','Next message'); + LCmds(17,3,'Reply to message','Show user'); + LCmds(17,3,'User editor','Validate user'); + LCmds(17,3,'Xtract to file','Zap (Delete w/o reciept)'); + LCmds(17,3,'Quit',''); + END; + ELSE + IF (SNum < MNum) THEN + Inc(SNum) + ELSE + SNum := 1; + END; + IF (MNum = 0) THEN + Cmd := 'Q'; + UNTIL (Cmd IN ['L','Q']) OR (HangUp); + END; + IF (Cmd = 'Q') THEN + IF (RMsg IN ThisUser.Flags) AND (NOT CoSysOp) AND (MNum > 0) AND (NOT InWFCMenu) THEN + BEGIN + { Print(FString.SorryReply); } + lRGLngStr(53,FALSE); + SNum := 1; + Cmd := 'L'; + END; + UNTIL (Cmd = 'Q') OR (HangUp); + END; + Inc(ThisUser.Waiting,MNum); + SaveURec(ThisUser,UserNum); + LoadMsgArea(SaveReadMsgArea); + ReadingMail := FALSE; +END; + +PROCEDURE ShowEmail; +VAR + User: UserRecordType; + MHeader: MHeaderRec; + Cmd: Char; + SaveReadMsgArea: Integer; + MsgNum, + PreviousMsgNum, + MaxMsgs: Word; + AnyFound: Boolean; +BEGIN + ReadingMail := TRUE; + SaveReadMsgArea := ReadMsgArea; + InitMsgArea(-1); + Abort := FALSE; + Next := FALSE; + AnyFound := FALSE; + Cmd := #0; + MaxMsgs := HiMsg; + MsgNum := 1; + WHILE ((MsgNum <= MaxMsgs) AND (Cmd <> 'Q') AND (NOT HangUp)) DO + BEGIN + LoadHeader(MsgNum,MHeader); + IF (MHeader.From.UserNum <> UserNum) THEN + Inc(MsgNum) + ELSE + BEGIN + AnyFound := TRUE; + IF (Cmd <> '?') THEN + BEGIN + CLS; + ReadMsg(MsgNum,MsgNum,MaxMsgs); + END; + NL; + Prt('Private messages sent [^5?^4=^5Help^4]: '); + IF (CoSysOp) THEN + OneK(Cmd,'Q-ADENX?'^M,TRUE,TRUE) + ELSE + OneK(Cmd,'Q-ADEN?'^M,TRUE,TRUE); + CASE Cmd OF + '-' : BEGIN + PreviousMsgNum := (MsgNum - 1); + WHILE (PreviousMsgNum >= 1) AND (PreviousMsgNum <> MsgNum) DO + BEGIN + LoadHeader(PreviousMsgNum,MHeader); + IF (MHeader.From.UserNum <> UserNum) THEN + Dec(PreviousMsgNum) + ELSE + MsgNum := PreviousMsgNum; + END; + END; + 'A' : ; + 'D' : IF (NOT (MDeleted IN MHeader.Status)) THEN + BEGIN + Include(MHeader.Status,MDeleted); + SaveHeader(MsgNum,MHeader); + LoadURec(User,MHeader.MTO.UserNum); + IF (User.Waiting > 0) THEN + Dec(User.Waiting); + SaveURec(User,MHeader.MTO.UserNum); + Print('%LFPrivate message deleted.'); + SysOpLog('* Deleted private message to '+Caps(MHeader.From.A1S)); + END + ELSE + BEGIN + Exclude(MHeader.Status,MDeleted); + SaveHeader(MsgNum,MHeader); + LoadURec(User,MHeader.MTO.UserNum); + IF (User.Waiting < 255) THEN + Inc(User.Waiting); + SaveURec(User,MHeader.MTO.UserNum); + Print('%LFPrivate message undeleted.'); + SysOpLog('* Undeleted private message to '+Caps(MHeader.From.A1S)); + END; + 'E' : EditMessageText(MsgNum); + 'X' : IF (NOT CoSysOp) THEN + Print('%LF^7You do not have the required access level for this option!^1%LF%PA') + ELSE + ExtractMsgToFile(MsgNum,MHeader); + '?' : BEGIN + Print('%LF<^3CR^1>Next message'); + LCmds(20,3,'Again','Edit message'); + LCmds(20,3,'Delete message','-Previous message'); + IF (CoSysOp) THEN + LCmds(20,3,'Xtract to file','Quit') + ELSE + LCmds(20,3,'Quit',''); + END; + ELSE + Inc(MsgNum); + END; + END; + END; + IF (NOT AnyFound) THEN + BEGIN + NL; + Print('^3No private messages sent.'); + END; + LoadMsgArea(SaveReadMsgArea); + ReadingMail := FALSE; +END; + +END. diff --git a/SOURCE/EVENTS.PAS b/SOURCE/EVENTS.PAS new file mode 100644 index 0000000..d0b2c98 --- /dev/null +++ b/SOURCE/EVENTS.PAS @@ -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. diff --git a/SOURCE/EXECBAT.PAS b/SOURCE/EXECBAT.PAS new file mode 100644 index 0000000..c6e87dd --- /dev/null +++ b/SOURCE/EXECBAT.PAS @@ -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. diff --git a/SOURCE/FILE0.PAS b/SOURCE/FILE0.PAS new file mode 100644 index 0000000..9521d5c --- /dev/null +++ b/SOURCE/FILE0.PAS @@ -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'+''; + 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. diff --git a/SOURCE/FILE1.PAS b/SOURCE/FILE1.PAS new file mode 100644 index 0000000..23e6cdd --- /dev/null +++ b/SOURCE/FILE1.PAS @@ -0,0 +1,1588 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT File1; + +INTERFACE + +USES + Common; + +FUNCTION ChargeFilePoints(FArea: Integer): Boolean; +FUNCTION ChargeFileRatio(FArea: Integer): Boolean; +PROCEDURE CreditUploader(FileInfo: FileInfoRecordType); +FUNCTION SearchForDups(CONST CompleteFN: Str12): Boolean; +FUNCTION DizExists(CONST FN: AStr): Boolean; +PROCEDURE GetDiz(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte); +PROCEDURE DLX(FileInfo: FileInfoRecordType; + DirFileRecNum: Integer; + VAR TransferFlags: TransferFlagSet); +FUNCTION DLInTime: BOOLEAN; +FUNCTION BatchDLQueuedFiles(TransferFlags: TransferFlagSet): BOOLEAN; +PROCEDURE DL(CONST FileName: Str12; TransferFlags: TransferFlagSet); +PROCEDURE GetFileDescription(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray; + VAR NumExtDesc: Byte; VAR ToSysOp: Boolean); +PROCEDURE WriteFV(FileInfo: FileInfoRecordType;DirFileRecNum: Integer; ExtendedArray: ExtendedDescriptionArray); +PROCEDURE UpdateFileInfo(VAR FileInfo: FileInfoRecordType; CONST FN: Str12; VAR GotPts: Integer); +PROCEDURE ArcStuff(VAR Ok,Convt: Boolean; VAR FSize,ConvTime: LongInt; + ITest: Boolean; CONST FilePath: AStr; VAR FileName: Str12; VAR Descr: AStr); +PROCEDURE DownloadFile(FileName: Str12; TransferFlags: TransferFlagSet); +PROCEDURE UploadFile; +PROCEDURE LFileAreaList(VAR FArea,NumFAreas: Integer; AdjPageLen: Byte; ShowScan: Boolean); +PROCEDURE UnlistedDownload(FileName: AStr); +PROCEDURE Do_Unlisted_Download; + +IMPLEMENTATION + +USES + Dos, + Crt, + Archive1, + Email, + Events, + File0, + File2, + File6, + File8, + File11, + File12, + File14, + MultNode, + ShortMsg, + TimeFunc; + +FUNCTION ChargeFilePoints(FArea: Integer): Boolean; +VAR + ChargePoints: Boolean; +BEGIN + ChargePoints := FALSE; + IF (FArea <> -1) AND + (NOT (FANoRatio IN MemFileArea.FAFlags)) AND + (NOT AACS(General.NoFileCredits)) AND + (NOT (FNoCredits IN ThisUser.Flags)) AND + (General.FileCreditRatio) THEN + ChargePoints := TRUE; + ChargeFilePoints := ChargePoints; +END; + +FUNCTION ChargeFileRatio(FArea: Integer): Boolean; +VAR + ChargeRatio: Boolean; +BEGIN + ChargeRatio := FALSE; + IF (FArea <> -1) AND + (NOT (FANoRatio IN MemFileArea.FAFlags)) AND + (NOT AACS(General.NoDLRatio)) AND + (NOT (FNoDLRatio IN ThisUser.Flags)) AND + (General.ULDLRatio) THEN + ChargeRatio := TRUE; + ChargeFileRatio := ChargeRatio; +END; + +PROCEDURE CreditUploader(FileInfo: FileInfoRecordType); +VAR + User: UserRecordType; + FilePointCredit: LongInt; +BEGIN + IF (General.RewardSystem) AND (FileInfo.OwnerNum >= 1) AND (FileInfo.OwnerNum <= (MaxUsers - 1)) AND + (FileInfo.OwnerNum <> UserNum) THEN + BEGIN + LoadURec(User,FileInfo.OwnerNum); + FilePointCredit := Trunc(FileInfo.FilePoints * (General.RewardRatio DIV 100)); + IF (CRC32(FileInfo.OwnerName) = CRC32(User.Name)) AND (FilePointCredit > 0) THEN + BEGIN + IF ((User.FilePoints + FilePointCredit) < 2147483647) THEN + Inc(User.FilePoints,FilePointCredit) + ELSE + User.FilePoints := 2147483647; + SaveURec(User,FileInfo.OwnerNum); + SysOpLog('^3 - Credits: '+FormatNumber(FilePointCredit)+' fp to "^5'+Caps(User.Name)+'^3".'); + SendShortMessage(FileInfo.OwnerNum,'You received '+FormatNumber(FilePointCredit)+ + ' '+Plural('file point',FilePointCredit)+' for the download of ' + +SQOutSp(FileInfo.FileName)); + END; + END; +END; + +FUNCTION OKDL(CONST FileInfo: FileInfoRecordType): Boolean; +VAR + MHeader: MHeaderRec; + Counter: Byte; +BEGIN + OKDL := TRUE; + IF (FIIsRequest IN FileInfo.FIFlags) THEN + BEGIN + PrintF('REQFILE'); + IF (NoFile) THEN + BEGIN + NL; + Print('^5You must request this from '+General.SysOpName+'!^1'); + END; + NL; + IF (PYNQ('Request this file now? ',0,FALSE)) THEN + BEGIN + InResponseTo := #1'Request "'+SQOutSp(FileInfo.FileName)+'" from area #'+IntToStr(CompFileArea(FileArea,0)); + MHeader.Status := []; + SEMail(1,MHeader); + END; + OKDL := FALSE; + END + ELSE IF (FIResumeLater IN FileInfo.FIFlags) AND (NOT FileSysOp) THEN + BEGIN + NL; + Print('^7You are not the uploader of this file!^1'); + OKDL := FALSE; + END + ELSE IF (FINotVal IN FileInfo.FIFlags) AND (NOT AACS(General.DLUNVal)) THEN + BEGIN + NL; + Print('^7Your access level does not permit downloading unvalidated files!^1'); + OKDL := FALSE; + END + ELSE IF (FileInfo.FilePoints > 0) AND (ThisUser.FilePoints < FileInfo.FilePoints) AND + ChargeFilePoints(FileArea) THEN + BEGIN + NL; + Print('^7'+lRGLngStr(26,TRUE)+'^1'{FString.NoFileCredits}); + OKDL := FALSE; + END + ELSE IF ((FileInfo.FileSize DIV Rate) > NSL) THEN + BEGIN + NL; + Print('^7Insufficient time left online to download this file!^1'); + Print(Ctim(NSL)); + OKDL := FALSE; + END; +END; + +PROCEDURE DLX(FileInfo: FileInfoRecordType; + DirFileRecNum: Integer; + VAR TransferFlags: TransferFlagSet); +VAR + DownloadPath: Str52; + CopyPath: Str40; + Cmd: Char; + Changed: Boolean; +BEGIN + Abort := FALSE; + Next := FALSE; + IF (IsFileAttach IN TransferFlags) THEN + BEGIN + NL; + Print('^4The following has been attached:^1'); + END; + NL; + DisplayFileInfo(FileInfo,FALSE); + IF (IsFileAttach IN TransferFlags) THEN + IF (InCom) THEN + BEGIN + NL; + IF (NOT PYNQ('Download file now? ',0,FALSE)) THEN + Exit; + END + ELSE IF (NOT CoSysOp) THEN + Exit + ELSE + BEGIN + NL; + IF (NOT PYNQ('Move file now? ',0,FALSE)) THEN + Exit; + END; + + IF (NOT OKDL(FileInfo)) THEN + Include(TransferFlags,IsPaused) + ELSE + BEGIN + + DownloadPath := ''; + + IF (Exist(MemFileArea.DLPath+FileInfo.FileName)) THEN + BEGIN + DownloadPath := MemFileArea.DLPath; + IF (FACDRom IN MemFileArea.FAFlags) THEN + InClude(TransferFLags,IsCDRom); + END + ELSE IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN + DownloadPath := MemFileArea.ULPath; + + IF (DownloadPath = '') THEN + BEGIN + NL; + Print('^7File does not actually exist.^1'); + SysOpLog('File missing: '+SQOutSp(DownloadPath+FileInfo.FileName)); + Exit; + END; + IF (InCom) THEN + Send(FileInfo,DirFileRecNum,DownloadPath,TransferFlags) + ELSE IF (NOT CoSysOp) THEN + Include(TransferFlags,IsPaused) + ELSE + BEGIN + CopyPath := ''; + InputPath('%LF^4Enter the destination path (^5End with a ^4"^5\^4"):%LF^4:',CopyPath,FALSE,TRUE,Changed); + IF (CopyPath = '') THEN + Include(TransferFlags,IsPaused) + ELSE + BEGIN + NL; + IF (NOT CopyMoveFile(NOT (IsFileAttach IN TransferFlags), + +AOnOff(IsFileAttach IN TransferFlags,'^1Moving ... ','^1Copying ... '), + DownloadPath+SQOutSp(FileInfo.FileName), + CopyPath+SQOutSp(FileInfo.FileName),TRUE)) THEN + Include(TransferFlags,IsPaused); + END; + END; + END; + IF (IsPaused IN TransferFlags) AND (NOT (IsFileAttach IN TransferFlags)) THEN + BEGIN + NL; + Prompt('^1Press [^5Enter^1] to Continue or [^5Q^1]uit: '); + Onek(Cmd,'Q'^M,TRUE,TRUE); + IF (Cmd = 'Q') THEN + BEGIN + Include(TransferFlags,IsKeyboardAbort); + Abort := TRUE; + END; + END; + IF (IsPaused IN TransferFLags) THEN + Exclude(TransferFlags,IsPaused); +END; + +PROCEDURE DL(CONST FileName: Str12; TransferFlags: TransferFlagSet); +VAR + SaveFileArea, + FArea: Integer; + GotAny, + Junk: Boolean; + + FUNCTION ScanBase(FileName1: Str12; VAR GotAny1: Boolean): Boolean; + VAR + DirFileRecNum: Integer; + BEGIN + ScanBase := FALSE; + RecNo(FileInfo,FileName1,DirFileRecNum); + IF (BadDownloadPath) THEN + Exit; + WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(FileInfoFile,DirFileRecNum); + Read(FileInfoFile,FileInfo); + BackErase(13); + IF (NOT (FINotVal IN FileInfo.FIFlags)) OR (AACS(General.DLUnVal)) THEN + IF AACS(MemFileArea.DLACS) THEN + BEGIN + DLX(FileInfo,DirFileRecNum,TransferFlags); + ScanBase := TRUE; + IF (IsKeyboardAbort IN TransferFlags) THEN + Abort := TRUE; + IF (NOT (IsWildCard(FileName1))) THEN + Abort := TRUE; + END + ELSE + BEGIN + NL; + Print('Your access level does not permit downloading this file.'); + END; + GotAny1 := TRUE; + WKey; + NRecNo(FileInfo,DirFileRecNum); + END; + Close(FileInfoFile); + Close(ExtInfoFile); + LastError := IOResult; + END; + +BEGIN + GotAny := FALSE; + Abort := FALSE; + Next := FALSE; + + Include(TransferFlags,IsCheckRatio); + + NL; + Prompt('Searching ...'); + + IF (NOT ScanBase(FileName,GotAny)) THEN + BEGIN + SaveFileArea := FileArea; + FArea := 1; + WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (FArea <> SaveFileArea) THEN + BEGIN + LoadFileArea(FArea); + IF (MemFileArea.Password = '') THEN (* Doesn't scan areas with a Password ??? *) + ChangeFileArea(FArea); + IF (FileArea = FArea) THEN + Junk := ScanBase(FileName,GotAny); + END; + WKey; + Inc(FArea); + END; + FileArea := SaveFileArea; + LoadFileArea(FileArea); + END; + IF (NOT GotAny) THEN + BEGIN + BackErase(13); + NL; + Print('File not found.'); + END; +END; + +FUNCTION DLInTime: BOOLEAN; +VAR + DLAllowed: BOOLEAN; +BEGIN + DLAllowed := TRUE; + + IF (NOT InTime(Timer,General.DLLowTime,General.DLHiTime)) THEN + DLAllowed := FALSE; + + IF (ComPortSpeed < General.MinimumDLBaud) THEN + IF (NOT InTime(Timer,General.MinBaudDLLowTime,General.MinBaudDLHiTime)) THEN + DLAllowed := FALSE; + + IF (NOT DLAllowed) THEN + BEGIN + NL; + PrintF('DLHOURS'); + IF (NoFile) THEN + Print('File downloading is not allowed at this time.'); + END; + DLInTime := DLAllowed; +END; + +FUNCTION BatchDLQueuedFiles(TransferFlags: TransferFlagSet): BOOLEAN; +VAR + DLBatch: BOOLEAN; +BEGIN + DLBatch := FALSE; + IF (NOT (lIsAddDLBatch IN TransferFLags)) AND (NumBatchDLFiles > 0) THEN + BEGIN + NL; + IF (PYNQ('Batch download queued files? ',0,FALSE)) THEN + BEGIN + BatchDownload; + DLBatch := TRUE; + END; + END; + BatchDLQueuedFiles := DLBatch; +END; + +PROCEDURE DownloadFile(FileName: Str12; TransferFlags: TransferFlagSet); +BEGIN + IF (DLInTime) THEN + IF (NOT BatchDLQueuedFiles(TransferFlags)) THEN + BEGIN + IF (FileName = '') THEN + BEGIN + PrintF('DLOAD'); + IF (NOT (lIsAddDLBatch IN TransferFlags)) THEN + { + NL; + Print(FString.downloadline) + NL; + Prt('File name: '); + } + lRGLngStr(23,FALSE) + ELSE + { + NL; + Print(FString.AddDLBatch); + NL; + Prt('File name: '); + } + lRGLngStr(31,FALSE); + MPL(12); + Input(FileName,12); + IF (FileName = '') THEN + BEGIN + NL; + Print('Aborted.'); + END; + END; + IF (FileName <> '') THEN + BEGIN + IF (Pos('.',FileName) = 0) THEN + FileName := FileName+'.*'; + DL(FileName,TransferFlags); + END + END; +END; + +PROCEDURE GetFileDescription(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray; + VAR NumExtDesc: Byte; VAR ToSysOp: Boolean); +VAR + MaxLen: Byte; +BEGIN + NL; + IF ((ToSysOp) AND (General.ToSysOpDir >= 1) AND (General.ToSysOpDir <= NumFileAreas)) THEN + Print('Begin description with (/) to make upload "Private".') + ELSE + ToSysOp := FALSE; + LoadFileArea(FileArea); + IF ((FAUseGIFSpecs IN MemFileArea.FAFlags) AND ISGifExt(FileInfo.FileName)) THEN + BEGIN + Print('Enter your text. Press <^5Enter^1> alone to end. (31 chars/line 1, 50 chars/line 2-'+IntToStr(MaxExtDesc + 1)+')'); + MaxLen := 31; + END + ELSE + BEGIN + Print('Enter your text. Press <^5Enter^1> alone to end. (50 chars/line 1-'+IntToStr(MaxExtDesc + 1)+')'); + MaxLen := 50; + END; + REPEAT + Prt(': '); + MPL(MaxLen); + InputWC(FileInfo.Description,MaxLen); + IF ((FileInfo.Description[1] = '/') OR (RValidate IN ThisUser.Flags)) AND (ToSysOp) THEN + BEGIN + IF (General.ToSysOpDir >= 1) AND (General.ToSysOpDir <= NumFileAreas) THEN + FileArea := General.ToSysOpDir; + InitFileArea(FileArea); + ToSysOp := TRUE; + END + ELSE + ToSysOp := FALSE; + IF (FileInfo.Description[1] = '/') THEN + Delete(FileInfo.Description,1,1); + UNTIL ((FileInfo.Description <> '') OR (FileSysOp) OR (HangUp)); + FillChar(ExtendedArray,SizeOf(ExtendedArray),0); + NumExtDesc := 0; + REPEAT + Inc(NumExtDesc); + Prt(': '); + MPL(50); + InputL(ExtendedArray[NumExtDesc],50); + UNTIL (ExtendedArray[NumExtDesc] = '') OR (NumExtDesc = MaxExtDesc) OR (HangUp); +END; + +FUNCTION DizExists(CONST FN: AStr): Boolean; +VAR + Ok: Boolean; +BEGIN + DizExists := FALSE; + IF (ArcType(FN) > 0) THEN + BEGIN + Star('Checking for description...'#29); + ArcDecomp(Ok,ArcType(FN),FN,'FILE_ID.DIZ DESC.SDI'); + IF (Ok) AND (Exist(TempDir+'ARC\FILE_ID.DIZ') OR (Exist(TempDir+'ARC\DESC.SDI'))) THEN + DizExists := TRUE; + NL; + END; +END; + +PROCEDURE GetDiz(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte); +VAR + DizFile: Text; + TempStr: Str50; + Counter: Byte; +BEGIN + IF (Exist(TempDir+'ARC\FILE_ID.DIZ')) THEN + Assign(DizFile,TempDir+'ARC\FILE_ID.DIZ') + ELSE + Assign(DizFile,TempDir+'ARC\DESC.SDI'); + Reset(DizFile); + IF (IOResult <> 0) THEN + Exit; + Star('Importing description.'); + FillChar(ExtendedArray,SizeOf(ExtendedArray),0); + Counter := 1; + WHILE NOT EOF(DizFile) AND (Counter <= (MaxExtDesc + 1)) DO + BEGIN + ReadLn(DizFile,TempStr); + IF (TempStr = '') THEN + TempStr := ' '; + IF (Counter = 1) THEN + FileInfo.Description := TempStr + ELSE + ExtendedArray[Counter - 1] := TempStr; + Inc(Counter); + END; + NumExtDesc := MaxExtDesc; + WHILE (NumExtDesc >= 1) AND ((ExtendedArray[NumExtDesc] = ' ') OR (ExtendedArray[NumExtDesc] = '')) DO + BEGIN + ExtendedArray[NumExtDesc] := ''; + Dec(NumExtDesc); + END; + Close(DizFile); + Erase(DizFile); + LastError := IOResult; +END; + +PROCEDURE WriteFV(FileInfo: FileInfoRecordType; DirFileRecNum: Integer; ExtendedArray: ExtendedDescriptionArray); +VAR + LineNum: Byte; + VFO: Boolean; +BEGIN + FileInfo.VTextSize := 0; + IF (ExtendedArray[1] = '') THEN + FileInfo.VPointer := -1 + ELSE + BEGIN + VFO := (FileRec(ExtInfoFile).Mode <> FMClosed); + IF (NOT VFO) THEN + Reset(ExtInfoFile,1); + IF (IOResult = 0) THEN + BEGIN + FileInfo.VPointer := (FileSize(ExtInfoFile) + 1); + Seek(ExtInfoFile,FileSize(ExtInfoFile)); + FOR LineNum := 1 TO MaxExtDesc DO + IF (ExtendedArray[LineNum] <> '') THEN + BEGIN + Inc(FileInfo.VTextSize,(Length(ExtendedArray[LineNum]) + 1)); + BlockWrite(ExtInfoFile,ExtendedArray[LineNum],(Length(ExtendedArray[LineNum]) + 1)); + END; + IF (NOT VFO) THEN + Close(ExtInfoFile); + END; + END; + Seek(FileInfoFile,DirFileRecNum); + Write(FileInfoFile,FileInfo); + LastError := IOResult; +END; + +PROCEDURE UpdateFileInfo(VAR FileInfo: FileInfoRecordType; CONST FN: Str12; VAR GotPts: Integer); +BEGIN + WITH FileInfo DO + BEGIN + FileName := Align(FN); + Downloaded := 0; + OwnerNum := UserNum; + OwnerName := AllCaps(ThisUser.Name); + FileDate := Date2PD(DateStr); + IF (NOT General.FileCreditRatio) THEN + BEGIN + FilePoints := 0; + GotPts := 0; + END + ELSE + BEGIN + FilePoints := 0; + IF (General.FileCreditCompBaseSize > 0) THEN + FilePoints := ((FileSize DIV 1024) DIV General.FileCreditCompBaseSize); + GotPts := (FilePoints * General.FileCreditComp); + IF (GotPts < 1) THEN + GotPts := 1; + END; + FIFlags := []; + + IF (NOT AACS(General.ULValReq)) AND (NOT General.ValidateAllFiles) THEN + Include(FIFlags,FINotVal); + + END; +END; + +(* +OldArcType : current archive format, 0 IF none +NewArcType : desired archive format, 0 IF none +OldFileName : current FileName +NewFileName : desired archive format FileName +*) + +PROCEDURE ArcStuff(VAR Ok, + Convt: Boolean; { IF Ok - IF converted } + VAR FSize, { file size } + ConvTime: LongInt; { convert time } + ITest: Boolean; { whether to test integrity } + CONST FilePath: AStr; { filepath } + VAR FileName: Str12; { FileName } + VAR Descr: AStr); { Description } +VAR + OldFileName, + NewFileName: AStr; + OldArcType, + NewArcType: Byte; +BEGIN + Ok := TRUE; + + ConvTime := 0; + + FSize := GetFileSize(FilePath+FileName); + + IF (NOT General.TestUploads) THEN + Exit; + + OldFileName := SQOutSp(FilePath+FileName); + + OldArcType := ArcType(OldFileName); + + NewArcType := MemFileArea.ArcType; + + IF (NOT General.FileArcInfo[NewArcType].Active) OR + (General.FileArcInfo[NewArcType].Ext = '') THEN + BEGIN + NewArcType := 0; + NewArcType := OldArcType; + END; + + + IF ((OldArcType <> 0) AND (NewArcType <> 0)) THEN + BEGIN + + + NewFileName := FileName; + + IF (Pos('.',NewFileName) <> 0) THEN + NewFileName := Copy(NewFileName,1,(Pos('.',NewFileName) - 1)); + + NewFileName := SQOutSp(FilePath+NewFileName+'.'+General.FileArcInfo[NewArcType].Ext); + + IF ((ITest) AND (General.FileArcInfo[OldArcType].TestLine <> '')) THEN + BEGIN + NL; + Star('Testing file integrity ... '#29); + ArcIntegrityTest(Ok,OldArcType,OldFileName); + IF (NOT Ok) THEN + BEGIN + SysOpLog('^5 '+OldFileName+' on #'+IntToStr(FileArea)+': errors in integrity test'); + Print('^3failed.'); + END + ELSE + Print('^3passed.'); + END; + + IF (Ok) AND ((OldArcType <> NewArcType) OR General.Recompress) AND (NewArcType <> 0) THEN + BEGIN + Convt := InCom; {* don't convert IF local AND non-file-SysOp *} + + IF (FileSysOp) THEN + BEGIN + IF (OldArcType = NewArcType) THEN + Convt := PYNQ('Recompress this file? ',0,TRUE) + ELSE + Convt := PYNQ('Convert archive to .'+General.FileArcInfo[NewArcType].Ext+' format? ',0,TRUE); + END; + + IF (Convt) THEN + BEGIN + NL; + + ConvTime := GetPackDateTime; + + ConvA(Ok,OldArcType,NewArcType,OldFileName,NewFileName); + + ConvTime := (GetPackDateTime - ConvTime); + + IF (Ok) THEN + BEGIN + + IF (OldArcType <> NewArcType) THEN + Kill(FilePath+FileName); + + FSize := GetFileSize(NewFileName); + + IF (FSize = -1) OR (FSize = 0) THEN + Ok := FALSE; + + FileName := Align(StripName(NewFileName)); + Star('No errors in conversion, file passed.'); + END + ELSE + BEGIN + IF (OldArcType <> NewArcType) THEN + Kill(NewFileName); + SysOpLog('^5 '+OldFileName+' on #'+IntToStr(FileArea)+': Conversion unsuccessful'); + Star('errors in conversion! Original format retained.'); + NewArcType := OldArcType; + END; + Ok := TRUE; + END + ELSE + NewArcType := OldArcType; + END; + + IF (Ok) AND (General.FileArcInfo[NewArcType].CmtLine <> '') THEN + BEGIN + ArcComment(Ok,NewArcType,MemFileArea.CmtType,SQOutSp(FilePath+FileName)); + Ok := TRUE; + END; + + END; + + FileName := SQOutSp(FileName); + + IF (FAUseGIFSpecs IN MemFileArea.FAFlags) AND (IsGifExt(FileName)) THEN + Descr := GetGIFSpecs(FilePath+FileName,Descr,2); + +END; + +FUNCTION SearchForDups(CONST CompleteFN: Str12): Boolean; +VAR + WildFN, + NearFN: Str12; + SaveFileArea, + FArea, + FArrayRecNum: Integer; + AnyFound, + HadACC, + Thisboard, + CompleteMatch, + NearMatch: Boolean; + + PROCEDURE SearchB(FArea1: Integer; VAR FArrayRecNum: Integer; CONST FN: Str12; VAR HadACC: Boolean); + VAR + DirFileRecNum: Integer; + BEGIN + HadACC := FileAreaAC(FArea1); + IF (NOT HadACC) OR (FANoDupeCheck IN MemFileArea.FAFlags) AND (NOT (FileArea = FArea1)) THEN + Exit; + FileArea := FArea1; + RecNo(FileInfo,FN,DirFileRecNum); + IF (BadDownloadPath) THEN + Exit; + WHILE (DirFileRecNum <> -1) DO + BEGIN + IF (NOT AnyFound) THEN + BEGIN + NL; + NL; + AnyFound := TRUE; + END; + Seek(FileInfoFile,DirFileRecNum); + Read(FileInfoFile,FileInfo); + IF (CanSee(FileInfo)) THEN + BEGIN + WITH FArray[FArrayRecNum] DO + BEGIN + FArrayFileArea := FileArea; + FArrayDirFileRecNum := DirFileRecNum; + END; + LDisplay_File(FileInfo,FArrayRecNum,'',TRUE); + Inc(FArrayRecNum); + IF (FArrayRecNum = 100) THEN + FArrayRecNum := 0; + END; + IF (Align(FileInfo.FileName) = Align(CompleteFN)) THEN + BEGIN + CompleteMatch := TRUE; + ThisBoard := TRUE; + END + ELSE + BEGIN + NearFN := Align(FileInfo.FileName); + NearMatch := TRUE; + ThisBoard := TRUE; + END; + NRecNo(FileInfo,DirFileRecNum); + END; + Close(FileInfoFile); + Close(ExtInfoFile); + FileArea := SaveFileArea; + InitFileArea(FileArea); + LastError := IOResult; + END; + +BEGIN + SaveFileArea := FileArea; + InitFArray(FArray); + FArrayRecNum := 0; + AnyFound := FALSE; + Prompt('^5Searching for possible duplicates ... '); + SearchForDups := TRUE; + IF (Pos('.',CompleteFN) > 0) THEN + WildFN := Copy(CompleteFN,1,Pos('.',CompleteFN) - 1) + ELSE + WildFN := CompleteFN; + WildFn := SQOutSp(WildFN); + WHILE (WildFN[Length(WildFN)] IN ['0'..'9']) AND (Length(WildFN) > 2) DO + Dec(WildFN[0]); + WHILE (Length(WildFN) < 8) DO + WildFN := WildFN + '?'; + WildFN := WildFN + '.???'; + CompleteMatch := FALSE; + NearMatch := FALSE; + FArea := 1; + WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT HangUp) DO + BEGIN + Thisboard := FALSE; + SearchB(FArea,FArrayRecNum,WildFN,HadACC); + LoadFileArea(FArea); + IF (CompleteMatch) THEN + BEGIN + SysOpLog('User tried to upload '+SQOutSp(CompleteFN)+' to #'+IntToStr(SaveFileArea)+ + '; existed in #'+IntToStr(FArea)+AOnOff(NOT HadACC,' - no access','')); + NL; + NL; + IF (HadACC) THEN + Print('^5File "'+SQOutSp(CompleteFN)+'" already exists in "'+MemFileArea.AreaName+'^5 #'+IntToStr(FArea)+'".') + ELSE + Print('^5File "'+SQOutSp(CompleteFN)+ 'cannot be accepted by the system at this time.'); + Print('^7Illegal File Name.'); + Exit; + END + ELSE IF (NearMatch) AND (Thisboard) THEN + BEGIN + SysOpLog('User entered upload file name "'+SQOutSp(CompleteFN)+'" in #'+ + IntToStr(FileArea)+'; was warned that "'+SQOutSp(NearFN)+ + '" existed in #'+IntToStr(FArea)+AOnOff(NOT HadACC,' - no access to','')); + END; + Inc(FArea); + END; + FileArea := SaveFileArea; + InitFileArea(FileArea); + IF (NOT AnyFound) THEN + Print('No duplicates found.'); + NL; + SearchForDups := FALSE; +END; + +(* +AExists : if file already exists in dir +DirFileRecNum : rec-num of file if already exists in file listing +ResumeFile : IF user is going to RESUME THE UPLOAD +ULS : whether file is to be actually UPLOADED +OffLine : IF uploaded a file to be OffLine automatically.. +*) + +PROCEDURE UL(FileName: Str12; LocBatUp: Boolean; VAR AddULBatch: Boolean); +VAR + fi: FILE OF Byte; + Cmd: Char; + Counter, + LineNum, + NumExtDesc: Byte; + DirFileRecNum, + SaveFileArea, + GotPts: Integer; + TransferTime, + RefundTime, + ConversionTime: LongInt; + ULS, + UploadOk, + KeyboardAbort, + Convt, + AExists, + ResumeFile, + WentToSysOp, + OffLine: Boolean; +BEGIN + SaveFileArea := FileArea; + InitFileArea(FileArea); + IF (BadUploadPath) THEN + Exit; + + UploadOk := TRUE; + + IF (FileName[1] = ' ') OR (FileName[10] = ' ') THEN + UploadOk := FALSE; + + FOR Counter := 1 TO Length(FileName) DO + IF (Pos(FileName[Counter],'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.-!#$%^&''~()_') = 0) THEN + BEGIN + UploadOk := FALSE; + Break; + END; + + IF (NOT UploadOk) THEN + BEGIN + NL; + Print('^7Illegal file name specified!^1'); + PauseScr(FALSE); + Exit; + END; + + Abort := FALSE; + Next := FALSE; + + ResumeFile := FALSE; + + ULS := TRUE; + + OffLine := FALSE; + + AExists := Exist(MemFileArea.ULPath+FileName); + + FileName := Align(FileName); + + RecNo(FileInfo,FileName,DirFileRecNum); + IF (DirFileRecNum <> -1) THEN + BEGIN + Seek(FileInfoFile,DirFileRecNum); + Read(FileInfoFile,FileInfo); + ResumeFile := (FIResumeLater IN FileInfo.FIFlags); + IF (ResumeFile) THEN + BEGIN + NL; + Print('^5Note: ^1This is a resume-later file.^1'); + ResumeFile := (CRC32(FileInfo.OwnerName) = CRC32(ThisUser.Name)) OR (FileSysOp); + IF (ResumeFile) THEN + BEGIN + IF (NOT InCom) THEN + BEGIN + NL; + Print('^7File upload can not be resumed locally!^1'); + PauseScr(FALSE); + Exit; + END; + NL; + ResumeFile := PYNQ('Resume upload of "'+SQOutSp(FileName)+'"? ',0,TRUE); + IF (NOT ResumeFile) THEN + Exit; + END + ELSE + BEGIN + NL; + Print('^7You are not the uploader of this file!^1'); + PauseScr(FALSE); + Exit; + END; + END; + END; + + IF (NOT AExists) AND (FileSysOp) AND (NOT InCom) THEN + BEGIN + ULS := FALSE; + OffLine := TRUE; + NL; + Print('File does not exist in upload path: ^5'+MemFileArea.ULPath+SQOutSp(FileName)+'^1'); + IF (DirFileRecNum <> -1) THEN + BEGIN + NL; + Print('^5Note: ^1File exists in listing.^1'); + END; + NL; + IF NOT PYNQ('Do you want to create an offline entry? ',0,FALSE) THEN + Exit; + END; + + IF (NOT ResumeFile) THEN + BEGIN + + IF (((AExists) OR (DirFileRecNum <> -1)) AND (NOT FileSysOp)) THEN + BEGIN + NL; + Print('^7File already exists!^1'); + Exit; + END; + IF (FileSize(FileInfoFile) >= MemFileArea.MaxFiles) THEN + BEGIN + NL; + Star('^7This file area is full!^1'); + Exit; + END; + + IF (NOT AExists) AND (NOT OffLine) THEN + IF (NOT CheckDriveSpace('Upload',MemFileArea.ULPath,General.MinSpaceForUpload)) THEN + Exit; + + IF (AExists) THEN + BEGIN + ULS := FALSE; + NL; + Print('^1File exists in upload path: ^5'+MemFileArea.ULPath+SQOutSp(FileName)); + IF (DirFileRecNum <> -1) THEN + BEGIN + NL; + Print('^5Note: ^1File exists in listing.^1'); + END; + + IF (LocBatUp) THEN + BEGIN + NL; + Prompt('^7[Q]uit or Upload this? (Y/N) ['+SQOutSp(ShowYesNo(DirFileRecNum = -1))+']: '); + OneK(Cmd,'QYN'^M,FALSE,FALSE); + IF (DirFileRecNum <> -1) THEN + UploadOk := (Cmd = 'Y') + ELSE + UploadOk := (Cmd IN ['Y',^M]); + Abort := (Cmd = 'Q'); + IF (Abort) THEN + Print('^3Quit') + ELSE IF (NOT UploadOk) THEN + Print('^3No') + ELSE + Print('^3Yes'); + UserColor(1); + END + ELSE + BEGIN + NL; + UploadOk := PYNQ('Upload this? (Y/N) ['+SQOutSp(ShowYesNo(DirFileRecNum = -1))+']: ',0,(DirFileRecNum = -1)); + END; + DirFileRecNum := 0; + END; + + IF (General.SearchDup) AND (UploadOk) AND (NOT Abort) AND (InCom) THEN + IF (NOT FileSysOp) OR (PYNQ('Search for duplicates? ',0,FALSE)) THEN + IF (SearchForDups(FileName)) THEN + Exit; + + IF (ULS) THEN + BEGIN + NL; + UploadOk := PYNQ('Upload "^5'+SQOutSp(FileName)+'^7" to ^5'+MemFileArea.AreaName+'^7? ',0,TRUE); + END; + + IF ((UploadOk) AND (ULS) AND (NOT ResumeFile)) THEN + BEGIN + + Assign(fi,MemFileArea.ULPath+FileName); + ReWrite(fi); + IF (IOResult <> 0) THEN + UploadOk := FALSE + ELSE + BEGIN + Close(fi); + Erase(fi); + IF (IOResult <> 0) THEN + UploadOk := FALSE; + END; + + IF (NOT UploadOk) THEN + BEGIN + NL; + Print('^7Unable to upload that file name!^1'); + Exit; + END; + END; + + END; + + IF (NOT UploadOk) THEN + Exit; + + WentToSysOp := TRUE; + + IF (NOT ResumeFile) THEN + BEGIN + FileInfo.FileName := Align(FileName); + GetFileDescription(FileInfo,ExtendedArray,NumExtDesc,WentToSysOp); + END; + + UploadOk := TRUE; + + IF (ULS) THEN + BEGIN + Receive(FileName,MemFileArea.ULPath,ResumeFile,UploadOk,KeyboardAbort,AddULBatch,TransferTime); + + IF (AddULBatch) THEN + BEGIN + IF CheckBatchUL(FileName) THEN + BEGIN + NL; + Print('^7This file is already in the batch upload queue!^1'); + END + ELSE IF (NumBatchULFiles = General.MaxBatchULFiles) THEN + BEGIN + NL; + Print('^7The batch upload queue is full!^1'); + END + ELSE + BEGIN + Assign(BatchULFile,General.DataPath+'BATCHUL.DAT'); + IF (NOT Exist(General.DataPath+'BATCHUL.DAT')) THEN + ReWrite(BatchULFile) + ELSE + Reset(BatchULFile); + WITH BatchUL DO + BEGIN + BULFileName := SQOutSp(FileName); + BULUserNum := UserNum; + + BULSection := FileArea; (* Should this be CompFileArea ??? *) + + BULDescription := FileInfo.Description; + + IF (ExtendedArray[1] = '') THEN + BEGIN + BULVPointer := -1; + BULVTextSize := 0; + END + ELSE + BEGIN + Assign(BatchULF,General.DataPath+'BATCHUL.EXT'); + IF (NOT Exist(General.DataPath+'BATCHUL.EXT')) THEN + ReWrite(BatchULF,1) + ELSE + Reset(BatchULF,1); + BULVPointer := (FileSize(BatchULF) + 1); + BULVTextSize := 0; + Seek(BatchULF,FileSize(BatchULF)); + FOR LineNum := 1 TO NumExtDesc DO + IF (ExtendedArray[LineNum] <> '') THEN + BEGIN + Inc(BULVTextSize,(Length(ExtendedArray[LineNum]) + 1)); + BlockWrite(BatchULF,ExtendedArray[LineNum],(Length(ExtendedArray[LineNum]) + 1)); + END; + Close(BatchULF); + LastError := IOResult; + END; + + Seek(BatchULFile,FileSize(BatchULFile)); + Write(BatchULFile,BatchUL); + Close(BatchULFile); + LastError := IOResult; + + Inc(NumBatchULFiles); + NL; + Print('^5File added to the batch upload queue.^1'); + NL; + Star('^1Batch upload queue: ^5'+IntToStr(NumBatchULFiles)+' '+Plural('file',NumBatchULFiles)); + SysOpLog('Batch UL Add: "^5'+BatchUL.BULFileName+'^1" to ^5'+MemFileArea.AreaName); + END; + END; + NL; + Star('^1Press <^5Enter^1> to stop adding to the batch upload queue.^1'); + NL; + FileArea := SaveFileArea; + Exit; + END; + + IF (KeyboardAbort) THEN + BEGIN + FileArea := SaveFileArea; + Exit; + END; + + RefundTime := (TransferTime * (General.ULRefund DIV 100)); + + Inc(FreeTime,RefundTime); + + NL; + + END; + + NL; + + Convt := FALSE; + + IF (NOT OffLine) THEN + BEGIN + + Assign(fi,MemFileArea.ULPath+FileName); + Reset(fi); + IF (IOResult <> 0) THEN + UploadOk := FALSE + ELSE + BEGIN + FileInfo.FileSize := FileSize(fi); + IF (FileSize(fi) = 0) THEN + UploadOk := FALSE; + Close(fi); + + END; + + END; + + IF ((UploadOk) AND (NOT OffLine)) THEN + BEGIN + + ArcStuff(UploadOk,Convt,FileInfo.FileSize,ConversionTime,ULS,MemFileArea.ULPath,FileName,FileInfo.Description); + + UpdateFileInfo(FileInfo,FileName,GotPts); + + IF (General.FileDiz) AND (DizExists(MemFileArea.ULPath+FileName)) THEN + GetDiz(FileInfo,ExtendedArray,NumExtDesc); + + IF (UploadOk) THEN + BEGIN + + IF (AACS(General.ULValReq)) OR (General.ValidateAllFiles) THEN + Include(FileInfo.FIFlags,FIOwnerCredited); + + IF (NOT ResumeFile) OR (DirFileRecNum = -1) THEN + WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray) + ELSE + WriteFV(FileInfo,DirFileRecNum,ExtendedArray); + + IF (ULS) THEN + BEGIN + + IF (UploadsToday < 2147483647) THEN + Inc(UploadsToday); + + IF ((UploadKBytesToday + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN + Inc(UploadKBytesToday,(FileInfo.FileSize DIV 1024)) + ELSE + UploadKBytesToday := 2147483647; + + END; + + SysOpLog('^3Uploaded: "^5'+SQOutSp(FileName)+'^3" on ^5'+MemFileArea.AreaName); + + IF (ULS) THEN + + + SysOpLog('^3 ('+ConvertBytes(FileInfo.FileSize,FALSE)+', '+FormattedTime(TransferTime)+ + ', '+FormatNumber(GetCPS(FileInfo.FileSize,Transfertime))+' cps)'); + + IF ((InCom) AND (ULS)) THEN + BEGIN + + Star('File size : ^5'+ConvertBytes(FileInfo.FileSize,FALSE)); + + Star('Upload time : ^5'+FormattedTime(TransferTime)); + + IF (Convt) THEN + Star('Convert time : ^5'+FormattedTime(ConversionTime)); + + Star('Transfer rate: ^5'+FormatNumber(GetCPS(FileInfo.FileSize,TransferTime))+' cps'); + + Star('Time refund : ^5'+FormattedTime(RefundTime)); + + IF (GotPts <> 0) THEN + Star('File Points : ^5'+FormatNumber(GotPts)+' pts'); + + IF (ChopTime > 0) THEN + BEGIN + Inc(ChopTime,RefundTime); + Dec(FreeTime,RefundTime); + NL; + Star('Sorry, no upload time refund may be given at this time.'); + Star('You will get your refund after the event.'); + NL; + END; + + IF (NOT AACS(General.ULValReq)) AND (NOT General.ValidateAllFiles) THEN + BEGIN + IF (General.ULDLRatio) THEN + BEGIN + NL; + Print('^5You will receive file credit as soon as the SysOp validates the file!') + END + ELSE + BEGIN + NL; + Print('^5You will receive credit as soon as the SysOp validates the file!'); + END; + END + ELSE + BEGIN + + IF ((NOT General.ULDLRatio) AND (NOT General.FileCreditRatio) AND (GotPts = 0)) THEN + BEGIN + NL; + Print('^5You will receive credit as soon as the Sysop validates the file!') + END + ELSE + BEGIN + + IF (ThisUser.Uploads < 2147483647) THEN + Inc(ThisUser.Uploads); + + IF ((ThisUser.UK + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN + Inc(ThisUser.UK,(FileInfo.FileSize DIV 1024)) + ELSE + ThisUser.UK := 2147483647; + + IF ((ThisUser.FilePoints + GotPts) < 2147483647) THEN + Inc(ThisUser.FilePoints,GotPts) + ELSE + ThisUser.FilePoints := 2147483647; + + END; + END; + + + NL; + Print('^5Thanks for the file, '+Caps(ThisUser.Name)+'!'); + PauseScr(FALSE); + + END + ELSE + Star('Entry added.'); + END; + END; + + IF (NOT UploadOk) AND (NOT OffLine) THEN + BEGIN + + IF (Exist(MemFileArea.ULPath+FileName)) THEN + 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 + + UpdateFileInfo(FileInfo,FileName,GotPts); + + Include(FileInfo.FIFlags,FIResumeLater); + + IF (NOT AExists) OR (DirFileRecNum = -1) THEN + WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray) + ELSE + WriteFV(FileInfo,DirFileRecNum,ExtendedArray); + + END; + END; + + IF (NOT (FIResumeLater IN FileInfo.FIFlags)) AND (Exist(MemFileArea.ULPath+FileName)) THEN + Kill(MemFileArea.ULPath+FileName); + + SysOpLog('^3Error uploading '+SQOutSp(FileName)+ + ' - '+AOnOff(FIResumeLater IN FileInfo.FIFlags,'file saved for later resume','file deleted')); + END; + + Star('Removing time refund of '+FormattedTime(RefundTime)); + + Dec(FreeTime,RefundTime); + END; + + IF (OffLine) THEN + BEGIN + FileInfo.FileSize := 0; + UpdateFileInfo(FileInfo,FileName,GotPts); + Include(FileInfo.FIFlags,FIIsRequest); + WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray); + END; + + Close(FileInfoFile); + Close(ExtInfoFile); + + FileArea := SaveFileArea; + InitFileArea(FileArea); + + SaveURec(ThisUser,UserNum); +END; + +PROCEDURE UploadFile; +VAR + FileName: Str12; + AddULBatch: Boolean; +BEGIN + InitFileArea(FileArea); + IF (BadUploadPath) THEN + Exit; + IF (NOT AACS(MemFileArea.ULACS)) THEN + BEGIN + NL; + Star('Your access level does not permit uploading to this file area.'); + Exit; + END; + PrintF('UPLOAD'); + IF (NumBatchULFiles > 0) THEN + BEGIN + NL; + IF PYNQ('Upload queued files? ',0,FALSE) THEN + BEGIN + BatchUpload(FALSE,0); + Exit; + END; + END; + REPEAT + AddULBatch := FALSE; + { + NL; + Print(FString.UploadLine); + NL; + Prt('File name: '); + } + lRGLngStr(24,FALSE); + MPL(12); + Input(FileName,12); + FileName := SQOutSp(FileName); + IF (FileName = '') THEN + BEGIN + NL; + Print('Aborted.'); + END + ELSE + BEGIN + IF (NOT FileSysOp) THEN + UL(FileName,FALSE,AddULBatch) + ELSE + BEGIN + IF (NOT IsWildCard(FileName)) THEN + UL(FileName,FALSE,AddULBatch) + ELSE + BEGIN + FindFirst(MemFileArea.ULPath+FileName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo); + IF (DOSError <> 0) THEN + BEGIN + NL; + Print('No files found.'); + END + ELSE + REPEAT + UL(DirInfo.Name,TRUE,AddULBatch); + FindNext(DirInfo); + UNTIL (DOSError <> 0) OR (Abort) OR (HangUp); + END; + END; + END; + UNTIL (NOT AddUlBatch) OR (HangUp); +END; + +PROCEDURE LFileAreaList(VAR FArea,NumFAreas: Integer; AdjPageLen: Byte; ShowScan: Boolean); +VAR + ScanChar: Str1; + TempStr: AStr; + NumOnline, + NumDone: Byte; + SaveFileArea: Integer; +BEGIN + SaveFileArea := FileArea; + Abort := FALSE; + Next := FALSE; + NumOnline := 0; + TempStr := ''; + + FillChar(LightBarArray,SizeOf(LightBarArray),0); + LightBarCounter := 0; + + { + $New_Scan_Char_File + � + $ + } + IF (ShowScan) THEN + ScanChar := lRGLngStr(55,TRUE); + { + %CL-旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + -�. Num -�/ Name -�. Num -�/ Name -� + -읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + } + lRGLngStr(59,FALSE); + Reset(FileAreaFile); + NumDone := 0; + WHILE (NumDone < (PageLength - AdjPageLen)) AND (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadFileArea(FArea); + IF (ShowScan) THEN + LoadNewScanFile(NewScanFileArea); + IF AACS(MemFileArea.ACS) OR (FAUnHidden IN MemFileArea.FAFlags) THEN + BEGIN + + IF (General.UseFileAreaLightBar) AND (FileAreaLightBar IN ThisUser.SFlags) THEN + BEGIN + Inc(LightBarCounter); + LightBarArray[LightBarCounter].CmdToExec := CompFileArea(FArea,0); + LightBarArray[LightBarCounter].CmdToShow := MemFileArea.AreaName; + 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 NewScanFileArea,'0'+ScanChar[1],' ')+ + PadLeftStr(PadRightStr('1'+IntToStr(CompFileArea(FArea,0)),5)+ + +'2 '+MemFileArea.AreaName,37)+' '; + Inc(NumOnline); + IF (NumOnLine = 2) THEN + BEGIN + PrintACR(TempStr); + NumOnline := 0; + Inc(NumDone); + TempStr := ''; + END; + Inc(NumFAreas); + END; + WKey; + Inc(FArea); + END; + Close(FileAreaFile); + LastError := IOResult; + IF (NumOnline = 1) AND (NOT Abort) AND (NOT HangUp) THEN + PrintACR(TempStr) + ELSE IF (NumFAreas = 0) AND (NOT Abort) AND (NOT HangUp) THEN + LRGLngStr(67,FALSE); + { + %LF^7No file areas!^1 + } + FileArea := SaveFileArea; + LoadFileArea(FileArea); +END; + +PROCEDURE UnlistedDownload(FileName: AStr); +VAR + User: UserRecordType; + TransferFlags: TransferFlagSet; + DS: DirStr; + NS: NameStr; + ES: ExtStr; + SaveFileArea: Integer; +BEGIN + IF (FileName <> '') THEN + IF (NOT Exist(FileName)) THEN + BEGIN + NL; + Print('File not found.'); + END + ELSE + BEGIN + SaveFileArea := FileArea; + FileArea := -1; + Abort := FALSE; + Next := FALSE; + LoadURec(User,1); + FSplit(FileName,DS,NS,ES); + FindFirst(SQOutSp(FileName),AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo); + WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + WITH MemFileArea DO + BEGIN + AreaName := 'Unlisted Download'; + DLPath := DS; + ULPath := DS; + FAFlags := [FANoRatio]; + END; + WITH FileInfo DO + BEGIN + FileName := Align(DirInfo.Name); + Description := 'Unlisted Download'; + FilePoints := 0; + Downloaded := 0; + FileSize := DirInfo.Size; + OwnerNum := 1; + OwnerName := Caps(User.Name); + FileDate := Date2PD(DateStr); + VPointer := -1; + VTextSize := 0; + FIFlags := []; + END; + TransferFlags := [IsUnlisted]; + IF (InCom) THEN + BEGIN + NL; + IF (PYNQ('Is this file located on a CDRom? ',0,FALSE)) THEN + Include(MemFileArea.FAFlags,FACDROm); + END; + DLX(FileInfo,-1,TransferFlags); + IF (IsKeyboardAbort IN Transferflags) THEN + Abort := TRUE; + FindNext(DirInfo); + END; + FileArea := SaveFileArea; + LoadFileArea(FileArea); + END; +END; + +PROCEDURE Do_Unlisted_Download; +VAR + PathFileName: Str52; +BEGIN + NL; + Print('Enter file name to download (d:path\filename.ext)'); + Prt(': '); + MPL(52); + Input(PathFileName,52); + IF (PathFileName = '') THEN + BEGIN + NL; + Print('Aborted.'); + END + ELSE IF (NOT IsUL(PathFileName)) THEN + BEGIN + NL; + Print('You must specify the complete path to the file.'); + END + ELSE + UnlistedDownload(PathFileName) +END; + +END. diff --git a/SOURCE/FILE10.PAS b/SOURCE/FILE10.PAS new file mode 100644 index 0000000..5aa873c --- /dev/null +++ b/SOURCE/FILE10.PAS @@ -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^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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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. diff --git a/SOURCE/FILE11.PAS b/SOURCE/FILE11.PAS new file mode 100644 index 0000000..700704f --- /dev/null +++ b/SOURCE/FILE11.PAS @@ -0,0 +1,1249 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT File11; + +INTERFACE + +USES + Common; + +TYPE + FileRecType = RECORD + FArrayFileArea, + FArrayDirFileRecNum: SmallInt; + END; + + FileArrayType = ARRAY [0..99] OF FileRecType; + +VAR + FArray: FileArrayType; + +FUNCTION CanSee(CONST FileInfo: FileInfoRecordType): Boolean; +FUNCTION GetFileStats(FileInfo: FileInfoRecordType): AStr; +PROCEDURE InitFArray(VAR F: FileArrayType); +PROCEDURE DisplayFileAreaHeader; +PROCEDURE lDisplay_File(FileInfo: FileInfoRecordType; FArrayRecNum: Byte; SearchString: Str20; + NormalPause: Boolean); +PROCEDURE SearchFileSpec; +PROCEDURE ListFileSpec(FName: Str12); +PROCEDURE SearchFileDescriptions; +PROCEDURE GlobalNewFileScan(VAR FArrayRecNum: Byte); +PROCEDURE NewFilesScanSearchType(CONST MenuOption: Str50); +PROCEDURE FileAreaChange(VAR Done: Boolean; CONST MenuOption: Str50); +PROCEDURE CreateTempDir; + +IMPLEMENTATION + +USES + Dos, + Crt, + ArcView, + Common5, + File0, + File1, + File10, + Menus, + TimeFunc; + +TYPE + DownLoadArrayType = ARRAY [0..99] OF SmallInt; + +VAR + DLArray: DownloadArrayType; + Lines, + FileRedisplayLines: Byte; + +PROCEDURE InitFArray(VAR F: FileArrayType); +VAR + Counter: Byte; +BEGIN + FOR Counter := 0 TO 99 DO + WITH F[Counter] DO + BEGIN + FArrayFileArea := -1; + FArrayDirFileRecNum := -1; + END; +END; + +FUNCTION GetDlArray(VAR DLArray: DownLoadArrayType; CmdLen: Byte): Boolean; +VAR + s, + s1, + s2: Str160; + Counter, + Counter1, + Counter2, + Counter3: Byte; + Ok: Boolean; +BEGIN + Ok := TRUE; + FOR Counter := 1 TO (((LennMCI(MemMenu.MenuPrompt) + CmdLen) + 1)) DO + BackSpace; + FOR Counter := 0 TO 99 DO + DLArray[Counter] := -1; + Prt('Enter file number or range (##,##-##): '); + s := ''; + MPL(20); + InputMain(s,20,[NoLineFeed]); + IF (SqOutSp(S) = '') THEN + OK := FALSE + ELSE + BEGIN + FOR Counter := 1 TO Length(S) DO + IF (NOT (S[Counter] IN ['0'..'9','-'])) THEN + Ok := FALSE; + IF (S = '-') OR (S[1] = '-') OR (S[Length(s)] = '-') THEN + OK := FALSE; + IF (Ok) THEN + BEGIN + NL; + s1 := ''; + s2 := ''; + Counter1 := 0; + FOR Counter := 1 TO Length(s) DO + BEGIN + IF s[Counter] IN ['0'..'9'] THEN + s1 := s1 + s[Counter] + ELSE + BEGIN + IF (s[Counter] = '-') THEN + BEGIN + s2 := ''; + FOR Counter2 := (Counter + 1) TO Length(s) DO + BEGIN + IF (s[counter2] IN ['0'..'9']) THEN + s2 := s2 + s[counter2] + ELSE + BEGIN + IF (s1 <> '') AND (StrToInt(s1) >= 0) AND (StrToInt(s1) <= 99) AND + (S2 <> '') AND (StrToInt(s2) >= 0) AND (StrToInt(s2) <= 99) THEN + FOR Counter3 := StrToInt(s1) TO StrToInt(s2) DO + BEGIN + DLArray[Counter1] := Counter3; + Inc(Counter1); + END; + s1 := ''; + Counter := Counter + Length(s2); + s2 := ''; + Counter2 := Length(s); + END; + END; + Counter := Counter + Length(s2); + END + ELSE IF (StrToInt(s1) >= 0) AND (StrToInt(s1) <= 99) THEN + BEGIN + DLArray[Counter1] := StrToInt(s1); + Inc(Counter1); + s1 := ''; + s2 := ''; + END; + END; + END; + IF (Length(s1) <> 0) AND (StrToInt(s1) >= 0) AND (StrToInt(s1) <= 99) THEN + DLArray[Counter1] := StrToInt(s1); + IF (s1 <> '') AND (StrToInt(s1) >= 0) AND (StrToInt(s1) <= 99) AND + (S2 <> '') AND (StrToInt(s2) >= 0) AND (StrToInt(s2) <= 99) THEN + FOR Counter3 := StrToInt(s1) TO StrToInt(s2) DO + BEGIN + DLArray[Counter1] := Counter3; + Inc(Counter1) + END; + END; + END; + IF (NOT OK) THEN + BEGIN + FOR Counter := 1 TO 20 DO + OutKey(' '); + UserColor(1); + FOR Counter := 1 TO (LennMCI(MemMenu.MenuPrompt) + 21) DO + BackSpace; + END; + + GetDLArray := OK; +END; + +PROCEDURE Pause_Files; +VAR + TransferFlags: TransferFlagSet; + CmdStr, + NewMenuCmd: AStr; + SaveLastDirFileName: Str12; + Cmd: Char; + SaveMenu, + Counter, + CmdToExec: Byte; + Counter1, + SaveFileArea, + SaveLastDirFileRecNum: Integer; + Done, + CmdNotHid, + CmdExists, + FO: Boolean; +BEGIN + LIL := 0; + IF (Lines < PageLength) OR (HangUp) THEN + Exit; + Lines := 0; + FileRedisplayLines := 0; + FileAreaNameDisplayed := FALSE; + + SaveMenu := CurMenu; + CurMenu := General.FileListingMenu; + IF (NOT NewMenuToLoad) THEN + LoadMenuPW; + AutoExecCmd('FIRSTCMD'); + REPEAT + MainMenuHandle(CmdStr); + NewMenuCmd := ''; + CmdToExec := 0; + TFilePrompt := 0; + Done := FALSE; + REPEAT + FCmd(CmdStr,CmdToExec,CmdExists,CmdNotHid); + IF (CmdToExec <> 0) AND (MemCmd^[CmdToExec].CmdKeys <> '-^') AND + (MemCmd^[CmdToExec].CmdKeys <> '-/') AND (MemCmd^[CmdToExec].CmdKeys <> '-\') THEN + BEGIN + IF (CmdStr <> '') AND (CmdStr <> 'ENTER') AND (MemCmd^[CmdToExec].CmdKeys <> 'L5') AND + (MemCmd^[CmdToExec].CmdKeys <> 'L6') AND (MemCmd^[CmdToExec].CmdKeys <> 'L7') AND + (MemCmd^[CmdToExec].CmdKeys <> 'L8') THEN + NL; + DoMenuCommand(Done, + MemCmd^[CmdToExec].CmdKeys, + MemCmd^[CmdToExec].Options, + NewMenuCmd, + MemCmd^[CmdToExec].NodeActivityDesc); + END; + UNTIL (CmdToExec = 0) OR (Done) OR (HangUp); + Abort := FALSE; + Next := FALSE; + CASE TFilePrompt OF + 1 : ; + 2 : BEGIN + Print('%LFListing aborted.'); + Abort := TRUE; + END; + 3 : BEGIN + Print('%LFFile area skipped.'); + Next := TRUE; + END; + 4 : BEGIN + Print('%LF^5'+MemFileArea.AreaName+'^3 '+AOnOff(NewScanFileArea,'will NOT','WILL')+ + ' be scanned.'); + LoadNewScanFile(NewScanFileArea); + NewScanFileArea := (NOT NewScanFileArea); + SaveNewScanFile(NewScanFileArea); + END; + 5 : BEGIN + IF GetDLArray(DLArray,Length(CmdStr)) THEN + IF (DLInTime) THEN + IF (NOT BatchDLQueuedFiles([])) THEN + BEGIN + Counter := 0; + WHILE (Counter <= 99) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (DLArray[Counter] <> -1) THEN + IF (FArray[DLArray[Counter]].FArrayDirFileRecNum = -1) THEN + Print('%LF^7Invalid file number selected: "^9'+IntToStr(DLArray[Counter])+'^7".') + ELSE + BEGIN + SaveLastDirFileRecNum := LastDIRRecNum; + SaveLastDirFileName := LastDIRFileName; + FO := (FileRec(FileInfoFile).Mode <> FMClosed); + IF (FO) THEN + BEGIN + Close(FileInfoFile); + Close(ExtInfoFile); + END; + SaveFileArea := FileArea; + FileArea := FArray[DLArray[Counter]].FArrayFileArea; + InitFileArea(FileArea); + Seek(FileInfoFile,FArray[DLArray[Counter]].FArrayDirFileRecNum); + Read(FileInfoFile,FileInfo); + TransferFlags := [IsCheckRatio]; + DLX(FileInfo,FArray[DLArray[Counter]].FArrayDirFileRecNum,TransferFlags); + IF (IsKeyboardAbort IN TransferFlags) THEN + Abort := TRUE; + Close(FileInfoFile); + Close(ExtInfoFile); + FileArea := SaveFileArea; + IF (FO) THEN + InitFileArea(FileArea); + LastDIRRecNum := SaveLastDirFileRecNum; + LastDIRFileName := SaveLastDirFileName; + END; + Inc(Counter); + END; + IF (Abort) THEN + Abort := FALSE; + NL; + END; + END; + 6 : BEGIN + IF GetDLArray(DLArray,Length(CmdStr)) THEN + IF (DLInTime) THEN + BEGIN + Counter := 0; + WHILE (Counter <= 99) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (DLArray[Counter] <> -1) THEN + IF (FArray[DLArray[Counter]].FArrayDirFileRecNum = -1) THEN + Print('%LF^7Invalid file number selected: "^9'+IntToStr(DLArray[Counter])+'^7".') + ELSE + BEGIN + SaveLastDirFileRecNum := LastDIRRecNum; + SaveLastDirFileName := LastDIRFileName; + FO := (FileRec(FileInfoFile).Mode <> FMClosed); + IF (FO) THEN + BEGIN + Close(FileInfoFile); + Close(ExtInfoFile); + END; + SaveFileArea := FileArea; + FileArea := FArray[DLArray[Counter]].FArrayFileArea; + InitFileArea(FileArea); + Seek(FileInfoFile,FArray[DLArray[Counter]].FArrayDirFileRecNum); + Read(FileInfoFile,FileInfo); + TransferFlags := [IsCheckRatio,lIsAddDLBatch]; + DLX(FileInfo,FArray[DLArray[Counter]].FArrayDirFileRecNum,TransferFlags); + IF (IsKeyboardAbort IN TransferFlags) THEN + Abort := TRUE; + Close(FileInfoFile); + Close(ExtInfoFile); + FileArea := SaveFileArea; + IF (FO) THEN + InitFileArea(FileArea); + LastDIRRecNum := SaveLastDirFileRecNum; + LastDIRFileName := SaveLastDirFileName; + END; + Inc(Counter); + END; + IF (Abort) THEN + Abort := FALSE; + NL; + END; + END; + 7 : BEGIN + IF GetDLArray(DLArray,Length(CmdStr)) THEN + BEGIN + Counter := 0; + WHILE (Counter <= 99) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (DLArray[Counter] <> -1) THEN + IF (FArray[DLArray[Counter]].FArrayDirFileRecNum = -1) THEN + Print('%LF^7Invalid file number selected: "^9'+IntToStr(DLArray[Counter])+'^7".') + ELSE + BEGIN + SaveLastDirFileRecNum := LastDIRRecNum; + SaveLastDirFileName := LastDIRFileName; + FO := (FileRec(FileInfoFile).Mode <> FMClosed); + IF (FO) THEN + BEGIN + Close(FileInfoFile); + Close(ExtInfoFile); + END; + SaveFileArea := FileArea; + FileArea := FArray[DLArray[Counter]].FArrayFileArea; + InitFileArea(FileArea); + Seek(FileInfoFile,FArray[DLArray[Counter]].FArrayDirFileRecNum); + Read(FileInfoFile,FileInfo); + IF (NOT ValidIntArcType(FileInfo.FileName)) THEN + Print('%LF'+SQOutSp(FileInfo.FileName)+' is not a valid archive type or not supported.') + ELSE + BEGIN + IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN + ViewInternalArchive(MemFileArea.DLPath+SQOutSp(FileInfo.FileName)) + ELSE IF Exist(MemFileArea.ULPath+FileInfo.FileName) THEN + ViewInternalArchive(MemFileArea.ULPath+SQOutSp(FileInfo.FileName)); + END; + Close(FileInfoFile); + Close(ExtInfoFile); + FileArea := SaveFileArea; + IF (FO) THEN + InitFileArea(FileArea); + LastDIRRecNum := SaveLastDirFileRecNum; + LastDIRFileName := SaveLastDirFileName; + END; + Inc(Counter); + END; + IF (Abort) THEN + Abort := FALSE; + NL; + END; + END; + 8 : IF (NOT FileSysop) THEN + BEGIN + NL; + Print('%LFYou do not have the required access level for this option.'); + NL; + END + ELSE + BEGIN + IF GetDLArray(DLArray,Length(CmdStr)) THEN + BEGIN + Counter := 0; + WHILE (Counter <= 99) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (DLArray[Counter] <> -1) THEN + IF (FArray[DLArray[Counter]].FArrayDirFileRecNum = -1) THEN + Print('%LF^7Invalid file number selected: "^9'+IntToStr(DLArray[Counter])+'^7".') + ELSE + BEGIN + SaveLastDirFileRecNum := LastDIRRecNum; + SaveLastDirFileName := LastDIRFileName; + FO := (FileRec(FileInfoFile).Mode <> FMClosed); + IF (FO) THEN + BEGIN + Close(FileInfoFile); + Close(ExtInfoFile); + END; + SaveFileArea := FileArea; + FileArea := FArray[DLArray[Counter]].FArrayFileArea; + InitFileArea(FileArea); + Seek(FileInfoFile,FArray[DLArray[Counter]].FArrayDirFileRecNum); + Read(FileInfoFile,FileInfo); + EditFile(FArray[DLArray[Counter]].FArrayDirFileRecNum,Cmd,FALSE,FALSE); + IF (Cmd = 'Q') THEN + Abort := TRUE + ELSE IF (Cmd = 'P') THEN + BEGIN + Counter1 := Counter; + IF (Counter1 > 0) THEN + BEGIN + IF (DLArray[Counter1] <> -1) THEN + IF (FArray[DLArray[Counter1]].FArrayDirFileRecNum <> -1) THEN + Counter := (Counter1 - 1); + Dec(Counter1); + END; + Dec(Counter); + END; + Close(FileInfoFile); + Close(ExtInfoFile); + FileArea := SaveFileArea; + IF (FO) THEN + InitFileArea(FileArea); + LastDIRRecNum := SaveLastDirFileRecNum; + LastDIRFileName := SaveLastDirFileName; + END; + Inc(Counter); + END; + IF (Abort) THEN + Abort := FALSE; + IF (Next) THEN + Next := FALSE; + IF (Cmd <> 'Q') THEN + NL; + END; + END; + END; + UNTIL (TFilePrompt = 1) OR (Abort) OR (Next) OR (HangUp); + IF (TFilePrompt = 1) AND (NOT Abort) AND (NOT Next) AND (NOT HangUp) THEN + NL; + CurMenu := SaveMenu; + NewMenuToLoad := TRUE; +END; + +FUNCTION CanSee(CONST FileInfo: FileInfoRecordType): Boolean; +BEGIN + CanSee := (NOT (FINotVal IN FileInfo.FIFlags)) OR (UserNum = FileInfo.OwnerNum) OR (AACS(General.SeeUnVal)); +END; + +PROCEDURE Output_File_Stuff(CONST s: AStr); +BEGIN + IF (TextRec(NewFilesF).Mode = FMOutPut)THEN + BEGIN + WriteLn(NewFilesF,StripColor(s)); + Lines := 0; + END + ELSE + PrintACR(s+'^1'); +END; + +PROCEDURE DisplayFileAreaHeader; +BEGIN + IF (FileAreaNameDisplayed) THEN + Exit; + Lil := 0; + Lines := 0; + FileRedisplayLines := 0; + (* + CLS; + IF (NOT General.FileCreditRatio) THEN + BEGIN + Output_File_Stuff(' 旼컫컴컴컴컴컴컴쩡컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + Output_File_Stuff(' � ## � File Name  � Size  � Description '+PadLeftStr(s,34)+'  �'); + Output_File_Stuff(' 읕컨컴컴컴컴컴컴좔컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + END + ELSE + BEGIN + Output_File_Stuff(' 旼컫컴컴컴컴컴컴쩡컴쩡컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + Output_File_Stuff(' � ## � �File Name  �Pts � Size  � Description '+PadLeftStr(s,34)+'  �'); + Output_File_Stuff(' 읕컨컴컴컴컴컴컴좔컴좔컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + END; + *) + + IF (NOT General.FileCreditRatio) THEN + lRGLngStr(63,FALSE) + ELSE + lRGLngStr(64,FALSE); + Inc(Lines,LIL); + Inc(FileRedisplayLines,LIL); + + FileAreaNameDisplayed := TRUE; +END; + +FUNCTION GetFileStats(FileInfo: FileInfoRecordType): AStr; +BEGIN + IF (FIIsRequest IN FileInfo.FIFlags) THEN + GetFileStats := ' Offline' + ELSE IF (FIResumeLater IN FileInfo.FIFlags) THEN + GetFileStats := ' ResLatr' + ELSE IF (FINotVal IN FileInfo.FIFlags) THEN + GetFileStats := ' Unvalid' + ELSE IF (NOT General.FileCreditRatio) THEN + GetFileStats := ''+PadRightStr(ConvertBytes(FileInfo.FileSize,TRUE),10) + ELSE + GetFileStats := ''+PadRightInt(FileInfo.FilePoints,3)+' '+PadRightStr(ConvertKB(FileInfo.FileSize DIV 1024,TRUE),6); +END; + +PROCEDURE lDisplay_File(FileInfo: FileInfoRecordType; FArrayRecNum: Byte; SearchString: Str20; + NormalPause: Boolean); +VAR + TempStr, + TempStr1, + TempStr2: AStr; + LineNum, + NumExtDesc: Byte; + + FUNCTION SubStone(SrcStr,OldStr,NewStr: AStr; IsCaps: Boolean): AStr; + VAR + StrPos: Byte; + BEGIN + IF (OldStr <> '') THEN + BEGIN + IF (IsCaps) THEN + NewStr := AllCaps(NewStr); + StrPos := Pos(AllCaps(OldStr),AllCaps(SrcStr)); + IF (StrPos > 0) THEN + BEGIN + Insert(NewStr,SrcStr,(StrPos + Length(OldStr))); + Delete(SrcStr,StrPos,Length(OldStr)); + END; + END; + SubStone := SrcStr; + END; + +BEGIN + TempStr := AOnOff(DayNum(PD2Date(FileInfo.FileDate)) >= DayNum(PD2Date(NewFileDate)),'*',' ')+ + ''+PadRightInt(FArrayRecNum,2); + + TempStr1 := FileInfo.FileName; + IF (SearchString <> '') THEN + TempStr1 := SubStone(TempStr1,SearchString,''+AllCaps(SearchString)+'',TRUE); + TempStr := TempStr + ' '+TempStr1+' '+GetFileStats(FileInfo)+''; + + TempStr2 := TempStr; + + TempStr1 := FileInfo.Description; + IF (SearchString <> '') THEN + TempStr1 := SubStone(TempStr1,SearchString,''+AllCaps(SearchString)+'',TRUE); + IF (LennMCI(TempStr1) > 50) THEN + TempStr1 := Copy(TempStr1,1,Length(TempStr1) - (LennMCI(TempStr1) - 50)); + TempStr := TempStr + ' '+TempStr1; + + + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + DisplayFileAreaHeader; + + Inc(Lines); + + IF (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Output_File_Stuff(TempStr); + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Pause_Files; + + IF (FileInfo.VPointer <> -1) THEN + BEGIN + LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc); + LineNum := 1; + WHILE (LineNum <= NumExtDesc) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + TempStr1 := ExtendedArray[LineNum]; + IF (SearchString <> '') THEN + TempStr1 := SubStone(TempStr1,SearchString,''+AllCaps(SearchString)+'',TRUE); + + IF (Lines = FileRedisplayLines) THEN + TempStr := TempStr2 + ' '+TempStr1+'' + ELSE + TempStr := PadLeftStr('',28)+''+TempStr1+''; + + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + DisplayFileAreaHeader; + + Inc(Lines); + + IF (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Output_File_Stuff(TempStr); + + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Pause_Files; + Inc(LineNum); + END; + END; + + TempStr := ''; + IF (FAShowName IN MemFileArea.FAFlags) THEN + IF (Lines = FileRedisplayLines) THEN + TempStr := TempStr2 + ' Uploaded by '+Caps(FileInfo.OwnerName) + ELSE + TempStr := TempStr + PadLeftStr('',28)+'Uploaded by '+Caps(FileInfo.OwnerName); + + IF (FAShowDate IN MemFileArea.FAFlags) THEN + BEGIN + IF (TempStr = '') THEN + IF (Lines = FileRedisplayLines) THEN + TempStr := TempStr2 + ' Uploaded' + ELSE + TempStr := PadLeftStr('',28)+'Uploaded'; + TempStr := TempStr +' on '+PD2Date(FileInfo.FileDate); + IF (Length(TempStr) > 78) THEN + TempStr := Copy(TempStr,1,78); + END; + + IF (FAShowName IN MemFileArea.FAFlags) OR (FAShowDate IN MemFileArea.FAFlags) THEN + BEGIN + + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + DisplayFileAreaHeader; + + Inc(Lines); + + IF (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Output_File_Stuff(TempStr); + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Pause_Files; + END; + + IF (FIResumeLater IN FileInfo.FIFlags) AND (FileInfo.OwnerNum = UserNum) AND NOT (TextRec(NewFilesF).Mode = FMOutPut) THEN + BEGIN + IF (Lines = FileRedisplayLines) THEN + TempStr := TempStr2 + ' ^8>^7'+'>> ^3'+'You ^5'+'MUST RESUME^3'+' this file to receive credit' + ELSE + TempStr := PadLeftStr('',28)+'^8>^7'+'>> ^3'+'You ^5'+'MUST RESUME^3'+' this file to receive credit'; + + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + DisplayFileAreaHeader; + + Inc(Lines); + + IF (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Output_File_Stuff(TempStr); + IF (NOT NormalPause) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) THEN + Pause_Files; + END; +END; + +PROCEDURE SearchFileAreaSpec(FArea: Integer; FName: Str12; VAR FArrayRecNum: Byte); +VAR + DirFileRecNum: Integer; + Found: Boolean; +BEGIN + IF (FileArea <> FArea) THEN + ChangeFileArea(FArea); + IF (FileArea = FArea) THEN + BEGIN + RecNo(FileInfo,FName,DirFileRecNum); + IF (BadDownloadPath) THEN + Exit; + Found := FALSE; + LIL := 0; + CLS; + 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 (CanSee(FileInfo)) THEN + BEGIN + + WITH FArray[FArrayRecNum] DO + BEGIN + FArrayFileArea := FileArea; + FArrayDirFileRecNum := DirFileRecNum; + END; + + DisplayFileAreaHeader; + lDisplay_File(FileInfo,FArrayRecNum,'',FALSE); + + Inc(FArrayRecNum); + IF (FArrayRecNum = 100) THEN + FArrayRecNum := 0; + + Found := TRUE; + END; + NRecNo(FileInfo,DirFileRecNum); + IF (DirFileRecNum = -1) AND (Found) AND (Lines > FileRedisplayLines) AND (NOT Abort) AND (NOT HangUp) THEN + BEGIN + Lines := PageLength; + Pause_Files; + END; + END; + IF (NOT Found) THEN + BEGIN + LIL := 0; + BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FArea,0)))); + END; + Close(FileInfoFile); + Close(ExtInfoFile); + END; +END; + +PROCEDURE SearchFileSpec; +VAR + FName: Str12; + FArrayRecNum: Byte; + FArea, + SaveFileArea: Integer; + SaveConfSystem: Boolean; +BEGIN + NL; + { Print(FString.SearchLine); } + lRGLngStr(20,FALSE); + { Print(FString.lGFNLine1); } + lRGLngStr(28,FALSE); + { Prt(FString.GFNLine2); } + lRGLngStr(29,FALSE); + FName := ''; + GetFileName(FName); + IF (FName = '') THEN + BEGIN + Print('%LFAborted.'); + Exit; + END; + SaveFileArea := FileArea; + Abort := FALSE; + Next := FALSE; + InitFArray(FArray); + FArrayRecNum := 0; + SaveConfSystem := ConfSystem; + ConfSystem := NOT PYNQ('%LFSearch all conferences? ',0,TRUE); + IF (ConfSystem <> SaveConfSystem) THEN + NewCompTables; + FArea := 1; + WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + SearchFileAreaSpec(FArea,FName,FArrayRecNum); + WKey; + Inc(FArea); + END; + IF (ConfSystem <> SaveConfSystem) THEN + BEGIN + ConfSystem := SaveConfSystem; + NewCompTables; + END; + FileArea := SaveFileArea; + LoadFileArea(FileArea); +END; + +PROCEDURE ListFileSpec(FName: Str12); +VAR + FArrayRecNum: Byte; +BEGIN + Abort := FALSE; + Next := FALSE; + InitFArray(FArray); + FArrayRecNum := 0; + IF (FName = '') THEN + BEGIN + NL; + { Print(FString.ListLine); } + lRGLngStr(18,FALSE); + { Print(FString.lGFNLine1); } + lRGLngStr(28,FALSE); + { Prt(FString.GFNLine2); } + lRGLngStr(29,FALSE); + GetFileName(FName); + END + ELSE + FName := Align(FName); + SearchFileAreaSpec(FileArea,FName,FArrayRecNum); +END; + +PROCEDURE SearchFileAreaDescription(FArea: Integer; SearchString: Str20; VAR FArrayRecNum: Byte); +VAR + LineNum, + NumExtDesc: Byte; + DirFileRecNum: Integer; + SearchStringFound, + Found: Boolean; +BEGIN + IF (FileArea <> FArea) THEN + ChangeFileArea(FArea); + IF (FileArea = FArea) THEN + BEGIN + RecNo(FileInfo,'*.*',DirFileRecNum); + IF (BadDownloadPath) THEN + Exit; + Found := FALSE; + LIL := 0; + CLS; + 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 (CanSee(FileInfo)) THEN + BEGIN + SearchStringFound := ((Pos(SearchString,AllCaps(FileInfo.Description)) <> 0) OR + (Pos(SearchString,AllCaps(FileInfo.FileName)) <> 0)); + IF (NOT SearchStringFound) AND (FileInfo.VPointer <> -1) THEN + BEGIN + LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc); + LineNum := 1; + WHILE (LineNum <= NumExtDesc) AND (NOT SearchStringFound) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (Pos(SearchString,AllCaps(ExtendedArray[LineNum])) <> 0) THEN + SearchStringFound := TRUE; + Inc(LineNum); + END; + END; + IF (SearchStringFound) THEN + BEGIN + + WITH FArray[FArrayRecNum] DO + BEGIN + FArrayFileArea := FileArea; + FArrayDirFileRecNum := DirFileRecNum; + END; + + DisplayFileAreaHeader; + + lDisplay_File(FileInfo,FArrayRecNum,SearchString,FALSE); + + Inc(FArrayRecNum); + IF (FArrayRecNum = 100) THEN + FArrayRecNum := 0; + + Found := TRUE; + END; + END; + NRecNo(FileInfo,DirFileRecNum); + IF (DirFileRecNum = -1) AND (Found) AND (Lines > FileRedisplayLines) AND (NOT Abort) AND (NOT HangUp) THEN + BEGIN + Lines := PageLength; + Pause_Files; + END; + END; + IF (NOT Found) THEN + BEGIN + LIL := 0; + BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FArea,0)))); + END; + Close(FileInfoFile); + Close(ExtInfoFile); + END; +END; + +PROCEDURE SearchFileDescriptions; +VAR + SearchString: Str20; + FArrayRecNum: Byte; + FArea, + SaveFileArea: Integer; + SaveConfSystem: Boolean; +BEGIN + NL; + { Print(FString.FindLine1); } + lRGLngStr(21,FALSE); + NL; + { Print(FString.FindLine2); } + lRGLngStr(22,FALSE); + Prt(': '); + MPL(20); + Input(SearchString,20); + IF (SearchString = '') THEN + BEGIN + Print('%LFAborted.'); + Exit; + END; + Abort := FALSE; + Next := FALSE; + InitFArray(FArray); + FArrayRecNum := 0; + Print('%LFSearching for "'+SearchString+'"'); + IF (NOT PYNQ('%LFSearch all file areas? ',0,FALSE)) THEN + SearchFileAreaDescription(FileArea,SearchString,FArrayRecNum) + ELSE + BEGIN + SaveFileArea := FileArea; + SaveConfSystem := ConfSystem; + ConfSystem := NOT PYNQ('%LFSearch all conferences? ',0,TRUE); + IF (ConfSystem <> SaveConfSystem) THEN + NewCompTables; + FArea := 1; + WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + SearchFileAreaDescription(FArea,SearchString,FArrayRecNum); + WKey; + Inc(FArea); + END; + IF (ConfSystem <> SaveConfSystem) THEN + BEGIN + ConfSystem := SaveConfSystem; + NewCompTables; + END; + FileArea := SaveFileArea; + LoadFileArea(FileArea); + END; +END; + +PROCEDURE NewFileScan(FArea: Integer; Global: Boolean; VAR FArrayRecNum: Byte); +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 (NOT Global) OR (NewScanFileArea) THEN + BEGIN + Found := FALSE; + LIL := 0; + CLS; + 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 ((CanSee(FileInfo)) AND (DayNum(PD2Date(FileInfo.FileDate)) >= DayNum(PD2Date(NewFileDate)))) + OR (CanSee(FileInfo) AND (FINotVal IN FileInfo.FIFlags)) THEN + BEGIN + + WITH FArray[FArrayRecNum] DO + BEGIN + FArrayFileArea := FileArea; + FArrayDirFileRecNum := DirFileRecNum; + END; + + DisplayFileAreaHeader; + lDisplay_File(FileInfo,FArrayRecNum,'',FALSE); + + Inc(FArrayRecNum); + IF (FArrayRecNum = 100) THEN + FArrayRecNum := 0; + + Found := TRUE; + END; + NRecNo(FileInfo,DirFileRecNum); + IF (DirFileRecNum = -1) AND (Found) AND (Lines > FileRedisplayLines) AND (NOT Abort) AND (NOT HangUp) THEN + BEGIN + Lines := PageLength; + Pause_Files; + END; + END; + IF (NOT Found) THEN + BEGIN + LIL := 0; + BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FArea,0)))); + END; + END; + Close(FileInfoFile); + Close(ExtInfoFile); + END; +END; + +PROCEDURE GlobalNewFileScan(VAR FArrayRecNum: Byte); +VAR + FArea: Integer; +BEGIN + FArea := 1; + WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + NewFileScan(FArea,TRUE,FArrayRecNum); + IF (TextRec(NewFilesF).Mode = FMOutPut) THEN + Output_File_Stuff(''); + WKey; + Inc(FArea); + END; +END; + +PROCEDURE NewFilesScanSearchType(CONST MenuOption: Str50); +VAR + FArrayRecNum: Byte; + SaveFileArea: Integer; +BEGIN + SaveFileArea := FileArea; + Abort := FALSE; + Next := FALSE; + InitFArray(FArray); + FArrayRecNum := 0; + IF (UpCase(MenuOption[1]) = 'C') THEN + NewFileScan(FileArea,FALSE,FArrayRecNum) + ELSE IF (UpCase(MenuOption[1]) = 'G') THEN + GlobalNewFileScan(FArrayRecNum) + ELSE IF (StrToInt(MenuOption) <> 0) THEN + NewFileScan(StrToInt(MenuOption),FALSE,FArrayRecNum) + ELSE + BEGIN + { + NL; + Print('|03List Files - |11P |03to Pause'); + NL; + } + lRGLngStr(19,FALSE); + + IF PYNQ('%LFSearch all file areas? ',0,FALSE) THEN + GlobalNewFileScan(FArrayRecNum) + ELSE + NewFileScan(FileArea,FALSE,FArrayRecNum); + END; + FileArea := SaveFileArea; + LoadFileArea(FileArea); +END; + +PROCEDURE FileAreaChange(VAR Done: Boolean; CONST MenuOption: Str50); +VAR + InputStr: Str5; + Cmd: Char; + FArea, + SaveFArea, + NumFAreas: Integer; + SaveTempPause: Boolean; +BEGIN + IF (MenuOption <> '') THEN + CASE Upcase(MenuOption[1]) OF + '+' : BEGIN + FArea := FileArea; + IF (FileArea >= NumFileAreas) THEN + FArea := 0 + ELSE + REPEAT + Inc(FArea); + ChangeFileArea(FArea); + UNTIL ((FileArea = FArea) OR (FArea >= NumFileAreas)); + IF (FileArea <> FArea) THEN + BEGIN + { + %LFHighest accessible file area. + %PA + } + LRGLngStr(83,FALSE); + END + ELSE + LastCommandOvr := TRUE; + END; + '-' : BEGIN + FArea := FileArea; + IF (FileArea <= 0) THEN + FArea := 0 + ELSE + REPEAT + Dec(FArea); + ChangeFileArea(FArea); + UNTIL ((FileArea = FArea) OR (FArea <= 0)); + IF (FileArea <> FArea) THEN + BEGIN + { + %LFLowest accessible file area. + %PA + } + LRGLngStr(82,FALSE); + END + ELSE + LastCommandOvr := TRUE; + END; + 'L' : BEGIN + SaveTempPause := TempPause; + TempPause := FALSE; + FArea := 1; + NumFAreas := 0; + Cmd := '?'; + REPEAT + SaveFArea := FArea; + IF (Cmd = '?') THEN + LFileAreaList(FArea,NumFAreas,5,FALSE); + { + %LFFile area list? [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ + } + LOneK(LRGLngStr(70,TRUE),Cmd,'Q[]?',TRUE,TRUE); + TempPause := FALSE; + IF (Cmd <> 'Q') THEN + BEGIN + IF (Cmd = '[') THEN + BEGIN + Farea := (SaveFArea - ((PageLength - 5) * 2)); + IF (FArea < 1) THEN + FArea := 1; + Cmd := '?'; + END + ELSE IF (Cmd = ']') THEN + BEGIN + IF (FArea > NumFileAreas) THEN + FArea := SaveFArea; + Cmd := '?'; + END + ELSE IF (Cmd = '?') THEN + BEGIN + { + $File_Message_Area_List_Help + %LF^1(^3###^1)Manual entry selection ^1(^3^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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 + END; + UNTIL (Cmd = 'Q') OR (HangUp); + TempPause := SaveTempPause; + LastCommandOvr := TRUE; + END; + ELSE + BEGIN + IF (StrToInt(MenuOption) > 0) THEN + BEGIN + FArea := StrToInt(MenuOption); + IF (FArea <> FileArea) THEN + ChangeFileArea(FArea); + 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; + FArea := 1; + NumFAreas := 0; + + LightBarCmd := 1; + LightBarFirstCmd := TRUE; + + InputStr := '?'; + REPEAT + SaveFArea := FArea; + IF (InputStr = '?') THEN + lFileAreaList(FArea,NumFAreas,5,FALSE); + { + %LFChange file area? [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ + } + FileAreaScanInput(LRGLngStr(72,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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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 + { + %LF^7The range must be from %A1 to %A2!^1 + } + LRGLngStr(78,FALSE); + FArea := SaveFArea; + InputStr := '?'; + END + ELSE + BEGIN + FArea := CompFileArea(StrToInt(InputStr),1); + IF (FArea <> FileArea) THEN + ChangeFileArea(FArea); + IF (FArea = FileArea) THEN + InputStr := 'Q' + ELSE + BEGIN + { + %LF^7You do not have access to this file area!^1 + } + LRGLngStr(80,FALSE); + FArea := SaveFArea; + InputStr := '?'; + END; + END; + END; + UNTIL (InputStr = 'Q') OR (HangUp); + TempPause := SaveTempPause; + LastCommandOvr := TRUE; + END; +END; + +PROCEDURE CreateTempDir; +VAR + TempPath: Str40; + Changed: Boolean; +BEGIN + TempPath := ''; + InputPath('%LF^4Enter file path for temporary directory (^5End with a ^4"^5\^4"):%LF^4:',TempPath,TRUE,TRUE,Changed); + IF (TempPath = '') THEN + BEGIN + Print('%LFAborted.'); + Exit; + END; + IF (NOT ExistDir(TempPath)) THEN + BEGIN + Print('%LFThat directory does not exist.'); + Exit; + END; + FillChar(TempMemFileArea,SizeOf(TempMemFileArea),0); + WITH TempMemFileArea DO + BEGIN + AreaName := '<< Temporary >>'; + FileName := 'TEMPFILE'; + DLPath := TempPath; + ULPath := TempPath; + MaxFiles := 2000; + Password := ''; + ArcType := 1; + CmtType := 1; + ACS := 's'+IntToStr(ThisUser.SL)+'d'+IntToStr(ThisUser.DSL); + ULACS := ACS; + DLACS := ACS; + FAFlags := []; + END; + FileArea := (NumFileAreas + 1); + LoadFileArea(FileArea); + SysOpLog('Created temporary directory #'+IntToStr(FileArea)+' in "'+TempPath+'"'); +END; + +END. diff --git a/SOURCE/FILE12.PAS b/SOURCE/FILE12.PAS new file mode 100644 index 0000000..d4603c4 --- /dev/null +++ b/SOURCE/FILE12.PAS @@ -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^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^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^1)Select current entry'); + Print('^1(^3^1)First entry on page ^1(^3^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. + diff --git a/SOURCE/FILE13.PAS b/SOURCE/FILE13.PAS new file mode 100644 index 0000000..2fee0cd --- /dev/null +++ b/SOURCE/FILE13.PAS @@ -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. diff --git a/SOURCE/FILE14.PAS b/SOURCE/FILE14.PAS new file mode 100644 index 0000000..a6cd71a --- /dev/null +++ b/SOURCE/FILE14.PAS @@ -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. diff --git a/SOURCE/FILE2.PAS b/SOURCE/FILE2.PAS new file mode 100644 index 0000000..f56c58c --- /dev/null +++ b/SOURCE/FILE2.PAS @@ -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. diff --git a/SOURCE/FILE3.PAS b/SOURCE/FILE3.PAS new file mode 100644 index 0000000..4396c53 --- /dev/null +++ b/SOURCE/FILE3.PAS @@ -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. diff --git a/SOURCE/FILE4.PAS b/SOURCE/FILE4.PAS new file mode 100644 index 0000000..d2bd265 --- /dev/null +++ b/SOURCE/FILE4.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/FILE5.PAS b/SOURCE/FILE5.PAS new file mode 100644 index 0000000..aa2ff9e --- /dev/null +++ b/SOURCE/FILE5.PAS @@ -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+' "'); + 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+' [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 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^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. + diff --git a/SOURCE/FILE6.PAS b/SOURCE/FILE6.PAS new file mode 100644 index 0000000..7ab44cf --- /dev/null +++ b/SOURCE/FILE6.PAS @@ -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^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. diff --git a/SOURCE/FILE7.PAS b/SOURCE/FILE7.PAS new file mode 100644 index 0000000..58dd8b1 --- /dev/null +++ b/SOURCE/FILE7.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/FILE8.PAS b/SOURCE/FILE8.PAS new file mode 100644 index 0000000..acc4d97 --- /dev/null +++ b/SOURCE/FILE8.PAS @@ -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. diff --git a/SOURCE/FILE9.PAS b/SOURCE/FILE9.PAS new file mode 100644 index 0000000..99dc735 --- /dev/null +++ b/SOURCE/FILE9.PAS @@ -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('',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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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. diff --git a/SOURCE/LINECHAT.PAS b/SOURCE/LINECHAT.PAS new file mode 100644 index 0000000..e493a42 --- /dev/null +++ b/SOURCE/LINECHAT.PAS @@ -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. diff --git a/SOURCE/LOGON.PAS b/SOURCE/LOGON.PAS new file mode 100644 index 0000000..7855ede --- /dev/null +++ b/SOURCE/LOGON.PAS @@ -0,0 +1,1194 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Logon; + +INTERFACE + +FUNCTION GetUser: Boolean; + +IMPLEMENTATION + +USES + Crt, + Common, + Archive1, + CUser, + Doors, + Email, + Events, + Mail0, + Mail1, + Maint, + Menus, + Menus2, + NewUsers, + ShortMsg, + SysOp2G, + TimeFunc, + MiscUser; + +VAR + GotName: Boolean; + OldUser: UserRecordType; + +FUNCTION Hex(i: LongInt; j: Byte): STRING; +CONST + hc : ARRAY [0..15] OF Char = '0123456789ABCDEF'; +VAR + One, + Two, + Three, + Four: Byte; +BEGIN + One := (i AND $000000FF); + Two := (i AND $0000FF00) SHR 8; + Three := (i AND $00FF0000) SHR 16; + Four := (i AND $FF000000) SHR 24; + Hex[0] := chr(j); { Length of STRING = 4 or 8} + IF (j = 4) THEN + BEGIN + Hex[1] := hc[Two SHR 4]; + Hex[2] := hc[Two AND $F]; + Hex[3] := hc[One SHR 4]; + Hex[4] := hc[One AND $F]; + END + ELSE + BEGIN + Hex[8] := hc[One AND $F]; + Hex[7] := hc[One SHR 4]; + Hex[6] := hc[Two AND $F]; + Hex[5] := hc[Two SHR 4]; + Hex[4] := hc[Three AND $F]; + Hex[3] := hc[Three SHR 4]; + Hex[2] := hc[Four AND $F]; + Hex[1] := hc[Four SHR 4]; + END; +END; + +PROCEDURE IEMSI; +VAR + Tries: Byte; + T1,T2: LongInt; + Emsi_Irq: STRING[20]; + Done,Success: Boolean; + S,Isi: STRING; + C: Char; + I: Integer; + Buffer: ARRAY [1..2048] OF Char; + Buffptr: Integer; + User: UserRecordType; + NextItemPointer: Integer; + + FUNCTION NextItem: STRING; + VAR + S: AStr; + BEGIN + S := ''; + WHILE (NextItemPointer < 2048) AND (Buffer[NextItemPointer] <> #0) AND (Buffer [NextItemPointer] <> '{') DO + Inc(NextItemPointer); + IF (Buffer[NextItemPointer] = '{') THEN + Inc(NextItemPointer); + WHILE (NextItemPointer < 2048) AND (Buffer[NextItemPointer] <> #0) AND (Buffer [NextItemPointer] <> '}') DO + BEGIN + S := S + Buffer[NextItemPointer]; + Inc(NextItemPointer); + END; + IF (Buffer[NextItemPointer] = '}') THEN + Inc(NextItemPointer); + NextItem := S; + END; + +BEGIN + FillChar(IEMSIRec,SizeOf(IEMSIRec),0); + IF (ComPortSpeed = 0) OR (NOT General.UseIEMSI) THEN + Exit; + (* Should this be Prompt ??? + Write('Attempting IEMSI negotiation ... '); + *) + Write(RGNoteStr(21,TRUE)); + FillChar(Buffer,SizeOf(Buffer),0); + T1 := Timer; + T2 := Timer; + Tries := 0; + Done := FALSE; + Success := FALSE; + Emsi_Irq := '**EMSI_IRQ8E08'^M^L; + Com_Flush_Recv; + SerialOut(Emsi_Irq); + S := ''; + REPEAT + HangUp := NOT Com_Carrier; + IF (ABS(T1 - Timer) > 2) THEN + BEGIN + T1 := Timer; + Inc(Tries); + IF (Tries >= 2) THEN + Done := TRUE + ELSE + BEGIN + Com_Flush_Recv; + SerialOut(Emsi_Irq); + END; + END; + IF (ABS(T2 - Timer) >= 8) THEN + Done := TRUE; + C := Cinkey; + IF (C > #0) THEN + BEGIN + IF (Length(S) >= 160) THEN + Delete(S, 1, 120); + S := S + C; + IF (Pos('**EMSI_ICI', S) > 0) THEN + BEGIN + Delete(S,1,Pos('EMSI_ICI',S) - 1); + Move(S[1],Buffer[1],Length(S)); + Buffptr := Length(S); + T1 := Timer; + REPEAT + C := Cinkey; + IF NOT (C IN [#0, #13]) THEN + BEGIN + Inc(Buffptr); + Buffer[Buffptr] := C; + END; + UNTIL (HangUp) OR (ABS(Timer - T1) > 4) OR (C = ^M) OR (Buffptr = 2048); + S [0] := #8; + Move(Buffer[Buffptr - 7],S[1],8); + Dec(Buffptr,8); + IF (S = Hex(UpdateCRC32($Ffffffff,Buffer[1],Buffptr),8)) THEN + BEGIN + LoadURec(User,1); + Isi := '{Renegade,'+General.Version+'}{'+General.BBSName+'}{'+User.CityState+ + '}{'+General.SysOpName+'}{'+Hex(GetPackDateTime,8)+ + '}{Live free or die!}{}{Everything!}'; + Isi := 'EMSI_ISI'+ Hex(Length(Isi),4) + Isi; + Isi := Isi + Hex(UpdateCRC32($Ffffffff,Isi[1],Length(Isi)),8); + Isi := '**' + Isi + ^M; + Com_Flush_Recv; + SerialOut(Isi); + Tries := 0; + T1 := Timer; + S := ''; + REPEAT + IF (ABS(Timer - T1) >= 3) THEN + BEGIN + T1 := Timer; + Inc(Tries); + Com_Flush_Recv; + SerialOut(Isi); + END; + C := Cinkey; + IF (C > #0) THEN + BEGIN + IF (Length(S) >= 160) THEN + Delete(S,1,120); + S := S + C; + IF (Pos('**EMSI_ACK', S) > 0) THEN + BEGIN + Com_Flush_Recv; + Com_Purge_Send; + Done := TRUE; + Success := TRUE; + END + ELSE IF (Pos('**EMSI_NAKEEC3',S) > 0) THEN + BEGIN + Com_Flush_Recv; + SerialOut(Isi); + Inc(Tries); + END; + END; + UNTIL (Tries >= 3) OR (Done); + END + ELSE + BEGIN + SerialOut('**EMSI_NAKEEC3'); + T1 := Timer; + END; + END; + END; + UNTIL (Done) OR (HangUp); + IF (Success) THEN + BEGIN + (* Should this be print ??? + WriteLn('success.'); + *) + Writeln(RGNOteStr(22,TRUE)); + SL1('IEMSI negotiation Suceeded.'); + END + ELSE + BEGIN + (* Should this be print ??? + WriteLn('failure.'); + *) + WriteLn(RGNoteStr(23,TRUE)); + SL1('IEMSI negotiation failed.'); + END; + NextItemPointer := 1; + WITH IEMSIRec DO + BEGIN + UserName := NextItem; + Handle := NextItem; + CityState := NextItem; + Ph := NextItem; + S := NextItem; + Pw := AllCaps(NextItem); + I := StrToInt('$'+NextItem); + IF (I > 0) THEN + Bdate := Pd2Date(I); + END; + Com_Flush_Recv; +END; + +PROCEDURE Check_Ansi; +VAR + L: LongInt; + C: Char; + Ox,x,y: Byte; + S: AStr; + + PROCEDURE ANSIResponse(VAR x,y: Byte); + VAR + Xs, + Ys: STRING[4]; + BEGIN + L := (Timer + 2); + C := #0; + Xs := ''; + Ys := ''; + x := 0; + y := 0; + WHILE (L > Timer) AND (C <> ^[) AND (NOT HangUp) DO + IF (NOT Empty) THEN + C := Com_Recv; { must be low level to avoid ansi-eater } + IF (C = ^[) THEN + BEGIN + L := (Timer + 1); + WHILE (L > Timer) AND (C <> ';') AND (NOT HangUp) DO + IF (NOT Empty) THEN + BEGIN + C := Com_Recv; + IF (C IN ['0'..'9']) AND (Length(Ys) < 4) THEN + Ys := Ys + C; + END; + L := (Timer + 1); + WHILE (L > Timer) AND (C <> 'R') AND (NOT HangUp) DO + IF (NOT Empty) THEN + BEGIN + C := Com_Recv; + IF (C IN ['0'..'9']) AND (Length(Xs) < 4) THEN + Xs := Xs + C; + END; + x := StrToInt(Xs); + y := StrToInt(Ys); + END; + END; + +BEGIN + TextAttr := 10; + (* Should this be Prompt ??? + Write('Attempting to detect emulation ... '); + *) + Write(RGNoteStr(24,TRUE)); + Exclude(ThisUser.Flags,Avatar); + Exclude(ThisUser.Flags,Ansi); + Exclude(ThisUser.Flags,Vt100); + Exclude(ThisUser.SFlags,Rip); + IF (ComPortSpeed = 0) THEN + BEGIN + Include(ThisUser.Flags,Ansi); + Exit; + END; + Com_Flush_Recv; + SerialOut(^M^M^['[!'#8#8#8); + L := (Timer + 2); + C := #0; + S := ''; + WHILE (L > Timer) AND (C <> 'R') AND (NOT HangUp) DO IF (NOT Empty) THEN + C := Com_Recv; + IF (C = 'R') THEN + BEGIN + L := (Ticks + 3); + WHILE (NOT Empty) AND (Ticks < L) DO; + C := Com_Recv; + IF (C = 'I') THEN + BEGIN + L := (Ticks + 3); + WHILE (NOT Empty) AND (Ticks < L) DO; + C := Com_Recv; + IF (C = 'P') THEN + BEGIN + Include(ThisUser.SFlags,Rip); + S := RGNoteStr(25,TRUE); {'RIP'} + END; + END; + Com_Flush_Recv; + END; + SerialOut(^M^M^['[6n'#8#8#8#8); + ANSIResponse(x,y); + IF (x + y > 0) THEN + BEGIN + Include(ThisUser.Flags,Ansi); + ANSIDetected := TRUE; + IF (S <> '') THEN + S := S + RGNoteStr(26,TRUE) {'/Ansi'} + ELSE + S := RGNoteStr(27,TRUE); {'Ansi'} + SerialOut(^V^F); + SerialOut(^['[6n'#8#8); + Ox := x; + ANSIResponse(x,y); + IF (x = Ox + 1) THEN + BEGIN + Include(ThisUser.Flags,Avatar); + IF (S <> '') THEN + S := S + RGNoteStr(28,TRUE) {'/Avatar'} + ELSE + S := RGNoteStr(29,TRUE); {'Avatar'} + END + ELSE + SerialOut(#8#8); + END; + IF (S <> '') THEN + Print('|10'+S+RGNoteStr(30,TRUE)) {' detected.'} + ELSE + BEGIN + TextAttr := 7; + { Should this be Print ??? } + WriteLn; + END; +END; + +PROCEDURE GetPWS(VAR Ok: Boolean; VAR Tries: Integer); (* Tries should be Byte *) +VAR + MHeader: MHeaderRec; + S: AStr; + PhonePW: STR4; + Birthday: Str10; + UserPW, + SysOpPW: Str20; + ForgotPW: Str40; +BEGIN + Ok := TRUE; + IF (NOT (FastLogon AND (NOT General.LocalSec))) THEN + BEGIN + IF (IEMSIRec.Pw = '') THEN + BEGIN + (* + Prompt(FString.Yourpassword); + *) + RGMainStr(3,FALSE); + GetPassword(UserPw,20); + END + ELSE + BEGIN + UserPW := IEMSIRec.Pw; + IEMSIRec.Pw := ''; + END; + IF (General.Phonepw) THEN + IF (IEMSIRec.Ph = '') THEN + BEGIN + (* + Prompt(FString.YourPhoneNumber); + *) + RGMainStr(4,FALSE); + GetPassword(PhonePW,4); + END + ELSE + BEGIN + PhonePW := Copy(IEMSIRec.Ph,Length(IEMSIRec.Ph) - 3,4); + IEMSIRec.Ph := ''; + END + ELSE + PhonePW := Copy(ThisUser.Ph,Length(ThisUser.Ph) - 3,4); + END; + IF (NOT (FastLogon AND (NOT General.LocalSec))) AND ((ThisUser.Pw <> Crc32(UserPW)) OR + (Copy(ThisUser.Ph,Length(ThisUser.Ph) - 3,4) <> PhonePW)) THEN + BEGIN + ok := FALSE; + (* + Prompt(FString.ILogon); + *) + RGNoteStr(9,FALSE); + IF (NOT HangUp) AND (UserNum <> 0) THEN + BEGIN + S := '* Illegal logon attempt! Tried: '+Caps(ThisUser.Name)+' #'+IntToStr(UserNum)+' PW='+UserPw; + IF (General.Phonepw) THEN + S := S + ', PH#='+PhonePW; + SendShortMessage(1,S); + SL1(S); + END; + Inc(ThisUser.Illegal); + IF (UserNum <> - 1) THEN + SaveURec(ThisUser,UserNum); + Inc(Tries); + IF (Tries >= General.MaxLogonTries) THEN + BEGIN + IF (General.NewUserToggles[20] = 0) OR (RGMainStr(6, TRUE) = '') + {(General.ForgotPWQuestion = '')} OR (ThisUser.ForgotPWAnswer = '') THEN + HangUp := TRUE + ELSE + BEGIN + (* + Print('|03Please answer the following question to logon to the BBS.'); + Print('|03'+General.ForgotPWQuestion); + Prt(': '); + *) + RGMainStr(6,FALSE); + MPL(40); + Input(ForgotPW,40); + IF (ForgotPW <> ThisUser.ForgotPWAnswer) THEN + BEGIN + S := '* Invalid forgot password response: '+ForgotPW; + SL1(S); + SendShortMessage(1,S); + HangUp := TRUE + END + ELSE + BEGIN + S := '* Entered correct forgot password response.'; + SL1(S); + SendShortMessage(1,S); + CStuff(9,1,ThisUser); + ok := TRUE; + Tries := 0; + END; + END; + END; + END; + IF (Ok) THEN + lStatus_Screen(General.Curwindow,'',FALSE,S); + IF ((AACS(General.Spw)) AND (Ok) AND (InCom) AND (NOT HangUp)) THEN + BEGIN + (* + Prompt(FString.SysOpPrompt); + *) + RGMainStr(5,FALSE); + GetPassword(SysOpPW,20); + IF (SysOpPW <> General.SysOpPW) THEN + BEGIN + (* + Prompt(FString.ILogon); + *) + RGNoteStr(9,FALSE); + SL1('* Illegal System password: '+SysOpPw); + Inc(Tries); + IF (Tries >= General.MaxLogonTries) THEN + HangUp := TRUE; + Ok := FALSE; + END; + END; + IF (Ok) AND NOT (AACS(Liner.LogonACS)) THEN + BEGIN + PrintF('NONODE'); + IF (NoFile) THEN + (* + Print('You don''t have the required ACS to logon to this node!'); + *) + RGNoteStr(10,FALSE); + SysOpLog(ThisUser.Name+': Attempt to logon node '+IntToStr(ThisNode)+' without access.'); + HangUp := TRUE; + END; + IF ((Ok) AND (General.ShuttleLog) AND (LockedOut IN ThisUser.SFlags)) THEN + BEGIN + PrintF(ThisUser.LockedFile); + IF (NoFile) THEN + (* + Print('You have been locked out of the BBS by the SysOp.'); + *) + RGNoteStr(11,FALSE); + SysOpLog(ThisUser.Name+': Attempt to access system when locked out^7 <--'); + HangUp := TRUE; + END; + IF (UserNum > 0) AND (Onnode(UserNum) > 0) AND NOT (Cosysop) THEN + BEGIN + PrintF('MULTILOG'); + IF (NoFile) THEN + (* + Print('You are already logged in on another node!'); + *) + RGNoteStr(12,FALSE); + HangUp := TRUE; + END; + IF (NOT FastLogon) AND (Ok) AND (NOT HangUp) AND (General.Birthdatecheck > 0) AND + (ThisUser.LoggedOn MOD General.Birthdatecheck = 0) THEN + BEGIN + (* + Prt('Please verify your date of birth (mm/dd/yyyy): '); + *) + RGMainStr(7,FALSE); + Inputformatted('',Birthday,'##/##/####',FALSE); + IF (Date2Pd(Birthday) <> ThisUser.Birthdate) THEN + BEGIN + Dec(ThisUser.LoggedOn); + PrintF('WRNGBDAY'); + IF (NoFile) THEN + (* + Print('You entered an incorrect birthdate.'); + *) + RGNoteStr(13,FALSE); + SL1('*'+ThisUser.Name+' Failed birthday verification. Tried = '+Birthday+' Actual = '+Pd2Date(ThisUser.Birthdate)); + SendShortMessage(1,ThisUser.Name+' failed birthday verification on '+DateStr); + InResponseTo := '\'#1'Failed birthdate check'; + MHeader.Status := []; + SeMail(1,MHeader); + HangUp := TRUE; + END; + END; + UserOn := Ok; +END; + +PROCEDURE TryIEMSILogon; +VAR + I, Zz: Integer; + Ok: Boolean; +BEGIN + IF (IEMSIRec.UserName <> '') THEN + BEGIN + I := SearchUser(IEMSIRec.UserName,TRUE); + IF (I = 0) AND (IEMSIRec.Handle <> '') THEN + I := SearchUser(IEMSIRec.Handle,TRUE); + IF (I > 0) THEN + BEGIN + Zz := UserNum; + UserNum := 0; + OldUser := ThisUser; + LoadURec(ThisUser,I); + UserNum := Zz; + GetPWS(Ok,Zz); + GotName := Ok; + IF (NOT GotName) THEN + BEGIN + ThisUser := OldUser; + Update_Screen; + END + ELSE + BEGIN + UserNum := I; + IF (Pd2Date(ThisUser.LastOn) <> DateStr) THEN + WITH ThisUser DO + BEGIN + OnToday := 0; + TLToday := General.TimeAllow[SL]; + TimeBankAdd := 0; + DLToday := 0; + DLKToday := 0; + TimeBankWith := 0; + END; + UserOn := TRUE; + Update_Screen; + SysOpLog('Logged in IEMSI as '+Caps(ThisUser.Name)); + END; + END + ELSE + (* + Print(FString.NameNotFound); + *) + RGNoteStr(8,FALSE); + + END; +END; + +PROCEDURE Doshuttle; +VAR + Cmd,NewMenuCmd: AStr; + SaveMenu, + CmdToExec: Byte; + Tries, + RecNum, + RecNum1, + I: Integer; + Done,Loggedon,Ok,CmdNotHid,CmdExists: Boolean; +BEGIN + PrintF('PRESHUTL'); + GotName := FALSE; + Loggedon := FALSE; + TryIEMSILogon; + SaveMenu := CurMenu; + CurMenu := General.ShuttleLogonMenu; + LoadMenu; + AutoExecCmd('FIRSTCMD'); + Tries := 0; + Curhelplevel := 2; + REPEAT + TSHuttleLogon := 0; + MainMenuHandle(Cmd); + NewMenuCmd:= ''; + CmdToExec := 0; + Done := FALSE; + REPEAT + FCmd(Cmd,CmdToExec,CmdExists,CmdNotHid); + IF (CmdToExec <> 0) THEN + IF (MemCmd^[CmdToExec].Cmdkeys <> 'OP') AND (MemCmd^[CmdToExec].Cmdkeys <> 'O2') AND + (MemCmd^[CmdToExec].Cmdkeys[1] <> 'H') AND (MemCmd^[CmdToExec].Cmdkeys[1] <> '-') AND + (NOT GotName) THEN + BEGIN + (* + Prompt(FString.Shuttleprompt); + *) + RGMainStr(9,FALSE); + FindUser(UserNum); + IF (UserNum >= 1) THEN + BEGIN + I := UserNum; + UserNum := 0; + OldUser := ThisUser; + LoadURec(ThisUser,I); + UserNum := I; + GetPWS(Ok,Tries); + GotName := Ok; + IF (NOT GotName) THEN + BEGIN + ThisUser := OldUser; + Update_Screen; + END + ELSE + BEGIN + IF (Pd2Date(ThisUser.LastOn) <> DateStr) THEN + WITH ThisUser DO + BEGIN + OnToday := 0; + TLToday := General.TimeAllow[SL]; + TimeBankAdd := 0; + DLToday := 0; + DLKToday := 0; + TimeBankWith := 0; + END; + UserOn := TRUE; + Update_Screen; + SysOpLog('Logged on to Shuttle Menu as '+Caps(ThisUser.Name)); + DoMenuCommand(Done, + MemCmd^[CmdToExec].Cmdkeys, + MemCmd^[CmdToExec].Options, + NewMenuCmd, + MemCmd^[CmdToExec].NodeActivityDesc); + END; + END + ELSE + BEGIN + (* + Print(FString.ILogon); + *) + RGNoteStr(9,FALSE); + Inc(Tries); + END; + END + ELSE + DoMenuCommand(Done, + MemCmd^[CmdToExec].Cmdkeys, + MemCmd^[CmdToExec].Options, + NewMenuCmd, + MemCmd^[CmdToExec].NodeActivityDesc); + UNTIL (CmdToExec = 0) OR (Done); + CASE TSHuttleLogon OF + 1 : 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 = '!') THEN + RecNum1 := RecNum; + Inc(RecNum); + END; + Close(ValidationFile); + + IF (RecNum1 <> -1) AND (ThisUser.SL > Validation.NewSL) THEN + Loggedon := TRUE + ELSE + BEGIN + PrintF('NOSHUTT'); + IF (NoFile) THEN + (* + Print('You have not been validated yet.'); + *) + RGNoteStr(31,FALSE); + SL1('* Illegal Shuttle Logon attempt'); + Inc(Tries); + END; + + END; + 2 : BEGIN + IF (NOT General.ClosedSystem) AND PYNQ(RGMainStr(2,TRUE){FString.LogonAsNew},0,FALSE) THEN + BEGIN + NewUserInit; + NewUser; + IF (UserNum > 0) AND (NOT HangUp) THEN + BEGIN + GotName := TRUE; + UserOn := TRUE; + DailyMaint; + END; + CurMenu := General.ShuttleLogonMenu; + LoadMenu; + END; + END; + END; + IF (Tries >= General.MaxLogonTries) THEN + HangUp := TRUE; + UNTIL (Loggedon) OR (HangUp); + CurMenu := SaveMenu; + NewMenuToLoad := TRUE; +END; + +FUNCTION GetUser: Boolean; +VAR + User: UserRecordType; + MHeader: MHeaderRec; + Pw, + S, + ACSReq: AStr; + OverridePW: Str20; + Lng: SmallInt; + Tries, + I, + TTimes, + Zz, + EventNum: Integer; (* Tries/TTimes should be Byte, may NOT need TTimes *) + Done, + Nu, + Ok, + TooMuch, + ACSUser: Boolean; +BEGIN + WasNewUser := FALSE; + UserNum := -1; + LoadURec(ThisUser,0); + TimeOn := GetPackDateTime; + ChatChannel := 0; + Update_Node(RGNoteStr(35,TRUE){ Logging on },TRUE); (* New *) + + LoadNode(ThisNode); (* New *) + NodeR.GroupChat := FALSE; + SaveNode(ThisNode); + + CreditsLastUpdated := GetPackDateTime; + + PublicReadThisCall := 0; + + ExtraTime := 0; + FreeTime := 0; + ChopTime := 0; + CreditTime := 0; + + SL1(''); + + S := '^3Logon node '+IntToStr(ThisNode)+'^5 ['+Dat+']^4 ('; + IF (ComPortSpeed > 0) THEN + BEGIN + S := S + IntToStr(ActualSpeed)+' baud'; + IF (Reliable) THEN + S := S + '/Reliable)' + ELSE + S := S + ')'; + IF (CallerIDNumber > '') THEN + BEGIN + IF (NOT Telnet) THEN + S := S + ' Number: '+CallerIDNumber + ELSE + S := S + ' IP Number: '+CallerIDNumber; + END; + END + ELSE + S := S + 'Keyboard)'; + SL1(S); + + Nu := FALSE; + Pw := ''; + + IF (ActualSpeed < General.MinimumBaud) AND (ComPortSpeed > 0) THEN + BEGIN + IF ((General.MinBaudHiTime - General.MinBaudLowTime) > 1430) THEN + BEGIN + IF (General.MinBaudOverride <> '') THEN + BEGIN + (* + Prt('Baud rate override password: '); + *) + RGMainStr(0,FALSE); + GetPassword(OverridePW,20); + END; + IF (General.MinBaudOverride = '') OR (OverRidePW <> General.MinBaudOverride) THEN + BEGIN + PrintF('NOBAUD.ASC'); + IF (NoFile) THEN + RGNoteStr(3,FALSE); + (* + Print('You must be using at least '+IntToStr(General.MinimumBaud)+' baud to call this BBS.'); + *) + HangUp := TRUE; + Exit; + END; + END + ELSE IF (NOT InTime(Timer,General.MinBaudLowTime,General.MinBaudHiTime)) THEN + BEGIN + IF (General.MinBaudOverride <> '') THEN + BEGIN + (* + Prt('Baud rate override password: '); + *) + RGMainStr(0,FALSE); + GetPassword(OverridePW,20); + END; + IF (General.MinBaudOverride = '') OR (OverridePW <> General.MinBaudOverride) THEN + BEGIN + PrintF('NOBAUDH.ASC'); + IF (NoFile) THEN + (* + Print('Hours for those using less than '+IntToStr(General.MinimumBaud)+' baud are from '+ + Ctim(General.MinBaudLowTime)+' to '+Ctim(General.MinBaudHiTime)); + *) + RGNoteStr(4,FALSE); + HangUp := TRUE; + Exit; + END; + END + ELSE + BEGIN + IF (NOT HangUp) THEN + IF ((General.MinBaudLowTime <> 0) OR (General.MinBaudHiTime <> 0)) THEN + BEGIN + PrintF('YESBAUDH.ASC'); + IF (NoFile) THEN + (* + Print('NOTE: Callers at less than '+IntToStr(General.MinimumBaud)+' baud are'); + Print('restricted to the following hours ONLY:'); + Print(' '+Ctim(General.MinBaudLowTime)+' to '+Ctim(General.MinBaudHiTime)); + *) + RGNoteStr(5,FALSE); + END; + END; + END; + + ACSUser := FALSE; + FOR I := 1 TO NumEvents DO + WITH MemEventArray[I]^ DO + IF ((EventIsActive IN EFlags) AND (EventIsLogon IN EFlags) AND (CheckEventTime(I,0))) THEN + BEGIN + ACSUser := TRUE; + ACSReq := MemEventArray[I]^.EventACS; + EventNum := I; + END; + + Check_Ansi; + IEMSI; + GotName := FALSE; + IF ((General.ShuttleLog) AND (NOT FastLogon) AND (NOT HangUp)) THEN + Doshuttle; + Setc(7); + CLS; + Print(Centre(VerLine(1))); + Print(Centre(VerLine(2))); + Print(Centre(VerLine(3))); + PrintF('PRELOGON'); + IF (ACSUser) THEN + BEGIN + PrintF('ACSEA'+IntToStr(EventNum)); + IF (NoFile) THEN + (* + Print('Restricted: Only certain users allowed online at this time.'); + *) + RGNoteStr(6,FALSE); + END; + IF (NOT GotName) THEN + TryIEMSILogon; + TTimes := 0; + Tries := 0; + REPEAT + REPEAT + IF (UserNum <> - 1) AND (TTimes >= General.MaxLogonTries) THEN + HangUp := TRUE; + OldUser := ThisUser; + IF (NOT GotName) THEN + BEGIN + (* + IF (FString.Note[1] <> '') THEN + Print(FString.Note[1]); + IF (FString.Note[2] <> '') THEN + Print(FString.Note[2]); + IF (FString.Lprompt <> '') THEN + Prompt(FString.Lprompt); + *) + RGMainStr(1,FALSE); + FindUser(UserNum); + Inc(TTimes); + IF (ACSUser) AND (UserNum = -1) THEN + BEGIN + PrintF('ACSEB'+IntToStr(EventNum)); + IF (NoFile) THEN + (* + Print('This time window allows certain other users to get online.'); + Print('Please call back later, after it has ended.'); + *) + RGNoteStr(7,FALSE); + HangUp := TRUE; + END; + IF (NOT HangUp) AND (UserNum = 0) THEN + BEGIN + PrintF('LOGERR'); + IF (NoFile) THEN + (* + Print('Name not found in user list.'); + *) + RGNoteStr(8,FALSE); + IF NOT (General.ShuttleLog) AND (NOT General.ClosedSystem) THEN + IF PYNQ(RGMainStr(2,TRUE){FString.LogonAsNew},0,FALSE) THEN + UserNum := -1; + END; + END; + UNTIL (UserNum <> 0) OR (HangUp); + IF (ACSUser) AND (UserNum = -1) THEN + BEGIN + PrintF('ACSEB'+IntToStr(EventNum)); + IF (NoFile) THEN + (* + Print('This time window allows certain other users to get online.'); + Print('Please call back later, after it has ended.'); + *) + RGNoteStr(7,FALSE); + HangUp := TRUE; + END; + Ok := TRUE; + Done := FALSE; + IF (NOT HangUp) THEN + BEGIN + IF (UserNum = -1) THEN + BEGIN + NewUserInit; + Nu := TRUE; + Done := TRUE; + Ok := FALSE; + END + ELSE + BEGIN + I := UserNum; + UserNum := 0; + LoadURec(ThisUser,I); + UserNum := I; + TempPause := (Pause IN ThisUser.Flags); + NewFileDate := ThisUser.LastOn; + MsgArea := ThisUser.LastMsgArea; + FileArea := ThisUser.LastFileArea; + IF (AutoDetect IN ThisUser.SFlags) THEN + BEGIN + IF (Rip IN OldUser.SFlags) THEN + Include(ThisUser.SFlags,Rip) + ELSE + Exclude(ThisUser.SFlags,Rip); + IF (Ansi IN OldUser.Flags) THEN + Include(ThisUser.Flags,Ansi) + ELSE + Exclude(ThisUser.Flags,Ansi); + IF (Avatar IN OldUser.Flags) THEN + Include(ThisUser.Flags,Avatar) + ELSE + Exclude(ThisUser.Flags,Avatar); + END; + IF (Pd2Date(ThisUser.LastOn) <> DateStr) THEN + WITH ThisUser DO + BEGIN + OnToday := 0; + TLToday := General.TimeAllow[SL]; + TimeBankAdd := 0; + DLToday := 0; + DLKToday := 0; + TimeBankWith := 0; + END + ELSE IF (General.PerCall) THEN + ThisUser.TLToday := General.TimeAllow[ThisUser.SL]; + + IF (ThisUser.Expiration > 0) AND + (ThisUser.Expiration <= GetPackDateTime) AND + (ThisUser.ExpireTo IN ['!'..'~']) THEN + BEGIN + SysOpLog('Subscription expired to level: "'+ThisUser.ExpireTo+'".'); + AutoValidate(ThisUser,UserNum,ThisUser.ExpireTo); + END; + + IF (CallerIDNumber <> '') THEN + ThisUser.CallerID := CallerIDNumber; + SaveURec(ThisUser,UserNum); + IF (NOT GotName) THEN + GetPWS(Ok,Tries); + IF (Ok) THEN + Done := TRUE; + IF (NOT Done) THEN + BEGIN + ThisUser := OldUser; + UserNum := 0; + Update_Screen; + END; + END; + END; + UNTIL ((Done) OR (HangUp)); + Reset(SchemeFile); + IF (ThisUser.ColorScheme > 0) AND (ThisUser.ColorScheme <= FileSize(SchemeFile) ) THEN + Seek(SchemeFile,ThisUser.ColorScheme - 1) + ELSE + ThisUser.ColorScheme := 1; + Read(SchemeFile,Scheme); + Close(SchemeFile); + IF (ACSUser) AND NOT (AACS(ACSReq)) THEN + BEGIN + PrintF('ACSEB'+IntToStr(EventNum)); + IF (NoFile) THEN + (* + Print('This time window allows certain other users to get online.'); + Print('Please call back later, after it has ended.'); + *) + RGNoteStr(7,FALSE); + HangUp := TRUE; + END; + IF NOT (AACS(Liner.LogonACS)) AND (NOT HangUp) THEN + BEGIN + PrintF('NONODE'); + IF (NoFile) THEN + (* + Print('You don''t have the required ACS to logon to this node!'); + *) + RGNoteStr(10,FALSE); + SysOpLog(ThisUser.Name+': Attempt to logon node '+IntToStr(ThisNode)+' without access.'); + HangUp := TRUE; + END; + IF ((LockedOut IN ThisUser.SFlags) AND (NOT HangUp)) THEN + BEGIN + PrintF(ThisUser.LockedFile); + IF (NoFile) THEN + (* + Print('You have been locked out of the BBS by the SysOp.'); + *) + RGNoteStr(11,FALSE); + SysOpLog(ThisUser.Name+': Attempt to access system when locked out^7 <--'); + HangUp := TRUE; + END; + IF ((NOT Nu) AND (NOT HangUp)) THEN + BEGIN + TooMuch := FALSE; + IF (Accountbalance < General.Creditminute) AND (General.Creditminute > 0) AND + NOT (FNoCredits IN ThisUser.Flags) THEN + BEGIN + PrintF('NOCREDTS'); + IF (NoFile) THEN + (* + Print('You have insufficient credits for online time.'); + *) + RGNoteStr(14,FALSE); + SysOpLog(ThisUser.Name+': insufficient credits for logon.'); + IF (General.CreditFreeTime < 1) THEN + HangUp := TRUE + ELSE + BEGIN + ThisUser.TLToday := General.CreditFreeTime DIV General.Creditminute; + Inc(ThisUser.lCredit,General.CreditFreeTime); + END; + END + ELSE IF (((Rlogon IN ThisUser.Flags) OR (General.CallAllow[ThisUser.SL] = 1)) AND + (ThisUser.OnToday >= 1) AND (Pd2Date(ThisUser.LastOn) = DateStr)) THEN + BEGIN + PrintF('2MANYCAL'); + IF (NoFile) THEN + (* + Print('You can only log on once per day.'); + *) + RGNoteStr(15,FALSE); + TooMuch := TRUE; + END + ELSE IF ((ThisUser.OnToday >= General.CallAllow[ThisUser.SL]) AND + (Pd2Date(ThisUser.LastOn) = DateStr)) THEN + BEGIN + PrintF('2MANYCAL'); + IF (NoFile) THEN + (* + Print('You can only log on '+IntToStr(General.CallAllow[ThisUser.SL])+' times per day.'); + *) + RGNoteStr(16,FALSE); + TooMuch := TRUE; + END + ELSE IF (ThisUser.TLToday <= 0) AND NOT (General.PerCall) THEN + BEGIN + PrintF('NOTLEFTA'); + IF (NoFile) THEN + (* + Prompt('You can only log on for '+IntToStr(General.TimeAllow[ThisUser.SL])+' minutes per day.'); + *) + RGNoteStr(17,FALSE); + TooMuch := TRUE; + IF (ThisUser.TimeBank > 0) THEN + BEGIN + (* + Print('^5However, you have '+IntToStr(ThisUser.TimeBank)+' minutes left in your Time Bank.'); + *) + RGNoteStr(18,FALSE); + IF PYNQ(RGMainStr(8,TRUE){'Withdraw from Time Bank? '},0,TRUE) THEN + BEGIN + InputIntegerWOC('Withdraw how many minutes',Lng,[NumbersOnly],1,32767); + BEGIN + IF (Lng > ThisUser.TimeBank) THEN + Lng := ThisUser.TimeBank; + Dec(ThisUser.TimeBankAdd,Lng); + IF (ThisUser.TimeBankAdd < 0) THEN + ThisUser.TimeBankAdd := 0; + Dec(ThisUser.TimeBank,Lng); + Inc(ThisUser.TLToday,Lng); + (* + Print('^5In your account: ^3'+IntToStr(ThisUser.TimeBank)+'^5 Time left online: ^3'+Formattedtime(NSL)); + *) + RGNoteStr(19,FALSE); + SysOpLog('TimeBank: Withdrew '+ IntToStr(Lng)+' minutes at logon.'); + END; + END; + IF (NSL >= 0) THEN + TooMuch := FALSE + ELSE + (* + Print('Hanging up.'); + *) + RGNoteStr(20,FALSE); + END; + END; + IF (TooMuch) THEN + BEGIN + SL1(ThisUser.Name+' attempt to exceed time/call limits.'); + HangUp := TRUE; + END; + IF (Tries >= General.MaxLogonTries) THEN + HangUp := TRUE; + IF (NOT HangUp) THEN + Inc(ThisUser.OnToday); + END; + IF (UserNum > 0) AND (NOT HangUp) THEN + BEGIN + GetUser := Nu; + IF (NOT FastLogon) THEN + BEGIN + PrintF('WELCOME'); + IF (NOT NoFile) THEN + PauseScr(FALSE); + I := 0; + REPEAT + Inc(I); + PrintF('WELCOME'+IntToStr(I)); + IF (NOT NoFile) THEN + PauseScr(FALSE); + UNTIL (I = 9) OR (NoFile) OR (HangUp); + END; + UserOn := TRUE; + Update_Screen; + (* + Update_Node('Logged on',TRUE); + *) + InitTrapFile; + UserOn := FALSE; + CLS; + END; + IF (HangUp) THEN + GetUser := FALSE; +END; + +END. diff --git a/SOURCE/MAIL0.PAS b/SOURCE/MAIL0.PAS new file mode 100644 index 0000000..da4eeb6 --- /dev/null +++ b/SOURCE/MAIL0.PAS @@ -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. diff --git a/SOURCE/MAIL1.PAS b/SOURCE/MAIL1.PAS new file mode 100644 index 0000000..6ac56f6 --- /dev/null +++ b/SOURCE/MAIL1.PAS @@ -0,0 +1,2408 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Mail1; + +INTERFACE + +USES + Common; + +FUNCTION Inputmessage(Pub, + IsReply: Boolean; + CONST MsgTitle: Str40; + VAR MHeader: MHeaderRec; + CONST ReadInMsg: AStr; + MaxLineLen: Byte; + MaxMsgLines: Integer): Boolean; +PROCEDURE Anonymous(Offline: Boolean; VAR MHeader: MHeaderRec); + +IMPLEMENTATION + +USES + Crt, + Common5, + File8, + File0, + Mail0, + TimeFunc; + +VAR + InportFile: Text; + InportFileOpen: Boolean; + Escp: Boolean; + +PROCEDURE Anonymous(Offline: Boolean; VAR MHeader: MHeaderRec); +VAR + An: Anontyp; + HeaderL: AStr; + UName, + Junk: Str36; + Cmd: Char; + Counter: Byte; +BEGIN + IF (ReadMsgArea <> -1) THEN + BEGIN + An := MemMsgArea.Anonymous; + IF (An = ATNo) AND (AACS(General.AnonPubPost) AND (NOT Offline)) THEN + An := ATYes; + IF (RPostAn IN ThisUser.Flags) THEN + An := ATNo; + END + ELSE IF (AACS(General.AnonPrivPost)) THEN + An := ATYes + ELSE + An := ATNo; + IF (Offline) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + IF (An = ATNo) THEN + FOR Counter := 1 TO 5 DO + BEGIN + HeaderL := Headerline(MHeader,FileSize(MsgHdrF),FileSize(MsgHdrF),Counter,Junk); + IF (HeaderL <> '') THEN + PrintACR(HeaderL); + END + ELSE + BEGIN + ReadMsg(FileSize(MsgHdrF),FileSize(MsgHdrF),FileSize(MsgHdrF)); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + IF (IOResult <> 0) THEN + SysOpLog('Anon: error opening message areas.'); + END; + END; + CASE An OF + ATNo : ; + ATForced : IF (CoSysOp) THEN + MHeader.From.Anon := 2 + ELSE + MHeader.From.Anon := 1; + ATYes : BEGIN + NL; + IF PYNQ(AOnOff(ReadMsgArea <> - 1,'Post anonymously? ','Send anonymously? '),0,FALSE) THEN + IF (CoSysOp) THEN + MHeader.From.Anon := 2 + ELSE + MHeader.From.Anon := 1; + END; + ATDearAbby : BEGIN + NL; + Print(AOnOff(ReadMsgArea <> - 1,'Post as:','Send as:')); + NL; + Print('1. Abby'); + Print('2. Problemed Person'); + Print('3. '+Caps(ThisUser.Name)); + NL; + Prt('Which? '); + OneK(Cmd,'123'^M,TRUE,TRUE); + CASE Cmd OF + '1' : MHeader.From.Anon := 3; + '2' : MHeader.From.Anon := 4; + END; + END; + ATAnyName : BEGIN + NL; + Print('You can post under any name in this area.'); + NL; + Prt('Name: '); + InputDefault(UName,MHeader.From.A1S,36,[InterActiveEdit],TRUE); + IF (UName <> MHeader.From.A1S) THEN + BEGIN + MHeader.From.Anon := 5; + MHeader.From.A1S := Caps(UName); + END; + END; + END; +END; + +PROCEDURE InputLine(VAR S: AStr; MaxLineLen: Byte); +VAR + CKeyPos, + RP, + Counter, + Counter1: Integer; + CKey, + ccc: Char; + HitCmdKey, + HitBkSpc, + DoThisChar: Boolean; + + PROCEDURE BkSpc; + BEGIN + IF (CKeyPos > 1) THEN + BEGIN + IF (S[CKeyPos - 2] = '^') AND (S[CKeyPos - 1] IN [#0..#9]) THEN + BEGIN + Dec(CKeyPos); + UserColor(1); + END + ELSE + BEGIN + BackSpace; + Dec(RP); + END; + Dec(CKeyPos); + END; + END; + +BEGIN + Write_Msg := TRUE; + HitCmdKey := FALSE; + HitBkSpc := FALSE; + ccc := '1'; + RP := 1; + CKeyPos := 1; + S := ''; + IF (LastLineStr <> '') THEN + BEGIN + Abort := FALSE; + Next := FALSE; + AllowAbort := FALSE; + Reading_A_Msg := TRUE; + PrintMain(LastLineStr); + Reading_A_Msg := FALSE; + AllowAbort := TRUE; + S := LastLineStr; + LastLineStr := ''; + IF (Pos(^[,S) > 0) THEN + Escp := TRUE; + CKeyPos := (Length(S) + 1); + RP := CKeyPos; + END; + REPEAT + IF ((InportFileOpen) AND (Buf = '')) THEN + IF (NOT EOF(InportFile)) THEN + BEGIN + Counter1 := 0; + REPEAT + Inc(Counter1); + Read(InportFile,Buf[Counter1]); + IF (Buf[Counter1] = ^J) THEN + Dec(Counter1); + UNTIL (Counter1 >= 255) OR (Buf[Counter1] = ^M) OR (EOF(InportFile)); + Buf[0] := Chr(Counter1); + END + ELSE + BEGIN + Close(InportFile); + InportFileOpen := FALSE; + DOSANSIOn := FALSE; + Buf := ^P+'1'; + END; + CKey := Char(GetKey); + DoThisChar := FALSE; + IF ((CKey >= #32) AND (CKey <= #255)) THEN + BEGIN + IF (CKey = '/') AND (CKeyPos = 1) THEN + HitCmdKey := TRUE + ELSE + DoThisChar := TRUE; + END + ELSE + CASE CKey OF + ^[ : DoThisChar := TRUE; + ^H : IF (CKeyPos = 1) THEN + BEGIN + HitCmdKey := TRUE; + HitBkSpc := TRUE; + END + ELSE + BkSpc; + ^I : BEGIN + Counter := (5 - (CKeyPos MOD 5)); + IF ((CKeyPos + Counter) < StrLen) AND ((RP + Counter) < ThisUser.LineLen) THEN + FOR Counter1 := 1 TO Counter DO + BEGIN + OutKey(' '); + IF (Trapping) THEN + Write(TrapFile,' '); + S[CKeyPos] := ' '; + Inc(RP); + Inc(CKeyPos); + END; + END; + ^J : BEGIN + OutKey(CKey); + S[CKeyPos] := CKey; + IF (Trapping) THEN + Write(TrapFile,^J); + Inc(CKeyPos); + END; + ^N : BEGIN + OutKey(^H); + S[CKeyPos] := ^H; + IF (Trapping) THEN + Write(TrapFile,^H); + Inc(CKeyPos); + Dec(RP); + END; + ^P : IF (OkANSI OR OkAvatar) AND (CKeyPos < (StrLen - 1)) THEN + BEGIN + CKey := Char(GetKey); + IF (CKey IN ['0'..'9']) THEN + BEGIN + ccc := CKey; + S[CKeyPos] := '^'; + Inc(CKeyPos); + S[CKeyPos] := CKey; + Inc(CKeyPos); + UserColor(Ord(CKey) - Ord('0')); + END; + CKey := #0; + END; + ^W : IF (CKeyPos = 1) THEN + BEGIN + HitCmdKey := TRUE; + HitBkSpc := TRUE; + END + ELSE + REPEAT + BkSpc + UNTIL (CKeyPos = 1) OR (S[CKeyPos] = ' ') OR ((S[CKeyPos] = ^H) AND (S[CKeyPos - 1] <> '^')); + ^X,^Y : BEGIN + CKeyPos := 1; + FOR Counter := 1 TO (RP - 1) DO + BackSpace; + RP := 1; + IF (ccc <> '1') THEN + BEGIN + CKey := ccc; + S[CKeyPos] := '^'; + Inc(CKeyPos); + S[CKeyPos] := CKey; + Inc(CKeyPos); + UserColor(Ord(CKey) - Ord('0')); + END; + CKey := #0; + END; + END; + IF (DoThisChar) AND ((CKey <> ^G) AND (CKey <> ^M)) THEN + IF ((CKeyPos < StrLen) AND (Escp)) OR ((RP < ThisUser.LineLen) AND (NOT Escp)) THEN + BEGIN + IF (CKey = ^[) THEN + Escp := TRUE; + S[CKeyPos] := CKey; + Inc(CKeyPos); + Inc(RP); + OutKey(CKey); + IF (Trapping) THEN + Write(TrapFile,CKey); + END; + UNTIL (((RP - 1) = MaxLineLen) AND (NOT Escp)) OR (CKeyPos = StrLen) OR (CKey = ^M) OR (HitCmdKey) OR (HangUp); + IF (HitCmdKey) THEN + BEGIN + IF (HitBkSpc) THEN + S := '/'^H + ELSE + S := '/'; + END + ELSE + BEGIN + S[0] := Chr(CKeyPos - 1); + IF (CKey <> ^M) AND (CKeyPos <> StrLen) AND (NOT Escp) THEN + BEGIN + Counter := (CKeyPos - 1); + WHILE (Counter > 1) AND (S[Counter] <> ' ') AND ((S[Counter] <> ^H) OR (S[Counter - 1] = '^')) DO + Dec(Counter); + IF (Counter > (RP DIV 2)) AND (Counter <> (CKeyPos - 1)) THEN + BEGIN + LastLineStr := Copy(S,(Counter + 1),(CKeyPos - Counter)); + FOR Counter1 := (CKeyPos - 2) DOWNTO Counter DO + BackSpace; + S[0] := Chr(Counter - 1); + END; + END; + IF (Escp) AND (RP = ThisUser.LineLen) THEN + CKeyPos := StrLen; + IF (CKeyPos <> StrLen) THEN + NL + ELSE + BEGIN + RP := 1; + CKeyPos := 1; + S := S + #29; + END; + END; + Write_Msg := FALSE; +END; + +FUNCTION Inputmessage(Pub, + IsReply: Boolean; + CONST MsgTitle: Str40; + VAR MHeader: MHeaderRec; + CONST ReadInMsg: AStr; + MaxLineLen: Byte; + MaxMsgLines: Integer): Boolean; +CONST + TopScreen = 3; {first screen line for Text entry} + ScrollSize = 5; {number OF lines to scroll by} +TYPE + LinePointer = ^LineArray; + LineArray = ARRAY [1..500] OF STRING[120]; +VAR + LinePtr: LinePointer; + PhyLine: ARRAY [1..20] OF STRING[78]; + TotalLines: 1..500; + + MsgSubj: Str40; + + MsgTo: Str36; + + ScreenLines, + MaxLines, + LastQuoteLine, + MaxQuoteLines, + CurrentLine, + TopLine, + CCol: Integer; + + DisableMCI, + CantAbort, + Insert_Mode, + SaveMsg: Boolean; + + PROCEDURE DoLines; + BEGIN + IF (OkANSI OR OkAvatar) THEN + Print('^4旼컴:컴컴:컴컴:컴컴:컴컴:컴컴:컴컴:컴컴쩡컴�:컴컴:컴컴:컴컴:컴컴:컴컴:컴컴:컴커^1') + ELSE + Print('[---:----:----:----:----:----:----:----|----:----:----:----:----:----:----:---]'); + END; + + 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; + + PROCEDURE Count_Lines; + BEGIN + TotalLines := MaxLines; + WHILE (TotalLines > 0) AND (Length(LinePtr^[TotalLines]) = 0) DO + Dec(TotalLines); + END; + + PROCEDURE Append_Space; + BEGIN + LinePtr^[CurrentLine] := LinePtr^[CurrentLine]+' '; + END; + + FUNCTION CurLength: Integer; + BEGIN + CurLength := Length(LinePtr^[CurrentLine]); + END; + + FUNCTION Line_Boundry: Boolean; + {is the cursor at either the start OF the END OF a line?} + BEGIN + Line_Boundry := (CCol = 1) OR (CCol > CurLength); + END; + + FUNCTION CurChar: Char; + {return the character under the cursor} + BEGIN + IF (CCol <= CurLength) THEN + CurChar := LinePtr^[CurrentLine][CCol] + ELSE + CurChar := ' '; + END; + + FUNCTION LastChar: Char; + {return the last character on the current line} + BEGIN + IF (CurLength = 0) THEN + LastChar := ' ' + ELSE + LastChar := LinePtr^[CurrentLine][CurLength]; + END; + + PROCEDURE Remove_Trailing; + BEGIN + WHILE (Length(LinePtr^[CurrentLine]) > 0) AND (LinePtr^[CurrentLine][Length(LinePtr^[CurrentLine])] <= ' ') DO + Dec(LinePtr^[CurrentLine][0]); + END; + + FUNCTION Delimiter: Boolean; + {return TRUE IF the current character is a Delimiter FOR words} + BEGIN + CASE CurChar OF + '0'..'9', 'a'..'z', 'A'..'Z', '_': + Delimiter := FALSE; + ELSE + Delimiter := TRUE; + END; + END; + + PROCEDURE Reposition(x: Boolean); + VAR + Eol: Integer; + BEGIN + IF (x) THEN + BEGIN + Eol := (CurLength + 1); + IF (CCol > Eol) THEN + CCol := Eol; + END; + Count_Lines; + ANSIG(CCol,((CurrentLine - TopLine) + TopScreen)); + IF (Pos('>',Copy(LinePtr^[CurrentLine],1,4)) > 0) THEN + Usercolor(3) + ELSE + Usercolor(1); + END; + + PROCEDURE Set_PhyLine; + {set physical line to match logical line (indicates display update)} + BEGIN + PhyLine[((CurrentLine - TopLine) + 1)] := LinePtr^[CurrentLine]; + END; + + PROCEDURE Clear_Eol; + BEGIN + IF (NOT OkAvatar) THEN + SerialOut(#27'[K') + ELSE + SerialOut(^V^G); + IF (WantOut) THEN + ClrEOL; + END; + + PROCEDURE Truncate_Line; + {update screen after changing END-OF-line} + BEGIN + IF (CCol > 0) THEN + LinePtr^[CurrentLine][0] := Chr(CCol - 1); + Reposition(TRUE); + Clear_Eol; + {Set_PhyLine; don't understand this} + END; + + PROCEDURE Refresh_Screen; + VAR + PLine, + PCol, + Phline, + Junk: Integer; + BEGIN + IF (CurrentLine >= MaxLines) THEN + CurrentLine := MaxLines; + PLine := CurrentLine; + CurrentLine := TopLine; + PCol := CCol; + CCol := 1; + FOR Junk := TopLine TO ((TopLine + ScreenLines) - 1) DO + BEGIN + CurrentLine:= Junk; + Phline := ((CurrentLine - TopLine) + 1); + IF (CurrentLine > MaxLines) THEN + BEGIN + Reposition (TRUE); + Prompt('^9--'); + PhyLine[Phline] := '--'; + Clear_Eol; + END + ELSE + BEGIN + IF (LinePtr^[CurrentLine] <> PhyLine[Phline]) THEN + BEGIN + Reposition (TRUE); + MCIAllowed := FALSE; + ColorAllowed := FALSE; + AllowAbort := FALSE; + PrintMain(Copy(LinePtr^[CurrentLine],1,MaxLineLen)); + MCIAllowed := TRUE; + ColorAllowed := TRUE; + AllowAbort := TRUE; + IF (CurLength < Length(PhyLine[Phline])) THEN + Clear_Eol; + Set_PhyLine; + END; + END; + END; + Tleft; + CCol := PCol; + CurrentLine := PLine; + Reposition(TRUE); + END; + + PROCEDURE Scroll_Screen(Lines: Integer); + BEGIN + Inc(TopLine,Lines); + IF (CurrentLine < TopLine) OR (CurrentLine >= (TopLine + ScreenLines)) THEN + TopLine := ((CurrentLine - ScreenLines) DIV 2); + IF (TopLine < 1) THEN + TopLine := 1 + ELSE IF (TopLine >= MaxLines) THEN + Dec(TopLine,ScrollSize DIV 2); + Refresh_Screen; + END; + + PROCEDURE Cursor_Up; + BEGIN + IF (CurrentLine > 1) THEN + Dec(CurrentLine); + IF (CurrentLine < TopLine) THEN + Scroll_Screen(-ScrollSize) + ELSE + Reposition(FALSE); + END; + + PROCEDURE Cursor_Down; + BEGIN + Inc(CurrentLine); + IF (CurrentLine >= MaxLines) THEN + BEGIN + CurrentLine := MaxLines; + IF (InportFileOpen) THEN + BEGIN + InportFileOpen := FALSE; + Close(InportFile); + END; + END; + IF ((CurrentLine - TopLine) >= ScreenLines) THEN + Scroll_Screen(ScrollSize) + ELSE + Reposition(FALSE); + END; + + PROCEDURE Cursor_EndLine; + BEGIN + CCol := (MaxLineLen + 1); (* 78 or 79 chars, Test This *) + Reposition(TRUE); + END; + + PROCEDURE Cursor_StartLine; + BEGIN + CCol := 1; + Reposition(TRUE); + END; + + PROCEDURE Cursor_Left; + BEGIN + IF (CCol = 1) THEN + BEGIN + Cursor_Up; + Cursor_EndLine; + END + ELSE + BEGIN + Dec(CCol); + IF (NOT OkAvatar) THEN + SerialOut(#27'[D') + ELSE + SerialOut(^V^E); + GoToXY((WhereX - 1),WhereY); + END; + END; + + PROCEDURE Cursor_Right; + BEGIN + IF (CCol > CurLength) THEN + BEGIN + CCol := 1; + Cursor_Down; + END + ELSE + BEGIN + OutKey(CurChar); + Inc(CCol); + END; + END; + + PROCEDURE Cursor_WordRight; + BEGIN + IF (Delimiter) THEN + BEGIN + {skip blanks right} + REPEAT + Cursor_Right; + IF (Line_Boundry) THEN + Exit; + UNTIL (NOT Delimiter); + END + ELSE + BEGIN + {find Next blank right} + REPEAT + Cursor_Right; + IF (Line_Boundry) THEN + Exit; + UNTIL (Delimiter); + {THEN move to a Word start (recursive)} + Cursor_WordRight; + END; + END; + + PROCEDURE Cursor_WordLeft; + BEGIN + IF (Delimiter) THEN + BEGIN + {skip blanks left} + REPEAT + Cursor_Left; + IF (Line_Boundry) THEN + Exit; + UNTIL (NOT Delimiter); + {find Next blank left} + REPEAT + Cursor_Left; + IF (Line_Boundry) THEN + Exit; + UNTIL (Delimiter); + {move to start OF the Word} + Cursor_Right; + END + ELSE + BEGIN + {find Next blank left} + REPEAT + Cursor_Left; + IF (Line_Boundry) THEN + Exit; + UNTIL (Delimiter); + {AND THEN move a Word left (recursive)} + Cursor_WordLeft; + END; + END; + + PROCEDURE Delete_Line; + {Delete the line at the cursor} + VAR + LineNum1: Integer; + BEGIN + FOR LineNum1 := CurrentLine TO (MaxLines - 1) DO + LinePtr^[LineNum1] := LinePtr^[LineNum1 + 1]; + LinePtr^[MaxLines] := ''; + IF (CurrentLine <= TotalLines) AND (TotalLines > 1) THEN + Dec(TotalLines); + END; + + PROCEDURE Insert_Line(CONST Contents: AStr); + {open a new line at the cursor} + VAR + LineNum1: Integer; + BEGIN + FOR LineNum1 := MaxLines DOWNTO (CurrentLine + 1) DO + LinePtr^[LineNum1] := LinePtr^[LineNum1 - 1]; + LinePtr^[CurrentLine] := Contents; + IF (CurrentLine < TotalLines) THEN + Inc(TotalLines); + IF (CurrentLine > TotalLines) THEN + TotalLines := CurrentLine; + END; + + PROCEDURE Reformat_Paragraph; + BEGIN + Remove_Trailing; + CCol := CurLength; + {FOR each line OF the paragraph} + WHILE (CurChar <> ' ') DO + BEGIN + {FOR each Word OF the current line} + REPEAT + {determine Length OF first Word on the following line} + Inc(CurrentLine); + Remove_Trailing; + CCol := 1; + WHILE (CurChar <> ' ') DO + Inc(CCol); + Dec(CurrentLine); + {hoist a Word From the following line IF it will fit} + IF (CCol > 1) AND ((CCol + CurLength) < MaxLineLen) THEN + BEGIN + IF (CurLength > 0) THEN + BEGIN + {add a second space after sentences} + CASE LastChar OF + '.', '?', '!': + Append_Space; + END; + Append_Space; + END; + LinePtr^[CurrentLine] := LinePtr^[CurrentLine] + Copy(LinePtr^[CurrentLine + 1],1,(CCol - 1)); + {remove the hoisted Word} + Inc(CurrentLine); + WHILE (CurChar = ' ') AND (CCol <= CurLength) DO + Inc(CCol); + Delete(LinePtr^[CurrentLine],1,(CCol - 1)); + IF (CurLength = 0) THEN + Delete_Line; + Dec(CurrentLine); + END + ELSE + CCol := 0; {END OF line} + UNTIL (CCol = 0); + {no more lines will fit - either time FOR Next line, OR END OF paragraph} + Inc(CurrentLine); + CCol := 1; + Remove_Trailing; + END; + END; + + PROCEDURE Word_Wrap; + {line is full AND a character must be inserted. perform Word-wrap, + updating screen AND leave ready FOR the insertion} + VAR + TempStr1: AStr; + PCol, + PLine: Integer; + BEGIN + Remove_Trailing; + PLine := CurrentLine; + PCol := CCol; + {find start OF Word to wrap} + CCol := CurLength; + WHILE (CCol > 0) AND (CurChar <> ' ') DO + Dec(CCol); + {cancel wrap IF no spaces IN whole line} + IF (CCol = 0) THEN + BEGIN + CCol := 1; + Cursor_Down; + Exit; + END; + {get the portion to be moved down} + Inc(CCol); + TempStr1 := Copy(LinePtr^[CurrentLine],CCol,MaxLineLen); + {remove it From current line AND refresh screen} + Truncate_Line; + {place Text on open a new line following the cursor} + Inc(CurrentLine); + Insert_Line(TempStr1); + {join the wrapped Text WITH the following lines OF Text} + Reformat_Paragraph; + {restore cursor to proper position after the wrap} + CurrentLine := PLine; + IF (PCol > CurLength) THEN + BEGIN + CCol := (PCol - CurLength); {position cursor after wrapped Word} + Inc(CurrentLine); {Cursor_Down;} + END + ELSE + CCol := PCol; {restore original cursor position} + IF ((CurrentLine - TopLine) >= ScreenLines) THEN + Scroll_Screen(ScrollSize) + ELSE + Refresh_Screen; + END; + + PROCEDURE Join_Lines; + {join the current line WITH the following line, IF possible} + BEGIN + Inc(CurrentLine); + Remove_Trailing; + Dec(CurrentLine); + Remove_Trailing; + IF ((CurLength + Length(LinePtr^[CurrentLine + 1])) >= MaxLineLen) THEN + Exit; + IF (LastChar <> ' ') THEN + Append_Space; + LinePtr^[CurrentLine] := LinePtr^[CurrentLine]+LinePtr^[CurrentLine + 1]; + Inc(CurrentLine); + Delete_Line; + Dec(CurrentLine); + Refresh_Screen; + END; + + PROCEDURE Split_Line; + {splits the current line at the cursor, leaves cursor IN original position} + VAR + TempStr1: AStr; + PCol: Integer; + BEGIN + PCol := CCol; + Remove_Trailing; {get the portion FOR the Next line} + TempStr1 := Copy(LinePtr^[CurrentLine],CCol,MaxLineLen); + Truncate_Line; + CCol := 1; {open a blank line} + Inc(CurrentLine); + Insert_Line(TempStr1); + IF ((CurrentLine - TopLine) > (ScreenLines - 2)) THEN + Scroll_Screen(ScrollSize) + ELSE + Refresh_Screen; + Dec(CurrentLine); + CCol := PCol; + END; + + PROCEDURE Cursor_NewLine; + BEGIN + IF (Insert_Mode) THEN + Split_Line; + CCol := 1; + Cursor_Down; + END; + + PROCEDURE Reformat; + {reformat paragraph, update display} + VAR + PLine: Integer; + BEGIN + PLine := CurrentLine; + Reformat_Paragraph; + {find start OF Next paragraph} + WHILE (CurLength = 0) AND (CurrentLine <= TotalLines) DO + Inc(CurrentLine); + {find top OF screen FOR Redisplay} + WHILE ((CurrentLine - TopLine) > (ScreenLines - 2)) DO + BEGIN + Inc(TopLine,ScrollSize); + PLine := TopLine; + END; + Refresh_Screen; + END; + + PROCEDURE Insert_Char(C1: Char); + BEGIN + IF (CCol < CurLength) THEN + BEGIN + Remove_Trailing; + IF (CCol > CurLength) THEN + Reposition(TRUE); + END; + IF (Insert_Mode AND (CurLength >= MaxLineLen)) OR (CCol > MaxLineLen) THEN + BEGIN + IF (CCol <= MaxLineLen) THEN + Word_Wrap + ELSE IF (C1 = ' ') THEN + BEGIN + Cursor_NewLine; + Exit; + END + ELSE IF (LastChar = ' ') THEN + Cursor_NewLine {nonspace w/space at END-line is newline} + ELSE + Word_Wrap; {otherwise wrap Word down AND continue} + END; + {Insert character into the middle OF a line} + IF (Insert_Mode) AND (CCol <= CurLength) THEN + BEGIN + Insert(C1,LinePtr^[CurrentLine],CCol); + {update display line following cursor} + MCIAllowed := FALSE; + ColorAllowed := FALSE; + AllowAbort := FALSE; + PrintMain(Copy(LinePtr^[CurrentLine],CCol,MaxLineLen)); + MCIAllowed := TRUE; + ColorAllowed := TRUE; + AllowAbort := TRUE; + {position cursor FOR Next insertion} + Inc(CCol); + Reposition(TRUE); + END + ELSE + BEGIN {append a character to the END OF a line} + WHILE (CurLength < CCol) DO + Append_Space; + LinePtr^[CurrentLine][CCol] := C1; + {advance the cursor, updating the display} + Cursor_Right; + END; + Set_PhyLine; + END; + + PROCEDURE Delete_Char; + BEGIN + {Delete whole line IF it is empty} + IF (CCol > CurLength) AND (CurLength > 0) THEN + Join_Lines + ELSE IF (CCol <= CurLength) THEN + BEGIN {Delete IN the middle OF a line} + Delete(LinePtr^[CurrentLine],CCol,1); + MCIAllowed := FALSE; + ColorAllowed := FALSE; + AllowAbort := FALSE; + PrintMain(Copy(LinePtr^[CurrentLine],CCol,MaxLineLen)+' '); + MCIAllowed := TRUE; + ColorAllowed := TRUE; + AllowAbort := TRUE; + Reposition(TRUE); + Set_PhyLine; + END; + END; + + PROCEDURE Delete_WordRight; + BEGIN + IF (CurChar = ' ') THEN + REPEAT {skip blanks right} + Delete_Char; + UNTIL (CurChar <> ' ') OR (CCol > CurLength) + ELSE + BEGIN + REPEAT {find Next blank right} + Delete_Char; + UNTIL (Delimiter); + Delete_Char; + END; + END; + + PROCEDURE Page_Down; + BEGIN + IF ((TopLine + ScreenLines) < MaxLines) THEN + BEGIN + Inc(CurrentLine,ScrollSize); + Scroll_Screen(ScrollSize); + END; + END; + + PROCEDURE Page_Up; + BEGIN + IF (TopLine > 1) THEN + BEGIN + Dec(CurrentLine,ScrollSize); + IF (CurrentLine < 1) THEN + CurrentLine := 1; + Scroll_Screen(-ScrollSize); + END + ELSE + BEGIN + CurrentLine := 1; + CCol := 1; + Scroll_Screen(0); + END; + END; + + PROCEDURE FS_Delete_Line; + {Delete the line at the cursor, update display} + BEGIN + Delete_Line; + Refresh_Screen; + END; + + PROCEDURE Display_Insert_Status; + BEGIN + ANSIG(69,1); + Prompt('^1(Mode: '); + IF (Insert_Mode) THEN + Prompt('INS)') + ELSE + Prompt('OVR)'); + END; + + PROCEDURE Prepare_Screen; + VAR + Counter: Integer; + BEGIN + CLS; + ANSIG(1,1); + IF (TimeWarn) THEN + Prompt(^G^G' |12Warning: |10You have less than '+IntToStr(NSL DIV 60 + 1)+' '+ + Plural('minute',NSL DIV 60 + 1)+' remaining online!') + ELSE + BEGIN + Prompt('^1(Ctrl-Z = Help) ^5To:^1 '+PadLeftStr(MsgTo,20)+' ^5Subj: ^1'); + IF (MHeader.FileAttached = 0) THEN + Print(PadLeftStr(MsgSubj,20)) + ELSE + Print(PadLeftStr(StripName(MsgSubj),20)); + Display_Insert_Status; + END; + ANSIG(1,2); + DoLines; + FOR Counter := 1 TO ScreenLines DO {physical lines are now invalid} + PhyLine[Counter] := ''; + Scroll_Screen(0); {causes Redisplay} + END; + + PROCEDURE Redisplay; + BEGIN + TopLine := ((CurrentLine - ScreenLines) DIV 2); + Prepare_Screen; + END; + + PROCEDURE FS_Help; + BEGIN + CLS; + PrintF('FSHELP'); + PauseScr(FALSE); + Prepare_Screen; + END; + + PROCEDURE DoQuote(RedrawScreen: Boolean); + VAR + QuoteFile: Text; + TempStr1: AStr; + Fline, + Nline, + QuoteLi: Integer; + Done: Boolean; + + PROCEDURE GetOut(x: Boolean); + BEGIN + IF (x) THEN + Close(QuoteFile); + IF (InvisEdit) AND (RedrawScreen) THEN + Prepare_Screen; + MCIAllowed := TRUE; + END; + + BEGIN + Assign(QuoteFile,'TEMPQ'+IntToStr(ThisNode)); + Reset(QuoteFile); + IF (IOResult <> 0) THEN + Exit; + IF (MaxQuoteLines = 0) THEN + BEGIN + WHILE NOT EOF(QuoteFile) DO + BEGIN + ReadLn(QuoteFile,TempStr1); + Inc(MaxQuoteLines); + END; + Close(QuoteFile); + Reset(QuoteFile); + END; + + MCIAllowed := FALSE; + Done := FALSE; + + REPEAT + Abort := FALSE; + Next := FALSE; + CLS; + QuoteLi := 0; + IF (LastQuoteLine > 0) THEN + WHILE NOT EOF(QuoteFile) AND (QuoteLi < LastQuoteLine) DO + BEGIN + ReadLn(QuoteFile,TempStr1); + Inc(QuoteLi); + END; + IF EOF(QuoteFile) THEN + BEGIN + LastQuoteLine := 0; + QuoteLi := 0; + Reset(QuoteFile); + END; + WHILE (NOT EOF(QuoteFile)) AND ((QuoteLi - LastQuoteLine) < (PageLength - 4)) DO + BEGIN + ReadLn(QuoteFile,TempStr1); + Inc(QuoteLi); + TempStr1 := Copy(PadRightInt(QuoteLi,Length(IntToStr(MaxQuoteLines)))+':'+TempStr1,1,MaxLineLen); + PrintACR('^3'+TempStr1); + END; + Close(QuoteFile); + Reset(QuoteFile); + REPEAT + NL; + Prt('First line to quote [^5?^4=^5Help^4]: '); + Scaninput(TempStr1,'HQ?'^M); + IF (TempStr1 = '?') THEN + BEGIN + NL; + Print('^1<^3Q^1>uit, <^3H^1>eader, <^3?^1>Help, or first line to quote.'); + END + ELSE IF (TempStr1 = 'H') THEN + BEGIN + WHILE (TempStr1 > '') AND (NOT EOF(QuoteFile)) AND (CurrentLine <= MaxLines) DO + BEGIN + ReadLn(QuoteFile,TempStr1); + IF (InvisEdit) THEN + Insert_Line(TempStr1) + ELSE + BEGIN + LinePtr^[TotalLines] := TempStr1; + Inc(TotalLines); + END; + Inc(CurrentLine); + END; + Close(QuoteFile); + Reset(QuoteFile); + TempStr1 := 'H'; + END; + UNTIL ((TempStr1 <> '?') AND (TempStr1 <> 'H')) OR (HangUp); + Fline := StrToInt(TempStr1); + IF (Fline <= 0) THEN + LastQuoteLine := QuoteLi; + IF (TempStr1 = 'Q') THEN + Done := TRUE; + IF (Fline > MaxQuoteLines) OR (HangUp) THEN + BEGIN + GetOut(TRUE); + Exit; + END; + IF (Fline > 0) THEN + BEGIN + Prt('Last line to quote: '); + Scaninput(TempStr1,'Q'^M); + IF (TempStr1 <> #13) THEN + Nline := StrToInt(TempStr1) + ELSE + Nline := Fline; + IF (Nline < Fline) OR (Nline > MaxQuoteLines) THEN + BEGIN + GetOut(TRUE); + Exit; + END; + Nline := ((Nline - Fline) + 1); + WHILE (NOT EOF(QuoteFile)) AND (Fline > 1) DO + BEGIN + Dec(Fline); + ReadLn(QuoteFile,TempStr1); + END; + IF (NOT InvisEdit) THEN + CurrentLine := TotalLines; + WHILE (NOT EOF(QuoteFile)) AND (Nline > 0) AND (CurrentLine <= MaxLines) DO + BEGIN + Dec(Nline); + ReadLn(QuoteFile,TempStr1); + IF (InvisEdit) THEN + Insert_Line(TempStr1) + ELSE + BEGIN + LinePtr^[TotalLines] := TempStr1; + Inc(TotalLines); + END; + Inc(CurrentLine); + END; + Done := TRUE; + END; + UNTIL (Done) OR (HangUp); + GetOut(TRUE); + LastError := IOResult; + END; + + PROCEDURE FS_Editor; + VAR + GKey: Word; + SaveTimeWarn: Boolean; + BEGIN + InvisEdit := TRUE; + Insert_Mode := TRUE; + SaveTimeWarn := TimeWarn; + Count_Lines; + IF (TotalLines > 0) THEN + CurrentLine := (TotalLines + 1) + ELSE + CurrentLine := 1; + CCol := 1; + TopLine := 1; + ScreenLines := (PageLength - 4); + IF (ScreenLines > 20) THEN + ScreenLines := 20; + WHILE (CurrentLine - TopLine) > (ScrollSize + 3) DO + Inc(TopLine,ScrollSize); + Prepare_Screen; + REPEAT + IF ((InportFileOpen) AND (Buf = '')) THEN + IF (NOT EOF(InportFile)) THEN + BEGIN + ReadLn(InportFile,Buf); + Buf := Buf + ^M + END + ELSE + BEGIN + Close(InportFile); + InportFileOpen := FALSE; + END; + IF (TimeWarn) AND (NOT SaveTimeWarn) THEN + BEGIN + ANSIG(1,1); + Prompt(^G^G' |12Warning: |10You have '+IntToStr(NSL DIV 60)+' minute(s) remaining online!'); + ANSIG(CCol,((CurrentLine - TopLine) + TopScreen)); + SaveTimeWarn := TRUE; + END; + GKey := GetKey; + CASE GKey OF + 47 : + IF (CCol = 1) AND (NOT InportFileOpen) THEN + GKey := 27 + ELSE + Insert_Char(Char(GKey)); + 127 : + Delete_Char; + 32..46, 48..126, 128..254 : + Insert_Char(Char(GKey)); + 8 : BEGIN + IF (CCol = 1) THEN + BEGIN + Cursor_Left; + Join_Lines; + END + ELSE + BEGIN + Cursor_Left; + Delete_Char; + END; + END; + F_CTRLLEFT,1 : + Cursor_WordLeft; { ^A } + 2 : Reformat; { ^B } + F_PGDN,3 : + Page_Down; { ^C } + F_RIGHT,4 : + Cursor_Right; { ^D } + F_UP,5 : + Cursor_Up; { ^E } + F_CTRLRIGHT,6 : + Cursor_WordRight; { ^F } + F_DEL,7 : + Delete_Char; { ^G } + 9 : REPEAT + Insert_Char(' '); + UNTIL ((CCol MOD 5) = 0); { ^I } + 10 : + Join_Lines; { ^J } + F_END,11 : + Cursor_EndLine; { ^K } + 12 : + Redisplay; { ^L } + 13 : + Cursor_NewLine; { ^M } + 14 : + BEGIN + Split_Line; + Reposition(TRUE); + END; { ^N } + 16 : + BEGIN { ^P } + GKey := GetKey; + IF (GKey IN [0..9,Ord('0')..Ord('9')]) THEN + BEGIN + Insert_Char('^'); + Insert_Char(Char(GKey)); + END + ELSE + Buf := Char(GKey); + GKey := 0; + END; + 17 : + DoQuote(TRUE); { ^Q } + F_PGUP,18 : + Page_Up; { ^R } + F_LEFT,19 : + Cursor_Left; { ^S } + 20 : + Delete_WordRight;{ ^T } + F_INS,22 : + BEGIN { ^V } + Insert_Mode := NOT Insert_Mode; + Display_Insert_Status; + Reposition(TRUE); + END; + F_HOME,23 : + Cursor_StartLine; { ^W } + F_DOWN,24 : + Cursor_Down; { ^X } + 25 : + FS_Delete_Line; { ^Y } + 26 : + FS_Help; { ^Z } + END; + UNTIL ((GKey = 27) AND (NOT InportFileOpen)) OR (HangUp); + IF (InportFileOpen) THEN + BEGIN + Close(InportFile); + InportFileOpen := FALSE; + END; + Count_Lines; + InvisEdit := FALSE; + END; + + PROCEDURE PrintMsgTitle; + BEGIN + NL; + (* + Print(FString.lentermsg1); + *) + lRGLngStr(6,FALSE); + (* + Print(FString.lentermsg2); + *) + lRGLNGStr(7,FALSE); + DoLines; + END; + + PROCEDURE InputTheMessage(CantAbort1: Boolean; VAR DisableMCI1,SaveMsg1: Boolean); + VAR + LineStr, + TempStr1, + TempStr2, + TempStr3: AStr; + SaveMsgSubj: Str40; + Cmd, + Drive: Char; + SaveFileAttached, + HelpCounter: Byte; + Counter, + LineNum1, + LineNum2: SmallInt; + ShowCont, + ExitMsg, + SaveLine, + AbortMsg: Boolean; + + PROCEDURE EditMsgTo(VAR MsgTo1: Str36); + VAR + User: UserRecordType; + TempMsgTo: Str36; + UNum: Integer; + BEGIN + { Print(FString.default + ^M^J); } + lRGLngStr(34,FALSE); + IF (Pub) AND (NOT (MAInternet IN MemMsgArea.MAFlags)) THEN + BEGIN + Prt('To: '); + IF (MsgTo1 <> '') THEN + InputDefault(TempMsgTo,MsgTo1,36,[NoLineFeed,CapWords],FALSE) + ELSE + BEGIN + MPL(36); + InputMain(TempMsgTo,36,[NoLineFeed,CapWords]); + END; + MsgTo1 := TempMsgTo; + UserColor(6); + FOR UNum := 1 TO LennMCI(MsgTo1) DO + BackSpace; + UNum := StrToInt(MsgTo1); + IF (UNum >= 1) AND (UNum <= (MaxUsers - 1)) AND NOT (NetMail IN MHeader.Status) THEN + BEGIN + LoadURec(User,UNum); + MsgTo1 := Caps(User.Name); + MHeader.MTO.UserNum := UNum; + MHeader.MTO.Real := User.RealName; + IF (Pub) AND (MARealName IN MemMsgArea.MAFlags) THEN + MsgTo1 := Caps(User.RealName) + ELSE + MsgTo1 := Caps(User.Name); + END; + IF (SQOutSp(MsgTo1) = '') THEN + MsgTo1 := 'All'; + IF (MsgTo1 <> '') THEN + BEGIN + Prompt(MsgTo1); + UserColor(1); + NL; + END; + END + ELSE IF (NOT (MAInternet IN MemMsgArea.MAFlags)) THEN + Print(PadLeftStr('^4To: ^6'+Caps(MsgTo1),40)); + END; + + PROCEDURE EditMsgSubj(VAR MsgSubj1: Str40; CantAbort2: Boolean); + VAR + TempMsgSubj: Str40; + BEGIN + IF (MHeader.FileAttached = 0) AND (NOT CantAbort2) THEN + BEGIN + Prt('Subject: '); + IF (MsgSubj1 <> '') THEN + InputDefault(TempMsgSubj,MsgSubj1,40,[NoLineFeed],FALSE) + ELSE + BEGIN + MPL(40); + InputMain(TempMsgSubj,40,[NoLineFeed]); + END; + IF (TempMsgSubj <> '') THEN + MsgSubj1 := TempMsgSubj + ELSE + BEGIN + IF (MsgSubj1 <> '') THEN + Prompt('^6'+MsgSubj1+'^1'); + END; + NL; + END + ELSE + MsgSubj1 := MHeader.Subject; + UserColor(1); + END; + + PROCEDURE FileAttach(VAR ExitMsg1: Boolean); + VAR + FileName: Str40; + DOk, + KAbort, + AddBatch: Boolean; + TransferTime: LongInt; + BEGIN + NL; + Prt('File name: '); + MPL(40); + Input(FileName,40); + NL; + IF (NOT CoSysOp) OR (NOT IsUL(FileName)) THEN + FileName := General.FileAttachPath+StripName(FileName); + IF (NOT Exist(FileName)) AND (NOT InCom) AND (NOT Exist(FileName)) AND (FileName <> '') THEN + BEGIN + Print('^7That file does not exist!^1'); + ExitMsg1 := FALSE; + END + ELSE + BEGIN + IF Exist(FileName) AND (NOT CoSysOp) THEN + BEGIN + Print('^7You cannot use that file name!^1'); + ExitMsg1 := FALSE; + END + ELSE + BEGIN + IF (NOT Exist(FileName)) AND (InCom) THEN + BEGIN + Receive(FileName,TempDir+'\UP',FALSE,DOk,KAbort,AddBatch,TransferTime); + MHeader.FileAttached := 1; + END + ELSE IF Exist(FileName) THEN + BEGIN + DOk := TRUE; + MHeader.FileAttached := 2; + END; + IF (DOk) THEN + BEGIN + MsgSubj := FileName; + IF (CoSysOp) AND (NOT (NetMail IN MHeader.Status)) THEN + BEGIN + IF PYNQ('Delete file upon receipt? ',0,FALSE) THEN + MHeader.FileAttached := 1 + ELSE + MHeader.FileAttached := 2 + END + ELSE + MHeader.FileAttached := 1; + END + ELSE + MHeader.FileAttached := 0; + END; + END; + UserColor(1); + END; + + PROCEDURE ListMsg(LineNum1: Integer; DisplayLineNum: Boolean; VAR SaveLine: Boolean); + BEGIN + MCIAllowed := FALSE; + AllowContinue := TRUE; + DOSANSIOn := FALSE; + Abort := FALSE; + Next := FALSE; + NL; + WHILE ((LineNum1 <= (TotalLines - 1)) AND (NOT Abort) AND (NOT HangUp)) DO + BEGIN + IF (DisplayLineNum) THEN + Print('^3'+IntToStr(LineNum1)+':'); + Reading_A_Msg := TRUE; + IF (NOT DOSANSIOn) THEN + IF (Pos('>',Copy(LinePtr^[LineNum1],1,4)) > 0) THEN + UserColor(3) + ELSE + UserColor(1); + PrintACR(LinePtr^[LineNum1]); + Reading_A_Msg := FALSE; + Inc(LineNum1); + END; + IF (DisplayLineNum) THEN + BEGIN + NL; + Print(' ^7** ^3'+IntToStr(TotalLines - 1)+' '+(Plural('line',(TotalLines - 1))+' ^7**')); + END; + MCIAllowed := TRUE; + AllowContinue := FALSE; + DOSANSIOn := FALSE; + SaveLine := FALSE; + UserColor(1); + END; + + PROCEDURE UploadFile; + VAR + TempStr1: AStr; + DOk, + KAbort, + AddBatch: Boolean; + TransferTime: LongInt; + BEGIN + NL; + TempStr1 := ''; + IF (CoSysOp) THEN + BEGIN + Prt('Enter file to import [Enter=Upload]: '); + MPL(40); + Input(TempStr1,40); + END; + IF (TempStr1 = '') THEN + BEGIN + TempStr1 := 'TEMPMSG.'+IntToStr(ThisNode); + IF Exist(TempStr1) THEN + Kill(TempStr1); + END; + IF (NOT Exist(TempStr1)) AND (InCom) THEN + BEGIN + Receive(TempStr1,TempDir+'UP\',FALSE,DOk,KAbort,AddBatch,TransferTime); + TempStr1 := TempDir+'UP\'+TempStr1; + END; + IF ((TempStr1 <> '') AND (NOT HangUp)) THEN + BEGIN + Assign(InportFile,TempStr1); + Reset(InportFile); + IF (IOResult = 0) THEN + InportFileOpen := TRUE; + END; + UserColor(1); + END; + + BEGIN + FillChar(LinePtr^,(MaxLines * 121),0); + Abort := FALSE; + Next := FALSE; + AbortMsg := FALSE; + SaveMsg1 := FALSE; + DisableMCI1 := FALSE; + TotalLines := 1; + LastLineStr := ''; + + IF (NOT CheckDriveSpace('Message posting',General.MsgPath,General.MinSpaceForPost)) THEN + MsgSubj := '' + ELSE + BEGIN + IF (ReadInMsg <> '') THEN + BEGIN + Assign(InportFile,ReadInMsg); + Reset(InportFile); + IF (IOResult = 0) THEN + BEGIN + WHILE (NOT EOF(InportFile)) AND ((TotalLines - 1) <= MaxLines) DO + BEGIN + ReadLn(InportFile,LinePtr^[TotalLines]); + Inc(TotalLines); + END; + Close(InportFile); + END; + END + ELSE + BEGIN + EditMsgTo(MsgTo); + NL; + EditMsgSubj(MsgSubj,CantAbort1); + END; + END; + + IF (MsgSubj = '') THEN + IF (NOT CantAbort1) THEN + BEGIN + SaveMsg1 := FALSE; + NL; + Print('Aborted!'); + Exit; + END; + + IF (FSEditor IN ThisUser.SFlags) THEN + BEGIN + REPEAT + FS_Editor; + REPEAT + ExitMsg := TRUE; + NL; + Prt('Full screen editor (^5?^4=^5Help^4): '); + OneK(Cmd,^M'ACFMQSTU?',TRUE,TRUE); + NL; + CASE Cmd OF + 'A' : IF (CantAbort1) THEN + BEGIN + Print('^7You can not abort this message!^1'); + ExitMsg := FALSE; + END + ELSE IF PYNQ('Abort message? ',0,FALSE) THEN + BEGIN + AbortMsg := TRUE; + SaveMsg1 := FALSE; + NL; + Print('Aborted!'); + END; + 'C' : IF (TotalLines = 0) THEN + BEGIN + Print('^7Nothing to clear!^1'); + ExitMsg := FALSE; + END + ELSE IF PYNQ('Clear message? ',0,FALSE) THEN + FOR LineNum1 := 1 TO TotalLines DO + LinePtr^[LineNum1][0] := #0; + 'F' : IF (NOT AACS(General.FileAttachACS)) THEN + BEGIN + Print('^7You do not have access to this command!^1'); + ExitMsg := FALSE; + END + ELSE IF (CantAbort1) THEN + BEGIN + Print('^7You can not attach a file to this message!^1'); + ExitMsg := FALSE; + END + ELSE IF (MHeader.FileAttached > 0) THEN + BEGIN + Print('File attached: ^5'+StripName(MsgSubj)); + NL; + IF (PYNQ('Replace the attached file? ',0,FALSE)) THEN + FileAttach(ExitMsg) + ELSE + BEGIN + NL; + IF (PYNQ('Remove the attached file? ',0,FALSE)) THEN + BEGIN + SaveFileAttached := MHeader.FileAttached; + SaveMsgSubj := MsgSubj; + MHeader.FileAttached := 0; + MsgSubj := ''; + NL; + EditMsgSubj(MsgSubj,CantAbort1); + IF (MsgSubj = '') THEN + BEGIN + MsgSubj := SaveMsgSubj; + MHeader.FileAttached := SaveFileAttached; + NL; + Print('Aborted!'); + END; + END; + END; + END + ELSE IF PYNQ('Attach a file to this message? ',0,FALSE) THEN + FileAttach(ExitMsg); + 'M' : IF (NOT AACS(MemMsgArea.MCIACS)) THEN + BEGIN + Print('^7You do not have access to this command!^1'); + ExitMsg := FALSE; + END + ELSE + DisableMCI1 := PYNQ('Disable MCI Codes for this message ['+SQOutSp(ShowYesNo(DisableMCI1))+']? ',0,FALSE); + 'Q' : IF (NOT Exist('TEMPQ'+IntToStr(ThisNode))) THEN + BEGIN + Print('^7You are not replying to a message!^1'); + ExitMsg := FALSE; + END + ELSE IF ((TotalLines + 1) = MaxLines) THEN + BEGIN + Print('^7You have reached the maximum line limit!^1'); + ExitMsg := FALSE; + END + ELSE + BEGIN + InvisEdit := TRUE; + DoQuote(FALSE); + InvisEdit := FALSE; + END; + 'S' : BEGIN + FOR Counter := TotalLines DOWNTO 1 DO + BEGIN + LineNum2 := 0; + FOR LineNum1 := 1 TO Length(LinePtr^[Counter]) DO + IF (LinePtr^[Counter][LineNum1] <> ' ') THEN + Inc(LineNum2); + IF (LineNum2 = 0) THEN + BEGIN + LinePtr^[Counter][0] := #0; + Dec(TotalLines) + END + ELSE + Counter := 1; + END; + IF (CantAbort1) AND (TotalLines = 0) THEN + BEGIN + Print('^7You must complete this message!^1'); + ExitMsg := FALSE; + END + ELSE IF (TotalLines = 0) THEN + BEGIN + Print('^7Nothing to save!^1'); + ExitMsg := FALSE; + END + ELSE + BEGIN + SaveMsg1 := TRUE; + AbortMsg := FALSE; + Inc(TotalLines); + END; + END; + 'T' : IF (CantAbort1) THEN + BEGIN + Print('^7The receiver and subject can not be changed!^1'); + ExitMsg := FALSE; + END + ELSE + BEGIN + IF (NOT Pub) OR (MAInternet IN MemMsgArea.MAFlags) THEN + BEGIN + Print('^7The receiver of this message can not be changed!'); + ExitMsg := FALSE; + END + ELSE + EditMsgTo(MsgTo); + NL; + IF (MHeader.FileAttached > 0) THEN + BEGIN + Print('^7The subject of this message can not be changed!'); + ExitMsg := FALSE; + END + ELSE + EditMsgSubj(MsgSubj,CantAbort1); + END; + 'U' : IF ((TotalLines + 1) = MaxLines) THEN + BEGIN + Print('^7You have reached the maximum line limit!^1'); + ExitMsg := FALSE; + END + ELSE IF PYNQ('Import a file to this message? ',0,FALSE) THEN + UploadFile; + ^M : ExitMsg := TRUE; + '?' : BEGIN + PrintF('FSHELP'); + ExitMsg := FALSE; + END; + END; + UNTIL (AbortMsg) OR (ExitMsg) OR (SaveMsg1) OR (HangUp); + UNTIL ((AbortMsg) OR (SaveMsg1) OR (HangUp)); + END + ELSE + BEGIN + PrintMsgTitle; + HelpCounter := 1; + REPEAT + SaveLine := TRUE; + ExitMsg := TRUE; + InputLine(LineStr,MaxLineLen); + REPEAT + IF (LineStr = '/'^H) THEN + BEGIN + SaveLine := FALSE; + IF ((TotalLines - 1) >= 1) THEN + BEGIN + Dec(TotalLines); + LastLineStr := LinePtr^[TotalLines]; + IF (LastLineStr[Length(LastLineStr)] = #1) THEN + LastLineStr := Copy(LastLineStr,1,(Length(LastLineStr) - 1)); + NL; + Print('^3Backed up to line '+IntToStr(TotalLines)+':^1'); + END; + END; + IF (LineStr = '/') AND (NOT (InportFileOpen)) THEN + BEGIN + SaveLine := FALSE; + ShowCont := TRUE; + NL; + Prt('Line editor (^5?^4=^5Help^4): '); + OneK(Cmd,^M'ACDFILMOPQRSTUZ?',TRUE,TRUE); + IF (Cmd <> ^M) THEN + NL; + CASE Cmd OF + 'A' : IF (CantAbort1) THEN + Print('^7You can not abort this message!^1') + ELSE IF PYNQ('Abort message? ',0,FALSE) THEN + BEGIN + AbortMsg := TRUE; + SaveMsg1 := FALSE; + ShowCont := FALSE; + NL; + Print('Aborted!'); + END; + 'C' : IF ((TotalLines - 1) < 1) THEN + Print('^7Nothing to clear!^1') + ELSE IF PYNQ('Clear message? ',0,FALSE) THEN + BEGIN + IF ((TotalLines - 1) = MaxLines) THEN + ExitMsg := TRUE; + FOR LineNum1 := 1 TO (TotalLines - 1) DO + LinePtr^[LineNum1][0] := #0; + TotalLines := 1; + Escp := FALSE; + ShowCont := FALSE; + NL; + Print('^0Message cleared ... Start over ...^1'); + NL; + END; + 'D' : IF ((TotalLines - 1) < 1) THEN + Print('^7No lines to delete!^1') + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('Delete which line',LineNum1,[NumbersOnly],1,(TotalLines - 1)); + IF (LineNum1 >= 1) AND (LineNum1 <= (TotalLines - 1)) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + NL; + Print('^3Line '+IntToStr(LineNum1)+':'); + MCIAllowed := FALSE; + PrintAcr('^1'+LinePtr^[LineNum1]); + MCIAllowed := TRUE; + NL; + IF (PYNQ('Delete this line? ',0,FALSE)) THEN + BEGIN + IF ((TotalLines - 1) = MaxLines) THEN + ExitMsg := TRUE; + FOR LineNum2 := LineNum1 TO (TotalLines - 2) DO + LinePtr^[LineNum2] := LinePtr^[LineNum2 + 1]; + Dec(TotalLines); + NL; + Print('^0Line '+IntToStr(LineNum1)+' deleted.^1'); + END; + END; + END; + 'F' : IF (NOT AACS(General.FileAttachACS)) THEN + Print('^7You do not have access to this command!^1') + ELSE IF (CantAbort1) THEN + Print('^7You can not attach a file to this message!^1') + ELSE IF (MHeader.FileAttached > 0) THEN + BEGIN + Print('File attached: ^5'+StripName(MsgSubj)); + NL; + IF (PYNQ('Replace the attached file? ',0,FALSE)) THEN + BEGIN + FileAttach(ExitMsg); + ExitMsg := TRUE; + END + ELSE + BEGIN + NL; + IF (PYNQ('Remove the attached file? ',0,FALSE)) THEN + BEGIN + SaveFileAttached := MHeader.FileAttached; + SaveMsgSubj := MsgSubj; + MHeader.FileAttached := 0; + MsgSubj := ''; + NL; + EditMsgSubj(MsgSubj,CantAbort1); + IF (MsgSubj = '') THEN + BEGIN + MsgSubj := SaveMsgSubj; + MHeader.FileAttached := SaveFileAttached; + NL; + Print('Aborted!'); + END; + END; + END; + END + ELSE IF PYNQ('Attach a file to this message? ',0,FALSE) THEN + BEGIN + FileAttach(ExitMsg); + ExitMsg := TRUE; + END; + 'I' : IF ((TotalLines - 1) < 1) THEN + Print('^7No lines to insert before!^1') + ELSE IF ((TotalLines - 1) >= MaxLines) THEN + Print('^7You have reached the maximum line limit!^1') + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('Insert before which line',LineNum1,[NumbersOnly],1,TotalLines); + IF (LineNum1 >= 1) AND (LineNum1 <= TotalLines) THEN + BEGIN + NL; + Print('^3Line '+IntToStr(LineNum1)+':'); + UserColor(1); + InputLine(TempStr1,MaxLineLen); + NL; + IF (PYNQ('Insert this line? ',0,FALSE)) THEN + BEGIN + FOR LineNum2 := TotalLines DOWNTO (LineNum1 + 1) DO + LinePtr^[LineNum2] := LinePtr^[LineNum2 - 1]; + LinePtr^[LineNum1] := TempStr1; + Inc(TotalLines); + IF ((TotalLines - 1) = MaxLines) THEN + ExitMsg := FALSE; + NL; + Print('^0Line '+IntToStr(LineNum1)+' inserted.^1'); + END; + END; + END; + 'L' : IF ((TotalLines - 1) < 1) THEN + Print('^7Nothing to list!^1') + ELSE + BEGIN + IF (PYNQ('List entire message? ',0,TRUE)) THEN + BEGIN + NL; + ListMsg(1,PYNQ('List message with line numbers? ',0,FALSE),SaveLine); + END + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('%LFStaring line number',LineNum1,[NumbersOnly],1,(TotalLines - 1)); + IF (LineNum1 >= 1) AND (LineNum1 <= (TotalLines - 1)) THEN + BEGIN + NL; + ListMsg(LineNum1,PYNQ('List message with line numbers? ',0,FALSE),SaveLine); + END; + END; + ShowCont := FALSE; + END; + 'M' : IF (NOT AACS(MemMsgArea.MCIACS)) THEN + Print('^7You do not have access to this command!^1') + ELSE + DisableMCI1 := PYNQ('Disable MCI Codes for this message ['+SQOutSp(ShowYesNo(DisableMCI1))+']? ',0,FALSE); + 'O' : PrintF('COLOR'); + 'P' : IF ((TotalLines - 1) < 1) THEN + Print('^7No lines to replace a string!^1') + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('Line to replace string',LineNum1,[NumbersOnly],1,(TotalLines - 1)); + IF (LineNum1 >= 1) AND (LineNum1 <= (TotalLines - 1)) THEN + BEGIN + TempStr3 := LinePtr^[LineNum1]; + Abort := FALSE; + Next := FALSE; + NL; + Print('^3Old line '+IntToStr(LineNum1)+':'); + MCIAllowed := FALSE; + PrintACR('^1'+TempStr3); + MCIAllowed := TRUE; + NL; + Print('^4Enter string to replace:'); + Prt(': '); + InputL(TempStr1,MaxLineLen); + IF (TempStr1 <> '') THEN + IF (Pos(TempStr1,LinePtr^[LineNum1]) = 0) THEN + BEGIN + NL; + Print('^7String not found.^1'); + END + ELSE + BEGIN + NL; + Print('^4Enter replacement string:'); + Prt(': '); + InputL(TempStr2,MaxLineLen); + IF (TempStr2 <> '') THEN + BEGIN + IF (Pos(TempStr1,TempStr3) > 0) THEN + BEGIN + Insert(TempStr2,TempStr3,(Pos(TempStr1,TempStr3) + Length(TempStr1))); + Delete(TempStr3,Pos(TempStr1,TempStr3),Length(TempStr1)); + END; + NL; + Print('^3New line '+IntToStr(LineNum1)+':'); + MCIAllowed := FALSE; + PrintACR('^1'+TempStr3); + MCIAllowed := TRUE; + NL; + IF (PYNQ('Save this line? ',0,FALSE)) THEN + BEGIN + Insert(TempStr2,LinePtr^[LineNum1],(Pos(TempStr1,LinePtr^[LineNum1]) + Length(TempStr1))); + Delete(LinePtr^[LineNum1],Pos(TempStr1,LinePtr^[LineNum1]),Length(TempStr1)); + NL; + Print('^0Line '+IntToStr(LineNum1)+' saved.^1'); + END; + END; + END; + END; + END; + 'Q' : IF (NOT Exist('TEMPQ'+IntToStr(ThisNode))) THEN + Print('^7You are not replying to a message!^1') + ELSE IF ((TotalLines - 1) >= MaxLines) THEN + Print('^7You have reached the maximum line limit!^1') + ELSE + BEGIN + DoQuote(FALSE); + NL; + CLS; + PrintMsgTitle; + Print('^0Quoting complete ... Continue ...^1'); + NL; + IF ((TotalLines - 1) >= 1) THEN + IF ((TotalLines - 1) > 10) THEN + ListMsg(((TotalLines - 1) - 10),FALSE,SaveLine) + ELSE + ListMsg(1,FALSE,SaveLine); + ShowCont := FALSE; + END; + 'R' : IF ((TotalLines - 1) < 1) THEN + Print('^7No last line to delete!^1') + ELSE + BEGIN + LineNum1 := (TotalLines - 1); + Print('^3Line '+IntToStr(LineNum1)+':'); + MCIAllowed := FALSE; + PrintAcr('^1'+LinePtr^[(LineNum1)]); + MCIAllowed := TRUE; + NL; + IF (PYNQ('Delete the last line? ',0,FALSE)) THEN + BEGIN + IF ((TotalLines - 1) = MaxLines) THEN + ExitMsg := TRUE; + Dec(TotalLines); + NL; + Print('^0Line '+IntToStr(LineNum1)+' deleted.^1'); + END; + END; + 'S' : BEGIN + WHILE (((TotalLines - 1) >= 1) AND ((LinePtr^[TotalLines - 1] = '') OR + (LinePtr^[TotalLines - 1] = ^J))) DO + Dec(TotalLines); + FOR Counter := (TotalLines - 1) DOWNTO 1 DO + BEGIN + LineNum2 := 0; + FOR LineNum1 := 1 TO Length(LinePtr^[Counter]) DO + IF (LinePtr^[Counter][LineNum1] <> ' ') THEN + Inc(LineNum2); + IF (LineNum2 = 0) THEN + BEGIN + LinePtr^[Counter][0] := #0; + Dec(TotalLines) + END + ELSE + Counter := 1; + END; + IF (CantAbort1) AND ((TotalLines - 1) < 1) THEN + Print('^7You must complete this message!^1') + ELSE IF ((TotalLines - 1) < 1) THEN + Print('^7Nothing to save!^1') + ELSE + BEGIN + SaveMsg1 := TRUE; + AbortMsg := FALSE; + ShowCont := FALSE; + END; + END; + 'T' : IF (CantAbort1) THEN + Print('^7The receiver and subject can not be changed!^1') + ELSE + BEGIN + IF (NOT Pub) OR (MAInternet IN MemMsgArea.MAFlags) THEN + Print('^7The receiver of this message can not be changed!') + ELSE + EditMsgTo(MsgTo); + NL; + IF (MHeader.FileAttached > 0) THEN + Print('^7The subject of this message can not be changed!') + ELSE + EditMsgSubj(MsgSubj,CantAbort1); + END; + 'U' : IF ((TotalLines - 1) >= MaxLines) THEN + Print('^7You have reached the maximum line limit!^1') + ELSE IF PYNQ('Import a file to this message? ',0,FALSE) THEN + UploadFile; + 'Z' : IF ((TotalLines - 1) < 1) THEN + Print('^7No lines to replace!') + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('Line number to replace',LineNum1,[NumbersOnly],1,(TotalLines - 1)); + IF ((LineNum1 >= 1) AND (LineNum1 <= (TotalLines - 1))) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + NL; + Print('^3Old line '+IntToStr(LineNum1)+':'); + MCIAllowed := FALSE; + PrintACR('^1'+LinePtr^[LineNum1]); + MCIAllowed := TRUE; + Print('^3New line '+IntToStr(LineNum1)+':'); + UserColor(1); + InputLine(TempStr1,MaxLineLen); + NL; + IF PYNQ('Replace this line? ',0,FALSE) THEN + BEGIN + IF (LinePtr^[LineNum1][Length(LinePtr^[LineNum1])] = #1) AND (TempStr1[Length(TempStr1)]<>#1) THEN + LinePtr^[LineNum1] := TempStr1 + #1 + ELSE + LinePtr^[LineNum1] := TempStr1; + NL; + Print('^0Line '+IntToStr(LineNum1)+' replaced.^1'); + END; + END; + END; + ^M : BEGIN + IF (HelpCounter = 5) THEN + BEGIN + NL; + PrintF('PRHELP'); + HelpCounter := 0; + END; + Inc(HelpCounter); + END; + '?' : PrintF('PRHELP'); + END; + IF (ShowCont) AND (ExitMsg) THEN + BEGIN + NL; + Print('^0Continue...^1'); + NL; + END; + END; + IF (SaveLine) THEN + BEGIN + LinePtr^[TotalLines] := LineStr; + Inc(TotalLines); + IF (LineStr <> '') THEN + HelpCounter := 1 + ELSE + BEGIN + IF (HelpCounter = 5) THEN + BEGIN + Print('^0Enter "/?" on a blank line for help.^1'); + Dec(TotalLines,5); + HelpCounter := 0; + END; + Inc(HelpCounter); + END; + IF ((TotalLines - 1) >= MaxLines) THEN + BEGIN + NL; + Print('^7You have reached the maximum line limit!'); + IF (InportFileOpen) THEN + BEGIN + InportFileOpen := FALSE; + Close(InportFile); + END; + HelpCounter := 1; + ExitMsg := FALSE; + LineStr := '/'; + END; + END; + UNTIL (AbortMsg) OR (ExitMsg) OR (SaveMsg1) OR (HangUp); + UNTIL ((AbortMsg) OR (SaveMsg1) OR (HangUp)); + END; + END; + + PROCEDURE SaveIt(DisableMCI1: Boolean); + VAR + LineStr: AStr; + UserName: Str36; + C: Char; + LineNum1, + Counter: Integer; + AddTagLine: Boolean; + BEGIN + + IF (ReadInMsg <> '') THEN + BEGIN + + Assign(InportFile,ReadInMsg); + ReWrite(InportFile); + IF (IOResult = 0) THEN + BEGIN + FOR LineNum1 := 1 TO (TotalLines - 1) DO + WriteLn(InportFile,LinePtr^[LineNum1]); + Close(InportFile); + END; + + END + ELSE + BEGIN + + AddTagLine := FALSE; + IF (MAQuote IN MemMsgArea.MAFlags) THEN + AddTagLine := PYNQ('Add a tagline to your message? ',0,TRUE); + + MHeader.Subject := MsgSubj; + MHeader.OriginDate := ''; + MHeader.From.Anon := 0; + MHeader.MTO.Anon := 0; + MHeader.Replies := 0; + MHeader.ReplyTo := 0; + MHeader.Date := GetPackDateTime; + GetDayOfWeek(MHeader.DayOfWeek); + + IF (Pub AND (MemMsgArea.MAType IN [1,2])) OR (NOT Pub AND (NetMail IN MHeader.Status)) THEN + BEGIN + NewEchoMail := TRUE; + IF (NOT (MAScanOut IN MemMsgArea.MAFlags)) THEN + UpdateBoard; + END; + + MHeader.From.UserNum := UserNum; + + UserName := AllCaps(ThisUser.Name); + + IF (NOT Pub) AND (NetMail IN MHeader.Status) AND (ThisUser.Name <> AllCaps(ThisUser.RealName)) THEN + IF (General.AllowAlias) THEN + BEGIN + NL; + IF PYNQ('Send this with your real name? ',0,TRUE) THEN + UserName := AllCaps(ThisUser.RealName); + END; + + MHeader.From.A1S := UserName; + MHeader.From.Real := AllCaps(ThisUser.RealName); + MHeader.From.Name := AllCaps(ThisUser.Name); + + MHeader.Status := [] + (MHeader.Status * [NetMail]); + + IF (Pub) AND (RValidate IN ThisUser.Flags) THEN + Include(MHeader.Status,Unvalidated); + + IF (AACS(MemMsgArea.MCIACS)) THEN + BEGIN + Include(MHeader.Status,AllowMCI); + IF (DisableMCI1) THEN + Exclude(MHeader.Status,AllowMCI); + END; + + IF (Pub) THEN + BEGIN + MHeader.MTO.Name := MsgTo; + MHeader.MTO.Real := MsgTo; + MHeader.MTO.A1S := MsgTo; + END; + + IF (NOT (NetMail IN MHeader.Status)) THEN + Anonymous(FALSE,MHeader); + + NL; + Prompt('^5Saving...'); + + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + MHeader.TextSize := 0; + MHeader.Pointer := (FileSize(MsgTxtF) + 1); + Seek(MsgTxtF,FileSize(MsgTxtF)); + + IF (NetMail IN MHeader.Status) AND (Pos('@',MHeader.MTO.A1S) > 0) THEN + BEGIN + + FOR Counter := 1 TO Length(MHeader.MTO.A1S) DO + IF (MHeader.MTO.A1S[Counter] IN ['A'..'Z']) THEN + Inc(MHeader.MTO.A1S[Counter],32); + + LineStr := 'To: '+MsgTo; + BlockWrite(MsgTxtF,LineStr,Length(LineStr) + 1); + Inc(MHeader.TextSize,Length(LineStr) + 1); + + MHeader.MTO.A1S := 'UUCP'; + END; + + IF ((Pub) AND (MAFilter IN MemMsgArea.MAFlags)) THEN + FOR LineNum1 := 1 TO (TotalLines - 1) DO + IF (Length(LinePtr^[LineNum1]) > 0) THEN + BEGIN + LinePtr^[LineNum1] := StripColor(LinePtr^[LineNum1]); + FOR Counter := 1 TO Length(LinePtr^[LineNum1]) DO + BEGIN + C := LinePtr^[LineNum1][Counter]; + IF (C IN [#0..#1,#3..#31,#127..#255]) THEN + C := '*'; + LinePtr^[LineNum1][Counter] := C; + END; + END; + + FOR LineNum1 := 1 TO (TotalLines - 1) DO + BEGIN + LineStr := LinePtr^[LineNum1]; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,(Length(LineStr) + 1)); + END; + + IF (AddTagLine) THEN + BEGIN + LineStr := ''; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,(Length(LineStr) + 1)); + LineStr := '... '+GetTagLine; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,(Length(LineStr) + 1)); + END; + + IF (MemMsgArea.MAType IN [1,2]) AND (MAAddTear IN MemMsgarea.MAFlags) THEN + BEGIN + LineStr := ''; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,1); + + LineStr := '--- Renegade v'+General.Version; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,(Length(LineStr) + 1)); + + IF (MemMsgArea.AKA > 19) THEN + MemMsgArea.AKA := 0; + + LineStr := ' * Origin: '; + IF (MemMsgArea.Origin <> '') THEN + LineStr := LineStr + MemMsgArea.Origin + ELSE + LineStr := LineStr + General.Origin; + + LineStr := LineStr + ' ('; + + LineStr := LineStr + IntToStr(General.AKA[MemMsgArea.AKA].Zone)+':'+ + IntToStr(General.AKA[MemMsgArea.AKA].Net)+'/'+ + IntToStr(General.AKA[MemMsgArea.AKA].Node); + + IF (General.AKA[MemMsgArea.AKA].Point > 0) THEN + LineStr := LineStr + '.'+IntToStr(General.AKA[MemMsgArea.AKA].Point); + + LineStr := LineStr + ')'; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,(Length(LineStr) + 1)); + + END; + + Close(MsgTxtF); + LastError := IOResult; + + BackErase(9); + + END; + + InputMessage := TRUE; + + END; + +BEGIN + CLS; + InputMessage := FALSE; + + MaxLines := ((MaxAvail DIV 120) - 20); + IF (MaxLines > MaxMsgLines) THEN + MaxLines := MaxMsgLines; + GetMem(LinePtr,(MaxLines * 120)); + + InportFileOpen := FALSE; + Escp := FALSE; + MaxQuoteLines := 0; + LastQuoteLine := 0; + + IF (NOT IsReply) THEN + MsgTo := '' + ELSE + BEGIN + IF (MARealName IN MemMsgArea.MAFlags) THEN + MsgTo := Caps(MHeader.MTO.Real) + ELSE + MsgTo := Caps(MHeader.MTO.A1S) + END; + + IF (InResponseTo <> '') THEN + MsgSubj := InResponseTo + ELSE + MsgSubj := MsgTitle; + + IF (MsgSubj[1] <> '\') THEN + CantAbort := FALSE + ELSE + BEGIN + MsgSubj := Copy(MsgSubj,2,(Length(MsgSubj) - 1)); + MHeader.Subject := MsgSubj; + CantAbort := TRUE; + END; + + IF (MsgSubj[1] = #1) THEN + BEGIN + MsgSubj := Copy(MsgSubj,2,(Length(MsgSubj) - 1)); + IF (MHeader.Subject[1] = #1) THEN + MHeader.Subject := Copy(MHeader.Subject,2,(Length(MHeader.Subject) - 1)); + END + ELSE IF (MsgSubj <> '') AND (Copy(MsgSubj,1,3) <> 'Re:') THEN + MsgSubj := 'Re: '+Copy(MsgSubj,1,36); + + MHeader.FileAttached := 0; + + InputTheMessage(CantAbort,DisableMCI,SaveMsg); + + IF (SaveMsg) THEN + SaveIt(DisableMCI); + + Kill('TEMPQ'+IntToStr(ThisNode)); + + DOSANSIOn := FALSE; + + FreeMem(LinePtr,(MaxLines * 120)); +END; + +END. diff --git a/SOURCE/MAIL2.PAS b/SOURCE/MAIL2.PAS new file mode 100644 index 0000000..ac4ffe9 --- /dev/null +++ b/SOURCE/MAIL2.PAS @@ -0,0 +1,1403 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Mail2; + +INTERFACE + +USES + Common; + +PROCEDURE Post(ReplyTo: LongInt; VAR TToI: FromToInfo; PvtMsg: Boolean); +PROCEDURE ReadAllMessages(MenuOption: Str50); +PROCEDURE ScanMessages(MArea: Integer; AskUpDate: Boolean; MenuOption: Str50); +PROCEDURE StartNewScan(MenuOption: Str50); +PROCEDURE ScanYours; +FUNCTION FirstNew: Word; + +IMPLEMENTATION + +USES + Dos, + Common5, + Mail0, + Mail1, + EMail, + Mail3, + Menus, + ShortMsg, + SysOp2G, + SysOp3, + TimeFunc; + +VAR + TempLastRead: LongInt; + +PROCEDURE Post(ReplyTo: LongInt; VAR TToI: FromToInfo; PvtMsg: Boolean); +VAR + MHeader: MHeaderRec; + PostOk: Boolean; +BEGIN + + LoadMsgArea(MsgArea); + + PostOk := TRUE; + + IF (NOT AACS(MemMsgArea.PostACS)) THEN + BEGIN + NL; + Print('^7Your access level does not permit you to post in this message area!^1'); + PostOk := FALSE; + END + ELSE IF (AccountBalance < General.CreditPost) AND (NOT (FNoCredits IN ThisUser.Flags)) THEN + BEGIN + NL; + Print('^7Insufficient account balance to post a public message!^1'); + PostOk := FALSE; + END + ELSE IF (RPost IN ThisUser.Flags) OR (NOT AACS(General.NormPubPost)) THEN + BEGIN + NL; + Print('^7Your access priviledges do not include posting a public messages!^1'); + PostOk := FALSE; + END + ELSE IF (PublicPostsToday >= General.MaxPubPost) AND (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You have already sent the maximum public messages allowed per day!^1'); + PostOk := FALSE; + END; + + IF (NOT PostOk) THEN + Exit; + + InitMsgArea(MsgArea); + + MHeader.Status := []; + + MHeader.FileAttached := 0; + + IF (ReplyTo <> -1) THEN + BEGIN + MHeader.MTo := TToI; + IF (MHeader.MTo.Anon > 0) THEN + MHeader.MTo.A1S := UseName(MHeader.MTo.Anon,MHeader.MTo.A1S); + END + ELSE + BEGIN + FillChar(MHeader.MTo,SizeOf(MHeader.MTo),0); + InResponseTo := ''; + END; + + IF (MemMsgArea.PrePostFile <> '') THEN + BEGIN + PrintF(MemMsgArea.PrePostFile); + PauseScr(FALSE); + END; + + IF (InputMessage(TRUE,(ReplyTo <> -1),'',MHeader,'',78,500)) THEN + BEGIN + + IF (ReplyTo <> -1) THEN + MHeader.ReplyTo := ((HiMsg + 1) - ReplyTo); + + IF (PvtMsg) THEN + Include(MHeader.Status,Prvt); + + SaveHeader((HiMsg + 1),MHeader); + + Print('^1Message posted on ^5'+MemMsgArea.Name+'^1.'); + + SysOpLog(MHeader.Subject+' posted on ^5'+MemMsgArea.Name); + + IF (MHeader.MTo.A1S <> '') THEN + SysOpLog(' To: "'+MHeader.MTo.A1S+'"'); + + IF (ReplyTo <> -1) THEN + BEGIN + LoadHeader(ReplyTo,MHeader); + Inc(MHeader.Replies); + SaveHeader(ReplyTo,MHeader); + END; + + IF (ThisUser.MsgPost < 2147483647) THEN + Inc(ThisUser.MsgPost); + + IF (PublicPostsToday < 255) THEN + Inc(PublicPostsToday); + + IF (NOT (FNoCredits IN ThisUser.Flags)) THEN + AdjustBalance(General.CreditPost); + + SaveURec(ThisUser,UserNum); + + Update_Screen; + + END; +END; + +PROCEDURE ListMessages(Pub: Boolean); +VAR + MHeader: MHeaderRec; + S, + S1: STRING; + TempHiMsg: Word; + ADate: DateTime; + NumDone: Byte; +BEGIN + TempHiMsg := HiMsg; + IF ((Msg_On < 1) OR (Msg_On > TempHiMsg)) THEN + Exit; + Abort := FALSE; + Next := FALSE; + CLS; + PrintACR('旼컴컴컫컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴컴컴컴컴컴쩡컴컴컴커'); + PrintACR('� Msg# � Sender � Receiver � '+'Subject �! Posted �'); + PrintACR('읕컴컴컨컴컴컴컴컴컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴컴컴컴컴컴좔컴컴컴켸'); + Dec(Msg_On); + NumDone := 0; + WHILE ((NumDone < (PageLength - 7)) AND (Msg_On >= 0) AND (Msg_On < TempHiMsg) AND (NOT Abort) AND (NOT HangUp)) DO + BEGIN + Inc(Msg_On); + + LoadHeader(Msg_On,MHeader); + + IF ((NOT (UnValidated IN MHeader.Status)) AND (NOT (MDeleted IN MHeader.Status))) OR (MsgSysOp) THEN + BEGIN + + IF (MDeleted IN MHeader.Status) THEN + S := '''D' + ELSE IF (UnValidated IN MHeader.Status) THEN + S := '''U' + ELSE IF ToYou(MHeader) OR FromYou(MHeader) THEN + S := '''>' + ELSE IF (Pub) AND (TempLastRead < MHeader.Date) THEN + S := '''*' + ELSE + S := ' '; + + S := S + ' "'+PadLeftInt(Msg_On,5)+' #'; + + IF (MARealName IN MemMsgArea.MAFlags) THEN + S1 := UseName(MHeader.From.Anon,MHeader.From.Real) + ELSE + S1 := UseName(MHeader.From.Anon,MHeader.From.A1S); + + S := S + PadLeftStr(S1,18)+' $'; + + IF ((MARealName IN MemMsgArea.MAFlags) AND (MHeader.MTo.Real <> '')) THEN + S1 := UseName(MHeader.MTo.Anon,MHeader.MTo.Real) + ELSE + S1 := UseName(MHeader.MTo.Anon,MHeader.MTo.A1S); + + S := S + PadLeftStr(S1,19)+' % '; + + IF (MHeader.FileAttached = 0) THEN + S := S + PadLeftStr(MHeader.Subject,18) + ELSE + S := S + PadLeftStr(Stripname(MHeader.Subject),18); + + PackToDate(ADate,MHeader.Date); + + S := S + ' &'+ZeroPad(IntToStr(ADate.Month))+'/'+ ZeroPad(IntToStr(ADate.Day))+'/'+ZeroPad(IntToStr(ADate.Year)); + + IF (AllowMCI IN MHeader.Status) THEN + PrintACR(S) + ELSE + Print(S); + + Inc(NumDone); + END; + Wkey; + END; +END; + +PROCEDURE MainRead(OncOnly,AskUpdate,Pub: Boolean); +VAR + User: UserRecordType; + MHeader: MHeaderRec; + Cmd, + NewMenuCmd: AStr; + Junk: Str36; + Cmd1: Char; + SaveMenu, + CmdToExec, + Counter: Byte; + MsgNum, + ThreadStart: Word; + Done, + CmdNotHid, + CmdExists, + AskPost, + Contlist, + DoneScan, + HadUnVal: Boolean; + + FUNCTION CantBeSeen: Boolean; + BEGIN + CantBeSeen := (NOT MsgSysOp) AND ((UnValidated IN MHeader.Status) OR (MDeleted IN MHeader.Status) OR + ((Prvt IN MHeader.Status) AND NOT (ToYou(MHeader) OR FromYou(MHeader)))); + END; + +BEGIN + AskPost := FALSE; + Contlist := FALSE; + DoneScan := FALSE; + HadUnVal := FALSE; + AllowContinue := TRUE; + ThreadStart := 0; + TReadPrompt := 0; + Abort := FALSE; + Next := FALSE; + SaveMenu := CurMenu; + + IF (MemMsgArea.MessageReadMenu <> 0) THEN + CurMenu := MemMsgArea.MessageReadMenu + ELSE + CurMenu := General.MessageReadMenu; + + IF (NOT NewMenuToLoad) THEN + LoadMenuPW; + + AutoExecCmd('FIRSTCMD'); + + REPEAT + + IF (Contlist) AND (Abort) THEN + BEGIN + Contlist := FALSE; + NL; + Print('Continuous message listing off.'); + TReadPrompt := 255; + END; + + IF (Msg_On < 1) OR (Msg_On > HiMsg) THEN + BEGIN + IF (NOT Contlist) THEN + BEGIN + DoneScan := TRUE; + IF (Pub) THEN + AskPost := TRUE; + END + ELSE + BEGIN + Contlist := FALSE; + Msg_On := HiMsg; + NL; + Print('Continuous message listing off.'); + TReadPrompt := 255; + END; + END; + + IF (NOT DoneScan) AND (TReadPrompt IN [0..2,8..10,18]) THEN + BEGIN + IF (Contlist) THEN + Next := TRUE; + LoadHeader(Msg_On,MHeader); + IF (Pub) AND (UnValidated IN MHeader.Status) THEN + HadUnVal := TRUE; + WHILE (((Msg_On < HiMsg) AND (TReadPrompt <> 2)) OR ((Msg_On > 1) AND (TReadPrompt = 2))) AND + (CantBeSeen) DO + BEGIN + IF (TReadPrompt = 2) THEN + Dec(Msg_On) + ELSE + Inc(Msg_On); + LoadHeader(Msg_On,MHeader); + END; + IF ((Msg_On = 1) OR (Msg_On = HiMsg)) AND (CantBeSeen) THEN + BEGIN + DoneScan := TRUE; + IF (Pub) THEN + AskPost := TRUE; + END + ELSE + BEGIN + IF ((CLSMsg IN ThisUser.SFlags) AND (NOT Contlist)) THEN + Cls + ELSE + NL; + ReadMsg(Msg_On,Msg_On,HiMsg); + IF (Pub) AND (TempLastRead < MHeader.Date) AND (MHeader.Date <= GetPackDateTime) THEN + TempLastRead := MHeader.Date; + IF (Pub) THEN + IF (PublicReadThisCall < 32767) THEN + Inc(PublicReadThisCall); + END; + END; + IF (NOT Contlist) AND (NOT DoneScan) THEN + REPEAT + TReadPrompt := 0; + MainMenuHandle(Cmd); + NewMenuCmd := ''; + CmdToExec := 0; + Done := FALSE; + REPEAT + FCmd(Cmd,CmdToExec,CmdExists,CmdNotHid); + IF (CmdToExec <> 0) AND (MemCmd^[CmdToExec].CmdKeys <> '-^') AND + (MemCmd^[CmdToExec].CmdKeys <> '-/') AND (MemCmd^[CmdToExec].CmdKeys <> '-\') THEN + DoMenuCommand(Done, + MemCmd^[CmdToExec].CmdKeys, + MemCmd^[CmdToExec].Options, + NewMenuCmd, + MemCmd^[CmdToExec].NodeActivityDesc); + UNTIL (CmdToExec = 0) OR (Done) OR (HangUp); + Abort := FALSE; + Next := FALSE; + CASE TReadPrompt OF + 1 : ; { Read Again } + 2 : Dec(Msg_On); { Previous Message } + + 3 : IF (NOT MsgSysOp) THEN + Print('^7You do not have the required access level for this option!^1') + ELSE + MoveMsg(Msg_On); + + 4 : IF (NOT CoSysOp) THEN + Print('^7You do not have the required access level for this option!^1') + ELSE + ExtractMsgToFile(Msg_On,Mheader); + + 5 : IF (NOT FromYou(MHeader)) AND (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You can only edit messages that you have sent!^1'); + END + ELSE + BEGIN + REPEAT + NL; + Prt('Message editing [^5?^4=^5Help^4]: '); + IF (MsgSysOp) THEN + Onek(Cmd1,'QADEFOPRSTV?'^M,TRUE,TRUE) + ELSE + Onek(Cmd1,'QDEFOST?'^M,TRUE,TRUE); + CASE Cmd1 OF + (* + 'D' : FOR Counter := 1 TO 6 DO + IF (HeaderLine(MHeader,Msg_On,HiMsg,Counter,Junk) <> '') THEN + PrintACR(Headerline(MHeader,Msg_On,HiMsg,Counter,Junk)); + 'O' : IF PYNQ('Reload old information? ',0,FALSE) THEN + LoadHeader(Msg_On,MHeader); + 'E' : BEGIN + EditMessageText(Msg_On); + LoadHeader(Msg_On,MHeader); + END; + 'S' : IF (MHeader.FileAttached = 0) OR (MsgSysOp) THEN + BEGIN + Prt('Subj: '); + InputDefault(MHeader.Subject,MHeader.Subject,40,[ColorsAllowed],FALSE) + END + ELSE + Print('Sorry, you can''t edit that.'); + 'T' : BEGIN + Print('^11. Posted to : ^5'+MHeader.MTo.A1S); + Print('^12. Real name : ^5'+MHeader.MTo.Real); + Print('^13. System name: ^5'+MHeader.MTo.Name); + NL; + Prt('Edit name (^51^4-^53^4) [^5Q^4]uit: '); + Onek(Cmd1,'Q123'^M,TRUE,TRUE); + IF (NOT (Cmd1 IN ['Q',^M])) THEN + NL; + CASE Cmd1 OF + '1' : BEGIN + Prt('Posted to: '); + InputDefault(MHeader.MTo.A1S,MHeader.MTo.A1S,36,[],FALSE); + END; + '2' : BEGIN + Prt('Real name: '); + InputDefault(MHeader.MTo.Real,MHeader.MTo.Real,36,[],FALSE); + END; + '3' : BEGIN + Prt('System name: '); + InputDefault(MHeader.MTo.Name,MHeader.MTo.Name,36,[],FALSE); + END; + END; + Cmd1 := #0; + END; + 'F' : IF (MHeader.From.Anon > 0) OR (MsgSysOp) THEN + BEGIN + Print('^11. Posted to : ^5'+MHeader.From.A1S); + Print('^12. Real name : ^5'+MHeader.From.Real); + Print('^13. System name: ^5'+MHeader.From.Name); + NL; + Prt('Edit name (^51^4-^53^4) [^5Q^4]uit: '); + Onek(Cmd1,'Q123'^M,TRUE,TRUE); + IF (NOT (Cmd1 IN ['Q',^M])) THEN + NL; + CASE Cmd1 OF + '1' : BEGIN + Prt('Posted to: '); + InputDefault(MHeader.From.A1S,MHeader.From.A1S,36,[],FALSE); + END; + '2' : BEGIN + Prt('Real name: '); + InputDefault(MHeader.From.Real,MHeader.From.Real,36,[],FALSE); + END; + '3' : BEGIN + Prt('System name: '); + InputDefault(MHeader.From.Name,MHeader.From.Name,36,[],FALSE); + END; + END; + Cmd1 := #0; + END + ELSE + Print('Sorry, you can''t edit that.'); + + 'A' : IF (MsgSysOp) THEN + BEGIN + IF (MHeader.From.Anon IN [1,2]) THEN + MHeader.From.Anon := 0 + ELSE + BEGIN + Loadurec(User,MHeader.From.UserNum); + IF AACS1(User,MHeader.From.UserNum,General.CSOP) THEN + MHeader.From.Anon := 2 + ELSE + MHeader.From.Anon := 1; + END; + Print('Message is '+AOnOff((MHeader.From.Anon = 0),'not ','')+'anonymous'); + SysOpLog('Message is '+AOnOff((MHeader.From.Anon = 0),'not ','')+'anonymous'); + END; + *) + 'A' : IF (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You do not have the required access level for this option!^1') + END + ELSE + BEGIN + IF (MHeader.From.Anon IN [1,2]) THEN + BEGIN + MHeader.From.Anon := 0; + NL; + Print('Message status is not anonymous.'); + SysOpLog('Message status is not anonymous.'); + END + ELSE + BEGIN + LoadURec(User,MHeader.From.UserNum); + IF AACS1(User,MHeader.From.UserNum,General.CSOP) THEN + MHeader.From.Anon := 2 + ELSE + MHeader.From.Anon := 1; + NL; + Print('Message status is anonymous.'); + SysOpLog('Message status is anonymous.'); + END; + END; + + 'D' : BEGIN + NL; + FOR Counter := 1 TO 6 DO + IF (HeaderLine(MHeader,Msg_On,HiMsg,Counter,Junk) <> '') THEN + PrintACR(Headerline(MHeader,Msg_On,HiMsg,Counter,Junk)); + END; + + 'E' : BEGIN + EditMessageText(Msg_On); + LoadHeader(Msg_On,MHeader); + END; + + 'F' : IF (MHeader.From.Anon > 0) OR (MsgSysOp) THEN + BEGIN + NL; + Print('^11. Posted from: ^5'+MHeader.From.A1S); + Print('^12. Real name : ^5'+MHeader.From.Real); + Print('^13. System name: ^5'+MHeader.From.Name); + NL; + Prt('Edit name [^51^4-^53^4,^5^4=^5Quit^4]: '); + Onek(Cmd1,^M'123',TRUE,TRUE); + CASE Cmd1 OF + '1' : BEGIN + NL; + Prt('Posted from: '); + InputDefault(MHeader.From.A1S,MHeader.From.A1S,36,[],FALSE); + END; + '2' : BEGIN + NL; + Prt('Real name: '); + InputDefault(MHeader.From.Real,MHeader.From.Real,36,[],FALSE); + END; + '3' : BEGIN + NL; + Prt('System name: '); + InputDefault(MHeader.From.Name,MHeader.From.Name,36,[],FALSE); + END; + END; + Cmd1 := #0; + END; + + 'O' : BEGIN + NL; + IF PYNQ('Reload old information? ',0,FALSE) THEN + LoadHeader(Msg_On,MHeader); + END; + 'P' : IF (NOT Pub) THEN + BEGIN + NL; + Print('^7This option is not available when reading private messages!^1'); + END + ELSE IF (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You do not have the required access level for this option!^1') + END + ELSE + BEGIN + IF (Permanent IN MHeader.Status) THEN + BEGIN + Exclude(MHeader.Status,Permanent); + NL; + Print('Message status is not permanent.'); + SysOpLog('Message status is not permanent.'); + END + ELSE + BEGIN + Include(MHeader.Status,Permanent); + NL; + Print('Message status is permanent.'); + SysOpLog('Message status is permanent.'); + END; + END; + + + 'R' : IF (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You do not have the required access level for this option!^1') + END + ELSE + BEGIN + IF (Sent IN MHeader.Status) THEN + BEGIN + Exclude(MHeader.Status,Sent); + IF (PUB) AND (MemMsgArea.MAType IN [1..2]) AND (NOT (MAScanOut IN MemMsgArea.MAFlags)) THEN + UpdateBoard; + NL; + Print('Message status is not sent.'); + SysOpLog('Message status is not sent.'); + END + ELSE + BEGIN + Include(MHeader.Status,Sent); + NL; + Print('Message status is sent.'); + SysOpLog('Message status is sent.'); + END; + END; + + 'S' : IF (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You do not have the required access level for this option!^1') + END + ELSE IF (MHeader.FileAttached > 0) THEN + BEGIN + NL; + Print('^7There is no file attached to this message!^1'); + END + ELSE + BEGIN + NL; + Prt('Subj: '); + InputDefault(MHeader.Subject,MHeader.Subject,40,[ColorsAllowed],FALSE); + SysOpLog('Message subject has been modified.'); + END; + + 'T' : BEGIN + NL; + Print('^11. Posted to : ^5'+MHeader.MTo.A1S); + Print('^12. Real name : ^5'+MHeader.MTo.Real); + Print('^13. System name: ^5'+MHeader.MTo.Name); + NL; + Prt('Edit name [^51^4-^53^4,^5^4=^5Quit^4]: '); + Onek(Cmd1,^M'123',TRUE,TRUE); + CASE Cmd1 OF + '1' : BEGIN + NL; + Prt('Posted to: '); + InputDefault(MHeader.MTo.A1S,MHeader.MTo.A1S,36,[],FALSE); + END; + '2' : BEGIN + NL; + Prt('Real name: '); + InputDefault(MHeader.MTo.Real,MHeader.MTo.Real,36,[],FALSE); + END; + '3' : BEGIN + NL; + Prt('System name: '); + InputDefault(MHeader.MTo.Name,MHeader.MTo.Name,36,[],FALSE); + END; + END; + Cmd1 := #0; + END; + + 'V' : IF (NOT Pub) THEN + BEGIN + NL; + Print('^7This option is not available when reading private messages!^1'); + END + ELSE IF (NOT MsgSysOp) THEN + BEGIN + NL; + Print('^7You do not have the required access level for this option!^1') + END + ELSE + BEGIN + IF (UnValidated IN MHeader.Status) THEN + BEGIN + Exclude(MHeader.Status,UnValidated); + NL; + Print('Message status is validated.'); + SysOpLog('Message status is validated.'); + END + ELSE + BEGIN + Include(MHeader.Status,UnValidated); + NL; + Print('Message status is unvalidated.'); + SysOpLog('Message status is unvalidated.'); + END; + END; + + '?' : BEGIN + NL; + LCmds(15,3,'From','To'); + LCmds(15,3,'Subject','Edit text'); + LCmds(15,3,'Oops','Display header'); + IF (MsgSysOp) THEN + BEGIN + LCmds(15,5,'Permanent','Validation'); + LCmds(15,5,'Rescan','Anonymous'); + END; + LCmds(15,3,'Quit',''); + END; + END; + UNTIL (Cmd1 IN ['Q',^M]) OR (HangUp); + Cmd1 := #0; + SaveHeader(Msg_On,MHeader); + END; + 6 : BEGIN + DumpQuote(MHeader); + IF (NOT Pub) THEN + AutoReply(MHeader) + ELSE + BEGIN + NL; + IF (MHeader.From.Anon = 0) OR (AACS(General.AnonPubRead)) THEN + IF PYNQ('Is this to be a private reply? ',0,Prvt IN MHeader.Status) THEN + IF (MAPrivate IN MemMsgArea.MAFlags) THEN + IF PYNQ('Reply in Email? ',0,FALSE) THEN + AutoReply(MHeader) + ELSE + Post(Msg_On,MHeader.From,TRUE) + ELSE + AutoReply(MHeader) + ELSE + Post(Msg_On,MHeader.From,FALSE) + ELSE + Post(Msg_On,MHeader.From,FALSE); + END; + END; + 7 : BEGIN + Msg_On := (HiMsg + 1); + IF (Pub) THEN + BEGIN + LoadHeader(HiMsg,MHeader); + IF (MHeader.Date <= GetPackDateTime) THEN + TempLastRead := MHeader.Date; + END; + Next := FALSE; + END; + + 8 : IF (Pub) AND ((Msg_On - MHeader.ReplyTo) > 0) AND (MHeader.ReplyTo > 0) THEN + BEGIN + IF (ThreadStart = 0) THEN + ThreadStart := Msg_On; + Dec(Msg_On,MHeader.ReplyTo); + END; + + 9 : IF (Pub) AND ((ThreadStart >= 1) AND (ThreadStart <= HiMsg)) THEN + BEGIN + Msg_On := ThreadStart; + ThreadStart := 0; + END; + + 10 : BEGIN + Contlist := TRUE; + Abort := FALSE; + NL; + Print('Continuous message listing on.'); + END; + 11 : IF (Pub) THEN + BEGIN + IF (Permanent IN MHeader.Status) THEN + BEGIN + NL; + Print('^7This is a permanent public message!^1'); + END + ELSE + BEGIN + IF (Msg_On >= 1) AND (Msg_On <= HiMsg) AND (MsgSysOp OR FromYou(MHeader)) THEN + BEGIN + LoadHeader(Msg_On,MHeader); + IF (MDeleted IN MHeader.Status) THEN + Exclude(MHeader.Status,MDeleted) + ELSE + Include(MHeader.Status,MDeleted); + SaveHeader(Msg_On,MHeader); + IF (NOT (MDeleted IN MHeader.Status)) THEN + BEGIN + IF FromYou(MHeader) THEN + BEGIN + IF (ThisUser.MsgPost < 2147483647) THEN + Inc(ThisUser.MsgPost); + AdjustBalance(General.Creditpost); + END; + NL; + Print('Public message undeleted.'); + SysOpLog('* Undeleted public message: ^5'+MHeader.Subject); + END + ELSE + BEGIN + IF FromYou(MHeader) THEN + BEGIN + IF (ThisUser.MsgPost > 0) THEN + Dec(ThisUser.MsgPost); + AdjustBalance(-General.Creditpost); + END; + NL; + Print('Public message deleted.'); + SysOpLog('* Deleted public message: ^5'+MHeader.Subject); + END; + END + ELSE + BEGIN + NL; + Print('^7You can only delete public messages from you!^1'); + END; + END; + END + ELSE + BEGIN + IF (Msg_On >= 1) AND (Msg_On <= HiMsg) AND (MsgSysOp OR FromYou(MHeader) OR ToYou(MHeader)) THEN + BEGIN + LoadHeader(Msg_On,MHeader); + IF (MDeleted IN MHeader.Status) THEN + Exclude(MHeader.Status,MDeleted) + ELSE + Include(MHeader.Status,MDeleted); + SaveHeader(Msg_On,MHeader); + IF (NOT (MDeleted IN MHeader.Status)) THEN + BEGIN + LoadURec(User,MHeader.MTo.UserNum); + IF (User.Waiting < 255) THEN + Inc(User.Waiting); + SaveURec(User,MHeader.MTo.UserNum); + NL; + Print('Private message undeleted.'); + IF FromYou(MHeader) OR (MsgSysOp) THEN + SysOpLog('* Undeleted private message from: ^5'+Caps(MHeader.From.A1S)) + ELSE IF ToYou(MHeader) OR (MsgSysOp) THEN + SysOpLog('* Undeleted private message to: ^5'+Caps(MHeader.MTo.A1S)); + END + ELSE + BEGIN + LoadURec(User,MHeader.MTo.UserNum); + IF (User.Waiting > 0) THEN + Dec(User.Waiting); + SaveURec(User,MHeader.MTo.UserNum); + NL; + Print('Private message deleted.'); + IF FromYou(MHeader) OR (MsgSysOp) THEN + SysOpLog('* Deleted private message from: ^5'+Caps(MHeader.From.A1S)) + ELSE IF ToYou(MHeader) OR (MsgSysOp) THEN + SysOpLog('* Deleted private message to: ^5'+Caps(MHeader.MTo.A1S)); + END; + END + ELSE + BEGIN + NL; + Print('^7You can only delete private messages from or to you!^1'); + END; + END; + 12 : IF (NOT Pub) THEN + BEGIN + NL; + Print('^7This option is not available when reading private messages!^1'); + END + ELSE + BEGIN + NL; + Print('Highest-read pointer for this area set to message #'+IntToStr(Msg_On)+'.'); + IF (MHeader.Date <= GetPackDateTime) THEN + TempLastRead := MHeader.Date; + END; + 13 : BEGIN + IF (Pub) AND (AskUpdate) THEN + BEGIN + NL; + IF PYNQ('Update message read pointers for this area? ',0,FALSE) THEN + BEGIN + LoadLastReadRecord(LastReadRecord); + LastReadRecord.LastRead := GetPackDateTime; + SaveLastReadRecord(LastReadRecord); + END; + END; + DoneScan := TRUE; + Next := TRUE; + END; + 14 : BEGIN + DoneScan := TRUE; + Abort := TRUE; + END; + 15 : ListMessages(Pub); + 16 : IF (NOT CoSysOp) THEN + Print('^7You do not have the required access level for this option!^1') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('^7The sender of this message does not have an account on this BBS!^1') + ELSE IF (CheckPW) THEN + UserEditor(LastAuthor); + 17 : IF (NOT PUB) THEN + BEGIN + NL; + Print('^7This option is not available when reading private messages!^1'); + END + ELSE + BEGIN + IF (MAForceRead IN MemMsgArea.MAFlags) THEN + BEGIN + NL; + Print('^7This message area can not be removed from your new scan!^1') + END + ELSE + BEGIN + + NL; + Print('^5'+MemMsgArea.Name+'^3 '+AOnOff(LastReadRecord.NewScan,'will NOT','WILL')+ + ' be scanned in future new scans.'); + SysOpLog('* Toggled ^5'+MemMsgArea.Name+ '^1 '+AOnOff(LastReadRecord.NewScan,'out of','back in')+ + ' new scan.'); + + LoadLastReadRecord(LastReadRecord); + LastReadRecord.NewScan := (NOT LastReadRecord.NewScan); + SaveLastReadRecord(LastReadRecord); + END; + END; + 18 : Inc(Msg_On); + 19 : IF (NOT CoSysOp) THEN + Print('^7You do not have the required access level for this option!^1') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('^7The sender of this message does not have an account on this BBS!^1.') + ELSE + BEGIN + LoadURec(User,LastAuthor); + ShowUserInfo(1,LastAuthor,User); + END; + 20 : IF (NOT CoSysOp) THEN + Print('^7You do not have the required access level for this option!^1') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('^7The sender of this message does not have an account on this BBS!^1') + ELSE + BEGIN + LoadURec(User,LastAuthor); + AutoVal(User,LastAuthor); + END; + 21 : ForwardMessage(Msg_On); + END; + UNTIL (TReadPrompt IN [1..2,7..10,13..15,18]) OR (Abort) OR (Next) OR (HangUp) + ELSE + Inc(Msg_On); + + IF (OncOnly) AND (TReadPrompt IN [13,14,18]) THEN + DoneScan := TRUE; + + UNTIL (DoneScan) OR (HangUp); + + CurMenu := SaveMenu; + + NewMenuToLoad := TRUE; + + AllowContinue := FALSE; + + IF ((Pub) AND (HadUnVal) AND (MsgSysOp)) THEN + IF PYNQ('%LFValidate all messages here? ',0,FALSE) THEN + BEGIN + FOR MsgNum := 1 TO HiMsg DO + BEGIN + LoadHeader(MsgNum,MHeader); + IF (UnValidated IN MHeader.Status) THEN + Exclude(MHeader.Status,UnValidated); + SaveHeader(MsgNum,MHeader); + END; + END; + + IF ((Pub) AND (AskPost) AND (AACS(MemMsgArea.PostACS)) AND + (NOT (RPost IN ThisUser.Flags)) AND (PublicPostsToday < General.MaxPubPost)) THEN + IF (TReadPrompt <> 7) THEN + IF PYNQ('%LFPost on ^5'+MemMsgArea.Name+'^7? ',0,FALSE) THEN + IF (MAPrivate IN MemMsgArea.MAFlags) THEN + Post(-1,MHeader.From,PYNQ('%LFIs this to be a private message? ',0,FALSE)) + ELSE + Post(-1,MHeader.From,FALSE); +END; + +PROCEDURE ReadAllMessages(MenuOption: Str50); +VAR + InputStr: AStr; + SaveReadMsgArea: Integer; +BEGIN + SaveReadMsgArea := ReadMsgArea; + Abort := FALSE; + Next := FALSE; + IF (MenuOption = '') THEN + MsgArea := -1; + InitMsgArea(MsgArea); + IF (HiMsg = 0) THEN + BEGIN + Print('%LFNo messages on ^5'+MemMsgArea.Name+'^1.'); + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + END + ELSE + BEGIN + + Msg_On := 1; + Inputstr := '?'; + REPEAT + IF (InputStr = '?') THEN + ListMessages(MsgArea <> -1); + NL; + { Prompt(FString.ReadQ); } + Prt('Select message (^51^4-^5'+IntToStr(HiMsg)+'^4) [^5?^4=^5First^4,^5^4=^5Next^4,^5Q^4=^5Quit^4)]: '); + (* + lRGLngStr(32,FALSE); + *) + ScanInput(InputStr,'Q?'^M); + + IF (InputStr = 'Q') THEN + Msg_On := 0 + ELSE + BEGIN + + IF (InputStr = ^M) THEN + BEGIN + InputStr := '?'; + IF (Msg_On >= HiMsg) THEN + Msg_On := 1; + END + ELSE IF (InputStr = '?') THEN + BEGIN + Msg_On := 1; + InputStr := '?'; + END + ELSE + BEGIN + Msg_On := StrToInt(InputStr); + IF (Msg_On >= 1) AND (Msg_On <= HIMsg) THEN + InputStr := 'Q' + ELSE + BEGIN + NL; + Print('^7The range must be from 1 to '+IntToStr(HiMsg)+'^1'); + PauseScr(FALSE); + Msg_On := 1; + InputStr := '?'; + END; + END; + END; + UNTIL (InputStr = 'Q') OR (HangUp); + + IF (Msg_On >= 1) AND (Msg_On <= HiMsg) AND (NOT HangUp) THEN + BEGIN + IF (MsgArea <> -1) THEN + BEGIN + LoadLastReadRecord(LastReadRecord); + TempLastRead := LastReadRecord.LastRead; + END; + MainRead(FALSE,FALSE,(MsgArea <> -1)); + IF (MsgArea <> -1) THEN + BEGIN + LastReadRecord.LastRead := TempLastRead; + SaveLastReadRecord(LastReadRecord); + END; + END; + + END; + MsgArea := SaveReadMsgArea; + LoadMsgArea(MsgArea); +END; + +FUNCTION FirstNew: Word; +VAR + MHeader: MHeaderRec; + MaxMsgs, + MsgNum: Word; + Done: Boolean; +BEGIN + MaxMsgs := HiMsg; + MsgNum := 0; + IF (MaxMsgs > 0) THEN + BEGIN + Done := FALSE; + MsgNum := 1; + WHILE (MsgNum <= MaxMsgs) AND (NOT Done) DO + BEGIN + LoadHeader(MsgNum,MHeader); + IF (LastReadRecord.LastRead < MHeader.Date) THEN + Done := TRUE + ELSE + BEGIN + IF (MsgNum < MaxMsgs) THEN + Inc(MsgNum,1) + ELSE + BEGIN + MsgNum := 0; + Done := TRUE; + END; + END; + END; + END; + FirstNew := MsgNum; +END; + +PROCEDURE ScanMessages(MArea: Integer; AskUpdate: Boolean; MenuOption: Str50); +VAR + ScanFor: STRING[40]; + Cmd: Char; + SaveMsgArea, + MsgNum: Word; + ScanNew, + ScanGlobal: Boolean; + + PROCEDURE Searchboard(MArea1: Integer; Cmd1: Char); + VAR + MsgHeader: MHeaderRec; + Searched: STRING; + TotLoad: Word; + Match, + AnyShown: Boolean; + BEGIN + IF (MsgArea <> MArea1) THEN + ChangeMsgArea(MArea1); + IF (MsgArea = MArea1) THEN + BEGIN + InitMsgArea(MsgArea); + AnyShown := FALSE; + LIL := 0; + CLS; + Prompt('^1Scanning ^5'+MemMsgArea.Name+' #'+IntToStr(CompMsgArea(MsgArea,0))+' ^1...'); + Reset(MsgHdrF); + Reset(MsgTxtF,1); + IF (IOResult <> 0) THEN + Exit; + IF (ScanNew) THEN + MsgNum := FirstNew + ELSE + MsgNum := 1; + IF (MsgNum > 0) AND (FileSize(MsgHdrF) > 0) THEN + WHILE (MsgNum <= FileSize(MsgHdrF)) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadHeader(MsgNum,MsgHeader); + Match := FALSE; + IF (Cmd1 IN ['Y',^M]) THEN + IF ToYou(MsgHeader) THEN + Match := TRUE; + IF (Cmd1 IN ['F','A']) THEN + BEGIN + IF (MARealName IN MemMsgArea.MAFlags) THEN + Searched := MsgHeader.From.Real + ELSE + Searched := MsgHeader.From.A1S; + IF (MemMsgArea.MAtype = 0) THEN + Searched := Searched; + Searched := AllCaps(UseName(MsgHeader.From.Anon,Searched)); + IF (Pos(ScanFor,Searched) > 0) THEN + Match := TRUE; + END; + IF (Cmd1 IN ['T','A'] ) THEN + BEGIN + IF (MARealName IN MemMsgArea.MAFlags) THEN + Searched := MsgHeader.MTo.Real + ELSE + Searched := MsgHeader.MTo.A1S; + IF (MemMsgArea.MAtype = 0) THEN + Searched := Searched; + Searched := AllCaps(UseName(MsgHeader.MTo.Anon,Searched)); + IF (Pos(ScanFor,Searched) > 0) THEN + Match := TRUE; + END; + IF (Cmd1 IN ['S','A'] ) THEN + IF (Pos(ScanFor,AllCaps(MsgHeader.Subject)) > 0) THEN + Match := TRUE; + IF (Cmd1 = 'A') AND (NOT Match) AND (MsgHeader.TextSize > 0) AND + (((MsgHeader.Pointer - 1) + MsgHeader.TextSize) <= FileSize(MsgTxtF)) AND + (MsgHeader.Pointer > 0) THEN + WITH MsgHeader DO + BEGIN + Seek(MsgTxtF,(Pointer - 1)); + TotLoad := 0; + REPEAT + BlockRead(MsgTxtF,Searched[0],1); + BlockRead(MsgTxtF,Searched[1],Ord(Searched[0])); + LastError := IOResult; + Inc(TotLoad,Length(Searched) + 1); + IF (Pos(ScanFor,AllCaps(Searched)) > 0) THEN + Match := TRUE; + UNTIL (TotLoad >= TextSize) OR (Match); + END; + IF (Match) THEN + BEGIN + Close(MsgHdrF); + Close(MsgTxtF); + Msg_On := MsgNum; + NL; + MainRead(TRUE,AskUpdate,(MsgArea <> -1)); + NL; + Reset(MsgHdrF); + Reset(MsgTxtF,1); + AnyShown := TRUE; + END; + Wkey; + IF (Next) THEN + Abort := TRUE; + Inc(MsgNum); + END; + Close(MsgHdrF); + Close(MsgTxtF); + IF (NOT AnyShown) THEN + BackErase(14 + Lennmci(MemMsgArea.Name) + Length(IntToStr(CompMsgArea(MsgArea,0)))); + END; + END; + +BEGIN + SaveMsgArea := MsgArea; + ScanNew := FALSE; + ScanGlobal := FALSE; + MenuOption := AllCaps(MenuOption); + IF (MenuOption <> '') THEN + Cmd := 'Y' + ELSE + Cmd := #0; + IF (Pos('N',MenuOption) > 0) THEN + ScanNew := TRUE; + IF (Pos('G',MenuOption) > 0) THEN + ScanGlobal := TRUE; + IF (Cmd = #0) THEN + REPEAT + NL; + Prt('Scan method (^5?^4=^5Help^4): '); + Onek(Cmd,'QFTSAY?'^M,TRUE,TRUE); + IF (Cmd = '?') THEN + BEGIN + NL; + LCmds(15,5,'From field','To field'); + LCmds(15,5,'Subject field','All text'); + LCmds(15,5,'Your messages','Quit'); + END; + UNTIL (Cmd <> '?') OR (HangUp); + NL; + IF (NOT (Cmd IN ['Q',^M])) THEN + BEGIN + IF (Cmd <> 'Y') THEN + BEGIN + Prt('Text to scan for: '); + Input(ScanFor,40); + IF (ScanFor = '') THEN + Exit; + NL; + END; + IF (MenuOption = '') THEN + ScanNew := PYNQ('Scan new messages only? ',0,TRUE); + IF (ScanGlobal) OR ((MenuOption = '') AND PYNQ('Global scan? ',0,FALSE)) THEN + BEGIN + MArea := 1; + WHILE (MArea >= 1) AND (MArea <= NumMsgAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Searchboard(MArea,Cmd); + Wkey; + Inc(MArea); + END; + END + ELSE + Searchboard(MArea,Cmd); + END; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); +END; + +PROCEDURE ScanYours; +VAR + ScanAllPublicMsgFile: FILE OF Boolean; + MsgHeader: MHeaderRec; + MArea, + SaveMsgArea: Integer; + MsgNum, + PubMsgsFound: Word; + SaveConfSystem, + AnyFound, + FirstTime, + MsgsFound: Boolean; +BEGIN + SaveMsgArea := MsgArea; + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + Assign(ScanAllPublicMsgFile,TempDir+'SAPM'+IntToStr(ThisNode)+'.DAT'); + ReWrite(ScanAllPublicMsgFile); + FOR MArea := 1 TO NumMsgAreas DO + BEGIN + MsgsFound := FALSE; + Write(ScanAllPublicMsgFile,MsgsFound); + END; + Prompt('%LF^5Scanning for your new public messages ... ^1'); + FirstTime := TRUE; + AnyFound := FALSE; + MArea := 1; + WHILE (MArea >= 1) AND (MArea <= NumMsgAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (MsgArea <> MArea) THEN + ChangeMsgArea(MArea); + IF (MsgArea = MArea) THEN + BEGIN + InitMsgArea(MsgArea); + IF (LastReadRecord.NewScan) THEN + BEGIN + Reset(MsgHdrF); + Reset(MsgTxtF,1); + IF (IOResult = 0) THEN + BEGIN + PubMsgsFound := 0; + MsgNum := FirstNew; + IF (MsgNum > 0) AND (FileSize(MsgHdrF) > 0) THEN + WHILE (MsgNum <= FileSize(MsgHdrF)) AND (NOT HangUp) DO + BEGIN + LoadHeader(MsgNum,MsgHeader); + IF (ToYou(MsgHeader)) THEN + BEGIN + Seek(ScanAllPublicMsgFile,(MArea - 1)); + MsgsFound := TRUE; + Write(ScanAllPublicMsgFile,MsgsFound); + Inc(PubMsgsFound); + END; + Inc(MsgNum); + END; + Close(MsgHdrF); + Close(MsgTxtF); + IF (PubMsgsFound > 0) THEN + BEGIN + IF (FirstTime) THEN + BEGIN + NL; + NL; + FirstTime := FALSE; + END; + Print('^5'+PadLeftStr(MemMsgArea.Name,30)+' ^1'+IntToStr(PubMsgsFound)); + AnyFound := TRUE; + END; + END; + END; + END; + Inc(MArea); + END; + Close(ScanAllPublicMsgFile); + IF (NOT AnyFound) THEN + Print('^5No messages found.^1') + ELSE + BEGIN + Abort := FALSE; + Next := FALSE; + NL; + IF PYNQ('Read your new public messages now? ',0,FALSE) THEN + BEGIN + Assign(ScanAllPublicMsgFile,TempDir+'SAPM'+IntToStr(ThisNode)+'.DAT'); + Reset(ScanAllPublicMsgFile); + MArea := 1; + WHILE (MArea >= 1) AND (MArea <= NumMsgAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(ScanAllPublicMsgFile,(MArea - 1)); + Read(ScanAllPublicMsgFile,MsgsFound); + IF (MsgsFound) THEN + ScanMessages(MArea,TRUE,'N'); + WKey; + Inc(MArea); + END; + Close(ScanAllPublicMsgFile); + END; + END; + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + LastError := IOResult; +END; + +PROCEDURE StartNewScan(MenuOption: Str50); +VAR + MArea, + SaveMsgArea: Integer; + Global: Boolean; + + PROCEDURE NewScan(MArea1: Integer); + BEGIN + IF (MsgArea <> MArea1) THEN + ChangeMsgArea(MArea1); + IF (MsgArea = MArea1) THEN + BEGIN + InitMsgArea(MsgArea); + IF (LastReadRecord.NewScan) OR ((MAForceRead IN MemMsgArea.MAFlags) AND (NOT CoSysOp)) THEN + BEGIN + TempLastRead := LastReadRecord.LastRead; + Lil := 0; + { Prompt('^3'+FString.NewScan1);} + lRGLngStr(8,FALSE); + Msg_On := FirstNew; + IF (Msg_On > 0) THEN + MainRead(FALSE,FALSE,(MsgArea <> -1)); + + LastReadRecord.LastRead := TempLastRead; + SaveLastReadRecord(LastReadRecord); + + (* Add backarase *) + END; + END; + END; + +BEGIN + SaveMsgArea := MsgArea; + MArea := MsgArea; + Global := FALSE; + Abort := FALSE; + Next := FALSE; + IF (UpCase(MenuOption[1]) = 'C') THEN + MArea := MsgArea + ELSE IF (UpCase(MenuOption[1]) = 'G') THEN + Global := TRUE + ELSE IF (StrToInt(MenuOption) <> 0) THEN + MArea := StrToInt(MenuOption) + ELSE IF (MenuOption = '') THEN + Global := PYNQ('%LFScan all message areas? ',0,FALSE); + IF (NOT Global) THEN + NewScan(MArea) + ELSE + BEGIN + MArea := 1; + WHILE (MArea >= 1) AND (MArea <= NumMsgAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + NewScan(MArea); + WKey; + Inc(MArea); + END; + SysOpLog('Global new scan of message areas'); + END; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); +END; + +END. diff --git a/SOURCE/MAIL3.PAS b/SOURCE/MAIL3.PAS new file mode 100644 index 0000000..6346b82 --- /dev/null +++ b/SOURCE/MAIL3.PAS @@ -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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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. diff --git a/SOURCE/MAIL4.PAS b/SOURCE/MAIL4.PAS new file mode 100644 index 0000000..83f37f2 --- /dev/null +++ b/SOURCE/MAIL4.PAS @@ -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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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^1)Select current entry + ^1(^3^1)First entry on page ^1(^3^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. diff --git a/SOURCE/MAINT.PAS b/SOURCE/MAINT.PAS new file mode 100644 index 0000000..ac5c00a --- /dev/null +++ b/SOURCE/MAINT.PAS @@ -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. diff --git a/SOURCE/MENUS.PAS b/SOURCE/MENUS.PAS new file mode 100644 index 0000000..4ae8f13 --- /dev/null +++ b/SOURCE/MENUS.PAS @@ -0,0 +1,1073 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O-,R-,S+,V-} + +UNIT Menus; + +INTERFACE + +USES + Common, + MyIO; + +PROCEDURE AutoExecCmd(AutoCmd: AStr); +PROCEDURE MenuExec; +PROCEDURE LoadMenuPW; +PROCEDURE MainMenuHandle(VAR Cmd: AStr); +PROCEDURE FCmd(CONST Cmd: AStr; VAR CmdToExec: Byte; VAR CmdExists,CmdNotHid: Boolean); +PROCEDURE DoMenuExec(Cmd: AStr; VAR NewMenuCmd: AStr); +PROCEDURE DoMenuCommand(VAR Done: Boolean; + Cmd, + MenuOption: AStr; + VAR NewMenuCmd: AStr; + NodeActivityDesc: AStr); + +IMPLEMENTATION + +USES + Arcview, + Archive1, + Archive2, + Archive3, + Automsg, + BBSList, + Boot, + Bulletin, + CUser, + Doors, + Email, + Events, + File0, + File1, + File2, + File3, + File5, + File6, + File7, + File8, + File9, + File10, + File11, + File12, + File13, + File14, + Mail0, + Mail1, + Mail2, + Mail3, + Mail4, + Menus2, + Menus3, + MiscUser, + MsgPack, + Multnode, + OffLine, + Script, + Stats, + LineChat, + Sysop1, + Sysop2, + SysOp2G, + Sysop3, + Sysop4, + SysOp5, + Sysop6, + Sysop7, + Sysop8, + Sysop9, + Sysop10, + Sysop11, + SysOp12, + TimeBank, + TimeFunc, + Vote, + OneLiner; + + + (* + I := 1; + Newmenucmd := ''; + while ((I <= Noc) and (Newmenucmd = '') ) do + begin + if (Menucommand^[I].Ckeys = 'FIRSTCMD') then + begin + if (Aacs(Menucommand^[I].Acs)) then + begin + Newmenucmd := 'FIRSTCMD'; + Domenuexec(Cmd,Newmenucmd); + end; + end; + inc(I); + end; + *) +PROCEDURE AutoExecCmd(AutoCmd: AStr); +VAR + NewMenuCmd: AStr; + Counter: Byte; + Done: Boolean; +BEGIN + NewMenuCmd := ''; + Done := FALSE; + Counter := 1; + WHILE (Counter <= NumCmds) AND (NewMenuCmd = '') AND (NOT Done) AND (NOT HangUp) DO + BEGIN + IF (MemCmd^[Counter].Ckeys = AutoCmd) then + IF (AACS(MemCmd^[Counter].ACS)) THEN + BEGIN + NewMenuCmd := AutoCmd; + DoMenuCommand(Done, + MemCmd^[Counter].CmdKeys, + MemCmd^[Counter].Options, + NewMenuCmd, + MemCmd^[Counter].NodeActivityDesc); + END; + Inc(Counter); + END; +END; + +PROCEDURE MenuExec; +VAR + Cmd, + NewMenuCmd: AStr; + Done: Boolean; +BEGIN + MainMenuHandle(Cmd); + IF ((Copy(Cmd,1,2) = '\\') AND (SysOp)) THEN + BEGIN + DoMenuCommand(Done,Copy(Cmd,1,2),Copy(Cmd,3,Length(Cmd) - 2),NewMenuCmd,'Activating SysOp Cmd'); + IF (NewMenuCmd <> '') THEN + Cmd := NewMenuCmd + ELSE + Cmd := ''; + END; + NewMenuCmd := ''; + REPEAT + DoMenuExec(Cmd,NewMenuCmd) + UNTIL (NewMenuCmd = '') OR (HangUp); +END; + +PROCEDURE CheckHelpLevel; +BEGIN + IF (MemMenu.ForceHelpLevel <> 0) THEN + CurHelpLevel := MemMenu.ForceHelpLevel + ELSE IF (Novice IN ThisUser.Flags) OR (OkRIP) THEN + CurHelpLevel := 2 + ELSE + CurHelpLevel := 1; +END; + +PROCEDURE LoadMenuPW; +VAR + s: Str20; + NACC: Boolean; +BEGIN + LoadMenu; + NACC := FALSE; + IF (NOT AACS(MemMenu.ACS)) OR (MemMenu.Password <> '') THEN + BEGIN + NACC := TRUE; + IF (MemMenu.Password <> '') THEN + BEGIN + NL; + Prt('Password: '); + GetPassword(s,20); + IF (s = MemMenu.Password) THEN + NACC := FALSE; + END; + IF (NACC) THEN + BEGIN + PrintF('NOACCESS'); + IF (NoFile) THEN + BEGIN + NL; + Print('Access denied.'); + PauseScr(FALSE); + END; + CurMenu := FallBackMenu; + LoadMenu; + END; + END; + IF (NOT NACC) THEN + CheckHelpLevel; +END; + +PROCEDURE CheckForceLevel; +BEGIN + IF (CurHelpLevel < MemMenu.ForceHelpLevel) THEN + CurHelpLevel := MemMenu.ForceHelpLevel; +END; + +PROCEDURE GetCmd(VAR Cmd: AStr); +VAR + S1, + SS, + SaveSS, + SHas0, + SHas1: AStr; + C: Char; + CmdToExec, + Counter, + SaveCurrentColor: Byte; + Key: Word; + GotCmd, + Has0, + Has1, + Has2: Boolean; +BEGIN + Cmd := ''; + IF (Buf <> '') THEN + IF (Buf[1] = '`') THEN + BEGIN + Buf := Copy(Buf,2,(Length(Buf) - 1)); + Counter := Pos('`',Buf); + IF (Counter <> 0) THEN + BEGIN + Cmd := AllCaps(Copy(Buf,1,(Counter - 1))); + Buf := Copy(Buf,(Counter + 1),(Length(Buf) - Counter)); + NL; + Exit; + END; + END; + + SHas0 := '?'; + SHas1 := ''; + Has0 := FALSE; + Has1 := FALSE; + Has2 := FALSE; + + + FOR CmdToExec := 1 TO NumCmds DO + IF ((CmdToExec <= (NumCmds - GlobalCmds)) OR NOT (NoGlobalUsed IN MemMenu.MenuFlags)) THEN + IF (AACS(MemCmd^[CmdToExec].ACS)) THEN + IF (MemCmd^[CmdToExec].CKeys[0] = #1) THEN + BEGIN + Has0 := TRUE; + SHas0 := SHas0 + MemCmd^[CmdToExec].CKeys; + END + ELSE IF ((MemCmd^[CmdToExec].CKeys[1] = '/') AND (MemCmd^[CmdToExec].CKeys[0] = #2)) THEN + BEGIN + Has1 := TRUE; + SHas1 := SHas1 + MemCmd^[CmdToExec].CKeys[2]; + END + ELSE + Has2 := TRUE; + + SaveCurrentColor := CurrentColor; + + GotCmd := FALSE; + SS := ''; + + IF (Trapping) THEN + Flush(TrapFile); + + IF (NOT (HotKey IN ThisUser.Flags)) OR (ForceLine IN MemMenu.MenuFlags) THEN + InputMain(Cmd,60,[UpperOnly,NoLineFeed]) + ELSE + BEGIN + + REPEAT + + Key := GetKey; + IF (Key = F_UP) OR (Key = F_DOWN) OR (Key = F_LEFT) OR (Key = F_RIGHT) THEN + BEGIN + CASE Key OF + F_UP : IF (Pos(#255,MenuKeys) > 0) THEN + BEGIN + Cmd := 'UP_ARROW'; + GotCmd := TRUE; + Exit; + END; + F_DOWN : + IF (Pos(#254,MenuKeys) > 0) THEN + BEGIN + Cmd := 'DOWN_ARROW'; + GotCmd := TRUE; + Exit; + END; + F_LEFT : + IF (Pos(#253,MenuKeys) > 0) THEN + BEGIN + Cmd := 'LEFT_ARROW'; + GotCmd := TRUE; + Exit; + END; + F_RIGHT : + IF (Pos(#252,MenuKeys) > 0) THEN + BEGIN + Cmd := 'RIGHT_ARROW'; + GotCmd := TRUE; + Exit; + END; + END; + END; + + C := UpCase(Char(Key)); + SaveSS := SS; + IF (SS = '') THEN + BEGIN + IF (C = #13) THEN + GotCmd := TRUE; + IF ((C = '/') AND ((Has1) OR (Has2) OR (SysOp))) THEN + SS := '/'; + IF (((FQArea) OR (RQArea) OR (MQArea) OR (VQArea)) AND (C IN ['0'..'9'])) THEN + BEGIN + SS := C; + IF (RQArea) AND (HiMsg <= 9) THEN + GotCmd := TRUE + ELSE IF (FQArea) AND (NumFileAreas <= 9) THEN + GotCmd := TRUE + ELSE IF (MQArea) AND (NumMsgAreas <= 9) THEN + GotCmd := TRUE + ELSE IF (VQArea) AND (GetTopics <= 9) THEN + GotCmd := TRUE; + END + ELSE IF (Pos(C,SHas0) <> 0) THEN + BEGIN + GotCmd := TRUE; + SS := C; + END; + END + ELSE IF (SS = '/') THEN + BEGIN + IF (C = ^H) THEN + SS := ''; + IF ((C = '/') AND ((Has2) OR (SysOp))) THEN + SS := SS + '/'; + IF ((Pos(C,SHas1) <> 0) AND (Has1)) THEN + BEGIN + GotCmd := TRUE; + SS := SS + C; + END; + END + ELSE IF (Copy(SS,1,2) = '//') THEN + BEGIN + IF (C = #13) THEN + GotCmd := TRUE + ELSE IF (C = ^H) THEN + Dec(SS[0]) + ELSE IF (C = ^X) THEN + BEGIN + FOR Counter := 1 TO (Length(SS) - 2) DO + BackSpace; + SS := '//'; + SaveSS := SS; + END + ELSE IF ((Length(SS) < 62) AND (C >= #32) AND (C <= #127)) THEN + SS := SS + C; + END + ELSE IF ((Length(SS) >= 1) AND (SS[1] IN ['0'..'9']) AND ((FQArea) OR (RQArea) OR (MQArea) OR (VQArea))) THEN + BEGIN + IF (C = ^H) THEN + Dec(SS[0]); + IF (C = #13) THEN + GotCmd := TRUE; + IF (C IN ['0'..'9']) THEN + BEGIN + SS := SS + C; + IF (VQArea) AND (Length(SS) = Length(IntToStr(GetTopics))) THEN + GotCmd := TRUE + ELSE IF (RQArea) AND (Length(SS) = Length(IntToStr(HiMsg))) THEN + GotCmd := TRUE + ELSE IF (MQArea) AND (Length(SS) = Length(IntToStr(NumMsgAreas))) THEN + GotCmd := TRUE + ELSE IF (FQArea) AND (Length(SS) = Length(IntToStr(NumFileAreas))) THEN + GotCmd := TRUE; + END; + END; + + IF ((Length(SS) = 1) AND (Length(SaveSS) = 2)) THEN + SetC(SaveCurrentColor); + + IF (SaveSS <> SS) AND (NOT (NoMenuPrompt IN MemMenu.MenuFlags)) THEN + BEGIN + IF (Length(SS) > Length(SaveSS)) THEN + Prompt(SS[Length(SS)]); + IF (Length(SS) < Length(SaveSS)) THEN + BackSpace; + END; + + IF ((NOT (SS[1] IN ['0'..'9'])) AND ((Length(SS) = 2) AND (Length(SaveSS) = 1))) THEN + UserColor(6); + + UNTIL ((GotCmd) OR (HangUp)); + + CursorOn(TRUE); + + UserColor(1); + + IF (Copy(SS,1,2) = '//') THEN + SS := Copy(SS,3,(Length(SS) - 2)); + + Cmd := SS; + END; + + (* Test *) + IF (CurMenu <> General.FileListingMenu) THEN + NL; + + IF (Pos(';',Cmd) <> 0) THEN + IF (Copy(Cmd,1,2) <> '\\') THEN + BEGIN + IF (HotKey IN ThisUser.Flags) THEN + BEGIN + S1 := Copy(Cmd,2,(Length(Cmd) - 1)); + IF (Copy(S1,1,1) = '/') THEN + Cmd := Copy(S1,1,2) + ELSE + Cmd := S1[1]; + S1 := Copy(S1,(Length(Cmd) + 1),(Length(S1) - Length(Cmd))); + END + ELSE + BEGIN + S1 := Copy(Cmd,(Pos(';',Cmd) + 1),(Length(Cmd) - Pos(';',Cmd))); + Cmd := Copy(Cmd,1,(Pos(';',Cmd) - 1)); + END; + WHILE (Pos(';',S1) <> 0) DO + S1[Pos(';',S1)] := ^M; + Buf := S1; + END; +END; + +PROCEDURE MainMenuHandle(VAR Cmd: AStr); +VAR + NewArea: Integer; +BEGIN + TLeft; + + CheckForceLevel; + + IF ((ForcePause IN MemMenu.MenuFlags) AND (CurHelpLevel > 1) AND (LastCommandGood)) THEN + PauseScr(FALSE); + LastCommandGood := FALSE; + MenuAborted := FALSE; + Abort := FALSE; + + ShowThisMenu; + + AutoExecCmd('EVERYTIME'); + + IF (General.MultiNode) THEN + Check_Status; + + IF ((NOT (NoMenuPrompt IN MemMenu.MenuFlags)) AND (NOT MenuAborted)) AND NOT + (OKAnsi AND (NoGenericAnsi IN MemMenu.MenuFlags) AND NOT (OkAvatar OR OKRIP)) AND NOT + (OkAvatar AND (NoGenericAvatar IN MemMenu.MenuFlags) AND NOT OkRIP) AND NOT + (OkRIP AND (NoGenericRIP IN MemMenu.MenuFlags)) THEN + BEGIN + + IF (CurMenu <> General.FileListingMenu) THEN + NL; + + IF (AutoTime IN MemMenu.MenuFlags) THEN + Print('^3[Time Left:'+CTim(NSL)+']'); + Prompt(MemMenu.MenuPrompt); + END; + + TempPause := (Pause IN ThisUser.Flags); + + GetCmd(Cmd); + + IF (Cmd = '') AND (Pos(#13,MenuKeys) > 0) THEN + Cmd := 'ENTER'; + + IF (Cmd = '?') THEN + BEGIN + Cmd := ''; + Inc(CurHelpLevel); + IF (CurHelpLevel > 3) THEN + CurHelpLevel := 3; + END + ELSE + CheckHelpLevel; + + CheckForceLevel; + + IF (FQArea) OR (MQArea) OR (VQArea) OR (RQArea) THEN + BEGIN + NewArea := StrToInt(Cmd); + IF ((NewArea <> 0) OR (Cmd[1] = '0')) THEN + BEGIN + IF (FQArea) AND (NewArea >= 1) AND (NewArea <= NumFileAreas) THEN + ChangeFileArea(CompFileArea(NewArea,1)) + ELSE IF (MQArea) AND (NewArea >= 1) AND (NewArea <= NumMsgAreas) THEN + ChangeMsgArea(CompMsgArea(NewArea,1)) + ELSE IF (VQArea) AND (NewArea >= 1) AND (NewArea <= NumVotes) THEN + VoteOne(NewArea) + ELSE IF (RQArea) AND (NewArea >= 1) AND (NewArea <= HiMsg) THEN + IF NOT (MAForceRead IN MemMsgArea.MAFlags) OR (NewArea <= Msg_On) THEN + BEGIN + Msg_On := (NewArea - 1); + TReadPrompt := 18; + END + ELSE + Print('You must read all of the messages in this area.'); + Cmd := ''; + END; + END; +END; + +PROCEDURE FCmd(CONST Cmd: AStr; VAR CmdToExec: Byte; VAR CmdExists,CmdNotHid: Boolean); +VAR + Done: Boolean; +BEGIN + Done := FALSE; + REPEAT + Inc(CmdToExec); + IF (CmdToExec <= NumCmds) AND (Cmd = MemCmd^[CmdToExec].CKeys) THEN + BEGIN + CmdExists := TRUE; + IF (OkSecurity(CmdToExec,CmdNotHid)) THEN + Done := TRUE; + END; + IF ((CmdToExec > (NumCmds - GlobalCmds)) AND (NoGlobalUsed IN MemMenu.MenuFlags)) THEN + BEGIN + CmdToExec := 0; + CmdExists := FALSE; + Done := TRUE; + END; + UNTIL (CmdToExec > NumCmds) OR (Done) OR (HangUp); + IF (CmdToExec > NumCmds) THEN + CmdToExec := 0; +END; + +PROCEDURE DoMenuExec(Cmd: AStr; VAR NewMenuCmd: AStr); +VAR + CmdToExec: Byte; + CmdACS, + CmdNotHid, + CmdExists, + Done: Boolean; +BEGIN + IF (NewMenuCmd <> '') THEN + BEGIN + Cmd := NewMenuCmd; + NewMenuCmd := ''; + END; + CmdACS := FALSE; + CmdExists := FALSE; + CmdNotHid := FALSE; + Done := FALSE; + CmdToExec := 0; + REPEAT + FCmd(Cmd,CmdToExec,CmdExists,CmdNotHid); + IF (CmdToExec <> 0) THEN + BEGIN + CmdACS := TRUE; + DoMenuCommand(Done, + MemCmd^[CmdToExec].CmdKeys, + MemCmd^[CmdToExec].Options, + NewMenuCmd, + MemCmd^[CmdToExec].NodeActivityDesc); + END; + UNTIL ((CmdToExec = 0) OR (Done) OR (HangUp)); + IF (NOT Done) AND (Cmd <> '') THEN + IF ((NOT CmdACS) AND (Cmd <> '')) THEN + BEGIN + NL; + IF ((CmdNotHid) AND (CmdExists)) THEN + Print('Insufficient clearence for this command.') + ELSE + Print('Invalid command.'); + END; +END; + +PROCEDURE DoMenuCommand(VAR Done: Boolean; + Cmd, + MenuOption: AStr; + VAR NewMenuCmd: AStr; + NodeActivityDesc: AStr); +VAR + MHeader: MHeaderRec; + TempStr: AStr; + SaveMenu: Byte; + NoCmd: Boolean; +BEGIN + NewMenuToLoad := FALSE; + NewMenuCmd := ''; + NoCmd := FALSE; + Abort := FALSE; + LastCommandOvr := FALSE; + + IF ((Cmd[1] + Cmd[2]) <> 'NW') THEN + Update_Node(NodeActivityDesc,TRUE); + + CASE Cmd[1] OF + '$' : CASE Cmd[2] OF + 'D' : Deposit; + 'W' : Withdraw; + '+' : Inc(ThisUser.lCredit,StrToInt(MenuOption)); + '-' : Inc(ThisUser.Debit,StrToInt(MenuOption)); + ELSE + NoCmd := TRUE; + END; + '/' : CASE Cmd[2] OF + 'F': BEGIN + MCIAllowed := FALSE; + PrintF(MCI(MenuOption)); + MCIAllowed := TRUE; + END; + ELSE + NoCmd := TRUE; + END; + '-' : CASE Cmd[2] OF + 'C' : lStatus_Screen(100,MenuOption,FALSE,MenuOption); + 'F' : PrintF(MCI(MenuOption)); + 'L' : Prompt(MenuOption); + 'Q' : ReadQ(General.MiscPath+MenuOption); + 'R' : ReadASW1(MenuOption); + 'S' : SysOpLog(MCI(MenuOption)); + ';' : BEGIN + TempStr := MenuOption; + WHILE (Pos(';',TempStr) > 0) DO + TempStr[Pos(';',TempStr)] := ^M; + Buf := TempStr; + END; + '$' : IF (SemiCmd(MenuOption,1) <> '') THEN + BEGIN + IF (SemiCmd(MenuOption,2) = '') THEN + Prt(': ') + ELSE + Prt(SemiCmd(MenuOption,2)); + GetPassword(TempStr,20); + IF (TempStr <> SemiCmd(MenuOption,1)) THEN + BEGIN + Done := TRUE; + IF (SemiCmd(MenuOption,3) <> '') THEN + Print(SemiCmd(MenuOption,3)); + END; + END; + 'Y' : IF (SemiCmd(MenuOption,1) <> '') AND NOT (PYNQ(SemiCmd(MenuOption,1),0,FALSE)) THEN + BEGIN + Done := TRUE; + IF (SemiCmd(MenuOption,2) <> '') THEN + Print(SemiCmd(MenuOption,2)); + END; + 'N' : IF (SemiCmd(MenuOption,1) <> '') AND (PYNQ(SemiCmd(MenuOption,1),0,FALSE)) THEN + BEGIN + Done := TRUE; + IF (SemiCmd(MenuOption,2) <> '') THEN + Print(SemiCmd(MenuOption,2)); + END; + '^','/','\' : + DoChangeMenu(Done,NewMenuCmd,Cmd[2],MenuOption); + ELSE + NoCmd := TRUE; + END; + '1' : CASE Cmd[2] OF + 'L' : DoOneLiners; + END; + 'A' : CASE Cmd[2] OF + 'A','C','M','T' : + DoArcCommand(Cmd[2]); + 'E' : ExtractToTemp; + 'G' : UserArchive; + 'R' : ReZipStuff; + ELSE + NoCmd := TRUE; + END; + 'B' : CASE Cmd[2] OF + '?' : BatchDLULInfo; + + 'C' : IF (UpCase(MenuOption[1]) = 'U') THEN + ClearBatchULQueue + ELSE + ClearBatchDLQueue; + 'D' : BatchDownload; + 'L' : IF (UpCase(MenuOption[1]) = 'U') THEN + ListBatchULFiles + ELSE + ListBatchDLFiles; + 'R' : IF (UpCase(MenuOption[1]) = 'U') THEN + RemoveBatchULFiles + ELSE + RemoveBatchDLFiles; + + 'U' : BatchUpload(FALSE,0); + ELSE + NoCmd := TRUE; + END; + 'D' : CASE Cmd[2] OF + 'P','C','D','G','S','W','-','3' : + DoDoorFunc(Cmd[2],MenuOption); + ELSE + NoCmd := TRUE; + END; + 'F' : CASE Cmd[2] OF + 'A' : FileAreaChange(Done,MenuOption); + 'B' : DownloadFile(MenuOption,[lIsAddDLBatch]); + 'C' : CheckFilesBBS; + 'D' : DownloadFile(MenuOption,[]); + 'F' : SearchFileDescriptions; + 'L' : ListFileSpec(MenuOption); + 'N' : NewFilesScanSearchType(MenuOption); + 'P' : SetFileAreaNewScanDate; + 'S' : SearchFileSpec; + 'U' : UploadFile; + 'V' : ViewDirInternalArchive; + 'Z' : ToggleFileAreaScanFlags; + '@' : CreateTempDir; + '#' : BEGIN + NL; + Print('Enter the number of a file area to change to.'); + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + END; + ELSE + NoCmd := TRUE; + END; + 'H' : CASE Cmd[2] OF + 'C' : IF PYNQ(MenuOption,0,FALSE) THEN + BEGIN + CLS; + PrintF('LOGOFF'); + HangUp := TRUE; + HungUp := FALSE; + END; + 'I' : HangUp := TRUE; + 'M' : BEGIN + NL; + Print(MenuOption); + HangUp := TRUE; + END; + ELSE + NoCmd := TRUE; + END; + 'L' : CASE Cmd[2] OF + '1' : TFilePrompt := 1; + '2' : TFilePrompt := 2; + '3' : TFilePrompt := 3; + '4' : TFilePrompt := 4; + '5' : TFilePrompt := 5; + '6' : TFilePrompt := 6; + '7' : TFilePrompt := 7; + '8' : TFilePrompt := 8; + ELSE + NoCmd := TRUE; + END; + 'M' : CASE Cmd[2] OF + 'A' : MessageAreaChange(Done,MenuOption); + 'E' : SSMail(MenuOption); + 'K' : ShowEMail; + 'L' : SMail(TRUE); + 'M' : ReadMail; + 'N' : StartNewScan(MenuOption); + 'P' : IF (ReadMsgArea = -1) THEN + BEGIN + NL; + Print('^7This option is not available when reading private messages!^1'); + END + ELSE + BEGIN + IF (MAPrivate IN MemMsgArea.MAFlags) THEN + BEGIN + NL; + Post(-1,MHeader.From,PYNQ('Is this to be a private message? ',0,FALSE)) + END + ELSE + Post(-1,MHeader.From,FALSE); + END; + 'R' : ReadAllMessages(MenuOption); + 'S' : BEGIN + Abort := FALSE; + Next := FALSE; + ScanMessages(MsgArea,FALSE,MenuOption); + END; + 'U' : BEGIN + LoadMsgArea(MsgArea); + UList(MemMsgArea.ACS); + END; + 'Y' : ScanYours; + 'Z' : ToggleMsgAreaScanFlags; + '#' : BEGIN + NL; + Print('Enter the number of a message area to change to.'); + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + END; + ELSE + NoCmd := TRUE; + END; + 'N' : CASE Cmd[2] OF + 'A' : ToggleChatAvailability; + 'D' : Dump_Node; + 'O' : BEGIN + LListNodes; + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + END; + 'P' : Page_User; + 'G' : MultiLine_Chat; + 'S' : LSend_Message(MenuOption); + 'T' : IF AACS(General.Invisible) THEN + BEGIN + IsInvisible := NOT IsInvisible; + LoadNode(ThisNode); + IF (IsInvisible) THEN + Include(NodeR.Status,NInvisible) + ELSE + Exclude(NodeR.Status,NInvisible); + SaveNode(ThisNode); + NL; + Print('Invisible mode is now '+ShowOnOff(IsInvisible)); + END; + (* Consider deleting this cmd *) + 'W' : BEGIN + LoadNode(ThisNode); + NodeR.ActivityDesc := MenuOption; + SaveNode(ThisNode); + END; + ELSE + NoCmd := TRUE; + END; + 'O' : CASE Cmd[2] OF + '1','2' : + TShuttleLogon := Ord(Cmd[2]) - 48; + 'A' : AutoValidationCmd(MenuOption); + 'B' : GetUserStats(MenuOption); + 'C' : RequestSysOpChat(MenuOption); + 'F' : ChangeARFlags(MenuOption); + 'G' : ChangeACFlags(MenuOption); + 'L' : BEGIN + IF (Pos(';',MenuOption) > 0) THEN + BEGIN + MenuOption := Copy(MenuOption,Pos(';',MenuOption) + 1,(Length(MenuOption)) - (Pos(';',MenuOption))); + TempStr := Copy(MenuOption,1,(Pos(';',MenuOption) - 1)); + END + ELSE + TempStr := '0'; + TodaysCallers(StrToInt(TempStr),MenuOption); + END; + 'P' : CStuff(StrToInt(MenuOption),2,ThisUser); + 'R' : ChangeConference(MenuOption); + 'S' : Bulletins(MenuOption); + 'U' : UList(MenuOption); + ELSE + NoCmd := TRUE; + END; + 'Q' : CASE Cmd[2] OF + 'Q' : RGQuote(MenuOption); + ELSE + NoCmd := TRUE; + END; + 'R' : CASE Cmd[2] OF + '#' : BEGIN + NL; + Print('Enter the number of a message to read it.'); + END; + 'A' : TReadPrompt := 1; + '-' : IF (Msg_On > 1) THEN + TReadPrompt := 2 + ELSE + BEGIN + NL; + Print('You are already at the first message.'); + END; + 'M' : TReadPrompt := 3; + 'X' : TReadPrompt := 4; + 'E' : TReadPrompt := 5; + 'R' : TReadPrompt := 6; + 'I' : IF (NOT (MAForceRead IN MemMsgArea.MAFlags)) OR (CoSysOp) THEN + TReadPrompt := 7 + ELSE + Print('You must read all of the messages in this area.'); + 'B' : TReadPrompt := 8; + 'F' : TReadPrompt := 9; + 'C' : TReadPrompt := 10; + 'D' : TReadPrompt := 11; + 'H' : TReadPrompt := 12; + 'G' : IF (NOT (MAForceRead IN MemMsgArea.MAFlags)) OR (CoSysOp) THEN + TReadPrompt := 13 + ELSE + Print('^7You must read all of the messages in this area!^1'); + 'Q' : IF (NOT (MAForceRead IN MemMsgArea.MAFlags)) OR (CoSysOp) THEN + TReadPrompt := 14 + ELSE + Print('^7You must read all of the messages in this area!^1'); + 'L' : TReadPrompt := 15; + 'U' : TReadPrompt := 16; + 'T' : TReadPrompt := 17; + 'N' : TReadPrompt := 18; + 'S' : TReadPrompt := 19; + 'V' : TReadPrompt := 20; + 'J' : TReadPrompt := 21; + ELSE + NoCmd := TRUE; + END; + 'U' : CASE Cmd[2] OF + 'A' : ReplyAutoMsg; + 'R' : ReadAutoMsg; + 'W' : WriteAutoMsg; + ELSE + NoCmd := TRUE; + END; + 'V' : CASE Cmd[2] OF + '#' : BEGIN + NL; + Print('Enter the number of the topic to vote on.'); + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + END; + 'A' : AddTopic; + 'L' : ListTopics(TRUE); + 'R' : Results(FALSE); + 'T' : TrackUser; + 'U' : Results(TRUE); + 'V' : VoteAll; + ELSE + NoCmd := TRUE; + END; + 'T' : CASE Cmd[2] OF + 'A' : BBSList_Add; + 'E' : BBSList_Edit; + 'D' : BBSList_Delete; + 'V' : BBSList_View; + 'X' : BBSList_xView; + ELSE + NoCmd := TRUE; + END; + '!' : CASE Cmd[2] OF + 'P' : SetMessageAreaNewScanDate; + 'D' : DownloadPacket; + 'U' : UploadPacket(FALSE); + ELSE + NoCmd := TRUE; + END; + '*' : CASE Cmd[2] OF + '=' : ShowCmds(MenuOption); + 'B' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Message Area Editor'); + MessageAreaEditor; + END; + 'C' : IF (CheckPW) THEN + ChangeUser; + 'D' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Entered Dos Emulator'); + MiniDOS; + END; + 'E' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Event Editor'); + EventEditor; + END; + 'F' : IF (CheckPW) THEN + BEGIN + SysOpLog('* File Area Editor'); + FileAreaEditor; + END; + 'V' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Vote Editor'); + VotingEditor; + END; + 'L' : IF (CheckPW) THEN + ShowLogs; + 'N' : TEdit1; + 'P' : IF (CheckPW) THEN + BEGIN + SysOpLog('* System Configuration Editor'); + SystemConfigurationEditor; + END; + 'R' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Conference Editor'); + ConferenceEditor; + END; + 'T' : IF (CheckPW) THEN + BEGIN + {$IFDEF MSDOS} + mem[Seg0040:$0017] := mem[Seg0040:$0017] XOR 16; + {$ENDIF} + IF (SysOpAvailable) THEN + BEGIN + SysOpLog('* Turned on chat availablity'); + END + ELSE + BEGIN + SysOpLog('* Turned off chat availablity'); + END; + END; + 'U' : IF (CheckPW) THEN + BEGIN + SysOpLog('* User Editor'); + UserEditor(UserNum); + END; + 'X' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Protocol Editor'); + ProtocolEditor; + END; + 'Z' : BEGIN + SysOpLog('* History Editor'); + HistoryEditor; + END; + '1' : BEGIN + SysOpLog('* Edited Files'); + EditFiles; + END; + '2' : BEGIN + SysOpLog('* Sorted Files'); + Sort; + END; + '3' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Read Private Messages'); + ReadAllMessages(''); + END; + '4' : IF (MenuOption = '') THEN + Do_Unlisted_Download + ELSE + UnlistedDownload(MenuOption); + '5' : BEGIN + SysOpLog('* Rechecked files'); + ReCheck; + END; + '6' : IF (CheckPW) THEN + UploadAll; + '7' : ValidateFiles; + '8' : AddGIFSpecs; + '9' : PackMessageAreas; + '#' : IF (CheckPW) THEN + BEGIN + SysOpLog('* Menu Editor'); + SaveMenu := CurMenu; + MenuEditor; + CurMenu := SaveMenu; + LoadMenu; + END; + '$' : DirF(TRUE); + '%' : DirF(FALSE); + ELSE + NoCmd := TRUE; + END; + ELSE + NoCmd := TRUE; + END; + LastCommandGood := NOT NoCmd; + IF (LastCommandOvr) THEN + LastCommandGood := FALSE; + IF (NoCmd) THEN + IF (CoSysOp) THEN + BEGIN + TempStr := 'Invalid command keys: '+Cmd[1]+Cmd[2]+' '+Cmd; + NL; + Print(TempStr); + SysOpLog(TempStr); + END; + + IF ((Cmd[1] + Cmd[2]) <> 'NW') THEN + Update_Node('',FALSE); + + IF (NewMenuToLoad) THEN + BEGIN + LoadMenuPW; + LastCommandGood := FALSE; + IF (NewMenuCmd = '') THEN + AutoExecCmd('FIRSTCMD'); + END; +END; + +END. diff --git a/SOURCE/MENUS2.PAS b/SOURCE/MENUS2.PAS new file mode 100644 index 0000000..1f03e0f --- /dev/null +++ b/SOURCE/MENUS2.PAS @@ -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. diff --git a/SOURCE/MENUS3.PAS b/SOURCE/MENUS3.PAS new file mode 100644 index 0000000..7c2be3e --- /dev/null +++ b/SOURCE/MENUS3.PAS @@ -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. diff --git a/SOURCE/MISC/ONELE.ANS b/SOURCE/MISC/ONELE.ANS new file mode 100644 index 0000000..dc8cad2 --- /dev/null +++ b/SOURCE/MISC/ONELE.ANS @@ -0,0 +1 @@ +%LF 컴컴컴컴컴컴컴컴 컴컴컴컴컴컴컴컴컴컴�컴컴컴컴컴�컴컴컴컴컴컴� 컴컴컴컴컴컴컴�%LF \ No newline at end of file diff --git a/SOURCE/MISC/ONELE.ASC b/SOURCE/MISC/ONELE.ASC new file mode 100644 index 0000000..258bb4f --- /dev/null +++ b/SOURCE/MISC/ONELE.ASC @@ -0,0 +1 @@ +%LF |15컴� |07컴 컴 컴|08컴� 컴 컴 � |03컴 컴 � � |11컴 � � 컴 |03컴 컴 � � |08컴� 컴 컴|07 컴� 컴 |15컴 컴%LF diff --git a/SOURCE/MISC/ONELH.ANS b/SOURCE/MISC/ONELH.ANS new file mode 100644 index 0000000..5601d68 --- /dev/null +++ b/SOURCE/MISC/ONELH.ANS @@ -0,0 +1,7 @@ +[?7h栢栢栢幡賽賽賽賽賽賽賽賽賽賽� 賽栢� 賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賞栢栢栢 + 賽賽賽賽 께栢栢� 께栢栢� 께栢栢 꾼� 꾼� 께栢栢� 께栢栢 께栢栢� 께栢栢 賽賽賽賽 + 栢栢栢栢 꾼栢栢� 꾼栢栢� 꾼栢 � 栢� 栢� 꾼栢栢� 꾼栢 � 꾼幡栢� 꾼栢 � 栢栢栢栢 + 栢栢栢栢 栢� 栢� 栢� 栢� 栢栢� 栢� 栢� 栢� 栢� 栢栢� 栢栢栢� 栢栢栢 栢栢栢栢 + 栢栢栢栢 栢栢栢� 栢� 栢� 栢栢 � 栢� 栢� 栢� 栢� 栢栢 � 栢� 栢 � 栢栢 栢栢栢栢 + 複複複複 栢栢昉� 栢� 昉� 栢栢昉 幡� 幡� 栢� 昉� 栢栢昉 昉� 栢� 栢栢方 複複複複 + 컴컴컴컴컴컴컴컴 컴컴컴컴컴컴컴컴컴컴�컴컴컴컴컴�컴컴컴컴컴컴� 컴컴컴컴컴컴컴�%LF diff --git a/SOURCE/MISC/ONELH.ASC b/SOURCE/MISC/ONELH.ASC new file mode 100644 index 0000000..59d3f03 --- /dev/null +++ b/SOURCE/MISC/ONELH.ASC @@ -0,0 +1,12 @@ + + 栢栢栢 + 栢幡賽 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + 賽� 蔔栢賽栢白 璽栢幡栢白 蔔栢賞栢� 栢栢 栢栢 璽栢幡栢白 蔔栢賞栢� + � 査栢� 査栢� 栢栢 査栢� 査栢� 栢栢 栢栢 栢栢 栢栢 査栢� 査栢� 栢栢 � + 賞 같栢 栢같 栢方 栢같 같栢複栢栢 栢方 栢方 栢方 栢같 같栢複栢栢 賽� + � 굇겡 方굇 方갚 方굇 굇겡 複複 方갚 方갚 方갚 方굇 굇겡 複複 � + 白輹껑금 檳굉� 갚께 檳굉� 殯굇� 栢겡 갚께 갚께 갚께 檳굉� 殯굇� 栢겡 rl� + � 賞栢複栢幡 께栢 栢幡 賞栢兵굇� 께栢複 께栢 께栢 栢幡 賞栢兵굇� v!� + 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 複複栢 + 栢栢栢 + diff --git a/SOURCE/MISC/ONELM.ASC b/SOURCE/MISC/ONELM.ASC new file mode 100644 index 0000000..529bf3b --- /dev/null +++ b/SOURCE/MISC/ONELM.ASC @@ -0,0 +1 @@ + |03~OL |11 ... |15~UN{16%LF diff --git a/SOURCE/MISCUSER.PAS b/SOURCE/MISCUSER.PAS new file mode 100644 index 0000000..a098438 --- /dev/null +++ b/SOURCE/MISCUSER.PAS @@ -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. diff --git a/SOURCE/MSGPACK.PAS b/SOURCE/MSGPACK.PAS new file mode 100644 index 0000000..ff81488 --- /dev/null +++ b/SOURCE/MSGPACK.PAS @@ -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. diff --git a/SOURCE/MULTNODE.PAS b/SOURCE/MULTNODE.PAS new file mode 100644 index 0000000..8fb6183 --- /dev/null +++ b/SOURCE/MULTNODE.PAS @@ -0,0 +1,1321 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +UNIT Multnode; + +INTERFACE + +USES + Common; + +PROCEDURE lListNodes; +PROCEDURE ToggleChatAvailability; +PROCEDURE page_user; +PROCEDURE check_status; +PROCEDURE multiline_chat; +PROCEDURE dump_node; +PROCEDURE lsend_message(CONST b: ASTR); + +IMPLEMENTATION + +USES + Doors, + Menus, + Script, + ShortMsg, + TimeFunc; + +PROCEDURE pick_node(VAR NodeNum: Byte; IsChat: BOOLEAN); +BEGIN + lListNodes; + InputByteWOC('Which node',NodeNum,[NumbersOnly],1,MaxNodes); + IF (NodeNum >= 1) AND (NodeNum <= MaxNodes) AND (NodeNum <> ThisNode) THEN + BEGIN + LoadNode(NodeNum); + IF (NOT (NActive IN NodeR.Status) OR (NOT (NAvail IN NodeR.Status) AND IsChat)) AND NOT + ((NInvisible IN NodeR.Status) AND NOT CoSysOp) THEN + BEGIN + NL; + Print('That node is unavailable.'); + NodeNum := 0; + END; + IF (NodeR.User = 0) OR NOT (NAvail IN NodeR.Status) OR ((NInvisible IN NodeR.Status) AND NOT CoSysOp) THEN + NodeNum := 0; + END + ELSE + NodeNum := 0; +END; + +PROCEDURE dump_node; +VAR + NodeNum: Byte; +BEGIN + pick_node(NodeNum,FALSE); + IF (NodeNum > 0) THEN + IF PYNQ('Hang up user on node '+IntToStr(NodeNum)+'? ',0,FALSE) THEN + BEGIN + LoadNode(NodeNum); + Include(NodeR.Status,NHangup); + IF PYNQ('Recycle node '+IntToStr(NodeNum)+' after logoff? ',0,FALSE) THEN + Include(NodeR.Status,NRecycle); + SaveNode(NodeNum); + END; +END; + +PROCEDURE page_user; +VAR + NodeNum: Byte; +BEGIN + NL; + IF (NOT General.MultiNode) THEN + BEGIN + Print('This BBS is currently not operating in Multi-Node.'); + Exit; + END; + pick_node(NodeNum,TRUE); + IF (NodeNum > 0) AND (NodeNum <> ThisNode) THEN + lsend_message(IntToStr(NodeNum)+';^8'+Caps(ThisUser.Name)+' on node '+IntToStr(ThisNode)+' has paged you for chat.'^M^J); +END; + +PROCEDURE check_status; +VAR + f: FILE; + s: STRING; + j: BYTE; +BEGIN + LoadNode(ThisNode); + WITH NodeR DO + BEGIN + IF (NUpdate IN Status) THEN + BEGIN + j := ThisUser.Waiting; + Reset(UserFile); + Seek(UserFile,UserNum); + Read(UserFile,ThisUser); + Close(UserFile); + LastError := IOResult; + update_screen; + IF (ThisUser.Waiting > j) THEN + BEGIN + NL; + Print('^8You have new private mail waiting.'); + NL; + END; + Exclude(Status,NUpdate); + SaveNode(ThisNode); + IF (SMW IN ThisUser.flags) THEN + BEGIN + ReadShortMessage; + NL; + END; + END; + IF (NHangup IN Status) OR (NRecycle IN Status) THEN + BEGIN + HangUp := TRUE; + IF (NRecycle IN Status) THEN + QuitAfterDone := TRUE; + END; + IF (NOT MultiNodeChat) AND (MaxChatRec > NodeChatLastRec) THEN + BEGIN + Assign(f,General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP'); + Reset(f,1); + Seek(f,NodeChatLastRec); + WHILE NOT EOF(f) DO + BEGIN + BlockRead(f,s[0],1); + BlockRead(f,s[1],Ord(s[0])); + Print(s); + END; + Close(f); + LastError := IOResult; + NodeChatLastRec := MaxChatRec; + PauseScr(FALSE); + END; + END; +END; + +PROCEDURE LowLevelSend(s: STRING; Node: Byte); +VAR + F: FILE; +BEGIN + IF (Node < 0) THEN + Exit; + Assign(f,General.TempPath+'MSG'+IntToStr(Node)+'.TMP'); + Reset(f,1); + IF (IOResult = 2) THEN + ReWrite(f,1); + Seek(f,FileSize(f)); + BlockWrite(f,s[0],(Length(s) + 1)); + Close(f); + LastError := IOResult; +END; + +PROCEDURE multiline_chat; +type + WhyNot = (NotModerator,NotOnline,NotRoom,NotInRoom,NotValid); +VAR + RoomFile: FILE OF RoomRec; + ActionsFile: TEXT; + Room: RoomRec; + User: UserRecordType; + s: STRING; + s2, + s3, + execs: ASTR; + SaveName: STRING[36]; + Cmd: CHAR; + i, + j, + SaveTimeOut, + SaveTimeOutBell: INTEGER; + Done, + ChannelOnly: BOOLEAN; + + FUNCTION ActionMCI(s: ASTR): STRING; + VAR + Temp: ASTR; + Index: INTEGER; + BEGIN + Temp := ''; + FOR Index := 1 TO Length(s) DO + IF (s[Index] = '%') THEN + CASE (UpCase(s[Index + 1])) OF + 'S' : BEGIN + Temp := Temp + Caps(ThisUser.Name); + Inc(Index); + END; + 'R' : BEGIN + Temp := Temp + Caps(SaveName); + Inc(Index); + END; + 'G' : BEGIN + Temp := Temp + AOnOff((ThisUser.sex = 'M'),'his','her'); + Inc(Index); + END; + 'H' : BEGIN + Temp := Temp + AOnOff((ThisUser.sex = 'M'),'him','her'); + Inc(Index); + END; + END + ELSE + Temp := Temp + s[Index]; + ActionMCI := Temp; + END; + + PROCEDURE LoadRoom(VAR Chan: INTEGER); + BEGIN + Reset(RoomFile); + Seek(RoomFile,(Chan - 1)); + Read(RoomFile,Room); + Close(RoomFile); + LastError := IOResult; + END; + + PROCEDURE SaveRoom(VAR Chan: INTEGER); + BEGIN + Reset(RoomFile); + Seek(RoomFile,(Chan - 1)); + Write(RoomFile,Room); + Close(RoomFile); + LastError := IOResult; + END; + + PROCEDURE SendMessage(s: STRING; showhere: BOOLEAN); + VAR + i: WORD; + Trap: TEXT; + BEGIN + IF (General.TrapTeleConf) THEN + BEGIN + Assign(Trap,General.LogsPath+'ROOM'+IntToStr(RoomNumber)+'.TRP'); + Append(Trap); + IF (IOResult = 2) THEN + ReWrite(Trap); + WriteLn(Trap,StripColor(s)); + Close(Trap); + END; + WITH NodeR DO + FOR i := 1 TO MaxNodes DO + BEGIN + LoadNode(i); + IF (i <> ThisNode) AND ((NOT ((ThisNode MOD 8) IN Forget[ThisNode DIV 8])) AND + ((NOT ChannelOnly) AND (MultiNodeChat) AND (Room = RoomNumber)) OR + ((NodeR.Channel = ChatChannel) AND (ChatChannel > 0) AND ChannelOnly)) THEN + LowLevelSend(s,i); + END; + IF (ShowHere) THEN + BEGIN + IF (MultiNodeChat) AND NOT AACS(General.TeleConfMCI) THEN + MCIAllowed := FALSE; + Print(s); + MCIAllowed := TRUE; + END; + END; + + PROCEDURE AddToRoom(VAR Chan: INTEGER); + VAR + People: WORD; + i: WORD; + BEGIN + IF (NOT IsInvisible) AND NOT ((Chan MOD 8) IN NodeR.Booted[Chan DIV 8]) THEN + SendMessage('^0[^9'+Caps(ThisUser.Name)+' ^0has entered the room. ]',FALSE); + NL; + Print('^1You are now in conference room ^3'+IntToStr(Chan)); + LoadRoom(Chan); + IF (NOT Room.Occupied) THEN + BEGIN + Room.Occupied := TRUE; + SaveRoom(Chan); + END; + People := 0; + FOR i := 1 TO MaxNodes DO + BEGIN + IF (i = ThisNode) THEN + Continue; + LoadNode(i); + IF (NodeR.Room = Chan) AND (NodeR.GroupChat) THEN + Inc(People); + END; + WITH Room DO + BEGIN + IF (Chan = 1) THEN + Topic := 'Main'; + IF (Topic <> '') THEN + Print('^1The Current Topic is: ^3'+Topic); + IF (People = 0) THEN + Print('^1You are the only one present.') + ELSE + Print('^1There '+AOnOff(People = 1,'is','are')+' '+IntToStr(People)+ + ' other '+AOnOff(People = 1,'person','people')+' present.'); + END; + LoadNode(ThisNode); + NodeR.Room := Chan; + SaveNode(ThisNode); + END; + + PROCEDURE RemoveFromRoom(VAR Chan: INTEGER); + VAR + People: WORD; + i: WORD; + BEGIN + IF (NOT IsInvisible) AND NOT ((Chan MOD 8) IN NodeR.Booted[Chan DIV 8]) THEN + SendMessage('^0[^9 '+Caps(ThisUser.Name)+'^0 has left the room. ]', FALSE); + LoadRoom(Chan); + WITH Room DO + IF (Moderator = UserNum) THEN + Moderator := 0; + People := 0; + FOR i := 1 TO MaxNodes DO + BEGIN + IF (i = ThisNode) THEN + Continue; + LoadNode(i); + IF (NodeR.Room = Chan) AND (NodeR.GroupChat) THEN + Inc(People); + END; + IF (People = 1) THEN + Room.Occupied := FALSE; + IF (NOT IsInvisible) THEN + SaveRoom(Chan); + END; + + FUNCTION Name2Number(VAR s,sname: ASTR): INTEGER; + VAR + i: INTEGER; + Temp: STRING; + BEGIN + Name2Number := 0; + IF (Pos(' ',s) > 0) THEN + Sname := Copy(s,1,Pos(' ',s)) + ELSE + Sname := s; + i := StrToInt(SQOutSp(Sname)); + IF (SQOutSp(Sname) = IntToStr(i)) AND ((i > 0) AND (i <= MaxNodes)) THEN + BEGIN + LoadNode(i); + WITH NodeR DO + IF (User > 0) THEN + BEGIN + IF ((NOT (NInvisible IN Status)) OR (CoSysOp)) THEN + Name2Number := i + ELSE + Name2Number := 0; + s := Copy(s,(Length(Sname) + 1),255); + Sname := Caps(UserName); + Exit; + END; + END; + i := 1; + Sname := ''; + IF (Pos(' ',s) > 0) THEN + Temp := AllCaps(Copy(s,1,(Pos(' ',s) - 1))) + ELSE + Temp := AllCaps(s); + WHILE (i <= MaxNodes) DO + BEGIN + LoadNode(i); + WITH NodeR DO + IF (User > 0) THEN + BEGIN + IF ((UserName = AllCaps(Copy(s,1,Length(UserName)))) OR (Pos(Temp,UserName) > 0)) THEN + BEGIN + Name2Number := i; + IF (UserName = AllCaps(Copy(s,1,Length(UserName)))) THEN + s := Copy(s,(Length(UserName) + 2), 255) + ELSE + s := Copy(s,(Length(temp) + 2), 255); + sname := Caps(UserName); + Break; + END; + END; + Inc(i); + END; + END; + + PROCEDURE Nope(Reason: WhyNot); + BEGIN + NL; + CASE Reason OF + NotModerator : Print('|10You are not the moderator.'); + NotOnline : Print('|10That user is not logged on.'); + NotRoom : Print('|10Invalid room number.'); + NotInRoom : Print('|10That user is not in this room.'); + NotValid : Print('|10Invalid option - Enter "/?" for help'); + END; + NL; + END; + + PROCEDURE ShowRoom(Chan: INTEGER); + VAR + People: WORD; + i: WORD; + BEGIN + LoadRoom(Chan); + IF (NOT Room.Occupied) THEN + Exit; + People := 0; + FOR i := 1 TO MaxNodes DO + BEGIN + IF (i = ThisNode) THEN + Continue; + LoadNode(i); + IF (NodeR.Room = Chan) AND (NodeR.GroupChat) THEN + Inc(People); + END; + IF (People = 0) THEN + BEGIN + NL; + IF (Room.Moderator >= 0) THEN + LoadURec(User,Room.Moderator) + ELSE + User.Name := 'Nobody'; + PrintACR('^9Conference Room: ^3'+PadLeftInt(Chan,5)+' ^9Moderator: ^3'+Caps(User.Name)); + PrintACR('^9Type: ^3'+PadLeftStr(AOnOff(Room.Private,'Private','Public'),17)+'^9Topic: ^3'+Room.Topic); + IF (Room.Anonymous) THEN + BEGIN + NL; + PrintACR('This room is in anonymous mode.'); + END; + NL; + j := 1; + WHILE (J <= MaxNodes) AND (NOT Abort) DO + BEGIN + LoadNode(j); + IF (NodeR.GroupChat) AND (NodeR.Room = Chan) THEN + IF NOT (NInvisible IN NodeR.Status) OR (CoSysOp) THEN + PrintACR('^1'+Caps(NodeR.UserName)+' on node '+IntToStr(j)); + Inc(j); + END; + NL; + END; + END; + + PROCEDURE InputMain(VAR s: STRING); + VAR + os, + cs: STRING; + cp: INTEGER; + c: CHAR; + ml, + origcolor: BYTE; + cb: WORD; + LastCheck: LONGINT; + + PROCEDURE DoBackSpace; + VAR + i,j,c: BYTE; + WasColor: BOOLEAN; + + PROCEDURE set_color; + BEGIN + c := origcolor; + i := 1; + WHILE (i < cp) DO + BEGIN + IF (s[i]='^') THEN + BEGIN + c := Scheme.Color[Ord(s[i+1]) + Ord('1')]; + Inc(i); + END; + IF (s[i]='|') AND (i + 1 < Length(s)) AND (s[i + 1] IN ['0'..'9']) AND (s[i + 2] IN ['0'..'9']) THEN + BEGIN + cs := s[i + 1] + s[i + 2]; + CASE cb OF + 0..15 : c := (c - (c MOD 16) + cb); + 16..23 : c:= ((cb - 16) * 16) + (c MOD 16); + END; + END; + Inc(i); + END; + SetC(c); + END; + + BEGIN + WasColor := FALSE; + IF (cp > 1) THEN + BEGIN + Dec(cp); + IF (cp > 1) THEN + BEGIN + IF (s[cp] IN ['0'..'9']) THEN + BEGIN + IF (s[cp-1] = '^') THEN + BEGIN + Dec(cp); + WasColor := TRUE; + set_color; + END + ELSE + BEGIN + j := 0; + WHILE (s[cp-j] <> '|') AND (s[cp - j] IN ['0'..'9']) AND (j < cp) DO + BEGIN + Inc(j); + END; + IF (s[cp - j] = '|') THEN + BEGIN + WasColor := TRUE; + Dec(cp,j); + set_color; + END; + END; + END; + END; + IF (NOT WasColor) THEN + BEGIN + BackSpace; + IF (trapping) THEN + Write(TrapFile,^H' '^H); + END; + END; + END; + + BEGIN + origcolor := CurrentColor; + os := s; + s:=''; + ml := (253 - Length(MCI(Liner.TeleConfNormal))); + checkhangup; + IF (HangUp) THEN + Exit; + cp := 1; + LastCheck := 0; + repeat + mlc := s; + MultiNodeChat := TRUE; + IF (cp > 1) AND MultiNodeChat AND NOT ThisUser.TeleConfInt THEN + MultiNodeChat := FALSE; + C := CHAR(GetKey); + IF (Timer - LastCheck > 1) THEN + BEGIN + LoadNode(ThisNode); + IF ((RoomNumber MOD 8) IN NodeR.Booted[RoomNumber DIV 8]) THEN + BEGIN + s := ''; + Print('^5You have been ^0EJECTED^5 from the room.'^M^J); + IF (RoomNumber = 1) THEN + Done := TRUE + ELSE + BEGIN + RemoveFromRoom(RoomNumber); + RoomNumber := 1; + AddToRoom(RoomNumber); + END; + Exit; + END + END; + CASE c OF + ^H : DoBackSpace; + ^P : IF (cp < ml) THEN + BEGIN + c := CHAR(GetKey); + IF (c IN ['0'..'9']) THEN + BEGIN + UserColor(Ord(c)-48); + s[cp] := '^'; + s[cp + 1] := c; + Inc(cp,2); + END; + END; + #32..#123,#125..#255 : + IF (cp <= ml) THEN + BEGIN + s[cp] := c; + Inc(cp); + outkey(c); + IF (trapping) THEN + Write(TrapFile,c); + END; + '|' : IF (cp + 1 <= ml) THEN + BEGIN + cs := ''; + c := '0'; + cb := 0; + WHILE (c IN ['0'..'9']) AND (cb < 2) DO + BEGIN + c := CHAR(GetKey); + IF (c IN ['0'..'9']) THEN + cs := cs + c; + Inc(cb); + END; + cb := StrToInt(cs); + CASE cb OF + 0..15 : SetC(CurrentColor - (CurrentColor MOD 16) + cb); + 16..23 : SetC(((cb - 16) * 16) + (CurrentColor MOD 16)); + END; + IF NOT (c IN ['0'..'9']) THEN + BEGIN + outkey(c); + IF (trapping) THEN + Write(TrapFile,c); + cs := cs + c; {here was buf} + END; + s := s + '|' + cs; + Inc(cp,Length(cs)+1); + END + ELSE IF (cp <= ml) THEN + BEGIN + s[cp] := c; + Inc(cp); + outkey(c); + IF (trapping) THEN + Write(TrapFile,c); + END; + ^X : BEGIN + WHILE (cp <> 1) DO + DoBackSpace; + SetC(origcolor); + END; + END; + s[0] := Chr(cp - 1); + until ((c = ^M) OR (c = ^N) OR (HangUp)); + mlc := ''; + NL; + END; + +BEGIN + NL; + IF (NOT General.MultiNode) THEN + BEGIN + Print('This BBS is currently not operating in Multi-Node.'); + Exit; + END; + + Assign(ActionsFile,General.MiscPath+'ACTIONS.LST'); + Reset(ActionsFile); + IF (IOResult = 2) THEN + ReWrite(ActionsFile); + Close(ActionsFile); + + Assign(RoomFile,General.DataPath+'ROOM.DAT'); + Reset(RoomFile); + IF (IOResult = 2) THEN + ReWrite(RoomFile); + FillChar(Room,SizeOf(Room),0); + Seek(RoomFile,FileSize(RoomFile)); + WHILE (FileSize(RoomFile) < 255) DO + Write(RoomFile,Room); + Close(RoomFile); + + IF (IOResult <> 0) THEN + Exit; + + SaveTimeOut := General.TimeOut; + General.TimeOut := -1; + SaveTimeOutBell := General.TimeOutBell; + General.TimeOutBell := -1; + + Kill(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP'); + + ChannelOnly := FALSE; + + IF (General.MultiNode) THEN + BEGIN + LoadNode(ThisNode); + NodeR.GroupChat := TRUE; + SaveNode(ThisNode); + END; + + mlc := ''; + RoomNumber := 1; + NodeChatLastRec := 0; + + CLS; + SysOpLog('Entered Teleconferencing'); + PrintF('TELECONF'); + IF (NoFile) THEN + Print('^0 Welcome to Teleconferencing. Type ^5/?^0 for help or ^5/Q^0 to quit.'); + AddToRoom(RoomNumber); + NL; + Done := FALSE; + WHILE (NOT Done) AND (NOT HangUp) DO + BEGIN + TLeft; + MultiNodeChat := TRUE; + LoadNode(ThisNode); + Usercolor(3); + check_status; + InputMain(s); + ChannelOnly := FALSE; + MultiNodeChat := FALSE; + IF (HangUp) THEN + s := '/Q'; + IF (s = '`') THEN + IF (ChatChannel > 0) THEN + BEGIN + j := 1; + Print('^0The following people are in global channel '+IntToStr(ChatChannel)+': '^M^J); + WHILE (J <= MaxNodes) AND (NOT Abort) DO + BEGIN + LoadNode(j); + WITH NodeR DO + IF (GroupChat) AND (Channel = ChatChannel) AND (j <> ThisNode) THEN + BEGIN + PrintACR('^9'+Caps(UserName)+' on node '+IntToStr(j)); + ChannelOnly := TRUE; + END; + Inc(j); + END; + IF (NOT ChannelOnly) THEN + Print('^9None.') + ELSE + ChannelOnly := FALSE; + NL; + s := ''; + END + ELSE + BEGIN + Print('^0You are not in a global channel.'^M^J); + s := ''; + END; + IF (NOT Done) AND (s <> '') AND (s[1] = '/') THEN + BEGIN + Cmd := UpCase(s[2]); + s3 := AllCaps(Copy(s,2,255)); + IF (Pos(' ',s3) > 0) THEN + BEGIN + SaveName := Copy(s3,(Pos(' ',s3) + 1),255); + s3 := Copy(s3,1,(Pos(' ',s3) - 1)); + END + ELSE + SaveName := ''; + s2 := SaveName; + IF (SaveName <> '') THEN + BEGIN + i := Name2Number(s2,SaveName); + IF (SaveName = '') THEN + i := -1; + END + ELSE + i := 0; + Reset(ActionsFile); + WHILE NOT EOF(ActionsFile) DO + BEGIN + ReadLn(ActionsFile,s2); { Action WORD } + IF (AllCaps(s2) = s3) THEN + BEGIN + ReadLn(ActionsFile,s2); { What sender sees } + s2 := MCI(s2); + IF (Copy(AllCaps(s2),1,5) <> ':EXEC') THEN + BEGIN + Print('^0'+ActionMCI(s2)); + execs := ''; + END + ELSE + execs := Copy(s2,6,255); { strip ":EXEC" } + ReadLn(ActionsFile,s2); { What everybody ELSE sees } + IF (i = 0) THEN + ReadLn(ActionsFile,s2); { What evrybdy sees IF no rcvr } + s2 := MCI(s2); + s2 := '^0' + ActionMCI(s2); + WITH NodeR DO + FOR j := 1 TO MaxNodes DO + BEGIN + LoadNode(j); + IF (GroupChat) AND (Room = RoomNumber) AND + (j <> ThisNode) AND NOT ((ThisNode MOD 8) IN Forget[ThisNode DIV 8]) AND + (j <> i) THEN + LowLevelSend(s2,j); + END; + IF (i > 0) THEN + ReadLn(ActionsFile,s2); + ReadLn(ActionsFile,s2); { What receiver sees } + s2 := MCI(s2); + IF (i > 0) THEN + BEGIN + LoadNode(i); + IF (NodeR.GroupChat) AND (NodeR.Room = RoomNumber) AND + NOT ((ThisNode MOD 8) IN NodeR.Forget[ThisNode DIV 8]) THEN + LowLevelSend('^0'+ActionMCI(s2), i); + END; + s := ''; + IF (execs <> '') THEN + BEGIN + Cmd := execs[1]; + execs := Copy(execs,2,255); + dodoorfunc(Cmd,execs); + END; + Break; + END + ELSE FOR j := 1 TO 4 DO + ReadLn(ActionsFile,s2); + END; + Close(ActionsFile); + + IF (s <> '') THEN + CASE Cmd OF + '/' : IF (Copy(s,2,3) = '/\\') AND (SysOp) THEN + DoMenuCommand(Done,AllCaps(Copy(S,5,2)),AllCaps(Copy(s,7,255)),s2,'Activating SysOp Cmd'); + + 'A' : IF (AllCaps(Copy(s,2,4)) <> 'ANON') THEN + BEGIN + s := Copy(s,4,(Length(s) - 3)); + s := '^0'+Caps(ThisUser.Name)+' '+s; + END + ELSE + BEGIN + IF (Room.Moderator = UserNum) OR (CoSysOp) THEN + BEGIN + LoadRoom(RoomNumber); + Room.Anonymous := NOT Room.Anonymous; + SaveRoom(RoomNumber); + SendMessage('^0[ This room is now in ^2'+AOnOff(Room.Anonymous,'Anonymous','Regular')+'^0 ]',TRUE); + END + ELSE + Nope(NotModerator); + END; + + 'E' : BEGIN + IF (AllCaps(Copy(s,2,4)) = 'ECHO') THEN + BEGIN + ThisUser.TeleConfEcho := NOT ThisUser.TeleConfEcho; + Print('^9Your message echo is now '+ShowOnOff(ThisUser.TeleConfEcho)); + END + ELSE IF (AllCaps(Copy(s,2,5)) = 'EJECT') THEN + BEGIN + IF (Room.Moderator = UserNum) OR (CoSysOp) THEN + BEGIN + s := Copy(s,(Pos(' ',s) + 1),Length(s)); + i := Name2Number(s,SaveName); + IF (i > 0) AND (i <= MaxNodes) THEN + BEGIN + LoadNode(i); + IF (NodeR.GroupChat) AND (NodeR.Room = RoomNumber) THEN + BEGIN + LoadURec(User,NodeR.User); + IF (aacs1(User, NodeR.User, General.CSOp)) THEN + Print('^9You cannot eject that person.'^M^J) + ELSE + BEGIN + NodeR.Booted[RoomNumber DIV 8] := NodeR.Booted[RoomNumber DIV 8] + [RoomNumber MOD 8]; + NodeR.Room := 1; + SaveNode(i); + IF (NOT IsInvisible) THEN + SendMessage('^0'+SaveName+'^9 has just been ejected from the room by ^0'+ + Caps(ThisUser.Name),TRUE); + SysOpLog('Ejected '+SaveName); + END; + END + ELSE + Nope(NotInRoom); + END + ELSE + Nope(NotOnline); + s := ''; + END + ELSE + Nope(NotModerator); + END; + END; + + 'F' : IF (S[3] <> ' ') OR (Copy(S,4,(Length(s) - 3)) = '') THEN + Nope(NotValid) + ELSE + BEGIN + s := Copy(s,4,(Length(s) - 3)); + i := Name2Number(s,SaveName); + IF (i > 0) AND (i <= MaxNodes) THEN + BEGIN + LoadURec(User,NodeR.User); + IF (aacs1(User,NodeR.User,General.CSOp)) THEN + Print('^9You cannot forget a sysop.'^M^J) + ELSE + BEGIN + LoadNode(ThisNode); + NodeR.Forget[i DIV 8] := NodeR.Forget[i DIV 8] + [i MOD 8]; + SaveNode(ThisNode); + Print('^0'+SaveName+'^9 has been forgotten.'); + END; + END + ELSE + Nope(NotOnLine); + s := ''; + END; + + 'G' : IF (AllCaps(Copy(s,2,6)) = 'GLOBAL') THEN + BEGIN + LoadNode(ThisNode); + NodeR.Channel := StrToInt(Copy(s,(Pos(' ',s) + 1),255)); + Print(^M^J'^0You are now in global channel '+IntToStr(NodeR.Channel)+'.'^M^J); + ChatChannel := NodeR.Channel; + SaveNode(ThisNode); + ChannelOnly := TRUE; + IF (NOT IsInvisible) THEN + SendMessage('^9'+Caps(ThisUser.Name)+' has joined global channel '+IntToStr(chatchannel)+'.', FALSE); + END + ELSE IF (AllCaps(s) = '/G') THEN + BEGIN + IF PYNQ('Are you sure you want to disconnect? ',39,FALSE) THEN + BEGIN + IF (NOT IsInvisible) THEN + SendMessage('^0[ ^2'+Caps(ThisUser.Name)+'^0 has disconnected on node '+IntToStr(ThisNode)+' ]',FALSE); + HangUp := TRUE; + END; + END; + + 'I' : IF (AllCaps(Copy(s,2,9)) = 'INTERRUPT') THEN + BEGIN + ThisUser.TeleConfInt := NOT ThisUser.TeleConfInt; + Print('^9Your message interruption is now '+ShowOnOff(ThisUser.TeleConfInt)); + END + ELSE + BEGIN + IF (Room.Moderator = UserNum) OR (CoSysOp) THEN + BEGIN + IF (Length(s) = 2) THEN + BEGIN + LoadRoom(RoomNumber); + Room.Private := NOT Room.Private; + SaveRoom(RoomNumber); + SendMessage('^0[ This room is now ^2'+AOnOff(Room.Private,'private','public') + '^0 ]', TRUE); + END + ELSE + BEGIN + s := Copy(s,4,(Length(s) - 3)); + i := Name2Number(s,SaveName); + IF (i > 0) AND (i <= MaxNodes) THEN + BEGIN + LoadNode(i); + s := ^M^J+'^9[^0 ' + Caps(ThisUser.Name) + '^9 is inviting you to join conference room ' + +IntToStr(RoomNumber)+' ]'; + NodeR.Invited[RoomNumber DIV 8] := NodeR.Invited[RoomNumber DIV 8] + [RoomNumber MOD 8]; + NodeR.Booted[RoomNumber DIV 8] := NodeR.Booted[RoomNumber DIV 8] - [RoomNumber MOD 8]; + Print('^0'+SaveName+'^9 on node '+IntToStr(i)+' has been invited.'); + SaveNode(i); + IF (i <> ThisNode) THEN + LowLevelSend(s,i); + END + ELSE + Nope(NotOnline); + s := ''; + END; + END + ELSE + Nope(NotModerator); + END; + + 'J' : IF (S[3] <> ' ') OR (Copy(S,4,(Length(s) - 3)) = '') THEN + Nope(NotValid) + ELSE + BEGIN + s := Copy(s,4,3); + i := StrToInt(s); + IF (i >= 1) AND (i <= 255) THEN + BEGIN + LoadNode(ThisNode); + IF ((i MOD 8) IN NodeR.Booted[i DIV 8]) THEN + BEGIN + NL; + Print('^5You were ^0EJECTED^5 from that room.'); + NL; + END + ELSE + BEGIN + LoadRoom(i); + IF (Room.Private) AND NOT (CoSysOp) AND NOT ((i MOD 8) IN NodeR.Invited[i DIV 8]) THEN + BEGIN + NL; + Print('^9You must be invited to private conference rooms.'); + NL; + LoadRoom(RoomNumber); + END + ELSE + BEGIN + RemoveFromRoom(RoomNumber); + RoomNumber := i; + AddToRoom(RoomNumber); + SysOpLog('Joined room '+IntToStr(RoomNumber)+' '+Room.Topic); + END; + END; + END + ELSE + Nope(NotRoom); + s := ''; + END; + + 'L' : IF (Copy(S,3,(Length(S) - 2)) <> '') THEN + Nope(NotValid) + ELSE + PrintF('ACTIONS'); + + 'M' : IF (S[3] <> ' ') OR (Copy(S,4,(Length(s) - 3)) = '') THEN + Nope(NotValid) + ELSE + BEGIN + NL; + IF (CoSysOp) OR (Room.Moderator = UserNum) OR ((Room.Moderator = 0) AND (RoomNumber <> 1)) THEN + BEGIN + s := Copy(S,4,40); + LoadRoom(RoomNumber); + Room.Topic := s; + IF (NOT IsInvisible) THEN + SendMessage('^0[ Conference "^2'+Room.Topic+'^0" is now moderated by ^2'+ + Caps(ThisUser.Name)+'^0 ]',TRUE); + IF (Room.Moderator = 0) THEN + BEGIN + FOR i := 1 TO MaxNodes DO + BEGIN + LoadNode(i); + NodeR.Invited[RoomNumber DIV 8] := NodeR.Invited[RoomNumber DIV 8] - [RoomNumber MOD 8]; + NodeR.Booted[RoomNumber DIV 8] := NodeR.Booted[RoomNumber DIV 8] - [RoomNumber MOD 8]; + SaveNode(i); + END; + END; + Room.Moderator := UserNum; + SaveRoom(RoomNumber); + END + ELSE + Nope(NotModerator); + s := ''; + END; + + 'P' : IF (S[3] <> ' ') OR (Copy(s,4,(Length(s) - 3)) = '') THEN + Nope(NotValid) + ELSE + BEGIN + s := Copy(s,4,(Length(s) - 3)); + i := Name2Number(s,SaveName); + IF (i > 0) AND (i <= MaxNodes) THEN + BEGIN + LoadNode(i); + IF ((ThisNode MOD 8) IN NodeR.Forget[ThisNode DIV 8]) THEN + Print('^9That user has forgotten you.'^M^J) + ELSE IF NOT (NAvail IN NodeR.Status) THEN + Print('^9That user is unavailable.'^M^J) + ELSE IF NOT (NInvisible IN NodeR.Status) THEN + BEGIN + Print('^9Private message sent to ^0'+SaveName); + IF AACS(General.TeleConfMCI) THEN + s := MCI(s); + s := MCI(Liner.TeleConfPrivate) + s; + LowLevelSend(s,i) + END + ELSE + Nope(NotOnline); + END + ELSE + Nope(NotOnline); + s := ''; + END; + + 'Q' : BEGIN + s := Copy(s,4,40); + IF (s <> '') THEN + s := '^0'+Caps(ThisUser.Name)+' '+s; + LoadNode(ThisNode); + SaveNode(ThisNode); + Done := TRUE; + END; + + 'R' : IF (AllCaps(Copy(s,2,8)) = 'REMEMBER') THEN + BEGIN + s := Copy(s,(Pos(' ',s) + 1), 255); + i := Name2Number(s,SaveName); + IF (i > 0) AND (i <= MaxNodes) THEN + BEGIN + LoadNode(ThisNode); + NodeR.Forget[i DIV 8] := NodeR.Forget[i DIV 8] - [i MOD 8]; + SaveNode(ThisNode); + Print('^0'+SaveName+'^9 has been remembered.'); + END + ELSE + Nope(NotOnLine); + END + ELSE + BEGIN + s:= Copy(s,(Pos(' ',s) + 1),255); + i := SearchUser(s,FALSE); + readasw(i,'registry'); + s := ''; + END; + + 'S' : IF (Copy(S,3,(Length(s) - 2)) <> '') THEN + Nope(NotValid) + ELSE + BEGIN + Abort := FALSE; + i := 1; + WHILE (i <= 255) AND (NOT Abort) DO + BEGIN + ShowRoom(i); + Inc(i); + END; + LoadRoom(RoomNumber); + s := ''; + END; + + 'U' : IF (Copy(S,3,(Length(s) - 2)) <> '') THEN + Nope(NotValid) + ELSE + BEGIN + ShowRoom(RoomNumber); + s := ''; + END; + + 'W' : IF (Copy(S,3,(Length(s) - 2)) <> '') THEN + Nope(NotValid) + ELSE + lListNodes; + + '?' : IF (Copy(S,3,(Length(s) - 2)) <> '') THEN + Nope(NotValid) + ELSE + PrintF('TELEHELP'); + END; + IF (s[1] = '/') THEN + s := ''; + END + ELSE + IF (s > #0) THEN + BEGIN + LoadRoom(RoomNumber); + IF (s[1] <> '`') THEN + IF (Room.Anonymous) THEN + s := MCI(Liner.TeleConfAnon) + s + ELSE + s := MCI(Liner.TeleConfNormal) + s + ELSE + BEGIN + s := MCI(Liner.TeleConfGlobal) + Copy(s,2,255); + ChannelOnly := TRUE; + END; + END + ELSE + s := ''; + IF (s <> '') THEN + BEGIN + MultiNodeChat := TRUE; + IF (AACS(General.TeleConfMCI)) THEN + s := MCI(s); + SendMessage(s,ThisUser.TeleConfEcho); + END; + END; + MultiNodeChat := FALSE; + + IF (General.MultiNode) THEN + BEGIN + LoadNode(ThisNode); + NodeR.GroupChat := FALSE; + SaveNode(ThisNode); + END; + + RemoveFromRoom(RoomNumber); + + NodeChatLastRec := 0; + Kill(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP'); + General.TimeOut := SaveTimeOut; + General.TimeOutBell := SaveTimeOutBell; +END; + +PROCEDURE ToggleChatAvailability; +BEGIN + NL; + IF (NOT General.MultiNode) THEN + BEGIN + Print('This BBS is currently not operating in Multi-Node.'); + Exit; + END; + LoadNode(ThisNode); + IF (NAvail IN NodeR.Status) THEN + BEGIN + Exclude(NodeR.Status,NAvail); + Print('You are not available for chat.'); + END + ELSE + BEGIN + Include(NodeR.Status,NAvail); + Print('You are now available for chat.'); + END; + SaveNode(ThisNode); +END; + +PROCEDURE lsend_message(CONST b: ASTR); +VAR + s: STRING; + NodeNum: Byte; + Forced: BOOLEAN; +BEGIN + NL; + IF (NOT General.MultiNode) THEN + BEGIN + Print('This BBS is currently not operating in Multi-Node.'); + Exit; + END; + s := b; + NodeNum := StrToInt(s); + IF (b <> '') AND (IsInvisible) THEN + Exit; + Forced := (s <> ''); + IF (NodeNum = 0) AND (Copy(s,1,1) <> '0') THEN + BEGIN + pick_node(NodeNum,TRUE); + Forced := FALSE; + IF (NodeNum = 0) THEN + Exit; + END; + IF (NodeNum = ThisNode) THEN + Exit; + IF (Forced OR AACS(General.TeleConfMCI)) THEN + s := MCI(s); + IF (NodeNum > 0) THEN + BEGIN + LoadNode(NodeNum); + IF (NodeR.User = 0) THEN + Exit; + END; + IF (s <> '') THEN + s := '^1'+Copy(s,(Pos(';',s) + 1),255) + ELSE + BEGIN + Prt('Message: '); + InputMain(s,(SizeOf(s) - 1),[ColorsAllowed]); + END; + IF (Forced OR AACS(General.TeleConfMCI)) THEN + s := MCI(s); + IF (s <> '') THEN + BEGIN + IF (NOT Forced) THEN + BEGIN + LoadNode(NodeNum); + IF (NOT ((ThisNode MOD 8) IN NodeR.Forget[ThisNode DIV 8])) THEN + LowLevelSend(^M^J'^5Message from '+Caps(ThisUser.Name)+' on node '+IntToStr(ThisNode)+':^1'^M^J,NodeNum) + ELSE + Print(^M^J'That node has forgotten you.'); + END; + IF (NodeNum = 0) THEN + FOR NodeNum := 1 TO MaxNodes DO + IF (NodeNum <> ThisNode) THEN + BEGIN + LoadNode(NodeNum); + IF (NodeR.User > 0) THEN + LowLevelSend(s,NodeNum) + END + ELSE (* Match up ELSE Statements ??? *) + ELSE + LowLevelSend(s,NodeNum); + END; +END; + +FUNCTION NodeListMCI(CONST s: ASTR; Data1,Data2: Pointer): STRING; +VAR + NodeRecPtr: ^NodeRecordType; + NodeNum: ^Byte; +BEGIN + NodeRecPtr := Data1; + NodeNum := Data2; + NodeListMCI := s; + IF (NOT (NActive IN NodeRecPtr^.Status)) OR + (NodeRecPtr^.User > (MaxUsers - 1)) OR + (NodeRecPtr^.User < 1) OR + ((NInvisible IN NodeRecPtr^.Status) AND + (NOT CoSysOp)) THEN + BEGIN + NodeListMCI := '-'; + WITH NodeRecPtr^ DO + CASE s[1] OF + 'N' : IF (s[2] = 'N') THEN + NodeListMCI := IntToStr(NodeNum^); + 'A' : CASE s[2] OF + 'C' : NodelistMCI := RGNoteStr(33,TRUE); + 'V' : NodeListMCI := AOnOff((NAvail IN Status),'Y','N'); + END; + 'U' : IF (s[2] = 'N') THEN + NodeListMCI := RGNoteStr(34,TRUE); + END; + END + ELSE + WITH NodeRecPtr^ DO + CASE s[1] OF + 'A' : CASE s[2] OF + 'C' : NodeListMCI := ActivityDesc; + 'G' : NodeListMCI := IntToStr(Age); + 'T' : NodeListMCI := AOnOff((NActive IN Status),'Y','N'); + 'V' : NodeListMCI := AOnOff((NAvail IN Status),'Y','N'); + END; + 'L' : IF (s[2] = 'C') THEN + NodeListMCI := CityState; + 'N' : IF (s[2] = 'N') THEN + NodeListMCI := IntToStr(NodeNum^); + 'U' : IF (s[2] = 'N') THEN + NodeListMCI := Caps(UserName); + 'R' : IF (s[2] = 'M') THEN + NodeListMCI := IntToStr(Room); + 'S' : IF (s[2] = 'X') THEN + NodeListMCI := Sex; + 'T' : IF (s[2] = 'O') THEN + NodeListMCI := IntToStr((GetPackDateTime - LogonTime) DIV 60); + END; +END; + +PROCEDURE lListNodes; +VAR + NodeNum: Byte; +BEGIN + IF (NOT General.MultiNode) THEN + BEGIN + NL; + Print('This BBS is currently not operating in Multi-Node.'); + Exit; + END; + Abort := FALSE; + Next := FALSE; + AllowContinue := TRUE; + IF (NOT ReadBuffer('NODELM')) THEN + Exit; + PrintF('NODELH'); + NodeNum := 1; + WHILE (NodeNum <= MaxNodes) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadNode(NodeNum); + DisplayBuffer(NodeListMCI,@NodeR,@NodeNum); + Inc(NodeNum); + END; + IF (NOT Abort) THEN + PrintF('NODELT'); + AllowContinue := FALSE; +END; + +END. diff --git a/SOURCE/MYIO.PAS b/SOURCE/MYIO.PAS new file mode 100644 index 0000000..8f1ea0f --- /dev/null +++ b/SOURCE/MYIO.PAS @@ -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. diff --git a/SOURCE/NEWUSERS.PAS b/SOURCE/NEWUSERS.PAS new file mode 100644 index 0000000..76e2936 --- /dev/null +++ b/SOURCE/NEWUSERS.PAS @@ -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. diff --git a/SOURCE/NODELIST.PAS b/SOURCE/NODELIST.PAS new file mode 100644 index 0000000..4cf07e3 --- /dev/null +++ b/SOURCE/NODELIST.PAS @@ -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. diff --git a/SOURCE/OFFLINE.PAS b/SOURCE/OFFLINE.PAS new file mode 100644 index 0000000..7caace4 --- /dev/null +++ b/SOURCE/OFFLINE.PAS @@ -0,0 +1,1225 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} + +UNIT OffLine; + +INTERFACE + +PROCEDURE SetMessageAreaNewScanDate; +PROCEDURE DownloadPacket; +PROCEDURE uploadpacket(Already: Boolean); + +IMPLEMENTATION + +USES + Crt, + Dos, + Common, + Archive1, + ExecBat, + File0, + File1, + File2, + File8, + File11, + Mail0, + Mail1, + Mail2, + Mail4, + NodeList, + TimeFunc; + +TYPE + BSingle = ARRAY [0..3] OF Byte; + + NDXRec = RECORD + Pointer: BSingle; + Conf: Byte; + END; + + QWKHeadeRec = RECORD + Flag: Char; + Num: ARRAY [1..7] OF Char; + MsgDate: ARRAY [1..8] OF Char; + MsgTime: ARRAY [1..5] OF Char; + MsgTo: ARRAY [1..25] OF Char; + MsgFrom: ARRAY [1..25] OF Char; + MsgSubj: ARRAY [1..25] OF Char; + MsgPWord: STRING[11]; + RNum: STRING[7]; + NumBlocks: ARRAY [1..6] OF Char; + Status: Byte; + MBase: SmallWord; + Crap: STRING[3]; + END; + +(* +PROCEDURE SetFileAreaNewScanDate; +VAR + TempDate: Str10; + Key: CHAR; +BEGIN + { + NL; + Prt(FString.FileNewScan); + } + lRGLngStr(54,FALSE); + MPL(10); + Prompt(PD2Date(NewDate)); + Key := Char(GetKey); + IF (Key = #13) THEN + BEGIN + NL; + TempDate := PD2Date(NewDate); + END + ELSE + BEGIN + Buf := Key; + DOBackSpace(1,10); + InputFormatted('',TempDate,'##/##/####',TRUE); + IF (TempDate = '') THEN + TempDate := PD2Date(NewDate); + END; + IF (DayNum(TempDate) = 0) OR (DayNum(TempDate) > DayNum(DateStr)) THEN + BEGIN + NL; + Print('Invalid date entered.'); + END + ELSE + BEGIN + NL; + Print('New file scan date set to: ^5'+TempDate+'^1'); + NewDate := Date2PD(TempDate); + SL1('Reset file new scan date to: ^5'+TempDate+'.'); + END; +END; +*) + +PROCEDURE SetMessageAreaNewScanDate; +VAR + S: AStr; + DT: DateTime; + MArea, + SaveMsgArea: Integer; + l: LongInt; +BEGIN + NL; + Prt('Enter oldest date for new messages (mm/dd/yyyy): '); + + InputFormatted('',S,'##/##/####',TRUE); + IF (DayNum(S) = 0) THEN + BEGIN + NL; + Print('^7Invalid date entered!^1') + END + ELSE IF (S <> '') THEN + BEGIN + NL; + Print('Current newscan date is now: ^5'+S); + SaveMsgArea := MsgArea; + FillChar(DT,SizeOf(DT),0); + WITH DT DO + BEGIN + Month := StrToInt(Copy(S,1,2)); + Day := StrToInt(Copy(S,4,2)); + Year := StrToInt(Copy(S,7,4)); + END; + l := DateToPack(DT); + FOR MArea := 1 TO NumMsgAreas DO + BEGIN + InitMsgArea(MArea); + LastReadRecord.LastRead := L; + SaveLastReadRecord(LastReadRecord); + END; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + SL1('Reset message last read pointers.'); + END; +END; + +PROCEDURE DownloadPacket; +VAR + IndexR: + NDXRec; + NDXFile, + PNDXFile: FILE OF NDXRec; + MsgFile: FILE; + ControlTxt: Text; + MHeader: MHeaderRec; + QWKHeader: QWKHeadeRec; + DT: DateTime; + TransferFlags: TransferFlagSet; + S, + Texts: STRING; + + C: Char; + + FArrayRecNum: Byte; + + MArea, + UseMsgArea, + AvailableMsgAreas, + SaveMsgArea, + SaveFileArea: Integer; + + + TotalNewMsgsInArea, + TotalYourMsgsInArea, + MsgNum, + TempTextSize: Word; + + X, + LastK, + Marker, + TotalMsgsAllAreas, + TotalNewMsgsAllAreas, + TotalYourMsgsAllAreas, + LastUpdate: LongInt; + + SaveConfSystem, + Ok: Boolean; + + PROCEDURE Real_To_Msb(PReal: Real; VAR B: BSingle); + VAR + R: ARRAY [0 .. 5] OF Byte ABSOLUTE PReal; + BEGIN + B[3] := R[0]; + Move(R[3],B[0],3); + END; + + PROCEDURE KillEmail; + VAR + MsgNum1: Word; + BEGIN + InitMsgArea(-1); + Reset(MsgHdrF); + IF (IOResult = 0) THEN + BEGIN + FOR MsgNum1 := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum1 - 1)); + Read(MsgHdrF,MHeader); + IF ToYou(MHeader) THEN + BEGIN + Include(MHeader.Status,MDeleted); + Seek(MsgHdrF,(MsgNum1 - 1)); + Write(MsgHdrF,MHeader); + END + END; + Close(MsgHdrF); + END; + ThisUser.Waiting := 0; + END; + + PROCEDURE Upload_Display; + BEGIN + LastUpdate := Timer; + IF (NOT Abort) THEN + Prompt(' �'+PadRightInt(TotalNewMsgsInArea,7)+ + '�'+PadRightInt(TotalYourMsgsInArea,6)+ + '�'+PadRightStr(IntToStr((FileSize(MsgFile) - LastK) DIV 1024)+'k',8)); + END; + + PROCEDURE UpdatePointers; + VAR + MArea1: Integer; + MsgNum1: Word; + BEGIN + TotalNewMsgsAllAreas := 0; + FOR MArea1 := 1 TO NumMsgAreas DO + IF (CompMsgArea(MArea1,0) <> 0) THEN + BEGIN + InitMsgArea(MArea1); + IF AACS(MemMsgArea.ACS) AND ((LastReadRecord.NewScan) OR (MAForceRead IN MemMsgArea.MAFlags)) THEN + BEGIN + LastError := IOResult; + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + MsgNum1 := FirstNew; + IF (MsgNum1 > 0) THEN + TotalNewMsgsInArea := FileSize(MsgHdrF) - MsgNum1 + 1 + ELSE + TotalNewMsgsInArea := 0; + MsgNum1 := FileSize(MsgHdrF); + IF (TotalNewMsgsAllAreas + TotalNewMsgsInArea > General.MaxQWKTotal) THEN + MsgNum1 := (FileSize(MsgHdrF) - TotalNewMsgsInArea) + (General.MaxQWKtotal - TotalNewMsgsAllAreas); + IF (TotalNewMsgsInArea > general.maxqwkbase) AND + (((FileSize(MsgHdrF) - TotalNewMsgsInArea) + General.MaxQWKBase) < MsgNum1) THEN + MsgNum1 := (FileSize(MsgHdrF) - TotalNewMsgsInArea) + General.MaxQWKBase; + Seek(MsgHdrF,MsgNum1- 1); + Read(MsgHdrF,MHeader); + LoadLastReadRecord(LastReadRecord); + LastReadRecord.LastRead := MHeader.Date; + SaveLastReadRecord(LastReadRecord); + Inc(TotalNewMsgsAllAreas, MsgNum1 - (FileSize(MsgHdrF) - TotalNewMsgsInArea)); + Close(MsgHdrF); + END; + END; + END; + +BEGIN + NL; + IF (ThisUser.DefArcType < 1) OR (ThisUser.DefArcType > MaxArcs) OR + (NOT General.FileArcInfo[ThisUser.DefArcType].Active) THEN + BEGIN + Print('Please select an archive type first.'); + Exit; + END; + + IF (MakeQWKFor > 0) OR (Exist(TempDir+'QWK\'+General.PacketName+'QWK') AND + PYNQ('Create a new QWK packet for download? ',0,FALSE)) THEN + PurgeDir(TempDir+'QWK\',FALSE) + ELSE + PurgeDir(TempDir+'QWK\',FALSE); + + SaveMsgArea := MsgArea; + + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + + OffLineMail := TRUE; + + IF (NOT Exist(TempDir+'QWK\'+General.PacketName+'QWK')) THEN + BEGIN + Assign(ControlTxt,TempDir+'QWK\CONTROL.DAT'); + ReWrite(ControlTxt); + WriteLn(ControlTxt,StripColor(General.BBSName)); + WriteLn(ControlTxt); + WriteLn(ControlTxt,General.BBSPhone); + WriteLn(ControlTxt,General.SysOpName,', Sysop'); + WriteLn(ControlTxt,'0,'+General.PacketName); + WriteLn(ControlTxt,Copy(DateStr,1,2)+'-'+Copy(DateStr,4,2)+'-'+Copy(DateStr,7,4)+','+TimeStr); + WriteLn(ControlTxt,ThisUser.Name); + WriteLn(ControlTxt); + WriteLn(ControlTxt,'0'); + WriteLn(ControlTxt,'0'); + + AvailableMsgAreas := 1; + + FOR MArea := 1 TO NumMsgAreas DO + IF MsgAreaAC(MArea) THEN + Inc(AvailableMsgAreas); + + WriteLn(ControlTxt,(AvailableMsgAreas - 1)); + + FOR MArea := -1 TO NumMsgAreas DO + IF (MArea > 0) AND MsgAreaAC(MArea) THEN + BEGIN + WriteLn(ControlTxt,MemMsgArea.QWKIndex); + WriteLn(ControlTxt,Caps(StripColor(MemMsgArea.FileName))); + END + ELSE IF (MArea = -1) THEN + BEGIN + WriteLn(ControlTxt,0); + WriteLn(ControlTxt,'Private Mail'); + END; + + WriteLn(ControlTxt,'WELCOME'); + WriteLn(ControlTxt,'NEWS'); + WriteLn(ControlTxt,'GOODBYE'); + Close(ControlTxt); + + IF (ThisUser.ScanFilesQWK) THEN + BEGIN + Assign(NewFilesF,TempDir+'QWK\NEWFILES.DAT'); + ReWrite(NewFilesF); + InitFArray(FArray); + FArrayRecNum := 0; + GlobalNewFileScan(FArrayRecNum); + Close(NewFilesF); + LastError := IOResult; + END; + + IF (General.QWKWelcome <> '') THEN + BEGIN + S := General.QWKWelcome; + IF (OkANSI) AND Exist(S+'.ANS') THEN + S := S +'.ANS' + ELSE + S := S +'.ASC'; + CopyMoveFile(TRUE,'',S,TempDir+'QWK\WELCOME',FALSE); + END; + + IF (General.QWKNews <> '') THEN + BEGIN + S := General.QWKNews; + IF (OkANSI) AND Exist(S+'.ANS') THEN + S := S +'.ANS' + ELSE + S := S +'.ASC'; + CopyMoveFile(TRUE,'',S,TempDir+'QWK\NEWS',FALSE); + END; + + IF (General.QWKGoodBye <> '') THEN + BEGIN + S := General.QWKGoodBye; + IF (OkANSI) AND Exist(S+'.ANS') THEN + S := S +'.ANS' + ELSE + S := S +'.ASC'; + CopyMoveFile(TRUE,'',S,TempDir+'QWK\GOODBYE',FALSE); + END; + + Assign(MsgFile,TempDir+'QWK\MESSAGES.DAT'); + + S := 'The Renegade Developement Team, Copyright (c) 1992-2009 (All rights reserved)'; + WHILE (Length(S) < 128) DO + S := S + ' '; + ReWrite(MsgFile,1); + BlockWrite(MsgFile,S[1],128); + + FillChar(QWKHeader.Crap,SizeOf(QWKHeader.Crap),0); + + Assign(PNDXFile,TempDir+'QWK\PERSONAL.NDX'); + ReWrite(PNDXFile); + + LastK := 0; + (* + TotalNewMsgsInArea := 0; + *) + TotalMsgsAllAreas := 0; + TotalNewMsgsAllAreas := 0; + TotalYourMsgsAllAreas := 0; + + TempPause := FALSE; + Abort := FALSE; + Next := FALSE; + + CLS; + Print(Centre('|The QWK�System is now gathering mail.')); + NL; + PrintACR('s旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴쩡컴컴컫컴컴컴컴컫컴컴컫컴컴컴쩡컴컴커'); + PrintACR('s�t Num s�u Message area name s�v Short s�w Echo s�x Total '+ + 's�y New s�z Your s�{ Size s�'); + PrintACR('s읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴좔컴컴컨컴컴컴컴컨컴컴컨컴컴컴좔컴컴켸'); + + FillChar(QWKHeader.MsgPWord,SizeOf(QWKHeader.MsgPWord),' '); + + FillChar(QWKHeader.RNum,SizeOf(QWKHeader.RNum),' '); + + QWKHeader.Status := 225; + + FOR MArea := -1 TO NumMsgAreas DO + BEGIN + IF (IOResult <> 0) THEN + BEGIN + WriteLn('error processing QWK packet.'); + Exit; + END; + + IF (MArea = 0) OR ((MArea = -1) AND (NOT ThisUser.PrivateQWK)) OR + ((CompMsgArea(MArea,0) = 0) AND (MArea >= 0)) THEN + Continue; + + InitMsgArea(MArea); + + IF (MArea > 0) THEN + UseMsgArea := MemMsgArea.QWKIndex + ELSE + UseMsgArea := 0; + + IF AACS(MemMsgArea.ACS) AND ((LastReadRecord.NewScan) OR + (MAForceRead IN MemMsgArea.MAFlags)) AND (NOT Abort) AND (NOT HangUp) THEN + BEGIN + LastError := IOResult; + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + + QWKHeader.MBase := UseMsgArea; + + IndexR.Conf := UseMsgArea; + + TotalNewMsgsInArea := 0; + + TotalYourMsgsInArea := 0; + + PrintMain('}'+PadRightInt(MArea,4)+ + ' ~'+PadLeftStr(MemMsgArea.Name,22)+ + ' '+PadLeftStr(MemMsgArea.FileName,11)+ + '�'+PadLeftStr(ShowYesNo(MemMsgArea.MAType <> 0),3)+ + '�'+PadRightInt(FileSize(MsgHdrF),8)); + + Upload_Display; + + IF (UseMsgArea > 0) THEN + MsgNum := FirstNew + ELSE + MsgNum := 1; + + IF (MsgNum > 0) THEN + BEGIN + + S := IntToStr(UseMsgArea); + + WHILE (Length(S) < 3) DO + S := '0' + S; + + Assign(NDXFile,TempDir+'QWK\'+S+'.NDX'); + ReWrite(NDXFile); + + WKey; + + WHILE (MsgNum <= FileSize(MsgHdrF)) AND + (TotalNewMsgsInArea < General.MaxQWKBase) AND + ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) < General.MaxQWKTotal) AND + (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (MArea >= 0) THEN + Inc(TotalNewMsgsInArea); + WKey; + IF ((Timer - LastUpdate) > 3) OR ((Timer - LastUpdate) < 0) THEN + BEGIN + BackErase(22); + Upload_Display; + END; + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (NOT (MDeleted IN MHeader.Status)) AND + NOT (Unvalidated IN MHeader.Status) AND + NOT (FromYou(MHeader) AND NOT ThisUser.GetOwnQWK) AND + NOT ((Prvt IN MHeader.Status) AND NOT (FromYou(MHeader) OR ToYou(MHeader))) AND + NOT ((MArea = -1) AND NOT (ToYou(MHeader))) THEN + BEGIN + + IF (MArea = -1) THEN + Inc(TotalNewMsgsInArea); + + IF (Prvt IN MHeader.Status) THEN + QWKHeader.Flag := '*' + ELSE + QWKHeader.Flag := ' '; + + S := IntToStr(MsgNum); + FillChar(QWKHeader.Num[1],SizeOf(QWKHeader.Num),' '); + Move(S[1],QWKHeader.Num[1],Length(S)); + + PackToDate(DT,MHeader.Date); + + IF (MHeader.From.Anon = 0) THEN + S := ZeroPad(IntToStr(DT.Month))+ + '-'+ZeroPad(IntToStr(DT.Day))+ + '-'+Copy(IntToStr(DT.Year),3,2) + ELSE + S := ''; + + FillChar(QWKHeader.MsgDate[1],SizeOf(QWKHeader.MsgDate),' '); + Move(S[1],QWKHeader.MsgDate[1],Length(S)); + + IF (MHeader.From.Anon = 0) THEN + S := ZeroPad(IntToStr(DT.Hour))+ + ':'+ZeroPad(IntToStr(DT.Min)) + ELSE + S := ''; + + FillChar(QWKHeader.MsgTime,SizeOf(QWKHeader.MsgTime),' '); + Move(S[1],QWKHeader.MsgTime[1],Length(S)); + + S := MHeader.MTo.A1S; + IF (MARealName IN MemMsgArea.MAFlags) THEN + S := AllCaps(MHeader.MTo.Real); + S := Caps(Usename(MHeader.MTo.Anon,S)); + + FillChar(QWKHeader.MsgTo,SizeOf(QWKHeader.MsgTo),' '); + Move(S[1],QWKHeader.MsgTo[1],Length(S)); + + S := MHeader.From.A1S; + IF (MARealName IN MemMsgArea.MAFlags) THEN + S := AllCaps(MHeader.From.Real); + S := Caps(Usename(MHeader.From.Anon,S)); + + FillChar(QWKHeader.MsgFrom[1],SizeOf(QWKHeader.MsgFrom),' '); + Move(S[1],QWKHeader.MsgFrom[1],Length(S)); + + FillChar(QWKHeader.MsgSubj[1],SizeOf(QWKHeader.MsgSubj),' '); + + IF (MHeader.FileAttached > 0) THEN + MHeader.Subject := StripName(MHeader.Subject); + + Move(MHeader.Subject[1],QWKHeader.MsgSubj[1],Length(MHeader.Subject)); + + Marker := FilePos(MsgFile); + + BlockWrite(MsgFile,QWKHeader,128); + + Real_To_Msb(FileSize(MsgFile) DIV 128,IndexR.Pointer); + Write(NDXFile,IndexR); + + IF ToYou(MHeader) THEN + BEGIN + Write(PNDXFile,IndexR); + Inc(TotalYourMsgsInArea); + END; + + X := 1; + TempTextSize := 0; + Texts := ''; + + IF ((MHeader.Pointer - 1) < FileSize(MsgTxtF)) AND + (((MHeader.Pointer - 1) + MHeader.TextSize) <= FileSize(MsgTxtF)) THEN + BEGIN + Seek(MsgTxtF,(MHeader.Pointer - 1)); + REPEAT + BlockRead(MsgTxtF,S[0],1); + BlockRead(MsgTxtF,S[1],Byte(S[0])); + Inc(TempTextSize,(Length(S) + 1)); + S := S + '�'; + Texts := Texts + S; + IF (Length(Texts) > 128) THEN + BEGIN + BlockWrite(MsgFile,Texts[1],128); + Inc(X); + Move(Texts[129],Texts[1],(Length(Texts) - 128)); + Dec(Texts[0],128); + END; + UNTIL (TempTextSize >= MHeader.TextSize); + IF (Texts <> '') THEN + BEGIN + IF (Length(Texts) < 128) THEN + BEGIN + FillChar(Texts[Length(Texts) + 1],(128 - Length(Texts)),32); + Texts[0] := #128; + END; + BlockWrite(MsgFile,Texts[1],128); + Inc(X); + END; + END + ELSE + BEGIN + Include(MHeader.Status,MDeleted); + MHeader.TextSize := 0; + MHeader.Pointer := -1; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + + S := IntToStr(X); + + FillChar(QWKHeader.NumBlocks[1],SizeOf(QWKHeader.NumBlocks),' '); + Move(S[1],QWKHeader.NumBlocks[1],Length(S)); + + Seek(MsgFile,Marker); + BlockWrite(MsgFile,QWKHeader,128); + Seek(MsgFile,FileSize(MsgFile)); + END; + Inc(MsgNum); + END; + Close(NDXFile); + END; + BackErase(22); + Upload_Display; + NL; + IF (TotalNewMsgsInArea >= General.MaxQWKBase) THEN + Print('Maximum number of messages per area reached.'); + IF ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) >= General.MaxQWKTotal) THEN + Print('Maximum number of messages per QWK packet reached.'); + LastK := FileSize(MsgFile); + Inc(TotalNewMsgsAllAreas,TotalNewMsgsInArea); + Inc(TotalYourMsgsAllAreas,TotalYourMsgsInArea); + Inc(TotalMsgsAllAreas,FileSize(MsgHdrF)); + Close(MsgHdrF); + Close(MsgTxtF); + END; + IF ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) >= General.MaxQWKTotal) OR Abort THEN + Break; + END; + + IF (FileSize(PNDXFile) = 0) THEN + BEGIN + Close(PNDXFile); + Erase(PNDXFile); + END + ELSE + Close(PNDXFile); + NL; + + IF (NOT Abort) THEN + Print('^0 Totals:'+PadRightInt(TotalMsgsAllAreas,43)+PadRightInt(TotalNewMsgsAllAreas,7)+ + PadRightInt(TotalYourMsgsAllAreas,6)+ + PadRightStr(IntToStr(FileSize(MsgFile) DIV 1024)+'k',8)); + + Close(MsgFile); + NL; + + lil := 0; + IF (TotalNewMsgsAllAreas < 1) OR (Abort) THEN + BEGIN + IF (TotalNewMsgsAllAreas < 1) THEN + Print('No new messages!'); + OffLineMail := FALSE; + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + Exit; + END; + + IF (MakeQWKFor = 0) THEN + BEGIN + NL; + IF NOT PYNQ('Proceed to packet compression: ',0,TRUE) THEN + BEGIN + OffLineMail := FALSE; + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + Exit; + END; + END; + + NL; + Star('Compressing '+General.PacketName+'.QWK'); + + ArcComp(Ok,ThisUser.DefArcType,TempDir+'QWK\'+General.PacketName+'.QWK',TempDir+'QWK\*.*'); + IF (NOT Ok) OR (NOT Exist(TempDir+'QWK\'+General.PacketName+'.QWK')) THEN + BEGIN + NL; + Print('Error archiving QWK packet!'); + OffLineMail := FALSE; + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + Exit; + END; + + SysOpLog('QWK packet created.'); + END; + + FindFirst(TempDir+'QWK\'+General.PacketName+'.QWK',AnyFile,DirInfo); + IF (InCom) AND (NSL < (DirInfo.Size DIV Rate)) AND (NOT General.qwktimeignore) THEN + BEGIN + NL; + Print('Sorry, not enough time left online to transfer.'); + OffLineMail := FALSE; + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + Exit; + END; + + Star('Compressed packet size is '+ConvertBytes(DirInfo.Size,FALSE)+'.'); + + IF (InCom) AND (NOT HangUp) THEN + BEGIN + SaveFileArea := FileArea; + FileArea := -1; + WITH MemFileArea DO + BEGIN + AreaName := 'Offline Mail'; + DLPath := TempDir+'QWK\'; + ULPath := TempDir+'QWK\'; + FAFlags := [FANoRatio]; + END; + WITH FileInfo DO + BEGIN + FileName := Align(General.PacketName+'.QWK'); + Description := 'QWK Download'; + FilePoints := 0; + Downloaded := 0; + FileSize := GetFileSize(TempDir+'QWK\'+General.PacketName+'.QWK'); + OwnerNum := UserNum; + OwnerName := Caps(ThisUser.Name); + FileDate := Date2PD(DateStr); + VPointer := -1; + VTextSize := 0; + FIFlags := []; + END; + TransferFlags := [IsQWK]; + DLX(FileInfo,-1,TransferFlags); + FileArea := SaveFileArea; + LoadFileArea(FileArea); + IF (IsTransferOk IN TransferFlags) AND (NOT (IsKeyboardAbort IN TransferFlags)) THEN + BEGIN + + Star('Updating message pointers'); + + Inc(PublicReadThisCall,TotalNewMsgsAllAreas); + + UpdatePointers; + + Star('Message pointers updated'); + + IF (ThisUser.PrivateQWK) THEN + BEGIN + KillEmail; + Star('Private messages killed.'); + END; + + END; + END + ELSE + BEGIN + S := General.QWKLocalPath+General.PacketName; + IF Exist(S+'.QWK') AND ((MakeQWKFor > 0) OR NOT (PYNQ(^M^J'Replace existing .QWK? ',0,FALSE))) THEN + FOR C := 'A' TO 'Z' DO + IF NOT (Exist(S+'.QW'+C)) THEN + BEGIN + S := S + '.QW' + C; + Break; + END; + IF (Pos('.', S) = 0) THEN + S := S + '.QWK'; + + CopyMoveFile(TRUE,'',TempDir+'QWK\'+General.PacketName+'.QWK',S,FALSE); + + NL; + UpdatePointers; + IF (ThisUser.PrivateQWK) THEN + KillEmail; + END; + IF Exist(TempDir+'QWK\'+General.PacketName+'.REP') THEN + BEGIN + NL; + Star('Bidirectional upload of '+General.PacketName+'.REP detected'); + UploadPacket(TRUE); + END; + OffLineMail := FALSE; + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + LastError := IOResult; +END; + + +PROCEDURE uploadpacket(Already:Boolean); +VAR + F: FILE; + User: UserRecordType; + MHeader: MHeaderRec; + QWKHeader: QWKHeadeRec; + + S, + Os: STRING; + + Counter, + Counter1: Byte; + + RCode, + MArea, + SaveMsgArea: Integer; + + X, + Blocks: Word; + + TransferTime, + TempDate: LongInt; + + Ok, + UploadOk, + KeyboardAbort, + AddBatch, + SaveConfSystem: Boolean; + + FUNCTION FindBase(IndexNumber: Word): Word; + VAR + j, + k: Integer; + BEGIN + Reset(MsgAreaFile); + j := 0; + k := 0; + WHILE (j = 0) AND NOT (EOF(MsgAreaFile)) DO + BEGIN + Inc(k); + Read(MsgAreaFile,MemMsgArea); + IF (MemMsgArea.QWKIndex = IndexNumber) THEN + j := k; + END; + Close(MsgAreaFile); + FindBase := k; + END; + +BEGIN + IF (RPost IN ThisUser.Flags) THEN + BEGIN + NL; + Print('You are restricted from posting messages.'); + Exit; + END; + + SaveMsgArea := MsgArea; (* Was ReadMsgArea *) + + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + + PurgeDir(TempDir+'UP\',FALSE); + + TimeLock := TRUE; + + UploadOk := TRUE; + KeyboardAbort := FALSE; + + IF (ComPortSpeed = 0) OR (UpQWKFor > 0) THEN + CopyMoveFile(TRUE,'',General.QWKLocalPath+General.PacketName+'.REP',TempDir + 'QWK\' + General.PacketName+'.REP',FALSE) + ELSE + BEGIN + IF (NOT Already) THEN + Receive(General.PacketName+'.REP',TempDir+'\QWK',FALSE,UploadOk,KeyboardAbort,AddBatch,TransferTime) + ELSE + CopyMoveFile(FALSE,'',TempDir+'UP\'+General.PacketName+'.REP', + TempDir+'QWK\'+General.PacketName+'.REP',FALSE); + END; + + TimeLock := FALSE; + + IF (UploadOk) AND (NOT KeyboardAbort) THEN + BEGIN + + SysOpLog('Uploaded REP packet'); + + IF (NOT Already) THEN + Print('Transfer successful'); + + ExecBatch(Ok,TempDir+'QWK\',General.ArcsPath+ + FunctionalMCI(General.FileArcInfo[ThisUser.DefArcType].UnArcLine, + TempDir+'QWK\'+General.PacketName+'.REP', + General.PacketName+'.MSG'), + General.FileArcInfo[ThisUser.DefArcType].SuccLevel,RCode,FALSE); + + IF (Ok) AND Exist(TempDir+'QWK\'+General.PacketName+'.MSG') THEN + BEGIN + Assign(F,TempDir+'QWK\'+General.PacketName+'.MSG'); + Reset(F,1); + + GetFTime(F,TempDate); + + IF (TempDate = ThisUser.LastQWK) THEN + BEGIN + NL; + Print('This packet has already been uploaded here.'); + Close(F); + Exit; + END; + + ThisUser.LastQWK := TempDate; + + MHeader.FileAttached := 0; + MHeader.MTo.UserNum := 0; + MHeader.MTo.Anon := 0; + MHeader.ReplyTo := 0; + MHeader.Replies := 0; + + TempDate := GetPackDateTime; + + BlockRead(F,S,128); + WHILE NOT EOF(F) DO + BEGIN + IF (IOResult <> 0) THEN + BEGIN + WriteLn('error processing REP packet.'); + Break; + END; + + BlockRead(F,QWKHeader,128); + + S[0] := #6; + Move(QWKHeader.NumBlocks[1],S[1],6); + + Blocks := (StrToInt(S) - 1); + + IF (QWKHeader.MBase = 0) THEN + MArea := -1 + ELSE + MArea := FindBase(QWKHeader.MBase); + + InitMsgArea(MArea); + + IF AACS(MemMsgArea.ACS) AND AACS(MemMsgArea.PostACS) AND NOT + ((PublicPostsToday >= General.MaxPubPost) AND (NOT MsgSysOp)) THEN + BEGIN + LastError := IOResult; + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + + IF AACS(General.QWKNetworkACS) THEN + BEGIN + S[0] := #25; + Move(QWKHeader.MsgFrom[1],S[1],SizeOf(QWKHeader.MsgFrom)); + WHILE (S[Length(S)] = ' ') DO + Dec(S[0]); + MHeader.From.UserNum := 0; + END + ELSE + BEGIN + IF (MARealName IN MemMsgArea.MAFlags) THEN + S := ThisUser.RealName + ELSE + S := ThisUser.Name; + MHeader.From.UserNum := UserNum; + END; + + MHeader.From.A1S := S; + MHeader.From.Real := S; + MHeader.From.Name := S; + MHeader.From.Anon := 0; + + S[0] := #25; + Move(QWKHeader.MsgTo[1],S[1],SizeOf(QWKHeader.MsgTo)); + + WHILE (S[Length(S)] = ' ') DO + Dec(S[0]); + + MHeader.MTo.A1S := S; + MHeader.MTo.Real := S; + MHeader.MTo.Name := S; + MHeader.MTo.UserNum := SearchUser(MHeader.MTo.Name,FALSE); + + MHeader.Pointer := (FileSize(MsgTxtF) + 1); + MHeader.Date := TempDate; + Inc(TempDate); + GetDayOfWeek(MHeader.DayOfWeek); + + MHeader.Status := []; + + IF (QWKHeader.Flag IN ['*','+']) AND (MAPrivate IN MemMsgArea.MAFlags) THEN + Include(MHeader.Status,Prvt); + + IF (RValidate IN ThisUser.Flags) THEN + Include(MHeader.Status,Unvalidated); + + IF (AACS(MemMsgArea.MCIACS)) THEN + Include(MHeader.Status,AllowMCI); + + Move(QWKHeader.MsgSubj[1],S[1],SizeOf(QWKHeader.MsgSubj)); + S[0] := Chr(SizeOf(QWKHeader.MsgSubj)); + + WHILE (S[Length(S)] = ' ') DO + Dec(S[0]); + + MHeader.Subject := S; + + SysOpLog(MHeader.From.Name+' posted on '+MemMsgArea.Name); + SysOpLog('To: '+MHeader.MTo.Name); + + MHeader.OriginDate[0] := #14; + Move(QWKHeader.MsgDate[1],MHeader.OriginDate[1],8); + MHeader.OriginDate[9] := #32; + Move(QWKHeader.MsgTime[1],MHeader.OriginDate[10],5); + + MHeader.TextSize := 0; + + IF (AllCaps(MHeader.MTo.A1S) <> 'QMAIL') THEN + BEGIN + Seek(MsgTxtF,FileSize(MsgTxtF)); + Os := ''; + X := 1; + WHILE (X <= Blocks) AND (IOResult = 0) DO + BEGIN + BlockRead(F,S[1],128); + S[0] := #128; + S := Os + S; + WHILE (Pos('�',S) > 0) DO + BEGIN + Os := Copy(S,1,Pos('�',S)-1); + S := Copy(S,Pos('�',S)+1,Length(S)); + IF (MemMsgArea.MAType <> 0) AND (Copy(Os,1,4) = '--- ') THEN + Os := '' + ELSE + BEGIN + IF (LennMCI(Os) > 78) THEN + Os := Copy(Os,1,78 + Length(Os) - LennMCI(Os)); + Inc(MHeader.TextSize,Length(Os)+1); + BlockWrite(MsgTxtF,Os,Length(Os)+1); + END; + END; + Os := S; + Inc(X); + END; + + WHILE (S[Length(S)] = ' ') DO + Dec(S[0]); + + IF (Length(S) > 0) THEN + BEGIN + Inc(MHeader.TextSize,(Length(S) + 1)); + BlockWrite(MsgTxtF,S,(Length(S) + 1)); + END; + + IF (MemMsgArea.MAType <> 0) THEN + BEGIN + NewEchoMail := TRUE; + IF NOT (MAScanOut IN MemMsgArea.MAFlags) THEN + UpdateBoard; + END; + + IF (MemMsgArea.MAType <> 0) AND (MAAddTear IN MemMsgArea.MAFlags) THEN + WITH MemMsgArea DO + BEGIN + S := '--- Renegade v'+General.Version; + Inc(MHeader.TextSize,(Length(S) + 1)); + BlockWrite(MsgTxtF,S,(Length(S) + 1)); + IF (MemMsgArea.Origin <> '') THEN + S := MemMsgArea.Origin + ELSE + S := General.Origin; + S := ' * Origin: '+S+' ('; + IF (AKA > 19) THEN + AKA := 0; + S := S + IntToStr(General.AKA[AKA].Zone)+':'+ + IntToStr(General.AKA[AKA].Net)+'/'+ + IntToStr(General.AKA[AKA].Node); + IF (General.AKA[AKA].Point > 0) THEN + S := S +'.'+IntToStr(General.AKA[AKA].Point); + S := S + ')'; + Inc(MHeader.TextSize,(Length(S) + 1)); + BlockWrite(MsgTxtF,S,(Length(S) + 1)); + END; + + CLS; + Ok := FALSE; + UploadOk := FALSE; + Seek(MsgHdrF,FileSize(MsgHdrF)); + Write(MsgHdrF,MHeader); + + IF (UpQWKFor <= 0) THEN + Anonymous(TRUE,MHeader); + + IF (MArea = -1) THEN + BEGIN + IF (MHeader.MTo.UserNum = 0) THEN + BEGIN + IF (AACS(General.NetMailACS)) AND + (PYNQ(^M^J'Is this to be a netmail message? ',0,FALSE)) THEN + BEGIN + IF (General.AllowAlias) AND PYNQ('Send this with your real name? ',0,FALSE) THEN + MHeader.From.A1S := ThisUser.RealName; + WITH MHeader.MTo DO + GetNetAddress(Name,Zone,Net,Node,Point,X,FALSE); + IF (MHeader.MTo.Name = '') THEN + Include(MHeader.Status,MDeleted) + ELSE + BEGIN + Inc(ThisUser.Debit,X); + Include(MHeader.Status,NetMail); + MHeader.NetAttribute := General.NetAttribute * + [Intransit,Private,Crash,KillSent,Hold,Local]; + ChangeFlags(MHeader); + Counter1 := 0; + Counter := 0; + WHILE (Counter <= 19) AND (Counter1 = 0) DO + BEGIN + IF (General.AKA[Counter].Zone = MHeader.MTo.Zone) AND + (General.AKA[Counter].Zone <> 0) THEN + Counter1 := Counter; + Inc(Counter); + END; + MHeader.From.Zone := General.AKA[Counter1].Zone; + MHeader.From.Net := General.AKA[Counter1].Net; + MHeader.From.Node := General.AKA[Counter1].Node; + MHeader.From.Point := General.AKA[Counter1].Point; + END; + END + ELSE + Include(MHeader.Status,MDeleted); + END + ELSE + BEGIN + IF (MHeader.MTo.UserNum > 1) THEN + BEGIN + Inc(ThisUser.EmailSent); + + IF (PrivatePostsToday < 255) THEN + Inc(PrivatePostsToday); + + END + ELSE + BEGIN + Inc(ThisUser.Feedback); + + IF (FeedbackPostsToday < 255) THEN + Inc(FeedbackPostsToday); + + END; + LoadURec(User,MHeader.MTo.UserNum); + Inc(User.Waiting); + SaveURec(User,MHeader.MTo.UserNum); + END; + END + ELSE + BEGIN + Inc(ThisUser.MsgPost); + + IF (PublicPostsToday < 255) THEN + Inc(PublicPostsToday); + + AdjustBalance(General.CreditPost); + END; + Seek(MsgHdrF,(FileSize(MsgHdrF) - 1)); + Write(MsgHdrF,MHeader); + + END + ELSE + BEGIN + IF (MHeader.Subject = 'DROP') THEN + BEGIN + LoadLastReadRecord(LastReadRecord); + LastReadRecord.NewScan := FALSE; + SaveLastReadRecord(LastReadRecord) + END + ELSE IF (MHeader.Subject = 'ADD') THEN + BEGIN + LoadLastReadRecord(LastReadRecord); + LastReadRecord.NewScan := TRUE; + SaveLastReadRecord(LastReadRecord); + END; + Seek(F,FilePos(F) + (Blocks * 128)); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END + ELSE + Seek(F,FilePos(F) + (Blocks * 128)); + END; + Close(F); + END + ELSE + Print('Unable to decompress REP packet.'); + END + ELSE + Print('Transfer unsuccessful'); + + IF Exist(General.QWKLocalPath+General.PacketName+'.REP') AND (ComPortSpeed = 0) + AND (UpQWKFor = 0) AND PYNQ(^M^J'Delete REP packet? ',0,FALSE) THEN + Kill(General.QWKLocalPath+General.PacketName+'.REP'); + + PurgeDir(TempDir+'QWK\',FALSE); + + Update_Screen; + + IF (SaveConfSystem) THEN + BEGIN + ConfSystem := SaveConfSystem; + NewCompTables; + END; + + MsgArea := SaveMsgArea; + InitMsgArea(MsgArea); + + LastError := IOResult; +END; + +END. diff --git a/SOURCE/ONELINER.PAS b/SOURCE/ONELINER.PAS new file mode 100644 index 0000000..a14ed93 --- /dev/null +++ b/SOURCE/ONELINER.PAS @@ -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. diff --git a/SOURCE/RECORDS.PAS b/SOURCE/RECORDS.PAS new file mode 100644 index 0000000..c731514 --- /dev/null +++ b/SOURCE/RECORDS.PAS @@ -0,0 +1,1019 @@ +CONST + Build = '1.20.1'; + +{$IFDEF MSDOS} + OS = '/DOS'; +{$ENDIF} + +{$IFDEF WIN32} + OS = '/Win32'; +{$ENDIF} + +{$IFDEF OS/2} + OS = '/2'; +{$ENDIF} + +{$IFDEF LINUX} + OS = 'Linux'; +{$ENDIF} + + Ver = Build + OS; + MaxProtocols = 120; + MaxEvents = 10; + MaxArcs = 8; + MaxCmds = 200; + MaxMenus = 100; + MaxResultCodes = 20; + MaxExtDesc = 99; + MaxFileAreas = 32767; + MaxMsgAreas = 32767; + MaxConfigurable = 1024; + MaxVotes = 25; + MaxChoices = 25; + MaxSchemes = 255; + MaxValKeys = 92; + MaxConfKeys = 27; + + User_String_Ask = ' '; {Ask for user string fields} + User_String_None = ''; {None for user string fields} + + User_Date_Ask = -2145916799; {Ask for user date fields - 01/01/1902} + User_Date_None = -2146003199; {None for user date fields - 12/31/1901} + + User_Word_Ask = 65535; {Ask for user word fields} + User_Word_None = 65534; {None for user word fields} + + User_Char_Ask = '~'; {Ask for user character fields} + User_Char_None = ' '; {None for user character fields} + + User_Phone_Ask = ' '; {Ask for user phone fields} + User_Phone_None = ''; {None for user phone fields} + +TYPE +{$IFDEF MSDOS} + SmallInt = Integer; + SmallWord = Word; +{$ENDIF} +{$IFDEF FPC} + SmallWord = Word; +{$ENDIF} + AStr = STRING[160]; + Str1 = STRING[1]; + Str2 = STRING[2]; + Str3 = STRING[3]; + Str4 = STRING[4]; + Str5 = STRING[5]; + Str7 = STRING[7]; + Str8 = STRING[8]; + Str9 = STRING[9]; + Str11 = STRING[11]; + Str10 = STRING[10]; + Str12 = STRING[12]; + Str15 = STRING[15]; + Str20 = STRING[20]; + Str26 = STRING[26]; + Str30 = STRING[30]; + Str35 = STRING[35]; + Str36 = STRING[36]; + Str40 = STRING[40]; + Str50 = STRING[50]; + Str52 = STRING[52]; + Str65 = STRING[65]; + Str74 = STRING[74]; + Str78 = STRING[78]; + Str160 = STRING[160]; + + UnixTime = LongInt; { Seconds since 1-1-70 } + + ACString = STRING[20]; { Access Condition STRING } + + ARFlagType = '@'..'Z'; {AR flags} + + ARFlagSet = SET OF ARFlagType; {SET OF AR flags} + + FlagType = + (RLogon, { L - Limited to one call a day } + RChat, { C - No SysOp paging } + RValidate, { V - Posts are unvalidated } + RUserList, { U - Can't list users } + RAMsg, { A - Can't leave automsg } + RPostAn, { * - Can't post anonymously } + RPost, { P - Can't post } + REmail, { E - Can't send email } + RVoting, { K - Can't use voting booth } + RMsg, { M - Force email deletion } + + VT100, { Supports VT00 } + HotKey, { hotkey input mode } + Avatar, { Supports Avatar } + Pause, { screen pausing } + Novice, { user requires novice help } + ANSI, { Supports ANSI } + Color, { Supports color } + Alert, { Alert SysOp upon login } + SMW, { Short message(s) waiting } + NoMail, { Mailbox is closed } + + FNoDLRatio, { 1 - No UL/DL ratio } + FNoPostRatio, { 2 - No post/call ratio } + FNoCredits, { 3 - No credits checking } + FNoDeletion); { 4 - Protected from deletion } + + FlagSet = SET OF FlagType; + + StatusFlagType = + (LockedOut, { if locked out } + Deleted, { if deleted } + TrapActivity, { if trapping users activity } + TrapSeparate, { if trap to seperate TRAP file } + ChatAuto, { if auto chat trapping } + ChatSeparate, { if separate chat file to trap to } + SLogSeparate, { if separate SysOp log } + CLSMsg, { if clear-screens } + RIP, { if RIP graphics can be used } + FSEditor, { if Full Screen Editor } + AutoDetect, { Use auto-detected emulation } + FileAreaLightBar, + MsgAreaLightBar, + UnUsedStatusFlag1, + UnUsedStatusFlag2, + UnUsedStatusFlag3 + ); + + StatusFlagSet = SET OF StatusFlagType; + + ANonTyp = + (ATNo, { Anonymous posts not allowed } + ATYes, { Anonymous posts are allowed } + ATForced, { Force anonymous } + ATDearAbby, { "Dear Abby" } + ATAnyName); { Post under any name } + + NetAttr = + (Private, + Crash, + Recd, + NSent, + FileAttach, + Intransit, + Orphan, + KillSent, + Local, + Hold, + Unused, + FileRequest, + ReturnReceiptRequest, + IsReturnReceipt, + AuditRequest, + FileUpdateRequest); + + NetAttribs = SET OF NetAttr; + + SecurityRangeType = ARRAY [0..255] OF LongInt; { Access tables } + + UserIDXRec = { USERS.IDX : Sorted names listing } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Name: STRING[36]; { the user's name } + Number, { user number } + Left, { Left node } + Right: SmallInt; { Right node } + RealName, { User's real name? } + Deleted: Boolean; { deleted or not } + END; + + UserRecordType = { USERS.DAT : User records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + Name, { system name } + RealName: STRING[36]; { real name } + + Street, { street address } + CityState: STRING[30]; { city, state } + + CallerID: STRING[20]; { caller ID STRING } + + ZipCode: STRING[10]; { zipcode } + + PH: STRING[12]; { phone # } + + ForgotPWAnswer: STRING[40]; + + UsrDefStr: ARRAY [1..3] OF STRING[35]; { definable strings } + + Note: STRING[35]; { SysOp note } + + LockedFile: STRING[8]; { print lockout msg } + + Vote: ARRAY [1..25] OF Byte; { voting data } + + Sex, { gender } + Subscription, { their subscription } + ExpireTo, { level to expire to } + LastConf, { last conference in } + UnUsedChar1, + UnUsedChar2: Char; + + SL, { SL } + DSL, { DSL } + Waiting, { mail waiting } + LineLen, { line length } + PageLen, { page length } + OnToday, { # times on today } + Illegal, { # illegal logons } + DefArcType, { QWK archive type } + ColorScheme, { Color scheme # } + UserStartMenu, { menu to start at } + UnUsedByte1, + UnUsedByte2: Byte; + + BirthDate, { Birth date } + FirstOn, { First On Date } + LastOn, { Last On Date } + TTimeOn, { total time on } + LastQWK, { last qwk packet } + Expiration, { Expiration date } + UnUsedUnixTime1, + UnUsedUnixTime2: UnixTime; + + UserID, { Permanent userid } + TLToday, { # min left today } + ForUsr, { forward mail to } + LastMsgArea, { # last msg area } + LastFileArea, { # last file area } + UnUsedInteger1, + UnUsedInteger2: SmallInt; + + PasswordChanged, { Numeric date pw changed - was UnixTime } + UnUsedWord1, + UnUsedWord2: SmallWord; + + lCredit, { Amount OF credit } + Debit, { Amount OF debit } + PW, { password } + Uploads, { # OF DLs } + Downloads, { # OF DLs } + UK, { UL k } + DK, { DL k } + LoggedOn, { # times on } + MsgPost, { # message posts } + EmailSent, { # email sent } + FeedBack, { # feedback sent } + TimeBank, { # mins in bank } + TimeBankAdd, { # added today } + DLKToday, { # kbytes dl today } + DLToday, { # files dl today } + FilePoints, + TimeBankWith, { Time withdrawn } + UnUsedLongInt1, + UnUsedLongInt2: LongInt; + + TeleConfEcho, { Teleconf echo? } + TeleConfInt, { Teleconf interrupt } + GetOwnQWK, { Get own messages } + ScanFilesQWK, { new files in qwk } + PrivateQWK, { private mail qwk } + UnUsedBoolean1, + UnUsedBoolean2: Boolean; + + AR: ARFlagSet; { AR flags } + + Flags: FlagSet; { flags } + + SFlags: StatusFlagSet; { status flags } + END; + + MsgStatusR = + (MDeleted, + Sent, + Unvalidated, + Permanent, + AllowMCI, + NetMail, + Prvt, + Junked); + + FromToInfo = { from/to information for mheaderrec } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Anon: Byte; + UserNum: SmallWord; { user number } + A1S: STRING[36]; { posted as } + Real: STRING[36]; { real name } + Name: STRING[36]; { system name } + Zone, + Net, + Node, + Point: SmallWord; + END; + + MHeaderRec = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + From, + MTO: FromToInfo; { message from/to info } + Pointer: LongInt; { starting record OF text } + TextSize: SmallWord; { size OF text } + ReplyTo: SmallWord; { ORIGINAL + REPLYTO = CURRENT } + Date: UnixTime; { date/time PACKED STRING } + DayOfWeek: Byte; { message day OF week } + Status: SET OF MsgStatusR; { message status flags } + Replies: SmallWord; { times replied to } + Subject: STRING[40]; { subject OF message } + OriginDate: STRING[19]; { date OF echo/group msgs } + FileAttached: Byte; { 0=No, 1=Yes&Del, 2=Yes&Save } + NetAttribute: NetAttribs; { Netmail attributes } + Res: ARRAY [1..2] OF Byte; { reserved } + END; + + HistoryRecordType = { HISTORY.DAT : Summary logs } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Date: UniXTime; + Active, + Callers, + NewUsers, + Posts, + Email, + FeedBack, + Errors, + Uploads, + Downloads, + UK, + DK: LongInt; + UserBaud: ARRAY [0..20] OF LongInt; + END; + + FileArcInfoRecordType = { Archive configuration records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Active: Boolean; { active or not } + Ext: STRING[3]; { file extension } + ListLine, { /x for internal; x: 1=ZIP, 2=ARC/PAK, 3=ZOO, 4=LZH } + ArcLine, { compression cmdline } + UnArcLine, { de-compression cmdline } + TestLine, { integrity test cmdline } + CmtLine: STRING[25]; { comment cmdline } + SuccLevel: SmallInt; { success errorlevel, -1=ignore results } + END; + + ModemFlagType = { MODEM.DAT status flags } + (Lockedport, { COM port locked at constant rate } + XOnXOff, { XON/XOFF (software) flow control } + CTSRTS); { CTS/RTS (hardware) flow control } + + MFlagSet = SET OF ModemFlagType; + + LineRec = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + InitBaud: LongInt; { initialization baud } + ComPort: Byte; { COM port number } + MFlags: MFlagSet; { status flags } + Init, { init STRING } + Answer, { answer STRING or blank } + Hangup, { hangup STRING } + Offhook: STRING[30]; { phone off-hook STRING } + DoorPath, { door drop files written to } + TeleConfNormal, + TeleConfAnon, { Teleconferencing strings } + TeleConfGlobal, + TeleConfPrivate: STRING[40]; + Ok, + Ring, + Reliable, + CallerID, + NoCarrier: STRING[20]; + Connect: ARRAY [1..22] OF STRING[20]; + { 300, 600, 1200, 2400, 4800, 7200, 9600, 12000, 14400, 16800, 19200, + 21600, 24000, 26400, 28800, 31200, 33600, 38400, 57600, 115200 + 2 extra } + UseCallerID: Boolean; { Insert Caller ID into sysop note? } + LogonACS: ACString; { ACS STRING to logon this node } + IRQ, + Address: STRING[10]; { used only for functional MCI codes + %C = Comport address + %E = IRQ + } + AnswerOnRing: Byte; { Answer after how many rings? } + MultiRing: Boolean; { Answer Ringmaster or some other type + OF multiple-ring system ONLY } + NodeTelnetUrl: STRING[65]; + END; + + ValidationRecordType = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Key, { Key '!' to '~' } + ExpireTo: Char; { validation level to expire to } + Description: STRING[30]; { description } + UserMsg: STRING[78]; { Message sent to user upon validation } + NewSL, { new SL } + NewDSL, { new DSL } + NewMenu: Byte; { User start out menu } + Expiration: SmallWord; { days until expiration } + NewFP, { nothing } + NewCredit: LongInt; { new credit } + SoftAR, { TRUE=AR added to current, else replaces } + SoftAC: Boolean; { TRUE=AC " " " " " } + NewAR: ARFlagSet; { new AR } + NewAC: FlagSet; { new AC } + END; + + GeneralRecordType = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + ForgotPWQuestion: STRING[70]; + + QWKWelcome, { QWK welcome file name } + QWKNews, { QWK news file name } + QWKGoodbye, { QWK goodbye file name } + Origin: STRING[50]; { Default Origin line } + + DataPath, { DATA path } + MiscPath, { MISC path } + LogsPath, { LOGS path } + MsgPath, { MSGS path } + NodePath, { NODE list path } + TempPath, { TEMP path } + ProtPath, { PROT path } + ArcsPath, { ARCS path } + lMultPath, { MULT path } + FileAttachPath, { directory for file attaches } + QWKLocalPath, { QWK path for local usage } + DefEchoPath, { default echomail path } + NetmailPath, { path to netmail } + BBSName: STRING[40]; { BBS name } + + SysOpName: STRING[30]; { SysOp's name } + + Version: STRING[20]; + + BBSPhone: STRING[12]; { BBS phone number } + + LastDate: STRING[10]; { last system date } + + PacketName, { QWK packet name } + BulletPrefix: STRING[8]; { default bulletins filename } + + SysOpPW, { SysOp password } + NewUserPW, { newuser password } + MinBaudOverride, { override minimum baud rate } + QWKNetworkACS, { QWK network REP ACS } + LastOnDatACS, + SOP, { SysOp } + CSOP, { Co-SysOp } + MSOP, { Message SysOp } + FSOP, { File SysOp } + SPW, { SysOp PW at logon } + AddChoice, { Add voting choices acs } + NormPubPost, { make normal public posts } + NormPrivPost, { send normal e-mail } + + AnonPubRead, { see who posted public anon } + AnonPrivRead, { see who sent anon e-mail } + AnonPubPost, { make anon posts } + AnonPrivPost, { send anon e-mail } + + SeeUnval, { see unvalidated files } + DLUnval, { DL unvalidated files } + NoDLRatio, { no UL/DL ratio } + NoPostRatio, { no post/call ratio } + NoFileCredits, { no file credits checking } + ULValReq, { uploads require validation } + TeleConfMCI, { ACS access for MCI codes while teleconfin' } + OverrideChat, { override chat hours } + NetMailACS, { do they have access to netmail? } + Invisible, { Invisible mode? } + FileAttachACS, { ACS to attach files to messages } + ChangeVote, { ACS to change their vote } + UnUsedACS1, + UnUsedACS2: ACString; + + MaxPrivPost, { max email can send per call } + MaxFBack, { max feedback per call } + MaxPubPost, { max posts per call } + MaxChat, { max sysop pages per call } + MaxWaiting, { max mail waiting } + CSMaxWaiting, { max mail waiting for Co-SysOp + } + MaxMassMailList, + MaxLogonTries, { tries allowed for PW's at logon } + SysOpColor, { SysOp color in chat mode } + UserColor, { user color in chat mode } + SliceTimer, + MaxBatchDLFiles, + MaxBatchULFiles, + Text_Color, { color OF standard text } + Quote_Color, { color OF quoted text } + Tear_Color, { color OF tear line } + Origin_Color, { color OF origin line } + BackSysOpLogs, { days to keep SYSOP##.LOG } + EventWarningTime, { minutes before event to warn user } + WFCBlankTime, { minutes before blanking WFC menu } + AlertBeep, { time between alert beeps - Was Integer } + FileCreditComp, { file credit compensation ratio } + FileCreditCompBaseSize, { file credit area compensation size } + ULRefund, { percent OF time to refund on ULs } + GlobalMenu, + AllStartMenu, + ShuttleLogonMenu, + NewUserInformationMenu, + FileListingMenu, + MessageReadMenu, + CurWindow, { type OF SysOp window in use } + SwapTo, { Swap where? } + UnUsedByte1, + UnUsedByte2: Byte; + + lLowTime, { SysOp begin minute (in minutes) } + HiTime, { SysOp END time } + DLLowTime, { normal downloading hours begin.. } + DLHiTime, { ..and END } + MinBaudLowTime, { minimum baud calling hours begin.. } + MinBaudHiTime, { ..and END } + MinBaudDLLowTime, { minimum baud downloading hours begin.. } + MinBaudDLHiTime, { ..and END } + NewApp, { send new user application to # } + TimeOutBell, { minutes before timeout beep } + TimeOut, { minutes before timeout } + ToSysOpDir, { SysOp file area } + CreditMinute, { Credits per minute } + CreditPost, { Credits per post } + CreditEmail, { Credits per Email sent } + CreditFreeTime, { Amount OF "Free" time given to user at logon } + NumUsers, { number OF users } + PasswordChange, { change password at least every x days } + RewardRatio, { % OF file points to reward back } + CreditInternetMail, { cost for Internet mail } + BirthDateCheck, { check user's birthdate every xx logons } + UnUsedInteger1, + UnUsedInteger2: SmallInt; + + MaxQWKTotal, { max msgs in a packet, period } + MaxQWKBase, { max msgs in a area } + DaysOnline, { days online } + UnUsedWord1, + UnUsedWord2: SmallWord; + + MinimumBaud, { minimum baud rate to logon } + MinimumDLBaud, { minimum baud rate to download } + MaxDepositEver, + MaxDepositPerDay, + MaxWithdrawalPerDay, + CallerNum, { system caller number } + RegNumber, { registration number } + TotalCalls, { incase different from callernum } + TotalUsage, { total usage in minutes } + TotalPosts, { total number OF posts } + TotalDloads, { total number OF dloads } + TotalUloads, { total number OF uloads } + MinResume, { min K to allow resume-later } + MaxInTemp, { max K allowed in TEMP } + MinSpaceForPost, { minimum drive space left to post } + MinSpaceForUpload, { minimum drive space left to upload } + UnUsedLongInt1, + UnUsedLongInt2: LongInt; + + AllowAlias, { allow handles? } + PhonePW, { phone number password in logon? } + LocalSec, { use local security? } + GlobalTrap, { trap everyone's activity? } + AutoChatOpen, { automatically open chat buffer? } + AutoMInLogon, { Auto-Message at logon? } + BullInLogon, { bulletins at logon? } + YourInfoInLogon, { "Your Info" at logon? } + OffHookLocalLogon, { phone off-hook for local logons? } + ForceVoting, { manditory voting? } + CompressBases, { "compress" file/msg area numbers? } + SearchDup, { search for dupes files when UL? } + ForceBatchDL, + ForceBatchUL, + LogonQuote, + UserAddQuote, + StripCLog, { strip colors from SysOp log? } + SKludge, { show kludge lines? } + SSeenby, { show SEEN-BY lines? } + SOrigin, { show origin line? } + AddTear, { show tear line? } + ShuttleLog, { Use Shuttle Logon? } + ClosedSystem, { Allow new users? } + SwapShell, { Swap on shell? } + UseEMS, { use EMS for overlay } + UseBios, { use BIOS for video output } + UseIEMSI, { use IEMSI } + ULDLRatio, { use UL/DL ratios? } + FileCreditRatio, { use auto file-credit compensation? } + ValidateAllFiles, { validate files automatically? } + FileDiz, { Search/Import file_id.diz } + SysOpPword, { check for sysop password? } + TrapTeleConf, { Trap teleconferencing to ROOMx.TRP? } + IsTopWindow, { is window at top OF screen? } + ReCompress, { recompress like archives? } + RewardSystem, { use file rewarding system? } + TrapGroup, { record group chats? } + QWKTimeIgnore, { ignore time remaining for qwk download? } + NetworkMode, { Network mode ? } + WindowOn, { is the sysop window on? } + ChatCall, { Whether system keeps beeping after chat} + DailyLimits, { Daily file limits on/off } + MultiNode, { enable multinode support } + PerCall, { time limits are per call or per day?} + TestUploads, { perform integrity tests on uploads? } + UseFileAreaLightBar, + UseMsgAreaLightBar, + UnUsedBoolean1, + UnUsedBoolean2: Boolean; + + FileArcInfo: + ARRAY [1..MaxArcs] OF FileArcInfoRecordType; { archive specs } + + FileArcComment: + ARRAY [1..3] OF STRING[40]; { BBS comment files for archives } + + Aka: ARRAY [0..20] OF + {$IFDEF WIN32} PACKED {$ENDIF} RECORD { 20 Addresses } + Zone, { 21st is for UUCP address } + Net, + Node, + Point: SmallWord; + END; + + NewUserToggles: ARRAY [1..20] OF Byte; + + Macro: ARRAY [0..9] OF STRING[100]; { sysop macros } + + Netattribute: NetAttribs; { default netmail attribute } + + TimeAllow, { time allowance } + CallAllow, { call allowance } + DLRatio, { # ULs/# DLs ratios } + DLKRatio, { DLk/ULk ratios } + PostRatio, { posts per call ratio } + DLOneday, { Max number OF dload files in one day} + DLKOneDay: SecurityRangeType; { Max k downloaded in one day} + END; + + ShortMessageRecordType = { SHORTMSG.DAT : One-line messages } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Msg: AStr; + Destin: SmallInt; + END; + + VotingRecordType = { VOTING.DAT : Voting records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Question1, { Voting Question 1 } + Question2: STRING[60]; { Voting Question 2 } + ACS: ACString; { ACS required to vote on this } + ChoiceNumber: Byte; { number OF choices } + NumVotedQuestion: SmallInt; { number OF votes on it } + CreatedBy: STRING[36]; { who created it } + AddAnswersACS: ACString; { ACS required to add choices } + Answers: ARRAY [1..25] OF + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + Answer1, { answer description } + Answer2: STRING[65]; { answer description #2 } + NumVotedAnswer: SmallInt; { # user's who picked this answer } + END; + END; + + MessageAreaFlagType = + (MARealName, { whether real names are forced } + MAUnHidden, { whether *VISIBLE* to users w/o access } + MAFilter, { whether to filter ANSI/8-bit ASCII } + MAPrivate, { allow private messages } + MAForceRead, { force the reading of this area } + MAQuote, { Allow Quote/Tagline to messages posted in this area } + MASKludge, { strip IFNA kludge lines } + MASSeenBy, { strip SEEN-BY lines } + MASOrigin, { strip origin lines } + MAAddTear, { add tear/origin lines } + MAInternet, { if internet message area } + MAScanOut); { Needs to be scanned out by renemail } + + MAFlagSet = SET OF MessageAreaFlagType; + + MessageAreaRecordType = { MBASES.DAT : Message area records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Name: STRING[40]; { message area description } + FileName: STRING[8]; { HDR/DAT data filename } + MsgPath: STRING[40]; {Not Used} { messages pathname } + ACS, { access requirement } + PostACS, { post access requirement } + MCIACS, { MCI usage requirement } + SysOpACS: ACString; { Message area sysop requirement } + MaxMsgs: SmallWord; { max message count } + Anonymous: AnonTyp; { anonymous type } + Password: STRING[20]; { area password } + MAFlags: MAFlagSet; { message area status vars } + MAType: SmallInt; { Area type (0=Local,1=Echo, 3=Qwk) } + Origin: STRING[50]; { origin line } + Text_Color, { color OF standard text } + Quote_Color, { color OF quoted text } + Tear_Color, { color OF tear line } + Origin_Color, { color OF origin line } + MessageReadMenu: Byte; + QuoteStart, + QuoteEnd: STRING[70]; + PrePostFile: STRING[8]; + AKA: Byte; { alternate address } + QWKIndex: SmallWord; { QWK indexing number } + END; + + FileAreaFlagType = + (FANoRatio, { if active } + FAUnHidden, { whether *VISIBLE* to users w/o access } + FADirDLPath, { if *.DIR file stored in DLPATH } + FAShowName, { show uploaders in listings } + FAUseGIFSpecs, { whether to use GifSpecs } + FACDROM, { Area is read only, no sorting or ul scanning } + FAShowDate, { show date uploaded in listings } + FANoDupeCheck); { No dupe check on this area } + + FAFlagSet = SET OF FileAreaFlagType; + + FileAreaRecordType = { FBASES.DAT : File area records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + AreaName: STRING[40]; { area description } + FileName: STRING[8]; { filename + ".DIR" } + DLPath, { download path } + ULPath: STRING[40]; { upload path } + MaxFiles: SmallInt; { max files allowed - VerbRec Limit would allow up to LongInt Value or Maximum 433835} + Password: STRING[20]; { password required } + ArcType, { wanted archive type (1..max,0=inactive) } + CmtType: Byte; { wanted comment type (1..3,0=inactive) } + ACS, { access requirements } + ULACS, { upload requirements } + DLACS: ACString; { download requirements } + FAFlags: FAFlagSet; { file area status vars } + END; + + FileInfoFlagType = + (FINotVal, { If file is not validated } + FIIsRequest, { If file is REQUEST } + FIResumeLater, { If file is RESUME-LATER } + FIHatched, { Has file been hatched? } + FIOwnerCredited, + FIUnusedFlag1, + FIUnusedFlag2, + FIUnusedFlag3); + + FIFlagSet = SET OF FileInfoFlagType; + + FileInfoRecordType = { *.DIR : File records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + FileName: STRING[12]; { Filename } + Description: STRING[50]; { File description } + FilePoints: SmallInt; { File points } + Downloaded: LongInt; { Number DLs } + FileSize: LongInt; { File size in Bytes } + OwnerNum: SmallInt; { ULer OF file } + OwnerName: STRING[36]; { ULer's name } + FileDate: UnixTime; { Date ULed } + VPointer: LongInt; { Pointer to verbose descr, -1 if none } + VTextSize: SmallInt; { Verbose descr textsize - 50 Bytes x 99 Lines = 4950 max } + FIFlags: FIFlagSet; { File status } + END; + + LastCallerRec = { LASTON.DAT : Last few callers records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Node: Byte; { Node number } + UserName: STRING[36]; { User name OF caller } + Location: STRING[30]; { Location OF caller } + Caller, { system caller number } + UserID, { User ID # } + Speed: LongInt; { Speed OF caller 0=Local } + LogonTime, { time user logged on } + LogoffTime: UnixTime; { time user logged off } + NewUser, { was it a new user? } + Invisible: Boolean; { Invisible user? } + Uploads, { Uploads/Downloads during call } + Downloads, + MsgRead, { Messages Read } + MsgPost, { Messages Posted } + EmailSent, { Email sent } + FeedbackSent: SmallWord; { Feedback sent } + UK, { Upload/Download kbytes during call } + DK: LongInt; + Reserved: ARRAY [1..17] OF Byte; { Reserved } + END; + + EventFlagType = + (EventIsExternal, + EventIsActive, + EventIsErrorLevel, + EventIsShell, + EventIsPackMsgAreas, + EventIsSortFiles, + EventIsFilesBBS, + EventIsLogon, + EventIsChat, + EventIsOffHook, + EventIsMonthly, + EventIsPermission, + EventIsSoft, + EventIsMissed, + BaudIsActive, + ACSIsActive, + TimeIsActive, + ARisActive, + SetARisActive, + ClearARisActive, + InRatioIsActive); + + EFlagSet = SET OF EventFlagType; + + EventDaysType = SET OF 0..6; {Set of event days} + + EventRecordType = {Events - EVENTS.DAT} +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + EventDescription: STRING[30]; {Description of the Event} + EventDayOfMonth: BYTE; {If monthly, the Day of Month} + EventDays: EventDaysType; {If Daily, the Days Active} + EventStartTime, {Start Time in Min from Mid.} + EventFinishTime: SmallWord; {Finish Time} + EventQualMsg, {Msg/Path if he qualifies} + EventNotQualMsg: STRING[64]; {Msg/Path if he doesn't} + EventPreTime: BYTE; {Min. B4 event to rest. Call} + EventNode: Byte; + EventLastDate: UnixTime; {Last Date Executed} + EventErrorLevel: BYTE; {For Ext Event ErrorLevel} + EventShellPath: STRING[8]; {File for Ext Event Shell} + LoBaud, {Low baud rate limit} + HiBaud: LongInt; {High baud rate limit} + EventACS: ACString; {Event ACS} + MaxTimeAllowed: SmallWord; {Max Time per user this event} + SetARflag, {AR Flag to Set} + ClearARflag: CHAR; {AR Flag to Clear} + EFlags: EFlagSet; {Kinds of Events Supported} { Changed } + END; + + ProtocolFlagType = + (ProtActive, + ProtIsBatch, + ProtIsResume, + ProtXferOkCode, + ProtBiDirectional, + ProtReliable); + + PRFlagSet = SET OF ProtocolFlagType; + + ProtocolCodeType = ARRAY [1..6] OF STRING[6]; + + ProtocolRecordType = { PROTOCOL.DAT records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + PRFlags: PRFlagSet; { Protocol Flags } + CKeys: STRING[14]; { Command Keys } + Description: STRING[40]; { Description } + ACS: ACString; { User Access STRING } + TempLog, { Utilized for Batch DL's - Temporary Log File } + DLoadLog, { Utilized for Batch DL's - Permanent Log Files } + ULoadLog, { Not Utilized } + DLFList: STRING[25]; { Utilized for Batch DL's - DL File Lists } + DLCmd, { DL Command Line } + ULCmd: STRING[76]; { UL Command Line } + DLCode, { DL Status/Return codes } + ULCode: ProtocolCodeType; { UL StAtus/Return codes } + EnvCmd: STRING[60]; { Environment Setup Cmd } + MaxChrs, { Utilized for Batch DL's - Max chrs in cmdline } + TempLogPF, { Utilized for Batch DL's - Position in log for DL Status } + TempLogPS: Byte; { Utilized for Batch DL's - Position in log for file data } + END; + + ConferenceRecordType = { CONFRENC.DAT : Conference data } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Key: Char; { key '@' to 'Z' } + Name: STRING[30]; { name of conference } + ACS: ACString; { access requirement } + END; + + NodeFlagType = + (NActive, { Is this node active? } + NAvail, { Is this node's user available? } + NUpdate, { This node should re-read it's user } + NHangup, { Hangup on this node } + NRecycle, { Recycle this node to the OS } + NInvisible); { This node is Invisible } + + NodeFlagSet = SET OF NodeFlagType; + + NodeRecordType = { MULTNODE.DAT } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + User: SmallWord; { What user number } + UserName: STRING[36]; { User's name } + CityState: STRING[30]; { User's location } + Sex: Char; { User's sex } + Age: Byte; { User's age } + LogonTime: UnixTime; { What time they logged on } + GroupChat: Boolean; { Are we in MultiNode Chat } + ActivityDesc: STRING[50]; { Activity STRING } + Status: NodeFlagSet; + Room: Byte; { What room are they in? } + Channel: SmallWord; { What channel are they in? } + Invited, { Have they been invited ? } + Booted, { Have they been kicked off ? } + Forget: ARRAY [0..31] OF SET OF 0..7; { Who are they forgetting? } + END; + + RoomRec = { ROOM.DAT } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Topic: STRING[40]; { Topic OF this room } + Anonymous: Boolean; { Is Room anonymous ? } + Private: Boolean; { Is Room private ? } + Occupied: Boolean; { Is anyone in here? } + Moderator: SmallWord; { Who's the moderator? } + END; + + ScanRec = { *.SCN files / MESSAGES } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + NewScan: Boolean; { Scan this area? } + LastRead: UnixTime; { Last date read } + END; + + SchemeRec = { Scheme.dat } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Description: STRING[30]; { Description OF the color scheme } + Color: ARRAY [1..200] OF Byte; { Colors in scheme } + END; + + { 1 - 10 system colors + 11 - file list colors + 28 - msg list colors + 45 - file area list colors + 55 - msg area list colors + 65 - user list colors + 80 - who's online colors + 100- last on colors + 115- qwk colors + 135- email colors + } + + BBSListRecordType = { *.BBS file records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + RecordNum, { Number OF the Record For Edit } + UserID, { User ID OF person adding this } + MaxNodes : LongInt; { Maximum Number Of Nodes } + Port : Word; { Telnet Port } + BBSName : STRING[30]; { Name OF BBS } + SysOpName : STRING[30]; { SysOp OF BBS } + TelnetUrl : STRING[60]; { Telnet Urls } + WebSiteUrl : STRING[60]; { Web Site Url } + PhoneNumber : STRING[20]; { Phone number OF BBS } + Location : STRING[30]; { Location of BBS } + Software, { Software used by BBS } + SoftwareVersion : String[12]; { Software Version of BBS } + OS : STRING[20]; { Operating System of BBS } + Speed : STRING[8]; { Highest connect speed OF BBS } + Hours : STRING[20]; { Hours of Operation } + Birth : STRING[10]; { When the BBS Began } + Description : STRING[60]; { Description OF BBS } + Description2 : STRING[60]; { Second line OF descrition } + DateAdded : UnixTime; { Date entry was added } + DateEdited : UnixTime; { Date entry was last edited } + SDA : STRING[8]; { sysop definable A } + SDB : STRING[30]; { sysop definable B } + SDC : STRING[30]; { sysop definable C } + SDD : STRING[40]; { sysop definable D } + SDE : STRING[60]; { sysop definable E } + SDF : STRING[60]; { sysop definable F } + SDG : Word; { sysop definable G } + SDH, { sysop definable H } + SDI : Boolean; { sysop definable I } + + END; + + MenuFlagType = + (ClrScrBefore, { C: clear screen before menu display } + DontCenter, { D: don't center the menu titles! } + NoMenuTitle, { T: no menu title displayed } + NoMenuPrompt, { N: no menu prompt whatsoever? } + ForcePause, { P: force a pause before menu display? } + AutoTime, { A: is time displayed automatically? } + ForceLine, { F: Force full line input } + NoGenericAnsi, { 1: DO NOT generate generic prompt if ANSI } + NoGenericAvatar, { 2: DO NOT generate generic prompt if AVT } + NoGenericRIP, { 3: DO NOT generate generic prompt if RIP } + NoGlobalDisplayed, { 4: DO NOT display the global commands! } + NoGlobalUsed); { 5: DO NOT use global commands! } + + MenuFlagSet = SET OF MenuFlagType; + + CmdFlagType = + (Hidden, { H: is command ALWAYS hidden? } + UnHidden); { U: is command ALWAYS visible? } + + CmdFlagSet = SET OF CmdFlagType; + + MenuRec = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + LDesc: ARRAY [1..3] OF STRING[100]; { Menu Or Command Long Description ARRAY } + ACS: ACString; { Access Requirements } + NodeActivityDesc: STRING[50]; + CASE Menu: Boolean OF { Menu Or Command - Variant section} + TRUE: + (MenuFlags: MenuFlagSet; { Menu Flag SET } + LongMenu: STRING[12]; { Displayed In Place OF Long Description } + MenuNum: Byte; { Menu Number } + MenuPrompt: STRING[120]; { Menu Prompt } + Password: STRING[20]; { Menu Password } + FallBack: Byte; { Menu Fallback Number } + Directive: STRING[12]; + ForceHelpLevel: Byte; { Menu Forced Help Level } + GenCols: Byte; { Generic Menus: # OF Columns } + GCol: ARRAY [1..3] OF Byte); { Generic Menus: Colors } + FALSE: + (CmdFlags: CmdFlagSet; { Command Flag SET } + SDesc: STRING[35]; { Command Short Description } + CKeys: STRING[14]; { Command Execution Keys } + CmdKeys: STRING[2]; { Command Keys: Type OF Command } + Options: STRING[50]); { MString: Command Data } + END; diff --git a/SOURCE/RECORDS.bak b/SOURCE/RECORDS.bak new file mode 100644 index 0000000..c731514 --- /dev/null +++ b/SOURCE/RECORDS.bak @@ -0,0 +1,1019 @@ +CONST + Build = '1.20.1'; + +{$IFDEF MSDOS} + OS = '/DOS'; +{$ENDIF} + +{$IFDEF WIN32} + OS = '/Win32'; +{$ENDIF} + +{$IFDEF OS/2} + OS = '/2'; +{$ENDIF} + +{$IFDEF LINUX} + OS = 'Linux'; +{$ENDIF} + + Ver = Build + OS; + MaxProtocols = 120; + MaxEvents = 10; + MaxArcs = 8; + MaxCmds = 200; + MaxMenus = 100; + MaxResultCodes = 20; + MaxExtDesc = 99; + MaxFileAreas = 32767; + MaxMsgAreas = 32767; + MaxConfigurable = 1024; + MaxVotes = 25; + MaxChoices = 25; + MaxSchemes = 255; + MaxValKeys = 92; + MaxConfKeys = 27; + + User_String_Ask = ' '; {Ask for user string fields} + User_String_None = ''; {None for user string fields} + + User_Date_Ask = -2145916799; {Ask for user date fields - 01/01/1902} + User_Date_None = -2146003199; {None for user date fields - 12/31/1901} + + User_Word_Ask = 65535; {Ask for user word fields} + User_Word_None = 65534; {None for user word fields} + + User_Char_Ask = '~'; {Ask for user character fields} + User_Char_None = ' '; {None for user character fields} + + User_Phone_Ask = ' '; {Ask for user phone fields} + User_Phone_None = ''; {None for user phone fields} + +TYPE +{$IFDEF MSDOS} + SmallInt = Integer; + SmallWord = Word; +{$ENDIF} +{$IFDEF FPC} + SmallWord = Word; +{$ENDIF} + AStr = STRING[160]; + Str1 = STRING[1]; + Str2 = STRING[2]; + Str3 = STRING[3]; + Str4 = STRING[4]; + Str5 = STRING[5]; + Str7 = STRING[7]; + Str8 = STRING[8]; + Str9 = STRING[9]; + Str11 = STRING[11]; + Str10 = STRING[10]; + Str12 = STRING[12]; + Str15 = STRING[15]; + Str20 = STRING[20]; + Str26 = STRING[26]; + Str30 = STRING[30]; + Str35 = STRING[35]; + Str36 = STRING[36]; + Str40 = STRING[40]; + Str50 = STRING[50]; + Str52 = STRING[52]; + Str65 = STRING[65]; + Str74 = STRING[74]; + Str78 = STRING[78]; + Str160 = STRING[160]; + + UnixTime = LongInt; { Seconds since 1-1-70 } + + ACString = STRING[20]; { Access Condition STRING } + + ARFlagType = '@'..'Z'; {AR flags} + + ARFlagSet = SET OF ARFlagType; {SET OF AR flags} + + FlagType = + (RLogon, { L - Limited to one call a day } + RChat, { C - No SysOp paging } + RValidate, { V - Posts are unvalidated } + RUserList, { U - Can't list users } + RAMsg, { A - Can't leave automsg } + RPostAn, { * - Can't post anonymously } + RPost, { P - Can't post } + REmail, { E - Can't send email } + RVoting, { K - Can't use voting booth } + RMsg, { M - Force email deletion } + + VT100, { Supports VT00 } + HotKey, { hotkey input mode } + Avatar, { Supports Avatar } + Pause, { screen pausing } + Novice, { user requires novice help } + ANSI, { Supports ANSI } + Color, { Supports color } + Alert, { Alert SysOp upon login } + SMW, { Short message(s) waiting } + NoMail, { Mailbox is closed } + + FNoDLRatio, { 1 - No UL/DL ratio } + FNoPostRatio, { 2 - No post/call ratio } + FNoCredits, { 3 - No credits checking } + FNoDeletion); { 4 - Protected from deletion } + + FlagSet = SET OF FlagType; + + StatusFlagType = + (LockedOut, { if locked out } + Deleted, { if deleted } + TrapActivity, { if trapping users activity } + TrapSeparate, { if trap to seperate TRAP file } + ChatAuto, { if auto chat trapping } + ChatSeparate, { if separate chat file to trap to } + SLogSeparate, { if separate SysOp log } + CLSMsg, { if clear-screens } + RIP, { if RIP graphics can be used } + FSEditor, { if Full Screen Editor } + AutoDetect, { Use auto-detected emulation } + FileAreaLightBar, + MsgAreaLightBar, + UnUsedStatusFlag1, + UnUsedStatusFlag2, + UnUsedStatusFlag3 + ); + + StatusFlagSet = SET OF StatusFlagType; + + ANonTyp = + (ATNo, { Anonymous posts not allowed } + ATYes, { Anonymous posts are allowed } + ATForced, { Force anonymous } + ATDearAbby, { "Dear Abby" } + ATAnyName); { Post under any name } + + NetAttr = + (Private, + Crash, + Recd, + NSent, + FileAttach, + Intransit, + Orphan, + KillSent, + Local, + Hold, + Unused, + FileRequest, + ReturnReceiptRequest, + IsReturnReceipt, + AuditRequest, + FileUpdateRequest); + + NetAttribs = SET OF NetAttr; + + SecurityRangeType = ARRAY [0..255] OF LongInt; { Access tables } + + UserIDXRec = { USERS.IDX : Sorted names listing } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Name: STRING[36]; { the user's name } + Number, { user number } + Left, { Left node } + Right: SmallInt; { Right node } + RealName, { User's real name? } + Deleted: Boolean; { deleted or not } + END; + + UserRecordType = { USERS.DAT : User records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + Name, { system name } + RealName: STRING[36]; { real name } + + Street, { street address } + CityState: STRING[30]; { city, state } + + CallerID: STRING[20]; { caller ID STRING } + + ZipCode: STRING[10]; { zipcode } + + PH: STRING[12]; { phone # } + + ForgotPWAnswer: STRING[40]; + + UsrDefStr: ARRAY [1..3] OF STRING[35]; { definable strings } + + Note: STRING[35]; { SysOp note } + + LockedFile: STRING[8]; { print lockout msg } + + Vote: ARRAY [1..25] OF Byte; { voting data } + + Sex, { gender } + Subscription, { their subscription } + ExpireTo, { level to expire to } + LastConf, { last conference in } + UnUsedChar1, + UnUsedChar2: Char; + + SL, { SL } + DSL, { DSL } + Waiting, { mail waiting } + LineLen, { line length } + PageLen, { page length } + OnToday, { # times on today } + Illegal, { # illegal logons } + DefArcType, { QWK archive type } + ColorScheme, { Color scheme # } + UserStartMenu, { menu to start at } + UnUsedByte1, + UnUsedByte2: Byte; + + BirthDate, { Birth date } + FirstOn, { First On Date } + LastOn, { Last On Date } + TTimeOn, { total time on } + LastQWK, { last qwk packet } + Expiration, { Expiration date } + UnUsedUnixTime1, + UnUsedUnixTime2: UnixTime; + + UserID, { Permanent userid } + TLToday, { # min left today } + ForUsr, { forward mail to } + LastMsgArea, { # last msg area } + LastFileArea, { # last file area } + UnUsedInteger1, + UnUsedInteger2: SmallInt; + + PasswordChanged, { Numeric date pw changed - was UnixTime } + UnUsedWord1, + UnUsedWord2: SmallWord; + + lCredit, { Amount OF credit } + Debit, { Amount OF debit } + PW, { password } + Uploads, { # OF DLs } + Downloads, { # OF DLs } + UK, { UL k } + DK, { DL k } + LoggedOn, { # times on } + MsgPost, { # message posts } + EmailSent, { # email sent } + FeedBack, { # feedback sent } + TimeBank, { # mins in bank } + TimeBankAdd, { # added today } + DLKToday, { # kbytes dl today } + DLToday, { # files dl today } + FilePoints, + TimeBankWith, { Time withdrawn } + UnUsedLongInt1, + UnUsedLongInt2: LongInt; + + TeleConfEcho, { Teleconf echo? } + TeleConfInt, { Teleconf interrupt } + GetOwnQWK, { Get own messages } + ScanFilesQWK, { new files in qwk } + PrivateQWK, { private mail qwk } + UnUsedBoolean1, + UnUsedBoolean2: Boolean; + + AR: ARFlagSet; { AR flags } + + Flags: FlagSet; { flags } + + SFlags: StatusFlagSet; { status flags } + END; + + MsgStatusR = + (MDeleted, + Sent, + Unvalidated, + Permanent, + AllowMCI, + NetMail, + Prvt, + Junked); + + FromToInfo = { from/to information for mheaderrec } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Anon: Byte; + UserNum: SmallWord; { user number } + A1S: STRING[36]; { posted as } + Real: STRING[36]; { real name } + Name: STRING[36]; { system name } + Zone, + Net, + Node, + Point: SmallWord; + END; + + MHeaderRec = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + From, + MTO: FromToInfo; { message from/to info } + Pointer: LongInt; { starting record OF text } + TextSize: SmallWord; { size OF text } + ReplyTo: SmallWord; { ORIGINAL + REPLYTO = CURRENT } + Date: UnixTime; { date/time PACKED STRING } + DayOfWeek: Byte; { message day OF week } + Status: SET OF MsgStatusR; { message status flags } + Replies: SmallWord; { times replied to } + Subject: STRING[40]; { subject OF message } + OriginDate: STRING[19]; { date OF echo/group msgs } + FileAttached: Byte; { 0=No, 1=Yes&Del, 2=Yes&Save } + NetAttribute: NetAttribs; { Netmail attributes } + Res: ARRAY [1..2] OF Byte; { reserved } + END; + + HistoryRecordType = { HISTORY.DAT : Summary logs } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Date: UniXTime; + Active, + Callers, + NewUsers, + Posts, + Email, + FeedBack, + Errors, + Uploads, + Downloads, + UK, + DK: LongInt; + UserBaud: ARRAY [0..20] OF LongInt; + END; + + FileArcInfoRecordType = { Archive configuration records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Active: Boolean; { active or not } + Ext: STRING[3]; { file extension } + ListLine, { /x for internal; x: 1=ZIP, 2=ARC/PAK, 3=ZOO, 4=LZH } + ArcLine, { compression cmdline } + UnArcLine, { de-compression cmdline } + TestLine, { integrity test cmdline } + CmtLine: STRING[25]; { comment cmdline } + SuccLevel: SmallInt; { success errorlevel, -1=ignore results } + END; + + ModemFlagType = { MODEM.DAT status flags } + (Lockedport, { COM port locked at constant rate } + XOnXOff, { XON/XOFF (software) flow control } + CTSRTS); { CTS/RTS (hardware) flow control } + + MFlagSet = SET OF ModemFlagType; + + LineRec = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + InitBaud: LongInt; { initialization baud } + ComPort: Byte; { COM port number } + MFlags: MFlagSet; { status flags } + Init, { init STRING } + Answer, { answer STRING or blank } + Hangup, { hangup STRING } + Offhook: STRING[30]; { phone off-hook STRING } + DoorPath, { door drop files written to } + TeleConfNormal, + TeleConfAnon, { Teleconferencing strings } + TeleConfGlobal, + TeleConfPrivate: STRING[40]; + Ok, + Ring, + Reliable, + CallerID, + NoCarrier: STRING[20]; + Connect: ARRAY [1..22] OF STRING[20]; + { 300, 600, 1200, 2400, 4800, 7200, 9600, 12000, 14400, 16800, 19200, + 21600, 24000, 26400, 28800, 31200, 33600, 38400, 57600, 115200 + 2 extra } + UseCallerID: Boolean; { Insert Caller ID into sysop note? } + LogonACS: ACString; { ACS STRING to logon this node } + IRQ, + Address: STRING[10]; { used only for functional MCI codes + %C = Comport address + %E = IRQ + } + AnswerOnRing: Byte; { Answer after how many rings? } + MultiRing: Boolean; { Answer Ringmaster or some other type + OF multiple-ring system ONLY } + NodeTelnetUrl: STRING[65]; + END; + + ValidationRecordType = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Key, { Key '!' to '~' } + ExpireTo: Char; { validation level to expire to } + Description: STRING[30]; { description } + UserMsg: STRING[78]; { Message sent to user upon validation } + NewSL, { new SL } + NewDSL, { new DSL } + NewMenu: Byte; { User start out menu } + Expiration: SmallWord; { days until expiration } + NewFP, { nothing } + NewCredit: LongInt; { new credit } + SoftAR, { TRUE=AR added to current, else replaces } + SoftAC: Boolean; { TRUE=AC " " " " " } + NewAR: ARFlagSet; { new AR } + NewAC: FlagSet; { new AC } + END; + + GeneralRecordType = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + ForgotPWQuestion: STRING[70]; + + QWKWelcome, { QWK welcome file name } + QWKNews, { QWK news file name } + QWKGoodbye, { QWK goodbye file name } + Origin: STRING[50]; { Default Origin line } + + DataPath, { DATA path } + MiscPath, { MISC path } + LogsPath, { LOGS path } + MsgPath, { MSGS path } + NodePath, { NODE list path } + TempPath, { TEMP path } + ProtPath, { PROT path } + ArcsPath, { ARCS path } + lMultPath, { MULT path } + FileAttachPath, { directory for file attaches } + QWKLocalPath, { QWK path for local usage } + DefEchoPath, { default echomail path } + NetmailPath, { path to netmail } + BBSName: STRING[40]; { BBS name } + + SysOpName: STRING[30]; { SysOp's name } + + Version: STRING[20]; + + BBSPhone: STRING[12]; { BBS phone number } + + LastDate: STRING[10]; { last system date } + + PacketName, { QWK packet name } + BulletPrefix: STRING[8]; { default bulletins filename } + + SysOpPW, { SysOp password } + NewUserPW, { newuser password } + MinBaudOverride, { override minimum baud rate } + QWKNetworkACS, { QWK network REP ACS } + LastOnDatACS, + SOP, { SysOp } + CSOP, { Co-SysOp } + MSOP, { Message SysOp } + FSOP, { File SysOp } + SPW, { SysOp PW at logon } + AddChoice, { Add voting choices acs } + NormPubPost, { make normal public posts } + NormPrivPost, { send normal e-mail } + + AnonPubRead, { see who posted public anon } + AnonPrivRead, { see who sent anon e-mail } + AnonPubPost, { make anon posts } + AnonPrivPost, { send anon e-mail } + + SeeUnval, { see unvalidated files } + DLUnval, { DL unvalidated files } + NoDLRatio, { no UL/DL ratio } + NoPostRatio, { no post/call ratio } + NoFileCredits, { no file credits checking } + ULValReq, { uploads require validation } + TeleConfMCI, { ACS access for MCI codes while teleconfin' } + OverrideChat, { override chat hours } + NetMailACS, { do they have access to netmail? } + Invisible, { Invisible mode? } + FileAttachACS, { ACS to attach files to messages } + ChangeVote, { ACS to change their vote } + UnUsedACS1, + UnUsedACS2: ACString; + + MaxPrivPost, { max email can send per call } + MaxFBack, { max feedback per call } + MaxPubPost, { max posts per call } + MaxChat, { max sysop pages per call } + MaxWaiting, { max mail waiting } + CSMaxWaiting, { max mail waiting for Co-SysOp + } + MaxMassMailList, + MaxLogonTries, { tries allowed for PW's at logon } + SysOpColor, { SysOp color in chat mode } + UserColor, { user color in chat mode } + SliceTimer, + MaxBatchDLFiles, + MaxBatchULFiles, + Text_Color, { color OF standard text } + Quote_Color, { color OF quoted text } + Tear_Color, { color OF tear line } + Origin_Color, { color OF origin line } + BackSysOpLogs, { days to keep SYSOP##.LOG } + EventWarningTime, { minutes before event to warn user } + WFCBlankTime, { minutes before blanking WFC menu } + AlertBeep, { time between alert beeps - Was Integer } + FileCreditComp, { file credit compensation ratio } + FileCreditCompBaseSize, { file credit area compensation size } + ULRefund, { percent OF time to refund on ULs } + GlobalMenu, + AllStartMenu, + ShuttleLogonMenu, + NewUserInformationMenu, + FileListingMenu, + MessageReadMenu, + CurWindow, { type OF SysOp window in use } + SwapTo, { Swap where? } + UnUsedByte1, + UnUsedByte2: Byte; + + lLowTime, { SysOp begin minute (in minutes) } + HiTime, { SysOp END time } + DLLowTime, { normal downloading hours begin.. } + DLHiTime, { ..and END } + MinBaudLowTime, { minimum baud calling hours begin.. } + MinBaudHiTime, { ..and END } + MinBaudDLLowTime, { minimum baud downloading hours begin.. } + MinBaudDLHiTime, { ..and END } + NewApp, { send new user application to # } + TimeOutBell, { minutes before timeout beep } + TimeOut, { minutes before timeout } + ToSysOpDir, { SysOp file area } + CreditMinute, { Credits per minute } + CreditPost, { Credits per post } + CreditEmail, { Credits per Email sent } + CreditFreeTime, { Amount OF "Free" time given to user at logon } + NumUsers, { number OF users } + PasswordChange, { change password at least every x days } + RewardRatio, { % OF file points to reward back } + CreditInternetMail, { cost for Internet mail } + BirthDateCheck, { check user's birthdate every xx logons } + UnUsedInteger1, + UnUsedInteger2: SmallInt; + + MaxQWKTotal, { max msgs in a packet, period } + MaxQWKBase, { max msgs in a area } + DaysOnline, { days online } + UnUsedWord1, + UnUsedWord2: SmallWord; + + MinimumBaud, { minimum baud rate to logon } + MinimumDLBaud, { minimum baud rate to download } + MaxDepositEver, + MaxDepositPerDay, + MaxWithdrawalPerDay, + CallerNum, { system caller number } + RegNumber, { registration number } + TotalCalls, { incase different from callernum } + TotalUsage, { total usage in minutes } + TotalPosts, { total number OF posts } + TotalDloads, { total number OF dloads } + TotalUloads, { total number OF uloads } + MinResume, { min K to allow resume-later } + MaxInTemp, { max K allowed in TEMP } + MinSpaceForPost, { minimum drive space left to post } + MinSpaceForUpload, { minimum drive space left to upload } + UnUsedLongInt1, + UnUsedLongInt2: LongInt; + + AllowAlias, { allow handles? } + PhonePW, { phone number password in logon? } + LocalSec, { use local security? } + GlobalTrap, { trap everyone's activity? } + AutoChatOpen, { automatically open chat buffer? } + AutoMInLogon, { Auto-Message at logon? } + BullInLogon, { bulletins at logon? } + YourInfoInLogon, { "Your Info" at logon? } + OffHookLocalLogon, { phone off-hook for local logons? } + ForceVoting, { manditory voting? } + CompressBases, { "compress" file/msg area numbers? } + SearchDup, { search for dupes files when UL? } + ForceBatchDL, + ForceBatchUL, + LogonQuote, + UserAddQuote, + StripCLog, { strip colors from SysOp log? } + SKludge, { show kludge lines? } + SSeenby, { show SEEN-BY lines? } + SOrigin, { show origin line? } + AddTear, { show tear line? } + ShuttleLog, { Use Shuttle Logon? } + ClosedSystem, { Allow new users? } + SwapShell, { Swap on shell? } + UseEMS, { use EMS for overlay } + UseBios, { use BIOS for video output } + UseIEMSI, { use IEMSI } + ULDLRatio, { use UL/DL ratios? } + FileCreditRatio, { use auto file-credit compensation? } + ValidateAllFiles, { validate files automatically? } + FileDiz, { Search/Import file_id.diz } + SysOpPword, { check for sysop password? } + TrapTeleConf, { Trap teleconferencing to ROOMx.TRP? } + IsTopWindow, { is window at top OF screen? } + ReCompress, { recompress like archives? } + RewardSystem, { use file rewarding system? } + TrapGroup, { record group chats? } + QWKTimeIgnore, { ignore time remaining for qwk download? } + NetworkMode, { Network mode ? } + WindowOn, { is the sysop window on? } + ChatCall, { Whether system keeps beeping after chat} + DailyLimits, { Daily file limits on/off } + MultiNode, { enable multinode support } + PerCall, { time limits are per call or per day?} + TestUploads, { perform integrity tests on uploads? } + UseFileAreaLightBar, + UseMsgAreaLightBar, + UnUsedBoolean1, + UnUsedBoolean2: Boolean; + + FileArcInfo: + ARRAY [1..MaxArcs] OF FileArcInfoRecordType; { archive specs } + + FileArcComment: + ARRAY [1..3] OF STRING[40]; { BBS comment files for archives } + + Aka: ARRAY [0..20] OF + {$IFDEF WIN32} PACKED {$ENDIF} RECORD { 20 Addresses } + Zone, { 21st is for UUCP address } + Net, + Node, + Point: SmallWord; + END; + + NewUserToggles: ARRAY [1..20] OF Byte; + + Macro: ARRAY [0..9] OF STRING[100]; { sysop macros } + + Netattribute: NetAttribs; { default netmail attribute } + + TimeAllow, { time allowance } + CallAllow, { call allowance } + DLRatio, { # ULs/# DLs ratios } + DLKRatio, { DLk/ULk ratios } + PostRatio, { posts per call ratio } + DLOneday, { Max number OF dload files in one day} + DLKOneDay: SecurityRangeType; { Max k downloaded in one day} + END; + + ShortMessageRecordType = { SHORTMSG.DAT : One-line messages } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Msg: AStr; + Destin: SmallInt; + END; + + VotingRecordType = { VOTING.DAT : Voting records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Question1, { Voting Question 1 } + Question2: STRING[60]; { Voting Question 2 } + ACS: ACString; { ACS required to vote on this } + ChoiceNumber: Byte; { number OF choices } + NumVotedQuestion: SmallInt; { number OF votes on it } + CreatedBy: STRING[36]; { who created it } + AddAnswersACS: ACString; { ACS required to add choices } + Answers: ARRAY [1..25] OF + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + Answer1, { answer description } + Answer2: STRING[65]; { answer description #2 } + NumVotedAnswer: SmallInt; { # user's who picked this answer } + END; + END; + + MessageAreaFlagType = + (MARealName, { whether real names are forced } + MAUnHidden, { whether *VISIBLE* to users w/o access } + MAFilter, { whether to filter ANSI/8-bit ASCII } + MAPrivate, { allow private messages } + MAForceRead, { force the reading of this area } + MAQuote, { Allow Quote/Tagline to messages posted in this area } + MASKludge, { strip IFNA kludge lines } + MASSeenBy, { strip SEEN-BY lines } + MASOrigin, { strip origin lines } + MAAddTear, { add tear/origin lines } + MAInternet, { if internet message area } + MAScanOut); { Needs to be scanned out by renemail } + + MAFlagSet = SET OF MessageAreaFlagType; + + MessageAreaRecordType = { MBASES.DAT : Message area records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Name: STRING[40]; { message area description } + FileName: STRING[8]; { HDR/DAT data filename } + MsgPath: STRING[40]; {Not Used} { messages pathname } + ACS, { access requirement } + PostACS, { post access requirement } + MCIACS, { MCI usage requirement } + SysOpACS: ACString; { Message area sysop requirement } + MaxMsgs: SmallWord; { max message count } + Anonymous: AnonTyp; { anonymous type } + Password: STRING[20]; { area password } + MAFlags: MAFlagSet; { message area status vars } + MAType: SmallInt; { Area type (0=Local,1=Echo, 3=Qwk) } + Origin: STRING[50]; { origin line } + Text_Color, { color OF standard text } + Quote_Color, { color OF quoted text } + Tear_Color, { color OF tear line } + Origin_Color, { color OF origin line } + MessageReadMenu: Byte; + QuoteStart, + QuoteEnd: STRING[70]; + PrePostFile: STRING[8]; + AKA: Byte; { alternate address } + QWKIndex: SmallWord; { QWK indexing number } + END; + + FileAreaFlagType = + (FANoRatio, { if active } + FAUnHidden, { whether *VISIBLE* to users w/o access } + FADirDLPath, { if *.DIR file stored in DLPATH } + FAShowName, { show uploaders in listings } + FAUseGIFSpecs, { whether to use GifSpecs } + FACDROM, { Area is read only, no sorting or ul scanning } + FAShowDate, { show date uploaded in listings } + FANoDupeCheck); { No dupe check on this area } + + FAFlagSet = SET OF FileAreaFlagType; + + FileAreaRecordType = { FBASES.DAT : File area records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + AreaName: STRING[40]; { area description } + FileName: STRING[8]; { filename + ".DIR" } + DLPath, { download path } + ULPath: STRING[40]; { upload path } + MaxFiles: SmallInt; { max files allowed - VerbRec Limit would allow up to LongInt Value or Maximum 433835} + Password: STRING[20]; { password required } + ArcType, { wanted archive type (1..max,0=inactive) } + CmtType: Byte; { wanted comment type (1..3,0=inactive) } + ACS, { access requirements } + ULACS, { upload requirements } + DLACS: ACString; { download requirements } + FAFlags: FAFlagSet; { file area status vars } + END; + + FileInfoFlagType = + (FINotVal, { If file is not validated } + FIIsRequest, { If file is REQUEST } + FIResumeLater, { If file is RESUME-LATER } + FIHatched, { Has file been hatched? } + FIOwnerCredited, + FIUnusedFlag1, + FIUnusedFlag2, + FIUnusedFlag3); + + FIFlagSet = SET OF FileInfoFlagType; + + FileInfoRecordType = { *.DIR : File records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + FileName: STRING[12]; { Filename } + Description: STRING[50]; { File description } + FilePoints: SmallInt; { File points } + Downloaded: LongInt; { Number DLs } + FileSize: LongInt; { File size in Bytes } + OwnerNum: SmallInt; { ULer OF file } + OwnerName: STRING[36]; { ULer's name } + FileDate: UnixTime; { Date ULed } + VPointer: LongInt; { Pointer to verbose descr, -1 if none } + VTextSize: SmallInt; { Verbose descr textsize - 50 Bytes x 99 Lines = 4950 max } + FIFlags: FIFlagSet; { File status } + END; + + LastCallerRec = { LASTON.DAT : Last few callers records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Node: Byte; { Node number } + UserName: STRING[36]; { User name OF caller } + Location: STRING[30]; { Location OF caller } + Caller, { system caller number } + UserID, { User ID # } + Speed: LongInt; { Speed OF caller 0=Local } + LogonTime, { time user logged on } + LogoffTime: UnixTime; { time user logged off } + NewUser, { was it a new user? } + Invisible: Boolean; { Invisible user? } + Uploads, { Uploads/Downloads during call } + Downloads, + MsgRead, { Messages Read } + MsgPost, { Messages Posted } + EmailSent, { Email sent } + FeedbackSent: SmallWord; { Feedback sent } + UK, { Upload/Download kbytes during call } + DK: LongInt; + Reserved: ARRAY [1..17] OF Byte; { Reserved } + END; + + EventFlagType = + (EventIsExternal, + EventIsActive, + EventIsErrorLevel, + EventIsShell, + EventIsPackMsgAreas, + EventIsSortFiles, + EventIsFilesBBS, + EventIsLogon, + EventIsChat, + EventIsOffHook, + EventIsMonthly, + EventIsPermission, + EventIsSoft, + EventIsMissed, + BaudIsActive, + ACSIsActive, + TimeIsActive, + ARisActive, + SetARisActive, + ClearARisActive, + InRatioIsActive); + + EFlagSet = SET OF EventFlagType; + + EventDaysType = SET OF 0..6; {Set of event days} + + EventRecordType = {Events - EVENTS.DAT} +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + EventDescription: STRING[30]; {Description of the Event} + EventDayOfMonth: BYTE; {If monthly, the Day of Month} + EventDays: EventDaysType; {If Daily, the Days Active} + EventStartTime, {Start Time in Min from Mid.} + EventFinishTime: SmallWord; {Finish Time} + EventQualMsg, {Msg/Path if he qualifies} + EventNotQualMsg: STRING[64]; {Msg/Path if he doesn't} + EventPreTime: BYTE; {Min. B4 event to rest. Call} + EventNode: Byte; + EventLastDate: UnixTime; {Last Date Executed} + EventErrorLevel: BYTE; {For Ext Event ErrorLevel} + EventShellPath: STRING[8]; {File for Ext Event Shell} + LoBaud, {Low baud rate limit} + HiBaud: LongInt; {High baud rate limit} + EventACS: ACString; {Event ACS} + MaxTimeAllowed: SmallWord; {Max Time per user this event} + SetARflag, {AR Flag to Set} + ClearARflag: CHAR; {AR Flag to Clear} + EFlags: EFlagSet; {Kinds of Events Supported} { Changed } + END; + + ProtocolFlagType = + (ProtActive, + ProtIsBatch, + ProtIsResume, + ProtXferOkCode, + ProtBiDirectional, + ProtReliable); + + PRFlagSet = SET OF ProtocolFlagType; + + ProtocolCodeType = ARRAY [1..6] OF STRING[6]; + + ProtocolRecordType = { PROTOCOL.DAT records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + PRFlags: PRFlagSet; { Protocol Flags } + CKeys: STRING[14]; { Command Keys } + Description: STRING[40]; { Description } + ACS: ACString; { User Access STRING } + TempLog, { Utilized for Batch DL's - Temporary Log File } + DLoadLog, { Utilized for Batch DL's - Permanent Log Files } + ULoadLog, { Not Utilized } + DLFList: STRING[25]; { Utilized for Batch DL's - DL File Lists } + DLCmd, { DL Command Line } + ULCmd: STRING[76]; { UL Command Line } + DLCode, { DL Status/Return codes } + ULCode: ProtocolCodeType; { UL StAtus/Return codes } + EnvCmd: STRING[60]; { Environment Setup Cmd } + MaxChrs, { Utilized for Batch DL's - Max chrs in cmdline } + TempLogPF, { Utilized for Batch DL's - Position in log for DL Status } + TempLogPS: Byte; { Utilized for Batch DL's - Position in log for file data } + END; + + ConferenceRecordType = { CONFRENC.DAT : Conference data } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Key: Char; { key '@' to 'Z' } + Name: STRING[30]; { name of conference } + ACS: ACString; { access requirement } + END; + + NodeFlagType = + (NActive, { Is this node active? } + NAvail, { Is this node's user available? } + NUpdate, { This node should re-read it's user } + NHangup, { Hangup on this node } + NRecycle, { Recycle this node to the OS } + NInvisible); { This node is Invisible } + + NodeFlagSet = SET OF NodeFlagType; + + NodeRecordType = { MULTNODE.DAT } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + User: SmallWord; { What user number } + UserName: STRING[36]; { User's name } + CityState: STRING[30]; { User's location } + Sex: Char; { User's sex } + Age: Byte; { User's age } + LogonTime: UnixTime; { What time they logged on } + GroupChat: Boolean; { Are we in MultiNode Chat } + ActivityDesc: STRING[50]; { Activity STRING } + Status: NodeFlagSet; + Room: Byte; { What room are they in? } + Channel: SmallWord; { What channel are they in? } + Invited, { Have they been invited ? } + Booted, { Have they been kicked off ? } + Forget: ARRAY [0..31] OF SET OF 0..7; { Who are they forgetting? } + END; + + RoomRec = { ROOM.DAT } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Topic: STRING[40]; { Topic OF this room } + Anonymous: Boolean; { Is Room anonymous ? } + Private: Boolean; { Is Room private ? } + Occupied: Boolean; { Is anyone in here? } + Moderator: SmallWord; { Who's the moderator? } + END; + + ScanRec = { *.SCN files / MESSAGES } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + NewScan: Boolean; { Scan this area? } + LastRead: UnixTime; { Last date read } + END; + + SchemeRec = { Scheme.dat } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Description: STRING[30]; { Description OF the color scheme } + Color: ARRAY [1..200] OF Byte; { Colors in scheme } + END; + + { 1 - 10 system colors + 11 - file list colors + 28 - msg list colors + 45 - file area list colors + 55 - msg area list colors + 65 - user list colors + 80 - who's online colors + 100- last on colors + 115- qwk colors + 135- email colors + } + + BBSListRecordType = { *.BBS file records } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + RecordNum, { Number OF the Record For Edit } + UserID, { User ID OF person adding this } + MaxNodes : LongInt; { Maximum Number Of Nodes } + Port : Word; { Telnet Port } + BBSName : STRING[30]; { Name OF BBS } + SysOpName : STRING[30]; { SysOp OF BBS } + TelnetUrl : STRING[60]; { Telnet Urls } + WebSiteUrl : STRING[60]; { Web Site Url } + PhoneNumber : STRING[20]; { Phone number OF BBS } + Location : STRING[30]; { Location of BBS } + Software, { Software used by BBS } + SoftwareVersion : String[12]; { Software Version of BBS } + OS : STRING[20]; { Operating System of BBS } + Speed : STRING[8]; { Highest connect speed OF BBS } + Hours : STRING[20]; { Hours of Operation } + Birth : STRING[10]; { When the BBS Began } + Description : STRING[60]; { Description OF BBS } + Description2 : STRING[60]; { Second line OF descrition } + DateAdded : UnixTime; { Date entry was added } + DateEdited : UnixTime; { Date entry was last edited } + SDA : STRING[8]; { sysop definable A } + SDB : STRING[30]; { sysop definable B } + SDC : STRING[30]; { sysop definable C } + SDD : STRING[40]; { sysop definable D } + SDE : STRING[60]; { sysop definable E } + SDF : STRING[60]; { sysop definable F } + SDG : Word; { sysop definable G } + SDH, { sysop definable H } + SDI : Boolean; { sysop definable I } + + END; + + MenuFlagType = + (ClrScrBefore, { C: clear screen before menu display } + DontCenter, { D: don't center the menu titles! } + NoMenuTitle, { T: no menu title displayed } + NoMenuPrompt, { N: no menu prompt whatsoever? } + ForcePause, { P: force a pause before menu display? } + AutoTime, { A: is time displayed automatically? } + ForceLine, { F: Force full line input } + NoGenericAnsi, { 1: DO NOT generate generic prompt if ANSI } + NoGenericAvatar, { 2: DO NOT generate generic prompt if AVT } + NoGenericRIP, { 3: DO NOT generate generic prompt if RIP } + NoGlobalDisplayed, { 4: DO NOT display the global commands! } + NoGlobalUsed); { 5: DO NOT use global commands! } + + MenuFlagSet = SET OF MenuFlagType; + + CmdFlagType = + (Hidden, { H: is command ALWAYS hidden? } + UnHidden); { U: is command ALWAYS visible? } + + CmdFlagSet = SET OF CmdFlagType; + + MenuRec = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + LDesc: ARRAY [1..3] OF STRING[100]; { Menu Or Command Long Description ARRAY } + ACS: ACString; { Access Requirements } + NodeActivityDesc: STRING[50]; + CASE Menu: Boolean OF { Menu Or Command - Variant section} + TRUE: + (MenuFlags: MenuFlagSet; { Menu Flag SET } + LongMenu: STRING[12]; { Displayed In Place OF Long Description } + MenuNum: Byte; { Menu Number } + MenuPrompt: STRING[120]; { Menu Prompt } + Password: STRING[20]; { Menu Password } + FallBack: Byte; { Menu Fallback Number } + Directive: STRING[12]; + ForceHelpLevel: Byte; { Menu Forced Help Level } + GenCols: Byte; { Generic Menus: # OF Columns } + GCol: ARRAY [1..3] OF Byte); { Generic Menus: Colors } + FALSE: + (CmdFlags: CmdFlagSet; { Command Flag SET } + SDesc: STRING[35]; { Command Short Description } + CKeys: STRING[14]; { Command Execution Keys } + CmdKeys: STRING[2]; { Command Keys: Type OF Command } + Options: STRING[50]); { MString: Command Data } + END; diff --git a/SOURCE/RENEGADE.PAS b/SOURCE/RENEGADE.PAS new file mode 100644 index 0000000..2bae2ea --- /dev/null +++ b/SOURCE/RENEGADE.PAS @@ -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. diff --git a/SOURCE/RENEGADE.bak b/SOURCE/RENEGADE.bak new file mode 100644 index 0000000..dc6d456 --- /dev/null +++ b/SOURCE/RENEGADE.bak @@ -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. diff --git a/SOURCE/RENEMAIL.PAS b/SOURCE/RENEMAIL.PAS new file mode 100644 index 0000000..93d77d1 --- /dev/null +++ b/SOURCE/RENEMAIL.PAS @@ -0,0 +1,2218 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$IFDEF MSDOS} +{$M 49152,0,65536} +{$ENDIF} +{$A+,I-,E-,F+} + +PROGRAM ReneMail; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +CONST + Activity_Log: Boolean = FALSE; + NetMailOnly: Boolean = FALSE; + IsNetMail: Boolean = FALSE; +{$IFDEF MSDOS} + FastPurge: Boolean = TRUE; +{$ENDIF} +{$IFDEF WIN32} + FastPurge: Boolean = FALSE; +{$ENDIF} + Process_NetMail: Boolean = TRUE; + Purge_NetMail: Boolean = TRUE; + Absolute_Scan: Boolean = FALSE; + Ignore_1Msg: Boolean = TRUE; + Toss_Mail: Boolean = FALSE; + Scan_Mail: Boolean = FALSE; + Purge_Dir: Boolean = FALSE; + +TYPE + FidoRecordType = RECORD + FromUserName: STRING[35]; + ToUserName: STRING[35]; + Subject: STRING[71]; + DateTime: STRING[19]; + TimesRead: Word; + DestNode: Word; + OrigNode: Word; + Cost: Word; + OrigNet: Word; + DestNet: Word; + Filler: ARRAY[1..8] OF Char; + ReplyTo: Word; + Attribute: Word; + NextReply: Word; + END; + + BufferArrayType = ARRAY[1..32767] OF Char; + +VAR + FCB: ARRAY[1..37] OF Char; + + BufferArray: BufferArrayType; + + GeneralFile: FILE OF GeneralRecordType; + + UserFile: FILE OF UserRecordType; + + MessageAreaFile: FILE OF MessageAreaRecordType; + + IndexFile: FILE OF UserIDXRec; + + RGMsgHdrFile: FILE OF MHeaderRec; + + RGMsgTxtFile: FILE; + + FidoFile: FILE; + + HiWaterF: FILE OF SmallWord; + + General: GeneralRecordType; + + User: UserRecordType; + + MemMsgArea: MessageAreaRecordType; + + IndexR: UserIDXRec; + + RGMsgHdr: MHeaderRec; + + FidoMsgHdr: FidoRecordType; + +{$IFDEF MSDOS} + Regs: Registers; +{$ENDIF} + + DirInfo: SearchRec; + + TempParamStr, + StartDir: STRING; + + LastError, + ParamCounter, + MsgArea: Integer; + + ParamFound: Boolean; + +{$IFDEF WIN32} +(* REENOTE + In BP/TP you can do this: + + var + MySet: NetAttribs; + MyWord: Word; + begin + MySet := [Private, Crash]; + MyWord := Word(MySet); + { MyWord now contains the value 3 in BP/TP } + { but VP refuses to compile the code due to Word(MySet) } + end; + + In VP this typecast isn't allowed (maybe there's a compiler setting to allow it, didn't look actually) + so this function converts from a set to a word type. + + While this function should work for both BP/TP and for VP, I'm only using it for VP and using the + original cast for BP/TP, since there's no need to change what isn't broken +*) +function NetAttribsToWord(inSet: NetAttribs): Word; +var + Result: Word; +begin + Result := 0; + if (Private in inSet) then result := result + 1; + if (Crash in inSet) then result := result + 2; + if (Recd in inSet) then result := result + 4; + if (NSent in inSet) then result := result + 8; + if (FileAttach in inSet) then result := result + 16; + if (Intransit in inSet) then result := result + 32; + if (Orphan in inSet) then result := result + 64; + if (KillSent in inSet) then result := result + 128; + if (Local in inSet) then result := result + 256; + if (Hold in inSet) then result := result + 512; + if (Unused in inSet) then result := result + 1024; + if (FileRequest in inSet) then result := result + 2048; + if (ReturnReceiptRequest in inSet) then result := result + 4096; + if (IsReturnReceipt in inSet) then result := result + 8192; + if (AuditRequest in inSet) then result := result + 16384; + if (FileUpdateRequest in inSet) then result := result + 32768; + NetAttribsToWord := Result; +end; +{$ENDIF} + +FUNCTION CenterStr(S: STRING): STRING; +VAR + Counter1: Byte; +BEGIN + Counter1 := ((80 - Length(S)) DIV 2); + Move(S[1],S[Counter1 + 1],Length(S)); + Inc(S[0],Counter1); + FillChar(S[1],Counter1,#32); + CenterStr := S; +END; + +PROCEDURE WriteCharXY(C: Char; X,Y,FColor,BColor: Byte); +BEGIN + TextColor(FColor); + TextBackGround(BColor); + GotoXY(X,Y); + Write(C); +END; + +PROCEDURE WriteStrXY(S: STRING; X,Y,FColor,BColor: Byte); +BEGIN + TextColor(FColor); + TextBackGround(BColor); + GotoXY(X,Y); + Write(S); +END; + +PROCEDURE DisplayMain(FColor,BColor: Byte); +VAR + X, + Y: Byte; +BEGIN + ClrScr; + Window(1,1,80,24); + TextColor(FColor); + TextBackGround(BColor); + ClrScr; + Window(1,1,80,25); + WriteCharXY(#201,1,1,FColor,BColor); + FOR X := 2 TO 79 DO + WriteCharXY(#205,X,1,FColor,BColor); + WriteCharXY(#187,80,1,FColor,BColor); + FOR Y := 2 TO 3 DO + BEGIN + WriteCharXY(#186,1,Y,FColor,BColor); + WriteCharXY(#186,80,Y,FColor,BColor); + END; + WriteCharXY(#204,1,4,FColor,BColor); + FOR X := 2 TO 79 DO + WriteCharXY(#205,X,4,FColor,BColor); + WriteCharXY(#185,80,4,FColor,BColor); + WriteStrXY(CenterStr('Renegade Echomail Interface v'+Ver),2,2,FColor,BColor); + WriteStrXY(CenterStr('Copyright 2004-2011 - The Renegade Developement Team'),2,3,FColor,BColor); + FOR Y := 5 TO 21 DO + BEGIN + WriteCharXY(#186,1,Y,FColor,BColor); + WriteCharXY(#186,80,Y,FColor,BColor); + END; + WriteCharXY(#204,1,22,FColor,BColor); + FOR X := 2 TO 79 DO + WriteCharXY(#205,X,22,FColor,BColor); + WriteCharXY(#185,80,22,FColor,BColor); + WriteCharXY(#186,1,23,FColor,BColor); + WriteStrXY('Message: None',3,23,FColor,BColor); + WriteCharXY(#186,80,23,FColor,BColor); + WriteCharXY(#200,1,24,FColor,BColor); + FOR X := 2 TO 79 DO + WriteCharXY(#205,X,24,FColor,BColor); + WriteCharXY(#188,80,24,FColor,BColor); + Window(2,5,78,21); + GoToXY(1,1); +END; + +PROCEDURE DisplayHelp(FColor,BColor: Byte); +BEGIN + WriteStrXY('Commands: -T Toss incoming messages',22,2,FColor,BColor); + WriteStrXY('-P Purge echomail dirs',33,3,FColor,BColor); + WriteStrXY('-S Scan outbound messages',33,4,FColor,BColor); + WriteStrXY('Options: -A Absolute Scan',22,6,FColor,BColor); + WriteStrXY('-D Do not delete netmail',37,7,FColor,BColor); + WriteStrXY('-F No fast purge',37,8,FColor,BColor); + WriteStrXY('-I Import 1.MSG',37,9,FColor,BColor); + WriteStrXY('-L Activity logging',37,10,FColor,BColor); + WriteStrXY('-N No netmail',37,11,FColor,BColor); + WriteStrXY('-O Only netmail',37,12,FColor,BColor); +END; + +PROCEDURE ErrorStrXY(S: STRING; X,Y,FColor,BColor: Byte); +VAR + SaveX, + SaveY: Byte; +BEGIN + SaveX := WhereX; + SaveY := WhereY; + Window(1,1,80,25); + GoToXY(X,Y); + TextColor(FColor); + TextBackGround(BColor); + Write(S); + Window(2,5,78,21); + GoToXY(SaveX,SaveY); +END; + +PROCEDURE HaltErrorStrXY(S: STRING; X,Y,FColor,BColor,HaltNum: Byte); +BEGIN + DisplayHelp(White,Blue); + Window(1,1,80,25); + GoToXY(X,Y); + TextColor(FColor); + TextBackGround(BColor); + Write(S); + GotoXY(1,25); + Halt(HaltNum); +END; + +PROCEDURE LogActivity(ActivityMsg: STRING); +VAR + ActivityFile: Text; +BEGIN + IF (Activity_Log) THEN + BEGIN + Assign(ActivityFile,General.LogsPath+'RENEMAIL.LOG'); + {$I-} Append(ActivityFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + {$I-} ReWrite(ActivityFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + ErrorStrXY('Unable to create RENEMAIL.LOG.',12,23,Red + 128,Blue); + END; + {$I-} Write(ActivityFile,ActivityMsg); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + ErrorStrXY('Unable to write to RENEMAIL.LOG.',12,23,Red + 128,Blue); + {$I-} Close(ActivityFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + ErrorStrXY('Unable to close RENEMAIL.LOG.',12,23,Red + 128,Blue); + END; +END; + +PROCEDURE LogError(ErrMsg: STRING); +VAR + ErrorFile: Text; +BEGIN + Assign(ErrorFile,General.LogsPath+'RENEMAIL.ERR'); + {$I-} Append(ErrorFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + {$I-} ReWrite(ErrorFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + ErrorStrXY('Unable to create RENEMAIL.ERR.',12,23,Red + 128,Blue); + END; + {$I-} WriteLn(ErrorFile,ToDate8(DateStr)+' '+TimeStr+': '+ErrMsg); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + ErrorStrXY('Unable to write to RENEMAIL.ERR.',12,23,Red + 128,Blue); + {$I-} Close(ErrorFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + ErrorStrXY('Unable to close RENEMAIL.ERR.',12,23,Red + 128,Blue); +END; + +FUNCTION SC(S: STRING; I: Integer): Char; +BEGIN + SC := UpCase(S[I]); +END; + +FUNCTION Hex(L: LongInt; B: Byte): STRING; +CONST + HC: ARRAY[0..15] OF Char = '0123456789ABCDEF'; +VAR + One, + Two, + Three, + Four: Byte; +BEGIN + One := (L AND $000000FF); + Two := ((L AND $0000FF00) SHR 8); + Three := ((L AND $00FF0000) SHR 16); + Four := ((L AND $FF000000) SHR 24); + Hex[0] := Chr(B); + IF (B = 4) THEN + BEGIN + Hex[1] := HC[Two SHR 4]; + Hex[2] := HC[Two AND $F]; + Hex[3] := HC[One SHR 4]; + Hex[4] := HC[One AND $F]; + END + ELSE + BEGIN + Hex[8] := HC[One AND $F]; + Hex[7] := HC[One SHR 4]; + Hex[6] := HC[Two AND $F]; + Hex[5] := HC[Two SHR 4]; + Hex[4] := HC[Three AND $F]; + Hex[3] := HC[Three SHR 4]; + Hex[2] := HC[Four AND $F]; + Hex[1] := HC[Four SHR 4]; + END; +END; + +FUNCTION SQOutSp(S: STRING): STRING; +BEGIN + WHILE (Pos(' ',S) > 0) DO + Delete(S,Pos(' ',S),1); + SQOutSp := S; +END; + +FUNCTION BSlash(S: STRING; B: Boolean): STRING; +BEGIN + IF (B) THEN + BEGIN + WHILE (Copy(S,(Length(S) - 1),2) = '\\') DO + S := Copy(S,1,(Length(S) - 2)); + IF (Copy(S,Length(S),1) <> '\') THEN + S := S + '\'; + END + ELSE + WHILE (S[Length(S)] = '\') DO + Dec(S[0]); + BSlash := S; +END; + +FUNCTION ExistDir(Dir: STRING): Boolean; +BEGIN + WHILE (Dir[Length(Dir)] = '\') DO + Dec(Dir[0]); + FindFirst(Dir,AnyFile,DirInfo); + ExistDir := (DOSError = 0) AND (DirInfo.Attr AND $10 = $10); +END; + +FUNCTION ExistFile(FileName: STRING): Boolean; +BEGIN + FindFirst(SQOutSp(FileNAme),AnyFile,DirInfo); + ExistFile := (DOSError = 0); +END; + +(* +PROCEDURE MakeDir(Dir: STRING); +VAR + Counter: Integer; +BEGIN + Dir := BSlash(Dir,TRUE); + IF (Length(Dir) > 3) AND (NOT ExistDir(Dir)) THEN + BEGIN + Counter := 2; + WHILE (Counter <= Length(Dir)) DO + BEGIN + IF (Dir[Counter] = '\') THEN + IF (Dir[Counter - 1] <> ':') THEN + IF (NOT ExistDir(Copy(Dir,1,(Counter - 1)))) THEN + BEGIN + MkDir(Copy(Dir,1,(Counter - 1))); + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + WriteLn('Error creating message path: '+Copy(Dir,1,(Counter - 1))); + LogError(Copy(Dir,1,(Counter - 1))+'/ '); + Halt(1); + END; + END; + Inc(Counter); + END; + END; +END; +*) + +{$IFDEF MSDOS} +FUNCTION AOnOff(B: Boolean; S1,S2: STRING): STRING; ASSEMBLER; +ASM + PUSH ds + Test b, 1 + JZ @@1 + LDS si, s1 + JMP @@2 + @@1: LDS si, s2 + @@2: LES di, @Result + XOR Ch, Ch + MOV cl, Byte ptr ds:[si] + MOV Byte ptr es:[di], cl + Inc di + Inc si + CLD + REP MOVSB + POP ds +END; +{$ENDIF} +{$IFDEF WIN32} +FUNCTION AOnOff(B: Boolean; S1,S2: STRING): STRING; +BEGIN + if (B) then + AOnOff := S1 + else + AOnOff := S2; +END; +{$ENDIF} + +FUNCTION StripName(S: STRING): STRING; +VAR + Counter: Integer; +BEGIN + Counter := Length(S); + WHILE (Counter > 0) AND (Pos(S[Counter],':\/') = 0) DO + Dec(Counter); + Delete(S,1,Counter); + StripName := S; +END; + +FUNCTION AllCaps(S: STRING): STRING; +VAR + Counter: Integer; +BEGIN + AllCaps[0] := s[0]; + FOR Counter := 1 TO Length(S) DO + AllCaps[Counter] := UpCase(S[Counter]); +END; + +FUNCTION Caps(S: STRING): STRING; +VAR + Counter: Integer; +BEGIN + FOR Counter := 1 TO Length(s) DO + IF (S[Counter] IN ['A'..'Z']) THEN + S[Counter] := Chr(Ord(S[Counter]) + 32); + FOR Counter := 1 TO Length(S) DO + IF (NOT (S[Counter] IN ['A'..'Z','a'..'z',Chr(39)])) THEN + IF (S[Counter + 1] IN ['a'..'z']) THEN + S[Counter + 1] := UpCase(S[Counter + 1]); + S[1] := UpCase(S[1]); + Caps := S; +END; + +FUNCTION StrToInt(S: STRING): LongInt; +VAR + I: Integer; + L: LongInt; +BEGIN + Val(S,L,I); + IF (I <> 0) THEN + BEGIN + S[0] := Chr(I - 1); + Val(S,L,I) + END; + StrToInt := L; + IF (S = '') THEN + StrToInt := 0; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING; +BEGIN + Str(L,S); + IntToStr := S; +END; + +FUNCTION PadRightStr(S: STRING; Len: Byte): STRING; +VAR + X, + Counter: Byte; +BEGIN + X := Length(S); + FOR Counter := X TO (Len - 1) DO + S := ' ' + S; + PadRightStr := S; +END; + +FUNCTION StripColor(MAFlags: MAFlagSet; InStr: STRING): STRING; +VAR + OutStr: STRING; + Counter, + Counter1: Byte; +BEGIN + Counter := 0; + OutStr := ''; + WHILE (Counter < Length(InStr)) DO + BEGIN + Inc(Counter); + CASE InStr[Counter] OF + #128..#255 : + IF (MAFilter IN MAFlags) THEN + OutStr := OutStr + Chr(Ord(InStr[Counter]) AND 128) + ELSE + OutStr := OutStr + InStr[Counter]; + '^' : IF InStr[Counter + 1] IN [#0..#9,'0'..'9'] THEN + Inc(Counter) + ELSE + OutStr := OutStr + '^'; + '|' : IF (MAFilter IN MAFlags) AND (InStr[Counter + 1] IN ['0'..'9']) THEN + BEGIN + Counter1 := 0; + WHILE (InStr[Counter + 1] IN ['0'..'9']) AND (Counter <= Length(InStr)) AND (Counter1 <= 2) DO + BEGIN + Inc(Counter); + Inc(Counter1) + END + END + ELSE + OutStr := OutStr + '|' + ELSE + OutStr := OutStr + InStr[Counter]; + END; + END; + StripColor := OutStr; +END; + +FUNCTION UseName(B: Byte; S: STRING): STRING; +BEGIN + CASE b OF + 1,2 + : S := 'Anonymous'; + 3 : S := 'Abby'; + 4 : S := 'Problemed Person'; + END; + UseName := S; +END; + +FUNCTION SearchUser(GenDataPath: STRING; Uname: STRING): Integer; +VAR + Current: Integer; + Done: Boolean; +BEGIN + Assign(IndexFile,GenDataPath+'USERS.IDX'); + {$I-} Reset(IndexFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to open USERS.IDX.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.IDX/Open File Error - '+IntToStr(LastError)+' (Proc: SearchUser)'); + Exit; + END; + Uname := AllCaps(UName); + Current := 0; + Done := FALSE; + IF (FileSize(IndexFile) > 0) THEN + REPEAT + {$I-} Seek(IndexFile,Current); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in USERS.IDX.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.IDX/Seek Record '+IntTostr(Current)+' Error - '+IntToStr(LastError)+' (Proc: SearchUser)'); + Exit; + END; + {$I-} Read(IndexFile,IndexR); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to read record from USERS.IDX.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.IDX/Read Record '+IntTostr(Current)+' Error - '+IntToStr(LastError)+' (Proc: SearchUser)'); + Exit; + END; + IF (Uname < IndexR.Name) THEN + Current := IndexR.Left + ELSE IF (Uname > IndexR.Name) THEN + Current := IndexR.Right + ELSE + Done := TRUE; + UNTIL (Current = -1) OR (Done); + {$I-} Close(IndexFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close USERS.IDX.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.IDX/Close File Error - '+IntToStr(LastError)+' (Proc: SearchUser)'); + Exit; + END; + IF (Done) AND (NOT IndexR.Deleted) THEN + SearchUser := IndexR.Number + ELSE + SearchUser := 0; +END; + +PROCEDURE GetGeneral(VAR General1: GeneralRecordType); +BEGIN + Assign(GeneralFile,'RENEGADE.DAT'); + {$I-} Reset(GeneralFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError('RENEGADE.DAT/Open File Error - '+IntToStr(LastError)+' (Proc: GetGeneral)'); + HaltErrorStrXY('Unable to open RENEGADE.DAT!',12,23,Red + 128,Blue,1); + END; + {$I-} Seek(GeneralFile,0); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError('RENEGADE.DAT/Seek Record 0 Error - '+IntToStr(LastError)+' (Proc: GetGeneral)'); + HaltErrorStrXY('Unable to seek record in RENEGADE.DAT!',12,23,Red + 128,Blue,1); + END; + {$I-} Read(GeneralFile,General1); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError('RENEGADE.DAT/Read Record 0 Error - '+IntToStr(LastError)+' (Proc: GetGeneral)'); + HaltErrorStrXY('Unable to read record from RENEGADE.DAT!',12,23,Red + 128,Blue,1); + END; + {$I-} Close(GeneralFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError('RENEGADE.DAT/Close File Error - '+IntToStr(LastError)+' (Proc: GetGeneral)'); + HaltErrorStrXY('Unable to close RENEGADE.DAT!',12,23,Red + 128,Blue,1); + END; +END; + +PROCEDURE GeneralPaths(General1: GeneralRecordType); +BEGIN + IF (NOT ExistDir(General1.DataPath)) THEN + BEGIN + LogError(General1.DataPath+'/Data Path - "Invalid" (Proc: GeneralPaths)'); + HaltErrorStrXY('The system configuration data path is invalid!',12,23,Red + 128,Blue,1); + END; + IF (NOT ExistDir(General1.NetMailPath)) THEN + BEGIN + LogError(General1.NetMailPath+'/NetMail Path - "Invalid" (Proc: GeneralPaths)'); + HaltErrorStrXY('The system configuration netmail path is invalid!',12,23,Red + 128,Blue,1); + END; + IF (NOT ExistDir(General1.MsgPath)) THEN + BEGIN + LogError(General1.MsgPath+'/Message Path - "Invalid" (Proc: GeneralPaths)'); + HaltErrorStrXY('The system configuration message path is invalid!',12,23,Red + 128,Blue,1); + END; + IF (NOT ExistDir(General1.LogsPath)) THEN + BEGIN + LogError(General1.LogsPath+'/Log Path - "Invalid" (Proc: GeneralPaths)'); + HaltErrorStrXY('The system configuration log path is invalid!',12,23,Red + 128,Blue,1); + END; +END; + +PROCEDURE GeneralFiles(General1: GeneralRecordType); +BEGIN + IF (NOT ExistFile(General1.DataPath+'USERS.DAT')) THEN + BEGIN + LogError(General1.DataPath+'USERS.DAT/File - "Missing" (Proc: GeneralFiles)'); + HaltErrorStrXY('Unable to locate USERS.DAT!',12,23,Red + 128,Blue,1); + END; + IF (NOT ExistFile(General1.DataPath+'USERS.IDX')) THEN + BEGIN + LogError(General1.DataPath+'USERS.IDX/File - "Missing" (Proc: GeneralFiles)'); + HaltErrorStrXY('Unable to locate USERS.IDX!',12,23,Red + 128,Blue,1); + END; + IF (NOT ExistFile(General1.DataPath+'MBASES.DAT')) THEN + BEGIN + LogError(General1.DataPath+'MBASES.DAT/File - "Missing" (Proc: GeneralFiles)'); + HaltErrorStrXY('Unable to locate MBASES.DAT!',12,23,Red + 128,Blue,1); + END; +END; + +(* +PROCEDURE MessageFile(General1: GeneralRecordType); +VAR + MArea: Integer; +BEGIN + Assign(MessageAreaFile,General1.DataPath+'MBASES.DAT'); + {$I-} Reset(MessageAreaFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to open MBASES.DAT.'); + TextColor(LightGray); + LogError(General1.DataPath+'MBASES.DAT/Open File Error - '+IntToStr(LastError)+' (Proc: MessageFile)'); + Halt(1); + END; + MArea := 1; + WHILE (MArea <= (FileSize(MessageAreaFile))) DO + BEGIN + {$I-} Seek(MessageAreaFile,(MArea - 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in MBASES.DAT.'); + TextColor(LightGray); + LogError(General1.DataPath+'MBASES.DAT/Seek Record '+IntToStr(MArea - 1)+' Error - '+IntToStr(LastError)+ + ' (Proc: MessageFile)'); + Halt(1); + END; + {$I-} Read(MessageAreaFile,MemMsgArea); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to read record from MBASES.DAT.'); + TextColor(LightGray); + LogError(General1.DataPath+'MBASES.DAT/Read Record '+IntToStr(MArea - 1)+' Error - '+IntToStr(LastError)+ + ' (Proc: MessageFile)'); + Halt(1); + END; + IF (MemMsgArea.MAType = 1) THEN + BEGIN + IF (NOT ExistDir(MemMsgArea.MsgPath)) THEN + + END; + Inc(MArea); + END; + {$I-} Close(MessageAreaFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close MBASES.DAT.'); + TextColor(LightGray); + LogError(General1.DataPath+'MBASES.DAT/Close File Error - '+IntToStr(LastError)+' (Proc: MessageFile)'); + Halt(1); + END; +END; +*) + +PROCEDURE GetMsgLst(MemMsgPath: STRING; VAR LowMsg,HighMsg: Word); +VAR + FidoMsgNum, + HiWater: Word; +BEGIN + HiWater := 1; + IF (NOT IsNetMail) THEN + BEGIN + Assign(HiWaterF,MemMsgPath+'HI_WATER.MRK'); + {$I- } Reset(HiWaterF); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + {$I-} ReWrite(HiWaterF); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to create '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/ReWrite File Error - '+IntToStr(LastError)+' (Proc: GetMsgList)'); + Exit; + END; + {$I-} Write(HiWaterF,HiWater); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to write record to '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/Write Record 0 Error - '+IntToStr(LastError)+' (Proc: GetMsgList)'); + Exit; + END; + END + ELSE + BEGIN + {$I-} Read(HiWaterF,HiWater); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to read record from '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/Read Record 0 Error - '+IntToStr(LastError)+' (Proc: GetMsgList)'); + Exit; + END; + FindFirst(MemMsgPath+IntToStr(HiWater)+'.MSG',AnyFile,DirInfo); + IF (DOSError <> 0) THEN + HiWater := 1; + END; + {$I-} Close(HiWaterF); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/Close File Error - '+IntToStr(LastError)+' (Proc: GetMsgList)'); + Exit; + END; + END; + HighMsg := 1; + LowMsg := 65535; + FindFirst(MemMsgPath+'*.MSG',AnyFile,DirInfo); + WHILE (DOSError = 0) DO + BEGIN + FidoMsgNum := StrToInt(DirInfo.Name); + IF (FidoMsgNum < LowMsg) THEN + LowMsg := FidoMsgNum; + IF (FidoMsgNum > HighMsg) THEN + HighMsg := FidoMsgNum; + FindNext(DirInfo); + END; + IF (HiWater <= HighMsg) THEN + IF (HiWater > 1) THEN + LowMsg := (HiWater + 1); + IF (Ignore_1Msg) THEN + IF (LowMsg = 1) AND (HighMsg > 1) THEN + LowMsg := 2; +END; + +PROCEDURE UpdateHiWater(MemMsgPath: STRING; HighWater: Word); +BEGIN + Assign(HiWaterF,MemMsgPath+'HI_WATER.MRK'); + {$I-} ReWrite(HiWaterF); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to create '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/ReWrite File Error - '+IntToStr(LastError)+' (Proc: UpdateHiWater)'); + Exit; + END; + {$I-} Write(HiWaterF,HighWater); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to write record to '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/Write Record 0 Error - '+IntToStr(LastError)+' (Proc: UpdateHiWater)'); + Exit; + END; + {$I-} Close(HiWaterF); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+MemMsgPath+'HI_WATER.MRK.'); + TextColor(LightGray); + LogError(MemMsgPath+'HI_WATER.MRK/Close File Error - '+IntToStr(LastError)+' (Proc: UpdateHiWater)'); + Exit; + END; +END; + +PROCEDURE PurgeDir(MemMsgPath: STRING); +VAR + TotalMsgsProcessed: Word; + Purged: Boolean; +BEGIN + TotalMsgsProcessed := 0; + IF (FastPurge) THEN + BEGIN + Randomize; + FillChar(FCB,SizeOf(FCB),' '); + FCB[1] := Chr(Ord(StartDir[1]) - 64); + FCB[2] := '*'; + FCB[10] := 'M'; + FCB[11] := 'S'; + FCB[12] := 'G'; + ChDir(Copy(MemMsgPath,1,Length(MemMsgPath) - 1)); + IF (IOResult <> 0) THEN + Exit; + IF (MemMsgPath[2] = ':') THEN + FCB[1] := Chr(Ord(MemMsgPath[1]) - 64) + ELSE + FCB[1] := Chr(Ord(StartDir[1]) - 64); +{$IFDEF MSDOS} + Regs.DS := Seg(FCB); + Regs.DX := Ofs(FCB); + Regs.AX := $1300; + MSDOS(Regs); + Purged := (Lo(Regs.AX) = 0); +{$ENDIF} +{$IFDEF WIN32} + // We ensure FastPurge is false in Win32, so this is never called +{$ENDIF} + END + ELSE + BEGIN + Purged := TRUE; + FindFirst(MemMsgPath+'*.MSG',AnyFile,DirInfo); + IF (DOSError <> 0) THEN + Purged := FALSE + ELSE + BEGIN + WHILE (DOSError = 0) DO + BEGIN + Assign(FidoFile,MemMsgPath+DirInfo.Name); + {$I-} Erase(FidoFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to erase '+MemMsgPath+DirInfo.Name); + TextColor(LightGray); + LogError(MemMsgPath+DirInfo.Name+'/Erase File Error - '+IntToStr(LastError)+ + ' (Proc: PurgeDir)'); + END; + FindNext(DirInfo); + Inc(TotalMsgsProcessed); + END; + END; + END; + IF (NOT Purged) THEN + BEGIN + LogActivity('No Messages!'^M^J); + Write('No messages!') + END + ELSE + BEGIN + IF (FastPurge) THEN + BEGIN + LogActivity('Fast purged!'^M^J); + Write('Fast purged!'); + END + ELSE + BEGIN + LogActivity(IntToStr(TotalMsgsProcessed)+' purged!'^M^J); + Write(IntToStr(TotalMsgsProcessed)+' purged!'); + END; + END; + UpdateHiWater(MemMsgPath,1); +END; + +PROCEDURE UpdateMailWaiting(GenDataPath: STRING; UserNum: Integer); +BEGIN + Assign(UserFile,GenDataPath+'USERS.DAT'); + {$I-} Reset(UserFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to open '+GenDataPath+'USERS.DAT.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.DAT/Open File Error - '+IntToStr(LastError)+' (Proc: UpdateMailWaiting)'); + Exit; + END; + {$I-} Seek(UserFile,UserNum); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+GenDataPath+'USERS.DAT.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.DAT/Seek Record '+IntToStr(UserNum)+' Error - '+IntToStr(LastError)+ + ' (Proc: UpdateMailWaiting)'); + Exit; + END; + {$I-} Read(UserFile,User); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to read record from '+GenDataPath+'USERS.DAT.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.DAT/Read Record '+IntToStr(UserNum)+' Error - '+IntToStr(LastError)+ + ' (Proc: UpdateMailWaiting)'); + Exit; + END; + Inc(User.Waiting); + {$I-} Seek(UserFile,UserNum); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+GenDataPath+'USERS.DAT.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.DAT/Seek Record '+IntToStr(UserNum)+' Error - '+IntToStr(LastError)+ + ' (Proc: UpdateMailWaiting)'); + Exit; + END; + {$I-} Write(UserFile,User); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to write record to '+GenDataPath+'USERS.DAT.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.DAT/Write Record '+IntToStr(UserNum)+' Error - '+IntToStr(LastError)+ + ' (Proc: UpdateMailWaiting)'); + Exit; + END; + {$I-} Close(UserFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+GenDataPath+'USERS.DAT.'); + TextColor(LightGray); + LogError(GenDataPath+'USERS.DAT/Close File Error - '+IntToStr(LastError)+' (Proc: UpdateMailWaiting)'); + Exit; + END; +END; + +PROCEDURE InitRGMsgHdrVars(VAR RGMsgHdr: MHeaderRec); +VAR + Counter: Integer; +BEGIN + WITH RGMsgHdr DO + BEGIN + WITH From DO + BEGIN + Anon := 0; + UserNum := 0; + A1S := ''; + Real := ''; + Name := ''; + Zone := 0; + Net := 0; + Node := 0; + Point := 0; + END; + WITH MTO DO + BEGIN + Anon := 0; + UserNum := 0; + A1S := ''; + Real := ''; + Name := ''; + Zone := 0; + Net := 0; + Node := 0; + Point := 0; + END; + Pointer := -1; + TextSize := 0; + ReplyTo := 0; + Date := GetPackDateTime; + GetDayOfWeek(DayOfWeek); + Status := []; + Replies := 0; + Subject := ''; + OriginDate := ''; + FileAttached := 0; + NetAttribute := []; + FOR Counter := 1 TO 2 DO + Res[Counter] := 0; + END; +END; + +FUNCTION ReadFidoMsg(General1: GeneralRecordType; + VAR RGMsgHdr: MHeaderRec; + FidoMsgNum: Word; + MemMsgPath: STRING; + VAR MsgLength: Integer): Boolean; +VAR + FidoTxt: STRING[81]; + BufSize, + Counter: Integer; + MsgRead: Boolean; +BEGIN + MsgRead := FALSE; + + IF (NOT ExistFile(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG')) THEN + BEGIN + ReadFidoMsg := MsgRead; + Exit; + END; + + Assign(FidoFile,MemMsgPath+IntToStr(FidoMsgNum)+'.MSG'); + {$I-} Reset(FidoFile,1); {$I+} + IF (IOResult <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Open File Error (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to open '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END + ELSE + BEGIN + + IF (FileSize(FidoFile) < SizeOf(FidoMsgHdr)) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Truncated File Error (Proc: ReadFidoMsg)'); + ErrorStrXY('Truncated file '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END + ELSE + BEGIN + {$I-} BlockRead(FidoFile,FidoMsgHdr,SizeOf(FidoMsgHdr)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Read Header Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to block read header from '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END; + + InitRGMsgHdrVars(RGMsgHdr); + + IF ((FidoMsgHdr.Attribute AND 16) = 16) THEN + RGMsgHdr.FileAttached := 1; + + FidoTxt := FidoMsgHdr.FromUserName[0]; + + FidoTxt := FidoTxt + Copy(FidoMsgHdr.FromUserName,1,((Pos(#0,FidoMsgHdr.FromUserName) - 1))); + + FidoTxt := Caps(FidoTxt); + + RGMsgHdr.From.A1S := FidoTxt; + RGMsgHdr.From.Real := FidoTxt; + RGMsgHdr.From.Name := FidoTxt; + + FidoTxt := FidoMsgHdr.ToUserName[0]; + + FidoTxt := FidoTxt + Copy(FidoMsgHdr.ToUserName,1,((Pos(#0,FidoMsgHdr.ToUserName) - 1))); + + FidoTxt := Caps(FidoTxt); + + RGMsgHdr.MTO.A1S := FidoTxt; + RGMsgHdr.MTO.Real := FidoTxt; + RGMsgHdr.MTO.Name := FidoTxt; + + FidoTxt := FidoMsgHdr.Subject[0]; + + FidoTxt := FidoTxt + Copy(FidoMsgHdr.Subject,1,((Pos(#0,FidoMsgHdr.Subject) - 1))); + + RGMsgHdr.Subject := FidoTxt; + + FidoTxt := FidoMsgHdr.DateTIme[0]; + + FidoTxt := FidoTxt + Copy(FidoMsgHdr.DateTime,1,((Pos(#0,FidoMsgHdr.DateTime) - 1))); + + RGMsgHdr.OriginDate := FidoTxt; + + RGMsgHdr.Status := [Sent]; + + IF (FidoMsgHdr.Attribute AND 1 = 1) THEN + Include(RGMsgHdr.Status,Prvt); + + MsgRead := TRUE; + + IF (IsNetMail) THEN + BEGIN + MsgRead := FALSE; + RGMsgHdr.From.Node := FidoMsgHdr.OrigNode; + RGMsgHdr.From.Net := FidoMsgHdr.OrigNet; + RGMsgHdr.MTO.Node := FidoMsgHdr.DestNode; + RGMsgHdr.MTO.Net := FidoMsgHdr.DestNet; + RGMsgHdr.From.Point := 0; + RGMsgHdr.MTO.Point := 0; + RGMsgHdr.From.Zone := 0; + RGMsgHdr.MTO.Zone := 0; + IF (FidoMsgHdr.Attribute AND 256 = 0) AND (FidoMsgHdr.Attribute AND 4 = 0) THEN + FOR Counter := 0 TO 19 DO + IF (RGMsgHdr.MTO.Node = General1.AKA[Counter].Node) AND (RGMsgHdr.MTO.Net = General1.AKA[Counter].Net) THEN + BEGIN + RGMsgHdr.MTO.Zone := General1.AKA[Counter].Zone; + RGMsgHdr.From.Zone := General1.AKA[Counter].Zone; + MsgRead := TRUE; + END; + IF (NOT MsgRead) THEN + BEGIN +{ LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Unknown Zone Error (Proc: ReadFidoMsg)'); + ErrorStrXY('Unknown zone '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); +} END; + END; + + IF (MsgRead) THEN + BEGIN + + IF (FileSize(FidoFile) - 190) <= SizeOf(BufferArray) THEN + BufSize := (FileSize(FidoFile) - 190) + ELSE + BufSize := SizeOf(BufferArray); + + {$I-} BlockRead(FidoFile,BufferArray,BufSize,MsgLength); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Read Text Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to block read text from '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + MsgRead := FALSE; + END; + END; + END; + IF (IsNetMail) THEN + IF (MsgRead) AND (Purge_NetMail) THEN + BEGIN + {$I-} Close(FidoFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Close File Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to close '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END; + {$I-} Erase(FidoFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Erase File Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to erase '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END; + END + ELSE IF (MsgRead) THEN + BEGIN + FidoMsgHdr.Attribute := 260; + {$I-} Seek(FidoFile,0); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Seek Record 0 Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to seek record in '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END; + {$I-} BlockWrite(FidoFile,FidoMsgHdr,SizeOf(FidoMsgHdr)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Header Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to block write header to '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END; + END; + IF (NOT (IsNetMail AND MsgRead AND Purge_NetMail)) THEN + BEGIN + {$I-} Close(FidoFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(MemMsgPath+IntToStr(FidoMsgNum)+'.MSG/Close File Error - '+IntToStr(LastError)+ + ' (Proc: ReadFidoMsg)'); + ErrorStrXY('Unable to close '+MemMsgPath+IntToStr(FidoMsgNum)+'.MSG',12,23,Red + 128,Blue); + END; + END; + END; + ReadFidoMsg := MsgRead; +END; + +PROCEDURE Toss(General1: GeneralRecordType; MemMsgArea1: MessageAreaRecordType); +VAR + MsgTxt: STRING[255]; + FidoTxt: STRING[81]; + AddressStr: STRING[20]; + C: Char; + Counter, + Counter1, + MsgPointer, + MsgLength: Integer; + LowMsg, + HighMsg, + FidoMsgNum, + TotalMsgsProcessed: Word; + FirstTime: Boolean; +BEGIN + + FirstTime := TRUE; + + TotalMsgsProcessed := 0; + + GetMsgLst(MemMsgArea1.MsgPath,LowMsg,HighMsg); + + IF (IsNetMail) AND (HighMsg > 1) THEN + LowMsg := 1; + + IF (LowMsg <= HighMsg) AND ((HighMsg > 1) OR (IsNetMail)) THEN + BEGIN + + Assign(RGMsgHdrFile,General1.MsgPath+MemMsgArea1.FileName+'.HDR'); + {$I-} Reset(RGMsgHdrFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + {$I-} ReWrite(RGMsgHdrFile); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to create '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/ReWrite File Error - '+IntToStr(LastError)+' (Proc: Toss)'); + Exit; + END; + END; + + Assign(RGMsgTxtFile,General1.MsgPath+MemMsgArea1.FileName+'.DAT'); + {$I-} Reset(RGMsgTxtFile,1); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + {$I-} ReWrite(RGMsgTxtFile); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to create '+General1.MsgPath+MemMsgArea1.FileName+'.DAT.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.DAT/ReWrite File Error - '+IntToStr(LastError)+' (Proc: Toss)'); + Exit; + END; + END; + + {$I-} Seek(RGMsgHdrFile,FileSize(RGMsgHdrFile)); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Seek End Of File Error - '+IntToStr(LastError)+' (Proc: Toss)'); + Exit; + END; + + {$I-} Seek(RGMsgTxtFile,FileSize(RGMsgTxtFile)); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+General1.MsgPath+MemMsgArea1.FileName+'.DAT.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.DAT/Seek End Of File Error - '+IntToStr(LastError)+' (Proc: Toss)'); + Exit; + END; + + FOR FidoMsgNum := LowMsg TO HighMsg DO + BEGIN + + TextColor(LightCyan); + TextBackGround(Blue); + Write(PadRightStr(IntToStr(FidoMsgNum),5)); + + IF ReadFidoMsg(General1,RGMsgHdr,FidoMsgNum,MemMsgArea1.MsgPath,MsgLength) THEN + BEGIN + + IF (FirstTime) THEN + BEGIN + LogActivity(^M^J); + FirstTime := FALSE; + END; + LogActivity(^M^J); + LogActivity('Processing: '+IntToStr(FidoMsgNum)+'.MSG'^M^J); + LogActivity(^M^J); + LogActivity('From : '+RGMsgHdr.From.Name+^M^J); + LogActivity('To : '+RGMsgHdr.MTO.Name+^M^J); + LogActivity('Subject: '+RGMsgHdr.Subject+^M^J); + LogActivity('Date : '+RGMsgHdr.OriginDate+^M^J); + + Inc(RGMsgHdr.Date); + + RGMsgHdr.Pointer := (FileSize(RGMsgTxtFile) + 1); + + RGMsgHdr.TextSize := 0; + + FidoTxt := ''; + + MsgPointer := 0; + WHILE (MsgPointer < MsgLength) DO + BEGIN + + MsgTxt := FidoTxt; + REPEAT + Inc(MsgPointer); + C := BufferArray[MsgPointer]; + IF (NOT (C IN [#0,#10,#13,#141])) THEN + IF (Length(MsgTxt) < 255) THEN + BEGIN + Inc(MsgTxt[0]); + MsgTxt[Length(MsgTxt)] := C; + END; + UNTIL ((FidoTxt = #13) OR (C IN [#13,#141]) OR ((Length(MsgTxt) > 79) AND (Pos(#27,MsgTxt) = 0)) + OR (Length(MsgTxt) = 254) OR (MsgPointer >= MsgLength)); + + IF (Length(MsgTxt) = 254) THEN + MsgTxt := MsgTxt + #29; + + Counter := Pos(#1'INTL ',MsgTxt); + IF (Counter > 0) THEN + BEGIN + Inc(Counter,6); + FOR Counter1 := 1 TO 8 DO + BEGIN + AddressStr := ''; + WHILE (MsgTxt[Counter] IN ['0'..'9']) AND (Counter <= Length(MsgTxt)) DO + BEGIN + AddressStr := AddressStr + MsgTxt[Counter]; + Inc(Counter); + END; + CASE Counter1 OF + 1 : RGMsgHdr.MTO.Zone := StrToInt(AddressStr); + 2 : RGMsgHdr.MTO.Net := StrToInt(AddressStr); + 3 : RGMsgHdr.MTO.Node := StrToInt(AddressStr); + 4 : RGMsgHdr.MTO.Point := StrToInt(AddressStr); + 5 : RGMsgHdr.From.Zone := StrToInt(AddressStr); + 6 : RGMsgHdr.From.Net := StrToInt(AddressStr); + 7 : RGMsgHdr.From.Node := StrToInt(AddressStr); + 8 : RGMsgHdr.From.Point := StrToInt(AddressStr); + END; + IF (Counter1 = 3) AND (MsgTxt[Counter] <> '.') THEN + Inc(Counter1); + IF (Counter1 = 7) AND (MsgTxt[Counter] <> '.') THEN + Break; + Inc(Counter); + END; + LogActivity('INTL : '+IntToStr(RGMsgHdr.MTO.Zone)+ + ':'+IntToStr(RGMsgHdr.MTO.Net)+ + '/'+IntToStr(RGMsgHdr.MTO.Node)+ + ' '+ + ' '+IntToStr(RGMsgHdr.From.Zone)+ + ':'+IntToStr(RGMsgHdr.From.Net)+ + '/'+IntToStr(RGMsgHdr.From.Node)+^M^J); + END; + + IF (Length(MsgTxt) > 79) THEN + BEGIN + Counter := Length(MsgTxt); + WHILE (MsgTxt[Counter] = ' ') AND (Counter > 1) DO + Dec(Counter); + WHILE (Counter > 65) AND (MsgTxt[Counter] <> ' ') DO + Dec(Counter); + FidoTxt[0] := Chr(Length(MsgTxt) - Counter); + Move(MsgTxt[Counter + 1],FidoTxt[1],(Length(MsgTxt) - Counter)); + MsgTxt[0] := Chr(Counter - 1); + END + ELSE + FidoTxt := ''; + + IF ((MsgTxt[1] = #1) AND (MASkludge IN MemMsgArea1.MAFlags)) OR + ((Pos('SEEN-BY',MsgTxt) > 0) AND (MASSeenby IN MemMsgArea1.MAFlags)) OR + ((Pos('* Origin:',MsgTxt) > 0) AND (MASOrigin IN MemMsgArea1.MAFlags)) THEN + MsgTxt := '' + ELSE + BEGIN + Inc(RGMsgHdr.TextSize,(Length(MsgTxt) + 1)); + + {$I-} BlockWrite(RGMsgTxtFile,MsgTxt,(Length(MsgTxt) + 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write text to '+General1.MsgPath+MemMsgArea1.FileName+'.DAT.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.DAT/Block Write Text Error - '+IntToStr(LastError)+ + ' (Proc: Toss)'); + Exit; + END; + END; + + END; + + IF (IsNetMail) THEN + BEGIN + Include(RGMsgHdr.Status,NetMail); + RGMsgHdr.MTO.UserNum := SearchUser(General1.DataPath,RGMsgHdr.MTO.A1S); + IF (RGMsgHdr.MTO.UserNum = 0) THEN + RGMsgHdr.MTO.UserNum := 1; + UpdateMailWaiting(General1.DataPath,RGMsgHdr.MTO.UserNum); + END; + + {$I-} Write(RGMsgHdrFile,RGMsgHdr); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to write record to '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Write End Of File Error - '+IntToStr(LastError)+ + ' (Proc: Toss)'); + Exit; + END; + + Inc(TotalMsgsProcessed); + + END; + + IF (FidoMsgNum < HighMsg) THEN + Write(#8#8#8#8#8); + + END; + + {$I-} Close(RGMsgHdrFile); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Close File Error - '+IntToStr(LastError)+' (Proc: Toss)'); + Exit; + END; + + {$I-} Close(RGMsgTxtFile); {$I+} + LastError := IOResult; + IF (IOResult <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+General1.MsgPath+MemMsgArea1.FileName+'.DAT.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.DAT/Close File Error - '+IntToStr(LastError)+' (Proc: Toss)'); + Exit; + END; + + IF (NOT IsNetMail) THEN + UpdateHiWater(MemMsgArea1.MsgPath,HighMsg); + + END + ELSE + Write('No messages!'); + + IF (TotalMsgsProcessed = 0) THEN + LogActivity('No Messages!'^M^J) + ELSE + BEGIN + LogActivity(^M^J); + LogActivity('Total processed: '+IntToStr(TotalMsgsProcessed)+^M^J); + LogActivity(^M^J); + END; +END; + +PROCEDURE Scan(General1: GeneralRecordType; MemMsgArea1: MessageAreaRecordType); +VAR + DT: DateTime; + FidoTxt: STRING[81]; + MsgLength: Integer; + LowMsg, + HighMsg, + RGMsgNum, + FidoMsgNum, + HighestWritten, + TotalMsgsProcessed: Word; + Scanned, + FirstTime: Boolean; +BEGIN + + Scanned := FALSE; + + TotalMsgsProcessed := 0; + + FirstTime := TRUE; + + GetMsgLst(MemMsgArea1.MsgPath,LowMsg,HighMsg); + + FidoMsgNum := HighMsg; + + Assign(RGMsgHdrFile,General1.MsgPath+MemMsgArea1.FileName+'.HDR'); + {$I-} Reset(RGMsgHdrFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to open '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Open File Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + Assign(RGMsgTxtFile,General1.MsgPath+MemMsgArea1.FileName+'.DAT'); + {$I-} Reset(RGMsgTxtFile,1); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to open '+General1.MsgPath+MemMsgArea1.FileName+'.DAT.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.DAT/Open File Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + FOR RGMsgNum := 1 TO FileSize(RGMsgHdrFile) DO + BEGIN + + {$I-} Seek(RGMsgHdrFile,(RGMsgNum - 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Seek Record '+IntToStr(RGMsgNum - 1)+' Error - ' + +IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + {$I-} Read(RGMsgHdrFile,RGMsgHdr); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to read record from '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Read Record '+IntToStr(RGMsgNum - 1)+' Error - ' + +IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + IF (NOT (Sent IN RGMsgHdr.Status)) AND + (NOT (MDeleted IN RGMsgHdr.Status)) AND + (NOT (UnValidated IN RGMsgHdr.Status)) AND + (NOT (IsNetMail AND (NOT (NetMail IN RGMsgHdr.Status)))) THEN + BEGIN + + Inc(FidoMsgNum); + + Assign(FidoFile,MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + {$I-} ReWrite(FidoFile,1); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to create '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG.'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Rewrite File Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + TextColor(LightCyan); + TextBackGround(Blue); + Write(PadRightStr(IntToStr(RGMsgNum),5)); + + Include(RGMsgHdr.Status,Sent); + + IF (IsNetMail) THEN + Include(RGMsgHdr.Status,MDeleted); + + {$I-} Seek(RGMsgHdrFile,(RGMsgNum - 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Seek Record '+IntToStr(RGMsgNum - 1)+ + ' Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + {$I-} Write(RGMsgHdrFile,RGMsgHdr); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to write record to '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Write Record '+IntToStr(RGMsgNum - 1)+ + ' Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + FillChar(FidoMsgHdr,SizeOf(FidoMsgHdr),#0); + + IF (FirstTime) THEN + BEGIN + LogActivity(^M^J); + FirstTime := FALSE; + END; + LogActivity(^M^J); + LogActivity('Processing: '+IntToStr(FidoMsgNum)+'.MSG'^M^J); + LogActivity(^M^J); + + FidoTxt := UseName(RGMsgHdr.From.Anon, + AOnOff((MARealName IN MemMsgArea1.MAFlags), + Caps(RGMsgHdr.From.Real), + Caps(RGMsgHdr.From.A1S))); + Move(FidoTxt[1],FidoMsgHdr.FromUserName[0],Length(FidoTxt)); + + LogActivity('From : '+FidoTxt+^M^J); + + FidoTxt := UseName(RGMsgHdr.MTO.Anon, + AOnOff((MARealName IN MemMsgArea1.MAFlags), + Caps(RGMsgHdr.MTO.Real), + Caps(RGMsgHdr.MTO.A1S))); + Move(FidoTxt[1],FidoMsgHdr.ToUserName[0],Length(FidoTxt)); + + LogActivity('To : '+FidoTxt+^M^J); + + FidoTxt := StripColor(MemMsgArea1.MAFlags,RGMsgHdr.Subject); + IF (NOT IsNetMail) AND (RGMsgHdr.FileAttached > 0) THEN + FidoTxt := StripName(FidoTxt); + Move(FidoTxt[1],FidoMsgHdr.Subject[0],Length(FidoTxt)); + + LogActivity('Subject: '+FidoTxt+^M^J); + + PackToDate(DT,RGMsgHdr.Date); + FidoTxt := ZeroPad(IntToStr(DT.Day))+ + ' '+Copy(MonthString[DT.Month],1,3)+ + ' '+Copy(IntToStr(DT.Year),3,2)+ + ' '+ZeroPad(IntToStr(DT.Hour))+ + ':'+ZeroPad(IntToStr(DT.Min))+ + ':'+ZeroPad(IntToStr(DT.Sec)); + Move(FidoTxt[1],FidoMsgHdr.DateTime[0],Length(FidoTxt)); + + LogActivity('Date : '+FidoTxt+^M^J); + + IF (IsNetMail) THEN + BEGIN + FidoMsgHdr.OrigNet := RGMsgHdr.From.Net; + FidoMsgHdr.OrigNode := RGMsgHdr.From.Node; + FidoMsgHdr.DestNet := RGMsgHdr.MTO.Net; + FidoMsgHdr.DestNode := RGMsgHdr.MTO.Node; + + LogActivity('Origin : '+IntToStr(FidoMsgHdr.OrigNet)+ + '/'+IntToStr(FidoMsgHdr.OrigNode)+^M^J); + + LogActivity('Destin : '+IntToStr(FidoMsgHdr.DestNet)+ + '/'+IntToStr(FidoMsgHdr.DestNode)+^M^J); + END + ELSE + BEGIN + FidoMsgHdr.OrigNet := General1.AKA[MemMsgArea1.AKA].Net; + FidoMsgHdr.OrigNode := General1.AKA[MemMsgArea1.AKA].Node; + FidoMsgHdr.DestNet := 0; + FidoMsgHdr.DestNode := 0; + + LogActivity('Origin : '+IntToStr(General1.AKA[MemMsgArea1.AKA].Net)+ + '/'+IntToStr(General1.AKA[MemMsgArea1.AKA].Node)+^M^J); + + END; + + IF (IsNetMail) THEN +{$IFDEF MSDOS} + FidoMsgHdr.Attribute := Word(RGMsgHdr.NetAttribute) +{$ENDIF} +{$IFDEF WIN32} + FidoMsgHdr.Attribute := NetAttribsToWord(RGMsgHdr.NetAttribute) +{$ENDIF} + ELSE IF (Prvt IN RGMsgHdr.Status) THEN + FidoMsgHdr.Attribute := 257 + ELSE + FidoMsgHdr.Attribute := 256; + + IF (RGMsgHdr.FileAttached > 0) THEN + FidoMsgHdr.Attribute := (FidoMsgHdr.Attribute + 16); + + {$I-} BlockWrite(FidoFile,FidoMsgHdr,SizeOf(FidoMsgHdr)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write header '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Header Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + {$I-} Seek(RGMsgTxtFile,(RGMsgHdr.Pointer - 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek text in '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Seek Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + IF (IsNetMail) THEN + BEGIN + + LogActivity('INTL : '+IntToStr(RGMsgHdr.MTO.Zone)+ + ':'+IntToStr(RGMsgHdr.MTO.Net)+ + '/'+IntToStr(RGMsgHdr.MTO.Node)+ + ' '+ + ' '+IntToStr(RGMsgHdr.From.Zone)+ + ':'+IntToStr(RGMsgHdr.From.Net)+ + '/'+IntToStr(RGMsgHdr.From.Node)+^M^J); + + FidoTxt := #1'INTL '+IntToStr(RGMsgHdr.MTO.Zone)+ + ':'+IntToStr(RGMsgHdr.MTO.Net)+ + '/'+IntToStr(RGMsgHdr.MTO.Node)+ + ' '+IntToStr(RGMsgHdr.From.Zone)+ + ':'+IntToStr(RGMsgHdr.From.Net)+ + '/'+IntToStr(RGMsgHdr.From.Node)+#13; + + {$I-} BlockWrite(FidoFile,FidoTxt[1],Length(FidoTxt)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write text to '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + IF (RGMsgHdr.MTO.Point > 0) THEN + BEGIN + LogActivity('TOPT : '+IntToStr(RGMsgHdr.MTO.Point)+^M^J); + + FidoTxt := #1'TOPT '+IntToStr(RGMsgHdr.MTO.Point)+#13; + + {$I-} BlockWrite(FidoFile,FidoTxt[1],Length(FidoTxt)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write text to '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + END; + + IF (RGMsgHdr.From.Point > 0) THEN + BEGIN + LogActivity('FMPT : '+IntToStr(RGMsgHdr.From.Point)+^M^J); + + FidoTxt := #1'FMPT '+IntToStr(RGMsgHdr.From.Point)+#13; + + {$I-} BlockWrite(FidoFile,FidoTxt[1],Length(FidoTxt)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write text to '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + END; + + FidoTxt := #1'MSGID: '+IntToStr(RGMsgHdr.From.Zone)+ + ':'+IntToStr(RGMsgHdr.From.Net)+ + '/'+IntToStr(RGMsgHdr.From.Node)+ + ' '+Hex(Random($FFFF),4)+Hex(Random($FFFF),4); + IF (RGMsgHdr.From.Point > 0) THEN + FidoTxt := FidoTxt +'.'+IntToStr(RGMsgHdr.From.Point); + + FidoTxt := FidoTxt + #13; + + {$I-} BlockWrite(FidoFile,FidoTxt[1],Length(FidoTxt)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write text to '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + END; + + MsgLength := 0; + + IF (RGMsgHdr.TextSize > 0) THEN + REPEAT + + {$I-} BlockRead(RGMsgTxtFile,FidoTxt[0],1); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block read text from '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Read Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + {$I-} BlockRead(RGMsgTxtFile,FidoTxt[1],Ord(FidoTxt[0])); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block read text from '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Read Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + Inc(MsgLength,(Length(FidoTxt) + 1)); + + WHILE (Pos(#0,FidoTxt) > 0) DO + Delete(FidoTxt,Pos(#0,FidoTxt),1); + + IF (FidoTxt[Length(FidoTxt)] = #29) THEN + Dec(FidoTxt[0]) + + (* NOTE: Should this be (Pos(#27,FidoTxt) <> 0) *) + + ELSE IF (Pos(#27,FidoTxt) = 0) THEN + FidoTxt := StripColor(MemMsgArea1.MAFlags,FidoTxt); + + FidoTxt := FidoTxt + #13; + + {$I-} BlockWrite(FidoFile,FidoTxt[1],Length(FidoTxt)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to block write text to '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Block Write Text Error - '+IntToStr(LastError)+ + ' (Proc: Scan)'); + Exit; + END; + + UNTIL (MsgLength >= RGMsgHdr.TextSize); + + {$I-} Close(FidoFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG.'); + TextColor(LightGray); + LogError(MemMsgArea1.MsgPath+IntToStr(FidoMsgNum)+'.MSG/Close File Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + Write(#8#8#8#8#8); + + Scanned := TRUE; + + Inc(TotalMsgsProcessed); + END; + + HighestWritten := FidoMsgNum; + + END; + + IF (NOT IsNetMail) THEN + UpdateHiWater(MemMsgArea1.MsgPath,HighestWritten); + + {$I-} Close(RGMsgHdrFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+General1.MsgPath+MemMsgArea1.FileName+'.HDR.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.HDR/Close File Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + {$I-} Close(RGMsgTxtFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+General1.MsgPath+MemMsgArea1.FileName+'.DAT.'); + TextColor(LightGray); + LogError(General1.MsgPath+MemMsgArea1.FileName+'.DAT/Close File Error - '+IntToStr(LastError)+' (Proc: Scan)'); + Exit; + END; + + IF (NOT Scanned) THEN + BEGIN + LogActivity('No Messages!'^M^J); + Write('No messages!'); + END + ELSE + BEGIN + LogActivity(^M^J); + LogActivity('Total processed: '+IntToStr(TotalMsgsProcessed)+^M^J); + LogActivity(^M^J); + END; + +END; + +BEGIN + DisplayMain(White,Blue); + + IF (ParamCount = 0) THEN + HaltErrorStrXY('No command line parameters specified!',12,23,Red + 128,Blue,1); + + TempParamStr := ''; + ParamFound := FALSE; + ParamCounter := 1; + WHILE (ParamCounter <= ParamCount) DO + BEGIN + IF (SC(ParamStr(ParamCounter),1) = '-') THEN + BEGIN + CASE SC(ParamStr(ParamCounter),2) OF + 'A' : Absolute_Scan := TRUE; + 'D' : Purge_NetMail := FALSE; + 'F' : FastPurge := FALSE; + 'I' : Ignore_1Msg := FALSE; + 'L' : Activity_Log := TRUE; + 'N' : Process_NetMail := FALSE; + 'O' : NetMailOnly := TRUE; + 'P' : BEGIN + Purge_Dir := TRUE; + ParamFound := TRUE; + END; + 'S' : BEGIN + Scan_Mail := TRUE; + ParamFound := TRUE; + END; + 'T' : BEGIN + Toss_Mail := TRUE; + ParamFound := TRUE; + END; + END; + TempParamStr := TempParamStr + AllCaps(ParamStr(ParamCounter))+' '; + END; + Inc(ParamCounter); + END; + + Dec(TempParamStr[0]); + + IF (NOT ParamFound) THEN + HaltErrorStrXY('Valid commands are -T, -P, -S, (With or without options)',12,23,Red + 128,Blue,1); + + GetDir(0,StartDir); + + FileMode := 66; +{$IFDEF WIN32} + {FileModeReadWrite := FileMode;} +{$ENDIF} + + GetGeneral(General); + + GeneralPaths(General); + + GeneralFiles(General); + + LogActivity(^M^J); + LogActivity(ToDate8(DateStr)+' '+TimeStr+': Renemail initiated with '+TempParamStr+' parameter(s).'^M^J); + LogActivity(^M^J); + + IF (Process_NetMail) AND (Toss_Mail) OR (Scan_Mail) THEN + BEGIN + IsNetMail := TRUE; + MemMsgArea.MsgPath := General.NetMailPath; + MemMsgArea.FileName := 'EMAIL'; + MemMsgArea.MAFlags := [MASkludge]; + IF (Toss_Mail) THEN + BEGIN + LogActivity(' Tossing: NETMAIL - '); + TextColor(3); + Write(' Tossing: '); + TextColor(14); + Write(' NETMAIL - '); + Toss(General,MemMsgArea); + WriteLn; + END; + IF (Scan_Mail) THEN + BEGIN + LogActivity('Scanning: NETMAIL - '); + TextColor(3); + Write('Scanning: '); + TextColor(14); + Write(' NETMAIL - '); + TextColor(11); + Scan(General,MemMsgArea); + WriteLn; + END; + IsNetMail := FALSE; + END; + + IF (NOT NetMailOnly) THEN + BEGIN + IF (Toss_Mail) OR (Purge_Dir) OR (Scan_Mail) THEN + BEGIN + Assign(MessageAreaFile,General.DataPath+'MBASES.DAT'); + {$I-} Reset(MessageAreaFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + LogError(General.DataPath+'MBASES.DAT/Open File Error - '+IntToStr(LastError)+' (Proc: Main)'); + HaltErrorStrXY('Unable to open '+General.DataPath+'MBASES.DAT!',12,23,Red + 128,Blue,1); + END; + MsgArea := 1; + WHILE (MsgArea <= FileSize(MessageAreaFile)) DO + BEGIN + {$I-} Seek(MessageAreaFile,(MsgArea - 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+General.DataPath+'MBASES.DAT'); + TextColor(LightGray); + LogError(General.DataPath+'MBASES.DAT/Seek Record '+IntToStr(MsgArea - 1)+' Error - '+IntToStr(LastError)+ + ' (Proc: Main)'); + Exit; + END; + {$I-} Read(MessageAreaFile,MemMsgArea); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to read record from '+General.DataPath+'MBASES.DAT'); + TextColor(LightGray); + LogError(General.DataPath+'MBASES.DAT/Read Record '+IntToStr(MsgArea - 1)+' Error - '+IntToStr(LastError)+ + ' (Proc: Main)'); + Exit; + END; + IF (MemMsgArea.MAType = 1) AND (NOT Scan_Mail OR (Absolute_Scan OR (MAScanOut IN MemMsgArea.MAFlags))) THEN + BEGIN + IF (Toss_Mail) THEN + BEGIN + LogActivity(' Tossing: '+PadRightStr(MemMsgArea.FileName,8)+' - '); + TextColor(3); + Write(' Tossing: '); + TextColor(14); + Write(PadRightStr(MemMsgArea.FileName,8)+' - '); + TextColor(11); + Toss(General,MemMsgArea); + WriteLn; + END; + IF (Purge_Dir) THEN + BEGIN + LogActivity(' Purging: '+PadRightStr(MemMsgArea.FileName,8)+' - '); + TextColor(3); + Write(' Purging: '); + TextColor(14); + Write(PadRightStr(MemMsgArea.FileName,8)+' - '); + TextColor(11); + PurgeDir(MemMsgArea.MsgPath); + WriteLn; + END; + IF (Scan_Mail) THEN + BEGIN + LogActivity('Scanning: '+PadRightStr(MemMsgArea.FileName,8)+' - '); + TextColor(3); + Write('Scanning: '); + TextColor(14); + Write(PadRightStr(MemMsgArea.FileName,8)+' - '); + TextColor(11); + Scan(General,MemMsgArea); + WriteLn; + END; + IF (Scan_Mail) AND (MAScanOut IN MemMsgArea.MAFlags) THEN + BEGIN + {$I-} Seek(MessageAreaFile,(MsgArea - 1)); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to seek record in '+General.DataPath+'MBASES.DAT'); + TextColor(LightGray); + LogError(General.DataPath+'MBASES.DAT/Seek Record '+IntToStr(MsgArea - 1)+' Error - '+IntToStr(LastError)+ + ' (Proc: Main)'); + Exit; + END; + Exclude(MemMsgArea.MAFlags,MAScanOut); + {$I-} Write(MessageAreaFile,MemMsgArea); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to write record to '+General.DataPath+'MBASES.DAT'); + TextColor(LightGray); + LogError(General.DataPath+'MBASES.DAT/Write Record '+IntToStr(MsgArea - 1)+' Error - '+IntToStr(LastError)+ + ' (Proc: Main)'); + Exit; + END; + END; + END; + Inc(MsgArea); + END; + {$I-} Close(MessageAreaFile); {$I+} + LastError := IOResult; + IF (LastError <> 0) THEN + BEGIN + TextColor(Red); + WriteLn('Unable to close '+General.DataPath+'MBASES.DAT'); + TextColor(LightGray); + LogError(General.DataPath+'MBASES.DAT/Close File Error - '+IntToStr(LastError)+' (Proc: Main)'); + Exit; + END; + END; + END; + + LogActivity(^M^J); + LogActivity(ToDate8(DateStr)+' '+TimeStr+': Renemail completed with '+TempParamStr+' parameter(s).'^M^J); + + ChDir(StartDir); + + Window(1,1,80,25); + + GoToXY(1,25); + +END. + + diff --git a/SOURCE/RENEMAIL.exe b/SOURCE/RENEMAIL.exe new file mode 100644 index 0000000..9429d73 Binary files /dev/null and b/SOURCE/RENEMAIL.exe differ diff --git a/SOURCE/RGLNG.PAS b/SOURCE/RGLNG.PAS new file mode 100644 index 0000000..106aeef --- /dev/null +++ b/SOURCE/RGLNG.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/RGLNG.exe b/SOURCE/RGLNG.exe new file mode 100644 index 0000000..699cc0b Binary files /dev/null and b/SOURCE/RGLNG.exe differ diff --git a/SOURCE/RGQUOTE.PAS b/SOURCE/RGQUOTE.PAS new file mode 100644 index 0000000..e8b1e1d --- /dev/null +++ b/SOURCE/RGQUOTE.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/RGQUOTE.exe b/SOURCE/RGQUOTE.exe new file mode 100644 index 0000000..cf1088c Binary files /dev/null and b/SOURCE/RGQUOTE.exe differ diff --git a/SOURCE/RPSCREEN.PAS b/SOURCE/RPSCREEN.PAS new file mode 100644 index 0000000..4c1859f --- /dev/null +++ b/SOURCE/RPSCREEN.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/SCRIPT.PAS b/SOURCE/SCRIPT.PAS new file mode 100644 index 0000000..b32bcab --- /dev/null +++ b/SOURCE/SCRIPT.PAS @@ -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. diff --git a/SOURCE/SHORTMSG.PAS b/SOURCE/SHORTMSG.PAS new file mode 100644 index 0000000..0a0baf8 --- /dev/null +++ b/SOURCE/SHORTMSG.PAS @@ -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. diff --git a/SOURCE/SPAWNO.PAS b/SOURCE/SPAWNO.PAS new file mode 100644 index 0000000..212a19d --- /dev/null +++ b/SOURCE/SPAWNO.PAS @@ -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. + diff --git a/SOURCE/SPLITCHA.PAS b/SOURCE/SPLITCHA.PAS new file mode 100644 index 0000000..6f91883 --- /dev/null +++ b/SOURCE/SPLITCHA.PAS @@ -0,0 +1,1421 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +UNIT SplitCha; + +INTERFACE + +USES + Common, + MyIO; + +PROCEDURE RequestSysOpChat(CONST MenuOption: Str50); +PROCEDURE ChatFileLog(b: Boolean); +PROCEDURE SysOpSplitChat; + +IMPLEMENTATION + +USES + Crt, + Dos, + Email, + Events, + TimeFunc; + +TYPE + ChatStrArray = ARRAY [1..10] OF AStr; + +VAR + UserChat: ChatStrArray; + SysOpChat: ChatStrArray; + UserXPos, + UserYPos, + SysOpXPos, + SysOpYPos: Byte; + Cmd : Char; + ChatHelp : Boolean; + ClrHlp : Shortint; +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} + WriteLn('REETODO SPLITCHA RequestSysOpChat'); Halt; +{$ENDIF} + END; + IF (KeyPressed) THEN + BEGIN + Cmd := ReadKey; + CASE Cmd OF + #0 : BEGIN + Cmd := ReadKey; + SKey1(Cmd); + END; + #32 : BEGIN + Chatted := TRUE; + ChatAttempts := 0; + SysOpSplitChat; + 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 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; + +PROCEDURE Clear_Eol; +BEGIN + IF (NOT OkAvatar) THEN + SerialOut(#27'[K') + ELSE + SerialOut(^V^G); + IF (WantOut) THEN + ClrEOL; +END; + +PROCEDURE SysOpChatWindow; +Var SysopNameLength : Integer; +BEGIN + Printf('SPLTCHAT'); + IF NOT NoFile THEN exit; + + SysopNameLength := ( 80 - Length(General.SysOpName) ); + CLS; + ANSIG(1,1); + Prompt('^4컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴'); + ANSIG( ( SysopNameLength - 5 ), 1); + Prompt('^4[ ^5' + General.SysOpName + ' ^4]'); + ANSIG(1,12); + Prompt('^4컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴'); + ANSIG(31,12); + Prompt('^4[ ^5Ctl^4+^5Z for Help ^4]'); + ANSIG(1,23); + Prompt('^4컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴'); + ANSIG(3,23); + Prompt('^4[ ^5'+ ThisUser.Name + ' ^4]'); + +END; + +PROCEDURE SysOpSplitChat; +VAR + S, + SysOpStr, + UserStr, + SysOpLastLineStr, + UserLastLineStr: AStr; + + SysOpLine, + UserLine, + SaveWhereX, + SaveWhereY, + SaveTextAttr: Byte; + + C: Char; + SysOpCPos, + UserCPos: Byte; + + ChatTime: LongInt; + SaveEcho, + SavePrintingFile, + SaveMCIAllowed: Boolean; + + PROCEDURE DoChar(C: Char; VAR CPos,XPos,YPos,Line: Byte; VAR ChatArray: ChatStrArray; VAR WrapLine: AStr); + VAR + Counter, + Counter1: Byte; + BEGIN + + IF C = #27 THEN { Esc Exit } + BEGIN + InChat := False; + Update_Screen; + END; + IF C = #63 THEN { F5 Exit } + BEGIN + InChat := False; + Update_Screen; + END; + + IF (CPos < 79) THEN + BEGIN + ANSIG(XPos,YPos); + ChatArray[Line][CPos] := C; + OutKey(C); + Inc(CPos); + Inc(XPos); + + ChatArray[Line][0] := Chr(CPos - 1); + + IF (Trapping) THEN + Write(TrapFile,C); + + END + ELSE + BEGIN + ChatArray[Line][CPos] := C; + Inc(CPos); + + ChatArray[Line][0] := Chr(CPos - 1); + Counter := (CPos - 1); + WHILE (Counter > 0) AND (ChatArray[Line][Counter] <> ' ') AND (ChatArray[Line][Counter] <> ^H) DO + Dec(Counter); + IF (Counter > (CPos DIV 2)) AND (Counter <> (CPos - 1)) THEN + BEGIN + WrapLine := Copy(ChatArray[Line],(Counter + 1),(CPos - Counter)); + FOR Counter1 := (CPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(XPos,YPos); + Prompt(^H); + Dec(XPos); + END; + FOR Counter1 := (CPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(XPos,YPos); + Prompt(' '); + Inc(XPos); + END; + ChatArray[Line][0] := Chr(Counter - 1); + END; + + NL; + + XPos := 2; + + IF (YPos > 1) AND (YPos < 11) OR (YPos > 12) AND (YPos < 22) THEN + BEGIN + Inc(YPos); + Inc(Line); + END + ELSE + BEGIN + + FOR Counter := 1 TO 9 DO + ChatArray[Counter] := ChatArray[Counter + 1]; + + ChatArray[10] := ''; + + + FOR Counter := 10 DOWNTO 1 DO + BEGIN + ANSIG(2,Counter + 1); + PrintMain(ChatArray[Counter]); + Clear_EOL; + END; + + END; + + ANSIG(XPos,YPos); + + CPos := 1; + + ChatArray[Line] := ''; + + IF (WrapLine <> '') THEN + BEGIN + Prompt(WrapLine); + ChatArray[Line] := WrapLine; + WrapLine := ''; + CPos := (Length(ChatArray[Line]) + 1); + XPos := Length(ChatArray[Line]) + 2; + END; + + END; + + END; + + PROCEDURE DOBackSpace(VAR Cpos,XPos: Byte; YPos: Byte; VAR S: AStr); + BEGIN + IF (CPos > 1) THEN + BEGIN + ANSIG(XPos,YPos); + BackSpace; + Dec(CPos); + Dec(XPos); + S[0] := Chr(CPos - 1); + END; + END; + + PROCEDURE DoTab(VAR CPos,XPos: Byte; YPos: Byte; VAR S: AStr); + VAR + Counter, + Counter1: Byte; + BEGIN + Counter := (5 - (CPos MOD 5)); + IF ((CPos + Counter) < 79) THEN + BEGIN + FOR Counter1 := 1 TO Counter DO + BEGIN + ANSIG(XPos,YPos); + Prompt(' '); + S[CPos] := ' '; + Inc(CPos); + Inc(XPos); + END; + S[0] := Chr(CPos - 1); + END; + END; + + PROCEDURE DOCarriageReturn(VAR CPos,XPos,YPos: Byte; VAR S: AStr); + Var i : Integer; + BEGIN + + S[0] := Chr(CPos - 1); + + (* Check Scrool here *) + + Inc(YPos); + XPos := 2; + { Fix Splitscreen so user and op stay on their own sides } + If (YPos = 12) Then + Begin + For i := 2 To 10 Do + Begin + ANSIG(1,i); + Clear_EOL; + End; + YPos := 2; + End + Else If (YPos = 23) Then + Begin + For i := 13 To 21 Do + Begin + ANSIG(1,i); + Clear_EOL; + End; + YPos := 13; + End; + + ANSIG(XPos,YPos); + + (* Do Cmds Here or add as Ctrl *) + + CPos := 1; + S := ''; + END; + + PROCEDURE DOBackSpaceWord(VAR CPos,XPos: Byte; YPos: Byte; VAR S: AStr); + BEGIN + IF (CPos > 1) THEN + BEGIN + REPEAT + ANSIG(XPos,YPos); + BackSpace; + Dec(CPos); + Dec(XPos); + UNTIL (CPos = 1) OR (S[CPos] = ' '); + S[0] := Chr(CPos - 1); + END; + END; + + PROCEDURE DOBackSpaceLine(VAR CPos,Xpos: Byte; YPos: Byte; VAR S: AStr); + VAR + Counter: Byte; + BEGIN + IF (CPos > 1) THEN + BEGIN + FOR Counter := 1 TO (CPos - 1) DO + BEGIN + ANSIG(XPos,YPos); + BackSpace; + Dec(CPos); + Dec(XPos); + END; + S[0] := Chr(CPos - 1); + END; + END; + +BEGIN + SaveWhereX := WhereX; + SaveWhereY := WhereY; + SaveTextAttr := TextAttr; + SaveScreen(Wind); + + 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); + } + + + IF (ChatReason <> '') THEN + BEGIN + lStatus_Screen(100,ChatReason,FALSE,S); + ChatReason := ''; + END; + + SysOpLastLineStr := ''; + UserLastLineStr := ''; + SysOpXPos := 2; + SysOpYPos := 2; + UserXPos := 2; + UserYPos := 13; + + SysOpStr := ''; + UserStr := ''; + SysOpCPos := 1; + UserCPos := 1; + SysOpLine := 1; + UserLine := 1; + + SysOpChatWindow; + + ANSIG(SysOpXPos,SysOpYPos); + + UserColor(General.SysOpColor); + WColor := TRUE; + + REPEAT + + C := Char(GetKey); + + CheckHangUp; + + CASE Ord(C) OF + 32..255 : + IF (WColor) THEN + DoChar(C,SysOpCPos,SysOpXPos,SysOpYPos,SysOpLine,SysOpChat,SysOpLastLineStr) + ELSE + DoChar(C,UserCPos,UserXPos,UserYPos,UserLine,UserChat,UserLastLineStr); + 3 : BEGIN + FOR ClrHlp := 18 TO 21 DO {Ctrl+Z Help Clear - (Ctrl+C) } + BEGIN + ANSIG(38,ClrHlp); + Clear_EOL; + END; + ANSIG(SaveWhereX,SaveWhereY); + END; + 7 : IF (OutCom) THEN + Com_Send(^G); + 8 : IF (WColor) THEN + DOBackSpace(SysOpCpos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DOBackSpace(UserCpos,UserXPos,UserYPos,UserStr); + 9 : IF (WColor) THEN + DoTab(SysOpCPos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DoTab(UserCPos,UserXPos,UserYPos,UserStr); + 13 : IF (WColor) THEN + DOCarriageReturn(SysOpCPos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DOCarriageReturn(UserCPos,UserXPos,UserYPos,UserStr); + + 17 : InChat := FALSE; + + 23 : IF (WColor) THEN + DOBackSpaceWord(SysOpCPos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DOBackSpaceWord(UserCPos,UserXPos,UserYPos,UserStr); + 24 : IF (WColor) THEN + DOBackSpaceLine(SysOpCPos,SysOpXpos,SysOpYPos,SysOpStr) + ELSE + DOBackSpaceLine(UserCPos,UserXpos,UserYPos,UserStr); + + 26 : Begin { Ctrl+Z } + + + + PrintF('CHATHELP'); + + If Not nofile Then + + Begin + + OneK(Cmd,#27#26,FALSE,FALSE); + + Case Ord(Cmd) Of + + 26,27 : SysOpChatWindow; { Escape } + + End; { /case } + + End { /If Not } + + Else + + Begin + + ChatHelp := TRUE; + + ANSIG(38,18); + + Print('^5Chat Help |15: ^4(^5Ctrl+C ^5:: ^4Clear Help^5)'); + + ANSIG(38,19); + + Print('^5Ctrl+G |15: ^4Hangup ^5Ctrl+W |15: ^4Delete Word'); + + ANSIG(38,20); + + Print('^5Ctrl+H |15: ^4Backspace ^5Ctrl+X |15: ^4Delete Line'); + + ANSIG(38,21); + + Print('^5Ctrl+H |15: ^4Tab ^5Ctrl+Q |15: ^4Quit|07'); + + + + ANSIG(SaveWhereX,SaveWhereY); + + End; { /If Not else case } + + End; { /26 } { Help } + END; + + (* + + 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 + FOR Counter := 650 TO 700 DO + BEGIN + Sound(Counter); + Delay(4); + NoSound; + END; + REPEAT + Dec(Counter); + Sound(Counter); + Delay(2); + NoSound; + UNTIL (Counter = 200); + 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)); + + RemoveWindow(Wind); + ANSIG(SaveWhereX,SaveWhereY); + TextAttr := SaveTextAttr; + + { + 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. +======= +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +UNIT SplitCha; + +INTERFACE + +USES + Common, + MyIO; + +PROCEDURE RequestSysOpChat(CONST MenuOption: Str50); +PROCEDURE ChatFileLog(b: Boolean); +PROCEDURE SysOpSplitChat; + +IMPLEMENTATION + +USES + Crt, + Dos, + Email, + Events, + TimeFunc; + +TYPE + ChatStrArray = ARRAY [1..10] OF AStr; + +VAR + UserChat: ChatStrArray; + SysOpChat: ChatStrArray; + UserXPos, + UserYPos, + SysOpXPos, + SysOpYPos: Byte; + +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} + WriteLn('REETODO SPLITCHA RequestSysOpChat'); Halt; +{$ENDIF} + END; + IF (KeyPressed) THEN + BEGIN + Cmd := ReadKey; + CASE Cmd OF + #0 : BEGIN + Cmd := ReadKey; + SKey1(Cmd); + END; + #32 : BEGIN + Chatted := TRUE; + ChatAttempts := 0; + SysOpSplitChat; + 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 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; + +PROCEDURE Clear_Eol; +BEGIN + IF (NOT OkAvatar) THEN + SerialOut(#27'[K') + ELSE + SerialOut(^V^G); + IF (WantOut) THEN + ClrEOL; +END; + +PROCEDURE SysOpChatWindow; +BEGIN + CLS; + ANSIG(1,1); + Prompt('占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙拷'); + ANSIG(1,12); + Prompt('占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占싶� CTRL-Z Help 占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙孤'); + ANSIG(1,23); + Prompt('占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙占쏙옙;'); +END; + +PROCEDURE SysOpSplitChat; +VAR + S, + SysOpStr, + UserStr, + SysOpLastLineStr, + UserLastLineStr: AStr; + + SysOpLine, + UserLine, + SaveWhereX, + SaveWhereY, + SaveTextAttr: Byte; + + C: Char; + SysOpCPos, + UserCPos: Byte; + + ChatTime: LongInt; + SaveEcho, + SavePrintingFile, + SaveMCIAllowed: Boolean; + + PROCEDURE DoChar(C: Char; VAR CPos,XPos,YPos,Line: Byte; VAR ChatArray: ChatStrArray; VAR WrapLine: AStr); + VAR + Counter, + Counter1: Byte; + BEGIN + IF (CPos < 79) THEN + BEGIN + ANSIG(XPos,YPos); + ChatArray[Line][CPos] := C; + OutKey(C); + Inc(CPos); + Inc(XPos); + + ChatArray[Line][0] := Chr(CPos - 1); + + IF (Trapping) THEN + Write(TrapFile,C); + + END + ELSE + BEGIN + ChatArray[Line][CPos] := C; + Inc(CPos); + + ChatArray[Line][0] := Chr(CPos - 1); + Counter := (CPos - 1); + WHILE (Counter > 0) AND (ChatArray[Line][Counter] <> ' ') AND (ChatArray[Line][Counter] <> ^H) DO + Dec(Counter); + IF (Counter > (CPos DIV 2)) AND (Counter <> (CPos - 1)) THEN + BEGIN + WrapLine := Copy(ChatArray[Line],(Counter + 1),(CPos - Counter)); + FOR Counter1 := (CPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(XPos,YPos); + Prompt(^H); + Dec(XPos); + END; + FOR Counter1 := (CPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(XPos,YPos); + Prompt(' '); + Inc(XPos); + END; + ChatArray[Line][0] := Chr(Counter - 1); + END; + + NL; + + XPos := 2; + + IF (YPos > 1) AND (YPos < 11) OR (YPos > 12) AND (YPos < 22) THEN + BEGIN + Inc(YPos); + Inc(Line); + END + ELSE + BEGIN + + FOR Counter := 1 TO 9 DO + ChatArray[Counter] := ChatArray[Counter + 1]; + + ChatArray[10] := ''; + + + FOR Counter := 10 DOWNTO 1 DO + BEGIN + ANSIG(2,Counter + 1); + PrintMain(ChatArray[Counter]); + Clear_EOL; + END; + + END; + + ANSIG(XPos,YPos); + + CPos := 1; + + ChatArray[Line] := ''; + + IF (WrapLine <> '') THEN + BEGIN + Prompt(WrapLine); + ChatArray[Line] := WrapLine; + WrapLine := ''; + CPos := (Length(ChatArray[Line]) + 1); + XPos := Length(ChatArray[Line]) + 2; + END; + + END; + + END; + + PROCEDURE DOBackSpace(VAR Cpos,XPos: Byte; YPos: Byte; VAR S: AStr); + BEGIN + IF (CPos > 1) THEN + BEGIN + ANSIG(XPos,YPos); + BackSpace; + Dec(CPos); + Dec(XPos); + S[0] := Chr(CPos - 1); + END; + END; + + PROCEDURE DoTab(VAR CPos,XPos: Byte; YPos: Byte; VAR S: AStr); + VAR + Counter, + Counter1: Byte; + BEGIN + Counter := (5 - (CPos MOD 5)); + IF ((CPos + Counter) < 79) THEN + BEGIN + FOR Counter1 := 1 TO Counter DO + BEGIN + ANSIG(XPos,YPos); + Prompt(' '); + S[CPos] := ' '; + Inc(CPos); + Inc(XPos); + END; + S[0] := Chr(CPos - 1); + END; + END; + + PROCEDURE DOCarriageReturn(VAR CPos,XPos,YPos: Byte; VAR S: AStr); + BEGIN + + S[0] := Chr(CPos - 1); + + (* Check Scrool here *) + + Inc(YPos); + XPos := 2; + { Fix Splitscreen so user and op stay on their own sides } + If (YPos = 12) Then + Begin + For i := 2 To 11 Do + Begin + ANSIG(1,i); + Clear_EOL; + End; + YPos := 2; + End + Else If (YPos = 23) Then + Begin + For i := 13 To 22 Do + Begin + ANSIG(1,i); + Clear_EOL; + End; + YPos := 13; + End; + + ANSIG(XPos,YPos); + + (* Do Cmds Here or add as Ctrl *) + + CPos := 1; + S := ''; + END; + + PROCEDURE DOBackSpaceWord(VAR CPos,XPos: Byte; YPos: Byte; VAR S: AStr); + BEGIN + IF (CPos > 1) THEN + BEGIN + REPEAT + ANSIG(XPos,YPos); + BackSpace; + Dec(CPos); + Dec(XPos); + UNTIL (CPos = 1) OR (S[CPos] = ' '); + S[0] := Chr(CPos - 1); + END; + END; + + PROCEDURE DOBackSpaceLine(VAR CPos,Xpos: Byte; YPos: Byte; VAR S: AStr); + VAR + Counter: Byte; + BEGIN + IF (CPos > 1) THEN + BEGIN + FOR Counter := 1 TO (CPos - 1) DO + BEGIN + ANSIG(XPos,YPos); + BackSpace; + Dec(CPos); + Dec(XPos); + END; + S[0] := Chr(CPos - 1); + END; + END; + +BEGIN + SaveWhereX := WhereX; + SaveWhereY := WhereY; + SaveTextAttr := TextAttr; + SaveScreen(Wind); + + 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); + } + + + IF (ChatReason <> '') THEN + BEGIN + lStatus_Screen(100,ChatReason,FALSE,S); + ChatReason := ''; + END; + + SysOpLastLineStr := ''; + UserLastLineStr := ''; + SysOpXPos := 2; + SysOpYPos := 2; + UserXPos := 2; + UserYPos := 13; + + SysOpStr := ''; + UserStr := ''; + SysOpCPos := 1; + UserCPos := 1; + SysOpLine := 1; + UserLine := 1; + + SysOpChatWindow; + + ANSIG(SysOpXPos,SysOpYPos); + + UserColor(General.SysOpColor); + WColor := TRUE; + + REPEAT + + C := Char(GetKey); + + CheckHangUp; + + CASE Ord(C) OF + 32..255 : + IF (WColor) THEN + DoChar(C,SysOpCPos,SysOpXPos,SysOpYPos,SysOpLine,SysOpChat,SysOpLastLineStr) + ELSE + DoChar(C,UserCPos,UserXPos,UserYPos,UserLine,UserChat,UserLastLineStr); + 7 : IF (OutCom) THEN + Com_Send(^G); + 8 : IF (WColor) THEN + DOBackSpace(SysOpCpos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DOBackSpace(UserCpos,UserXPos,UserYPos,UserStr); + 9 : IF (WColor) THEN + DoTab(SysOpCPos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DoTab(UserCPos,UserXPos,UserYPos,UserStr); + 13 : IF (WColor) THEN + DOCarriageReturn(SysOpCPos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DOCarriageReturn(UserCPos,UserXPos,UserYPos,UserStr); + + 17 : InChat := FALSE; + + 23 : IF (WColor) THEN + DOBackSpaceWord(SysOpCPos,SysOpXPos,SysOpYPos,SysOpStr) + ELSE + DOBackSpaceWord(UserCPos,UserXPos,UserYPos,UserStr); + 24 : IF (WColor) THEN + DOBackSpaceLine(SysOpCPos,SysOpXpos,SysOpYPos,SysOpStr) + ELSE + DOBackSpaceLine(UserCPos,UserXpos,UserYPos,UserStr); + + 26 : ; { Help } + END; + + (* + + 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 + FOR Counter := 650 TO 700 DO + BEGIN + Sound(Counter); + Delay(4); + NoSound; + END; + REPEAT + Dec(Counter); + Sound(Counter); + Delay(2); + NoSound; + UNTIL (Counter = 200); + 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)); + + RemoveWindow(Wind); + ANSIG(SaveWhereX,SaveWhereY); + TextAttr := SaveTextAttr; + + { + 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. +>>>>>>> b4a1907d1337950c0b7225c9b507a9a7cb4eb7f6 diff --git a/SOURCE/STATS.PAS b/SOURCE/STATS.PAS new file mode 100644 index 0000000..1e50c87 --- /dev/null +++ b/SOURCE/STATS.PAS @@ -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. \ No newline at end of file diff --git a/SOURCE/SYSOP1.PAS b/SOURCE/SYSOP1.PAS new file mode 100644 index 0000000..3573024 --- /dev/null +++ b/SOURCE/SYSOP1.PAS @@ -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 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 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 L Codes if you utilize the 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 L Codes if you utilize the 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 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 L Command.^1'); + Ok := FALSE; + END; + 11 : IF (Protocol.ULCmd = '') AND (Protocol.DLCmd = '') THEN + BEGIN + Print('%LF^7You must specify a L or 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 L Command if you utilize 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 L Command if you utilize 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 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. L log : ^5'+AOnOff(ULoadLog = '','*None*',ULoadLog)); + PrintACR('^1 L log : ^5'+AOnOff(DLoadLog = '','*None*',DLoadLog)); + END; + PrintACR('^15. L command: ^5'+AOnOff(ULCmd = '','*None*',ULCmd)); + PrintACR('^1 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. 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 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^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 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^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^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^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 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 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^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^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. diff --git a/SOURCE/SYSOP10.PAS b/SOURCE/SYSOP10.PAS new file mode 100644 index 0000000..909f18f --- /dev/null +++ b/SOURCE/SYSOP10.PAS @@ -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. diff --git a/SOURCE/SYSOP11.PAS b/SOURCE/SYSOP11.PAS new file mode 100644 index 0000000..f191a32 --- /dev/null +++ b/SOURCE/SYSOP11.PAS @@ -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. diff --git a/SOURCE/SYSOP12.PAS b/SOURCE/SYSOP12.PAS new file mode 100644 index 0000000..57e789b --- /dev/null +++ b/SOURCE/SYSOP12.PAS @@ -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^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. \ No newline at end of file diff --git a/SOURCE/SYSOP2.PAS b/SOURCE/SYSOP2.PAS new file mode 100644 index 0000000..557f80e --- /dev/null +++ b/SOURCE/SYSOP2.PAS @@ -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. diff --git a/SOURCE/SYSOP2A.PAS b/SOURCE/SYSOP2A.PAS new file mode 100644 index 0000000..d7809c8 --- /dev/null +++ b/SOURCE/SYSOP2A.PAS @@ -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. diff --git a/SOURCE/SYSOP2B.PAS b/SOURCE/SYSOP2B.PAS new file mode 100644 index 0000000..0685d7d --- /dev/null +++ b/SOURCE/SYSOP2B.PAS @@ -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^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^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. diff --git a/SOURCE/SYSOP2C.PAS b/SOURCE/SYSOP2C.PAS new file mode 100644 index 0000000..07b0e57 --- /dev/null +++ b/SOURCE/SYSOP2C.PAS @@ -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. diff --git a/SOURCE/SYSOP2D.PAS b/SOURCE/SYSOP2D.PAS new file mode 100644 index 0000000..ed251c9 --- /dev/null +++ b/SOURCE/SYSOP2D.PAS @@ -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^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. diff --git a/SOURCE/SYSOP2E.PAS b/SOURCE/SYSOP2E.PAS new file mode 100644 index 0000000..33e09e5 --- /dev/null +++ b/SOURCE/SYSOP2E.PAS @@ -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^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. diff --git a/SOURCE/SYSOP2F.PAS b/SOURCE/SYSOP2F.PAS new file mode 100644 index 0000000..fed37d5 --- /dev/null +++ b/SOURCE/SYSOP2F.PAS @@ -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. diff --git a/SOURCE/SYSOP2G.PAS b/SOURCE/SYSOP2G.PAS new file mode 100644 index 0000000..a20ff22 --- /dev/null +++ b/SOURCE/SYSOP2G.PAS @@ -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^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 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^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^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^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^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. diff --git a/SOURCE/SYSOP2H.PAS b/SOURCE/SYSOP2H.PAS new file mode 100644 index 0000000..bb9977a --- /dev/null +++ b/SOURCE/SYSOP2H.PAS @@ -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^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. diff --git a/SOURCE/SYSOP2I.PAS b/SOURCE/SYSOP2I.PAS new file mode 100644 index 0000000..f0ceb04 --- /dev/null +++ b/SOURCE/SYSOP2I.PAS @@ -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. diff --git a/SOURCE/SYSOP2J.PAS b/SOURCE/SYSOP2J.PAS new file mode 100644 index 0000000..ea446c8 --- /dev/null +++ b/SOURCE/SYSOP2J.PAS @@ -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^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^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^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^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^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 �530 �328 �13 �103k'); + PrintACR(' }2 ~Not so general NSGEN �No �854 � 86 �15 �43k'); + PrintACR(' }3 ~Vague VAGUE �No �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^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 �01 Jan 1993 01:00a 랤xodus 뢗enegade'); + PrintACR(' �1 �01 Jan 1993 01:00a 랲uclear 뢚pgrades'); + 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^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. diff --git a/SOURCE/SYSOP2K.PAS b/SOURCE/SYSOP2K.PAS new file mode 100644 index 0000000..9d7efd5 --- /dev/null +++ b/SOURCE/SYSOP2K.PAS @@ -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. diff --git a/SOURCE/SYSOP2L.PAS b/SOURCE/SYSOP2L.PAS new file mode 100644 index 0000000..e1f493f --- /dev/null +++ b/SOURCE/SYSOP2L.PAS @@ -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. diff --git a/SOURCE/SYSOP2M.PAS b/SOURCE/SYSOP2M.PAS new file mode 100644 index 0000000..87c3871 --- /dev/null +++ b/SOURCE/SYSOP2M.PAS @@ -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. diff --git a/SOURCE/SYSOP2O.PAS b/SOURCE/SYSOP2O.PAS new file mode 100644 index 0000000..21f1492 --- /dev/null +++ b/SOURCE/SYSOP2O.PAS @@ -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. diff --git a/SOURCE/SYSOP3.PAS b/SOURCE/SYSOP3.PAS new file mode 100644 index 0000000..c146fe7 --- /dev/null +++ b/SOURCE/SYSOP3.PAS @@ -0,0 +1,1416 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT SysOp3; + +INTERFACE + +USES + Common; + +PROCEDURE ShowUserInfo(DisplayType: Byte; UNum: Integer; CONST User: UserRecordType); +PROCEDURE UserEditor(UNum: Integer); + +IMPLEMENTATION + +USES + CUser, + Mail0, + Script, + ShortMsg, + SysOp2G, + SysOp7, + TimeFunc, + MiscUser; + +FUNCTION DisplayTerminalStr(StatusFlags: StatusFlagSet; Flags: FlagSet): Str8; +VAR + TempS: Str8; +BEGIN + IF (AutoDetect IN StatusFlags) THEN + TempS := 'Auto' + ELSE IF (RIP IN StatusFlags) THEN + TempS := 'RIP' + ELSE IF (Avatar IN Flags) THEN + TempS := 'Avatar' + ELSE IF (ANSI IN Flags) THEN + TempS := 'Ansi' + ELSE IF (OKVT100) THEN + TempS := 'VT-100' + ELSE + TempS := 'None'; + DisplayTerminalStr := PadLeftStr(TempS,8); +END; + +PROCEDURE ShowUserInfo(DisplayType: Byte; UNum: Integer; CONST User: UserRecordType); +VAR + Counter: Byte; + + PROCEDURE ShowUser(VAR Counter1: Byte); + VAR + S: AStr; + BEGIN + WITH User DO + CASE Counter1 OF + 1 : BEGIN + IF (UNum = 0) THEN + S := '^5New User Configuration:' + ELSE + BEGIN + S := '^5User #'+IntToStr(UNum)+' of '+IntToStr(MaxUsers - 1); + IF NOT (OnNode(UNum) IN [0,ThisNode]) THEN + S := PadLeftStr(S,45)+'^8Note: ^3User is on node '+IntToStr(OnNode(UNum)); + END; + S := S + #13#10; + END; + 2 : S := '^1A. User Name : ^3'+PadLeftStr(Name,29)+'^1 L. Security : ^3'+IntToStr(SL); + 3 : S := '^1B. Real Name : ^3'+PadLeftStr(RealName,29)+'^1 M. D Security: ^3'+IntToStr(DSL); + 4 : S := '^1C. Address : ^3'+PadLeftStr(Street,29)+'^1 N. AR: ^3'+DisplayARFlags(AR,'3','1'); + 5 : S := '^1D. City/State: ^3'+PadLeftStr(CityState,29)+'^1 O. AC: ^3'+DisplayACFlags(Flags,'3','1'); + 6 : S := '^1E. Zip code : ^3'+PadLeftStr(ZipCode,29)+'^1 P. Sex/Age : ^3'+ + Sex+IntToStr(AgeUser(BirthDate))+' ('+ToDate8(PD2Date(BirthDate))+')'; + 7 : S := '^1F. SysOp note: ^3'+PadLeftStr(Note,29)+'^1 R. Phone num : ^3'+Ph; + 8 : S := '^1G. '+PadLeftStr(lRGLngStr(41,TRUE){FString.UserDefEd[1]},10)+': ^3'+PadLeftStr(UsrDefStr[1],29)+ + '^1 T. Last/1st : ^3'+ToDate8(PD2Date(LastOn))+ + ' ('+ToDate8(PD2Date(FirstOn))+')'; + 9 : BEGIN + S := '^1H. '+PadLeftStr(lRGLngStr(42,TRUE){FString.UserDefEd[2]},10)+': ^3'+PadLeftStr(UsrDefStr[2],29)+ + '^1 V. Locked out: '+AOnOff(LockedOut IN SFlags,'^7'+LockedFile+'.ASC','^3Inactive'); + END; + 10 : BEGIN + S := '^1I. '+PadLeftStr(lRGLngStr(43,TRUE){FString.UserDefEd[3]},10)+': ^3'+PadLeftStr(UsrDefStr[3],29)+ + '^1 W. Password : [Not Shown]'; + END; + 11 : BEGIN + IF (Deleted IN SFlags) THEN + S := '^8' + ELSE + S := '^1'; + S := S + '[DEL] '; + IF (TrapActivity IN SFlags) AND ((UNum <> UserNum) OR (UserNum = 1)) THEN + IF (TrapSeparate IN SFlags) THEN + S := S + '^8[TRP SEP] ' + ELSE + S := S + '^8[TRP COM] ' + ELSE + S := S + '^1[TRP OFF] '; + IF (LockedOut IN SFlags) THEN + S := S + '^8' + ELSE + S := S + '^1'; + S := S + '[LOCK] '; + IF (Alert IN Flags) THEN + S := S + '^8' + ELSE + S := S + '^1'; + S := S + '[ALRT] '; + S := '^1J. Status : ^3'+PadLeftStr(S,29)+'^1 X. Caller ID : ^3'+CallerID; + END; + 12 : S := '^1K. QWK setup : ^3'+PadLeftStr(General.FileArcInfo[DefArcType].ext,29)+ + '^1 Y. Start Menu: ^3'+IntToStr(UserStartMenu); + 13 : S := '^1Z. Forgot PW : ^3'+ForgotPWAnswer+#13#10; + 14 : S := '^11. Call records - TC: ^3'+PadLeftInt(LoggedOn,8)+ + ' ^1TT: ^3'+PadLeftInt(TTimeOn,8)+ + ' ^1CT: ^3'+PadLeftInt(OnToday,8)+ + ' ^1TL: ^3'+PadLeftInt(TLToday,8)+ + ' ^1TB: ^3'+IntToStr(TimeBank); + 15 : S := '^12. Mail records - PB: ^3'+PadLeftInt(MsgPost,8)+ + ' ^1PV: ^3'+PadLeftInt(EmailSent,8)+ + ' ^1FB: ^3'+PadLeftInt(FeedBack,8)+ + ' ^1WT: ^3'+IntToStr(Waiting); + 16 : S := '^13. File records - DL: ^3'+PadLeftStr(IntToStr(Downloads)+'-'+FormatNumber(DK)+'k',15)+ + ' ^1UL: ^3'+PadLeftStr(IntToStr(Uploads)+'-'+FormatNumber(UK)+'k',15)+ + ' ^1DT: ^3'+IntToStr(DLToday)+'-'+FormatNumber(DLKToday)+'k'; + 17 : S := ' ^1FP: ^3'+IntToStr(FilePoints); + 18 : S := '^14. Pref records - EM: ^3'+DisplayTerminalStr(SFlags,Flags)+ + ' ^1CS: ^3'+PadLeftStr(ShowYesNo(CLSMsg IN SFlags),8)+ + ' ^1PS: ^3'+PadLeftStr(ShowYesNo(Pause IN Flags),8)+ + ' ^1CL: ^3'+PadLeftStr(ShowYesNo(Color IN Flags),8)+ + ' ^1ED: ^3'+AOnOff((FSEditor IN SFlags),'F/S','Reg'); + 19 : S := '^15. Subs records - CR: ^3'+PadLeftInt(lCredit,8)+ + ' ^1DB: ^3'+PadLeftInt(Debit,8)+ + ' ^1BL: ^3'+PadLeftInt(lCredit - Debit,8)+ + ' ^1ED: ^3'+AOnOff((Expiration > 0),ToDate8(PD2Date(Expiration)),'Never ')+ + ' ^1ET: ^3'+AOnOff(ExpireTo <> ' ',ExpireTo,'None'); + END; + PrintACR(S); + Inc(Counter1); + END; + +BEGIN + Abort := FALSE; + Next := FALSE; + CLS; + Counter := 1; + CASE DisplayType OF + 1 : WHILE (Counter <= 19) AND (NOT Abort) AND (NOT HangUp) DO + ShowUser(Counter); + 2 : WHILE (Counter <= 5) AND (NOT Abort) AND (NOT HangUp) DO + ShowUser(Counter); + END; +END; + +PROCEDURE UserEditor(UNum: Integer); +TYPE + F_StatusFlagsRec = (FS_Deleted,FS_Trapping,FS_ChatBuffer,FS_LockedOut,FS_Alert,FS_SLogging); +CONST + AutoList: Boolean = TRUE; + UserInfoTyp: Byte = 1; + F_State: ARRAY [0..14] OF Boolean = (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE); + F_GenText: STRING[40] = ''; + F_ACS: STRING[20] = ''; + F_SL1: Byte = 0; + F_SL2: Byte = 255; + F_DSL1: Byte = 0; + F_DSL2: Byte = 255; + F_AR: ARFlagSet = []; + F_AC: FlagSet = []; + F_Status: SET OF F_StatusFlagsRec = []; + F_LastOn1: LongInt = 0; + F_LastOn2: LongInt = $FFFFFFF; + F_FirstOn1: LongInt = 0; + F_FirstOn2: LongInt = $FFFFFFF; + F_NumCalls1: LongInt = 0; + F_NumCalls2: LongInt = 2147483647; + F_Age1: Byte = 0; + F_Age2: Byte = 255; + F_Gender: Char = 'M'; + F_PostRatio1: LongInt = 0; + F_PostRatio2: LongInt = 2147483647; + F_DLKRatio1: LongInt = 0; + F_DLKRatio2: LongInt = 2147483647; + F_DLRatio1: LongInt = 0; + F_DLRatio2: LongInt = 2147483647; +VAR + User: UserRecordType; + TempStr: AStr; + Cmd: Char; + TempB, + Counter: Byte; + UNum1, + SaveUNum, + TempMaxUsers, + RecNumToList: Integer; + Changed, + Save, + Save1, + Ok: Boolean; + + FUNCTION SearchType(SType: Byte): AStr; + BEGIN + CASE SType OF + 0 : SearchType := 'General text'; + 1 : SearchType := 'Search ACS'; + 2 : SearchType := 'User SL'; + 3 : SearchType := 'User DSL'; + 4 : SearchType := 'User AR Flags'; + 5 : SearchType := 'User AC Flags'; + 6 : SearchType := 'User status'; + 7 : SearchType := 'Date since last on'; + 8 : SearchType := 'Date since first on'; + 9 : SearchType := 'Number of calls'; + 10 : SearchType := 'User age'; + 11 : SearchType := 'User gender'; + 12 : SearchType := '# 1/10''s call/post'; + 13 : SearchType := '#k DL/1k UL'; + 14 : SearchType := '# DLs/1 UL'; + END; + END; + + FUNCTION Find_FS: AStr; + VAR + FSF: F_StatusFlagsRec; + TempStr1: AStr; + BEGIN + TempStr1 := ''; + FOR FSF := FS_Deleted TO FS_SLogging DO + IF (FSF IN F_Status) THEN + CASE FSF OF + FS_Deleted : TempStr1 := TempStr1 +'Deleted,'; + FS_Trapping : TempStr1 := TempStr1 +'Trapping,'; + FS_ChatBuffer: TempStr1 := TempStr1 +'Chat Buffering,'; + FS_LockedOut : TempStr1 := TempStr1 +'Locked Out,'; + FS_Alert : TempStr1 := TempStr1 +'Alert,'; + FS_SLogging : TempStr1 := TempStr1 +'Sep. SysOp Log,'; + END; + IF (TempStr1 <> '') THEN + TempStr1 := Copy(TempStr1,1,(Length(TempStr1) - 1)) + ELSE + TempStr1 := 'None.'; + Find_FS := TempStr1; + END; + + PROCEDURE DisplaySearchOptions; + VAR + TempStr1: AStr; + Cmd1: Char; + Counter1: Byte; + BEGIN + Print('^5Search Criterea:^1'); + NL; + Abort := FALSE; + Next := FALSE; + Counter1 := 0; + WHILE ((Counter1 <= 14) AND (NOT Abort) AND (NOT HangUp)) DO + BEGIN + CASE Counter1 OF + 0..9 : + Cmd1 := Chr(Counter1 + 48); + 10 : Cmd1 := 'A'; + 11 : Cmd1 := 'G'; + 12 : Cmd1 := 'P'; + 13 : Cmd1 := 'K'; + 14 : Cmd1 := 'N'; + END; + Prompt('^1'+Cmd1+'. '+PadLeftStr(SearchType(Counter1),19)+': '); + TempStr1 := ''; + IF (NOT F_State[Counter1]) THEN + TempStr1 := '^5' + ELSE + BEGIN + CASE Counter1 OF + 0 : TempStr1 := '"'+F_GenText+'"'; + 1 : TempStr1 := '"'+F_ACS+'"'; + 2 : TempStr1 := IntToStr(F_SL1)+' SL ... '+IntToStr(F_SL2)+' SL'; + 3 : TempStr1 := IntToStr(F_DSL1)+' DSL ... '+IntToStr(F_DSL2)+' DSL'; + 4 : TempStr1 := DisplayARFlags(F_AR,'3','1'); + 5 : TempStr1 := DisplayACFlags(F_AC,'3','1'); + 6 : TempStr1 := Find_FS; + 7 : TempStr1 := PD2Date(F_LastOn1)+' ... '+PD2Date(F_LastOn2); + 8 : TempStr1 := PD2Date(F_FirstOn1)+' ... '+PD2Date(F_FirstOn2); + 9 : TempStr1 := IntToStr(F_NumCalls1)+' calls ... '+IntToStr(F_NumCalls2)+' calls'; + 10 : TempStr1 := IntToStr(F_Age1)+' years ... '+IntToStr(F_Age2)+' years'; + 11 : TempStr1 := AOnOff(F_Gender = 'M','Male','Female'); + 12 : TempStr1 := IntToStr(F_PostRatio1)+' ... '+IntToStr(F_PostRatio2); + 13 : TempStr1 := IntToStr(F_DLKRatio1)+' ... '+IntToStr(F_DLKRatio2); + 14 : TempStr1 := IntToStr(F_DLRatio1)+' ... '+IntToStr(F_DLRatio2); + END; + UserColor(3); + END; + Print(TempStr1); + WKey; + Inc(Counter1); + END; + END; + + FUNCTION OKUser(UNum1: Integer): Boolean; + VAR + FSF: F_StatusFlagsRec; + User1: UserRecordType; + Counter1: Byte; + TempL: LongInt; + Ok1: Boolean; + + FUNCTION NoFindIt(TempStr1: AStr): Boolean; + BEGIN + NoFindIt := (Pos(AllCaps(F_GenText),AllCaps(TempStr1)) = 0); + END; + + BEGIN + WITH User1 DO + BEGIN + LoadURec(User1,UNum1); + Ok1 := TRUE; + Counter1 := 0; + WHILE ((Counter1 <= 14) AND (Ok1)) DO + BEGIN + IF (F_State[Counter1]) THEN + CASE Counter1 OF + 0 : IF ((NoFindIt(Name)) AND (NoFindIt(RealName)) AND + (NoFindIt(Street)) AND (NoFindIt(CityState)) AND + (NoFindIt(ZipCode)) AND (NoFindIt(UsrDefStr[1])) AND + (NoFindIt(Ph)) AND (NoFindIt(Note)) AND + (NoFindIt(UsrDefStr[2])) AND (NoFindIt(UsrDefStr[3]))) THEN + Ok1 := FALSE; + 1 : IF (NOT AACS1(User1,UNum1,F_ACS)) THEN + Ok1 := FALSE; + 2 : IF ((SL < F_SL1) OR (SL > F_SL2)) THEN + Ok1 := FALSE; + 3 : IF ((DSL < F_DSL1) OR (DSL > F_DSL2)) THEN + Ok1 := FALSE; + 4 : IF (NOT (AR >= F_AR)) THEN + Ok1 := FALSE; + 5 : IF (NOT (Flags >= F_AC)) THEN + Ok1 := FALSE; + 6 : FOR FSF := FS_Deleted TO FS_SLogging DO + IF (FSF IN F_Status) THEN + CASE FSF OF + FS_Deleted : IF NOT (Deleted IN User1.SFlags) THEN + Ok1 := FALSE; + FS_Trapping : IF NOT (TrapActivity IN User1.SFlags) THEN + Ok1 := FALSE; + FS_ChatBuffer : IF NOT (ChatAuto IN User1.SFlags) THEN + Ok1 := FALSE; + FS_LockedOut : IF NOT (LockedOut IN User1.SFlags) THEN + Ok1 := FALSE; + FS_Alert : IF NOT ((Alert IN Flags)) THEN + Ok1 := FALSE; + FS_SLogging : IF NOT (SLogSeparate IN User1.SFlags) THEN + Ok1 := FALSE; + END; + 7 : IF ((LastOn < F_LastOn1) OR (LastOn > F_LastOn2)) THEN + Ok1 := FALSE; + 8 : IF ((FirstOn < F_FirstOn1) OR (FirstOn > F_FirstOn2)) THEN + Ok1 := FALSE; + 9 : IF ((LoggedOn < F_NumCalls1) OR (LoggedOn > F_NumCalls2)) THEN + Ok1 := FALSE; + 10 : IF (((AgeUser(BirthDate) < F_Age1) OR (AgeUser(BirthDate) > F_Age2)) AND (AgeUser(BirthDate) <> 0)) THEN + Ok1 := FALSE; + 11 : IF (Sex <> F_Gender) THEN + Ok1 := FALSE; + 12 : BEGIN + IF (LoggedOn > 0) THEN + TempL := LoggedOn + ELSE + TempL := 1; + TempL := ((MsgPost DIV TempL) * 100); + IF ((TempL < F_PostRatio1) OR (TempL > F_PostRatio2)) THEN + Ok1 := FALSE; + END; + 13 : BEGIN + IF (UK > 0) THEN + TempL := UK + ELSE + TempL := 1; + TempL := (DK DIV TempL); + IF ((TempL < F_DLKRatio1) OR (TempL > F_DLKRatio2)) THEN + Ok1 := FALSE; + END; + 14 : BEGIN + IF (Uploads > 0) THEN + TempL := Uploads + ELSE + TempL := 1; + TempL := (Downloads DIV TempL); + IF ((TempL < F_DLRatio1) OR (TempL > F_DLRatio2)) THEN + Ok1 := FALSE; + END; + END; + Inc(Counter1); + END; + END; + OKUser := Ok1; + END; + + PROCEDURE Search(i: Integer); + VAR + n, + TempMaxUsers: Integer; + BEGIN + Prompt('Searching ... '); + Reset(UserFile); + TempMaxUsers := (MaxUsers - 1); + n := UNum; + REPEAT + Inc(UNum,i); + IF (UNum < 1) THEN + UNum := TempMaxUsers; + IF (UNum > TempMaxUsers) THEN + UNum := 1; + UNTIL ((OKUser(UNum)) OR (UNum = n)); + Close(UserFile); + END; + + PROCEDURE Clear_F; + VAR + Counter1: Byte; + BEGIN + FOR Counter1 := 0 TO 14 DO + F_State[Counter1] := FALSE; + F_GenText := ''; + F_ACS := ''; + F_SL1 := 0; + F_SL2 := 255; + F_DSL1 := 0; + F_DSL2 := 255; + F_AR := []; + F_AC := []; + F_Status := []; + F_LastOn1 := 0; + F_LastOn2 := $FFFFFFF; + F_FirstOn1 := 0; + F_FirstOn2 := $FFFFFFF; + F_NumCalls1 := 0; + F_NumCalls2 := 2147483647; + F_Age1 := 0; + F_Age2 := 255; + F_Gender := 'M'; + F_PostRatio1 := 0; + F_PostRatio2 := 2147483647; + F_DLKRatio1 := 0; + F_DLKRatio2 := 2147483647; + F_DLRatio1 := 0; + F_DLRatio2 := 2147483647; + END; + + PROCEDURE UserSearch; + VAR + User1: UserRecordType; + FSF: F_StatusFlagsRec; + TempStr1: AStr; + Cmd1: Char; + SType, + UNum1, + UserCount: Integer; + Changed1: Boolean; + BEGIN + DisplaySearchOptions; + REPEAT + NL; + Prt('Change [^5?^4=^5Help^4]: '); + OneK(Cmd1,'Q0123456789AGPKNCLTU?'^M,TRUE,TRUE); + NL; + CASE Cmd1 OF + '0'..'9' : + SType := (Ord(Cmd1) - 48); + 'A' : SType := 10; + 'G' : SType := 11; + 'P' : SType := 12; + 'K' : SType := 13; + 'N' : SType := 14; + ELSE + SType := -1; + END; + IF (SType <> -1) THEN + BEGIN + Prompt('^5[>^0 '); + IF (F_State[SType]) THEN + Print(SearchType(SType)+'^1') + ELSE + BEGIN + F_State[SType] := TRUE; + Print(SearchType(SType)+' is now *ON*^1'); + END; + NL; + END; + CASE Cmd1 OF + '0' : BEGIN + Print('General text ["'+F_GenText+'"]'); + Prt(': '); + MPL(40); + Input(TempStr1,40); + IF (TempStr1 <> '') THEN + F_GenText := TempStr1; + END; + '1' : BEGIN + Print('Search ACS ["'+F_ACS+'"]'); + Prt(': '); + MPL(20); + InputL(TempStr1,20); + IF (TempStr1 <> '') THEN + F_ACS := TempStr1; + END; + '2' : BEGIN + InputByteWOC('Lower limit',F_SL1,[DisplayValue,NumbersOnly],0,255); + InputByteWOC('%LFUpper limit',F_SL2,[DisplayValue,NumbersOnly],(0 + F_SL1),255); + END; + '3' : BEGIN + InputByteWOC('Lower limit',F_DSL1,[DisplayValue,NumbersOnly],0,255); + InputByteWOC('%LFUpper limit',F_DSL2,[DisplayValue,NumbersOnly],(0 + F_DSL1),255); + END; + '4' : BEGIN + REPEAT + Prt('Toggle which AR flag? ('+DisplayArFlags(F_AR,'5','4')+'^4) [^5?^4=^5Help^4,^5^4=^5Quit^4]: '); + OneK(Cmd1,^M'ABCDEFGHIJKLMNOPQRSTUVWXYZ?',TRUE,TRUE); + IF (Cmd1 = '?') THEN + PrintF('ARFLAGS') + ELSE IF (Cmd1 <> ^M) THEN + ToggleARFlag(Cmd1,F_AR,Changed); + UNTIL ((Cmd1 = ^M) OR (HangUp)); + Cmd1 := #0; + END; + '5' : BEGIN + REPEAT + Prt('Toggle which AC flag? ['+DisplayACFlags(F_AC,'5','4')+'] [?]Help: '); + OneK(Cmd1,^M'LCVUA*PEKM1234?',TRUE,TRUE); + IF (Cmd1 = '?') THEN + PrintF('ACFLAGS') + ELSE IF (Cmd1 <> ^M) THEN + ToggleACFlags(Cmd1,F_AC,Changed1); + UNTIL (Cmd1 = ^M) OR (HangUp); + Cmd1 := #0; + END; + '6' : BEGIN + REPEAT + Print('^4Current flags: ^3'+Find_FS); + NL; + Prt('Toggle which status flag? (^5?^4=^5Help^4): '); + OneK(Cmd1,'QACDLST? '^M,TRUE,TRUE); + CASE Cmd1 OF + 'A' : FSF := FS_Alert; + 'C' : FSF := FS_ChatBuffer; + 'D' : FSF := FS_Deleted; + 'L' : FSF := FS_LockedOut; + 'S' : FSF := FS_SLogging; + 'T' : FSF := FS_Trapping; + '?' : BEGIN + NL; + LCmds(15,3,'Alert','Chat-buffering'); + LCmds(15,3,'Deleted','Locked-out'); + LCmds(15,3,'Separate SysOp logging','Trapping'); + END; + END; + IF (Cmd1 IN ['A','C','D','L','S','T']) THEN + IF (FSF IN F_Status) THEN + Exclude(F_Status,FSF) + ELSE + Include(F_Status,FSF); + UNTIL ((Cmd1 IN ['Q',' ',^M]) OR (HangUp)); + Cmd1 := #0; + END; + '7' : BEGIN + Prt('Starting date: '); + MPL(10); + InputFormatted('',TempStr1,'##/##/####',TRUE); + F_LastOn1 := Date2PD(TempStr1); + NL; + Prt('Ending date: '); + MPL(10); + InputFormatted('',TempStr1,'##/##/####',TRUE); + F_LastOn2 := Date2PD(TempStr1); + END; + '8' : BEGIN + Prt('Starting date: '); + MPL(10); + InputFormatted('',TempStr1,'##/##/####',TRUE); + F_FirstOn1 := Date2PD(TempStr1); + NL; + Prt('Ending date: '); + MPL(10); + InputFormatted('',TempStr1,'##/##/####',TRUE); + F_FirstOn2 := Date2PD(TempStr1); + END; + '9' : BEGIN + InputLongIntWOC('%LFLower limit',F_NumCalls1,[DisplayValue,NumbersOnly],0,2147483647); + InputLongIntWOC('%LFUpper limit',F_NumCalls2,[DisplayValue,NumbersOnly],(0 + F_NumCalls1),2147483647); + END; + 'A' : BEGIN + InputByteWOC('Lower limit',F_Age1,[DisplayValue,NumbersOnly],0,255); + InputByteWOC('%LFUpper limit',F_Age2,[displayValue,NumbersOnly],(0 + F_Age1),255); + END; + 'G' : BEGIN + Prt('Gender ['+F_Gender+']: '); + OneK(Cmd1,^M'MF',TRUE,TRUE); + IF (Cmd1 IN ['F','M']) THEN + F_Gender := Cmd1; + END; + 'P' : BEGIN + InputLongIntWOC('%LFLower limit',F_PostRatio1,[DisplayValue,NumbersOnly],0,2147483647); + InputLongIntWOC('%LFUpper limit',F_PostRatio2,[DisplayValue,NumbersOnly],(0 + F_PostRatio1),2147483647); + END; + 'K' : BEGIN + InputLongIntWOC('%LFLower limit',F_DLKRatio1,[DisplayValue,NumbersOnly],0,2147483647); + InputLongIntWOC('%LFUpper limit',F_DLKRatio2,[DisplayValue,NumbersOnly],(0 + F_DLKRatio1),2147483647); + END; + 'N' : BEGIN + InputLongIntWOC('%LFLower limit',F_DLRatio1,[DisplayValue,NumbersOnly],0,2147483647); + InputLongIntWOC('%LFUpper limit',F_DLRatio2,[DisplayValue,NumbersOnly],(0 + F_DLRatio1),2147483647); + END; + 'C' : IF PYNQ('Are you sure? ',0,FALSE) THEN + Clear_F; + ^M,'L' : + DisplaySearchOptions; + 'T' : BEGIN + Prt('Which (0-9,A,G,P,K,N)? [Q]=Quit]: '); + OneK(Cmd1,'Q0123456789AGPKN'^M,TRUE,TRUE); + NL; + CASE Cmd1 OF + '0'..'9' : + SType := (Ord(Cmd1) - 48); + 'A' : SType := 10; + 'G' : SType := 11; + 'P' : SType := 12; + 'K' : SType := 13; + 'N' : SType := 14; + ELSE + SType := -1; + END; + IF (SType <> -1) THEN + BEGIN + F_State[SType] := NOT F_State[SType]; + Prompt('^5[>^0 '+SearchType(SType)+' is now *'+AonOff(F_State[SType],'ON','OFF')+'*^1'); + NL; + END; + Cmd1 := #0; + END; + 'U' : BEGIN + Abort := FALSE; + Next := FALSE; + Reset(UserFile); + UserCount := 0; + TempMaxUsers := (MaxUsers - 1); + UNum1 := 1; + WHILE (UNum1 <= TempMaxUsers) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (OKUser(UNum1)) THEN + BEGIN + LoadURec(User1,UNum1); + PrintACR('^3'+Caps(User1.Name)+' #'+IntToStr(UNum1)); + Inc(UserCount); + END; + Inc(UNum1); + END; + Close(UserFile); + IF (NOT Abort) THEN + BEGIN + NL; + Print('^7 ** ^5'+IntToStr(UserCount)+' Users.^1'); + END; + END; + '?' : BEGIN + Print('^30-9,AGPKN^1: Change option'); + LCmds(14,3,'List options','Toggle options on/off'); + LCmds(14,3,'Clear options','User''s who match'); + LCmds(14,3,'Quit',''); + END; + END; + UNTIL (Cmd1 = 'Q') OR (HangUp); + END; + + PROCEDURE KillUserMail; + VAR + User1: UserRecordType; + MHeader: MHeaderRec; + SaveReadMsgArea: Integer; + MsgNum: Word; + BEGIN + SaveReadMsgArea := ReadMsgArea; + InitMsgArea(-1); + Reset(MsgHdrF); + FOR MsgNum := 1 TO HiMsg DO + BEGIN + LoadHeader(MsgNum,MHeader); + IF (NOT (MDeleted IN MHeader.Status)) AND ((MHeader.MTO.UserNum = UNum) OR (MHeader.From.UserNum = UNum)) THEN + BEGIN + Include(MHeader.Status,MDeleted); + SaveHeader(MsgNum,MHeader); + LoadURec(User1,MHeader.MTO.UserNum); + IF (User1.Waiting > 0) THEN + Dec(User1.Waiting); + SaveURec(User1,MHeader.MTO.UserNum); + Reset(MsgHdrF); + END; + END; + Close(MsgHdrF); + InitMsgArea(SaveReadMsgArea); + END; + + PROCEDURE KillUserVotes; + VAR + Counter1: Byte; + BEGIN + Assign(VotingFile,General.DataPath+'VOTING.DAT'); + Reset(VotingFile); + IF (IOResult = 0) THEN + BEGIN + FOR Counter1 := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter1] > 0) THEN + BEGIN + Seek(VotingFile,(Counter1 - 1)); + Read(VotingFile,Topic); + Dec(Topic.Answers[User.Vote[Counter1]].NumVotedAnswer); + Dec(Topic.NumVotedQuestion); + Seek(VotingFile,(Counter1 - 1)); + Write(VotingFile,Topic); + User.Vote[Counter1] := 0; + END; + Close(VotingFile); + END; + LastError := IOResult; + END; + + PROCEDURE ChangeRecords(On: Byte); + VAR + OneKCmds: AStr; + Cmd1: Char; + TempL1: LongInt; + BEGIN + WITH User DO + REPEAT + NL; + CASE on OF + 1 : BEGIN + Print('^5Call records:^1'); + NL; + Print('^11. Total calls : ^5'+IntToStr(LoggedOn)); + Print('^12. Total time on : ^5'+IntToStr(TTimeOn)); + Print('^13. Calls today : ^5'+IntToStr(OnToday)); + Print('^14. Time left today: ^5'+IntToStr(TLToday)); + Print('^15. Ill. logons : ^5'+IntToStr(Illegal)); + Print('^16. Time Bank : ^5'+IntToStr(TimeBank)); + NL; + Prt('Select: (1-6) [M]ail [F]ile [P]ref [S]ubs: '); + OneK(Cmd1,^M'123456MFPS',TRUE,TRUE); + END; + 2 : BEGIN + Print('^5Mail records:^1'); + NL; + Print('^11. Pub. posts : ^5'+IntToStr(MsgPost)); + Print('^12. Priv. posts : ^5'+IntToStr(EmailSent)); + Print('^13. Fback sent : ^5'+IntToStr(FeedBack)); + Print('^14. Mail Waiting: ^5'+IntToStr(Waiting)); + NL; + Prt('Select: (1-4) [C]all [F]ile [P]ref [S]ubs: '); + OneK(Cmd1,^M'1234CFPS',TRUE,TRUE); + END; + 3 : BEGIN + Print('^5File records:^1'); + NL; + Print('^11. # of DLs : ^5'+IntToStr(Downloads)); + Print('^12. DL K : ^5'+FormatNumber(DK)+'k'); + Print('^13. # of ULs : ^5'+IntToStr(Uploads)); + Print('^14. UL K : ^5'+FormatNumber(UK)+'k'); + Print('^15. # DLs today: ^5'+IntToStr(DLToday)); + Print('^16. DL K today : ^5'+FormatNumber(DLKToday)+'k'); + Print('^17. File Points: ^5'+FormatNumBer(FilePoints)); + NL; + Prt('Select: (1-7) [C]all [M]ail [P]ref [S]ubs: '); + OneK(Cmd1,^M'1234567CMPS',TRUE,TRUE); + END; + 4 : BEGIN + Print('^5Preference records:^1'); + NL; + Print('^11. Emulation: ^5'+DisplayTerminalStr(SFlags,Flags)); + Print('^12. Clr Scrn : ^5'+AOnOff((CLSMsg IN SFlags),'On','Off')); + Print('^13. Pause : ^5'+AOnOff((Pause IN Flags),'On','Off')); + Print('^14. Color : ^5'+AOnOff((Color IN Flags),'On','Off')); + Print('^15. Editor : ^5'+AOnOff((FSEditor IN SFlags),'F/S','Reg')); + NL; + Prt('Select (1-5) [C]all [M]ail [F]ile [S]ubs: '); + OneK(Cmd1,^M'12345CMFS',TRUE,TRUE); + END; + 5 : BEGIN + Print('^5Subscription records:^1'); + NL; + Print('^11. Credit : ^5'+IntToStr(lCredit)); + Print('^12. Debit : ^5'+IntToStr(Debit)); + Print('^13. Expires : ^5'+AOnOff(Expiration = 0,'Never',ToDate8(PD2Date(Expiration)))); + Print('^1 Expire to: ^5'+AOnOff(ExpireTo = ' ','None',ExpireTo)); + NL; + Prt('Select: (1-3) [C]all [M]ail [P]ref [F]ile: '); + OneK(Cmd1,^M'123CMPF',TRUE,TRUE); + END; + END; + CASE Cmd1 OF + 'C' : on := 1; + 'M' : on := 2; + 'F' : on := 3; + 'P' : on := 4; + 'S' : on := 5; + '1'..'7' : + BEGIN + NL; + IF (on <> 4) THEN + BEGIN + IF (on <> 5) OR NOT (StrToInt(Cmd1) IN [3..4]) THEN + BEGIN + Prt('New value: '); + Input(TempStr,10); + TempL1 := StrToInt(TempStr); + END + ELSE + CASE StrToInt(Cmd1) OF + 3 : IF (PYNQ('Reset expiration date & level? ',0,FALSE)) THEN + BEGIN + TempL1 := 0; + TempStr := ' '; + END + ELSE + BEGIN + NL; + Prt('New expiration date: '); + MPL(10); + InputFormatted('',TempStr,'##/##/####',TRUE); + IF (TempStr <> '') THEN + TempL1 := Date2PD(TempStr) + ELSE + TempL1 := 0; + OneKCmds := ''; + FOR Cmd1 := '!' TO '~' DO + IF (Cmd1 IN ValKeys) THEN + OneKCmds := OneKCmds + Cmd1; + NL; + Prt('Level to expire to (!-~) [Space=No Change]: '); + OneK1(Cmd1,^M' '+OneKCmds,TRUE,TRUE); + TempStr := Cmd1; + IF (TempL1 = 0) OR (TempStr = ' ') THEN + BEGIN + TempL1 := 0; + TempStr := ' '; + END; + Cmd1 := '3'; + END; + END; + IF (TempStr <> '') THEN + CASE on OF + 1 : CASE StrToInt(Cmd1) OF + 1 : LoggedOn := TempL1; + 2 : TTimeOn := TempL1; + 3 : OnToday := TempL1; + 4 : TLToday := TempL1; + 5 : Illegal := TempL1; + 6 : TimeBank := TempL1; + END; + 2 : CASE StrToInt(Cmd1) OF + 1 : MsgPost := TempL1; + 2 : EmailSent := TempL1; + 3 : FeedBack := TempL1; + 4 : Waiting := TempL1; + END; + 3 : CASE StrToInt(Cmd1) OF + 1 : Downloads := TempL1; + 2 : DK := TempL1; + 3 : Uploads := TempL1; + 4 : UK := TempL1; + 5 : DLToday := TempL1; + 6 : DLKToday := TempL1; + 7 : FilePoints := TempL1; + END; + 5 : CASE StrToInt(Cmd1) OF + 1 : lCredit := TempL1; + 2 : Debit := TempL1; + 3 : BEGIN + Expiration := TempL1; + IF (TempStr[1] IN [' ','!'..'~']) THEN + ExpireTo := TempStr[1]; + END; + END; + END; + END + ELSE + CASE StrToInt(Cmd1) OF + 1 : CStuff(3,3,User); + 2 : ToggleStatusFlag(CLSMsg,SFlags); + 3 : ToggleACFlag(Pause,Flags); + 4 : ToggleACFlag(Color,Flags); + 5 : ToggleStatusFlag(FSEditor,SFlags); + END; + END; + END; + UNTIL (Cmd1 = ^M) OR (HangUp); + END; + +BEGIN + IF ((UNum < 1) OR (UNum > (MaxUsers - 1))) THEN + Exit; + IF (UNum = UserNum) THEN + BEGIN + User := ThisUser; + SaveURec(User,UNum); + END; + LoadURec(User,UNum); + Clear_F; + SaveUNum := 0; + Save := FALSE; + REPEAT + Abort := FALSE; + IF (AutoList) OR (UNum <> SaveUNum) OR (Cmd = ^M) THEN + BEGIN + ShowUserInfo(UserInfoTyp,UNum,User); + SaveUNum := UNum; + END; + NL; + Prt('User editor [^5?^4=^5Help^4]: '); + OneK(Cmd,'Q?[]=${}*ABCDEFGHIJKLMNOPRSTUVWXYZ12345-+_;:\/^'^M,TRUE,TRUE); + IF (Cmd IN ['A','F','L'..'O','S'..'X','Z','/','{','}','-',';','^','?','<','\','=','_']) THEN + NL; + CASE Cmd OF + '?' : BEGIN + Abort := FALSE; + PrintACR('^5Editor Help'); + NL; + LCmds3(21,3,';New list mode',':AutoList toggle','\Show sysop log'); + LCmds3(21,3,'[Back one user',']Forward one user','=Reload old data'); + LCmds3(21,3,'{Search backward','}Search forward','*Validate user'); + LCmds3(21,3,'+Mailbox','UGoto user name/#','Search options'); + LCmds3(21,3,'-New user answers','_Other Q. answers','^Delete user'); + LCmds3(21,3,'/New user config','$Clear fields',''); + NL; + PauseScr(FALSE); + Save := FALSE; + END; + '[',']','/','{','}','U','Q' : + BEGIN + IF (Save) THEN + BEGIN + SaveURec(User,UNum); + IF (UNum = UserNum) THEN + ThisUser := User; + Save := FALSE; + END; + CASE Cmd OF + '[' : BEGIN + Dec(UNum); + IF (UNum < 1) THEN + UNum := (MaxUsers - 1); + END; + ']' : BEGIN + Inc(UNum); + IF (UNum > (MaxUsers - 1)) THEN + UNum := 1; + END; + '/' : UNum := 0; + '{' : Search(-1); + '}' : Search(1); + 'U' : BEGIN + Print('Enter User Name, #, or partial search string.'); + Prt(': '); + lFindUserWS(UNum1); + IF (UNum1 > 0) THEN + BEGIN + LoadURec(User,UNum1); + UNum := UNum1; + END; + END; + END; + LoadURec(User,UNum); + IF (UNum = UserNum) THEN + ThisUser := User; + END; + '=' : IF PYNQ('Reload old user data? ',0,FALSE) THEN + BEGIN + LoadURec(User,UNum); + IF (UNum = UserNum) THEN + ThisUser := User; + Save := FALSE; + Print('^7Old data reloaded.^1'); + END; + 'S','-','_',';',':','\' : + BEGIN + CASE Cmd OF + 'S' : UserSearch; + '-' : BEGIN + ReadAsw(UNum,General.MiscPath+'NEWUSER'); + PauseScr(FALSE); + END; + '_' : BEGIN + Prt('Print questionairre file: '); + MPL(8); + Input(TempStr,8); + NL; + ReadAsw(UNum,General.MiscPath+TempStr); + PauseScr(FALSE); + END; + ';' : BEGIN + Prt('(L)ong or (S)hort list mode: '); + OneK(Cmd,'QSL '^M,TRUE,TRUE); + CASE Cmd OF + 'S' : UserInfoTyp := 2; + 'L' : UserInfoTyp := 1; + END; + Cmd := #0; + END; + ':' : AutoList := NOT AutoList; + '\' : BEGIN + TempStr := General.LogsPath+'SLOG'+IntToStr(UNum)+'.LOG'; + PrintF(TempStr); + IF (NoFile) THEN + Print('"'+TempStr+'": File not found.'); + PauseScr(FALSE); + END; + END; + END; + '$','*','+','A','B','C','D','E','F','G','H','I','J','K','L','M', + 'N','O','P','R','T','V','W','X','Y','Z','1','2','3','4','5','^' : + BEGIN + IF (((ThisUser.SL <= User.SL) OR (ThisUser.DSL <= User.DSL)) AND + (UserNum <> 1) AND (UserNum <> UNum)) THEN + BEGIN + SysOpLog('Tried to modify '+Caps(User.Name)+' #'+IntToStr(UNum)); + Print('Access denied.'); + NL; + PauseScr(FALSE); + END + ELSE + BEGIN + Save1 := Save; + Save := TRUE; + CASE Cmd OF + '$' : BEGIN + REPEAT + NL; + Prt('Clear fields (^5A^4-^5J^4,^5Q^4=^5Quit^4,^5?^4=^5Help^4): '); + OneK(Cmd,'QABCDEFGHIJ?',TRUE,TRUE); + IF (Cmd = '?') THEN + NL; + CASE Cmd OF + 'A' : User.RealName := User_String_Ask; + 'B' : User.Street := User_String_Ask; + 'C' : User.CityState := User_String_Ask; + 'D' : User.ZipCode := User_String_Ask; + 'E' : User.Birthdate := User_Date_Ask; + 'F' : User.Ph := User_Phone_Ask; + 'G' : User.UsrDefStr[1] := User_String_Ask; + 'H' : User.UsrDefStr[2] := User_String_Ask; + 'I' : User.UsrDefStr[3] := User_String_Ask; + 'J' : User.ForgotPWAnswer := User_String_Ask; + '?' : BEGIN + LCmds(20,3,'AReal Name','BStreet'); + LCmds(20,3,'CCity/State','DZip Code'); + LCmds(20,3,'EBirth Date','FPhone'); + LCmds(20,3,'GString 1','HString 2'); + LCmds(20,3,'IString 3','JPW Answer'); + END; + END; + UNTIL (Cmd = 'Q') OR (HangUp); + Cmd := #0; + END; + '*' : AutoVal(User,UNum); + '+' : CStuff(15,3,User); + '1'..'5' : + ChangeRecords(Ord(Cmd) - 48); + 'A' : BEGIN + IF (Deleted IN User.SFlags) THEN + Print('Can''t rename deleted users.') + ELSE + BEGIN + Print('Enter new name.'); + Prt(': '); + MPL((SizeOf(ThisUser.Name) - 1)); + Input(TempStr,(SizeOf(ThisUser.Name) - 1)); + UNum1 := SearchUser(TempStr,TRUE); + IF ((UNum1 = 0) OR (UNum1 = UNum)) AND (TempStr <> '') THEN + BEGIN + InsertIndex(User.Name,UNum,FALSE,TRUE); + User.Name := TempStr; + InsertIndex(User.Name,UNum,FALSE,FALSE); + Save := TRUE; + IF (UNum = UserNum) THEN + ThisUser.Name := TempStr; + END + ELSE + Print('Illegal Name.'); + END; + END; + 'B' : BEGIN + TempStr := User.RealName; + CStuff(10,3,User); + IF (User.RealName <> TempStr) THEN + BEGIN + InsertIndex(TempStr,UNum,TRUE,TRUE); + InsertIndex(User.RealName,UNum,TRUE,FALSE); + END; + END; + 'C' : CStuff(1,3,User); + 'D' : CStuff(4,3,User); + 'E' : CStuff(14,3,User); + 'F' : InputWN1('^1New SysOp note:%LF^4: ',User.Note,(SizeOf(User.Note) - 1),[ColorsAllowed],Next); + 'G' : CStuff(5,3,User); + 'H' : CStuff(6,3,User); + 'I' : CStuff(13,3,User); + 'J' : BEGIN + REPEAT + NL; + Print('^11. Trapping status: '+AOnOff((TrapActivity IN User.SFlags), + '^7'+AOnOff((TrapSeparate IN User.SFlags), + 'Trapping to TRAP'+IntToStr(UNum)+'.LOG', + 'Trapping to TRAP.LOG'), + 'Off')+AOnOff(General.globaltrap,'^8 ','')); + Print('^12. Auto-chat state: '+AOnOff((ChatAuto IN User.SFlags), + AOnOff((ChatSeparate IN User.SFlags), + '^7Output to CHAT'+IntToStr(UNum)+'.LOG', + '^7Output to CHAT.LOG'),'Off')+ + AOnOff(General.autochatopen,'^8 ','')); + Print('^13. SysOp Log state: '+AOnOff((SLogSeparate IN User.SFlags), + '^7Logging to SLOG'+IntToStr(UNum)+'.LOG', + '^3Normal output')); + Print('^14. Alert : '+AOnOff((Alert IN User.Flags), + '^7Alert', + '^3Normal')); + NL; + Prt('Select (1-4): '); + OneK(Cmd,^M'1234',TRUE,TRUE); + IF (Cmd <> ^M) THEN + NL; + CASE Cmd OF + '1' : BEGIN + IF PYNQ('Trap User activity? ['+ShowYesNo((TrapActivity IN User.SFlags))+']: ', + 0,TrapActivity IN User.SFlags) THEN + Include(User.SFlags,TrapActivity) + ELSE + Exclude(User.SFlags,TrapActivity); + IF (TrapActivity IN User.SFlags) THEN + BEGIN + IF PYNQ('Log to separate file? ['+ShowYesNo(TrapSeparate IN User.SFlags)+']: ', + 0,TrapSeparate IN User.SFlags) THEN + Include(User.SFlags,TrapSeparate) + ELSE + Exclude(User.SFlags,TrapSeparate); + END + ELSE + Exclude(User.SFlags,TrapSeparate); + END; + '2' : BEGIN + IF PYNQ('Auto-chat buffer open? ['+ShowYesNo(ChatAuto IN User.SFlags)+']: ', + 0,ChatAuto IN User.SFlags) THEN + Include(User.SFlags,ChatAuto) + ELSE + Exclude(User.SFlags,ChatAuto); + IF (ChatAuto IN User.SFlags) THEN + BEGIN + IF PYNQ('Separate buffer file? ['+ShowYesNo(ChatSeparate IN User.SFlags)+']: ', + 0,ChatSeparate IN User.SFlags) THEN + Include(User.SFlags,ChatSeparate) + ELSE + Exclude(User.SFlags,ChatSeparate); + END + ELSE + Exclude(User.SFlags,ChatSeparate); + END; + '3' : BEGIN + IF PYNQ('Output SysOp Log separately? ['+ShowYesNo(SLogSeparate IN User.SFlags)+']: ', + 0,SLogSeparate IN User.SFlags) THEN + Include(User.SFlags,SLogSeparate) + ELSE + Exclude(User.SFlags,SLogSeparate); + END; + '4' : ToggleACFlag(Alert,User.Flags); + END; + UNTIL (Cmd = ^M) OR (HangUp); + Cmd := #0; + END; + 'K' : CStuff(27,3,User); + 'L' : BEGIN + TempB := User.SL; + InputByteWOC('Enter new SL',TempB,[NumbersOnly],0,255); + IF (TempB >= 0) AND (TempB <= 255) THEN + BEGIN + Ok := TRUE; + IF (TempB < ThisUser.SL) OR (UserNum = 1) THEN + BEGIN + IF (UserNum = UNum) AND (TempB < ThisUser.SL) THEN + BEGIN + NL; + IF NOT PYNQ('Lower your own SL level? ',0,FALSE) THEN + Ok := FALSE; + END; + IF (Ok) THEN + BEGIN + User.SL := TempB; + User.TLToday := (General.TimeAllow[User.SL] - User.TTimeOn); + END; + END + ELSE + BEGIN + NL; + Print('Access denied.'^G); + SysOpLog('Illegal SL edit attempt: '+Caps(User.Name)+' #'+IntToStr(UNum)+' to '+IntToStr(TempB)); + END; + END; + END; + 'M' : BEGIN + TempB := User.DSL; + InputByteWOC('Enter new DSL',TempB,[NumbersOnly],0,255); + IF (TempB >= 0) AND (TempB <= 255) THEN + BEGIN + Ok := TRUE; + IF (TempB < ThisUser.DSL) OR (UserNum = 1) THEN + BEGIN + IF (UserNum = UNum) AND (TempB < ThisUser.SL) THEN + BEGIN + NL; + IF NOT PYNQ('Lower your own DSL level? ',0,FALSE) THEN + Ok := FALSE; + END; + IF (Ok) THEN + User.DSL := TempB; + END + ELSE + BEGIN + NL; + Print('Access denied.'^G); + SysOpLog('Illegal DSL edit attempt: '+Caps(User.Name)+' #'+IntToStr(UNum)+ + ' to '+IntToStr(TempB)); + END; + END; + END; + 'N' : BEGIN + REPEAT + Prt('Toggle which AR flag? ('+DisplayARFlags(User.AR,'5','4')+'^4)'+ + ' [^5*^4=^5All^4,^5?^4=^5Help^4,^5^4=^5Quit^4]: '); + OneK(Cmd,^M'ABCDEFGHIJKLMNOPQRSTUVWXYZ*?',TRUE,TRUE); + IF (Cmd = '?') THEN + PrintF('ARFLAGS') + ELSE IF (Cmd <> ^M) THEN + BEGIN + IF (NOT (Cmd IN ThisUser.AR)) AND (NOT SysOp) THEN + BEGIN + Print('Access denied.'^G); + SysOpLog('Tried to give '+Caps(User.Name)+' #'+IntToStr(UNum)+' AR flag "'+Cmd+'"'); + END + ELSE IF (Cmd IN ['A'..'Z']) THEN + ToggleARFlag(Cmd,User.AR,Changed) + ELSE IF (Cmd = '*') THEN + BEGIN + FOR Cmd := 'A' TO 'Z' DO + ToggleARFlag(Cmd,User.AR,Changed); + Cmd := '*'; + END; + END; + UNTIL (Cmd = ^M) OR (HangUp); + Cmd := #0; + END; + 'O' : BEGIN + REPEAT + Prt('Toggle which AC flag? ('+DisplayACFlags(User.Flags,'5','4')+'^4)'+ + ' [^5?^4=^5Help^4,^5^4=^5Quit^4]: '); + OneK(Cmd,^M'LCVUA*PEKM1234?',TRUE,TRUE); + IF (Cmd = '?') THEN + PrintF('ACFLAGS') + ELSE + BEGIN + IF (Cmd = '4') AND (NOT SysOp) THEN + BEGIN + Print('Access denied.'^G); + SysOpLog('Tried to change '+Caps(User.Name)+' #'+IntToStr(UNum)+' deletion status'); + END + ELSE IF (Cmd <> ^M) THEN + ToggleACFlags(Cmd,User.Flags,Changed); + END; + UNTIL (Cmd = ^M) OR (HangUp); + Cmd := #0; + END; + 'P' : BEGIN + CStuff(2,3,User); + CStuff(12,3,User); + END; + 'R' : CStuff(8,3,User); + 'T' : BEGIN + Print('New last on date (MM/DD/YYYY).'); + Prt(': '); + MPL(10); + InputFormatted('',TempStr,'##/##/####',TRUE); + IF (TempStr <> '') THEN + User.LastOn := Date2PD(TempStr); + END; + 'V' : BEGIN + IF (LockedOut IN User.SFlags) THEN + Exclude(User.SFlags,LockedOut) + ELSE + Include(User.SFlags,LockedOut); + IF (LockedOut IN User.SFlags) THEN + BEGIN + Print('User is now locked out.'); + NL; + Print('Each time the user logs on from now on, a text file will'); + Print('be displayed before user is terminated.'); + NL; + Prt('Enter lockout filename: '); + MPL(8); + Input(TempStr,8); + IF (TempStr = '') THEN + Exclude(User.SFlags,LockedOut) + ELSE + BEGIN + User.LockedFile := TempStr; + SysOpLog('Locked '+Caps(User.Name)+' #'+IntToStr(UNum)+' out: Lockfile "'+TempStr+'"'); + END; + END; + IF NOT (LockedOut IN User.SFlags) THEN + BEGIN + NL; + Print('User is no longer locked out of system.'); + END; + NL; + PauseScr(FALSE); + END; + 'W' : BEGIN + Print('Enter new password.'); + Prt(': '); + MPL(20); + Input(TempStr,20); + IF (TempStr <> '') THEN + User.PW := CRC32(TempStr); + END; + 'X' : BEGIN + Print('Enter new caller ID string.'); + Prt(': '); + MPL((SizeOf(User.CallerID) - 1)); + Input(TempStr,(SizeOf(User.CallerID) - 1)); + IF (TempStr <> '') THEN + User.CallerID := TempStr; + END; + 'Y' : FindMenu('%LFEnter new start menu (^50^4=^5Default^4)',User.UserStartMenu,0,NumMenus,Changed); + 'Z' : BEGIN + Print('Question:'); + NL; + {Print(General.ForgotPWQuestion);} + Print(RGMainStr(6,TRUE)); + NL; + Print('Enter new forgot password answer.'); + Prt(': '); + MPL((SizeOf(User.ForgotPWAnswer) - 1)); + Input(TempStr,(SizeOf(User.ForgotPWAnswer) - 1)); + IF (TempStr <> '') THEN + User.ForgotPWAnswer := TempStr; + END; + '^' : IF (Deleted IN User.SFlags) THEN + BEGIN + Print('User is currently deleted.'); + NL; + IF PYNQ('Restore this user? ',0,FALSE) THEN + BEGIN + InsertIndex(User.Name,UNum,FALSE,FALSE); + InsertIndex(User.RealName,UNum,TRUE,FALSE); + Inc(LTodayNumUsers); + SaveGeneral(TRUE); + Exclude(User.SFlags,Deleted); + END + ELSE + Save := Save1; + END + ELSE IF (FNoDeletion IN User.Flags) THEN + BEGIN + Print('Access denied - This user is protected from deletion.'); + SysOpLog('* Attempt to delete user: '+Caps(User.Name)+' #'+IntToStr(UNum)); + NL; + PauseScr(FALSE); + Save := Save1; + END + ELSE + BEGIN + NL; + IF PYNQ('*DELETE* this User? ',0,FALSE) THEN + BEGIN + IF NOT (Deleted IN User.SFlags) THEN + BEGIN + Save := TRUE; + Include(User.SFlags,Deleted); + InsertIndex(User.Name,UNum,FALSE,TRUE); + InsertIndex(User.RealName,UNum,TRUE,TRUE); + Dec(LTodayNumUsers); + SaveGeneral(TRUE); + SysOpLog('* Deleted User: '+Caps(User.Name)+' #'+IntToStr(UNum)); + UNum1 := UserNum; + UserNum := UNum; + ReadShortMessage; + UserNum := UNum1; + User.Waiting := 0; + KillUserMail; + KillUserVotes; + END + ELSE + Save := Save1; + END; + END; + ELSE + Save := Save1; + END; + END; + END; + END; + IF (UNum = UserNum) THEN + BEGIN + ThisUser := User; + NewComptables; + END; + UNTIL (Cmd = 'Q') OR (HangUp); + Update_Screen; + LastError := IOResult; +END; + +END. diff --git a/SOURCE/SYSOP4.PAS b/SOURCE/SYSOP4.PAS new file mode 100644 index 0000000..76cb032 --- /dev/null +++ b/SOURCE/SYSOP4.PAS @@ -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. diff --git a/SOURCE/SYSOP5.PAS b/SOURCE/SYSOP5.PAS new file mode 100644 index 0000000..fd3306c --- /dev/null +++ b/SOURCE/SYSOP5.PAS @@ -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^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. diff --git a/SOURCE/SYSOP6.PAS b/SOURCE/SYSOP6.PAS new file mode 100644 index 0000000..2dc296a --- /dev/null +++ b/SOURCE/SYSOP6.PAS @@ -0,0 +1,1001 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT SysOp6; + +INTERFACE + +PROCEDURE EventEditor; + +IMPLEMENTATION + +USES + Common, + TimeFunc; + +PROCEDURE EventEditor; +VAR + TempEvent: EventRecordType; + Cmd: Char; + RecNumToList: Integer; + SaveTempPause: Boolean; + + FUNCTION DaysEventActive(EventDays: EventDaysType; C1,C2: Char): AStr; + CONST + Days: Str7 = 'SMTWTFS'; + VAR + TempStr: AStr; + Counter: Byte; + BEGIN + TempStr := ''; + FOR Counter := 0 TO 6 DO + IF (Counter IN EventDays) THEN + TempStr := TempStr + '^'+C1+Days[Counter + 1] + ELSE + TempStr := TempStr + '^'+C2+'-'; + DaysEventActive := TempStr; + END; + + FUNCTION NextDay(Date: Str10): LongInt; + VAR + Day, + Month, + Year: Word; + BEGIN + Month := StrToInt(Copy(Date,1,2)); + Day := StrToInt(Copy(Date,4,2)); + Year := StrToInt(Copy(Date,7,4)); + IF (Day = 31) AND (Month = 12) THEN + BEGIN + Inc(Year); + Month := 1; + Day := 1; + END + ELSE + BEGIN + IF (Day < Days(Month,Year)) THEN + Inc(Day) + ELSE IF (Month < 12) THEN + BEGIN + Inc(Month); + Day := 1; + END; + END; + NextDay := Date2PD(ZeroPad(IntToStr(Month))+'/'+ZeroPad(IntToStr(Day))+'/'+IntToStr(Year)); + END; + + FUNCTION ShowTime(W: Word): Str5; + BEGIN + ShowTime := ZeroPad(IntToStr(W DIV 60))+':'+ZeroPad(IntToStr(W MOD 60)); + END; + + PROCEDURE ToggleEFlag(EFlagT: EventFlagType; VAR EFlags: EFlagSet); + BEGIN + IF (EFlagT IN EFlags) THEN + Exclude(EFlags,EFlagT) + ELSE + Include(EFlags,EFlagT); + END; + + PROCEDURE ToggleEFlags(C: Char; VAR EFlags: EFlagSet; VAR Changed: Boolean); + VAR + SaveEFlags: EFlagSet; + BEGIN + SaveEFlags := EFlags; + CASE C OF + 'A' : ToggleEFlag(EventIsExternal,EFlags); + 'B' : ToggleEFlag(EventIsActive,EFlags); + 'C' : ToggleEFlag(EventIsShell,EFlags); + 'D' : ToggleEFlag(EventIsOffhook,EFlags); + 'E' : ToggleEFlag(EventIsMonthly,EFlags); + 'F' : ToggleEFlag(EventIsPermission,EFlags); + 'G' : ToggleEFlag(EventIsLogon,EFlags); + 'H' : ToggleEFlag(EventIsChat,EFlags); + 'I' : ToggleEFlag(EventIsPackMsgAreas,EFlags); + 'J' : ToggleEFlag(EventIsSortFiles,EFlags); + 'K' : ToggleEFlag(EventIsSoft,EFlags); + 'L' : ToggleEFlag(EventIsMissed,EFlags); + 'M' : ToggleEFlag(BaudIsActive,EFlags); + 'N' : ToggleEFlag(AcsIsActive,EFlags); + 'O' : ToggleEFlag(TimeIsActive,EFlags); + 'P' : ToggleEFlag(ARisActive,EFlags); + 'Q' : ToggleEFlag(SetARisActive,EFlags); + 'R' : ToggleEFlag(ClearARisActive,EFlags); + 'S' : ToggleEFlag(InRatioIsActive,EFlags); + END; + IF (EFlags <> SaveEFlags) THEN + Changed := TRUE; + END; + + PROCEDURE InitEventVars(VAR Event: EventRecordType); + BEGIN + FillChar(Event,SizeOf(Event),0); + WITH Event DO + BEGIN + EventDescription := '<< New Event >>'; + EventDayOfMonth := 0; + EventDays := []; + EventStartTime := 0; + EventFinishTime := 0; + EventQualMsg := ''; + EventNotQualMsg := ''; + EventPreTime := 0; + EventNode := 0; + EventLastDate := 0; + EventErrorLevel := 0; + EventShellPath := ''; + LoBaud := 300; + HiBaud := 19200; + EventACS := 's10'; + MaxTimeAllowed := 60; + SetARflag := '@'; + ClearARflag := '@'; + EFlags := [EventIsExternal,EventIsShell]; + END; + END; + + PROCEDURE DeleteEvent(TempEvent1: EventRecordType; RecNumToDelete: SmallInt); + VAR + RecNum: Integer; + BEGIN + IF (NumEvents = 0) THEN + Messages(4,0,'events') + ELSE + BEGIN + RecNumToDelete := -1; + InputIntegerWOC('%LFEvent to delete?',RecNumToDelete,[NumbersOnly],1,NumEvents); + IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumEvents) THEN + BEGIN + Reset(EventFile); + Seek(EventFile,(RecNumToDelete - 1)); + Read(EventFile,TempEvent1); + Close(EventFile); + LastError := IOResult; + Print('%LFEvent: ^5'+TempEvent1.EventDescription); + IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN + BEGIN + Print('%LF[> Deleting event record ...'); + Dec(RecNumToDelete); + Reset(EventFile); + IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(EventFile) - 2)) THEN + FOR RecNum := RecNumToDelete TO (FileSize(EventFile) - 2) DO + BEGIN + Seek(EventFile,(RecNum + 1)); + Read(EventFile,Event); + Seek(EventFile,RecNum); + Write(EventFile,Event); + END; + Seek(EventFile,(FileSize(EventFile) - 1)); + Truncate(EventFile); + Close(EventFile); + LastError := IOResult; + Dec(NumEvents); + SysOpLog('* Deleted event: ^5'+TempEvent1.EventDescription); + END; + END; + END; + END; + + PROCEDURE CheckEvent(Event: EventRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean); + VAR + Counter: Byte; + BEGIN + FOR Counter := StartErrMsg TO EndErrMsg DO + CASE Counter OF + 1 : ; + END; + END; + + + + PROCEDURE EditEvent(TempEvent1: EventRecordType; VAR Event: EventRecordType; VAR Cmd1: Char; + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); + CONST + BaudRates: ARRAY [1..20] OF LongInt = (300,600,1200,2400,4800,7200,9600, + 12000,14400,16800,19200,21600,24000, + 26400,28800,31200,33600,38400,57600, + 115200); + VAR + OneKCmds, + TempStr: AStr; + Counter: Byte; + BEGIN + WITH Event DO + REPEAT + IF (Cmd1 <> '?') THEN + BEGIN + Abort := FALSE; + Next := FALSE; + CLS; + IF (Editing) THEN + PrintACR('^5Editing event #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumEvents)) + ELSE + PrintACR('^5Inserting event #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumEvents + 1)); + NL; + PrintACR('^1A. Event type : ^5'+AOnOff(EventIsExternal IN EFlags,'External','Internal')); + PrintACR('^1B. Description : ^5'+EventDescription); + PrintACR('^1C. Active : ^5'+AOnOff(EventIsActive IN EFlags,'Active','Inactive')); + IF (EventIsExternal IN EFlags) THEN + BEGIN + PrintACR('^1D. Execution hard/soft : ^5'+AOnOff(EventIsSoft IN EFlags,'Soft','Hard')); + TempStr := '^1E. Event type : ^5'; + IF (EventIsErrorLevel IN EFlags) THEN + TempStr := TempStr + 'Error level = '+IntToStr(EventErrorLevel) + ELSE IF (EventIsShell IN EFlags) THEN + TempStr := TempStr + 'Shell file = "'+EventShellPath+'"' + ELSE IF (EventIsSortFiles IN EFlags) THEN + TempStr := TempStr + 'Sort Files' + ELSE IF (EventIsPackMsgAreas IN EFlags) THEN + TempStr := TempStr + 'Pack Message Areas' + ELSE IF (EventIsFilesBBS IN EFlags) THEN + TempStr := TempStr + 'Check Files.BBS'; + PrintACR(TempStr); + PrintACR('^1G. Scheduled day(s) : ^5'+AOnOff(EventIsMonthly IN EFlags, + 'Monthly ^1-^5 Day ^1=^5 '+IntToStr(EventDayOfMonth), + 'Weekly ^1-^5 Days ^1=^5 '+DaysEventActive(EventDays,'5','1'))); + PrintACR('^1H. Start time : ^5'+ShowTime(EventStartTime)); + PrintACR('^1I. Phone status : ^5'+AOnOff(EventIsOffHook IN EFlags, + 'Off-hook ('+IntToStr(EventPreTime)+' minutes before the Event)', + 'Remain on-hook')); + PrintACR('^1K. Executed today : ^5'+ShowYesNo(PD2Date(EventLastDate) = DateStr)+' ' + +AOnOff(EventIsActive IN EFlags, + '(Next scheduled date: '+PD2Date(EventLastDate)+')', + '(Not scheduled for execution)')); + END + ELSE + BEGIN + PrintACR('^1D. Scheduled day(s) : ^5'+AOnOff(EventIsMonthly IN EFlags, + 'Monthly ^1-^5 Day ^1=^5 '+IntToStr(EventDayOfMonth), + 'Weekly ^1-^5 Days ^1=^5 '+DaysEventActive(EventDays,'5','1'))); + PrintACR('^1E. Time active : ^5'+ShowTime(EventStartTime)+' to '+ + ShowTime(EventFinishTime)); + PrintACR('^1G. Permission/restriction: ^5'+AOnOff(EventIsPermission IN EFlags, + 'Permission','Restriction')); + PrintACR('^1H. Event type : ^5'+AOnOff(EventIsChat IN EFlags,'Chat','Logon')); + PrintACR('^1I. Affected message : "^5'+eventqualmsg+'^1"'); + PrintACR('^1K. Unaffected message : "^5'+eventnotqualmsg+'^1"'); + END; + PrintACR('^1M. Run if missed : ^5'+ShowYesNo(EventIsMissed IN EFlags)); + PrintACR('^1N. Node number : ^5'+IntToStr(EventNode)); + IF (NOT (EventIsExternal IN EFlags)) THEN + BEGIN + NL; + PrintACR(' ^4<<<^5 Qualifiers ^4>>>'); + NL; + PrintACR('^11. Baud rate range : ^5'+AOnOff(BaudIsActive IN EFlags, + IntToStr(LoBaud)+' to '+IntToStr(HiBaud), + '<>')); + PrintACR('^12. ACS : ^5'+AOnOff(ACSIsActive IN EFlags,EventACS,'<>')); + IF (EventIsPermission IN EFlags) THEN + PrintACR('^13. Maximum time : ^5'+AOnOff(TimeIsActive IN EFlags, + IntToStr(MaxTimeAllowed), + '<>')); + IF (EventIsPermission IN EFlags) THEN + BEGIN + PrintACR('^14. Set AR flag : ^5'+AOnOff(SetArIsActive IN EFlags, + SetArFlag, + '<>')); + PrintACR('^15. Clear AR flag : ^5'+AOnOff(ClearArIsActive IN EFlags, + ClearArFlag, + '<>')); + END; + PrintACR('^16. UL/DL ratio check: ^5'+AOnOff(InRatioIsActive IN EFlags, + 'Active', + '<>')); + END; + END; + IF (EventIsExternal IN EFlags) THEN + OneKCmds := '' + ELSE + BEGIN + IF (EventIsPermission IN EFlags) THEN + OneKCmds := '123456' + ELSE + OneKCmds := '126'; + END; + LOneK('%LFModify '+AOnOff(EventIsExternal IN EFlags,'external','internal')+' event [^5?^4=^5Help^4]: ', + Cmd1,'QABCDEGHIKMN'+OneKCmds+'[]FJL?'^M,TRUE,TRUE); + CASE Cmd1 OF + 'A' : ToggleEFlagS('A',EFlags,Changed); { External/Internal } + 'B' : InputWN1('%LFNew description: ',EventDescription,30,[InterActiveEdit],Changed); + 'C' : ToggleEFlags('B',EFlags,Changed); { Active/InActive } + 'D' : IF (EventIsExternal IN EFlags) THEN + ToggleEFlags('K',EFlags,Changed) { Soft/Hard } + ELSE { Dialy/Monthly } + BEGIN + LOneK('%LFSchedule? [^5D^4=^5Daily^4,^5M^4=^5Monthly^4,^5^4=^5Quit^4]: ',Cmd1,^M'DM',TRUE,TRUE); + CASE Cmd1 OF + 'D' : BEGIN + IF (EventIsMonthly IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsMonthly); + EventDayOfMonth := 0; + Changed := TRUE; + END; + REPEAT + Print('%LF^5Active Days: ^3'+DaysEventActive(EventDays,'5','4')+'^1'); + NL; + LCmds(11,3,'1Sunday',''); + LCmds(11,3,'2Monday',''); + LCmds(11,3,'3Tuesday',''); + LCmds(11,3,'4Wednesday',''); + LCmds(11,3,'5Thursday',''); + LCmds(11,3,'6Friday',''); + LCmds(11,3,'7Saturday',''); + LOneK('%LFToggle which day? [^51^4-^57^4,^5^4=^5Quit^4]: ',Cmd1,^M'1234567',TRUE,TRUE); + IF (Cmd1 <> ^M) THEN + BEGIN + IF ((StrToInt(Cmd1) - 1) IN EventDays) THEN + Exclude(EventDays,(StrToInt(Cmd1) - 1)) + ELSE + Include(EventDays,(StrToInt(Cmd1) - 1)); + Changed := TRUE; + END; + UNTIL (Cmd1 = ^M) OR (HangUp); + Cmd1 := #0; + END; + 'M' : BEGIN + IF (NOT (EventIsMonthly IN EFlags)) THEN + BEGIN + Include(EFlags,EventIsMonthly); + EventDays := []; + Changed := TRUE; + END; + InputByteWC('%LFDay of the month',EventDayOfMonth,[],1,31,Changed); + END; + END; + Cmd1 := #0; + END; + 'E' : IF (EventIsExternal IN EFlags) THEN + BEGIN + Print('%LF^5External event type'); + NL; + LCmds(18,3,'1Errorlevel',''); + LCmds(18,3,'2Shell',''); + LCmds(18,3,'3Sort Files',''); + LCmds(18,3,'4Pack Message Areas',''); + LCmds(18,3,'5Files.BBS',''); + LOneK('%LFWhich external event? [^51^4-^55^4,^5^4=^5Quit^4]: ',Cmd1,^M'12345',TRUE,TRUE); + IF (Cmd1 <> ^M) THEN + BEGIN + CASE Cmd1 OF + '1' : BEGIN + IF (EventIsShell IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsShell); + EventShellPath := ''; + END; + IF (EventIsSortFiles IN EFlags) THEN + Exclude(EFlags,EventIsSortFiles); + IF (EventIsPackMsgAreas IN EFlags) THEN + Exclude(EFlags,EventIsPackMsgAreas); + IF (EventIsFilesBBS IN EFlags) THEN + Exclude(EFlags,EventIsFilesBBS); + Include(EFlags,EventIsErrorLevel); + InputByteWC('%LFError Level',EventErrorLevel,[],0,255,Changed); + END; + '2' : BEGIN + IF (EventIsErrorLevel IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsErrorLevel); + EventErrorLevel := 0; + END; + IF (EventIsSortFiles IN EFlags) THEN + Exclude(EFlags,EventIsSortFiles); + IF (EventIsPackMsgAreas IN EFlags) THEN + Exclude(EFlags,EventIsPackMsgAreas); + IF (EventIsFilesBBS IN EFlags) THEN + Exclude(EFlags,EventIsFilesBBS); + Include(EFlags,EventIsShell); + InputWN1('%LFShell file: ',EventShellPath,8,[UpperOnly],Changed); + END; + '3' : BEGIN + IF (EventIsShell IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsShell); + EventShellPath := ''; + END; + IF (EventIsErrorLevel IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsErrorLevel); + EventErrorLevel := 0; + END; + IF (EventIsPackMsgAreas IN EFlags) THEN + Exclude(EFlags,EventIsPackMsgAreas); + IF (EventIsFilesBBS IN EFlags) THEN + Exclude(EFlags,EventIsFilesBBS); + Include(EFlags,EventIsSortFiles); + END; + '4' : BEGIN + IF (EventIsShell IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsShell); + EventShellPath := ''; + END; + IF (EventIsErrorLevel IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsErrorLevel); + EventErrorLevel := 0; + END; + IF (EventIsSortFiles IN EFlags) THEN + Exclude(EFlags,EventIsSortFiles); + IF (EventIsFilesBBS IN EFlags) THEN + Exclude(EFlags,EventIsFilesBBS); + Include(EFlags,EventIsPackMsgAreas); + END; + '5' : BEGIN + IF (EventIsShell IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsShell); + EventShellPath := ''; + END; + IF (EventIsErrorLevel IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsErrorLevel); + EventErrorLevel := 0; + END; + IF (EventIsSortFiles IN EFlags) THEN + Exclude(EFlags,EventIsSortFiles); + IF (EventIsPackMsgAreas IN EFlags) THEN + Exclude(EFlags,EventIsPackMsgAreas); + Include(EFlags,EventIsFilesBBS); + END; + END; + Changed := TRUE; + END; + Cmd1 := #0; + END + ELSE + BEGIN + Prt('%LFNew event start time? (24 Hour Format) Hour: (0-23), Minute: (0-59): '); + InputFormatted('',TempStr,'##:##',TRUE); + IF (TempStr <> '') AND (Length(TempStr) = 5) AND (Pos(':',TempStr) = 3) THEN + BEGIN + IF (StrToInt(Copy(TempStr,1,2)) IN [0..23]) AND (StrToInt(Copy(TempStr,4,2)) IN [0..59]) THEN + BEGIN + EventStartTime := ((StrToInt(Copy(TempStr,1,2)) * 60) + StrToInt(Copy(TempStr,4,2))); + Changed := TRUE; + END + ELSE + BEGIN + Print('%LF^5Invalid time - Format is HH:MM (24 hour military)'); + PauseScr(FALSE); + END; + END; + Prt('%LFNew event finish time? (24 Hour Format) Hour: (0-23), Minute: (0-59): '); + InputFormatted('',TempStr,'##:##',TRUE); + IF (TempStr <> '') AND (Length(TempStr) = 5) AND (Pos(':',TempStr) = 3) THEN + BEGIN + IF (StrToInt(Copy(TempStr,1,2)) IN [0..23]) AND (StrToInt(Copy(TempStr,4,2)) IN [0..59]) THEN + BEGIN + EventFinishTime := ((StrToInt(Copy(TempStr,1,2)) * 60) + StrToInt(Copy(TempStr,4,2))); + Changed := TRUE; + END + ELSE + BEGIN + Print('%LF^5Invalid time - Format is HH:MM (24 hour military)'); + PauseScr(FALSE); + END; + END; + END; + 'G' : IF (EventIsExternal IN EFlags) THEN + BEGIN + LOneK('%LFSchedule? [^5D^4=^5Daily^4,^5M^4=^5Monthly^4,^5^4=^5Quit^4]: ',Cmd1,^M'DM',TRUE,TRUE); + CASE Cmd1 OF + 'D' : BEGIN + IF (EventIsMonthly IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsMonthly); + EventDayOfMonth := 0; + Changed := TRUE; + END; + REPEAT + Print('%LF^5Active Days: ^3'+DaysEventActive(EventDays,'5','4')+'^1'); + NL; + LCmds(11,3,'1Sunday',''); + LCmds(11,3,'2Monday',''); + LCmds(11,3,'3Tuesday',''); + LCmds(11,3,'4Wednesday',''); + LCmds(11,3,'5Thursday',''); + LCmds(11,3,'6Friday',''); + LCmds(11,3,'7Saturday',''); + LOneK('%LFToggle which day? [^51^4-^57^4,^5^4=^5Quit^4]: ',Cmd1,^M'1234567',TRUE,TRUE); + IF (Cmd1 <> ^M) THEN + BEGIN + IF (StrToInt(Cmd1) - 1 IN EventDays) THEN + Exclude(EventDays,StrToInt(Cmd1) - 1) + ELSE + Include(EventDays,StrToInt(Cmd1) - 1); + Changed := TRUE; + END; + UNTIL (Cmd1 = ^M) OR (HangUp); + Cmd1 := #0; + END; + 'M' : BEGIN + IF (NOT (EventIsMonthly IN EFlags)) THEN + BEGIN + Include(EFlags,EventIsMonthly); + EventDays := []; + Changed := TRUE; + END; + InputByteWC('%LFDay of the month',EventDayOfMonth,[],1,31,Changed); + END; + END; + Cmd1 := #0; + END + ELSE + BEGIN + ToggleEFlag(EventIsPermission,EFlags); + Changed := TRUE; + END; + 'H' : IF (EventIsExternal IN EFlags) THEN + BEGIN + Prt('%LFNew event start time? (24 Hour Format) Hour: (0-23), Minute: (0-59): '); + InputFormatted('',TempStr,'##:##',TRUE); + IF (TempStr <> '') AND (Length(TempStr) = 5) AND (Pos(':',TempStr) = 3) THEN + BEGIN + IF (StrToInt(Copy(TempStr,1,2)) IN [0..23]) AND (StrToInt(Copy(TempStr,4,2)) IN [0..59]) THEN + BEGIN + EventStartTime := ((StrToInt(Copy(TempStr,1,2)) * 60) + StrToInt(Copy(TempStr,4,2))); + Changed := TRUE; + END + ELSE + BEGIN + Print('%LF^5Invalid time - Format is HH:MM (24 hour military)'); + PauseScr(FALSE); + END; + END; + END + ELSE + BEGIN + Print('%LF^5Internal event type:'); + NL; + LCmds(7,3,'1Logon',''); + LCmds(7,3,'2Chat',''); + LOneK('%LFWhich internal event? [^51^4-^52^4,^5^4=^5Quit^4]: ',Cmd1,^M'12',TRUE,TRUE); + IF (Cmd1 <> ^M) THEN + BEGIN + CASE Cmd1 OF + '1' : BEGIN + IF (EventIsChat IN EFlags) THEN + Exclude(EFlags,EventIsChat); + Include(EFlags,EventIsLogon); + END; + '2' : BEGIN + IF (EventIsLogon IN EFlags) THEN + Exclude(EFlags,EventIsLogon); + Include(EFlags,EventIsChat); + END; + END; + Changed := TRUE; + END; + Cmd1 := #0; + END; + 'I' : IF (EventIsExternal IN EFlags) THEN + BEGIN + IF (EventIsOffHook IN EFlags) THEN + BEGIN + Exclude(EFlags,EventIsOffHook); + EventPreTime := 0; + Changed := TRUE; + END + ELSE + BEGIN + Include(EFlags,EventIsOffHook); + InputByteWC('%LFMinutes before event to take phone offhook',EventPreTime,[],0,255,Changed); + END; + END + ELSE + InputWN1('%LF^1Message/@File if the user is effected by the event:%LF^4: ',EventQualMsg,64,[],Changed); + 'K' : IF (EventIsExternal IN EFlags) THEN + BEGIN + IF (PD2Date(EventLastDate) = DateStr) THEN + EventLastDate := NextDay(PD2Date(EventLastDate)) + ELSE + EventLastDate := Date2PD(DateStr); + Changed := TRUE; + END + ELSE + InputWN1('%LF^1Message/@File if the user IS NOT effected by the event:%LF^4: ', + EventNotQualMsg,64,[],Changed); + 'M' : BEGIN + IF PYNQ('%LFRun this event later if the event time is missed? ',0,FALSE) THEN + Include(EFlags,EventIsMissed) + ELSE + Exclude(EFlags,EventIsMissed); + Changed := TRUE; + END; + 'N' : InputByteWC('%LFNode number to execute event from (0=All)',EventNode, + [DisplayValue,NumbersOnly],0,MaxNodes,Changed); + '1' : IF (NOT (EventIsExternal IN EFlags)) THEN + IF (BaudIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,BaudIsActive); + LoBaud := 300; + HiBaud := 115200; + Changed := TRUE; + END + ELSE + BEGIN + Include(EFlags,BaudIsActive); + Print('%LF^5Baud lower limit:^1%LF'); + Counter := 1; + WHILE (Counter <= 20) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + PrintACR(Char(Counter + 64)+'. '+IntToStr(BaudRates[Counter])); + Inc(Counter); + END; + LOneK('%LFWhich? (^5A^4-^5T^4): ',Cmd1,'ABCDEFGHIJKLMNOPQRST',TRUE,TRUE); + LoBaud := BaudRates[Ord(Cmd1) - 64]; + Print('%LF^5Baud upper limit:^1%LF'); + Counter := 1; + WHILE (Counter <= 20) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + PrintACR(Char(Counter + 64)+'. '+IntToStr(BaudRates[Counter])); + Inc(Counter); + END; + LOneK('%LFWhich? (^5A^4-^5T^4): ',Cmd1,'ABCDEFGHIJKLMNOPQRST',TRUE,TRUE); + HiBaud := BaudRates[Ord(Cmd1) - 64]; + Changed := TRUE; + Cmd1 := #0; + END; + '2' : IF (NOT (EventIsExternal IN EFlags)) THEN + IF (ACSIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,ACSIsActive); + EventACS := 's10'; + Changed := TRUE; + END + ELSE + BEGIN + Include(EFlags,ACSIsActive); + InputWN1('%LFSL ACS: ',EventACS,(SizeOf(EventACS) - 1),[InterActiveEdit],Changed); + END; + '3' : IF (NOT (EventIsExternal IN EFlags)) THEN + IF (EventIsPermission IN EFlags) THEN + BEGIN + IF (TimeIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,TimeIsActive); + MaxTimeAllowed := 60; + Changed := TRUE; + END + ELSE + BEGIN + Include(EFlags,TimeIsActive); + InputWordWoc('%LFMaximum time allowed on-line (minutes)',MaxTimeAllowed, + [DisplayValue,NumbersOnly],0,65535); + END; + END; + '4' : IF NOT (EventIsExternal IN EFlags) THEN + IF (EventIsPermission IN EFlags) THEN + BEGIN + IF (SetArIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,SetArIsActive); + SetArFlag := '@'; + Changed := TRUE; + END + ELSE + BEGIN + Include(EFlags,SetArIsActive); + LOneK('%LFAR flag to set (^5A^4-^5Z^4): ',Cmd1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',TRUE,TRUE); + SetArFlag := Cmd1; + Cmd1 := #0; + END; + END; + '5' : IF NOT (EventIsExternal IN EFlags) THEN + IF (EventIsPermission IN EFlags) THEN + BEGIN + IF (ClearArIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,ClearArIsActive); + ClearArFlag := '@'; + Changed := TRUE; + END + ELSE + BEGIN + Include(EFlags,ClearArIsActive); + LOneK('%LFAR flag to clear (^5A^4-^5Z^4): ',Cmd1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',TRUE,TRUE); + ClearArFlag := Cmd1; + Cmd1 := #0; + END; + END; + '6' : IF (NOT (EventIsExternal IN EFlags)) THEN + ToggleEFlags('S',EFlags,Changed); + '[' : IF (RecNumToEdit > 1) THEN + Dec(RecNumToEdit) + ELSE + BEGIN + Messages(2,0,''); + Cmd1 := #0; + END; + ']' : IF (RecNumToEdit < NumEvents) 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,NumEvents); + IF (RecNumToEdit < 1) OR (RecNumToEdit > NumEvents) THEN + Cmd1 := #0; + END; + 'L' : IF (RecNumToEdit <> NumEvents) THEN + RecNumToEdit := NumEvents + ELSE + BEGIN + Messages(3,0,''); + Cmd1 := #0; + END; + '?' : BEGIN + Print('%LF^1<^3CR^1>Redisplay screen'); + Print('^3 0) OR (HangUp); + END; + + PROCEDURE InsertEvent(TempEvent1: EventRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); + VAR + RecNum, + RecNumToEdit: SmallInt; + Ok, + Changed: Boolean; + BEGIN + IF (NumEvents = MaxEvents) THEN + Messages(5,MaxEvents,'events') + ELSE + BEGIN + RecNumToInsertBefore := -1; + InputIntegerWOC('%LFEvent to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumEvents + 1)); + IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumEvents + 1)) THEN + BEGIN + Reset(EventFile); + InitEventVars(TempEvent1); + IF (RecNumToInsertBefore = 1) THEN + RecNumToEdit := 1 + ELSE IF (RecNumToInsertBefore = (NumEvents + 1)) THEN + RecNumToEdit := (NumEvents + 1) + ELSE + RecNumToEdit := RecNumToInsertBefore; + REPEAT + OK := TRUE; + EditEvent(TempEvent1,TempEvent1,Cmd1,RecNumToEdit,Changed,FALSE); + CheckEvent(TempEvent1,1,1,Ok); + IF (NOT OK) THEN + IF (NOT PYNQ('%LFContinue inserting event? ',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 event record ...'); + Seek(EventFile,FileSize(EventFile)); + Write(EventFile,Event); + Dec(RecNumToInsertBefore); + FOR RecNum := ((FileSize(EventFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO + BEGIN + Seek(EventFile,RecNum); + Read(EventFile,Event); + Seek(EventFile,(RecNum + 1)); + Write(EventFile,Event); + END; + FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO + BEGIN + Seek(EventFile,RecNum); + Write(EventFile,TempEvent1); + Inc(NumEvents); + SysOpLog('* Inserted event: ^5'+TempEvent1.EventDescription); + END; + END; + Close(EventFile); + LastError := IOResult; + END; + END; + END; + + PROCEDURE ModifyEvent(TempEvent1: EventRecordType; Cmd1: Char; RecNumToEdit: SmallInt); + VAR + SaveRecNumToEdit: Integer; + Ok, + Changed: Boolean; + BEGIN + IF (NumEvents = 0) THEN + Messages(4,0,'events') + ELSE + BEGIN + RecNumToEdit := -1; + InputIntegerWOC('%LFModify which event?',RecNumToEdit,[NumbersOnly],1,NumEvents); + IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumEvents) THEN + BEGIN + SaveRecNumToEdit := -1; + Cmd1 := #0; + Reset(EventFile); + WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO + BEGIN + IF (SaveRecNumToEdit <> RecNumToEdit) THEN + BEGIN + Seek(EventFile,(RecNumToEdit - 1)); + Read(EventFile,Event); + SaveRecNumToEdit := RecNumToEdit; + Changed := FALSE; + END; + REPEAT + Ok := TRUE; + EditEvent(TempEvent1,Event,Cmd1,RecNumToEdit,Changed,TRUE); + CheckEvent(Event,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(EventFile,(SaveRecNumToEdit - 1)); + Write(EventFile,Event); + Changed := FALSE; + SysOpLog('* Modified event: ^5'+Event.EventDescription); + END; + END; + Close(EventFile); + LastError := IOResult; + END; + END; + END; + + PROCEDURE PositionEvent(TempEvent1: EventRecordType; RecNumToPosition: SmallInt); + VAR + RecNumToPositionBefore, + RecNum1, + RecNum2: SmallInt; + BEGIN + IF (NumEvents = 0) THEN + Messages(4,0,'events') + ELSE IF (NumEvents = 1) THEN + Messages(6,0,'events') + ELSE + BEGIN + InputIntegerWOC('%LFPosition which event?',RecNumToPosition,[NumbersOnly],1,NumEvents); + IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumEvents) THEN + BEGIN + Print('%LFAccording to the current numbering system.'); + InputIntegerWOC('%LFPosition before which event?',RecNumToPositionBefore,[Numbersonly],1,(NumEvents + 1)); + IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumEvents + 1)) AND + (RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN + BEGIN + Print('%LF[> Positioning event.'); + Reset(EventFile); + IF (RecNumToPositionBefore > RecNumToPosition) THEN + Dec(RecNumToPositionBefore); + Dec(RecNumToPosition); + Dec(RecNumToPositionBefore); + Seek(EventFile,RecNumToPosition); + Read(EventFile,TempEvent1); + RecNum1 := RecNumToPosition; + IF (RecNumToPosition > RecNumToPositionBefore) THEN + RecNum2 := -1 + ELSE + RecNum2 := 1; + WHILE (RecNum1 <> RecNumToPositionBefore) DO + BEGIN + IF ((RecNum1 + RecNum2) < FileSize(EventFile)) THEN + BEGIN + Seek(EventFile,(RecNum1 + RecNum2)); + Read(EventFile,Event); + Seek(EventFile,RecNum1); + Write(EventFile,Event); + END; + Inc(RecNum1,RecNum2); + END; + Seek(EventFile,RecNumToPositionBefore); + Write(EventFile,TempEvent1); + Close(EventFile); + LastError := IOResult; + END; + END; + END; + END; + + PROCEDURE ListEvents(VAR RecNumToList1: Integer); + VAR + NumDone: Integer; + BEGIN + IF (RecNumToList1 < 1) OR (RecNumToList1 > NumFileAreas) THEN + RecNumToList1 := 1; + Abort := FALSE; + Next := FALSE; + CLS; + PrintACR('^0 ##^4:^3Description ^4:^3Typ^4:^3Bsy^4:^3Time ^4:^3Len^4:^3Days ^4:^3Execinfo'); + PrintACR('^4 ==:==============================:===:===:=====:===:=======:============'); + Reset(EventFile); + NumDone := 0; + WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumEvents) + AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(EventFile,(RecNumToList1 - 1)); + Read(EventFile,Event); + WITH Event DO + PrintACR(AOnOff(EventIsActive IN EFlags,'^5+','^1-')+ + '^0'+PadRightInt(RecNumToList1,2)+ + ' ^3'+PadLeftStr(EventDescription,30)+ + (* + ' '+SchedT(FALSE,EType)+ + *) + ' ^5'+PadLeftInt(EventPreTime,3)+ + ' '+Copy(CTim(EventStartTime),4,5)); + (* + ' '+PadLeftInt(DurationOrLastDay,3)+ + ' '+DActiv(FALSE,ExecDays,Monthly)+ + ' ^3'+PadLeftStr(lExecData,9)); + *) + Inc(RecNumToList1); + Inc(NumDone); + END; + Close(EventFile); + LastError := IOResult; + IF (NumEvents = 0) THEN + Print('*** No events defined ***'); + END; + + +BEGIN + IF (MemEventArray[Numevents] <> NIL) THEN + FOR RecNumToList := 1 TO NumEvents DO + IF (MemEventArray[RecNumToList] <> NIL) THEN + Dispose(MemEventArray[RecNumToList]); + SaveTempPause := TempPause; + TempPause := FALSE; + RecNumToList := 1; + Cmd := #0; + REPEAT + IF (Cmd <> '?') THEN + ListEvents(RecNumToList); + LOneK('%LFEvent editor [^5?^4=^5Help^4]: ',Cmd,'QDIMP?'^M,TRUE,TRUE); + CASE Cmd OF + ^M : IF (RecNumToList < 1) OR (RecNumToList > NumEvents) THEN + RecNumToList := 1; + 'D' : DeleteEvent(TempEvent,RecNumToList); + 'I' : InsertEvent(TempEvent,Cmd,RecNumToList); + 'M' : ModifyEvent(TempEvent,Cmd,RecNumToList); + 'P' : PositionEvent(TempEvent,RecNumToList); + '?' : BEGIN + Print('%LF^1<^3CR^1>Next screen or redisplay current screen'); + Print('^1(^3?^1)Help/First event'); + LCmds(13,3,'Delete event','Insert event'); + LCmds(13,3,'Modify event','Position event'); + LCmds(13,3,'Quit',''); + END; + END; + IF (Cmd <> ^M) THEN + RecNumToList := 1; + UNTIL (Cmd = 'Q') OR (HangUp); + TempPause := SaveTempPause; + NumEvents := 0; + Reset(EventFile); + WHILE NOT EOF(EventFile) DO + BEGIN + Inc(NumEvents); + New(MemEventArray[NumEvents]); + Read(EventFile,MemEventArray[NumEvents]^); + END; + Close(EventFile); + LastError := IOResult; +END; + +END. diff --git a/SOURCE/SYSOP7.PAS b/SOURCE/SYSOP7.PAS new file mode 100644 index 0000000..9f21bd5 --- /dev/null +++ b/SOURCE/SYSOP7.PAS @@ -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^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^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. diff --git a/SOURCE/SYSOP7M.PAS b/SOURCE/SYSOP7M.PAS new file mode 100644 index 0000000..f711eeb --- /dev/null +++ b/SOURCE/SYSOP7M.PAS @@ -0,0 +1,488 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B+,D+,E+,F+,I+,L+,N-,O+,R-,S+,V-} +UNIT SysOp7M; + +INTERFACE + +USES + Common; + +PROCEDURE CommandEditor(MenuToModify,MenuNumber: Integer; MenuName: AStr); +PROCEDURE LoadMenuPointers; + +IMPLEMENTATION + +USES + Menus2; + +PROCEDURE LoadMenuPointers; +VAR + RecNum: Integer; +BEGIN + NumMenus := 0; + NumCmds := 0; + FOR RecNum := 1 TO MaxMenus DO + MenuRecNumArray[RecNum] := 0; + FOR RecNum := 1 TO MaxMenus DO + CmdNumArray[RecNum] := 0; + Reset(MenuFile); + RecNum := 0; + WHILE NOT Eof(MenuFile) DO + BEGIN + Read(MenuFile,MenuR); + IF (MenuR.Menu = FALSE) THEN + Inc(NumCmds) + ELSE + BEGIN + Inc(NumMenus); + MenuRecNumArray[NumMenus] := RecNum; + IF (NumMenus > 1) THEN + CmdNumArray[NumMenus - 1] := NumCmds; + NumCmds := 0; + END; + Inc(RecNum); + END; + CmdNumArray[NumMenus] := NumCmds; +END; + +PROCEDURE CommandEditor(MenuToModify,MenuNumber: Integer; MenuName: AStr); +VAR + TempS: AStr; + Cmd: Char; + RecNumToList, + Counter: Integer; + + FUNCTION DisplayCmdFlags(CmdFlags: CmdFlagSet; C1,C2: Char): AStr; + VAR + CmdFlagT: CmdFlagType; + DisplayStr: AStr; + BEGIN + DisplayStr := ''; + FOR CmdFlagT := Hidden TO UnHidden DO + IF (CmdFlagT IN CmdFlags) THEN + DisplayStr := DisplayStr + '^'+C1+Copy('HU',(Ord(CmdFlagT) + 1),1) + ELSE + DisplayStr := DisplayStr + '^'+C2+'-'; + DisplayCmdFlags := DisplayStr; + END; + + PROCEDURE ToggleCmdFlag(CmdFlagT: CmdFlagType; VAR CmdFlags: CmdFlagSet); + BEGIN + IF (CmdFlagT IN CmdFlags) THEN + Exclude(CmdFlags,CmdFlagT) + ELSE + Include(CmdFlags,CmdFlagT); + END; + + PROCEDURE ToggleCmdFlags(C: Char; VAR CmdFlags: CmdFlagSet; VAR Changed: Boolean); + VAR + TempCmdFlags: CmdFlagSet; + BEGIN + TempCmdFlags := CmdFlags; + CASE C OF + 'H' : ToggleCmdFlag(Hidden,CmdFlags); + 'U' : ToggleCmdFlag(UnHidden,CmdFlags); + END; + IF (CmdFlags <> TempCmdFlags) THEN + Changed := TRUE; + END; + + PROCEDURE InitCommandVars(VAR MenuR: MenuRec); + BEGIN + FillChar(MenuR,SizeOf(MenuR),0); + WITH MenuR DO + BEGIN + LDesc[1] := '<< New Command >>'; + ACS := ''; + NodeActivityDesc := ''; + Menu := FALSE; + CmdFlags := []; + SDesc := '(XXX)New Cmd'; + CKeys := 'XXX'; + CmdKeys := '-L'; + Options := ''; + END; + END; + + FUNCTION GetRecNum(NumCmds: Integer): Integer; + VAR + R: REAL; + BEGIN + R := (NumCmds / 3); + IF (Frac(r) = 0.0) THEN + GetRecNum := Trunc(R) + ELSE + GetRecNum := (Trunc(R) + 1); + END; + + PROCEDURE DeleteCommand; + VAR + RecNumToDelete, + RecNum: SmallInt; + BEGIN + IF (CmdNumArray[MenuToModify] = 0) THEN + Messages(4,0,'commands') + ELSE + BEGIN + RecNumToDelete := -1; + InputIntegerWOC('%LFDelete which command?',RecNumToDelete,[NumbersOnly],1,CmdNumArray[MenuToModify]); + IF (RecNumToDelete >= 1) AND (RecNumToDelete <= CmdNumArray[MenuToModify]) THEN + BEGIN + Seek(MenuFile,(MenuRecNumArray[MenuToModify] + RecNumToDelete)); + Read(MenuFile,MenuR); + Print('%LFCommand: ^5'+MenuR.LDesc[1]); + IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN + BEGIN + Print('%LF[> Deleting command record ...'); + SysOpLog('* Deleted command: ^5'+MenuR.LDesc[1]); + RecNumToDelete := (MenuRecNumArray[MenuToModify] + RecNumToDelete); { Convert To Real Record Number } + IF (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; + LastError := IOResult; + END; + END; + END; + END; + + PROCEDURE InsertCommand; + VAR + RecNumToInsertBefore, + InsertNum, + RecNum: SmallInt; + BEGIN + IF (CmdNumArray[MenuToModify] = MaxCmds) THEN + Messages(5,MaxCmds,'commands') + ELSE + BEGIN + RecNumToInsertBefore := -1; + InputIntegerWOC('%LFCommand to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(CmdNumArray[MenuToModify] + 1)); + IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (CmdNumArray[MenuToModify] + 1)) THEN + BEGIN + InsertNum := 1; + InputIntegerWOC('%LFInsert how many commands?',InsertNum, + [DisplayValue,NumbersOnly],1,(MaxCmds - CmdNumArray[MenuToModify])); + IF (InsertNum < 1) OR (InsertNum > (MaxCmds - CmdNumArray[MenuToModify])) THEN + InsertNum := 1; + Print('%LF[> Inserting '+IntToStr(InsertNum)+' commands.'); + SysOpLog('* Inserted '+IntToStr(InsertNum)+' commands.'); + RecNumToInsertBefore := (MenuRecNumArray[MenuToModify] + RecNumToInsertBefore); { Convert To Real Record Number } + FOR RecNum := 1 TO InsertNum DO + BEGIN + Seek(MenuFile,FileSize(MenuFile)); + Write(MenuFile,MenuR); + END; + FOR RecNum := ((FileSize(MenuFile) - 1) - InsertNum) DOWNTO RecNumToInsertBefore DO + BEGIN + Seek(MenuFile,RecNum); + Read(MenuFile,MenuR); + Seek(MenuFile,(RecNum + InsertNum)); + Write(MenuFile,MenuR); + END; + InitCommandVars(MenuR); + FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + InsertNum) - 1) DO + BEGIN + Seek(MenuFile,RecNum); + Write(MenuFile,MenuR); + END; + LoadMenuPointers; + LastError := IOResult; + END; + END; + END; + + PROCEDURE ModifyCommand; + VAR + TempS1: AStr; + Cmd1: Char; + TempB: Byte; + RecNumToModify, + SaveRecNumToModify: SmallInt; + Changed: Boolean; + BEGIN + IF (CmdNumArray[MenuToModify] = 0) THEN + Messages(4,0,'commands') + ELSE + BEGIN + RecNumToModify := -1; + InputIntegerWOC('%LFCommand to modify?',RecNumToModify,[NumbersOnly],1,CmdNumArray[MenuToModify]); + IF (RecNumToModify >= 1) AND (RecNumToModify <= CmdNumArray[MenuToModify]) THEN + BEGIN + SaveRecNumToModify := -1; + Cmd1 := #0; + WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO + BEGIN + IF (SaveRecNumToModify <> RecNumToModify) THEN + BEGIN + Seek(MenuFile,(MenuRecNumArray[MenuToModify] + RecNumToModify)); + Read(MenuFile,MenuR); + SaveRecNumToModify := RecNumToModify; + Changed := FALSE; + END; + WITH MenuR DO + REPEAT + IF (Cmd1 <> '?') THEN + BEGIN + Abort := FALSE; + Next := FALSE; + MCIAllowed := FALSE; + CLS; + Print('^5'+MenuName+' #'+IntToStr(MenuNumber)); + Print('^5Command #'+IntToStr(RecNumToModify)+' of '+IntToStr(CmdNumArray[MenuToModify])); + NL; + PrintACR('^11. Long descript : ^5'+LDesc[1]); + PrintACR('^12. Short descript: ^5'+SDesc); + PrintACR('^13. Menu keys : ^5'+CKeys); + PrintACR('^14. ACS required : ^5"'+ACS+'"'); + PrintACR('^15. CmdKeys : ^5'+CmdKeys); + PrintACR('^16. Options : ^5'+Options+'^1'); + IF (General.MultiNode) THEN + PrintACR('^1N. Node activity : ^5'+NodeActivityDesc); + PrintACR('^1T. Flags : ^5'+DisplayCmdFlags(CmdFlags,'5','1')); + MCIAllowed := TRUE; + END; + IF (General.MultiNode) THEN + LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q123456NT[]FJL?'^M,TRUE,TRUE) + ELSE + LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q123456T[]FJL?'^M,TRUE,TRUE); + CASE Cmd1 OF + '1' : InputWNWC('%LF^1New long description:%LF^4: ',LDesc[1],(SizeOf(LDesc[1]) - 1),Changed); + '2' : InputWNWC('%LFNew short description: ',SDesc,(SizeOf(SDesc) - 1),Changed); + '3' : InputWN1('%LFNew menu keys: ',Ckeys,(SizeOf(CKeys) - 1),[InterActiveEdit,UpperOnly],Changed); + '4' : InputWN1('%LFNew ACS: ',ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed); + '5' : BEGIN + REPEAT + Prt('%LFNew command keys [^5?^4=^5List^4]: '); + MPL(2); + Input(TempS1,2); + IF (TempS1 = '?') THEN + BEGIN + CLS; + PrintF('MENUCMD'); + NL; + END; + UNTIL (HangUp) OR (TempS1 <> '?'); + IF (Length(TempS1) = 2) THEN + BEGIN + CmdKeys := TempS1; + Changed := TRUE; + END; + END; + '6' : InputWNWC('%LFNew options: ',Options,(SizeOf(Options) - 1),Changed); + '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? ('+DisplayCmdFlags(CmdFlags,'5','4')+')'+ + ' [^5?^4=^5Help^4,^5^4=^5Quit^4]: ',Cmd1,^M'HU?',TRUE,TRUE); + CASE Cmd1 OF + 'H','U' : + ToggleCmdFlags(Cmd1,CmdFlags,Changed); + '?' : BEGIN + NL; + LCmds(17,3,'Hidden command','UnHidden Command'); + 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 < CmdNumArray[MenuToModify]) 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,CmdNumArray[MenuToModify]); + IF (RecNumToModify < 1) and (RecNumToModify > CmdNumArray[MenuToModify]) THEN + Cmd1 := #0; + END; + 'L' : IF (RecNumToModify <> CmdNumArray[MenuToModify]) THEN + RecNumToModify := CmdNumArray[MenuToModify] + ELSE + BEGIN + Messages(3,0,''); + Cmd1 := #0; + END; + '?' : BEGIN + Print('%LF^1<^3CR^1>Redisplay screen'); + Print('^31-6,N,T^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 (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); + IF (Changed) THEN + BEGIN + Seek(MenuFile,(MenuRecNumArray[MenuToModify] + SaveRecNumToModify)); + Write(MenuFile,MenuR); + Changed := FALSE; + SysOpLog('* Modified command: ^5'+MenuR.LDesc[1]); + END; + END; + LastError := IOResult; + END; + END; + END; + + PROCEDURE PositionCommand; + VAR + TempMenuR: MenuRec; + RecNumToPosition, + RecNumToPositionBefore, + RecNum1, + RecNum2: SmallInt; + BEGIN + IF (CmdNumArray[MenuToModify] = 0) THEN + Messages(4,0,'commands') + ELSE IF (CmdNumArray[MenuToModify] = 1) THEN + Messages(6,0,'commands') + ELSE + BEGIN + RecNumToPosition := -1; + InputIntegerWOC('%LFPosition which command',RecNumToPosition,[NumbersOnly],1,CmdNumArray[MenuToModify]); + IF (RecNumToPosition >= 1) AND (RecNumToPosition <= CmdNumArray[MenuToModify]) THEN + BEGIN + Print('%LFAccording to the current numbering system.'); + InputIntegerWOC('%LFPosition before which command?',RecNumToPositionBefore, + [NumbersOnly],1,(CmdNumArray[MenuToModify] + 1)); + IF (RecNumToPositionBefore <> RecNumToPosition) AND + (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN + BEGIN + RecNumToPosition := (MenuRecNumArray[MenuToModify] + RecNumToPosition); { Convert To Real Record Number } + RecNumToPositionBefore := (MenuRecNumArray[MenuToModify] + RecNumToPositionBefore); + Print('%LF[> Positioning command.'); + IF (RecNumToPositionBefore > RecNumToPosition) THEN + Dec(RecNumToPositionBefore); + Seek(MenuFile,RecNumToPosition); + Read(MenuFile,TempMenuR); + RecNum1 := RecNumToPosition; + IF (RecNumToPosition > RecNumToPositionBefore) THEN + RecNum2 := -1 + ELSE + RecNum2 := 1; + WHILE (RecNum1 <> RecNumToPositionBefore) DO + BEGIN + IF ((RecNum1 + RecNum2) < FileSize(MenuFile)) THEN + BEGIN + Seek(MenuFile,(RecNum1 + RecNum2)); + Read(MenuFile,MenuR); + Seek(MenuFile,RecNum1); + Write(MenuFile,MenuR); + END; + Inc(RecNum1,RecNum2); + END; + Seek(MenuFile,RecNumToPositionBefore); + Write(MenuFile,TempMenuR); + END; + LastError := IOResult; + END; + END; + END; + +BEGIN + Cmd := #0; + REPEAT + IF (Cmd <> '?') THEN + BEGIN + Abort := FALSE; + Next := FALSE; + MCIAllowed := FALSE; + CLS; + PrintACR('^0###^4:^3Short Desc. ^0###^4:^3Short Desc. ^0###^4:^3Short Desc.'); + PrintACR('^4===:===================== ===:===================== ===:====================='); + Reset(MenuFile); + RecNumToList := 1; + WHILE (RecNumToList <= GetRecNum(CmdNumArray[MenuToModify])) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(MenuFile,(RecNumToList + MenuRecNumArray[MenuToModify])); + Read(MenuFile,MenuR); + TempS := '^0'+PadRightStr(IntToStr(RecNumToList),3)+' ^5'+PadLeftStr(MenuR.SDesc,21)+' '; + Counter := (RecNumToList + GetRecNum(CmdNumArray[MenuToModify])); + IF (Counter <= CmdNumArray[MenuToModify]) THEN + BEGIN + Seek(MenuFile,(Counter + MenuRecNumArray[MenuToModify])); + Read(MenuFile,MenuR); + TempS := TempS + '^0'+PadRightStr(IntToStr(Counter),3)+' ^5'+PadLeftStr(MenuR.SDesc,21)+' '; + END; + Counter := (Counter + GetRecNum(CmdNumArray[MenuToModify])); + IF (Counter <= CmdNumArray[MenuToModify]) THEN + BEGIN + Seek(MenuFile,Counter + MenuRecNumArray[MenuToModify]); + Read(MenuFile,MenuR); + TempS := TempS + '^0'+PadRightStr(IntToStr(Counter),3)+' ^5'+PadLeftStr(MenuR.SDesc,21); + END; + PrintACR(TempS); + Inc(RecNumToList); + END; + IF (CmdNumArray[MenuToModify] = 0) THEN + Print('*** No commands defined ***'); + MCIAllowed := TRUE; + END; + LOneK('%LFCommand editor [^5?^4=^5Help^4]: ',Cmd,'QDILMPSX?'^M,TRUE,TRUE); + CASE Cmd OF + 'D' : DeleteCommand; + 'I' : InsertCommand; + 'L' : BEGIN + Seek(MenuFile,MenuRecNumArray[MenuNumber]); + Read(MenuFile,MenuR); + CurMenu := MenuNumber; + LoadMenu; + Reset(MenuFile); + GenericMenu(3); + NL; + PauseScr(FALSE); + END; + 'M' : ModifyCommand; + 'P' : PositionCommand; + 'S' : BEGIN + Seek(MenuFile,MenuRecNumArray[MenuNumber]); + Read(MenuFile,MenuR); + CurMenu := MenuNumber; + LoadMenu; + Reset(MenuFile); + GenericMenu(2); + NL; + PauseScr(FALSE); + END; + '?' : BEGIN + Print('%LF^1<^3CR^1>Redisplay screen'); + LCmds(20,3,'Delete command','Insert command'); + LCmds(20,3,'Long generic menu','Modify commands'); + LCmds(20,3,'Position command','Quit'); + LCmds(20,3,'Short generic menu',''); + END; + END; + UNTIL (Cmd = 'Q') OR (HangUp); + LastError := IOResult; +END; + +END. diff --git a/SOURCE/SYSOP8.PAS b/SOURCE/SYSOP8.PAS new file mode 100644 index 0000000..442d5c1 --- /dev/null +++ b/SOURCE/SYSOP8.PAS @@ -0,0 +1,1135 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT SysOp8; + +INTERFACE + +PROCEDURE MessageAreaEditor; + +IMPLEMENTATION + +USES + Common, + File2, + Mail0, + SysOp7; + +PROCEDURE MessageAreaEditor; +CONST + DisplayType: Byte = 1; +VAR + MsgareaDefFile: FILE OF MessageAreaRecordType; + TempMemMsgArea: MessageAreaRecordType; + Cmd: Char; + RecNumToList: SmallInt; + Ok, + Changed, + SaveTempPause: Boolean; + + FUNCTION DisplayNetFlags(MAFlags: MAFlagSet; C1,C2: Char): AStr; + VAR + MAFlagT: MessageAreaFlagType; + TempS: AStr; + BEGIN + TempS := ''; + FOR MAFlagT := MASKludge TO MAInternet DO + IF (MAFlagT IN MAFlags) THEN + TempS := TempS + '^'+C1+Copy('RUAPFQKSOTI',(Ord(MAFlagT) + 1),1) + ELSE + TempS := TempS + '^'+C2+'-'; + DisplayNetFlags := TempS; + END; + + FUNCTION DisplayMAFlags(MAFlags: MAFlagSet; C1,C2: Char): AStr; + VAR + MAFlagT: MessageAreaFlagType; + TempS: AStr; + BEGIN + TempS := ''; + FOR MAFlagT := MARealName TO MAQuote DO + IF (MAFlagT IN MAFlags) THEN + TempS := TempS + '^'+C1+Copy('RUAPFQKSOTI',(Ord(MAFlagT) + 1),1) + ELSE + TempS := TempS + '^'+C2+'-'; + DisplayMAFlags := TempS; + END; + + PROCEDURE ToggleMAFlag(MAFlagT: MessageAreaFlagType; VAR MAFlags: MAFlagSet); + BEGIN + IF (MAFlagT IN MAFlags) THEN + Exclude(MAFlags,MAFlagT) + ELSE + Include(MAFlags,MAFlagT); + END; + + PROCEDURE ToggleMAFlags(C: Char; VAR MAFlags: MAFlagSet; VAR Changed: Boolean); + VAR + TempMAFlags: MAFlagSet; + BEGIN + TempMAFlags := MAFlags; + CASE C OF + 'R' : ToggleMAFlag(MARealName,MAFlags); + 'U' : ToggleMAFlag(MAUnHidden,MAFlags); + 'A' : ToggleMAFlag(MAFilter,MAFlags); + 'P' : ToggleMAFlag(MAPrivate,MAFlags); + 'F' : ToggleMAFlag(MAForceRead,MAFlags); + 'Q' : ToggleMAFlag(MAQuote,MAFlags); + 'K' : ToggleMAFlag(MASKludge,MAFlags); + 'S' : ToggleMAFlag(MASSeenby,MAFlags); + 'O' : ToggleMAFlag(MASOrigin,MAFlags); + 'T' : ToggleMAFlag(MAAddTear,MAFlags); + 'I' : ToggleMAFlag(MAInternet,MAFlags); + END; + IF (MAFlags <> TempMAFlags) THEN + Changed := TRUE; + END; + + FUNCTION AnonTypeChar(Anonymous: AnonTyp): Char; + BEGIN + CASE Anonymous OF + ATYes : AnonTypeChar := 'Y'; + ATNo : AnonTypeChar := 'N'; + ATForced : AnonTypeChar := 'F'; + ATDearAbby : AnonTypeChar := 'D'; + ATAnyName : AnonTypeChar := 'A'; + END; + END; + + FUNCTION NodeStr(AKA: BYTE): AStr; + VAR + TempS: AStr; + BEGIN + TempS := IntToStr(General.AKA[AKA].Zone)+':'+ + IntToStr(General.AKA[AKA].Net)+'/'+ + IntToStr(General.AKA[AKA].Node); + IF (General.AKA[AKA].Point > 0) THEN + TempS := TempS+'.'+IntToStr(General.AKA[AKA].Point); + NodeStr := TempS; + END; + + FUNCTION MATypeStr(MAType: Integer): AStr; + BEGIN + CASE MAType OF + 0 : MATypeStr := 'Local'; + 1 : MATypeStr := 'EchoMail'; + 2 : MATypeStr := 'GroupMail'; + 3 : MATypeStr := 'QwkMail'; + END; + END; + + FUNCTION AnonTypeStr(Anonymous: AnonTyp): ASTR; + BEGIN + CASE Anonymous OF + ATYes : AnonTypeStr := 'Yes'; + ATNo : AnonTypeStr := 'No'; + ATForced : AnonTypeStr := 'Forced'; + ATDearAbby : AnonTypeStr := 'Dear Abby'; + ATAnyName : AnonTypeStr := 'Any Name'; + END; + END; + + PROCEDURE InitMsgAreaVars(VAR MemMsgArea: MessageAreaRecordType); + BEGIN + FillChar(MemMsgArea,SizeOf(MemMsgArea),0); + WITH MemMsgArea DO + BEGIN + Name := '<< New Message Area >>'; + FileName := 'NEWBOARD'; + MsgPath := ''; + ACS := ''; + PostACS := ''; + MCIACS := ''; + SysOpACS := ''; + MaxMsgs := 100; + Anonymous := ATNo; + Password := ''; + MAFlags := []; + MAType := 0; + Origin := ''; + Text_Color := General.Text_Color; + Quote_Color := General.Quote_Color; + Tear_Color := General.Tear_Color; + Origin_Color := General.Origin_Color; + MessageReadMenu := 0; + QuoteStart := '|03Quoting message from |11@F |03to |11@T'; + QuoteEnd := '|03on |11@D|03.'; + PrePostFile := ''; + AKA := 0; + QWKIndex := 0; + END; + END; + + PROCEDURE ChangeMsgAreaDrive(Drive: Char; FirstRecNum: SmallInt); + VAR + LastRecNum, + RecNum: SmallInt; + BEGIN + IF (NumMsgAreas = 0) THEN + Messages(4,0,'message areas') + ELSE + BEGIN + FirstRecNum := -1; + InputIntegerWOC('%LFMessage area to start at?',FirstRecNum,[NumbersOnly],1,NumMsgAreas); + IF (FirstRecNum >= 1) AND (FirstRecNum <= NumMsgAreas) THEN + BEGIN + LastRecNum := -1; + InputIntegerWOC('%LFMessage area to end at?',LastRecNum,[NumbersOnly],1,NumMsgAreas); + IF (LastRecNum >= 1) AND (LastRecNum <= NumMsgAreas) THEN + BEGIN + IF (FirstRecNum > LastRecNum) OR (LastRecNum < FirstRecNum) THEN + Messages(8,0,'') + ELSE + BEGIN + LOneK('%LFChange to which drive? (^5A^4-^5Z^4): ',Drive,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'^M,TRUE,TRUE); + ChDir(Drive+':'); + IF (IOResult <> 0) THEN + Messages(7,0,'') + ELSE + BEGIN + ChDir(StartDir); + Prompt('%LFUpdating the drive for message area '+IntToStr(FirstRecNum)+' to '+IntTostr(LastRecNum)+' ... '); + Reset(MsgAreaFile); + FOR RecNum := FirstRecNum TO LastRecNum DO + BEGIN + Seek(MsgAreaFile,(RecNum - 1)); + Read(MsgAreaFile,MemMsgArea); + IF (MemMsgArea.MAType IN [1,2]) THEN + MemMsgArea.MsgPath[1] := Drive; + Seek(MsgAreaFile,(RecNum - 1)); + Write(MsgAreaFile,MemMsgArea); + END; + Close(MsgAreaFile); + LastError := IOResult; + Print('Done'); + SysOpLog('* Changed message areas: ^5'+IntToStr(FirstRecNum)+'^1-^5'+IntToStr(LastRecNum)+'^1 to ^5'+Drive+':\'); + END; + END; + END; + END; + END + END; + + PROCEDURE DeleteMsgArea(TempMemMsgArea1: MessageAreaRecordType; RecNumToDelete: SmallInt); + VAR + RecNum: Integer; + Ok, + Ok1: Boolean; + BEGIN + IF (NumMsgAreas = 0) THEN + Messages(4,0,'message areas') + ELSE + BEGIN + RecNumToDelete := -1; + InputIntegerWOC('%LFMessage area to delete?',RecNumToDelete,[NumbersOnly],1,NumMsgAreas); + IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumMsgAreas) THEN + BEGIN + Reset(MsgAreaFile); + Seek(MsgAreaFile,(RecNumToDelete - 1)); + Read(MsgAreaFile,TempMemMsgArea1); + Close(MsgAreaFile); + LastError := IOResult; + Print('%LFMessage area: ^5'+TempMemMsgArea1.Name); + IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN + BEGIN + Print('%LF[> Deleting message area record ...'); + Dec(RecNumToDelete); + Reset(MsgAreaFile); + IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(MsgAreaFile) - 2)) THEN + FOR RecNum := RecNumToDelete TO (FileSize(MsgAreaFile) - 2) DO + BEGIN + Seek(MsgAreaFile,(RecNum + 1)); + Read(MsgAreaFile,MemMsgArea); + Seek(MsgAreaFile,RecNum); + Write(MsgAreaFile,MemMsgArea); + END; + Seek(MsgAreaFile,(FileSize(MsgAreaFile) - 1)); + Truncate(MsgAreaFile); + Close(MsgAreaFile); + LastError := IOResult; + Dec(NumMsgAreas); + SysOpLog('* Deleted message area: ^5'+TempMemMsgArea1.Name); + Ok := TRUE; + Ok1 := TRUE; + Reset(MsgAreaFile); + FOR RecNum := 1 TO FileSize(MsgAreaFile) DO + BEGIN + Seek(MsgAreaFile,(RecNum - 1)); + Read(MsgAreaFile,MemMsgArea); + IF (MemMsgArea.FileName = TempMemMsgArea1.FileName) THEN + Ok := FALSE; + IF (TempMemMsgArea1.MAType IN [1,2]) AND (MemMsgArea.MsgPath = TempMemMsgArea1.MsgPath) THEN + Ok1 := FALSE; + END; + Close(MsgAreaFile); + IF (Ok) THEN + IF (PYNQ('%LFDelete message area data files also? ',0,FALSE)) THEN + BEGIN + Kill(General.MsgPath+MemMsgArea.FileName+'.HDR'); + Kill(General.MsgPath+MemMsgArea.FileName+'.DAT'); + Kill(General.MsgPath+MemMsgArea.FileName+'.SCN'); + END; + IF (Ok1) AND (TempMemMsgArea1.MAType IN [1,2]) THEN + IF PYNQ('%LFRemove the message directory? ',0,FALSE) THEN + PurgeDir(TempMemMsgArea1.MsgPath,TRUE); + END; + END; + END; + END; + + PROCEDURE CheckMessageArea(MemMsgArea: MessageAreaRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean); + VAR + Counter: Byte; + BEGIN + FOR Counter := StartErrMsg TO EndErrMsg DO + CASE Counter OF + 1 : IF (MemMsgArea.Name = '') OR (MemMsgArea.Name = '<< New Message Area >>') THEN + BEGIN + Print('%LF^7The area name is invalid!^1'); + OK := FALSE; + END; + 2 : IF (MemMsgArea.FileName = '') OR (MemMsgArea.FileName = 'NEWBOARD') THEN + BEGIN + Print('%LF^7The file name is invalid!^1'); + OK := FALSE; + END; + 3 : IF (MemMsgArea.MAType IN [1,2]) AND (MemMsgArea.MsgPath = '') THEN + BEGIN + Print('%LF^7The message path is invalid!^1'); + OK := FALSE; + END; + 4 : IF (MemMsgArea.MAType IN [1,2]) AND (General.AKA[MemMsgArea.AKA].Net = 0) THEN + BEGIN + Print('%LF^7The AKA address is invalid!^1'); + Ok := FALSE; + END; + 5 : IF (MemMsgArea.MAType IN [1..3]) AND (MemMsgArea.Origin = '') THEN + BEGIN + Print('%LF^7The origin is invalid!^1'); + Ok := FALSE; + END; + END; + END; + + PROCEDURE EditMessageArea(TempMemMsgArea1: MessageAreaRecordType; VAR MemMsgArea: MessageAreaRecordType; VAR Cmd1: Char; + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); + VAR + TempFileName: Str8; + Path1, + Path2: Str52; + CmdStr: AStr; + RecNum, + RecNum1, + RecNumToList: Integer; + SaveQWKIndex: Word; + Ok: Boolean; + BEGIN + WITH MemMsgArea DO + REPEAT + IF (Cmd1 <> '?') THEN + BEGIN + MCIAllowed := FALSE; + Abort := FALSE; + Next := FALSE; + CLS; + IF (RecNumToEdit = -1) THEN + PrintACR('^5Default Message Area Configuration:') + ELSE + BEGIN + IF (Editing) THEN + PrintACR('^5Editing '+AOnOff(RecNumToEdit = 0,'private mail','message area #'+IntToStr(RecNumToEdit)+ + ' of '+IntToStr(NumMsgAreas))) + ELSE + PrintACR('^5Inserting message area #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumMsgAreas + 1)); + END; + NL; + PrintACR('^1A. Area name : ^5'+Name); + PrintACR('^1B. File name : ^5'+FileName+' ^7('+General.MsgPath+MemMsgArea.FileName+'.*)'); + PrintACR('^1C. Area type : ^5'+MATypeStr(MAType)); + IF (MAType IN [1,2]) THEN + PrintACR('^1 Message path: ^5'+MsgPath); + PrintACR('^1D. ACS required: ^5'+AOnOff(ACS = '','*None*',ACS)); + PrintACR('^1E. Post/MCI ACS: ^5'+AOnOff(PostACS = '','*None*',PostACS)+'^1 / ^5' + +AOnOff(MCIACS = '','*None*',MCIACS)); + PrintACR('^1G. Sysop ACS : ^5'+AOnOff(SysOpACS = '','*None*',SysOpACS)); + PrintACR('^1H. Max messages: ^5'+IntToStr(MaxMsgs)); + PrintACR('^1I. Anonymous : ^5'+AnonTypeStr(Anonymous)); + PrintACR('^1K. Password : ^5'+AOnOff(Password = '','*None*',Password)); + IF (MAType IN [1,2]) THEN + PrintACR('^1M. Net Address : ^5'+NodeStr(AKA)); + PrintACR('^1N. Colors : ^1Text=^'+IntToStr(Text_Color)+IntToStr(Text_Color)+ + '^1, Quote=^'+IntToStr(Quote_Color)+IntToStr(Quote_Color)+ + '^1, Tear=^'+IntToStr(Tear_Color)+IntToStr(Tear_Color)+ + '^1, Origin=^'+IntToStr(Origin_Color)+IntToStr(Origin_Color)); + PrintACR('^1O. Read menu : ^5'+IntToStr(MessageReadMenu)); + IF (MAType IN [1,2]) THEN + PrintACR('^1P. Mail flags : ^5'+DisplayNetFlags(MAFlags,'5','1')); + IF (MAType IN [1..3]) THEN + PrintACR('^1R. Origin line : ^5'+Origin); + PrintACR('^1S. Start quote : ^5'+AOnOff(QuoteStart = '','*None*',QuoteStart)); + PrintACR('^1T. End quote : ^5'+AOnOff(QuoteEnd = '','*None*',QuoteEnd)); + PrintACR('^1U. Post file : ^5'+AOnOff(PrePostFile = '','*None*',PrePostFile)); + PrintACR('^1V. QWK Index : ^5'+IntToStr(QWKIndex)); + PrintACR('^1W. Flags : ^5'+DisplayMAFlags(MAFlags,'5','1')); + MCIAllowed := TRUE; + END; + IF (RecNumToEdit = 0) THEN + CmdStr := 'ADEGHNOSTUW' + ELSE + BEGIN + IF (NOT Editing) THEN + CmdStr := 'ABCDEGHIKNOSTUVW' + ELSE + CmdStr := 'ABCDEGHIKNOSTUVW[]FJL'; + IF (MAType IN [1,2]) THEN + CmdStr := CmdStr + 'MP'; + IF (MAType IN [1..3]) THEN + CmdStr := CmdStr + 'R'; + END; + LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE); + CASE Cmd1 OF + 'A' : REPEAT + TempMemMsgArea1.Name := MemMsgArea.Name; + Ok := TRUE; + InputWNWC('%LFNew area name: ',Name,(SizeOF(Name) - 1),Changed); + CheckMessageArea(MemMsgArea,1,1,Ok); + IF (NOT Ok) THEN + MemMsgArea.Name := TempMemMsgArea1.Name; + UNTIL (Ok) OR (HangUp); + 'B' : REPEAT + Ok := TRUE; + TempFileName := FileName; + InputWN1('%LFNew file name (^5Do not enter ^4"^5.EXT^4"): ',TempFileName,(SizeOf(FileName) - 1), + [UpperOnly,InterActiveEdit],Changed); + TempFileName := SQOutSp(TempFileName); + IF (Pos('.',TempFileName) > 0) THEN + FileName := Copy(TempFileName,1,(Pos('.',TempFileName) - 1)); + MemMsgArea.FileName := TempFileName; + CheckMessageArea(MemMsgArea,2,2,Ok); + TempFileName := MemMsgArea.FileName; + IF (Ok) AND (TempFileName <> MemMsgArea.FileName) THEN + BEGIN + RecNum1 := -1; + RecNum := 0; + WHILE (RecNum <= (FileSize(MsgAreaFile) - 1)) AND (RecNum1 = -1) DO + BEGIN + Seek(MsgAreaFile,RecNum); + Read(MsgAreaFile,TempMemMsgArea1); + IF (TempFileName = TempMemMsgArea1.FileName) THEN + BEGIN + Print('%LF^7The file name is already in use!^1'); + RecNum1 := 1; + IF NOT PYNQ('%LFUse this file name anyway? ',0,FALSE) THEN + Ok := FALSE; + END; + Inc(RecNum); + END; + END; + IF (Ok) THEN + BEGIN + Path1 := General.MsgPath+MemMsgArea.FileName; + FileName := TempFileName; + IF (Editing) THEN + BEGIN + Path2 := General.MsgPath+MemMsgArea.FileName; + IF Exist(Path1+'.HDR') AND (NOT Exist(Path2+'.HDR')) THEN + BEGIN + Print('%LFOld HDR/DAT/SCN file names: "^5'+Path1+'.*^1"'); + Print('%LFNew HDR/DAT/SCN file names: "^5'+Path2+'.*^1"'); + IF PYNQ('%LFRename old data files? ',0,FALSE) THEN + BEGIN + CopyMoveFile(FALSE,'%LF^1Renaming "^5'+Path1+'.HDR^1" to "^5'+Path2+'.HDR^1": ',Path1+'.HDR', + Path2+'.HDR',TRUE); + CopyMoveFile(FALSE,'%LF^1Renaming "^5'+Path1+'.DAT^1" to "^5'+Path2+'.DAT^1": ',Path1+'.DAT', + Path2+'.DAT',TRUE); + CopyMoveFile(FALSE,'%LF^1Renaming "^5'+Path1+'.SCN^1" to "^5'+Path2+'.SCN^1": ',Path1+'.SCN', + Path2+'.SCN',TRUE); + END; + END; + END; + END; + UNTIL (Ok) OR (HangUp); + 'C' : BEGIN + TempMemMsgArea1.MAType := MaType; + Print('%LF^5Message area types:^1'); + NL; + LCmds(10,3,'Local',''); + LCmds(10,3,'Echomail',''); + LCmds(10,3,'Groupmail',''); + LCmds(10,3,'QWKmail',''); + LOneK('%LFNew message area type [^5L^4,^5E^4,^5G^4,^5Q^4,^5^4=^5Quit^4]: ',Cmd1,'LEGQ'^M,TRUE,TRUE); + CASE Cmd1 OF + 'L' : MAType := 0; + 'E' : MAType := 1; + 'G' : MAType := 2; + 'Q' : MAType := 3; + END; + IF (MAType IN [1,2]) THEN + BEGIN + IF (MsgPath <> '') THEN + MsgPath := MsgPath + ELSE + MsgPath := General.DefEchoPath+FileName+'\'; + InputPath('%LF^1New message path (^5End with a ^1"^5\^1"):%LF^4:',MsgPath,FALSE,FALSE,Changed); + END; + IF (TempMemMsgArea1.MAtype <> MaType) THEN + BEGIN + IF (MaType IN [0,3]) THEN + BEGIN + MsgPath := ''; + IF (MASKludge IN MAFlags) THEN + Exclude(MAFlags,MASKludge); + IF (MASSeenby IN MAFlags) THEN + Exclude(MAFlags,MASSeenby); + IF (MASOrigin IN MAFlags) THEN + Exclude(MAFlags,MASOrigin); + IF (MAAddTear IN MAFlags) THEN + Exclude(MAFlags,MAAddTear); + END + ELSE + BEGIN + IF (General.SKludge) THEN + Include(MAFlags,MASKludge); + IF (General.SSeenby) THEN + Include(MAFlags,MASSeenby); + IF (General.SOrigin) THEN + Include(MAFlags,MASOrigin); + IF (General.Addtear) THEN + Include(MAFlags,MAAddTear); + END; + IF (MAType = 0) THEN + Origin := '' + ELSE + BEGIN + IF (General.Origin <> '') THEN + Origin := General.Origin; + END; + Changed := TRUE; + END; + Cmd1 := #0; + END; + 'D' : InputWN1('%LFNew ACS: ',ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed); + 'E' : BEGIN + InputWN1('%LFNew Post ACS: ',PostACS,(SizeOf(PostACS) - 1),[InterActiveEdit],Changed); + InputWN1('%LFNew MCI ACS: ',MCIACS,(SizeOf(MCIACS) - 1),[InterActiveEdit],Changed); + END; + 'G' : InputWN1('%LFNew SysOp ACS: ',SysOpACS,(SizeOf(SysOpACS) - 1),[InterActiveEdit],Changed); + 'H' : InputWordWC('%LFMax messages',MaxMsgs,[DisplayValue,NumbersOnly],1,65535,Changed); + 'I' : BEGIN + TempMemMsgArea1.Anonymous := Anonymous; + Print('%LF^5Anonymous types:^1'); + NL; + LCmds(40,3,'Yes, Anonymous allowed, selectively',''); + LCmds(40,3,'No, Anonymous not allowed',''); + LCmds(40,3,'Forced Anonymous',''); + LCmds(40,3,'Dear Abby',''); + LCmds(40,3,'Any Name',''); + LOneK('%LFNew anonymous type [^5Y^4,^5N^4,^5F^4,^5D^4,^5A^4,^5^4=^5Quit^4]: ',Cmd1,'YNFDA'^M,TRUE,TRUE); + CASE Cmd1 OF + 'Y' : Anonymous := ATYes; + 'N' : Anonymous := ATNo; + 'F' : Anonymous := ATForced; + 'D' : Anonymous := ATDearAbby; + 'A' : Anonymous := ATAnyName; + END; + IF (TempMemMsgArea1.Anonymous <> Anonymous) THEN + Changed := TRUE; + Cmd1 := #0; + END; + 'K' : InputWN1('%LFNew password: ',Password,(SizeOf(Password) - 1),[InterActiveEdit,UpperOnly],Changed); + 'M' : IF (MAType IN [1,2]) THEN + BEGIN + TempMemMsgArea1.AKA := AKA; + REPEAT + Ok := TRUE; + Print('%LF^5Network addresses:'); + NL; + FOR RecNum := 0 TO 19 DO + BEGIN + Prompt('^1'+PadRightStr(IntToStr(RecNum),2)+'. ^5'+PadLeftStr(NodeStr(RecNum),25)); + IF (Odd(RecNum)) THEN + NL; + END; + InputByteWOC('%LFNew AKA address',AKA,[DisplayValue,NumbersOnly],0,19); + CheckMessageArea(MemMsgArea,4,4,Ok); + IF (NOT Ok) THEN + AKA := TempMemMsgArea1.AKA; + UNTIL (Ok) OR (HangUp); + IF (TempMemMsgArea1.AKA <> AKA) THEN + Changed := TRUE; + END; + 'N' : BEGIN + Prompt('%LF^5Colors: '); + ShowColors; + InputByteWC('%LFNew standard text color',Text_Color,[DisplayValue,NumbersOnly],0,9,Changed); + InputByteWC('%LFNew quoted text color',Quote_Color,[DisplayValue,NumbersOnly],0,9,Changed); + InputByteWC('%LFNew tear line color',Tear_Color,[DisplayValue,NumbersOnly],0,9,Changed); + InputByteWC('%LFNew origin line color',Origin_Color,[DisplayValue,NumbersOnly],0,9,Changed); + END; + 'O' : FindMenu('%LFNew read menu (^50^4=^5Default^4)',MessageReadMenu,0,NumMenus,Changed); + 'P' : IF (MAType IN [1,2]) THEN + BEGIN + REPEAT + LOneK('%LFToggle which network flag ('+DisplayNetFlags(MAFlags,'5','4')+ + '^4) [^5?^4=^5Help^4,^5^4=^5Quit^4]: ',Cmd1,^M'IKSOCBMT?',TRUE,TRUE); + CASE Cmd1 OF + 'K','S','O','T','I' : + ToggleMAFlags(Cmd1,MAFlags,Changed); + '?' : BEGIN + NL; + LCmds(22,3,'Kludge line strip','SEEN-BY line strip'); + LCmds(22,3,'Origin line strip','Tear/Origin line add'); + LCmds(22,3,'Internet flag',''); + END; + END; + UNTIL (Cmd1 = ^M) OR (HangUp); + Cmd1 := #0; + END; + 'R' : IF (MAType IN [1..3]) THEN + REPEAT + OK := TRUE; + InputWN1('%LF^4New origin line:%LF: ',Origin,(SizeOf(Origin) - 1),[InterActiveEdit],Changed); + CheckMessageArea(MemMsgArea,5,5,Ok); + UNTIL (Ok) OR (HangUp); + 'S' : InputWNWC('%LF^1New starting quote:%LF^4: ',QuoteStart,(SizeOf(QuoteStart) - 1),Changed); + 'T' : InputWNWC('%LF^1New ending quote:%LF^4: ',QuoteEnd,(SizeOf(QuoteEnd) - 1),Changed); + 'U' : InputWN1('%LFNew pre-post filename: ',PrePostFile,(SizeOf(PrePostFile) - 1),[],Changed); + 'V' : BEGIN + SaveQWKIndex := QWKIndex; + InputWordWOC('%LFNew permanent QWK Index',QWKIndex,[DisplayValue,NumbersOnly],1,(NumMsgAreas + 1)); + IF (SaveQWKIndex <> QWKIndex) AND (QWKIndex >= 1) AND (QWKIndex <= (NumMsgAreas + 1)) THEN + BEGIN + RecNum1 := -1; + RecNum := 0; + WHILE (RecNum <= (FileSize(MsgAreaFile) - 1)) AND (RecNum1 = -1) DO + BEGIN + Seek(MsgAreaFile,RecNum); + Read(MsgAreaFile,TempMemMsgArea1); + IF (QWKIndex = TempMemMsgArea1.QWKIndex) THEN + BEGIN + Print('%LF^7The QWK Index number is already in use!^1'); + PauseScr(FALSE); + RecNum1 := 1; + QWKIndex := SaveQWKIndex; + END; + Inc(RecNum); + END; + END; + IF (SaveQWKIndex <> QWKIndex) THEN + Changed := TRUE; + END; + 'W' : BEGIN + REPEAT + LOneK('%LFToggle which flag ('+DisplayMAFlags(MAFlags,'5','4')+ + '^4) [^5?^4=^5Help^4,^5^4=^5Quit^4]: ',Cmd1,^M'RUAPFQ?',TRUE,TRUE); + CASE Cmd1 OF + 'R','U','A','P','F','Q' : + ToggleMAFlags(Cmd1,MAFlags,Changed); + '?' : BEGIN + NL; + LCmds(25,3,'Real names','Unhidden'); + LCmds(25,3,'AFilter ANSI/8-bit ASCII','Private msgs allowed'); + LCmds(25,3,'Force Read','Quote/Tagline'); + END; + END; + UNTIL (Cmd1 = ^M) OR (HangUp); + Cmd1 := #0; + END; + '[' : IF (RecNumToEdit > 1) THEN + Dec(RecNumToEdit) + ELSE + BEGIN + Messages(2,0,''); + Cmd1 := #0; + END; + ']' : IF (RecNumToEdit < NumMsgAreas) 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,NumMsgAreas); + IF (RecNumToEdit < 1) OR (RecNumToEdit > NumMsgAreas) THEN + Cmd1 := #0; + END; + 'L' : IF (RecNumToEdit <> NumMsgAreas) THEN + RecNumToEdit := NumMsgAreas + 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-^3W^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 InsertMsgArea(TempMemMsgArea1: MessageAreaRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); + VAR + MsgAreaScanFile: FILE OF ScanRec; + RecNum, + RecNum1, + RecNumToEdit: SmallInt; + Ok, + Changed: Boolean; + BEGIN + IF (NumMsgAreas = MaxMsgAreas) THEN + Messages(5,MaxMsgAreas,'message areas') + ELSE + BEGIN + RecNumToInsertBefore := -1; + InputIntegerWOC('%LFMessage area to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumMsgAreas + 1)); + IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumMsgAreas + 1)) THEN + BEGIN + Reset(MsgAreaFile); + + Assign(MsgAreaDefFile,General.DataPath+'MBASES.DEF'); + IF (NOT Exist(General.DataPath+'MBASES.DEF')) THEN + InitMsgAreaVars(TempMemMsgArea1) + ELSE + BEGIN + Reset(MsgAreaDefFile); + Seek(MsgAreaDefFile,0); + Read(MsgAreaDefFile,TempMemMsgArea1); + Close(MsgAreaDefFile); + END; + + TempMemMsgArea1.QWKIndex := (FileSize(MsgAreaFile) + 1); + IF (RecNumToInsertBefore = 1) THEN + RecNumToEdit := 1 + ELSE IF (RecNumToInsertBefore = (NumMsgAreas + 1)) THEN + RecNumToEdit := (NumMsgAreas + 1) + ELSE + RecNumToEdit := RecNumToInsertBefore; + REPEAT + OK := TRUE; + EditMessageArea(TempMemMsgArea1,TempMemMsgArea1,Cmd1,RecNumToEdit,Changed,FALSE); + CheckMessageArea(TempMemMsgArea1,1,5,Ok); + IF (NOT OK) THEN + IF (NOT PYNQ('%LFContinue inserting message area? ',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 message area record ...'); + Seek(MsgAreaFile,FileSize(MsgAreaFile)); + Write(MsgAreaFile,MemMsgArea); + Dec(RecNumToInsertBefore); + FOR RecNum := ((FileSize(MsgAreaFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO + BEGIN + Seek(MsgAreaFile,RecNum); + Read(MsgAreaFile,MemMsgArea); + Seek(MsgAreaFile,(RecNum + 1)); + Write(MsgAreaFile,MemMsgArea); + END; + FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO + BEGIN + IF (TempMemMsgArea1.MAType IN [1,2]) THEN + MakeDir(TempMemMsgArea1.MsgPath,FALSE); + IF (NOT Exist(General.MsgPath+TempMemMsgArea1.FileName+'.HDR')) THEN + BEGIN + Assign(MsgHdrF,General.MsgPath+TempMemMsgArea1.FileName+'.HDR'); + ReWrite(MsgHdrF); + Close(MsgHdrF); + END; + IF (NOT Exist(General.MsgPath+TempMemMsgArea1.FileName+'.DAT')) THEN + BEGIN + Assign(MsgTxtF,General.MsgPath+TempMemMsgArea1.FileName+'.DAT'); + ReWrite(MsgTxtF,1); + Close(MsgTxtF); + END; + IF (NOT Exist(General.MsgPath+TempMemMsgArea1.FileName+'.SCN')) THEN + BEGIN + Assign(MsgAreaScanFile,General.MsgPath+TempMemMsgArea1.FileName+'.SCN'); + ReWrite(MsgAreaScanFile); + Close(MsgAreaScanFile); + END; + IF (Exist(General.MsgPath+TempMemMsgArea1.FileName+'.SCN')) THEN + BEGIN + Assign(MsgAreaScanFile,General.MsgPath+TempMemMsgArea1.FileName+'.SCN'); + Reset(MsgAreaScanFile); + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + FOR RecNum1 := (FileSize(MsgAreaScanFile) + 1) TO (MaxUsers - 1) DO + Write(MsgAreaScanFile,LastReadRecord); + Close(MsgAreaScanFile); + END; + Seek(MsgAreaFile,RecNum); + Write(MsgAreaFile,TempMemMsgArea1); + Inc(NumMsgAreas); + SysOpLog('* Inserted message area: ^5'+TempMemMsgArea1.Name); + END; + END; + Close(MsgAreaFile); + LastError := IOResult; + END; + END; + END; + + PROCEDURE ModifyMsgArea(TempMemMsgArea1: MessageAreaRecordType; Cmd1: Char; RecNumToEdit: SmallInt); + VAR + User: UserRecordType; + MsgAreaScanFile: FILE OF ScanRec; + RecNum1, + SaveRecNumToEdit: Integer; + Ok, + Changed: Boolean; + BEGIN + RecNumToEdit := -1; + InputIntegerWOC('%LFModify which message area?',RecNumToEdit,[NumbersOnly],0,NumMsgAreas); + IF ((RecNumToEdit >= 0) AND (RecNumToEdit <= NumMsgAreas)) THEN + BEGIN + SaveRecNumToEdit := -1; + Cmd1 := #0; + IF (RecNumToEdit = 0) THEN + BEGIN + Assign(EMailFile,General.DataPath+'MEMAIL.DAT'); + Reset(EmailFile); + END + ELSE + BEGIN + Assign(MsgAreaFile,General.DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + END; + WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO + BEGIN + IF (SaveRecNumToEdit <> RecNumToEdit) THEN + BEGIN + IF (RecNumToEdit = 0) THEN + BEGIN + Seek(EMailFile,0); + Read(EMailFile,MemMsgArea); + END + ELSE + BEGIN + Seek(MsgAreaFile,(RecNumToEdit - 1)); + Read(MsgAreaFile,MemMsgArea); + END; + SaveRecNumToEdit := RecNumToEdit; + Changed := FALSE; + END; + REPEAT + Ok := TRUE; + EditMessageArea(TempMemMsgArea1,MemMsgArea,Cmd1,RecNumToEdit,Changed,TRUE); + CheckMessageArea(MemMsgArea,1,5,Ok); + IF (NOT OK) THEN + BEGIN + PauseScr(FALSE); + IF (RecNumToEdit <> SaveRecNumToEdit) THEN + RecNumToEdit := SaveRecNumToEdit; + END; + UNTIL (Ok) OR (HangUp); + IF (MemMsgArea.MAType IN [1,2]) THEN + MakeDir(MemMsgArea.MsgPath,FALSE); + IF (NOT Exist(General.MsgPath+MemMsgArea.FileName+'.HDR')) THEN + BEGIN + Assign(MsgHdrF,General.MsgPath+MemMsgArea.FileName+'.HDR'); + ReWrite(MsgHdrF); + Close(MsgHdrF); + END; + IF (NOT Exist(General.MsgPath+MemMsgArea.FileName+'.DAT')) THEN + BEGIN + Assign(MsgTxtF,General.MsgPath+MemMsgArea.FileName+'.DAT'); + ReWrite(MsgTxtF,1); + Close(MsgTxtF); + END; + IF (RecNumToEdit <> 0) THEN + BEGIN + IF (NOT Exist(General.MsgPath+MemMsgArea.FileName+'.SCN')) THEN + BEGIN + Assign(MsgAreaScanFile,General.MsgPath+MemMsgArea.FileName+'.SCN'); + ReWrite(MsgAreaScanFile); + Close(MsgAreaScanFile); + END; + IF (Exist(General.MsgPath+MemMsgArea.FileName+'.SCN')) THEN + BEGIN + Assign(MsgAreaScanFile,General.MsgPath+MemMsgArea.FileName+'.SCN'); + Reset(MsgAreaScanFile); + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgAreaScanFile,FileSize(MsgAreaScanFile)); + FOR RecNum1 := (FileSize(MsgAreaScanFile) + 1) TO (MaxUsers - 1) DO + Write(MsgAreaScanFile,LastReadRecord); + Reset(UserFile); + FOR RecNum1 := 1 TO (MaxUsers - 1) DO + BEGIN + LoadURec(User,RecNum1); + IF (Deleted IN User.SFlags) THEN + BEGIN + Seek(MsgAreaScanFile,(RecNum1 - 1)); + Write(MsgAreaScanFile,LastReadRecord); + END; + END; + Close(UserFile); + Close(MsgAreaScanFile); + END; + END; + IF (Changed) THEN + BEGIN + IF (RecNumToEdit = 0) THEN + BEGIN + Seek(EMailFile,0); + Write(EMailFile,MemMsgArea); + END + ELSE + BEGIN + Seek(MsgAreaFile,(SaveRecNumToEdit - 1)); + Write(MsgAreaFile,MemMsgArea); + END; + SysOpLog('* Modified message area: ^5'+MemMsgArea.Name); + END; + END; + IF (RecNumToEdit = 0) THEN + Close(EmailFile) + ELSE + Close(MsgAreaFile); + LastError := IOResult; + END; + END; + + PROCEDURE PositionMsgArea(TempMemMsgArea1: MessageAreaRecordType; RecNumToPosition: SmallInt); + VAR + RecNumToPositionBefore, + RecNum1, + RecNum2: SmallInt; + BEGIN + IF (NumMsgAreas = 0) THEN + Messages(4,0,'message areas') + ELSE IF (NumMsgAreas = 1) THEN + Messages(6,0,'message areas') + ELSE + BEGIN + RecNumToPosition := -1; + InputIntegerWOC('%LFPosition which message area?',RecNumToPosition,[NumbersOnly],1,NumMsgAreas); + IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumMsgAreas) THEN + BEGIN + RecNumToPositionBefore := -1; + Print('%LFAccording to the current numbering system.'); + InputIntegerWOC('%LFPosition before which message area?',RecNumToPositionBefore,[NumbersOnly],1,(NumMsgAreas + 1)); + IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumMsgAreas + 1)) AND + (RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN + BEGIN + Print('%LF[> Positioning message area records ...'); + IF (RecNumToPositionBefore > RecNumToPosition) THEN + Dec(RecNumToPositionBefore); + Dec(RecNumToPosition); + Dec(RecNumToPositionBefore); + Reset(MsgAreaFile); + Seek(MsgAreaFile,RecNumToPosition); + Read(MsgAreaFile,TempMemMsgArea1); + RecNum1 := RecNumToPosition; + IF (RecNumToPosition > RecNumToPositionBefore) THEN + RecNum2 := -1 + ELSE + RecNum2 := 1; + WHILE (RecNum1 <> RecNumToPositionBefore) DO + BEGIN + IF ((RecNum1 + RecNum2) < FileSize(MsgAreaFile)) THEN + BEGIN + Seek(MsgAreaFile,(RecNum1 + RecNum2)); + Read(MsgAreaFile,MemMsgArea); + Seek(MsgAreaFile,RecNum1); + Write(MsgAreaFile,MemMsgArea); + END; + Inc(RecNum1,RecNum2); + END; + Seek(MsgAreaFile,RecNumToPositionBefore); + Write(MsgAreaFile,TempMemMsgArea1); + Close(MsgAreaFile); + LastError := IOResult; + END; + END; + END; + END; + + PROCEDURE RenumberQWKIndex; + VAR + RecNum: Integer; + BEGIN + IF (NumMsgAreas = 0) THEN + Messages(4,0,'message areas') + ELSE + BEGIN + IF PYNQ('%LFRenumber QWK Index for all message areas? ',0,FALSE) THEN + BEGIN + Prompt('%LFRenumbering the QWK index''s for all areas ... '); + Reset(MsgAreaFile); + RecNum := 1; + WHILE (RecNum <= NumMsgAreas) DO + BEGIN + Seek(MsgAreaFile,(RecNum - 1)); + Read(MsgAreaFile,MemMsgArea); + MemMsgArea.QWKIndex := RecNum; + Seek(MsgAreaFile,(RecNum - 1)); + Write(MsgAreaFile,MemMsgArea); + Inc(RecNum); + END; + Close(MsgAreaFile); + LastError := IOResult; + Print('Done'); + SysOpLog('* Renumbered the QWK index for all message areas.'); + END; + END; + END; + + PROCEDURE DisplayMsgArea(RecNumToList1: Integer); + BEGIN + WITH MemMsgArea DO + CASE DisplayType OF + 1 : PrintACR('^0'+PadRightInt(RecNumToList1,5)+ + ' ^5'+PadLeftStr(Name,24)+ + ' ^3'+Copy('LEGQ',(MAType + 1),1)+DisplayMAFlags(MAFlags,'5','4')+ + ' ^9'+PadLeftStr(AOnOff(ACS = '','*None*',ACS),10)+ + ' '+PadLeftStr(AOnOff(PostACS = '','*None*',PostACS),9)+ + ' '+PadLeftStr(AOnOff(MCIACS = '','*None*',MCIACS),9)+ + ' ^3'+PadLeftInt(MaxMsgs,6)+ + ' '+AnonTypeChar(Anonymous)); + 2 : PrintACR('^0'+PadRightInt(RecNumToList1,5)+ + ' ^5'+PadLeftStr(Name,27)+ + ' ^3'+PadLeftStr(AOnOff(MAType IN [0,3],'*None*',NodeStr(AKA)),11)+ + ' '+PadLeftStr(AOnOff(MsgPath = '','*None*',MsgPath),33)); + END; + END; + + PROCEDURE ListMsgAreas(VAR RecNumToList1: SmallInt); + VAR + NumDone: Integer; + BEGIN + IF (RecNumToList1 < 0) OR (RecNumToList1 > NumMsgAreas) THEN + RecNumToList1 := 0; + MCIAllowed := FALSE; + Abort := FALSE; + Next := FALSE; + CLS; + CASE DisplayType OF + 1 : BEGIN + PrintACR('^0#####^4:^3Message area name ^4:^3Flag ^4:^3ACS ^4:^3Post ACS ^4:^3MCI ACS'+ + ' ^4:^3MaxM ^4:^3A'); + PrintACR('^4=====:========================:=======:==========:=========:=========:======:='); + END; + 2 : BEGIN + PrintACR('^0#####^4:^3Message area name ^4:^3Address ^4:^3Message path'); + PrintACR('^4=====:===========================:===========:================================='); + END; + END; + IF (RecNumToList1 = 0) THEN + BEGIN + NumDone := 0; + Assign(EmailFile,General.DataPath+'MEMAIL.DAT'); + Reset(EMailFile); + Seek(EmailFile,RecNumToList1); + Read(EMailFile,MemMsgArea); + DisplayMsgArea(RecNumToList1); + Close(EmailFile); + LastError := IOResult; + RecNumToList := 1; + END; + Assign(MsgAreaFile,General.DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + NumDone := 1; + WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumMsgAreas) + AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(MsgAreaFile,(RecNumToList1 - 1)); + Read(MsgAreaFile,MemMsgArea); + DisplayMsgArea(RecNumToList1); + Inc(RecNumToList1); + Inc(NumDone); + END; + Close(MsgAreaFile); + LastError := IOResult; + MCIAllowed := TRUE; + END; + +BEGIN + SaveTempPause := TempPause; + TempPause := FALSE; + RecNumToList := 0; + Cmd := #0; + REPEAT + IF (Cmd <> '?') THEN + ListMsgAreas(RecNumToList); + LOneK('%LFMessage area editor [^5?^4=^5Help^4]: ',Cmd,'QCDIMPRTX?'^M,TRUE,TRUE); + CASE Cmd OF + ^M : IF (RecNumToList < 0) OR (RecNumToList > NumMsgAreas) THEN + RecNumToList := 0; + 'C' : ChangeMsgAreaDrive(Cmd,RecNumToList); + 'D' : DeleteMsgArea(TempMemMsgArea,RecNumToList); + 'I' : InsertMsgArea(TempMemMsgArea,Cmd,RecNumToList); + 'M' : ModifyMsgArea(TempMemMsgArea,Cmd,RecNumToList); + 'P' : PositionMsgArea(TempMemMsgArea,RecNumToList); + 'R' : ReNumberQWKIndex; + 'T' : DisplayType := ((DisplayType MOD 2) + 1); + 'X' : BEGIN + Assign(MsgAreaDefFile,General.DataPath+'MBASES.DEF'); + IF (Exist(General.DataPath+'MBASES.DEF')) THEN + BEGIN + Reset(MsgAreaDefFile); + Seek(MsgAreaDefFile,0); + Read(MsgAreaDefFile,MemMsgArea); + END + ELSE + BEGIN + ReWrite(MsgAreaDefFile); + InitMsgAreaVars(MemMsgArea); + END; + RecNumToList := -1; + EditMessageArea(TempMemMsgArea,MemMsgArea,Cmd,RecNumToList,Changed,FALSE); + Seek(MsgAreaDefFile,0); + Write(MsgAreaDefFile,MemMsgArea); + Close(MsgAreaDefFile); + Cmd := #0; + END; + '?' : BEGIN + Print('%LF^1<^3CR^1>Next screen or redisplay current screen'); + Print('^1(^3?^1)Help/First message area'); + LCmds(22,3,'Change message storage drive',''); + LCmds(22,3,'Delete message area','Insert message area'); + LCmds(22,3,'Modify message area','Position message area'); + LCmds(22,3,'Quit','Renumber QWK index'); + LCmds(22,3,'Toggle display format','XDefault configuration'); + END; + END; + IF (Cmd <> ^M) THEN + RecNumToList := 0; + UNTIL (Cmd = 'Q') OR (HangUp); + TempPause := SaveTempPause; + NewComptables; + IF ((MsgArea < 1) OR (MsgArea > NumMsgAreas)) THEN + MsgArea := 1; + ReadMsgArea := -1; + LoadMsgArea(MsgArea); + LastError := IOResult; +END; + +END. + diff --git a/SOURCE/SYSOP9.PAS b/SOURCE/SYSOP9.PAS new file mode 100644 index 0000000..8da5e7b --- /dev/null +++ b/SOURCE/SYSOP9.PAS @@ -0,0 +1,1266 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} +UNIT SysOp9; + +INTERFACE + +PROCEDURE FileAreaEditor; + +IMPLEMENTATION + +USES + Common, + File0, + File2, + SysOp2K; + +PROCEDURE FileAreaEditor; +TYPE + MCIVarRecord = Record + OldPath, + NewPath: AStr; + Drive: Char; + FirstRecNum, + LastRecNum, + RecNumToEdit: SmallInt; + END; + +CONST + DisplayType: Byte = 1; + +VAR + TempMemFileArea: FileAreaRecordType; + MCIVars: MCIVarRecord; + Cmd: Char; + RecNumToList: Integer; + SaveTempPause: Boolean; + + FUNCTION DisplayFAFlags(FAFlags: FAFlagSet; C1,C2: Char): AStr; + VAR + FAFlagT: FileAreaFlagType; + DisplayStr: AStr; + BEGIN + DisplayStr := ''; + FOR FAFlagT := FANoRatio TO FANoDupeCheck DO + BEGIN + IF (FAFlagT IN FAFlags) THEN + DisplayStr := DisplayStr + '^'+C1+Copy('NUISGCDP',(Ord(FAFlagT) + 1),1) + ELSE + DisplayStr := DisplayStr + '^'+C2+'-' + END; + DisplayFAFlags := DisplayStr; + END; + + PROCEDURE ToggleFAFlag(FAFlagT: FileAreaFlagType; VAR FAFlags: FAFlagSet); + BEGIN + IF (FAFlagT IN FAFlags) THEN + Exclude(FAFlags,FAFlagT) + ELSE + Include(FAFlags,FAFlagT); + END; + + PROCEDURE ToggleFAFlags(C: Char; VAR FAFlags: FAFlagSet; VAR Changed: Boolean); + VAR + SaveFAFlags: FAFlagSet; + BEGIN + SaveFAFlags := FAFlags; + CASE C OF + 'N' : ToggleFAFlag(FANoRatio,FAFlags); + 'U' : ToggleFAFlag(FAUnHidden,FAFlags); + 'I' : ToggleFAFlag(FADirDLPath,FAFlags); + 'S' : ToggleFAFlag(FAShowName,FAFlags); + 'G' : ToggleFAFlag(FAUseGIFSpecs,FAFlags); + 'C' : ToggleFAFlag(FACDRom,FAFlags); + 'D' : ToggleFAFlag(FAShowDate,FAFlags); + 'P' : ToggleFAFlag(FANoDupeCheck,FAFlags); + END; + IF (FAFlags <> SaveFAFlags) THEN + Changed := TRUE; + END; + + PROCEDURE InitFileAreaVars(VAR MemFileArea: FileAreaRecordType); + BEGIN + FillChar(MemFileArea,SizeOf(MemFileArea),0); + WITH MemFileArea DO + BEGIN + AreaName := '<< New File Area >>'; + FileName := 'NEWDIR'; + DLPath := StartDir[1]+':\'; + ULPath := DLPath; + MaxFiles := 2000; + Password := ''; + ArcType := 0; + CmtType := 0; + ACS := ''; + ULACS := ''; + DLACS := ''; + FAFlags := []; + END; + END; + + FUNCTION FAEMCI(CONST S: STRING; MemFileArea: FileAreaRecordType; MCIVars1: MCIVarRecord): STRING; + VAR + Temp: STRING; + Add: AStr; + Index: Byte; + BEGIN + Temp := ''; + FOR Index := 1 TO Length(S) DO + IF (S[Index] = '%') AND (Index + 1 < Length(S)) THEN + BEGIN + Add := '%' + S[Index + 1] + S[Index + 2]; + CASE UpCase(S[Index + 1]) OF + 'A' : CASE UpCase(S[Index + 2]) OF + 'N' : Add := MemFileArea.AreaName; + 'R' : Add := AOnOff((MemFileArea.ACS = ''),'*None*',MemFileArea.ACS); + 'T' : Add := AOnOff((MemFileArea.ArcType = 0),'*None*',General.FileArcInfo[MemFileArea.ArcType].Ext); + END; + 'C' : CASE UpCase(S[Index + 2]) OF + 'T' : Add := +AOnOff((MemFileArea.CmtType = 0),'*None*',IntToStr(MemFileArea.CmtType)); + END; + 'D' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := MCIVars1.Drive; + 'P' : Add := MemFileArea.DLPath; + 'R' : Add := AOnOff((MemFileArea.DLACS = ''),'*None*',MemFileArea.DLACS); + END; + 'F' : CASE UpCase(S[Index + 2]) OF + 'N' : Add := MemFileArea.FileName; + 'R' : Add := IntToStr(MCIVars1.FirstRecNum); + 'S' : Add := DisplayFAFlags(MemFileArea.FAFlags,'5','1'); + 'T' : Add := DisplayFAFlags(MemFileArea.FAFlags,'5','4'); + END; + 'G' : CASE UpCase(S[Index + 2]) OF + 'D' : Add := GetDirPath(MemFileArea); + END; + 'L' : CASE UpCase(S[Index + 2]) OF + 'R' : Add := IntToStr(MCIVars1.LastRecNum); + END; + 'M' : CASE UpCase(S[Index + 2]) OF + 'A' : Add := IntToStr(MaxFileAreas); + 'F' : Add := IntToStr(MemFileArea.MaxFiles); + END; + 'N' : CASE UpCase(S[Index + 2]) OF + 'A' : Add := IntToStr(NumFileAreas); + 'F' : Add := IntToStr(NumFileAreas + 1); + 'P' : Add := MCIVars1.NewPath; + END; + 'O' : CASE UpCase(S[Index + 2]) OF + 'P' : Add := MCIVars1.OldPath; + END; + 'P' : CASE UpCase(S[Index + 2]) OF + 'W' : Add := AOnOff((MemFileArea.Password = ''),'*None*',MemFileArea.Password); + END; + 'R' : CASE UpCase(S[Index + 2]) OF + 'E' : Add := IntToStr(MCIVars1.RecNumToEdit); + END; + 'U' : CASE UpCase(S[Index + 2]) OF + 'P' : Add := MemFileArea.ULPath; + 'R' : Add := AOnOff((MemFileArea.ULACS = ''),'*None*',MemFileArea.ULACS); + END; + END; + Temp := Temp + Add; + Inc(Index,2); + END + ELSE + Temp := Temp + S[Index]; + FAEMCI := Temp; + END; + + FUNCTION FAELngStr(StrNum: LongInt; MemFileArea: FileAreaRecordType; MCIVars1: MCIVarRecord; PassValue: Boolean): AStr; + VAR + StrPointerFile: FILE OF StrPointerRec; + StrPointer: StrPointerRec; + RGStrFile: FILE; + S: STRING; + TotLoad: LongInt; + Found: Boolean; + BEGIN + Assign(StrPointerFile,General.LMultPath+'FAEPR.DAT'); + Reset(StrPointerFile); + Seek(StrPointerFile,StrNum); + Read(StrPointerFile,StrPointer); + Close(StrPointerFile); + LastError := IOResult; + TotLoad := 0; + Assign(RGStrFile,General.LMultPath+'FAETX.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)); + S := FAEMCI(S,MemFileArea,MCIVars1); + IF (PassValue) THEN + BEGIN + IF (S[Length(s)] = '@') THEN + Dec(S[0]); + END + ELSE + BEGIN + IF (S[Length(S)] = '@') THEN + BEGIN + Dec(S[0]); + Prompt(S); + END + ELSE + PrintACR(S); + END; + UNTIL (TotLoad >= StrPointer.TextSize) OR (Abort) OR (HangUp); + Close(RGStrFile); + LastError := IOResult; + FAELNGStr := S; + END; + + { + ChangeFileArea External String Table + + 1. NO_FILE_AREAS + + %LF^7No file areas exist!^1 + %PA + + 2. FILE_CHANGE_DRIVE_START + + %LFFile area to start at? @ + + 3. FILE_CHANGE_DRIVE_END + + %LFFile area to end at?' @ + + 4. FILE_CHANGE_INVALID_ORDER + + %LF^7Invalid record number order!^1 + %PA + + 5. FILE_CHANGE_DRIVE_DRIVE + + %LFChange to which drive? (^5A^4-^5Z^4): @ + + 6. FILE_CHANGE_INVALID_DRIVE + + %LF^7Invalid drive!^1 + %PA + + 7. FILE_CHANGE_UPDATING_DRIVE + + %LFUpdating the drive for file area %FR to %LR ... + + 8. FILE_CHANGE_UPDATING_DRIVE_DONE + + Done! + + 9. FILE_CHANGE_UPDATING_SYSOPLOG + + * Changed file areas: ^5%FR^1-^5%LR^1 to ^5%DD:\ + } + + PROCEDURE ChangeFileAreaDrive(MCIVars1: MCIVarRecord); + VAR + RecNum: Integer; + BEGIN + IF (NumFileAreas = 0) THEN + FAELngStr(5,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + MCIVars1.FirstRecNum := -1; + InputIntegerWOC(FAELngStr(6,MemFileArea,MCIVars1,TRUE),MCIVars1.FirstRecNum,[NumbersOnly],1,NumFileAreas); + IF (MCIVars1.FirstRecNum >= 1) AND (MCIVars1.FirstRecNum <= NumFileAreas) THEN + BEGIN + MCIVars1.LastRecNum := -1; + InputIntegerWOC(FAELngStr(7,MemFileArea,MCIVars1,TRUE),MCIVars1.LastRecNum,[NumbersOnly],1,NumFileAreas); + IF (MCIVars1.LastRecNum >= 1) AND (MCIVars1.LastRecNum <= NumFileAreas) THEN + BEGIN + IF (MCIVars1.FirstRecNum > MCIVars1.LastRecNum) OR (MCIVars1.LastRecNum < MCIVars1.FirstRecNum) THEN + FAELngStr(9,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + LOneK(FAELngStr(8,MemFileArea,MCIVars1,TRUE),MCIVars1.Drive,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'^M,TRUE,TRUE); + ChDir(MCIVars1.Drive+':'); + IF (IOResult <> 0) THEN + FAELngStr(10,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + ChDir(StartDir); + FAELngStr(11,MemFileArea,MCIVars1,FALSE); + Reset(FileAreaFile); + FOR RecNum := MCIVars1.FirstRecNum TO MCIVars1.LastRecNum DO + BEGIN + Seek(FileAreaFile,(RecNum - 1)); + Read(FileAreaFile,MemFileArea); + MemFileArea.ULPath[1] := MCIVars1.Drive; + MemFileArea.DLPath[1] := MCIVars1.Drive; + Seek(FileAreaFile,(RecNum - 1)); + Write(FileAreaFile,MemFileArea); + END; + Close(FileAreaFile); + LastError := IOResult; + FAELngStr(12,MemFileArea,MCIVars1,FALSE); + FAELngStr(13,MemFileArea,MCIVars1,FALSE); + END; + END; + END; + END; + END; + END; + + { + DeleteFileArea External String Table + + 1. NO_FILE_AREAS + + %LF^7No file areas exist!^1 + %PA + + 2. FILE_DELETE_PROMPT + + %LFFile area to delete? @ + + 3. FILE_DELETE_DISPLAY_AREA + + %LFFile area: ^5%AN^1 + + 4. FILE_DELETE_VERIFY_DELETE + + %LFAre you sure you want to delete it? @ + + 5. FILE_DELETE_NOTICE + + %LF[> Deleting file area ... + + 6. FILE_DELETE_SYSOPLOG + + * Deleted file area: ^5%AN + + 7. FILE_DELETE_DATA_FILES + + %LFDelete file area data files also? @ + + 8. FILE_DELETE_REMOVE_DL_DIRECTORY + + %LFRemove the download directory? @ + + 9. FILE_DELETE_REMOVE_UL_DIRECTORY + + %LFRemove the upload directory? @ + } + + + PROCEDURE DeleteFileArea(TempMemFileArea1: FileAreaRecordType; MCIVars1: MCIVarRecord); + VAR + RecNum, + RecNumToDelete: SmallInt; + Ok, + OK1, + Ok2: Boolean; + BEGIN + IF (NumFileAreas = 0) THEN + FAELngStr(5,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + RecNumToDelete := -1; + InputIntegerWOC(FAELngStr(14,MemFileArea,MCIVars1,TRUE),RecNumToDelete,[NumbersOnly],1,NumFileAreas); + IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumFileAreas) THEN + BEGIN + Reset(FileAreaFile); + Seek(FileAreaFile,(RecNumToDelete - 1)); + Read(FileAreaFile,TempMemFileArea1); + Close(FileAreaFile); + LastError := IOResult; + FAELngStr(15,TempMemFileArea1,MCIVars1,FALSE); + IF PYNQ(FAELngStr(16,MemFileArea,MCIVars1,TRUE),0,FALSE) THEN + BEGIN + FAELngStr(17,MemFileArea,MCIVars1,FALSE); + Dec(RecNumToDelete); + Reset(FileAreaFile); + IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(FileAreaFile) - 2)) THEN + FOR RecNum := RecNumToDelete TO (FileSize(FileAreaFile) - 2) DO + BEGIN + Seek(FileAreaFile,(RecNum + 1)); + Read(FileAreaFile,MemFileArea); + Seek(FileAreaFile,RecNum); + Write(FileAreaFile,MemFileArea); + END; + Seek(FileAreaFile,(FileSize(FileAreaFile) - 1)); + Truncate(FileAreaFile); + Close(FileAreaFile); + LastError := IOResult; + Dec(NumFileAreas); + SysOpLog(FAELngStr(18,TempMemFileArea1,MCIVars1,TRUE)); + Ok := TRUE; + Ok1 := TRUE; + OK2 := TRUE; + Reset(FileAreaFile); + FOR RecNum := 1 TO FileSize(FileAreaFile) DO + BEGIN + Seek(FileAreaFile,(RecNum - 1)); + Read(FileAreaFile,MemFileArea); + IF (MemFileArea.FileName = TempMemFileArea1.FileName) THEN + Ok := FALSE; + IF (MemFileArea.DLPath = TempMemFileArea1.DLPath) THEN + Ok1 := FALSE; + IF (MemFileArea.ULPath = TempMemFileArea1.ULPath) THEN + Ok2 := FALSE; + END; + Close(FileAreaFile); + IF (Ok) AND (PYNQ(FAELngStr(19,TempMemFileArea1,MCIVars1,TRUE),0,FALSE)) THEN + BEGIN + Kill(GetDirPath(TempMemFileArea1)+'.DIR'); + Kill(GetDirPath(TempMemFileArea1)+'.EXT'); + Kill(GetDirPath(TempMemFileArea1)+'.SCN'); + END; + IF (Ok1) AND (ExistDir(TempMemFileArea1.DLPath)) THEN + IF PYNQ(FAELngStr(20,TempMemFileArea1,MCIVars1,TRUE),0,FALSE) THEN + PurgeDir(TempMemFileArea1.DLPath,TRUE); + IF (Ok2) AND (ExistDir(TempMemFileArea1.ULPath)) THEN + IF PYNQ(FAELngStr(21,TempMemFileArea1,MCIVars1,TRUE),0,FALSE) THEN + PurgeDir(TempMemFileArea1.ULPath,TRUE); + END; + END; + END; + END; + + { + DeleteFileArea External String Table + + 1. CHECK_AREA_NAME_ERROR + + %LF^7The area name is invalid!^1 + + 2. CHECK_FILE_NAME_ERROR + + %LF^7The file name is invalid!^1' + + 3. CHECK_DL_PATH_ERROR + + %LF^7The download path is invalid!^1 + + 4. CHECK_UL_PATH_ERROR + + %LF^7The upload path is invalid!^1 + + 5. CHECK_ARCHIVE_TYPE_ERROR + + %LF^7The archive type is invalid!^1 + + 6. CHECK_COMMENT_TYPE_ERROR + + %LF^7The comment type is invalid!^1 + + } + + PROCEDURE CheckFileArea(MemFileArea: FileAreaRecordType; + MCIVars1: MCIVarRecord; + StartErrMsg, + EndErrMsg: Byte; + VAR Ok: Boolean); + VAR + Counter: Byte; + BEGIN + FOR Counter := StartErrMsg TO EndErrMsg DO + CASE Counter OF + 1 : IF (MemFileArea.AreaName = '') OR (MemFileArea.AreaName = '<< New File Area >>') THEN + BEGIN + FAELngStr(65,MemFileArea,MCIVars1,FALSE); + OK := FALSE; + END; + 2 : IF (MemFileArea.FileName = '') OR (MemFileArea.FileName = 'NEWDIR') THEN + BEGIN + FAELngStr(66,MemFileArea,MCIVars1,FALSE); + OK := FALSE; + END; + 3 : IF (MemFileArea.DLPath = '') THEN + BEGIN + FAELngStr(67,MemFileArea,MCIVars1,FALSE); + OK := FALSE; + END; + 4 : IF (MemFileArea.ULPath = '') THEN + BEGIN + FAELngStr(68,MemFileArea,MCIVars1,FALSE); + OK := FALSE; + END; + 5 : IF (MemFileArea.ArcType <> 0) AND (NOT General.FileArcInfo[MemFileArea.ArcType].Active) THEN + BEGIN + FAELngStr(69,MemFileArea,MCIVars1,FALSE); + OK := FALSE; + END; + 6 : IF (MemFileArea.CmtType <> 0) AND (General.FileArcComment[MemFileArea.CmtType] = '') THEN + BEGIN + FAELngStr(70,MemFileArea,MCIVars1,FALSE); + OK := FALSE; + END; + END; + END; + + { + DeleteFileArea External String Table + + 1. FILE_EDITING_AREA_HEADER + + ^5Editing file area #%RE of %NA + + 2. FILE_INSERTING_AREA_HEADER + + ^5Inserting file area #%RE of %NF + + 3. FILE_EDITING_INSERTING_SCREEN + + %LF^11. Area name : ^5%AN + ^12. File name : ^5%FN ^7(%GD.*) + ^13. DL path : ^5%DP + ^14. UL path : ^5%UP + ^15. ACS required: ^5%AR + ^16. DL/UL ACS : ^5%DR^1 / ^5%UR + ^17. Max files : ^5%MF + ^18. Password : ^5%PW + ^19. Arc/cmt type: ^5%AT^1 / ^5%CT + ^1T. Flags : ^5%FS + + 4. FILE_EDITING_INSERTING_PROMPT + + %LFModify menu [^5?^4=^5Help^4]: @ + + 5. FILE_AREA_NAME_CHANGE + + %LFNew area name: @ + + 6. FILE_FILE_NAME_CHANGE + + %LFNew file name (^5Do not enter ^4"^5.EXT^4"): @ + + 7. FILE_DUPLICATE_FILE_NAME_ERROR + + %LF^7The file name is already in use!^1 + + 8. FILE_USE_DUPLICATE_FILE_NAME + + %LFUse this file name anyway? @ + + 9. FILE_OLD_DATA_FILES_PATH + + %LFOld DIR/EXT/SCN file names: "^5%OP.*^1" + + 10. FILE_NEW_DATA_FILES_PATH + + %LFNew DIR/EXT/SCN file names: "^5%NP.*^1" + + 11. FILE_RENAME_DATA_FILES + + %LFRename old data files? @ + + 12. FILE_DL_PATH + + ^4New download path @ + + 13. FILE_SET_DL_PATH_TO_UL_PATH + + %LFSet the upload path to the download path? @ + + 14. FILE_UL_PATH + + ^4New upload path @ + + 15. FILE_ACS + + %LFNew ACS: @ + + 16. FILE_DL_ACCESS + + %LFNew download ACS: @ + + 17. FILE_UL_ACCESS + + %LFNew upload ACS: @ + + 18. FILE_MAX_FILES + + %LFNew max files @ + + 19. FILE_PASSWORD + + %LFNew password: @ + + 20. FILE_ARCHIVE_TYPE + + %LFNew archive type (^50^4=^5None^4) @ + + 21. FILE_COMMENT_TYPE + + %LFNew comment type (^50^4=^5None^4) @ + + 22. FILE_TOGGLE_FLAGS + + %LFToggle which flag (%FT)+'^4) [^5?^4=^5Help^4,^5^4=^5Quit^4]: @ + + 23. FILE_MOVE_DATA_FILES + + %LFMove old data files to new directory? @ + + 24. FILE_TOGGLE_HELP + + %LF^1(^3N^1)oRatio ^1(^3U^1)nhidden + ^1(^3G^1)ifSpecs ^1(^3I^1)*.DIR file in DLPath + ^1(^3C^1)D-ROM ^1(^3S^1)how uploader Name + ^1(^3D^1)ate uploaded ^1du(^3P^1)e checking off + + 25. FILE_JUMP_TO + + %LFJump to entry? + + 26. FILE_FIRST_VALID_RECORD + + %LF^7You are at the first valid record!^1 + + 27. FILE_LAST_VALID_RECORD + + %LF^7You are at the last valid record!^1 + + 28. FILE_INSERT_EDIT_HELP + + %LF^1<^3CR^1>Redisplay current screen + ^31-9,T^1:Modify item + + 29. FILE_INSERT_HELP + + ^1(^3Q^1)uit and save + + 30. FILE_EDIT_HELP + + ^1(^3[^1)Back entry ^1(^3]^1)Forward entry'); + ^1(^3F^1)irst entry in list ^1(^3J^1)ump to entry'); + ^1(^3L^1)ast entry in list ^1(^3Q^1)uit and save'); + } + + PROCEDURE EditFileArea(TempMemFileArea1: FileAreaRecordType; VAR MemFileArea: FileAreaRecordType; VAR Cmd1: Char; + VAR MCIVars1: MCIVarRecord; VAR Changed: Boolean; Editing: Boolean); + VAR + TempFileName: Str8; + CmdStr: AStr; + RecNum, + RecNum1: Integer; + Ok: Boolean; + BEGIN + WITH MemFileArea DO + REPEAT + IF (Cmd1 <> '?') THEN + BEGIN + Abort := FALSE; + Next := FALSE; + CLS; + IF (Editing) THEN + FAELngStr(35,MemFileArea,MCIVars1,FALSE) + ELSE + FAELngStr(36,MemFileArea,MCIVars1,FALSE); + FAELngStr(37,MemFileArea,MCIVars1,FALSE); + END; + IF (NOT Editing) THEN + CmdStr := '123456789T' + ELSE + CmdStr := '123456789T[]FJL'; + LOneK(FAELngStr(38,MemFileArea,MCIVars1,TRUE),Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE); + CASE Cmd1 OF + '1' : REPEAT + TempMemFileArea1.AreaName := MemFileArea.AreaName; + OK := TRUE; + InputWNWC(FAELngStr(39,MemFileArea,MCIVars1,TRUE),AreaName,(SizeOf(AreaName) - 1),Changed); + CheckFileArea(MemFileArea,MCIVars1,1,1,Ok); + IF (NOT Ok) THEN + MemFileArea.AreaName := TempMemFileArea1.AreaName; + UNTIL (OK) OR (HangUp); + '2' : REPEAT + OK := TRUE; + TempFileName := FileName; + InputWN1(FAELngStr(40,MemFileArea,MCIVars1,TRUE),TempFileName,(SizeOf(FileName) - 1), + [UpperOnly,InterActiveEdit],Changed); + TempFileName := SQOutSp(TempFileName); + IF (Pos('.',TempFileName) > 0) THEN + TempFileName := Copy(TempFileName,1,(Pos('.',TempFileName) - 1)); + TempMemFileArea1.FileName := TempFileName; + CheckFileArea(TempMemFileArea1,MCIVars1,2,2,Ok); + IF (Ok) AND (TempFileName <> MemFileArea.FileName) THEN + BEGIN + RecNum1 := -1; + RecNum := 0; + WHILE (RecNum <= (FileSize(FileAreaFile) - 1)) AND (RecNum1 = -1) DO + BEGIN + Seek(FileAreaFile,RecNum); + Read(FileAreaFile,TempMemFileArea1); + IF (TempFileName = TempMemFileArea1.FileName) THEN + BEGIN + FAELngStr(41,MemFileArea,MCIVars1,FALSE); + RecNum1 := 1; + IF NOT PYNQ(FAELngStr(42,MemFileArea,MCIVars1,TRUE),0,FALSE) THEN + Ok := FALSE; + END; + Inc(RecNum); + END; + END; + IF (Ok) THEN + BEGIN + MCIVars1.OldPath := GetDirPath(MemFileArea); + FileName := TempFileName; + IF (Editing) THEN + BEGIN + MCIVars1.NewPath := GetDirPath(MemFileArea); + IF Exist(MCIVars1.OldPath+'.DIR') AND (NOT Exist(MCIVars1.NewPath+'.DIR')) THEN + BEGIN + FAELngStr(43,MemFileArea,MCIVars1,FALSE); + FAELngStr(44,MemFileArea,MCIVars1,FALSE); + IF PYNQ(FAELngStr(45,MemFileArea,MCIVars1,TRUE),0,FALSE) THEN + BEGIN + CopyMoveFile(FALSE,'%LF^1Renaming "^5'+MCIVars1.OldPath+'.DIR^1" to "^5'+ + MCIVars1.NewPath+'.DIR^1": ',MCIVars1.OldPath+'.DIR',MCIVars1.NewPath+'.DIR',TRUE); + CopyMoveFile(FALSE,'%LF^1Renaming "^5'+MCIVars1.OldPath+'.EXT^1" to "^5'+ + MCIVars1.NewPath+'.EXT^1": ',MCIVars1.OldPath+'.EXT',MCIVars1.NewPath+'.EXT',TRUE); + CopyMoveFile(FALSE,'%LF^1Renaming "^5'+MCIVars1.OldPath+'.SCN^1" to "^5'+ + MCIVars1.NewPath+'.SCN^1": ',MCIVars1.OldPath+'.SCN',MCIVars1.NewPath+'.SCN',TRUE); + END; + END; + END; + END; + UNTIL (Ok) OR (HangUp); + '3' : BEGIN + InputPath(FAELngStr(46,MemFileArea,MCIVars1,TRUE),DLPath,Editing,FALSE,Changed); + IF (ULPath <> DLPath) AND (PYNQ(FAELngStr(47,MemFileArea,MCIVars1,TRUE),0,FALSE)) THEN + BEGIN + ULPath := DLPath; + Changed := TRUE; + END; + END; + '4' : InputPath(FAELngStr(48,MemFileArea,MCIVars1,TRUE),ULPath,Editing,FALSE,Changed); + '5' : InputWN1(FAELngStr(49,MemFileArea,MCIVars1,TRUE),ACS,(SizeOf(ACS) - 1),[InterActiveEdit],Changed); + '6' : BEGIN + InputWN1(FAELngStr(50,MemFileArea,MCIVars1,TRUE),DLACS,(SizeOf(DLACS) - 1),[InterActiveEdit],Changed); + InputWN1(FAELngStr(51,MemFileArea,MCIVars1,TRUE),ULACS,(SizeOf(ULACS) - 1),[InterActiveEdit],Changed); + END; + '7' : InputIntegerWC(FAELngStr(52,MemFileArea,MCIVars1,TRUE),MaxFiles,[DisplayValue,NumbersOnly],0,32767,Changed); + '8' : InputWN1(FAELngStr(53,MemFileArea,MCIVars1,TRUE),Password,(SizeOf(Password) - 1), + [InterActiveEdit,UpperOnly],Changed); + '9' : BEGIN + REPEAT + OK := TRUE; + NL; + DisplayARCS; + InputByteWC(FAELngStr(54,MemFileArea,MCIVars1,TRUE),MemFileArea.ArcType, + [DisplayValue,NumbersOnly],0,NumArcs,Changed); + CheckFileArea(MemFileArea,MCIVars1,5,5,Ok); + UNTIL (Ok) OR (HangUp); + REPEAT + OK := TRUE; + NL; + DisplayCmt; + InputByteWC(FAELngStr(55,MemFileArea,MCIVars1,TRUE),CmtType,[DisplayValue,NumbersOnly],0,3,Changed); + CheckFileArea(MemFileArea,MCIVars1,6,6,Ok); + UNTIL (Ok) OR (HangUp) + END; + 'T' : BEGIN + REPEAT + LOneK(FAELngStr(56,MemFileArea,MCIVars1,TRUE),Cmd1,^M'CDGINPSU?',TRUE,TRUE); + CASE (Cmd1) OF + 'C','D','G','N','P','S','U' : + ToggleFAFlags(Cmd1,FAFlags,Changed); + 'I' : BEGIN + MCIVars1.OldPath := GetDIRPath(MemFileArea); + ToggleFAFlags('I',FAFlags,Changed); + IF (Editing) THEN + BEGIN + MCIVars1.NewPath := GetDIRPath(MemFileArea); + IF (Exist(MCIVars1.OldPath+'.DIR')) AND (NOT Exist(MCIVars1.NewPath+'.DIR')) THEN + BEGIN + FAELngStr(43,MemFileArea,MCIVars1,FALSE); + FAELngStr(44,MemFileArea,MCIVars1,FALSE); + IF PYNQ(FAELngStr(57,MemFileArea,MCIVars1,TRUE),0,FALSE) THEN + BEGIN + CopyMoveFile(FALSE,'%LF^1Moving "^5'+MCIVars1.OldPath+'.DIR^1" to "^5'+ + MCIVars1.NewPath+'.DIR^1": ',MCIVars1.OldPath+'.DIR',MCIVars1.NewPath+'.DIR', + TRUE); + CopyMoveFile(FALSE,'%LF^1Moving "^5'+MCIVars1.OldPath+'.EXT^1" to "^5'+ + MCIVars1.NewPath+'.EXT^1": ',MCIVars1.OldPath+'.EXT',MCIVars1.NewPath+'.EXT', + TRUE); + CopyMoveFile(FALSE,'%LF^1Moving "^5'+MCIVars1.OldPath+'.SCN^1" to "^5'+ + MCIVars1.NewPath+'.SCN^1": ',MCIVars1.OldPath+'.SCN',MCIVars1.NewPath+'.SCN', + TRUE); + END; + END; + END; + END; + '?' : FAELngStr(58,MemFileArea,MCIVars1,FALSE); + END; + UNTIL (Cmd1 = ^M) OR (HangUp); + Cmd1 := #0; + END; + '[' : IF (MCIVars1.RecNumToEdit > 1) THEN + Dec(MCIVars1.RecNumToEdit) + ELSE + BEGIN + FAELngStr(60,MemFileArea,MCIVars1,FALSE); + Cmd1 := #0; + END; + ']' : IF (MCIVars1.RecNumToEdit < NumFileAreas) THEN + Inc(MCIVars1.RecNumToEdit) + ELSE + BEGIN + FAELngStr(61,MemFileArea,MCIVars1,FALSE); + Cmd1 := #0; + END; + 'F' : IF (MCIVars1.RecNumToEdit <> 1) THEN + MCIVars1.RecNumToEdit := 1 + ELSE + BEGIN + FAELngStr(60,MemFileArea,MCIVars1,FALSE); + Cmd1 := #0; + END; + 'J' : BEGIN + InputIntegerWOC(FAELngStr(59,MemFileArea,MCIVars1,TRUE),MCIVars1.RecNumToEdit,[Numbersonly],1,NumFileAreas); + IF (MCIVars1.RecNumToEdit < 1) OR (MCIVars1.RecNumToEdit > NumFileAreas) THEN + Cmd1 := #0; + END; + 'L' : IF (MCIVars1.RecNumToEdit <> NumFileAreas) THEN + MCIVars1.RecNumToEdit := NumFileAreas + ELSE + BEGIN + FAELngStr(61,MemFileArea,MCIVars1,FALSE); + Cmd1 := #0; + END; + '?' : BEGIN + FAELngStr(62,MemFileArea,MCIVars1,FALSE); + IF (NOT Editing) THEN + FAELngStr(63,MemFileArea,MCIVars1,FALSE) + ELSE + FAELngStr(64,MemFileArea,MCIVars1,FALSE); + END; + END; + UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); + END; + + { + InsertFileArea External String Table + + 1. FILE_INSERT_MAX_FILE_AREAS + + %LF^7No more then %MA file areas can exist!^1 + %PA + + 2. FILE_INSERT_PROMPT + + %LFFile area to insert before? @ + + 3. FILE_INSERT_AFTER_ERROR_PROMPT + + %LFContinue inserting file area? @ + + 4. FILE_INSERT_CONFIRM_INSERT + + %LFIs this what you want? @ + + 5. FILE_INSERT_NOTICE + + %LF[> Inserting file area ... + + 6. FILE_INSERT_SYSOPLOG + + * Inserted file area: ^5%AN + } + + PROCEDURE InsertFileArea(TempMemFileArea1: FileAreaRecordType; MCIVars1: MCIVarRecord); + VAR + FileAreaScanFile: FILE OF Boolean; + Cmd1: Char; + RecNum, + RecNum1, + RecNumToInsertBefore: SmallInt; + Ok, + Changed: Boolean; + BEGIN + IF (NumFileAreas = MaxFileAreas) THEN + FAELngStr(22,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + RecNumToInsertBefore := -1; + InputIntegerWOC(FAELngStr(23,MemFileArea,MCIVars1,TRUE),RecNumToInsertBefore,[NumbersOnly],1,(NumFileAreas + 1)); + IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumFileAreas + 1)) THEN + BEGIN + Reset(FileAreaFile); + InitFileAreaVars(TempMemFileArea1); + IF (RecNumToInsertBefore = 1) THEN + MCIVars1.RecNumToEdit := 1 + ELSE IF (RecNumToInsertBefore = (NumFileAreas + 1)) THEN + MCIVars1.RecNumToEdit := (NumFileAreas + 1) + ELSE + MCIVars1.RecNumToEdit := RecNumToInsertBefore; + REPEAT + OK := TRUE; + EditFileArea(TempMemFileArea1,TempMemFileArea1,Cmd1,MCIVars1,Changed,FALSE); + CheckFileArea(TempMemFileArea1,MCIVars1,1,6,Ok); + IF (NOT OK) THEN + IF (NOT PYNQ(FAELngStr(24,MemFileArea,MCIVars1,TRUE),0,TRUE)) THEN + Abort := TRUE; + UNTIL (OK) OR (Abort) OR (HangUp); + IF (NOT Abort) AND (PYNQ(FAELngStr(25,MemFileArea,MCIVars1,TRUE),0,FALSE)) THEN + BEGIN + FAELngStr(26,MemFileArea,MCIVars1,FALSE); + Seek(FileAreaFile,FileSize(FileAreaFile)); + Write(FileAreaFile,MemFileArea); + Dec(RecNumToInsertBefore); + FOR RecNum := ((FileSize(FileAreaFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO + BEGIN + Seek(FileAreaFile,RecNum); + Read(FileAreaFile,MemFileArea); + Seek(FileAreaFile,(RecNum + 1)); + Write(FileAreaFile,MemFileArea); + END; + FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO + BEGIN + MakeDir(TempMemFileArea1.DLPath,FALSE); + MakeDir(TempMemFileArea1.ULPath,FALSE); + IF (NOT Exist(GetDirPath(TempMemFileArea1)+'.DIR')) THEN + BEGIN + Assign(FileInfoFile,GetDIRPath(TempMemFileArea1)+'.DIR'); + ReWrite(FileInfoFile); + Close(FileInfoFile); + END; + IF (NOT Exist(GetDirPath(TempMemFileArea1)+'.EXT')) THEN + BEGIN + Assign(ExtInfoFile,GetDIRPath(TempMemFileArea1)+'.EXT'); + ReWrite(ExtInfoFile,1); + Close(ExtInfoFile); + END; + IF (NOT Exist(GetDirPath(TempMemFileArea1)+'.SCN')) THEN + BEGIN + Assign(FileAreaScanFile,GetDIRPath(TempMemFileArea1)+'.SCN'); + ReWrite(FileAreaScanFile); + Close(FileAreaScanFile); + END; + IF (Exist(GetDirPath(TempMemFileArea1)+'.SCN')) THEN + BEGIN + Assign(FileAreaScanFile,GetDIRPath(TempMemFileArea1)+'.SCN'); + Reset(FileAreaScanFile); + NewScanFileArea := TRUE; + FOR RecNum1 := (FileSize(FileAreaScanFile) + 1) TO (MaxUsers - 1) DO + Write(FileAreaScanFile,NewScanFileArea); + Close(FileAreaScanFile); + END; + Seek(FileAreaFile,RecNum); + Write(FileAreaFile,TempMemFileArea1); + Inc(NumFileAreas); + SysOpLog(FAELngStr(27,TempMemFileArea1,MCIVars1,TRUE)); + END; + END; + Close(FileAreaFile); + LastError := IOResult; + END; + END; + END; + + { + ModifyFileArea External String Table + + 1. NO_FILE_AREAS + + %LF^7No file areas exist!^1 + %PA + + 2. FILE_MODIFY_PROMPT + + %LFFile area to modify? @ + + 3. FILE_MODIFY_SYSOPLOG + + * Modified file area: ^5%AN + } + + PROCEDURE ModifyFileArea(TempMemFileArea1: FileAreaRecordType; MCIVars1: MCIVarRecord); + VAR + FileAreaScanFile: FILE OF Boolean; + User: UserRecordType; + Cmd1: Char; + RecNum1, + SaveRecNumToEdit: Integer; + Ok, + Changed: Boolean; + BEGIN + IF (NumFileAreas = 0) THEN + FAELngStr(5,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + MCIVars1.RecNumToEdit := -1; + InputIntegerWOC(FAELngStr(28,MemFileArea,MCIVars1,TRUE),MCIVars1.RecNumToEdit,[NumbersOnly],1,NumFileAreas); + IF (MCIVars1.RecNumToEdit >= 1) AND (MCIVars1.RecNumToEdit <= NumFileAreas) THEN + BEGIN + SaveRecNumToEdit := -1; + Cmd1 := #0; + Reset(FileAreaFile); + WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO + BEGIN + IF (SaveRecNumToEdit <> MCIVars1.RecNumToEdit) THEN + BEGIN + Seek(FileAreaFile,(MCIVars1.RecNumToEdit - 1)); + Read(FileAreaFile,MemFileArea); + SaveRecNumToEdit := MCIVars1.RecNumToEdit; + Changed := FALSE; + END; + REPEAT + Ok := TRUE; + EditFileArea(TempMemFileArea1,MemFileArea,Cmd1,MCIVars1,Changed,TRUE); + CheckFileArea(MemFileArea,MCIVars1,1,6,Ok); + IF (NOT OK) THEN + BEGIN + PauseScr(FALSE); + IF (MCIVars1.RecNumToEdit <> SaveRecNumToEdit) THEN + MCIVars1.RecNumToEdit := SaveRecNumToEdit; + END; + UNTIL (OK) OR (HangUp); + MakeDir(MemFileArea.DLPath,FALSE); + MakeDir(MemFileArea.ULPath,FALSE); + IF (NOT Exist(GetDirPath(MemFileArea)+'.DIR')) THEN + BEGIN + Assign(FileInfoFile,GetDIRPath(MemFileArea)+'.DIR'); + ReWrite(FileInfoFile); + Close(FileInfoFile); + END; + IF (NOT Exist(GetDirPath(MemFileArea)+'.EXT')) THEN + BEGIN + Assign(ExtInfoFile,GetDIRPath(MemFileArea)+'.EXT'); + ReWrite(ExtInfoFile,1); + Close(ExtInfoFile); + END; + IF (NOT Exist(GetDirPath(MemFileArea)+'.SCN')) THEN + BEGIN + Assign(FileAreaScanFile,GetDIRPath(MemFileArea)+'.SCN'); + ReWrite(FileAreaScanFile); + Close(FileAreaScanFile); + END; + IF (Exist(GetDirPath(MemFileArea)+'.SCN')) THEN + BEGIN + Assign(FileAreaScanFile,GetDIRPath(MemFileArea)+'.SCN'); + Reset(FileAreaScanFile); + NewScanFileArea := TRUE; + Seek(FileAreaScanFile,FileSize(FileAreaScanFile)); + FOR RecNum1 := (FileSize(FileAreaScanFile) + 1) TO (MaxUsers - 1) DO + Write(FileAreaScanFile,NewScanFileArea); + Reset(UserFile); + FOR RecNum1 := 1 TO (MaxUsers - 1) DO + BEGIN + LoadURec(User,RecNum1); + IF (Deleted IN User.SFlags) THEN + BEGIN + Seek(FileAreaScanFile,(RecNum1 - 1)); + Write(FileAreaScanFile,NewScanFileArea); + END; + END; + Close(UserFile); + Close(FileAreaScanFile); + END; + IF (Changed) THEN + BEGIN + Seek(FileAreaFile,(SaveRecNumToEdit - 1)); + Write(FileAreaFile,MemFileArea); + Changed := FALSE; + SysOpLog(FAELngStr(29,MemFileArea,MCIVars1,TRUE)); + END; + END; + Close(FileAreaFile); + LastError := IOResult; + END; + END; + END; + + { + PositionFileArea External String Table + + 1. NO_FILE_AREAS + + %LF^7No file areas exist!^1 + %PA + + 2. FILE_POSITION_NO_AREAS + + %LF^7No file areas to position!^1 + %PA + + 3. FILE_POSITION_PROMPT + + %LFPosition which file area? @ + + 4. FILE_POSITION_NUMBERING + + %LFAccording to the current numbering system. + + 5. FILE_POSITION_BEFORE_WHICH + + %LFPosition before which file area?' + + 6. FILE_POSITION_NOTICE + + %LF[> Positioning file areas ... + } + + PROCEDURE PositionFileArea(TempMemFileArea1: FileAreaRecordType; MCIVars1: MCIVarRecord); + VAR + RecNumToPosition, + RecNumToPositionBefore, + RecNum1, + RecNum2: SmallInt; + BEGIN + IF (NumFileAreas = 0) THEN + FAELngStr(5,MemFileArea,MCIVars1,FALSE) + ELSE IF (NumFileAreas = 1) THEN + FAELngStr(30,MemFileArea,MCIVars1,FALSE) + ELSE + BEGIN + RecNumToPosition := -1; + InputIntegerWOC(FAELngStr(31,MemFileArea,MCIVars1,TRUE),RecNumToPosition,[NumbersOnly],1,NumFileAreas); + IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumFileAreas) THEN + BEGIN + RecNumToPositionBefore := -1; + FAELngStr(32,MemFileArea,MCIVars1,FALSE); + InputIntegerWOC(FAELngStr(33,MemFileArea,MCIVars1,TRUE),RecNumToPositionBefore,[Numbersonly],1,(NumFileAreas + 1)); + IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumFileAreas + 1)) AND + (RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN + BEGIN + FAELngStr(34,MemFileArea,MCIVars1,FALSE); + Reset(FileAreaFile); + IF (RecNumToPositionBefore > RecNumToPosition) THEN + Dec(RecNumToPositionBefore); + Dec(RecNumToPosition); + Dec(RecNumToPositionBefore); + Seek(FileAreaFile,RecNumToPosition); + Read(FileAreaFile,TempMemFileArea1); + RecNum1 := RecNumToPosition; + IF (RecNumToPosition > RecNumToPositionBefore) THEN + RecNum2 := -1 + ELSE + RecNum2 := 1; + WHILE (RecNum1 <> RecNumToPositionBefore) DO + BEGIN + IF ((RecNum1 + RecNum2) < FileSize(FileAreaFile)) THEN + BEGIN + Seek(FileAreaFile,(RecNum1 + RecNum2)); + Read(FileAreaFile,MemFileArea); + Seek(FileAreaFile,RecNum1); + Write(FileAreaFile,MemFileArea); + END; + Inc(RecNum1,RecNum2); + END; + Seek(FileAreaFile,RecNumToPositionBefore); + Write(FileAreaFile,TempMemFileArea1); + Close(FileAreaFile); + LastError := IOResult; + END; + END; + END; + END; + + { + ListFileAreas External String Table + + 1. FILE_AREA_HEADER_TOGGLE_ONE + + ^0#####^4:^3File area name ^4:^3Flags ^4:^3ACS ^4:^3UL ACS ^4:^3DL ACS ^4:^3MaxF + ^4=====:=========================:========:==========:==========:==========:===== + + 2. FILE_AREA_HEADER_TOGGLE_TWO + + ^0#####^4:^3File area name ^4:^3FileName^4:^3Download path ^4:^3Upload path + ^4=====:================:========:=======================:======================= + + 3. FILE_AREA_HEADER_NO_FILE_AREAS + + #7*** No file areas defined ***^1 + } + + PROCEDURE ListFileAreas(VAR RecNumToList1: Integer; MCIVars1: MCIVarRecord); + VAR + NumDone: Integer; + BEGIN + IF (RecNumToList1 < 1) OR (RecNumToList1 > NumFileAreas) THEN + RecNumToList1 := 1; + Abort := FALSE; + Next := FALSE; + CLS; + CASE DisplayType OF + 1 : FAELngStr(0,MemFileArea,MCIVars1,FALSE); + 2 : FAELngStr(1,MemFileArea,MCIVars1,FALSE); + END; + Reset(FileAreaFile); + NumDone := 0; + WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumFileAreas) + AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(FileAreaFile,(RecNumToList1 - 1)); + Read(FileAreaFile,MemFileArea); + WITH MemFileArea DO + CASE DisplayType OF + 1 : PrintACR('^0'+PadRightInt(RecNumToList1,5)+ + ' ^5'+PadLeftStr(AreaName,25)+ + ' ^3'+DisplayFAFlags(FAFlags,'5','4')+ + ' ^9'+PadLeftStr(AOnOff(ACS = '','*None*',ACS),10)+ + ' '+PadLeftStr(AOnOff(ULACS = '','*None*',ULACS),10)+ + ' '+PadLeftStr(AOnOff(DLACS = '','*None*',DLACS),10)+ + ' ^3'+PadRightInt(MaxFiles,5)); + 2 : PrintACR('^0'+PadRightInt(RecNumToList1,5)+ + ' ^5'+PadLeftStr(AreaName,16)+ + ' ^3'+PadLeftStr(FileName,8)+ + ' '+PadLeftStr(DLPath,23)+ + ' '+PadLeftStr(ULPath,23)); + END; + Inc(RecNumToList1); + Inc(NumDone); + END; + Close(FileAreaFile); + LastError := IOResult; + IF (NumFileAreas = 0) AND (NOT Abort) AND (NOT HangUp) THEN + FAELngStr(2,MemFileArea,MCIVars1,FALSE); + END; + + { + MainFileArea External String Table + + 1. FILE_AREA_EDITOR_PROMPT + + %LFFile area editor [^5?^4=^5Help^4]: + + 2. FILE_AREA_EDITOR_HELP + + %LF^1<^3CR^1>Next screen or redisplay current screen + ^1(^3C^1)hange file area storage drive + ^1(^3D^1)elete area ^1(^3I^1)nsert area + ^1(^3M^1)odify area ^1(^3P^1)osition area + ^1(^3Q^1)uit ^1(^3T^1)oggle display format + } + +BEGIN + SaveTempPause := TempPause; + TempPause := FALSE; + RecNumToList := 1; + Cmd := #0; + REPEAT + IF (Cmd <> '?') THEN + ListFileAreas(RecNumToList,MCIVars); + LOneK(FAELngStr(3,MemFileArea,MCIVars,TRUE),Cmd,'QCDIMPT?'^M,TRUE,TRUE); + CASE Cmd OF + ^M : IF (RecNumToList < 1) OR (RecNumToList > NumFileAreas) THEN + RecNumToList := 1; + 'C' : ChangeFileAreaDrive(MCIVars); + 'D' : DeleteFileArea(TempMemFileArea,MCIVars); + 'I' : InsertFileArea(TempMemFileArea,MCIVars); + 'M' : ModifyFileArea(TempMemFileArea,MCIVars); + 'P' : PositionFileArea(TempMemFileArea,MCIVars); + 'T' : DisplayType := ((DisplayType MOD 2) + 1); + '?' : FAELngStr(4,MemFileArea,MCIVars,FALSE); + END; + IF (Cmd <> ^M) THEN + RecNumToList := 1; + UNTIL (Cmd = 'Q') OR (HangUp); + TempPause := SaveTempPause; + NewCompTables; + IF ((FileArea < 1) OR (FileArea > NumFileAreas)) THEN + FileArea := 1; + ReadFileArea := -1; + LoadFileArea(FileArea); + LastError := IOResult; +END; + +END. diff --git a/SOURCE/TAGLINE.PAS b/SOURCE/TAGLINE.PAS new file mode 100644 index 0000000..baf4241 --- /dev/null +++ b/SOURCE/TAGLINE.PAS @@ -0,0 +1,105 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +PROGRAM TAGLINE; + +USES + Crt, + Dos; + +TYPE + StrPointerRec = RECORD + Pointer, + TextSize: LongInt; + END; + +VAR + RGStrFile: FILE; + StrPointerFile: FILE OF StrPointerRec; + F: Text; + StrPointer: StrPointerRec; + S: STRING; + RGStrNum, + Counter: Word; + +FUNCTION Exist(FN: STRING): Boolean; +VAR + DirInfo: SearchRec; +BEGIN + FindFirst(FN,AnyFile,DirInfo); + Exist := (DosError = 0); +END; + +BEGIN + CLrScr; + WriteLn('Renegade Tagline Compiler Version 1.1'); + Writeln('Copyright 2006-2009 - The Renegade Developement Team'); + WriteLn; + IF (NOT Exist('TAGLINE.TXT')) THEN + WriteLn(^G^G^G'TAGLINE.TXT file was not found!') + ELSE + BEGIN + Counter := 0; + Write('Checking maximum string length of 74 characters ... '); + Assign(F,'TAGLINE.TXT'); + Reset(F); + WHILE NOT EOF(F) DO + BEGIN + ReadLn(F,S); + IF (Length(S) > 74) THEN + BEGIN + WriteLn; + WriteLn; + WriteLn('This string is longer then 74 characters:'); + WriteLn; + Writeln(^G^G^G'-> '+S); + WriteLn; + WriteLn('Please reduce it''s length or delete from TAGLINE.TXT!'); + Halt; + END; + Inc(Counter); + END; + WriteLn('Done!'); + IF (Counter > 65535) THEN + BEGIN + WriteLn; + WriteLn; + WriteLn(^G^G^G'This file contains more then 65,535 lines'); + WriteLn; + Writeln('Please reduce the number of lines in TAGLINE.TXT!'); + WriteLn; + WriteLn('NOTE: Blank lines between Taglines are not required.'); + Writeln; + Halt; + END; + WriteLn; + Write('Compiling taglines ... '); + Assign(StrPointerFile,'TAGLINE.PTR'); + ReWrite(StrPointerFile); + Assign(RGStrFile,'TAGLINE.DAT'); + ReWrite(RGStrFile,1); + Reset(F); + WHILE NOT EOF(F) DO + BEGIN + ReadLn(F,S); + IF (S <> '') THEN + BEGIN + WITH StrPointer DO + BEGIN + Pointer := (FileSize(RGStrFile) + 1); + TextSize := 0; + END; + Seek(RGStrFile,FileSize(RGStrFile)); + Inc(StrPointer.TextSize,(Length(S) + 1)); + BlockWrite(RGStrFile,S,(Length(S) + 1)); + Seek(StrPointerFile,FileSize(StrPointerFile)); + Write(StrPointerFile,StrPointer); + END; + END; + Close(F); + Close(RGStrFile); + Close(StrPointerFile); + WriteLn('Done!') + END; +END. diff --git a/SOURCE/TIMEBANK.PAS b/SOURCE/TIMEBANK.PAS new file mode 100644 index 0000000..8643ecb --- /dev/null +++ b/SOURCE/TIMEBANK.PAS @@ -0,0 +1,215 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +UNIT TimeBank; + +INTERFACE + +PROCEDURE Deposit; +PROCEDURE WithDraw; + +IMPLEMENTATION + +USES + Common; + +(* +PROCEDURE TimeBank; +VAR + CmdStr: Str3; + Cmd: CHAR; + DepositTime, + MaxDepositTime: BYTE; + + FUNCTION MinStr(W: WORD): Str160; + BEGIN + MinStr := #3'3'+PadRightInt(W,3)+' minutes'; + END; + +BEGIN + { Display time bank statistics } + NewLine; + Print(#3'0 << Time Bank Information >>'); + NewLine; + Print('Time left on-line : '+MinStr(Trunc(TimeLeft / 60))); + Print('Time in time bank : '+MinStr(ThisUser.TimeBank)); + Print('Maximum allowed in bank: '+MinStr(Systat.MaxTimeInBank)); + NewLine; + Print('Time deposited today : '+MinStr(ThisUser.TbDeposit)); + Print('Maximum daily deposit : '+MinStr(Systat.TbMaxDeposit)); + Print('Time withdrawn today : '+MinStr(ThisUser.TbWithDraw)); + Print('Maximum daily withdraw : '+MinStr(Systat.TbMaxWithDraw)); + NewLine; + Print('Time bank options available:'); + { Determine options user has available } + CmdStr := 'Q'; + IF (Trunc(TimeLeft / 60) > 0) AND (ThisUser.TbDeposit < Systat.TbMaxDeposit) AND + (ThisUser.TimeBank < Systat.MaxTimeInBank) THEN + BEGIN + Print(' ('#3'3D'#3'1)eposit time into the bank'); + CmdStr := CmdStr + 'D'; + END; + IF (ThisUser.TimeBank > 0) AND (ThisUser.TbWithDraw < Systat.TbMaxWithDraw) THEN + BEGIN + Print(' ('#3'3W'#3'1)ithdraw time from the bank'); + CmdStr := CmdStr + 'W'; + END; + Print(' ('#3'3Q'#3'1)uit (exit time bank manager)'); + NewLine; + Prt('Time Bank: '); + OneKeyInput(Cmd,CmdStr); + CASE Cmd OF + 'D' : BEGIN + { Set default deposit to use } + DepositTime := 0; + { Make sure user is unable to deposit more then maximum minus what + was already deposited } + MaxDepositTime := (Systat.TbMaxDeposit - ThisUser.TbDeposit); + { Make sure user is unable to deposit more then they have } + IF (MaxDepositTime > Trunc(TimeLeft / 60)) THEN + MaxDepositTime := Trunc(TimeLeft / 60); + InputByteWoc('How many minutes do you wish to deposit',DepositTime,[],0,MaxDepositTime, + Length(IntToStr(MaxDepositTime)),TRUE); + IF (DepositTime >= 1) AND (DepositTime <= MaxDepositTime) THEN + BEGIN + { Increase what user deposited today } + Inc(ThisUser.TbDeposit,DepositTime); + { Increase what user has in bank } + Inc(ThisUser.TimeBank,DepositTime); + { Decrease user's time on-line } + Dec(ThisUser.AdjTime,DepositTime); + END; + END; + 'W' : BEGIN + { Set default withdraw to use } + DepositTime := 0; + { Make sure user is unable to withdraw more then maximum minus what + was already withdrawn } + MaxDepositTime := (Systat.TbMaxWithDraw - ThisUser.TbWithDraw); + { Make sure user is unable to withdraw more then they have } + IF (MaxDepositTime > ThisUser.TimeBank) THEN + MaxDepositTime := ThisUser.TimeBank; + InputByteWoc('How many minutes do you wish to withdraw',DepositTime,[],0,MaxDepositTime, + Length(IntToStr(MaxDepositTime)),TRUE); + IF (DepositTime >= 1) AND (DepositTime <= MaxDepositTime) THEN + BEGIN + { Increase what user withdrew today } + Inc(ThisUSer.TbWithDraw,DepositTime); + { Decrease what user has in bank } + Dec(ThisUser.TimeBank,DepositTime); + { Increase user's time on-line } + Inc(ThisUSer.AdjTime,DepositTime); + END; + END; + END; + IF (Cmd <> 'Q') THEN + BEGIN + { Display Time Bank Statistics } + NewLine; + TStr(255); + END; +END; +*) + +PROCEDURE Deposit; +CONST + Deposit: LongInt = 0; +BEGIN + NL; + IF ((ThisUser.TimeBank >= General.MaxDepositEver) AND (General.MaxDepositEver <> 0)) THEN + BEGIN + Print('Your time bank has reached the maximum limit allowed.'); + PauseScr(FALSE); + Exit; + END; + IF ((ThisUser.TimeBankAdd >= General.MaxDepositPerDay) AND (General.MaxDepositPerDay <> 0)) THEN + BEGIN + Print('You cannot deposit any more time today.'); + PauseScr(FALSE); + Exit; + END; + + Print('^5Time left online : ^3'+FormattedTime(NSL)); + Print('^5Time in time bank: ^3'+FormattedTime(ThisUser.TimeBank * 60)); + + IF (General.MaxDepositEver > 0) THEN + Print('^5Max account limit: ^3'+FormattedTime(General.MaxDepositEver * 60)); + + IF (General.MaxDepositPerDay > 0) THEN + Print('^5Max deposit/day : ^3'+FormattedTime(General.MaxDepositPerDay * 60)); + + IF (ThisUser.TimeBankAdd <> 0) THEN + Print('^5Deposited today : ^3'+FormattedTime(ThisUser.TimeBankAdd * 60)); + + InputLongIntWOC('%LFDeposit how many minutes',Deposit,[DisplayValue,NumbersOnly],0,32767); + + IF (Deposit > 0) THEN + BEGIN + NL; + IF ((Deposit * 60) > NSL) THEN + Print('^7You don''t have that much time left to deposit!') + ELSE IF ((Deposit + ThisUser.TimeBankAdd) > General.MaxDepositPerDay) AND (General.MaxDepositPerDay <> 0) THEN + Print('^7You can only add '+IntToStr(General.MaxDepositPerDay)+' minutes to your account per day!') + ELSE IF ((Deposit + ThisUser.TimeBank) > General.MaxDepositEver) AND (General.MaxDepositEver <> 0) THEN + Print('^7Your account deposit limit is '+IntToStr(General.MaxDepositEver)+' minutes!') + ELSE + BEGIN + Inc(ThisUser.TimeBankAdd,Deposit); + Inc(ThisUser.TimeBank,Deposit); + Dec(ThisUser.TLToday,Deposit); + SysOpLog('Timebank: Deposited '+IntToStr(Deposit)+' minutes.'); + END; + END; +END; + +PROCEDURE WithDraw; +CONST + Withdrawal: LongInt = 0; +BEGIN + NL; + IF (ChopTime <> 0) THEN + BEGIN + Print('You cannot withdraw any more time during this call.'); + PauseScr(FALSE); + Exit; + END; + IF (ThisUser.TimeBankWith >= General.MaxWithdrawalPerDay) AND (General.MaxWithDrawalPerDay > 0) THEN + BEGIN + Print('You cannot withdraw any more time today.'); + PauseScr(FALSE); + Exit; + END; + + Print('^5Time left online : ^3'+FormattedTime(NSL)); + Print('^5Time in time bank : ^3'+FormattedTime(ThisUser.TimeBank * 60)); + + IF (General.MaxWithdrawalPerDay > 0) THEN + Print('^5Max withdrawal/day: ^3'+FormattedTime(General.MaxWithdrawalPerDay * 60)); + + IF (ThisUser.TimeBankWith > 0) THEN + Print('^5Withdrawn today : ^3'+FormattedTime(ThisUser.TimeBankWith * 60)); + + InputLongIntWOC('%LFWithdraw how many minutes',WithDrawal,[DisplayValue,NumbersOnly],0,32767); + IF (Withdrawal > 0) THEN + BEGIN + NL; + IF (Withdrawal > ThisUser.TimeBank) THEN + Print('^7You don''t have that much time left in your account!') + ELSE IF ((Withdrawal + ThisUser.TimeBankWith) > General.MaxWithdrawalPerDay) AND (General.MaxWithdrawalPerDay > 0) THEN + Print('^7You cannot withdraw that amount of time.') + ELSE + BEGIN + Inc(ThisUser.TimeBankWith,Withdrawal); + Dec(ThisUser.TimeBank,Withdrawal); + Inc(ThisUser.TLToday,Withdrawal); + IF (TimeWarn) AND (NSL > 180) THEN + TimeWarn := FALSE; + SysOpLog('Timebank: Withdrew '+IntToStr(Withdrawal)+' minutes.'); + END; + END; +END; + +END. diff --git a/SOURCE/TIMEFUNC.PAS b/SOURCE/TIMEFUNC.PAS new file mode 100644 index 0000000..84e0bcd --- /dev/null +++ b/SOURCE/TIMEFUNC.PAS @@ -0,0 +1,393 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +UNIT TimeFunc; + +INTERFACE + +USES + Dos; + +CONST + MonthString: ARRAY [1..12] OF STRING[9] = ('January','February','March','April','May','June', + 'July','August','September','October','November','December'); + +TYPE + Str2 = STRING[2]; + Str5 = STRING[5]; + Str8 = STRING[8]; + Str10 = STRING[10]; + Str160 = STRING[160]; + +PROCEDURE ConvertAmPm(VAR Hour: Word; VAR AmPm: Str2); +FUNCTION ZeroPad(S: Str8): Str2; +PROCEDURE PackToDate(VAR DT: DateTime; L: LongInt); +FUNCTION DateToPack(VAR DT: DateTime): LongInt; +PROCEDURE GetDateTime(VAR DT: DateTime); +PROCEDURE GetYear(VAR Year: Word); +PROCEDURE GetDayOfWeek(VAR DOW: Byte); +FUNCTION GetPackDateTime: LongInt; +FUNCTION DoorToDate8(CONST SDate: Str10): Str8; +FUNCTION PD2Time24(CONST PD: LongInt): Str5; +FUNCTION ToDate8(CONST SDate: Str10): Str8; +FUNCTION PDT2Dat(VAR PDT: LongInt; CONST DOW: Byte): STRING; +FUNCTION PD2Date(CONST PD: LongInt): STR10; +FUNCTION Date2PD(CONST SDate: Str10): LongInt; +FUNCTION TimeStr: Str8; +FUNCTION DateStr: Str10; +FUNCTION CTim(L: LongInt): Str8; +FUNCTION Days(VAR Month,Year: Word): Word; +FUNCTION DayNum(DateStr: Str10): Word; +FUNCTION Dat: Str160; + +IMPLEMENTATION + +CONST + DayString: ARRAY [0..6] OF STRING[9] = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); + + SecondsPerYear: ARRAY [FALSE..TRUE] OF LongInt = (31536000,31622400); + + M31 = (86400 * 31); + M30 = (86400 * 30); + M28 = (86400 * 28); + + SecondsPerMonth: ARRAY [1..12] OF LongInt = (M31,M28,M31,M30,M31,M30,M31,M31,M30,M31,M30,M31); + +TYPE + Str11 = STRING[11]; + +(* Done - Lee Palmer 11/23/07 *) +FUNCTION IntToStr(L: LongInt): Str11; +VAR + S: Str11; +BEGIN + Str(L,S); + IntToStr := S; +END; + +(* Done - Lee Palmer 12/06/07 *) +FUNCTION StrToInt(S: Str11): LongInt; +VAR + I: Integer; + L: LongInt; +BEGIN + Val(S,L,I); + IF (I > 0) THEN + BEGIN + S[0] := Chr(I - 1); + Val(S,L,I) + END; + IF (S = '') THEN + StrToInt := 0 + ELSE + StrToInt := L; +END; + +(* Done - Lee Palmer 03/27/07 *) +FUNCTION ZeroPad(S: Str8): Str2; +BEGIN + IF (Length(s) > 2) THEN + s := Copy(s,(Length(s) - 1),2) + ELSE IF (Length(s) = 1) THEN + s := '0'+s; + ZeroPad := s; +END; + +(* Done - 10/25/07 - Lee Palmer *) +PROCEDURE ConvertAmPm(VAR Hour: Word; VAR AmPm: Str2); +BEGIN + IF (Hour < 12) THEN + AmPm := 'am' + ELSE + BEGIN + AmPm := 'pm'; + IF (Hour > 12) THEN + Dec(Hour,12); + END; + IF (Hour = 0) THEN + Hour := 12; +END; + +PROCEDURE February(VAR Year: Word); +BEGIN + IF ((Year MOD 4) = 0) THEN + SecondsPerMonth[2] := (86400 * 29) + ELSE + SecondsPerMonth[2] := (86400 * 28); +END; + +PROCEDURE PackToDate(VAR DT: DateTime; L: LongInt); +BEGIN + DT.Year := 1970; + WHILE (L < 0) DO + BEGIN + Dec(DT.Year); + Inc(L,SecondsPerYear[((DT.Year MOD 4) = 0)]); + END; + WHILE (L >= SecondsPerYear[((DT.Year MOD 4) = 0)]) DO + BEGIN + Dec(L,SecondsPerYear[((DT.Year MOD 4) = 0)]); + Inc(DT.Year); + END; + DT.Month := 1; + February(DT.Year); + WHILE (L >= SecondsPerMonth[DT.Month]) DO + BEGIN + Dec(L,SecondsPerMonth[DT.Month]); + Inc(DT.Month); + END; + DT.Day := (Word(L DIV 86400) + 1); + L := (L MOD 86400); + DT.Hour := Word(L DIV 3600); + L := (L MOD 3600); + DT.Min := Word(L DIV 60); + DT.Sec := Word(L MOD 60); +END; + +FUNCTION DateToPack(VAR DT: DateTime): LongInt; +VAR + Month, + Year: Word; + DTP: LongInt; +BEGIN + DTP := 0; + Inc(DTP,LongInt(DT.Day - 1) * 86400); + Inc(DTP,LongInt(DT.Hour) * 3600); + Inc(DTP,LongInt(DT.Min) * 60); + Inc(DTP,LongInt(DT.Sec)); + February(DT.Year); + FOR Month := 1 TO (DT.Month - 1) DO + Inc(DTP,SecondsPerMonth[Month]); + Year := DT.Year; + WHILE (Year <> 1970) DO + BEGIN + IF (DT.Year > 1970) THEN + BEGIN + Dec(Year); + Inc(DTP,SecondsPerYear[(Year MOD 4 = 0)]); + END + ELSE + BEGIN + Inc(Year); + Dec(DTP,SecondsPerYear[((Year - 1) MOD 4 = 0)]); + END; + END; + DateToPack := DTP; +END; + +PROCEDURE GetDateTime(VAR DT: DateTime); +VAR + DayOfWeek, + HundSec: Word; +BEGIN + GetDate(DT.Year,DT.Month,DT.Day,DayOfWeek); + GetTime(DT.Hour,DT.Min,DT.Sec,HundSec); +END; + +FUNCTION GetPackDateTime: LongInt; +VAR + DT: DateTime; +BEGIN + GetDateTime(DT); + GetPackDateTime := DateToPack(DT); +END; + +PROCEDURE GetYear(VAR Year: Word); +VAR + Month, + Day, + DayOfWeek: Word; +BEGIN + GetDate(Year,Month,Day,DayOfWeek); +END; + +PROCEDURE GetDayOfWeek(VAR DOW: Byte); +VAR + Year, + Month, + Day, + DayOfWeek: Word; +BEGIN + GetDate(Year,Month,Day,DayOfWeek); + DOW := DayOfWeek; +END; + +FUNCTION DoorToDate8(CONST SDate: Str10): Str8; +BEGIN + DoorToDate8 := Copy(SDate,1,2)+'/'+Copy(SDate,4,2)+'/'+Copy(SDate,9,2); +END; + +FUNCTION PD2Time24(CONST PD: LongInt): Str5; +VAR + DT: DateTime; +BEGIN + PackToDate(DT,PD); + PD2Time24 := ZeroPad(IntToStr(DT.Hour))+':'+ZeroPad(IntToStr(DT.Min)); +END; + +FUNCTION PD2Date(CONST PD: LongInt): Str10; +VAR + DT: DateTime; +BEGIN + PackToDate(DT,PD); + PD2Date := ZeroPad(IntToStr(DT.Month))+'-'+ZeroPad(IntToStr(DT.Day))+'-'+IntToStr(DT.Year); +END; + +FUNCTION Date2PD(CONST SDate: Str10): LongInt; +VAR + DT: DateTime; +BEGIN + FillChar(DT,SizeOf(DT),0); + DT.Sec := 1; + DT.Year := StrToInt(Copy(SDate,7,4)); + DT.Day := StrToInt(Copy(SDate,4,2)); + DT.Month := StrToInt(Copy(SDate,1,2)); + IF (DT.Year = 0) THEN + DT.Year := 1; + IF (DT.Month = 0) THEN + DT.Month := 1; + IF (DT.Day = 0) THEN + DT.Day := 1; + Date2PD := DateToPack(DT); +END; + +FUNCTION ToDate8(CONST SDate: Str10): Str8; +BEGIN + IF (Length(SDate) = 8) THEN + ToDate8 := SDate + ELSE + ToDate8 := Copy(SDate,1,6)+Copy(SDate,9,2); +END; + +(* Done - Lee Palmer 11/23/07 *) +FUNCTION PDT2Dat(VAR PDT: LongInt; CONST DOW: Byte): STRING; +(* Example Output: 12:00 am Fri Nov 23, 2007 *) +VAR + DT: DateTime; + AmPm: Str2; +BEGIN + PackToDate(DT,PDT); + ConvertAmPm(DT.Hour,AmPm); + PDT2Dat := IntToStr(DT.Hour)+ + ':'+ZeroPad(IntToStr(DT.Min))+ + ' '+AmPm+ + ' '+Copy(DayString[DOW],1,3)+ + ' '+Copy(MonthString[DT.Month],1,3)+ + ' '+IntToStr(DT.Day)+ + ', '+IntToStr(DT.Year); +END; + +FUNCTION TimeStr: Str8; +VAR + AmPm: Str2; + Hour, + Minute, + Second, + Sec100: Word; +BEGIN + GetTime(Hour,Minute,Second,Sec100); + ConvertAmPm(Hour,AmPm); + TimeStr := IntToStr(Hour)+':'+ZeroPad(IntToStr(Minute))+' '+AmPm; +END; + +FUNCTION DateStr: Str10; +VAR + Year, + Month, + Day, + DayOfWeek: Word; +BEGIN + GetDate(Year,Month,Day,DayOfWeek); + DateStr := ZeroPad(IntToStr(Month))+'-'+ZeroPad(IntToStr(Day))+'-'+IntToStr(Year); +END; + +FUNCTION CTim(L: LongInt): Str8; +VAR + Hour, + Minute, + Second: Str2; +BEGIN + Hour := ZeroPad(IntToStr(L DIV 3600)); + L := (L MOD 3600); + Minute := ZeroPad(IntToStr(L DIV 60)); + L := (L MOD 60); + Second := ZeroPad(IntToStr(L)); + CTim := Hour+':'+Minute+':'+Second; +END; + +(* Done - 10/25/07 - Lee Palmer *) +FUNCTION Days(VAR Month,Year: Word): Word; +VAR + TotalDayCount: Word; +BEGIN + TotalDayCount := StrToInt(Copy('312831303130313130313031',(1 + ((Month - 1) * 2)),2)); + IF ((Month = 2) AND (Year MOD 4 = 0)) THEN + Inc(TotalDayCount); + Days := TotalDaycount; +END; + +(* Done - 10/25/07 - Lee Palmer *) +FUNCTION DayNum(DateStr: Str10): Word; +(* Range 01/01/85 - 07/26/3061 = 0-65535 *) +VAR + Day, + Month, + Year, + YearCounter, + TotalDayCount: Word; + + FUNCTION DayCount(VAR Month1,Year1: Word): Word; + VAR + MonthCounter, + TotalDayCount1: Word; + BEGIN + TotalDayCount1 := 0; + FOR MonthCounter := 1 TO (Month1 - 1) DO + Inc(TotalDayCount1,Days(MonthCounter,Year1)); + DayCount := TotalDayCount1; + END; + +BEGIN + TotalDayCount := 0; + Month := StrToInt(Copy(DateStr,1,2)); + Day := StrToInt(Copy(DateStr,4,2)); + Year := StrToInt(Copy(DateStr,7,4)); + IF (Year < 1985) THEN + DayNum := 0 + ELSE + BEGIN + FOR YearCounter := 1985 TO (Year - 1) DO + IF (YearCounter MOD 4 = 0) THEN + Inc(TotalDayCount,366) + ELSE + Inc(TotalDayCount,365); + TotalDayCount := ((TotalDayCount + DayCount(Month,Year)) + (Day - 1)); + DayNum := TotalDayCount; + END; +END; + +(* Done - 10/25/07 - Lee Palmer *) +FUNCTION Dat: Str160; +VAR + DT: DateTime; + AmPm: Str2; + DayOfWeek, + Sec100: Word; +BEGIN + GetDate(DT.Year,DT.Month,DT.Day,DayOfWeek); + GetTime(DT.Hour,DT.Min,DT.Sec,Sec100); + ConvertAmPm(DT.Hour,AmPm); + Dat := IntToStr(DT.Hour)+ + ':'+ZeroPad(IntToStr(DT.Min))+ + ' '+AmPm+ + ' '+Copy(DayString[DayOfWeek],1,3)+ + ' '+Copy(MonthString[DT.Month],1,3)+ + ' '+IntToStr(DT.Day)+ + ', '+IntToStr(DT.Year); +END; + + +END. diff --git a/SOURCE/UPGRADE/BBSLEDT.ASC b/SOURCE/UPGRADE/BBSLEDT.ASC new file mode 100644 index 0000000..c4cae12 --- /dev/null +++ b/SOURCE/UPGRADE/BBSLEDT.ASC @@ -0,0 +1,4 @@ +%CL + |03旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 + �|17|15 Num |16|03�|17|15 BBS Name |11Last Edited |16|03� + 읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 diff --git a/SOURCE/UPGRADE/BBSLEH.ASC b/SOURCE/UPGRADE/BBSLEH.ASC new file mode 100644 index 0000000..c4cae12 --- /dev/null +++ b/SOURCE/UPGRADE/BBSLEH.ASC @@ -0,0 +1,4 @@ +%CL + |03旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 + �|17|15 Num |16|03�|17|15 BBS Name |11Last Edited |16|03� + 읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 diff --git a/SOURCE/UPGRADE/BBSLEM.ASC b/SOURCE/UPGRADE/BBSLEM.ASC new file mode 100644 index 0000000..c595c72 --- /dev/null +++ b/SOURCE/UPGRADE/BBSLEM.ASC @@ -0,0 +1,2 @@ + |12~RN |15~BN |16%LF + diff --git a/SOURCE/UPGRADE/BBSLIST.SCR b/SOURCE/UPGRADE/BBSLIST.SCR new file mode 100644 index 0000000..d724caa --- /dev/null +++ b/SOURCE/UPGRADE/BBSLIST.SCR @@ -0,0 +1,66 @@ +# +# This is an example of a bbslist template. +# +# Anything after a '#' is considered a comment and is ignored. +# Anything That doesn't begin with a [ is ignored. +# +# The ~ Codes in parenthases are MCIs to access the values +# (~BN) [BBSName]: BBS Name +# (~SN) [SysOpName]: Sysop Name +# (~MN) [MaxNodes]: Max Nodes +# (~BP) [Port]: Telnet Port +# (~TN) [TelnetUrl]: Telnet Url +# (~WS) [WebSiteUrl]: Website +# (~PN) [PhoneNumber]: BBS Phone Number +# (~LO) [Location]: Location of BBS +# (~SW) [Software]: BBS Software Used +# (~SV) [SoftwareVersion]: BBS Software Version +# (~OS) [OS]: Operating System of BBS +# (~SP) [Speed]: Speed of the BBS +# (~HR) [Hours]: Hours of Operation +# (~ST) [Birth]: When the bbs started +# (~DS) [Description]: Description +# (~D2) [Description2]: Description 2 +# (~SA) [SDA]: SysOp Definable String 8 +# (~SB) [SDB]: SysOp Definable String 30 +# (~SC) [SDC]: SysOp Definable String 30 +# (~SD) [SDD]: SysOp Definable String 40 +# (~SE) [SDE]: SysOp Definable String 60 +# (~SF) [SDF]: SysOp Definable String 60 +# (~SG) [SDG]: SysOp Definable Number +# (~SH) [SDH]: SysOp Definable Yes/No (Default Yes) +# (~SI) [SDI]: SysOp Definable Yes/No (Default No) +# !! Extra Display Codes !! +# (~AC) : Area Code +# (~DA) : Date Added +# (~DE) : Date Edited +# (~RN) : Record Number +# (~UN) : User who added record +# +# if you want to ask the questions in a certain order change the order. +# if you don't want to ask a question then leave it out. +# +# MCI and Pipe Color Codes are allowed in the question. +# +# Start BBS List Questions +# +[BBSName]:%DFAEBBS%%LF |03Enter the Name of BBS |15:|11 +[SysOpName]:%LF |03What is the Sysop of this BBS name? |15:|11 +[TelnetUrl]:%LF |03What is the Telnet Address of the BBS?%LF |15:|11 +[Port]:%LF |03What port can this BBS be reached at? |15:|08 +[WebSiteUrl]:%LF |03What is the web address of the BBS?%LF |15:|11 +[PhoneNumber]:%DFAEBBS%%LF |03BBS Phone Number |08(|07if any|08) |15:|11 +[Location]:%LF |03What is the location of this BBS? |15:|11 +[Software]:%LF |03What Software does this BBS use? |15:|11 +[SoftwareVersion]:%LF |03Software Version? |15:|11 +[OS]:%LF |03Operating System? |15:|11 +[MaxNodes]:%LF |03How Many Nodes? |15:|08 +[Speed]:%DFAEBBS%%LF |03What is the Speed of the BBS? |08(|072400, 56700, Telnet|08) |15:|11 +[Hours]:%LF |03What hours does this bbs run? |08(|0724/7 |08.. |076am-3pm|08) |15:|11 +[Birth]:%LF |03When did this bbs start? +[Description]:%LF |03Enter a small description of the BBS 60 Chars Max. 2 Lines%LF |15 : |11 +[Description2]: |15: |11 +#[SDG]:%LF |03Number Test? |15:|08 +#[SDH]:%LF |03BBS Is 24/7? |15:|11 +#[SDI]:%LF |03Private Nodes? |15:|11 + diff --git a/SOURCE/UPGRADE/FIXBBSL.PAS b/SOURCE/UPGRADE/FIXBBSL.PAS new file mode 100644 index 0000000..402be6d --- /dev/null +++ b/SOURCE/UPGRADE/FIXBBSL.PAS @@ -0,0 +1,217 @@ +Program FixBBSL; + +Uses + Dos, + Crt, + Common, + BBSList; + +Type + + UnixTime = Longint; + + OldBBSListRecordType = { *.BBS file records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + RecordNum : LongInt; { Number OF the Record For Edit } + UserID : LongInt; { User ID OF person adding this } + BBSName : STRING[30]; { Name OF BBS } + SysOpName : STRING[30]; { SysOp OF BBS } + TelnetUrl : STRING[60]; { Telnet Urls } + WebSiteUrl : STRING[60]; { Web Site Url } + PhoneNumber : STRING[20]; { Phone number OF BBS } + Software : STRING[8]; { Software used by BBS } + Speed : STRING[8]; { Highest connect speed OF BBS } + Description : STRING[60]; { Description OF BBS } + Description2 : STRING[60]; { Second line OF descrition } + DateAdded : UnixTime; { Date entry was added } + DateEdited : UnixTime; { Date entry was last edited } + XA : STRING[8]; { sysop definable A } + XB : STRING[30]; { sysop definable B } + XC : STRING[30]; { sysop definable C } + XD : STRING[40]; { sysop definable D } + XE : STRING[60]; { sysop definable E } + XF : STRING[60]; { sysop definable F } + END; + + NewBBSListRecordType = { New *.BBS file records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + RecordNum, { Number OF the Record For Edit } + UserID, { User ID OF person adding this } + MaxNodes : LongInt; { Maximum Number Of Nodes } + Port : Word; { Telnet Port } + BBSName : STRING[30]; { Name OF BBS } + SysOpName : STRING[30]; { SysOp OF BBS } + TelnetUrl : STRING[60]; { Telnet Urls } + WebSiteUrl : STRING[60]; { Web Site Url } + PhoneNumber : STRING[20]; { Phone number OF BBS } + Location : STRING[30]; { Location of BBS } + Software, { Software used by BBS } + SoftwareVersion : String[12]; { Software Version of BBS } + OS : STRING[20]; { Operating System of BBS } + Speed : STRING[8]; { Highest connect speed OF BBS } + Hours : STRING[20]; { Hours of Operation } + Birth : STRING[10]; { When The BBS Began } + Description : STRING[60]; { Description OF BBS } + Description2 : STRING[60]; { Second line OF descrition } + DateAdded : UnixTime; { Date entry was added } + DateEdited : UnixTime; { Date entry was last edited } + SDA : STRING[8]; { sysop definable A } + SDB : STRING[30]; { sysop definable B } + SDC : STRING[30]; { sysop definable C } + SDD : STRING[40]; { sysop definable D } + SDE : STRING[60]; { sysop definable E } + SDF : STRING[60]; { sysop definable F } + SDG : Word; { sysop definable G } + SDH, { sysop definable H } + SDI : Boolean; { sysop definable I } + END; + + +Var + + OldBBSFile : File Of OldBBSListRecordType; + OldBBSDat : OldBBSListRecordType; + + BBSFile : File Of NewBBSListRecordType; + BBSDat : NewBBSListRecordType; + + i : Integer; + + TempFile, + Dir, + BBSListDat : String; + + +Function GetDataFile : String; +Var + Old : String; +Begin + GetDir(0,BBSListDat); + BBSListDat := BBSListDat+'\DATA\BBSLIST.DAT'; + GetDir(0,Old); + Old := Old+'\DATA\BBSLIST.OLD'; + If Exist(Old) Then + Begin + WriteLn; + TextColor(12); + Write(' ', Old); + TextColor(4); + WriteLn(' exists. '); + TextColor(7); + WriteLn(' It seems you have already run this program. '); + TextColor(7); + WriteLn(' There is no need to run it again.'); + WriteLn; + Halt; + End + Else If Exist(BBSListDat) Then + Begin + GetDataFile := BBSListDat; + Exit; + End + Else + Begin + WriteLn; + TextColor(12); + Write(' ',BBSListDat); + TextColor(4); + WriteLn(' doesn''t exist'); + TextColor(7); + WriteLn(' Run this from inside your RENEGADE Home Dir.'); + WriteLn; + Halt; + End; +End; + +Begin { Main Program } + +BBSListDat := GetDataFile; { Get BBSLIST.DAT or Quit } + +TempFile := 'DATA\BBSTEMP.DAT'; + + Assign(OldBBSFile, BBSListDat); + Assign(BBSFile, TempFile); + Reset(OldBBSFile); + Rewrite(BBSFile); + Seek(OldBBSFile, 0); + Seek(BBSFile, 0); + WriteLn; + TextColor(3); + Write(' Converting Old BBS Records '); + +For i := 1 to FileSize(OldBBSFile) Do + Begin + Delay(200); + TextColor(11); + Write('.'); + Read(OldBBSFile, OldBBSDat); + + BBSDat.RecordNum := OldBBSDat.RecordNum; + BBSDat.UserID := OldBBSDat.UserID; + BBSDat.BBSName := OldBBSDat.BBSName; + BBSDat.SysOpName := OldBBSDat.SysOpName; + BBSDat.TelnetUrl := OldBBSDat.TelnetUrl; + BBSDat.WebSiteUrl := OldBBSDat.WebSiteUrl; + BBSDat.PhoneNumber := OldBBSDat.PhoneNumber; + BBSDat.Software := OldBBSDat.Software; + BBSDat.Speed := OldBBSDat.Speed; + BBSDat.Description := OldBBSDat.Description; + BBSDat.Description2 := OldBBSDat.Description2; + BBSDat.DateAdded := OldBBSDat.DateAdded; + BBSDat.DateEdited := OldBBSDat.DateEdited; + BBSDat.SDA := OldBBSDat.XA; + BBSDat.SDB := OldBBSDat.XB; + BBSDat.SDC := OldBBSDat.XC; + BBSDat.SDD := OldBBSDat.XD; + BBSDat.SDE := OldBBSDat.XE; + BBSDat.SDF := OldBBSDat.XF; + + Write(BBSFile, BBSDat); + + Seek(OldBBSFile, i); + Seek(BBSFile, i); + + End; +TextColor(3); +WriteLn(' Done!'); + +GetDir(0,Dir); + +WriteLn; +TextColor(3); +Write(' Copying '); +TextColor(11); +Write(Dir,'\DATA\BBSLIST.DAT '); +TextColor(3); +Write('to '); +TextColor(11); +Write(Dir,'\DATA\BBSLIST.OLD '); +TextColor(3); +Write('...'); + +Rename(OldBBSFile,Dir+'\DATA\BBSLIST.OLD'); + +TextColor(3); +WriteLn(' Done!'); + +TextColor(3); +Write(' Moving '); +TextColor(11); +Write(Dir,'\DATA\BBSTEMP.DAT '); +TextColor(3); +Write('to '); +TextColor(11); +Write(Dir,'\DATA\BBSLIST.DAT '); +TextColor(3); +Write('...'); + +Rename(BBSFile,Dir+'\DATA\BBSLIST.DAT'); + +TextColor(3); +WriteLn(' Done!'); +WriteLn; + +Close(OldBBSFile); +Close(BBSFile); + +End. diff --git a/SOURCE/VOTE.PAS b/SOURCE/VOTE.PAS new file mode 100644 index 0000000..42fbf02 --- /dev/null +++ b/SOURCE/VOTE.PAS @@ -0,0 +1,548 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Vote; + +INTERFACE + +USES + Common; + +FUNCTION GetTopics: Byte; +FUNCTION UnVotedTopics: Byte; +PROCEDURE ListTopics(UsePause: Boolean); +PROCEDURE VoteAll; +PROCEDURE VoteOne(TopicNum: Byte); +PROCEDURE Results(ListVoters: Boolean); +PROCEDURE TrackUser; +PROCEDURE AddTopic; + +IMPLEMENTATION + +USES + Common5, + MiscUser; + +VAR + AvailableTopics: ARRAY [1..25] OF Byte; + +FUNCTION GetTopics: Byte; +VAR + TopicNum, + NumTopics: Byte; +BEGIN + FillChar(AvailableTopics,SizeOf(AvailableTopics),0); + Abort := FALSE; + Next := FALSE; + NumTopics := 0; + Reset(VotingFile); + TopicNum := 1; + WHILE (TopicNum <= NumVotes) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(VotingFile,(TopicNum - 1)); + Read(VotingFile,Topic); + IF AACS(Topic.ACS) THEN + BEGIN + Inc(NumTopics); + AvailableTopics[NumTopics] := TopicNum; + END; + Inc(TopicNum); + END; + Close(VotingFile); + LastError := IOResult; + GetTopics := NumTopics; +END; + +FUNCTION UnVotedTopics: Byte; +VAR + TopicNum, + NumTopics: Byte; +BEGIN + Abort := FALSE; + Next := FALSE; + NumTopics := 0; + Reset(VotingFile); + TopicNum := 1; + WHILE (TopicNum <= NumVotes) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(VotingFile,(TopicNum - 1)); + Read(VotingFile,Topic); + IF AACS(Topic.ACS) AND (ThisUser.Vote[TopicNum] = 0) THEN + Inc(NumTopics); + Inc(TopicNum); + END; + Close(VotingFile); + LastError := IOResult; + UnVotedTopics := NumTopics; +END; + +PROCEDURE ListTopics(UsePause: Boolean); +VAR + TopicNum, + NumTopics: Byte; +BEGIN + NumTopics := GetTopics; + IF (NumTopics = 0) THEN + BEGIN + NL; + Print('There are no topics available.'); + PauseScr(FALSE); + Exit; + END; + Abort := FALSE; + Next := FALSE; + (* + CLS; + PrintACR('|03旼컴컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + PrintACR('�|11|17 Num |03|16�|11|17Votes|03|16�|11|17 Choice '+ + ' |03|16�'); + PrintACR('읕컴컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + *) + lRGLngStr(61,FALSE); + Reset(VotingFile); + TopicNum := 1; + WHILE (TopicNum <= NumTopics) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(VotingFile,(AvailableTopics[TopicNum] - 1)); + Read(VotingFile,Topic); + PrintACR('|07'+PadRightInt(TopicNum,5)+ + '|10'+PadRightInt(Topic.NumVotedQuestion,7)+ + '|14 '+Topic.Question1); + IF (Topic.Question2 <> '') THEN + PrintACR(PadRightStr('',12)+'|14 '+Topic.Question2); + WKey; + Inc(TopicNum); + END; + Close(VotingFile); + LastError := IOResult; + IF (UsePause) THEN + BEGIN + NL; + PauseScr(FALSE); + END; +END; + +PROCEDURE TopicResults(TopicNum: Byte; User: UserRecordType; ListVoters: Boolean); +VAR + ChoiceNum: Byte; + NumVoted, + UNum, + TempMaxUsers: Integer; +BEGIN + Reset(VotingFile); + Seek(VotingFile,(TopicNum - 1)); + Read(VotingFile,Topic); + Close(VotingFile); + Abort := FALSE; + Next := FALSE; + CLS; + PrintACR('^5Topic: ^3'+Topic.Question1); + IF (Topic.Question2 <> '') THEN + PrintACR('^5 : ^3'+Topic.Question2); + NL; + PrintACR('^5Created By: ^3'+Topic.CreatedBy); + NL; + (* + PrintACR('|03旼컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + PrintACR('�|11|17 N |03|16�|11|17 % |03|16'+ + '�|11|17 Choice |03|16�'); + PrintACR('읕컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�'); + *) + lRGLngStr(62,FALSE); + ChoiceNum := 1; + WHILE (ChoiceNum <= Topic.ChoiceNumber) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + PrintACR('^3'+PadRightInt(Topic.Answers[ChoiceNum].NumVotedAnswer,4)+ + CTP(Topic.Answers[ChoiceNum].NumVotedAnswer,Topic.NumVotedQuestion)+ + AOnOff(User.Vote[TopicNum] = ChoiceNum,' |12',' |10')+ + PadRightInt(ChoiceNum,2)+ + '.'+Topic.Answers[ChoiceNum].Answer1); + IF (Topic.Answers[ChoiceNum].Answer2 <> '') THEN + PrintACR(PadLeftStr('',14)+Topic.Answers[ChoiceNum].Answer2); + + IF (ListVoters) AND (Topic.Answers[ChoiceNum].NumVotedAnswer > 0) THEN + BEGIN + NumVoted := Topic.Answers[ChoiceNum].NumVotedAnswer; + Reset(UserFile); + TempMaxUsers := (MaxUsers - 1); + UNum := 1; + WHILE (UNum <= TempMaxUsers) AND (NumVoted > 0) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + LoadURec(User,UNum); + IF (User.Vote[TopicNum] = ChoiceNum) THEN + BEGIN + PrintACR(PadLeftStr('^1',14)+Caps(User.Name)+' #'+IntToStr(UNum)); + Dec(NumVoted); + END; + Inc(UNum); + END; + Close(UserFile); + END; + Inc(ChoiceNum); + END; + LastError := IOResult; + NL; + PauseScr(FALSE); +END; + +PROCEDURE GoVote(TopicNum: Byte); +VAR + InputStr: Str2; + ChoiceNum: Byte; +BEGIN + Reset(VotingFile); + Seek(VotingFile,(TopicNum - 1)); + Read(VotingFile,Topic); + Abort := FALSE; + Next := FALSE; + CLS; + Print('^5Renegade Voting:'); + NL; + PrintACR('^5Topic: ^3'+Topic.Question1); + IF (Topic.Question2 <> '') THEN + PrintACR('^5 : ^3'+Topic.Question2); + NL; + PrintACR('^5Created by: ^3'+Topic.CreatedBy); + NL; + ChoiceNum := 1; + WHILE (ChoiceNum <= Topic.ChoiceNumber) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + PrintACR('^3'+PadRightInt(ChoiceNum,3)+'.^9 '+Topic.Answers[ChoiceNum].Answer1); + IF (Topic.Answers[ChoiceNum].Answer2 <> '') THEN + PrintACR(' ^9'+Topic.Answers[ChoiceNum].Answer2); + Inc(ChoiceNum); + END; + Dec(ChoiceNum); + IF (AACS(Topic.AddAnswersACS)) AND (ChoiceNum < 25) THEN + BEGIN + Inc(ChoiceNum); + Print('^3'+PadRightInt(ChoiceNum,3)+'.^9 '); + END; + IF (ThisUser.Vote[TopicNum] >= 1) AND (ThisUser.Vote[TopicNum] <= Topic.ChoiceNumber) THEN + BEGIN + NL; + IF PYNQ('Change your vote? ',0,FALSE) THEN + BEGIN + Dec(Topic.Answers[ThisUser.Vote[TopicNum]].NumVotedAnswer); + Dec(Topic.NumVotedQuestion); + ThisUser.Vote[TopicNum] := 0; + Seek(VotingFile,(TopicNum - 1)); + Write(VotingFile,Topic); + END + ELSE + BEGIN + Close(VotingFile); + Exit; + END; + END; + NL; + Prt('Your choice: '); + MPL(Length(IntToStr(ChoiceNum))); + ScanInput(InputStr,'Q'^M); + ChoiceNum := StrToInt(InputStr); + IF (ChoiceNum = (Topic.ChoiceNumber + 1)) AND AACS(Topic.AddAnswersACS) AND (ChoiceNum <= 25) THEN + BEGIN + NL; + Prt('Choice '+IntToStr(ChoiceNum)+': '); + MPL(65); + InputWC(Topic.Answers[ChoiceNum].Answer1,65); + IF (Topic.Answers[ChoiceNum].Answer1 <> '') THEN + BEGIN + Prt(PadLeftStr('',7+Length(IntToStr(ChoiceNum)))+': '); + MPL(65); + InputWC(Topic.Answers[ChoiceNum].Answer2,65); + NL; + IF (NOT PYNQ('Add this choice? ',0,FALSE)) THEN + BEGIN + Topic.Answers[ChoiceNum].Answer1 := ''; + Topic.Answers[ChoiceNum].Answer2 := ''; + END + ELSE + BEGIN + Inc(Topic.ChoiceNumber); + Topic.Answers[ChoiceNum].NumVotedAnswer := 1; + Inc(Topic.NumVotedQuestion); + ThisUser.Vote[TopicNum] := ChoiceNum; + SL1('Added choice to '+Topic.Question1+':'); + SysOpLog(Topic.Answers[ChoiceNum].Answer1); + IF (Topic.Answers[ChoiceNum].Answer2 <> '') THEN + SysOpLog(Topic.Answers[ChoiceNum].Answer2); + END; + END; + END + ELSE IF (ChoiceNum >= 1) AND (ChoiceNum <= Topic.ChoiceNumber) THEN + BEGIN + Inc(Topic.Answers[ChoiceNum].NumVotedAnswer); + Inc(Topic.NumVotedQuestion); + ThisUser.Vote[TopicNum] := ChoiceNum; + END; + Seek(VotingFile,(TopicNum - 1)); + Write(VotingFile,Topic); + Close(VotingFile); + SaveURec(ThisUser,UserNum); + NL; + IF PYNQ('See results? ',0,TRUE) THEN + TopicResults(TopicNum,ThisUser,FALSE); + IF (InputStr = 'Q') THEN + Abort := TRUE; + LastError := IOResult; +END; + +PROCEDURE VoteAll; +VAR + TopicNum, + NumTopics: Byte; + Found: Boolean; +BEGIN + IF (RVoting IN ThisUser.Flags) THEN + BEGIN + NL; + Print('You are restricted from voting.'); + PauseScr(FALSE); + Exit; + END; + NumTopics := GetTopics; + IF (NumTopics = 0) THEN + BEGIN + NL; + Print('There are no topics available.'); + PauseScr(FALSE); + Exit; + END; + Abort := FALSE; + Next := FALSE; + Found := FALSE; + TopicNum := 1; + WHILE (TopicNum <= NumTopics) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (ThisUser.Vote[AvailableTopics[TopicNum]] = 0) THEN + BEGIN + GoVote(AvailableTopics[TopicNum]); + Found := TRUE; + END; + Inc(TopicNum); + END; + IF (NOT Found) THEN + BEGIN + NL; + Print('You have voted on all available topics.'); + PauseScr(FALSE); + END; +END; + +PROCEDURE VoteOne(TopicNum: Byte); +VAR + NumTopics: Byte; +BEGIN + IF (RVoting IN ThisUser.Flags) THEN + BEGIN + NL; + Print('You are restricted from voting.'); + PauseScr(FALSE); + Exit; + END; + NumTopics := GetTopics; + IF (NumTopics = 0) THEN + BEGIN + NL; + Print('There are no topics available.'); + PauseScr(FALSE); + Exit; + END; + IF (TopicNum < 1) AND (TopicNum > NumTopics) THEN + BEGIN + NL; + Print('The range must be from 1 to '+IntToStr(NumTopics)+'.'); + PauseScr(FALSE); + Exit; + END; + IF (ThisUser.Vote[AvailableTopics[TopicNum]] > 0) AND (NOT AACS(General.ChangeVote)) THEN + BEGIN + NL; + Print('You can only vote once on this topic.'); + PauseScr(FALSE); + Exit; + END; + GoVote(AvailableTopics[TopicNum]); +END; + +PROCEDURE Results(ListVoters: Boolean); +VAR + InputStr: Str2; + TopicNum, + NumTopics: Byte; +BEGIN + NumTopics := GetTopics; + IF (NumTopics = 0) THEN + BEGIN + NL; + Print('There are no topics available.'); + PauseScr(FALSE); + Exit; + END; + REPEAT + NL; + Prt('Results of which topic? (^51^4-^5'+IntToStr(NumTopics)+'^4) [^5?^4=^5List^4]: '); + MPL(Length(IntToStr(NumTopics))); + ScanInput(InputStr,^M'?'); + IF (InputStr = '?') THEN + ListTopics(FALSE); + UNTIL (InputStr <> '?') OR (HangUp); + IF (InputStr <> ^M) THEN + BEGIN + TopicNum := StrToInt(InputStr); + IF (TopicNum >= 1) AND (TopicNum <= NumTopics) THEN + TopicResults(AvailableTopics[TopicNum],ThisUser,ListVoters) + ELSE + BEGIN + NL; + Print('^1The range must be from 1 to '+IntToStr(NumTopics)+'.'); + PauseScr(FALSE); + END; + END; +END; + +PROCEDURE TrackUser; +VAR + User: UserRecordType; + NumTopics, + TopicNum: Byte; + Unum: Integer; + Found: Boolean; +BEGIN + NumTopics := GetTopics; + IF (NumTopics = 0) THEN + BEGIN + NL; + Print('There are no topics available.'); + PauseScr(FALSE); + Exit; + END; + NL; + Print('Track voting for which user (1-'+IntToStr(MaxUsers - 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); + IF (RVoting IN User.Flags) THEN + BEGIN + NL; + Print('^1This user is restricted from voting.'); + PauseScr(FALSE); + Exit; + END; + Abort := FALSE; + Next := FALSE; + Found := FALSE; + TopicNum := 1; + WHILE (TopicNum <= NumTopics) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (User.Vote[TopicNum] > 0) THEN + BEGIN + TopicResults(TopicNum,User,FALSE); + Found := TRUE; + END; + Inc(TopicNum); + END; + IF (NOT Found) THEN + BEGIN + NL; + Print('^1This user has not voted on any topics.'); + PauseScr(FALSE); + END; + END; +END; + +PROCEDURE AddTopic; +VAR + ChoiceNum: Byte; +BEGIN + IF (NumVotes = MaxVotes) THEN + BEGIN + NL; + Prt('No room for additional topics!'); + PauseScr(FALSE); + Exit; + END; + FillChar(Topic,SizeOf(Topic),'0'); + CLS; + Print('^3Voting addition:'); + NL; + Print('^9Now enter your topic. You have up to two lines for your topic.'); + Print('^9Press [Enter] on a blank line to leave blank or abort.'); + NL; + Prt('Topic: '); + MPL(SizeOf(Topic.Question1) - 1); + InputWC(Topic.Question1,SizeOf(Topic.Question1) - 1); + IF (Topic.Question1 <> '') THEN + BEGIN + Prt(PadLeftStr('',5)+': '); + MPL(SizeOf(Topic.Question2) - 1); + InputWC(Topic.Question2,SizeOf(Topic.Question2) - 1); + NL; + IF PYNQ('Are you sure? ',0,FALSE) THEN + BEGIN + Topic.CreatedBy := Caps(ThisUser.Name); + Topic.NumVotedQuestion := 0; + Topic.ACS := 'VV'; + NL; + IF PYNQ('Allow other users to add choices? ',0,FALSE) THEN + Topic.AddAnswersACS := Topic.ACS + ELSE + Topic.AddAnswersACS := General.AddChoice; + NL; + Print('^9Now enter the choices. You have up to two lines for each'); + Print('choice. Press [Enter] on a blank first choice line to end.'); + NL; + Topic.ChoiceNumber := 0; + Abort := FALSE; + Next := FALSE; + ChoiceNum := 0; + WHILE (ChoiceNum < 25) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Inc(ChoiceNum); + Prt('Choice '+PadRightInt(ChoiceNum,2)+': '); + MPL(SizeOf(Topic.Answers[ChoiceNum].Answer1) - 1); + InputWC(Topic.Answers[ChoiceNum].Answer1,SizeOf(Topic.Answers[ChoiceNum].Answer1) - 1); + IF (Topic.Answers[ChoiceNum].Answer1 = '') THEN + Abort := TRUE + ELSE + BEGIN + Inc(Topic.ChoiceNumber); + Prt(PadLeftStr('',9)+': '); + MPL(SizeOf(Topic.Answers[ChoiceNum].Answer2) - 1); + InputWC(Topic.Answers[ChoiceNum].Answer2,SizeOf(Topic.Answers[ChoiceNum].Answer2) - 1); + Topic.Answers[ChoiceNum].NumVotedAnswer := 0; + END; + END; + IF ((ChoiceNum > 1) OR (Topic.ChoiceNumber > 0)) THEN + BEGIN + NL; + IF (PYNQ('Add this topic? ',0,FALSE)) THEN + BEGIN + Reset(VotingFile); + Seek(VotingFile,FileSize(VotingFile)); + Write(VotingFile,Topic); + Close(VotingFile); + Inc(NumVotes); + SysOpLog('Added voting topic: '+Topic.Question1); + IF (Topic.Question2 <> '') THEN + SysOpLog(' : '+Topic.Question2); + END; + END; + END; + END; + LastError := IOResult; + NL; + PauseScr(FALSE); +END; + +END. diff --git a/SOURCE/WFCMENU.PAS b/SOURCE/WFCMENU.PAS new file mode 100644 index 0000000..8feebab --- /dev/null +++ b/SOURCE/WFCMENU.PAS @@ -0,0 +1,1364 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT WFCMenu; + +INTERFACE + +PROCEDURE WFCMDefine; +PROCEDURE WFCMenus; + +IMPLEMENTATION + +USES + Crt, + Dos, + Boot, + Bulletin, + Common, + CUser, + Doors, + EMail, + Events, + File7, + File10, + File13, + Mail1, + Mail2, + Mail3, + Maint, + Menus2, + MsgPack, + MultNode, + MyIO, + SysOp1, + SysOp2, + SysOp3, + SysOp4, + SysOp5, + SysOp6, + SysOp7, + SysOp8, + SysOp9, + SysOp10, + SysOp11, + SysOp12, + TimeFunc, + MiscUser +{$IFDEF WIN32} + ,Windows +{$ENDIF} + ; + +VAR + LastKeyPress: LongInt; + +CONST + ANSWER_LENGTH = 203; + ANSWER: ARRAY [1..203] OF Char = ( + #0 ,#17,#25,#23,#14,'R','e','n','e','g','a','d','e',' ','i','s',' ', + 'a','n','s','w','e','r','i','n','g',' ','t','h','e',' ','p','h','o', + 'n','e','.',#25,#19,#24,#25,'K',#24,' ',' ',#15,'[',#14,'A',#15,']', + ' ',' ','3','0','0',#25,#3 ,'[',#14,'C',#15,']',' ','2','4','0','0', + #25,#3 ,'[',#14,'E',#15,']',' ','7','2','0','0',#25,#3 ,'[',#14,'G', + #15,']',' ','1','2','0','0','0',#25,#3 ,'[',#14,'I',#15,']',' ','1', + '6','8','0','0',#25,#3 ,'[',#14,'K',#15,']',' ','3','8','4','0','0', + #25,#2 ,#24,' ',' ','[',#14,'B',#15,']',' ','1','2','0','0',#25,#3 , + '[',#14,'D',#15,']',' ','4','8','0','0',#25,#3 ,'[',#14,'F',#15,']', + ' ','9','6','0','0',#25,#3 ,'[',#14,'H',#15,']',' ','1','4','4','0', + '0',#25,#3 ,'[',#14,'J',#15,']',' ','1','9','2','0','0',#25,#3 ,'[', + #14,'L',#15,']',' ','5','7','6','0','0',#25,#2 ,#24,#25,'K',#24); + + WFCNET_LENGTH = 98; + WFCNET: ARRAY [1..98] OF Char = ( + #0 ,#17,#25,'K',#24,#25,#26,#15,'R','e','n','e','g','a','d','e',' ', + 'N','e','t','w','o','r','k',' ','N','o','d','e',#25,#27,#24,#25,'K', + #24,#25,#9 ,'P','r','e','s','s',' ','[','S','P','A','C','E','B','A', + 'R',']',' ','t','o',' ','l','o','g','i','n','.',' ',' ','P','r','e', + 's','s',' ','[','Q',']',' ','t','o',' ','q','u','i','t',' ','R','e', + 'n','e','g','a','d','e','.',#25,#10,#24,#25,'K',#24); + + WFC_LENGTH = 1153; + WFC : ARRAY [1..1153] OF Char = ( + #15,#17,#25,#22,'T','h','e',' ','R','e','n','e','g','a','d','e',' ', + 'B','u','l','l','e','t','i','n',' ','B','o','a','r','d',' ','S','y', + 's','t','e','m',#25,#22,#24,' ', #0,'�',#26,#16,'�', #9,'�',' ', #0, + '�',#26,#16,'�', #9,'�',' ', #0,'�',#26,#16,'�', #9,'�',' ', #0,'�', + #26,#15,'�', #9,'�',' ',#24,' ', #0,'�',' ',' ',#10,'T','o','d','a', + 'y',#39,'s',' ','S','t','a','t','s',' ',' ', #9,'�',' ', #0,'�',' ', + #10,'S','y','s','t','e','m',' ','A','v','e','r','a','g','e','s',' ', + #9,'�',' ', #0,'�',' ',' ',#10,'S','y','s','t','e','m',' ','T','o', + 't','a','l','s',' ',' ', #9,'�',' ', #0,'�',#25, #2,#10,'O','t','h', + 'e','r',' ','I','n','f','o',#25, #2, #9,'�',' ',#24,' ', #0,'�',' ', + #15,'C','a','l','l','s',#25,#10, #9,'�',' ', #0,'�',' ',#15,'C','a', + 'l','l','s',#25,#10, #9,'�',' ', #0,'�',' ',#15,'C','a','l','l','s', + #25,#10, #9,'�',' ', #0,'�',' ',#15,'N','o','d','e',#25,#10, #9,'�', + ' ',#24,' ', #0,'�',' ',#15,'P','o','s','t','s',#25,#10, #9,'�',' ', + #0,'�',' ',#15,'P','o','s','t','s',#25,#10, #9,'�',' ', #0,'�',' ', + #15,'P','o','s','t','s',#25,#10, #9,'�',' ', #0,'�',' ',#15,'U','n', + 'd','e','r',#25, #9, #9,'�',' ',#24,' ', #0,'�',' ',#15,'E','m','a', + 'i','l',#25,#10, #9,'�',' ', #0,'�',' ',#15,'#',' ','U','L',#25,#11, + #9,'�',' ', #0,'�',' ',#15,'#',' ','U','L',#25,#11, #9,'�',' ', #0, + '�',' ',#15,'E','r','r','o','r','s',#25, #8, #9,'�',' ',#24,' ', #0, + '�',' ',#15,'N','e','w','u','s','e','r','s',#25, #7, #9,'�',' ', #0, + '�',' ',#15,'#',' ','D','L',#25,#11, #9,'�',' ', #0,'�',' ',#15,'#', + ' ','D','L',#25,#11, #9,'�',' ', #0,'�',' ',#15,'M','a','i','l',#25, + #10, #9,'�',' ',#24,' ', #0,'�',' ',#15,'F','e','e','d','b','a','c', + 'k',#25, #7, #9,'�',' ', #0,'�',' ',#15,'A','c','t','i','v','i','t', + 'y',#25, #7, #9,'�',' ', #0,'�',' ',#15,'D','a','y','s',#25,#11, #9, + '�',' ', #0,'�',' ',#15,'U','s','e','r','s',#25, #9, #9,'�',' ',#24, + ' ', #0,'�',' ',#15,'#',' ','U','L',#25,#11, #9,'�',' ', #0,'�', #9, + #26,#16,'�','�',' ', #0,'�', #9,#26,#16,'�','�',' ', #0,'�', #9,#26, + #15,'�','�',' ',#24,' ', #0,'�',' ',#15,'K','b',' ','U','L',#25,#10, + #9,'�',' ', #0,'�',#26,#23,'�',' ',#15,'M','o','d','e','m',' ', #0, + #26,#24,'�', #9,'�',' ',#24,' ', #0,'�',' ',#15,'#',' ','D','L',#25, + #11, #9,'�',' ', #0,'�',#16,#25,'7', #9,#17,'�',' ',#24,' ', #0,'�', + ' ',#15,'K','b',' ','D','L',#25,#10, #9,'�',' ', #0,'�',#16,#25,'7', + #9,#17,'�',' ',#24,' ', #0,'�',' ',#15,'M','i','n','u','t','e','s', + #25, #8, #9,'�',' ', #0,'�',#16,#25,'7', #9,#17,'�',' ',#24,' ', #0, + '�',' ',#15,'O','v','e','r','l','a','y','s',#25, #7, #9,'�',' ', #0, + '�',#16,#25,'7', #9,#17,'�',' ',#24,' ', #0,'�',' ',#15,'F','r','e', + 'e',' ',' ',' ',' ',' ',#25, #6, #9,'�',' ', #0,'�',#16,#25,'7', #9, + #17,'�',' ',#24,' ', #0,'�', #9,#26,#16,'�','�',' ', #0,'�', #9,#26, + '7','�','�',' ',#24,#25,'O',#24,' ', #0,'�',#26,'K','�', #9,'�',' ', + #24,' ', #0,'�',' ',#15,'[',#14,'S',#15,']','y','s','t','e','m',' ', + 'C','o','n','f','i','g',' ','[',#14,'F',#15,']','i','l','e',' ','B', + 'a','s','e',#25, #3,'[',#14,'C',#15,']','a','l','l','e','r','s',#25, + #3,'[',#14,'I',#15,']','n','i','t',' ','M','o','d','e','m',#25, #3, + '[',#14,'!',#15,']','V','a','l','i','d','a','t','e',#25, #3, #9,'�', + ' ',#24,' ', #0,'�',' ',#15,'[',#14,'U',#15,']','s','e','r',' ','E', + 'd','i','t','o','r',#25, #2,'[',#14,'B',#15,']','M','s','g',' ','B', + 'a','s','e',#25, #3,'[',#14,'P',#15,']','a','c','k',' ','M','s','g', + 's',' ',' ','[',#14,'O',#15,']','f','f','h','o','o','k',' ','M','o', + 'd','e','m',' ','[',#14,'L',#15,']','o','g','s',#25, #8, #9,'�',' ', + #24,' ', #0,'�',' ',#15,'[',#14,'#',#15,']','M','e','n','u',' ','E', + 'd','i','t','o','r',' ',' ','[',#14,'X',#15,']','f','e','r',' ','P', + 'r','o','t','s',#25, #2,'[',#14,'M',#15,']','a','i','l',' ','R','e', + 'a','d',' ',' ','[',#14,'A',#15,']','n','s','w','e','r',' ','M','o', + 'd','e','m',' ',' ','[',#14,'Z',#15,']','H','i','s','t','o','r','y', + #25, #4, #9,'�',' ',#24,' ', #0,'�',' ',#15,'[',#14,'E',#15,']','v', + 'e','n','t',' ','E','d','i','t','o','r',' ',' ','[',#14,'W',#15,']', + 'r','i','t','e',' ','M','a','i','l',#25, #2,'[',#14,'R',#15,']','e', + 'a','d',' ','M','a','i','l',' ',' ','[',#14,'H',#15,']','a','n','g', + 'u','p',' ','M','o','d','e','m',' ',' ','[',#14,'D',#15,']','r','o', + 'p',' ','t','o',' ','D','O','S',' ',' ', #9,'�',' ',#24,' ', #0,'�', + ' ',#15,'[',#14,'V',#15,']','o','t','i','n','g',' ','E','d','i','t', + 'o','r',' ','[',#14,'$',#15,']','C','o','n','f','e','r','e','n','c', + 'e','s',' ','[',' ',']',' ','L','o','g',' ','O','n',#25, #2,'[',#14, + 'N',#15,']','o','d','e',' ','l','i','s','t','i','n','g',' ',' ','[', + #14,'Q',#15,']','u','i','t',' ','t','o',' ','D','O','S',' ',' ', #9, + '�',' ',#24,' ', #0,'�', #9,#26,'K','�','�',' ',#24,#24); + + + WFC0_LENGTH = 488; + WFC0: ARRAY [1..488] OF Char = ( + #14,#16,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24,#24, + #24,#24,#17,' ', #0,'�',#26,'K','�', #9,'�',' ',#24,' ', #0,'�',' ', + #15,'[',#14,'S',#15,']','y','s','t','e','m',' ','C','o','n','f','i', + 'g',' ','[',#14,'F',#15,']','i','l','e',' ','B','a','s','e',#25, #3, + '[',#14,'C',#15,']','a','l','l','e','r','s',#25, #3,'[',#14,'I',#15, + ']','n','i','t',' ','M','o','d','e','m',#25, #3,'[',#14,'!',#15,']', + 'V','a','l','i','d','a','t','e',#25, #3, #9,'�',' ',#24,' ', #0,'�', + ' ',#15,'[',#14,'J',#15,']','u','m','p',' ','t','o',' ','D','O','S', + #25, #2,'[',#14,'B',#15,']','M','s','g',' ','B','a','s','e',#25, #3, + '[',#14,'P',#15,']','a','c','k',' ','M','s','g','s',' ',' ','[',#14, + 'O',#15,']','f','f','h','o','o','k',' ','M','o','d','e','m',' ','[', + #14,'L',#15,']','o','g','s',#25, #8, #9,'�',' ',#24,' ', #0,'�',' ', + #15,'[',#14,'#',#15,']','M','e','n','u',' ','E','d','i','t','o','r', + ' ',' ','[',#14,'X',#15,']','f','e','r',' ','P','r','o','t','s',#25, + #2,'[',#14,'M',#15,']','a','i','l',' ','R','e','a','d',' ',' ','[', + #14,'A',#15,']','n','s','w','e','r',' ','M','o','d','e','m',' ',' ', + '[',#14,'Z',#15,']','H','i','s','t','o','r','y',#25, #4, #9,'�',' ', + #24,' ', #0,'�',' ',#15,'[',#14,'E',#15,']','v','e','n','t',' ','E', + 'd','i','t','o','r',' ',' ','[',#14,'W',#15,']','r','i','t','e',' ', + 'M','a','i','l',#25, #2,'[',#14,'R',#15,']','e','a','d',' ','M','a', + 'i','l',' ',' ','[',#14,'H',#15,']','a','n','g','u','p',' ','M','o', + 'd','e','m',' ',' ','[',#14,'U',#15,']','s','e','r',' ','E','d','i', + 't','o','r',' ',' ', #9,'�',' ',#24,' ', #0,'�',' ',#15,'[',#14,'V', + #15,']','o','t','i','n','g',' ','E','d','i','t','o','r',' ','[',#14, + '$',#15,']','C','o','n','f','e','r','e','n','c','e','s',' ','[',#14, + 'D',#15,']','i','s','p','l','a','y',' ','N','S',' ','[',#14,'N',#15, + ']','o','d','e',' ','l','i','s','t','i','n','g',' ',' ','[',#14,'Q', + #15,']','u','i','t',' ','t','o',' ','D','O','S',' ',' ', #9,'�',' ', + #24,' ', #0,'�', #9,#26,'K','�','�',' ',#24,#24); + +PROCEDURE WFCMDefine; +BEGIN + UploadsToday := 0; + DownloadsToday := 0; + UploadKBytesToday := 0; + DownloadKBytesToday := 0; + PrivatePostsToday := 0; + PublicPostsToday := 0; + FeedbackPostsToday := 0; + ChatAttempts := 0; + ShutUpChatCall := FALSE; + ContList := FALSE; + BadDLPath := FALSE; + TellUserEvent := 0; + TimeWarn := FALSE; + FastLogon := FALSE; + FileArea := 1; + MsgArea := 1; + ReadFileArea := -1; + ReadMsgArea := -1; + InWFCMenu := TRUE; + Reading_A_Msg := FALSE; + OutCom := FALSE; + UserOn := FALSE; + LastLineStr := ''; + ChatReason := ''; + Buf := ''; + HangUp := FALSE; + ChatCall := FALSE; + HungUp := FALSE; + TimedOut := FALSE; + Rate := 3840; + ANSIDetected := FALSE; + TextAttr := 7; + ClrScr; + UserNum := 0; + IF ((MaxUsers - 1) >= 1) THEN + BEGIN + LoadURec(ThisUser,1); + TempPause := (Pause IN ThisUser.Flags); + Reset(SchemeFile); + IF (ThisUser.ColorScheme > 0) AND (ThisUser.ColorScheme <= FileSize(SchemeFile)) THEN + Seek(SchemeFile,(ThisUser.ColorScheme - 1)); + Read(SchemeFile,Scheme); + Close(SchemeFile); + NewCompTables; + UserNum := 1; + END + ELSE + WITH ThisUser DO + BEGIN + LineLen := 80; + PageLen := 24; + Flags := [HotKey,Pause,Novice,ANSI,Color]; + Exclude(Flags,Avatar); + Reset(SchemeFile); + Read(SchemeFile,Scheme); + Close(SchemeFile); + END; +END; + +PROCEDURE GetConnection; +VAR + s: AStr; + C: Char; + Done: Boolean; + rl, + SaveTimer: LongInt; + + PROCEDURE GetResultCode(CONST ResultCode: AStr); + VAR + MaxCodes: Byte; + BEGIN + MaxCodes := MaxResultCodes; { NOTE! Done backwards to avoid CONNECT 1200 / CONNECT 12000 confusion!! } + Reliable := (Pos(Liner.Reliable,ResultCode) > 0); + WITH Liner DO + REPEAT + IF (Connect[MaxCodes] <> '') AND (Pos(Connect[MaxCodes],ResultCode) > 0) THEN + BEGIN + CASE MaxCodes OF + 1 : ActualSpeed := 300; + 2 : ActualSpeed := 600; + 3 : ActualSpeed := 1200; + 4 : ActualSpeed := 2400; + 5 : ActualSpeed := 4800; + 6 : ActualSpeed := 7200; + 7 : ActualSpeed := 9600; + 8 : ActualSpeed := 12000; + 9 : ActualSpeed := 14400; + 10 : ActualSpeed := 16800; + 11 : ActualSpeed := 19200; + 12 : ActualSpeed := 21600; + 13 : ActualSpeed := 24000; + 14 : ActualSpeed := 26400; + 15 : ActualSpeed := 28800; + 16 : ActualSpeed := 31200; + 17 : ActualSpeed := 33600; + 18 : ActualSpeed := 38400; + 19 : ActualSpeed := 57600; + 20 : ActualSpeed := 115200; + END; + Done := TRUE; + END + ELSE + Dec(MaxCodes); + UNTIL (Done) OR (MaxCodes = 1); + END; + +BEGIN + IF (AnswerBaud > 0) THEN + BEGIN + ActualSpeed := AnswerBaud; + IF (LockedPort IN Liner.MFlags) THEN + ComPortSpeed := Liner.InitBaud + ELSE + ComPortSpeed := ActualSpeed; + AnswerBaud := 0; + InCom := TRUE; + Exit; + END; + + Reliable := FALSE; { Could've been set in boot - don't move } + + Com_Flush_Recv; + IF (Liner.Answer <> '') THEN + Com_Send_Str(Liner.Answer); + + IF (SysOpOn) THEN +{$IFDEF MSDOS} + Update_Logo(ANSWER,ScreenAddr[(3*2)+(19*160)-162],ANSWER_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(ANSWER, 3, 19, ANSWER_LENGTH); +{$ENDIF} + + rl := 0; + SaveTimer := Timer; + + s := ''; + + REPEAT + Done := FALSE; + + IF (KeyPressed) THEN + BEGIN + + C := UpCase(ReadKey); + + IF (C = ^[) THEN + BEGIN + DTR(FALSE); + Done := TRUE; + Com_Send_Str(Liner.HangUp); + Delay(100); + DTR(TRUE); + Com_Flush_Recv; + END; + + CASE C OF + 'A' : ActualSpeed := 300; + 'B' : ActualSpeed := 1200; + 'C' : ActualSpeed := 2400; + 'D' : ActualSpeed := 4800; + 'E' : ActualSpeed := 7200; + 'F' : ActualSpeed := 9600; + 'G' : ActualSpeed := 12000; + 'H' : ActualSpeed := 14400; + 'I' : ActualSpeed := 16800; + 'J' : ActualSpeed := 19200; + 'K' : ActualSpeed := 38400; + 'L': ActualSpeed := 57600; + END; + Done := TRUE; + END; + + C := CInKey; + IF (rl <> 0) AND (ABS(rl - Timer) > 2) AND (C = #0) THEN + C := ^M; + IF (C > #0) THEN + BEGIN + WriteWFC(C); + IF (C <> ^M) THEN + BEGIN + IF (Length(s) >= 160) THEN + Delete(s,1,120); + s := s + C; + rl := Timer; + END + ELSE + BEGIN + IF (Pos(Liner.NoCarrier,s) > 0) THEN + Done := TRUE; + IF (Pos(Liner.CallerID,s) > 0) THEN + CallerIDNumber := Copy(s,Pos(Liner.CallerID,s) + Length(Liner.CallerID),40); + GetResultCode(s); + rl := 0; + END; + END; + IF (C = ^M) THEN + s := ''; + IF (ABS(Timer - SaveTimer) > 45) THEN + Done := TRUE; + UNTIL (Done); + + + Com_Flush_Recv; + + IF (ABS(Timer - SaveTimer) > 45) THEN + C := 'X'; + + InCom := (ActualSpeed <> 0); + + IF (InCom) AND (LockedPort IN Liner.MFlags) THEN + ComPortSpeed := Liner.InitBaud + ELSE + ComPortSpeed := ActualSpeed; + +END; + +PROCEDURE WFCDraw; +VAR + HistoryFile: FILE OF HistoryRecordType; + History: HistoryRecordType; + s: STRING[10]; + L: LongInt; +BEGIN + Window(1,1,MaxDisplayCols,MaxDisplayRows); + LastWFCX := 1; + LastWFCY := 1; + CursorOn(FALSE); + ClrScr; + IF (AnswerBaud > 0) THEN + Exit; + + IF (NOT BlankMenuNow) AND (SysOpOn) THEN + BEGIN + + IF (SysOpOn) THEN + BEGIN + +{$IFDEF MSDOS} + Update_Logo(WFC,ScreenAddr[0],WFC_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(WFC, 1, 1, WFC_LENGTH); +{$ENDIF} + IF (General.NetworkMode) THEN +{$IFDEF MSDOS} + Update_Logo(WFCNET,ScreenAddr[(3*2)+(19*160)-162],WFCNET_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(WFCNET, 3, 19, WFCNET_LENGTH); +{$ENDIF} + + LoadURec(ThisUser,1); + + TextAttr := 31; + GoToXY(4,1); + Write(PadRightStr(TimeStr,8)); + GoToXY(68,1); + Write(DateStr); + + Assign(HistoryFile,General.DataPath+'HISTORY.DAT'); + IF (NOT Exist(General.DataPath+'HISTORY.DAT')) THEN + BEGIN + ReWrite(HistoryFile); + WITH History DO + BEGIN + Date := Date2PD(DateStr); + Active := 0; + Callers := 0; + NewUsers := 0; + Posts := 0; + EMail := 0; + FeedBack := 0; + Errors := 0; + Uploads := 0; + Downloads := 0; + UK := 0; + Dk := 0; + FOR L := 0 TO 20 DO + UserBaud[L] := 0; + END; + Write(HistoryFile,History); + END + ELSE + BEGIN + Reset(HistoryFile); + Seek(HistoryFile,(FileSize(HistoryFile) - 1)); + Read(HistoryFile,History); + END; + Close(HistoryFile); + + WITH History DO + BEGIN + TextAttr := 19; + + GoToXY(14,04); + Write(PadRightInt(Callers,5)); + + GoToXY(14,05); + Write(PadRightInt(Posts,5)); + + GoToXY(14,06); + Write(PadRightInt(EMail,5)); + + GoToXY(14,07); + Write(PadRightInt(NewUsers,5)); + + GoToXY(14,08); + Write(PadRightInt(FeedBack,5)); + + GoToXY(14,09); + Write(PadRightInt(Uploads,5)); + + TextAttr := 31; + S := ConvertBytes(UK * 1024,FALSE); + GoToXY(04,10); + Write(Copy(S,(Pos(' ',S) + 1),Length(S))+' UL'); + + TextAttr := 19; + GoToXY(14,10); + Write(PadRightStr(Copy(S,1,(Pos(' ',S) - 1)),5)); + + GoToXY(14,11); + Write(PadRightInt(Downloads,5)); + + TextAttr := 31; + S := ConvertBytes(DK * 1024,FALSE); + GoToXY(04,12); + Write(Copy(S,(Pos(' ',S) + 1),Length(S))+' DL'); + + TextAttr := 19; + GoToXY(14,12); + Write(PadRightStr(Copy(S,1,(Pos(' ',S) - 1)),5)); + + GoToXY(14,13); + Write(PadRightInt(Active,5)); + GoToXY(14,14); + + CASE OverlayLocation OF + 0 : Write(' Disk'); + 1 : Write(' EMS'); + 2 : Write(' XMS'); + END; + + GoToXY(11,15); + L := DiskKBFree(StartDir); + IF (L < General.MinSpaceForUpload) OR (L < General.MinSpaceForPost) THEN + TextAttr := 156; + + Write(PadRightStr(ConvertKB(L,FALSE),8)); + TextAttr := 19; + + IF (General.DaysOnline = 0) THEN + Inc(General.DaysOnline); + GoToXY(34,04); + Str(((General.TotalCalls + Callers) / General.DaysOnline):2:2,s); + Write(PadRightStr(s,5)); + + GoToXY(34,05); + Str(((General.TotalPosts + Posts) / General.DaysOnline):2:2,s); + Write(PadRightStr(s,5)); + + GoToXY(34,06); + Str(((General.TotalUloads + Uploads) / General.DaysOnline):2:2,s); + Write(PadRightStr(s,5)); + + GoToXY(34,07); + Str(((General.TotalDloads + Downloads) / General.DaysOnline):2:2,s); + Write(PadRightStr(s,5)); + + GoToXY(34,08); + Str(((General.TotalUsage + Active) / General.DaysOnline) / 14.0:2:2,s); + Write(PadRightStr(s,4),'%'); + + GoToXY(53,04); + Write(PadRightInt(General.CallerNum,6)); + + GoToXY(53,05); + Write(PadRightInt((General.TotalPosts + Posts),6)); + + GoToXY(53,06); + Write(PadRightInt((General.TotalUloads + Uploads),6)); + + GoToXY(53,07); + Write(PadRightInt((General.TotalDloads + Downloads),6)); + + GoToXY(53,08); + Write(PadRightInt(General.DaysOnline,6)); + + GoToXY(73,04); + Write(PadRightInt(ThisNode,5)); + + GoToXY(73,05); + CASE Tasker OF + None : Write(' DOS'); + DV : Write(' DV'); + Win : Write(' Win'); + OS2 : Write(' OS/2'); + Win32 : Write('Win32'); + Dos5N : Write('DOS/N'); + END; + + GoToXY(73,06); + Write(PadRightInt(Errors,5)); + + IF (ThisUser.Waiting > 0) THEN + TextAttr := 156; + GoToXY(73,07); + Write(PadRightInt(ThisUser.Waiting,5)); + + TextAttr := 19; + GoToXY(73,08); + Write(PadRightInt(General.NumUsers,5)); + + IF (General.TotalUsage < 1) OR (General.DaysOnline < 1) THEN + UpdateGeneral; + TextAttr := 7; + END; + END + ELSE +{$IFDEF MSDOS} + Update_Logo(WFC0,ScreenAddr[0],WFC0_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(WFC0, 1, 1, WFC0_LENGTH); +{$ENDIF} + END; +END; + +PROCEDURE WFCMenus; +CONST + RingNumber: Byte = 0; + MultiRinging: Boolean = FALSE; +VAR + WFCMessage, + s: AStr; + C, + c2: Char; + UNum: Integer; + LastRing, + LastMinute, + rl2, + LastInit: LongInt; + InBox, + RedrawWFC, + PhoneOffHook, + CheckForConnection: Boolean; + + PROCEDURE InitModem; + VAR + s: AStr; + C: Char; + try: Integer; + rl, + rl1: LongInt; + done: Boolean; + BEGIN + C := #0; + done := FALSE; + try := 0; + IF ((Liner.Init <> '') AND (AnswerBaud = 0) AND (NOT LocalIOOnly)) THEN + BEGIN + IF (SysOpOn) AND (NOT BlankMenuNow) THEN + BEGIN + TextAttr := 31; + GoToXY(1,17); + ClrEOL; + GoToXY(31,17); + Write('Initializing modem ...'); + END; + rl := Timer; + + WHILE (KeyPressed) DO + C := ReadKey; + + REPEAT + Com_Set_Speed(Liner.InitBaud); + Com_Flush_Recv; + Com_Send_Str(Liner.Init); + s := ''; + rl1 := Timer; + REPEAT + C := CInKey; + IF (C > #0) THEN + BEGIN + WriteWFC(C); + IF (Length(s) >= 160) THEN + Delete(s,1,120); + s := s + C; + IF (Pos(Liner.OK, s) > 0) THEN + Done := TRUE; + END; + UNTIL ((ABS(Timer - rl1) > 3) OR (done)) OR (KeyPressed); + Com_Flush_Recv; + Inc(try); + IF (try > 10) THEN + Done := TRUE; + UNTIL ((done) OR (KeyPressed)); + IF (SysOpOn) AND (NOT BlankMenuNow) THEN + BEGIN + GoToXY(1,17); + ClrEOL; + END; + END; + PhoneOffHook := FALSE; + WFCMessage := ''; + LastInit := Timer; + WHILE (KeyPressed) DO + C := ReadKey; + Com_Flush_Recv; + TextAttr := 7; + END; + + FUNCTION CPW: Boolean; + VAR + PW: Str20; + BEGIN + IF (NOT SysOpOn) THEN + BEGIN + TextAttr := 25; + Write('Password: '); + TextAttr := 17; + GetPassword(PW,20); + ClrScr; + CPW := (PW = General.SysOpPW); + END + ELSE + CPW := TRUE; + END; + + PROCEDURE TakeOffHook(ShowIt: Boolean); + BEGIN + IF (NOT LocalIOOnly) THEN + BEGIN + DoPhoneOffHook(ShowIt); + PhoneOffHook := TRUE; + WFCMessage := 'Modem off hook'; + END; + END; + + PROCEDURE BeepHim; + VAR + C: Char; + rl, + rl1: LongInt; + BEGIN + TakeOffHook(FALSE); + BeepEnd := FALSE; + rl := Timer; + REPEAT +{$IFDEF MSDOS} + Sound(1500); + Delay(20); + Sound(1000); + Delay(20); + Sound(800); + Delay(20); + NoSound; +{$ENDIF} +{$IFDEF WIN32} + Sound(1000, 60); +{$ENDIF} + rl1 := Timer; + WHILE (ABS(rl1 - Timer) < 0.9) AND (NOT KeyPressed) DO; + UNTIL (ABS(rl - Timer) > 30) OR (KeyPressed); + IF (KeyPressed) THEN + C := ReadKey; + InitModem; + END; + + PROCEDURE PackAllBases; + BEGIN + ClrScr; + TempPause := FALSE; + DoShowPackMessageAreas; + SysOpLog('Message areas packed'); + WFCDraw; + END; + + PROCEDURE ChkEvents; + VAR + EventNum: Byte; + RCode: Integer; + BEGIN + IF (CheckEvents(0) <> 0) THEN + FOR EventNum := 1 TO NumEvents DO + BEGIN + IF (CheckPreEventTime(EventNum,0)) THEN + IF (NOT PhoneOffHook) THEN + BEGIN + TakeOffHook(FALSE); + WFCMessage := 'Modem off hook in preparation for event at '+ + Copy(CTim(MemEventArray[EventNum]^.EventStartTime),4,5)+':00'; + END; + + IF (CheckEventTime(EventNum,0)) THEN + WITH MemEventArray[EventNum]^ DO + BEGIN + Assign(EventFile,General.DataPath+'EVENTS.DAT'); + InitModem; + IF (EventIsOffHook IN EFlags) THEN + TakeOffHook(TRUE); + ClrScr; + Write(Copy(CTim(EventStartTime),4,5)+':00 - Event: '); + WriteLn('"'+EventDescription+'"'); + SL1(''); + SL1('Executing event: '+IntToStr(EventNum)+' '+EventDescription+' on '+DateStr+' '+TimeStr+ + ' from node '+IntToStr(ThisNode)); + IF (EventIsShell IN EFlags) THEN + BEGIN + CursorOn(TRUE); + EventLastDate := Date2PD(DateStr); + Reset(EventFile); + Seek(EventFile,(EventNum - 1)); + Write(EventFile,MemEventArray[EventNum]^); + Close(EventFile); + ShellDOS(FALSE,EventShellPath+'.BAT',RCode); + CursorOn(FALSE); + SL1('Returned from '+EventDescription+' on '+DateStr+' '+TimeStr); + DoPhoneHangup(TRUE); + InitModem; + WFCDraw; + END + ELSE IF (EventIsErrorLevel IN EFlags) THEN + BEGIN + CursorOn(TRUE); + DoneDay := TRUE; + ExitErrorLevel := EventErrorLevel; + EventLastDate := Date2PD(DateStr); + Reset(EventFile); + Seek(EventFile,(EventNum - 1)); + Write(EventFile,MemEventArray[EventNum]^); + Close(EventFile); + CursorOn(FALSE); + END + ELSE IF (EventIsSortFiles IN EFlags) THEN + BEGIN + EventLastDate := Date2PD(DateStr); + Reset(EventFile); + Seek(EventFile,(EventNum - 1)); + Write(EventFile,MemEventArray[EventNum]^); + Close(EventFile); + CursorOn(FALSE); + SortFilesOnly := TRUE; + Sort; + SortFilesOnly := FALSE; + InitModem; + WFCDraw; + END + ELSE IF (EventIsPackMsgAreas IN EFlags) THEN + BEGIN + EventLastDate := Date2PD(DateStr); + Reset(EventFile); + Seek(EventFile,(EventNum - 1)); + Write(EventFile,MemEventArray[EventNum]^); + Close(EventFile); + CursorOn(FALSE); + PackAllBases; + InitModem; + WFCDraw; + END + ELSE IF (EventIsFilesBBS IN EFlags) THEN + BEGIN + EventLastDate := Date2PD(DateStr); + Reset(EventFile); + Seek(EventFile,(EventNum - 1)); + Write(EventFile,MemEventArray[EventNum]^); + Close(EventFile); + CursorOn(FALSE); + CheckFilesBBS; + InitModem; + WFCDraw; + END; + END; + END; + LastError := IOResult; + END; + +BEGIN + IF (NOT General.LocalSec) OR (General.NetworkMode) THEN + SysOpOn := TRUE + ELSE + SysOpOn := FALSE; + LastKeyPress := GetPackDateTime; + InBox := FALSE; + BlankMenuNow := FALSE; + WantOut := TRUE; + RedrawWFC := TRUE; + + Com_Install; + + WFCMDefine; + + WFCDraw; + + DTR(TRUE); + InitModem; + + IF (NOT General.LocalSec) OR (General.NetworkMode) THEN + SysOpOn := TRUE; + IF (BeepEnd) THEN + WFCMessage := 'Modem off hook - paging SysOp'; + Randomize; + TextAttr := CurrentColor; + CursorOn(FALSE); + LastMinute := (Timer - 61); + CheckForConnection := FALSE; + + IF (AnswerBaud > 0) AND NOT (LocalIOOnly) THEN + BEGIN + C := 'A'; + InCom := Com_Carrier; + END + ELSE + BEGIN + C := #0; + CallerIDNumber := ''; + END; + + IF (WFCMessage <> '') AND (SysOpOn) AND NOT (BlankMenuNow) THEN + BEGIN + GoToXY((80 - Length(WFCMessage)) DIV 2,17); + TextAttr := 31; + Write('�� '); + Write(WFCMessage); + Write(' ��'); + END; + + TextAttr := 3; + + IF (BeepEnd) THEN + BeepHim; + + IF (DoneAfterNext) THEN + BEGIN + TakeOffHook(TRUE); + ExitErrorLevel := ExitNormal; + HangUp := TRUE; + DoneDay := TRUE; + ClrScr; + END; + + s := ''; + + REPEAT + InCom := FALSE; + OutCom := FALSE; + FastLogon := FALSE; + ActualSpeed := 0; + HangUp := FALSE; + HungUp := FALSE; + InResponseTo := ''; + LastAuthor := 0; + CFO := FALSE; + ComPortSpeed := 0; + FreeTime := 0; + ExtraTime := 0; + ChopTime := 0; + CreditTime := 0; + LIL := 0; + + DailyMaint; + +{$IFDEF MSDOS} + ASM + Int 28h + END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} + + IF (AnswerBaud = 0) THEN + BEGIN + IF ((Timer - LastMinute) > 60) OR ((Timer - LastMinute) < 0) THEN + BEGIN + LastMinute := Timer; + IF (SysOpOn) AND NOT (BlankMenuNow) THEN + BEGIN + TextAttr := 31; + GoToXY(4,1); + Write(PadRightStr(TimeStr,8)); + GoToXY(68,1); + Write(DateStr); + TextAttr := 15; + END; + IF ((Timer - LastInit) > NoCallInitTime) THEN + BEGIN + LastInit := Timer; + IF (NOT PhoneOffHook) AND (AnswerBaud = 0) THEN + BEGIN + Com_Deinstall; + Com_Install; + InitModem; + END; + IF (General.MultiNode) THEN + BEGIN + LoadURec(ThisUser,1); + SaveGeneral(TRUE); + END; + END; + IF (SysOpOn) AND (General.LocalSec) AND (NOT General.NetworkMode) THEN + SysOpOn := FALSE; + IF ((NOT BlankMenuNow) AND (General.WFCBlankTime > 0)) THEN + IF ((GetPackDateTime - LastKeyPress) DIV 60 >= General.WFCBlankTime) THEN + BEGIN + BlankMenuNow := TRUE; + ClrScr; + END; + IF (NumEvents > 0) THEN + ChkEvents; + END; + C := Char(InKey); + END; + + IF (InBox) AND (C > #0) THEN + BEGIN + IF (C IN [#9,#27]) THEN + BEGIN + InBox := FALSE; + Window(1,1,MaxDisplayCols,MaxDisplayRows); + GoToXY(32,17); + ClrEOL; + END + ELSE + BEGIN + Com_send(C); + WriteWFC(C); + END; + C := #0; + END; + + IF (C > #0) THEN + BEGIN + TempPause := (Pause IN ThisUser.Flags); + RedrawWFC := TRUE; + IF (BlankMenuNow) THEN + BEGIN + BlankMenuNow := FALSE; + WFCDraw; + LastKeyPress := GetPackDateTime; + END; + + C := UpCase(C); + CursorOn(TRUE); + IF (NOT SysOpOn) THEN + CASE C OF + 'Q' : BEGIN + ExitErrorLevel := 255; + HangUp := TRUE; + DoneDay := TRUE; + END; + ' ' : BEGIN + SysOpOn := CPW; + IF (SysOpOn) THEN + WantOut := TRUE; + C := #1; + END; + ELSE + RedrawWFC := FALSE; + END + ELSE + BEGIN + TextAttr := 7; + CurrentColor := 7; + IF (General.NetworkMode) AND (Answerbaud = 0) AND (Pos(C,'HIABCDEFJTV$PLNMOS!RUWXZ#') > 0) THEN + C := #0; + CASE C OF + #9 : BEGIN + InBox := TRUE; + TextAttr := 31; + GoToXY(32,17); + Write('Talking to modem ...'); + RedrawWFC := FALSE; + END; + + 'A' : IF (NOT LocalIOOnly) THEN + CheckForConnection := TRUE + ELSE + RedrawWFC := FALSE; + 'B' : IF (CPW) THEN + MessageAreaEditor; + 'C' : TodaysCallers(0,''); + 'D' : SysOpShell; + 'E' : IF (CPW) THEN + EventEditor; + 'F' : IF (CPW) THEN + FileAreaEditor; + 'H' : BEGIN + DoPhoneHangup(TRUE); + RedrawWFC := FALSE; + END; + 'I' : BEGIN + InitModem; + RedrawWFC := FALSE; + END; + 'L' : BEGIN + ClrScr; + ShowLogs; + NL; + PauseScr(FALSE); + END; + 'M' : IF (CPW) THEN + BEGIN + ClrScr; + ReadAllMessages(''); + END; + 'N' : BEGIN + ClrScr; + lListNodes; + PauseScr(FALSE); + END; + 'O' : BEGIN + TakeOffHook(TRUE); + RedrawWFC := FALSE; + END; + 'P' : BEGIN + ClrScr; + IF (PYNQ('Pack the message areas? ',0,FALSE)) THEN + DoShowPackMessageAreas; + END; + 'Q' : BEGIN + ExitErrorLevel := 255; + HangUp := TRUE; + DoneDay := TRUE; + RedrawWFC := FALSE; + END; + 'R' : IF (CPW) THEN + BEGIN + ClrScr; + Print('^5User''s private messages to read (1-'+IntToStr(MaxUsers - 1)+')?^1'); + NL; + Print('Enter User Number, Name, or Partial Search String.'); + Prt(': '); + lFindUserWS(UNum); + IF (UNum < 1) THEN + BEGIN + NL; + PauseScr(FALSE); + END + ELSE + BEGIN + ClrScr; + LoadURec(ThisUser,UNum); + UserNum := UNum; + ReadMail; + SaveURec(ThisUser,UNum); + LoadURec(ThisUser,1); + UserNum := 1; + END; + END; + 'S' : IF (CPW) THEN + SystemConfigurationEditor; + 'U' : IF (CPW) THEN + BEGIN + ClrScr; + UserEditor(UserNum); + END; + 'V' : IF (CPW) THEN + VotingEditor; + 'W' : IF (CPW) THEN + BEGIN + ClrScr; + Print('^5User to send private message from (1-'+IntToStr(MaxUsers - 1)+')?^1'); + NL; + Print('Enter User Number, Name, or Partial Search String.'); + Prt(': '); + lFindUserWS(UNum); + IF (UNum < 1) THEN + BEGIN + NL; + PauseScr(FALSE); + END + ELSE + BEGIN + LoadURec(ThisUser,UNum); + UserNum := UNum; + NL; + SMail(PYNQ('Send mass mail? ',0,FALSE)); + LoadURec(ThisUser,1); + UserNum := 1; + END; + END; + 'X' : IF (CPW) THEN + ProtocolEditor; + 'Z' : IF (CPW) THEN + HistoryEditor; + + '$' : IF (CPW) THEN + ConferenceEditor; + '!' : BEGIN + ClrScr; + ValidateFiles; + END; + '#' : IF (CPW) THEN + MenuEditor; + ' ' : BEGIN + IF (General.OffHookLocalLogon) THEN + TakeOffHook(TRUE); + GoToXY(32,17); + TextAttr := 31; + Write('Log on? (Y/N'); + IF (NOT General.LocalSec) THEN + Write('/Fast): ') + ELSE + Write('): '); + rl2 := Timer; + WHILE (NOT KeyPressed) AND (ABS(Timer - rl2) < 10) DO; + IF (KeyPressed) THEN + C := UpCase(ReadKey) + ELSE + C := 'N'; + WriteLn(C); + CASE C OF + 'F' : IF (NOT General.LocalSec) THEN + BEGIN + FastLogon := TRUE; + C := ' '; + END; + 'Y' : C := ' '; + ELSE + BEGIN + IF (SysOpOn) AND (NOT BlankMenuNow) THEN + BEGIN + GoToXY(1,17); + ClrEOL; + END; + IF (General.OffHookLocalLogon) THEN + InitModem; + RedrawWFC := FALSE; + END; + END; + END; + ELSE + RedrawWFC := FALSE; + END; + LastKeyPress := GetPackDateTime; + END; + IF (RedrawWFC) THEN + BEGIN + IF NOT (C IN ['A','I','H',' ']) THEN + BEGIN + CurrentColor := 7; + TextAttr := CurrentColor; + WFCDraw; + InitModem; + END; + END; + END; + + + IF (NOT Com_IsRecv_Empty) THEN + BEGIN + c2 := CInKey; + IF (c2 > #0) THEN + BEGIN + WriteWFC(c2); + IF (Length(s) >= 160) THEN + Delete(s,1,120); + IF (c2 <> ^M) THEN + s := s + c2 + ELSE + BEGIN + IF (Pos(Liner.CallerID,s) > 0) THEN + BEGIN + CallerIDNumber := Copy(s,Pos(Liner.CallerID,s) + Length(Liner.CallerID),40); + s := ''; + END; + IF (Pos(Liner.Ring, s) > 0) THEN + BEGIN + s := ''; + IF (RingNumber > 0) AND (ABS(Timer - LastRing) > 10) THEN + BEGIN + RingNumber := 0; + CallerIDNumber := ''; + MultiRinging := FALSE; + END; + IF (ABS(Timer - LastRing) < 4) AND (NOT MultiRinging) THEN + MultiRinging := TRUE + ELSE + Inc(RingNumber); + LastRing := Timer; + IF (RingNumber >= Liner.AnswerOnRing) AND (NOT Liner.MultiRing OR MultiRinging) THEN + CheckForConnection := TRUE; + s := ''; + END; + END; + END; + END; + IF (C > #0) OR (CheckForConnection) THEN + BEGIN + IF (NOT General.LocalSec) OR (General.NetworkMode) THEN + SysOpOn := TRUE; + IF (BlankMenuNow) THEN + BEGIN + BlankMenuNow := FALSE; + WFCDraw; + END; + IF (NOT PhoneOffHook) AND (NOT LocalIOOnly) AND (CheckForConnection) THEN + BEGIN + GetConnection; + CheckForConnection := FALSE; + IF (NOT InCom) THEN + BEGIN + WFCDraw; + InitModem; + IF (QuitAfterDone) THEN + BEGIN + ExitErrorLevel := ExitNormal; + HangUp := TRUE; + DoneDay := TRUE; + END; + END; + END; + END; + CursorOn(FALSE); + UNTIL ((InCom) OR (C = ' ') OR (DoneDay)); + + UploadKBytesToday := 0; + DownloadKBytesToday := 0; + UploadsToday := 0; + PrivatePostsToday := 0; + PublicPostsToday := 0; + FeedbackPostsToday := 0; + ChatAttempts := 0; + ShutUpChatCall := FALSE; + ChatChannel := 0; + ContList := FALSE; + BadDLPath := FALSE; + UserNum := -1; + TempSysOp := FALSE; + + Reset(SchemeFile); + Read(SchemeFile,Scheme); + Close(SchemeFile); + + CurrentColor := 7; + TextAttr := CurrentColor; + IF (InCom) THEN + BEGIN + Com_Flush_Recv; + DTR(TRUE); + OutCom := TRUE; + Com_Set_Speed(ComPortSpeed); + END + ELSE + BEGIN + DTR(FALSE); + OutCom := FALSE; + END; + IF (ActualSpeed = 0) THEN + Rate := (Liner.InitBaud DIV 10) + ELSE + Rate := (ActualSpeed DIV 10); + TimeOn := GetPackDateTime; + ClrScr; + Com_Flush_Recv; + BeepEnd := FALSE; + InWFCMenu := FALSE; + + Kill(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP'); + NodeChatLastRec := 0; + + IF (ComPortSpeed = 0) AND (NOT WantOut) THEN + WantOut := TRUE; + + IF (WantOut) THEN + CursorOn(TRUE); + + SaveGeneral(TRUE); + + LastError := IOResult; +END; + +END. \ No newline at end of file diff --git a/SOURCE/WIN32/defines.inc b/SOURCE/WIN32/defines.inc new file mode 100644 index 0000000..32468f8 --- /dev/null +++ b/SOURCE/WIN32/defines.inc @@ -0,0 +1,7 @@ +{$IFDEF VPASCAL} + {&AlignRec-} + {&Delphi-} + {&Use32+} + {$H-} + {$V-} +{$ENDIF} \ No newline at end of file diff --git a/SOURCE/WIN32/overlay.pas b/SOURCE/WIN32/overlay.pas new file mode 100644 index 0000000..4c4f8c2 --- /dev/null +++ b/SOURCE/WIN32/overlay.pas @@ -0,0 +1,9 @@ +unit overlay; + +// Dummy unit for Win32, so I don't have to IFDEF the USES OVERLAY out of dozens of files! + +interface + +implementation + +end. \ No newline at end of file diff --git a/SOURCE/crc32.obj b/SOURCE/crc32.obj new file mode 100644 index 0000000..e821fa5 Binary files /dev/null and b/SOURCE/crc32.obj differ diff --git a/SOURCE/execwin.obj b/SOURCE/execwin.obj new file mode 100644 index 0000000..0b70993 Binary files /dev/null and b/SOURCE/execwin.obj differ diff --git a/SOURCE/spawntp.obj b/SOURCE/spawntp.obj new file mode 100644 index 0000000..eb36f7b Binary files /dev/null and b/SOURCE/spawntp.obj differ