diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..08dc0bf --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +EXE/ +ORIGINAL ARCHIVES/ \ No newline at end of file diff --git a/BPC.CFG b/BPC.CFG new file mode 100644 index 0000000..0d1172d --- /dev/null +++ b/BPC.CFG @@ -0,0 +1,27 @@ +/EZ:\PROGRA~1\RG119SRC\EXE\BP +/IZ:\BP\UNITS; +/OZ:\BP\UNITS; +/UZ:\BP\UNITS; +/R +/$MD64000,0,655360 +/$MP64000 +/$A+ +/$B- +/$D+ +/$E+ +/$F+ +/$G+ +/$I- +/$L+ +/$N- +/$O+ +/$P- +/$Q- +/$R- +/$S- +/$T- +/$V- +/$X+ +/$Y+ +/B +/GD diff --git a/BUILDBP.CMD b/BUILDBP.CMD new file mode 100644 index 0000000..5dccab0 --- /dev/null +++ b/BUILDBP.CMD @@ -0,0 +1,48 @@ +@ECHO OFF + +Z: + +ECHO CLEAING UP OUTPUT DIRECTORY +DEL /Q Z:\PROGRAMMING\RG119SRC\EXE\BP\*.* + +ECHO COPYING BPC.CFG TO BP DIRECTORY +COPY Z:\PROGRAMMING\RG119SRC\BPC.CFG Z:\BP\BIN + +CD Z:\PROGRAMMING\RG119SRC\SOURCE + +ECHO. +ECHO COMPILING RENEGADE.EXE +Z:\BP\BIN\BPC.EXE RENEGADE.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING RENEMAIL.EXE +Z:\BP\BIN\BPC.EXE RENEMAIL.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING RGLNG.EXE +Z:\BP\BIN\BPC.EXE RGLNG.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING RGQUOTE.EXE +Z:\BP\BIN\BPC.EXE RGQUOTE.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING TAGLINE.EXE +Z:\BP\BIN\BPC.EXE TAGLINE.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +:COPY +ECHO. +ECHO BUILD COMPLETE! HIT A KEY TO COPY EXE FILES OR CTRL-C TO SKIP +PAUSE + +CD Z:\PROGRAMMING\RG119SRC +CALL COPYEXEBP +GOTO END + +:END +PAUSE \ No newline at end of file diff --git a/BUILDVP.CMD b/BUILDVP.CMD new file mode 100644 index 0000000..636c97e --- /dev/null +++ b/BUILDVP.CMD @@ -0,0 +1,48 @@ +@ECHO OFF + +Z: + +ECHO CLEAING UP OUTPUT DIRECTORY +DEL /Q Z:\PROGRAMMING\RG119SRC\EXE\VP\*.* + +ECHO COPYING VPC.CFG TO VP21 DIRECTORY +COPY Z:\PROGRAMMING\RG119SRC\VPC.CFG Z:\VP21\BIN.W32 + +CD Z:\PROGRAMMING\RG119SRC\SOURCE + +ECHO. +ECHO COMPILING RENEGADE.EXE +Z:\VP21\BIN.W32\VPC RENEGADE.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING RENEMAIL.EXE +Z:\VP21\BIN.W32\VPC RENEMAIL.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING RGLNG.EXE +Z:\VP21\BIN.W32\VPC RGLNG.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING RGQUOTE.EXE +Z:\VP21\BIN.W32\VPC RGQUOTE.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +ECHO. +ECHO COMPILING TAGLINE.EXE +Z:\VP21\BIN.W32\VPC TAGLINE.PAS +IF NOT %ERRORLEVEL% == 0 GOTO END + +:COPY +ECHO. +ECHO BUILD COMPLETE! HIT A KEY TO COPY EXE FILES OR CTRL-C TO SKIP +PAUSE + +CD Z:\PROGRAMMING\RG119SRC +CALL COPYEXEVP +GOTO END + +:END +PAUSE \ No newline at end of file diff --git a/COMPILE.TXT b/COMPILE.TXT new file mode 100644 index 0000000..d69d5f5 --- /dev/null +++ b/COMPILE.TXT @@ -0,0 +1,55 @@ +Step 0) Assumptions: + + The first assumption is that you have Borland Pascal installed in Z:\BP. + If you don't, you'll have to update the BUILDBP.CMD file + + The second assumption is that you have Virtual Pascal installed in Z:\vp21. + If you don't, you'll have to update the BUILDVP.CMD file + + *NOTE* The BUILD*.CMD files will copy a BPC.CFG or VPC.CFG into the relevant bin directory, meaning + if you have cusomized the .CFG file in the bin directory, it will be lost. Make a backup! + +Step 1) Create directories to hold everything: + + Z:\RG119 + Z:\Programming\RG119SRC + Z:\Programming\RG119SRC\EXE\BP + Z:\Programming\RG119SRC\EXE\VP + + If you don't have a Z: drive, you can use SUBST or map a network drive to fake one + You can also put the files in an alternate location if you want, you'll just have to update the BUILD*.CMD scripts + +Step 2) Get the source + + Check out the GIT contents into Z:\Programming\RG119SRC + +Step 3) Edit Z:\vp21\source\rtl\vpsysw32.pas + + For some reason the cursor position isn't always updated in the background thread in the Win32 version. I'm guessing + it's a race condition with the CurXPos and CurYPos variables, so the thread doesn't think an update is needed when + one really is. So I've updated my copy of CursorThreadFunc to take the return value of the SemWaitEvent() call into + account, so the update will also happen if the event is signaled. Can't think of a reason why they wouldn't have done + this in the first place. Here's the entire function to copy/paste into place: + + function CursorThreadFunc(P: Pointer): Longint; + var + LastX, LastY: Longint; + begin + LastX := -1; + LastY := -1; + repeat + if SemWaitEvent(semCursor, 300) or (CurXPos <> LastX) or (CurYPos <> LastY) then + begin + DoSetCursorPosition; + LastX := CurXPos; + LastY := CurYPos; + end; + until tidCursor = -2; + tidCursor := -1; + end; + +Step 4) Build new EXEs + + Run BUILDBP.CMD to build the DOS EXEs and have them copied to Z:\RG119 + + Run BUILDVP.CMD to build the WIN32 EXEs and have them copied to Z:\RG119 \ No newline at end of file diff --git a/COPYEXEBP.CMD b/COPYEXEBP.CMD new file mode 100644 index 0000000..1844aac --- /dev/null +++ b/COPYEXEBP.CMD @@ -0,0 +1,7 @@ +@ECHO OFF +COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RENEGADE.EXE Z:\RG119\ +COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RENEGADE.OVR Z:\RG119\ +COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RENEMAIL.EXE Z:\RG119\ +COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGLNG.EXE Z:\RG119\DATA\ +COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGQUOTE.EXE Z:\RG119\DATA\ +COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\TAGLINE.EXE Z:\RG119\DATA\ diff --git a/COPYEXEVP.CMD b/COPYEXEVP.CMD new file mode 100644 index 0000000..9c22858 --- /dev/null +++ b/COPYEXEVP.CMD @@ -0,0 +1,6 @@ +@ECHO OFF +COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RENEGADE.EXE Z:\RG119\RENEGADE32.EXE +COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RENEMAIL.EXE Z:\RG119\RENEMAIL32.EXE +COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGLNG.EXE Z:\RG119\DATA\RGLNG32.EXE +COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGQUOTE.EXE Z:\RG119\DATA\RGQUOTE32.EXE +COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\TAGLINE.EXE Z:\RG119\DATA\TAGLINE32.EXE diff --git a/README.md b/README.md index 1e644b7..02af095 100644 --- a/README.md +++ b/README.md @@ -1 +1,28 @@ -Renegade BBS Source Code For v1.19/DOS was removed. This code is MANY years out of date, plus it can more than likely be found on countless forks. No one seemed interested in more than forking a copy over, so it was worthless to leave on here. - Please see the current non-source builds are located @ http://www.rgbbs.info and happy BBSing! +Renegade BBS Source Code http://rgbbs.info +============== + +============================== + +Copyright Cott Lang, Patrick Spence, Gary Hall, Jeff Herrings, T.J. McMillen, Chris Hoppman, and Lee Palmer
+Ported to Win32 by Rick Parrish
+ +
+ +TODO list:
+ + +Completed list
+ diff --git a/SOURCE/ARCHIVE1.PAS b/SOURCE/ARCHIVE1.PAS new file mode 100644 index 0000000..94cf95d --- /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..70b8d25 --- /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..7c9d304 --- /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..d02c5c6 --- /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..f53fe7c --- /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..522c49a --- /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); + + InputWordWoc(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); + InputWordWoc(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..2d6d3be --- /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..7d91889 --- /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..845c220 --- /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..76f78f6 --- /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..538f76c --- /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..7abe0e2 --- /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..2126279 --- /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..a7f1ab4 --- /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..cade80b --- /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/ELECOM/BUFUNIT.PAS b/SOURCE/ELECOM/BUFUNIT.PAS new file mode 100644 index 0000000..6f16c24 --- /dev/null +++ b/SOURCE/ELECOM/BUFUNIT.PAS @@ -0,0 +1,140 @@ +unit BufUnit; +{$I-,R-,S-,Q-} +(* +** +** Large char-buffer handling routines for EleCOM +** +** Copyright (c) 1998-2002 by Maarten Bekers +** +** Version : 1.03 +** Created : 05-Jan-1999 +** Last update : 12-Jan-2003 +** +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +Type CharBufType = Array[0..65520] of Char; + +type BufArrayObj = Object + TxtArr : CharBufType; + TxtMaxLen : Longint; + TxtStartPtr: Longint; { Start of buffer ptr } + CurTxtPtr : Longint; { Maximum data entered yet } + TmpBuf : CharBufType; + + constructor Init(TxtSize: Longint); + destructor Done; + + function BufRoom: Longint; + function BufUsed: Longint; + function Put(var Buf; Size: Longint): Longint; + function Get(var Buf; Size: Longint; Remove: Boolean): Longint; + + procedure Clear; + end; { BufArrayObj } + + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor BufArrayObj.Init(TxtSize: Longint); +begin + TxtMaxLen := TxtSize; + CurTxtPtr := -1; + TxtStartPtr := 0; + + FillChar(TxtArr, TxtMaxLen, #00); + FillChar(TmpBuf, TxtMaxLen, #00); +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor BufArrayObj.Done; +begin +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function BufArrayObj.BufRoom: Longint; +begin + BufRoom := (TxtMaxLen - (CurTxtPtr + 1)); +end; { func. BufRoom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function BufArrayObj.BufUsed: Longint; +begin + BufUsed := (CurTxtPtr + 01); +end; { func. BufUsed } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function BufArrayObj.Put(var Buf; Size: Longint): Longint; +var RetSize: Longint; +begin + Put := 0; + if Size < 0 then EXIT; + + if TxtStartPtr > 0 then + if (CurTxtPtr + TxtStartPtr) > TxtMaxLen then + begin + Move(TxtArr[TxtStartPtr], TxtArr[0], Succ(CurTxtPtr)); + TxtStartPtr := 0; + end; { if } + + if Size > BufRoom then RetSize := BufRoom + else RetSize := Size; + + Move(Buf, TxtArr[TxtStartPtr + BufUsed], RetSize); + + Inc(CurTxtPtr, RetSize); + TxtArr[TxtStartPtr + BufUsed + 1] := #0; + Put := RetSize; +end; { func. Put } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function BufArrayObj.Get(var Buf; Size: Longint; Remove: Boolean): Longint; +var RetSize: Longint; +begin + Get := 0; + if Size < 0 then EXIT; + + if Size > BufUsed then RetSize := BufUsed + else RetSize := Size; + + Move(TxtArr[TxtStartPtr], Buf, RetSize); + + Get := RetSize; + + if Remove then + begin + if RetSize = BufUsed then + begin + CurTxtPtr := -1; + TxtStartPtr := 0; + TxtArr[0] := #0; + end + else begin + Inc(TxtStartPtr, RetSize); + Dec(CurTxtPtr, RetSize); + TxtArr[CurTxtPtr + TxtStartPtr + 1] := #0; + end; { if } + end; { if } +end; { func. Get } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure BufArrayObj.Clear; +begin + CurTxtPtr := -1; +end; { proc. Clear } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/COMBASE.PAS b/SOURCE/ELECOM/COMBASE.PAS new file mode 100644 index 0000000..dd72401 --- /dev/null +++ b/SOURCE/ELECOM/COMBASE.PAS @@ -0,0 +1,309 @@ +unit ComBase; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 21-May-1998 +** Last update : 14-May-1999 +** +** Note: (c)1998-2003 by Maarten Bekers +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +{$IFDEF VirtualPascal} +uses Use32; +{$ENDIF} + +{$IFDEF MSDOS} + Type ShortString = String; +{$ENDIF} + +type SliceProc = procedure; + +type TCommObj = Object + DontClose : Boolean; + InitFailed : Boolean; + ErrorStr : ShortString; + BlockAll : Boolean; + + constructor Init; + destructor Done; + + procedure Com_OpenQuick(Handle: Longint); virtual; + function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; virtual; + function Com_OpenKeep(Comport: Byte): Boolean; virtual; + procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual; + + procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual; + function Com_GetBPSrate: Longint; virtual; + + procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual; + procedure Com_SetDtr(State: Boolean); virtual; + + function Com_CharAvail: Boolean; virtual; + function Com_Carrier: Boolean; virtual; + function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual; + + function Com_GetChar: Char; virtual; + function Com_PeekChar: Char; virtual; + function Com_SendChar(C: Char): Boolean; virtual; + function Com_GetDriverInfo: String; virtual; + function Com_GetHandle: Longint; virtual; + function Com_InitSucceeded: Boolean; virtual; + + procedure Com_Close; virtual; + procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual; + procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); virtual; + procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_PurgeOutBuffer; virtual; + procedure Com_PurgeInBuffer; virtual; + procedure Com_PauseCom(CloseCom: Boolean); virtual; + procedure Com_ResumeCom(OpenCom: Boolean); virtual; + procedure Com_FlushOutBuffer(Slice: SliceProc); virtual; + procedure Com_SendString(Temp: ShortString); virtual; + procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual; + + procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual; + + end; { object TCommObj } + +Type PCommObj = ^TCommObj; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +{-- We disable warnings as this is just an abstract -} + +constructor TCommObj.Init; +begin + DontClose := false; + InitFailed := false; + BlockAll := false; + ErrorStr := ''; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TCommObj.Done; +begin +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + Com_Open := FALSE; +end; { func. Com_Open } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_OpenQuick(Handle: Longint); +begin +end; { proc. TCommObj.Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_Close; +begin +end; { proc. TCommObj.Com_Close } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_GetChar: Char; +begin + Com_GetChar := #0; +end; { func. TCommObj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_PeekChar: Char; +begin + Com_PeekChar := #0; +end; { func. TCommObj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_SendChar(C: Char): Boolean; +begin + Com_SendChar := FALSE; +end; { proc. TCommObj.Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +begin +end; { proc. TCommObj.Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin +end; { proc. TCommObj.Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_CharAvail: Boolean; +begin + Com_CharAvail := FALSE; +end; { func. TCommObj.Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_Carrier: Boolean; +begin + Com_Carrier := FALSE; +end; { func. Comm_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SetDtr(State: Boolean); +begin +end; { proc. TCommObj.Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_OpenKeep(Comport: Byte): Boolean; +begin + Com_OpenKeep := FALSE; +end; { func. TCommObj.Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Com_ReadyToSend := FALSE; +end; { func. TCommObj.Com_ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +begin +end; { proc. TCommObj.Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_GetBPSrate: Longint; +begin + Com_GetBpsRate := -1; +end; { func. TCommObj.Com_GetBPSrate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +begin +end; { proc. TCommObj.Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +begin +end; { proc. TCommObj.Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_PurgeInBuffer; +begin +end; { proc. TCommObj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_PurgeOutBuffer; +begin +end; { proc. TCommObj.Com_PurgeOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_GetDriverInfo: String; +begin + Com_GetDriverInfo := ''; +end; { func. Com_GetDriverInfo } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_GetHandle: Longint; +begin + Com_GetHandle := -1; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_PauseCom(CloseCom: Boolean); +begin +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_ResumeCom(OpenCom: Boolean); +begin +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TCommObj.Com_InitSucceeded: Boolean; +begin + Com_InitSucceeded := NOT InitFailed; +end; { func. Com_InitFailed } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_FlushOutBuffer(Slice: SliceProc); +var InFree, + OutFree, + InUsed, + OutUsed : Longint; +begin + Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed); + + while (OutUsed > 1) AND (Com_Carrier) do + { X00 (fossil) will never go below 1 ! } + begin + Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed); + + if @Slice <> nil then + begin + Slice; + Slice; + end; { if } + end; { while } +end; { proc. Com_FlushOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); +begin + Com_SendBlock(Block, BlockLen, Written); +end; { proc. Com_SendWait } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SendString(Temp: ShortString); +var Written: Longint; +begin + Com_SendBlock(Temp[1], Length(Temp), Written); +end; { proc. Com_SendString } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); +begin +end; { proc. Com_Setflow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TCommObj.Com_SetDataProc(ReadPtr, WritePtr: Pointer); +begin +end; { Com_SetDataProc } + +end. diff --git a/SOURCE/ELECOM/ELECOM13.PAS b/SOURCE/ELECOM/ELECOM13.PAS new file mode 100644 index 0000000..0e2dc44 --- /dev/null +++ b/SOURCE/ELECOM/ELECOM13.PAS @@ -0,0 +1,350 @@ +library ELECOM13; +{$H-} { important, turn off Ansi-Strings } +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.02 +** Created : 13-Jun-1999 +** Last update : 28-Jun-2000 +** +** Note: (c)1998-1999 by Maarten Bekers. +** If you have any suggestions, please let me know. +** +*) +uses ComBase, + {$IFDEF WIN32} + W32SNGL, + {$ENDIF} + + {$IFDEF OS2} + Os2Com, + {$ENDIF} + + Telnet; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + var ComObj : pCommObj; + ComSystem: Longint; +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComReadProc(var TempPtr: Pointer); stdcall; +begin + {$IFDEF WIN32} + Case ComSystem of + 1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case ComSystem of + 1 : POs2Obj(ComObj)^.Com_ReadProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComWriteProc(var TempPtr: Pointer); stdcall; +begin + {$IFDEF WIN32} + Case ComSystem of + 1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case ComSystem of + 1 : POs2Obj(ComObj)^.Com_WriteProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComWriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_Startup(ObjectType: Longint); stdcall; +begin + ComSystem := ObjectType; + + Case Objecttype of + {$IFDEF WIN32} + 01 : ComObj := New(pWin32Obj, Init); + {$ENDIF} + + {$IFDEF OS2} + 01 : ComObj := New(pOs2Obj, Init); + {$ENDIF} + + 02 : ComObj := New(pTelnetObj, Init); + end; { case } + + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); +end; { proc. Com_Startup } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_OpenQuick(Handle: Longint); stdcall; +begin + ComObj^.Com_OpenQuick(Handle); +end; { proc. Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; stdcall; +begin + Result := ComObj^.Com_Open(Comport, BaudRate, DataBits, Parity, StopBits); +end; { func. Com_Open } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_OpenKeep(Comport: Byte): Boolean; stdcall; +begin + Result := ComObj^.Com_OpenKeep(Comport); +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); stdcall; +begin + ComObj^.Com_GetModemStatus(LineStatus, ModemStatus); +end; { proc. Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); stdcall; +begin + ComObj^.Com_SetLine(BpsRate, Parity, DataBits, StopBits); +end; { proc. Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetBPSrate: Longint; stdcall; +begin + Result := ComObj^.Com_GetBpsRate; +end; { func. Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); stdcall; +begin + ComObj^.Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed); +end; { proc. Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetDtr(State: Boolean); stdcall; +begin + ComObj^.Com_SetDtr(State); +end; { proc. Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_CharAvail: Boolean; stdcall; +begin + Result := ComObj^.Com_CharAvail; +end; { func. Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_Carrier: Boolean; stdcall; +begin + Result := ComObj^.Com_Carrier; +end; { func. Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_ReadyToSend(BlockLen: Longint): Boolean; stdcall; +begin + Result := ComObj^.Com_ReadyToSend(BlockLen); +end; { func. Com_ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetChar: Char; stdcall; +begin + Result := ComObj^.Com_GetChar; +end; { func. Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_SendChar(C: Char): Boolean; stdcall; +begin + Result := ComObj^.Com_SendChar(C); +end; { func. Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetDriverInfo: String; stdcall; +begin + Result := ComObj^.Com_GetDriverInfo; +end; { func. Com_GetDriverInfo } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetHandle: Longint; stdcall; +begin + Result := ComObj^.Com_GetHandle; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_InitSucceeded: Boolean; stdcall; +begin + Result := ComObj^.Com_InitSucceeded; +end; { func. Com_InitSucceeded } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_Close; stdcall; +begin + ComObj^.Com_Close; +end; { proc. Com_Close } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); stdcall; +begin + ComObj^.Com_SendBlock(Block, BlockLen, Written); +end; { proc. Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); stdcall; +begin + ComObj^.Com_SendWait(Block, BlockLen, Written, Slice); +end; { proc. Com_SendWait } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); stdcall; +begin + ComObj^.Com_ReadBlock(Block, BlockLen, Reads); +end; { proc. Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_PurgeOutBuffer; stdcall; +begin + ComObj^.Com_PurgeOutBuffer; +end; { proc. Com_PurgeOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_PurgeInBuffer; stdcall; +begin + ComObj^.Com_PurgeInBuffer; +end; { proc. Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_PauseCom(CloseCom: Boolean); stdcall; +begin + ComObj^.Com_PauseCom(CloseCom); +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_ResumeCom(OpenCom: Boolean); stdcall; +begin + ComObj^.Com_ResumeCom(OpenCom); +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_FlushOutBuffer(Slice: SliceProc); stdcall; +begin + ComObj^.Com_FlushOutBuffer(Slice); +end; { proc. Com_FlushOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SendString(Temp: String); stdcall; +begin + ComObj^.Com_SendString(Temp); +end; { Com_SendString } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetDontClose(Value: Boolean); stdcall; +begin + ComObj^.DontClose := Value; +end; { proc. Com_SetDontClose } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); stdcall; +begin + ComObj^.Com_SetFlow(SoftTX, SoftRX, Hard); +end; { proc. Com_Setflow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_ShutDown; stdcall; +begin + Dispose(ComObj, Done); +end; { proc. Com_ShutDown } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_InitFailed: Boolean; stdcall; +begin + Result := ComObj^.InitFailed; +end; { func. Com_Initfailed } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_ErrorStr: String; stdcall; +begin + Result := ComObj^.ErrorStr; +end; { func. Com_ErrorStr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +exports + Com_Startup index 1 name 'Com_Startup', + Com_Open index 2 name 'Com_Open', + Com_OpenQuick index 3 name 'Com_OpenQuick', + Com_OpenKeep index 4 name 'Com_OpenKeep', + Com_GetModemStatus index 5 name 'Com_GetModemStatus', + Com_SetLine index 6 name 'Com_SetLine', + Com_GetBPSrate index 7 name 'Com_GetBPSrate', + Com_GetBufferStatus index 8 name 'Com_GetBufferStatus', + Com_SetDtr index 09 name 'Com_SetDtr', + Com_CharAvail index 10 name 'Com_CharAvail', + Com_Carrier index 11 name 'Com_Carrier', + Com_ReadyToSend index 12 name 'Com_ReadyToSend', + Com_GetChar index 13 name 'Com_GetChar', + Com_SendChar index 14 name 'Com_SendChar', + Com_GetDriverInfo index 15 name 'Com_GetDriverInfo', + Com_GetHandle index 16 name 'Com_GetHandle', + Com_InitSucceeded index 17 name 'Com_InitSucceeded', + Com_Close index 18 name 'Com_Close', + Com_SendBlock index 19 name 'Com_SendBlock', + Com_SendWait index 20 name 'Com_SendWait', + Com_ReadBlock index 21 name 'Com_ReadBlock', + Com_PurgeOutBuffer index 22 name 'Com_PurgeOutBuffer', + Com_PurgeInBuffer index 23 name 'Com_PurgeInBuffer', + Com_PauseCom index 24 name 'Com_PauseCom', + Com_ResumeCom index 25 name 'Com_ResumeCom', + Com_FlushOutBuffer index 26 name 'Com_FlushOutBuffer', + Com_SendString index 27 name 'Com_SendString', + Com_ShutDown index 28 name 'Com_ShutDown', + Com_SetDontClose index 29 name 'Com_SetDontClose', + Com_SetFlow index 30 name 'Com_SetFlow', + Com_InitFailed index 31 name 'Com_InitFailed', + Com_ErrorStr index 32 name 'Com_ErrorStr'; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +begin + ComObj := nil; +end. diff --git a/SOURCE/ELECOM/ELEDEF.PAS b/SOURCE/ELECOM/ELEDEF.PAS new file mode 100644 index 0000000..d7d88a5 --- /dev/null +++ b/SOURCE/ELECOM/ELEDEF.PAS @@ -0,0 +1,101 @@ +unit ELEDEF; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.03 +** Created : 13-Jun-1999 +** Last update : 05-Aug-2000 +** +** Note: (c)1998-1999 by Maarten Bekers. +** If you have any suggestions, please let me know. +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +Const + ComNameDLL = 'elecom13.dll'; + +type SliceProc = procedure; + +procedure Com_Startup(ObjectType: Longint); stdcall; +function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; stdcall; +procedure Com_OpenQuick(Handle: Longint); stdcall; +function Com_OpenKeep(Comport: Byte): Boolean; stdcall; +procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); stdcall; +procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); stdcall; +function Com_GetBPSrate: Longint; stdcall; +procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); stdcall; +procedure Com_SetDtr(State: Boolean); stdcall; +function Com_CharAvail: Boolean; stdcall; +function Com_Carrier: Boolean; stdcall; +function Com_ReadyToSend(BlockLen: Longint): Boolean; +function Com_GetChar: Char; stdcall; +function Com_SendChar(C: Char): Boolean; stdcall; +function Com_GetDriverInfo: String; stdcall; +function Com_GetHandle: Longint; stdcall; +function Com_InitSucceeded: Boolean; stdcall; +procedure Com_Close; stdcall; +procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); stdcall; +procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); stdcall; +procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); stdcall; +procedure Com_PurgeOutBuffer; stdcall; +procedure Com_PurgeInBuffer; stdcall; +procedure Com_PauseCom(CloseCom: Boolean); stdcall; +procedure Com_ResumeCom(OpenCom: Boolean); stdcall; +procedure Com_FlushOutBuffer(Slice: SliceProc); stdcall; +procedure Com_SendString(Temp: String); stdcall; +procedure Com_ShutDown; stdcall; +procedure Com_SetDontClose(Value: Boolean); stdcall; +procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); stdcall; +function Com_InitFailed: Boolean; stdcall; +function Com_ErrorStr: String; stdcall; + + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_Startup(ObjectType: Longint); external ComNameDLL index 1; +function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; external ComNameDLL index 2; +procedure Com_OpenQuick(Handle: Longint); external ComNameDLL index 3; +function Com_OpenKeep(Comport: Byte): Boolean; external ComNameDLL index 4; +procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); external ComNameDLL index 5; +procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); external ComNameDLL index 6; +function Com_GetBPSrate: Longint; external ComNameDLL index 7; +procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); external ComNameDLL index 8; +procedure Com_SetDtr(State: Boolean); external ComNameDLL index 9; +function Com_CharAvail: Boolean; external ComNameDLL index 10; +function Com_Carrier: Boolean; external ComNameDLL index 11; +function Com_ReadyToSend(BlockLen: Longint): Boolean; external ComNameDLL index 12; +function Com_GetChar: Char; external ComNameDLL index 13; +function Com_SendChar(C: Char): Boolean; external ComNameDLL index 14; +function Com_GetDriverInfo: String; external ComNameDLL index 15; +function Com_GetHandle: Longint; external ComNameDLL index 16; +function Com_InitSucceeded: Boolean; external ComNameDLL index 17; +procedure Com_Close; external ComNameDLL index 18; +procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); external ComNameDLL index 19; +procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); external ComNameDLL index 20; +procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); external ComNameDLL index 21; +procedure Com_PurgeOutBuffer; external ComNameDLL index 22; +procedure Com_PurgeInBuffer; external ComNameDLL index 23; +procedure Com_PauseCom(CloseCom: Boolean); external ComNameDLL index 24; +procedure Com_ResumeCom(OpenCom: Boolean); external ComNameDLL index 25; +procedure Com_FlushOutBuffer(Slice: SliceProc); external ComNameDLL index 26; +procedure Com_SendString(Temp: String); external ComNameDLL index 27; +procedure Com_ShutDown; external ComNameDLL index 28; +procedure Com_SetDontClose(Value: Boolean); external ComNameDLL index 29; +procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); external ComNameDLL index 30; +function Com_InitFailed: Boolean; external ComNameDLL index 31; +function Com_ErrorStr: String; external ComNameDLL index 32; + +end. diff --git a/SOURCE/ELECOM/ELENORM.PAS b/SOURCE/ELECOM/ELENORM.PAS new file mode 100644 index 0000000..d6b2bc2 --- /dev/null +++ b/SOURCE/ELECOM/ELENORM.PAS @@ -0,0 +1,376 @@ +unit EleNORM; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 13-Jun-1999 +** Last update : 28-Jun-2000 +** +** Note: (c)1998 - 2000 by Maarten Bekers. This unit tries to make it easier +** to use EleCOM. +** +** Usage: +** Before calling any of these routines, first call Com_StartUp: +** Pass the following number to it: +** 01 - Use the "modem" communications (OS/2, Win32 or FOSSIL) +** 02 - Use the TELNET type (OS/2 or Win32 only). +** +*) +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses ComBase + {$IFDEF WIN32} + , W32SNGL + , Telnet + {$ENDIF} + + {$IFDEF OS2} + , Telnet + , Os2com + {$ENDIF} + + {$IFDEF GO32V2} + , Fos_Com + {$ENDIF} + + {$IFDEF MSDOS} + , Fos_com + {$ENDIF} ; + + +function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +function Com_OpenKeep(Comport: Byte): Boolean; +function Com_CharAvail: Boolean; +function Com_Carrier: Boolean; +function Com_ReadyToSend(BlockLen: Longint): Boolean; +function Com_GetChar: Char; +function Com_PeekChar: Char; +function Com_SendChar(C: Char): Boolean; +function Com_GetDriverInfo: String; +function Com_GetHandle: Longint; +function Com_InitSucceeded: Boolean; +procedure Com_Startup(ObjectType: Longint); +procedure Com_OpenQuick(Handle: Longint); +procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +procedure Com_SetDtr(State: Boolean); +procedure Com_Close; +procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); +procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +procedure Com_PurgeOutBuffer; +procedure Com_PurgeInBuffer; +procedure Com_PauseCom(CloseCom: Boolean); +procedure Com_ResumeCom(OpenCom: Boolean); +procedure Com_FlushOutBuffer(Slice: SliceProc); +procedure Com_SendString(Temp: String); +procedure Com_SetDontClose(Value: Boolean); +procedure Com_ShutDown; +procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); + + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + var ComObj : pCommObj; + ComSystem: Longint; +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComReadProc(var TempPtr: Pointer); +begin + {$IFDEF WIN32} + Case ComSystem of + 1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case ComSystem of + 1 : POs2Obj(ComObj)^.Com_ReadProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComWriteProc(var TempPtr: Pointer); +begin + {$IFDEF WIN32} + Case ComSystem of + 1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case ComSystem of + 1 : POs2Obj(ComObj)^.Com_WriteProc(TempPtr); + 2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComWriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_Startup(ObjectType: Longint); +begin + ComSystem := ObjectType; + + Case Objecttype of + {$IFDEF WIN32} + 01 : ComObj := New(pWin32Obj, Init); + 02 : ComObj := New(pTelnetObj, Init); + {$ENDIF} + + {$IFDEF OS2} + 01 : ComObj := New(pOs2Obj, Init); + 02 : ComObj := New(pTelnetObj, Init); + {$ENDIF} + + {$IFDEF MSDOS} + 01 : ComObj := New(pFossilObj, Init); + {$ENDIF} + + {$IFDEF GO32V2} + 01 : ComObj := New(pFossilObj, Init); + {$ENDIF} + end; { case } + + {$IFDEF WIN32} + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); + {$ENDIF} + + {$IFDEF OS2} + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); + {$ENDIF} +end; { proc. Com_Startup } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_OpenQuick(Handle: Longint); +begin + ComObj^.Com_OpenQuick(Handle); +end; { proc. Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + Com_Open := ComObj^.Com_Open(Comport, BaudRate, DataBits, Parity, StopBits); +end; { func. Com_Open } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_OpenKeep(Comport: Byte): Boolean; +begin + Com_OpenKeep := ComObj^.Com_OpenKeep(Comport); +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +begin + ComObj^.Com_GetModemStatus(LineStatus, ModemStatus); +end; { proc. Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +begin + ComObj^.Com_SetLine(BpsRate, Parity, DataBits, StopBits); +end; { proc. Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetBPSrate: Longint; +begin + Com_GetBpsRate := ComObj^.Com_GetBpsRate; +end; { func. Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +begin + ComObj^.Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed); +end; { proc. Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetDtr(State: Boolean); +begin + ComObj^.Com_SetDtr(State); +end; { proc. Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_CharAvail: Boolean; +begin + Com_CharAvail := ComObj^.Com_CharAvail; +end; { func. Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_Carrier: Boolean; +begin + Com_Carrier := ComObj^.Com_Carrier; +end; { func. Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Com_ReadyToSend := ComObj^.Com_ReadyToSend(BlockLen); +end; { func. Com_ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetChar: Char; +begin + Com_GetChar := ComObj^.Com_GetChar; +end; { func. Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_PeekChar: Char; +begin + Com_PeekChar := ComObj^.Com_PeekChar; +end; { func. Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_SendChar(C: Char): Boolean; +begin + Com_SendChar := ComObj^.Com_SendChar(C); +end; { func. Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetDriverInfo: String; +begin + Com_GetDriverInfo := ComObj^.Com_GetDriverInfo; +end; { func. Com_GetDriverInfo } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_GetHandle: Longint; +begin + Com_GetHandle := ComObj^.Com_GetHandle; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function Com_InitSucceeded: Boolean; +begin + Com_InitSucceeded := ComObj^.Com_InitSucceeded; +end; { func. Com_InitSucceeded } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_Close; +begin + ComObj^.Com_Close; +end; { proc. Com_Close } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +begin + ComObj^.Com_SendBlock(Block, BlockLen, Written); +end; { proc. Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); +begin + ComObj^.Com_SendWait(Block, BlockLen, Written, Slice); +end; { proc. Com_SendWait } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin + ComObj^.Com_ReadBlock(Block, BlockLen, Reads); +end; { proc. Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_PurgeOutBuffer; +begin + ComObj^.Com_PurgeOutBuffer; +end; { proc. Com_PurgeOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_PurgeInBuffer; +begin + ComObj^.Com_PurgeInBuffer; +end; { proc. Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_PauseCom(CloseCom: Boolean); +begin + ComObj^.Com_PauseCom(CloseCom); +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_ResumeCom(OpenCom: Boolean); +begin + ComObj^.Com_ResumeCom(OpenCom); +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_FlushOutBuffer(Slice: SliceProc); +begin + ComObj^.Com_FlushOutBuffer(Slice); +end; { proc. Com_FlushOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SendString(Temp: String); +begin + ComObj^.Com_SendString(Temp); +end; { Com_SendString } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetDontClose(Value: Boolean); +begin + ComObj^.DontClose := Value; +end; { proc. Com_SetDontClose } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_ShutDown; +begin + Dispose(ComObj, Done); +end; { proc. Com_ShutDown } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); +begin + ComObj^.Com_SetFlow(SoftTX, SoftRX, Hard); +end; { proc. Com_SetFlow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +begin + ComObj := nil; +end. diff --git a/SOURCE/ELECOM/EXAM2.PAS b/SOURCE/ELECOM/EXAM2.PAS new file mode 100644 index 0000000..da00107 --- /dev/null +++ b/SOURCE/ELECOM/EXAM2.PAS @@ -0,0 +1,150 @@ +program Exam2; +(* +** +** EXAMPLE how to use communications +** This is only an example of how to use EleCOM independently of a BBS program, +** to see an example how to use EleCOM as a door from a BBS program, see +** EXAMPLE.PAS +** TELNET is not supported as we dont have a telnet server +** +** version: 1.01 +** Created: 30-Sep-1999 +** +** Fire up line: EXAM2.EXE -C +** eg: EXAM2.EXE -C4 +** +*) + +{.DEFINE FOSSIL} +{.DEFINE OS2COM} +{$DEFINE W32COM} + +{$IFNDEF FOSSIL} + {$IFNDEF OS2COM} + {$IFNDEF W32COM} + You need to define one of these.. + {$ENDIF} + {$ENDIF} +{$ENDIF} + +uses Combase, + {$IFDEF FOSSIL} + Fos_Com + {$ENDIF} + + {$IFDEF OS2COM} + Os2Com + {$ENDIF} + + {$IFDEF W32COM} + W32SNGL + {$ENDIF} ; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +var ComObj : PCommObj; + ComPort : Longint; + ReadCH : Char; + IsTelnet : Boolean; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComReadProc(var TempPtr: Pointer); +begin + {$IFDEF WIN32} + Case IsTelnet of + FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case IsTelnet of + FALSE : POs2Obj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComWriteProc(var TempPtr: Pointer); +begin + {$IFDEF WIN32} + Case IsTelnet of + FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case IsTelnet of + FALSE : POs2Obj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComWriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure ParseCommandLine; +var Counter: Longint; + TempStr: String; + {$IFDEF MSDOS} + Code : Integer; + {$ELSE} + Code : Longint; + {$ENDIF} +begin + for Counter := 01 to ParamCount do + begin + TempStr := ParamStr(Counter); + + if TempStr[1] in ['/', '-'] then + Case UpCase(TempStr[2]) of + 'C' : begin + + TempStr := Copy(TempStr, 3, Length(TempStr) - 2); + Val(TempStr, ComPort, Code); + + end; { 'C' } + end; { case } + + end; { for } +end; { proc. ParseCommandLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + + +begin + IsTelnet := false; + ParseCommandLine; + + {$IFDEF W32COM} + ComObj := New(PWin32Obj, Init); + {$ENDIF} + + {$IFDEF FOSSIL} + ComObj := New(PFossilObj, Init); + {$ENDIF} + + {$IFDEF OS2COM} + ComObj := New(POs2Obj, Init); + {$ENDIF} + + {$IFDEF WIN32} + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); + {$ENDIF} + + {$IFDEF OS2} + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); + {$ENDIF} + + ComObj^.Com_OpenKeep(Comport); { Dont change any comport settings } + ComObj^.Com_SendString('Hello there!' + #13#10); + + repeat + ReadCH := ComObj^.Com_GetChar; + + if ReadCH <> #13 then + Writeln('Other..'); + until (ReadCH = #13) OR (NOT ComObj^.Com_Carrier); + + Dispose(ComObj, Done); { Dispose the communications object } +end. diff --git a/SOURCE/ELECOM/FOS_COM.PAS b/SOURCE/ELECOM/FOS_COM.PAS new file mode 100644 index 0000000..92d0a4a --- /dev/null +++ b/SOURCE/ELECOM/FOS_COM.PAS @@ -0,0 +1,550 @@ +unit FOS_COM; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 21-May-1998 +** Last update : 07-Apr-1999 +** +** Note: (c) 1998-1999 by Maarten Bekers +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses Dos, Combase; + +type TFossilObj = Object(TCommObj) + Regs : Registers; + FosPort: Byte; + + constructor Init; + destructor Done; + + function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; virtual; + function Com_OpenKeep(Comport: Byte): Boolean; virtual; + function Com_GetChar: Char; virtual; + function Com_CharAvail: Boolean; virtual; + function Com_Carrier: Boolean; virtual; + function Com_SendChar(C: Char): Boolean; virtual; + function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual; + function Com_GetBPSrate: Longint; virtual; + function Com_GetDriverInfo: String; virtual; + function Com_GetHandle: longint; virtual; + + procedure Com_OpenQuick(Handle: Longint); virtual; + procedure Com_Close; virtual; + procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual; + procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); virtual; + procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual; + procedure Com_SetDtr(State: Boolean); virtual; + procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual; + procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual; + procedure Com_PurgeInBuffer; virtual; + procedure Com_PurgeOutBuffer; virtual; + procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual; + end; { object TFossilObj } + +Type PFossilObj = ^TFossilObj; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses Strings + {$IFDEF GO32V2} + ,Go32 + {$ENDIF} ; + + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure DosAlloc(var Selector: Word; var SegMent: Word; Size: Longint); +var Res: Longint; +begin + {$IFDEF GO32V2} + Res := Global_DOS_Alloc(Size); + Selector := Word(Res); + + Segment := Word(RES SHR 16); + {$ENDIF} +end; { proc. DosAlloc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure DosFree(Selector: Word); +begin + {$IFDEF GO32V2} + Global_DOS_Free(Selector); + {$ENDIF} +end; { proc. DosFree } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TFossilObj.Init; +begin + inherited Init; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TFossilObj.Done; +begin + inherited Done; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure FossilIntr(var Regs: Registers); +begin + Intr($14, Regs); +end; { proc. FossilIntr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + {-------------------------- Open the comport -----------------------------} + FosPort := (ComPort - 01); + + Regs.AH := $04; + Regs.DX := FosPort; + Regs.BX := $4F50; + + FossilIntr(Regs); + + Com_Open := (Regs.AX = $1954); + InitFailed := (Regs.AX <> $1954); + Com_SetLine(BaudRate, Parity, DataBits, StopBits); +end; { func. TFossilObj.Com_OpenCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_OpenKeep(Comport: Byte): Boolean; +begin + FosPort := (ComPort - 01); + + Regs.AH := $04; + Regs.DX := FosPort; + Regs.BX := $4F50; + + FossilIntr(Regs); + + Com_OpenKeep := (Regs.AX = $1954); + InitFailed := (Regs.AX <> $1954); +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_OpenQuick(Handle: Longint); +begin + {-------------------------- Open the comport -----------------------------} + FosPort := (Handle - 01); + + Regs.AH := $04; + Regs.DX := FosPort; + Regs.BX := $4F50; + + FossilIntr(Regs); + InitFailed := (Regs.AX <> $1954); +end; { proc. Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +var BPS: Byte; +begin + if BpsRate > 65534 then + BpsRate := 65534; + + Case Word(BpsRate) of { have to typecast to word, else will rte201 in dos } + 1200 : BPS := 128; + 2400 : BPS := 160; + 4800 : BPS := 192; + 9600 : BPS := 224; + 19200 : BPS := 0 + else BPS := 32; + end; { case } + + if DataBits in [6..8] then + BPS := BPS + (DataBits - 5); + + if Parity = 'O' then BPS := BPS + 8 else + If Parity = 'E' then BPS := BPS + 24; + + if StopBits = 2 then BPS := BPS + 04; + + Regs.AH := $00; + Regs.AL := BPS; + Regs.DX := FosPort; + FossilIntr(Regs); +end; { proc. TFossilObj.Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_GetBPSrate: Longint; +begin + Com_GetBpsRate := 115200; +end; { func. TFossilObj.Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_Close; +begin + if Dontclose then EXIT; + + Regs.AH := $05; + Regs.DX := FosPort; + FossilIntr(Regs); +end; { proc. TFossilObj.Com_Close } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_SendChar(C: Char): Boolean; +var Written: Longint; +begin + Com_SendWait(C, SizeOf(c), Written, nil); + + Com_SendChar := (Written >= SizeOf(c)); +end; { proc. TFossilObj.Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_GetChar: Char; +begin + Regs.AH := $02; + Regs.DX := FosPort; + FossilIntr(Regs); + + Com_GetChar := Chr(Regs.AL); +end; { proc. TFossilObj.Com_ReadChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +{$IFDEF GO32V2} +var Selector, + Segment : Word; +{$ENDIF} +begin + {$IFDEF MSDOS} + Regs.AH := $18; + Regs.DX := FosPort; + Regs.CX := Blocklen; + Regs.ES := Seg(Block); + Regs.DI := Ofs(Block); + FossilIntr(Regs); + + Reads := Regs.AX; + {$ENDIF} + + {$IFDEF GO32V2} + DosAlloc(Selector, Segment, BlockLen); + + if Int31Error <> 0 then EXIT; + DosmemPut(Segment, 0, Block, BlockLen); + + Regs.AH := $18; + Regs.DX := FosPort; + Regs.CX := Blocklen; + Regs.ES := Segment; + Regs.DI := 0; + FossilIntr(Regs); + + Reads := Regs.AX; + + DosMemGet(Segment, 0, Block, BlockLen); + DosFree(Selector); + {$ENDIF} +end; { proc. TFossilObj.Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +{$IFDEF GO32V2} +var Selector, + Segment : Word; +{$ENDIF} +begin + {$IFDEF MSDOS} + Regs.AH := $19; + Regs.DX := FosPort; + Regs.CX := Blocklen; + Regs.ES := Seg(Block); + Regs.DI := Ofs(Block); + FossilIntr(Regs); + + Written := Regs.AX; + {$ENDIF} + + {$IFDEF GO32V2} + DosAlloc(Selector, Segment, BlockLen); + + if Int31Error <> 0 then EXIT; + DosmemPut(Segment, 0, Block, BlockLen); + + Regs.AH := $19; + Regs.DX := FosPort; + Regs.CX := Blocklen; + Regs.ES := Segment; + Regs.DI := 0; + FossilIntr(Regs); + + Written := Regs.AX; + + DosMemGet(Segment, 0, Block, BlockLen); + DosFree(Selector); + {$ENDIF} +end; { proc. TFossilObj.Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_CharAvail: Boolean; +begin + Regs.AH := $03; + Regs.DX := FosPort; + FossilIntr(Regs); + + Com_CharAvail := (Regs.AH AND 01) <> 00; +end; { func. TFossilObj.Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Regs.AH := $03; + Regs.DX := FosPort; + FossilIntr(Regs); + + Com_ReadyToSend := (Regs.AH AND $20) = $20; +end; { func. TFossilObj.Com_ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_Carrier: Boolean; +begin + Regs.AH := $03; + Regs.DX := FosPort; + FossilIntr(Regs); + + Com_Carrier := (Regs.AL AND 128) <> 00; +end; { func. TFossilObj.Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_SetDtr(State: Boolean); +begin + Regs.AH := $06; + Regs.AL := Byte(State); + Regs.DX := Fosport; + FossilIntr(Regs); +end; { proc. TFossilObj.Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +begin + Regs.AH := $03; + Regs.DX := FosPort; + FossilIntr(Regs); + + ModemStatus := Regs.AL; + LineStatus := Regs.AH; +end; { proc. TFossilObj.Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +type + FosRec = record + Size : Word; + Spec : Byte; + Rev : Byte; + ID : Pointer; + InSize : Word; + InFree : Word; + OutSize : Word; + OutFree : Word; + SWidth : Byte; + SHeight : Byte; + BaudMask : Byte; + Junk : Word; + end; + +var Com_Info: FosRec; + + Selector, + Segment : Word; +begin + {$IFDEF MSDOS} + Regs.AH := $1B; + Regs.DX := FosPort; + Regs.ES := Seg(Com_Info); + Regs.DI := Ofs(Com_Info); + Regs.CX := SizeOf(Com_Info); + {$ENDIF} + + {$IFDEF GO32V2} + DosAlloc(Selector, Segment, SizeOf(Com_Info)); + if Int31Error <> 0 then EXIT; + + DosmemPut(Segment, 0, Com_Info, SizeOf(Com_Info)); + + Regs.AH := $1B; + Regs.DX := FosPort; + Regs.ES := Segment; + Regs.DI := 0; + Regs.CX := SizeOf(Com_Info); + FossilIntr(Regs); + + DosMemGet(Segment, 0, Com_Info, SizeOf(Com_Info)); + DosFree(Selector); + {$ENDIF} + + FossilIntr(Regs); + + InFree := Com_Info.InFree; + InUsed := Com_Info.InSize - Com_Info.InFree; + + OutFree := Com_Info.OutFree; + OutUsed := Com_Info.OutSize - Com_Info.OutFree; +end; { proc. TFossilObj.Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_GetDriverInfo: String; +type + FosRec = record + Size : Word; + Spec : Byte; + Rev : Byte; + ID : PChar; + InSize : Word; + InFree : Word; + OutSize : Word; + OutFree : Word; + SWidth : Byte; + SHeight : Byte; + BaudMask : Byte; + Junk : Word; + end; + +var Com_Info: FosRec; + Segment, + Selector: Word; +begin + FillChar(Com_Info, SizeOf(FosRec), #00); + + {$IFDEF MSDOS} + Regs.AH := $1B; + Regs.DX := FosPort; + Regs.ES := Seg(Com_Info); + Regs.DI := Ofs(Com_Info); + Regs.CX := SizeOf(Com_Info); + {$ENDIF} + + {$IFDEF GO32V2} + DosAlloc(Selector, Segment, SizeOf(Com_Info)); + if Int31Error <> 0 then EXIT; + + DosmemPut(Segment, 0, Com_Info, SizeOf(Com_Info)); + + Regs.AH := $1B; + Regs.DX := FosPort; + Regs.ES := Segment; + Regs.DI := 0; + Regs.CX := SizeOf(Com_Info); + FossilIntr(Regs); + + DosMemGet(Segment, 0, Com_Info, SizeOf(Com_Info)); + DosFree(Selector); + {$ENDIF} + + FossilIntr(Regs); + Com_GetDriverInfo := StrPas(Com_Info.ID); +end; { proc. TFossilObj.Com_GetDriverInfo } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_PurgeInBuffer; +begin + Regs.AH := $0A; + Regs.DX := FosPort; + + FossilIntr(Regs); +end; { proc. TFossilObj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_PurgeOutBuffer; +begin + Regs.AH := $09; + Regs.DX := FosPort; + + FossilIntr(Regs); +end; { proc. TFossilObj.Com_PurgeOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TFossilObj.Com_GetHandle: longint; +begin + Com_GetHandle := FosPort; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); +var RestLen : Longint; + Temp : Array[0..(1024 * 50)] of Char ABSOLUTE Block; + MaxTries: Longint; +begin + RestLen := BlockLen; + MaxTries := (Com_GetBpsRate div 8); + + repeat + Com_SendBlock(Temp[BlockLen - RestLen], RestLen, Written); + + Dec(RestLen, Written); + Dec(MaxTries); + + if RestLen <> 0 then + if @Slice <> nil then + Slice; + until (RestLen <= 0) OR (NOT COM_Carrier) OR (MaxTries < 0); + + Written := (BlockLen - RestLen); +end; { proc. Com_SendWait } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TFossilObj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); +begin + Regs.AH := $0F; + + if SoftTX then + Regs.AL := $01 + else Regs.AL := $00; + + if SoftRX then + Regs.AL := Regs.AL OR $08; + + if Hard then + Regs.AL := Regs.AL OR $02; + + Regs.DX := FosPort; + FossilIntr(Regs); +end; { proc. Com_SetFlow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/HISTORY.102 b/SOURCE/ELECOM/HISTORY.102 new file mode 100644 index 0000000..a8b34f6 --- /dev/null +++ b/SOURCE/ELECOM/HISTORY.102 @@ -0,0 +1,19 @@ +WHATSNEW +======== + +30 July 2000 : Initial DoRxEvent and DoTxEvent were set in true state + which could cause initial very high CPU usage. +18 June 2000 : Changed the way EleCOM calls it threaded functions, making + EleCOM useful for applications where more than one comport + has to be controlled at a time. +20 February 2000 : W32SNGL.PAS or WIN32COM.PAS now include WINDEF.FPC if + compiled with the FPC compiler. This include file redefines + (some) of the Win32 API calls to make sure they are the + correct calling format for us (= the same as with Delphi + and VirtualPascal) +09 September 1999: W32SNGL.PAS - Reduced the number of threads used by this + engine. This one works better on Win9x systems. +05 September 1999: TELNET.PAS added some extra error information to make sure + errors can be more easily diagnosed. +29 August 1999 : ELENORM.PAS - "Plain, vanilly" Pascal version you can use + as a wrapper around the OOP code. diff --git a/SOURCE/ELECOM/HISTORY.103 b/SOURCE/ELECOM/HISTORY.103 new file mode 100644 index 0000000..c9a944f --- /dev/null +++ b/SOURCE/ELECOM/HISTORY.103 @@ -0,0 +1,24 @@ +WHATSNEW +======== + +16 June 2002 : Added a very small state machine to the IAC parser of the + telnet code, to prevent misses of IAC's on the last + character of the buffer. +23 December 2000 : Increased buffersizes that Win32 allocates for in/out + communications. It now uses 3k, instead of 256 bytes. +30 July 2000 : Initial DoRxEvent and DoTxEvent were set in true state + which could cause initial very high CPU usage. +18 June 2000 : Changed the way EleCOM calls it threaded functions, making + EleCOM useful for applications where more than one comport + has to be controlled at a time. +20 February 2000 : W32SNGL.PAS or WIN32COM.PAS now include WINDEF.FPC if + compiled with the FPC compiler. This include file redefines + (some) of the Win32 API calls to make sure they are the + correct calling format for us (= the same as with Delphi + and VirtualPascal) +09 September 1999: W32SNGL.PAS - Reduced the number of threads used by this + engine. This one works better on Win9x systems. +05 September 1999: TELNET.PAS added some extra error information to make sure + errors can be more easily diagnosed. +29 August 1999 : ELENORM.PAS - "Plain, vanilly" Pascal version you can use + as a wrapper around the OOP code. diff --git a/SOURCE/ELECOM/IBMSO32.PAS b/SOURCE/ELECOM/IBMSO32.PAS new file mode 100644 index 0000000..583e395 --- /dev/null +++ b/SOURCE/ELECOM/IBMSO32.PAS @@ -0,0 +1,113 @@ +unit IBMSO32; + +{$OrgName+ } + +interface + +uses OS2Def; + +{$CDECL+} + (****************************************************************************) + function IBM_accept(SFamily: ULong; + SAddr: pointer; + SAddrL: pointer): APIRET; + (****************************************************************************) + function IBM_bind(SSocket: ULong; + SAddr: pointer; + SAddrLen: ULong): APIRET; + (****************************************************************************) + function IBM_connect(SSocket: ULong; + SAddr: pointer; + SAddrLen:ULong): APIRET; + (****************************************************************************) + function IBM_gethostid: APIRET; + (****************************************************************************) + function IBM_select( Sockets: pointer; + noreads, nowrites, noexcepts: longint; + timeout: longint ): ApiRet; + (****************************************************************************) + function IBM_getsockname(SSocket: ULong; + SName: pointer; + SLength: pointer): APIRET; + (****************************************************************************) + function IBM_ioctl(SSocket: ULong; + SRequest: longint; + SArgp: pointer; + ArgSize: longint): APIRET; + (****************************************************************************) + function IBM_listen(SSocket: ULong; + SQueue: ULong): APIRET; + (****************************************************************************) + function IBM_getsockopt(SSocket: uLong; + sLevel: LongInt; + sOptname: LongInt; + sOptVal: pchar; + var sOptLen: LongInt ): ApiRet; + (****************************************************************************) + FUNCTION IBM_setsockopt(sSocket: ulong; + sLevel: uLong; + sOptName: uLong; + sOptVal: pointer; + sOptLen: uLong ): ApiRet; + (****************************************************************************) + function IBM_recv(SSocket: ULong; + SBuffer: pointer; + SLength: ULong; + SFlags: ULong): APIRET; + (****************************************************************************) + function IBM_send(SSocket: ULong; + SBuffer: pointer; + SLength: ULong; + SFlags: ULong): APIRET; + (****************************************************************************) + function IBM_socket(SDomain: ULong; + SType: ULong; + SProtocol: ULong): APIRET; + (****************************************************************************) + function IBM_soclose(SProtocol: ULong): APIRET; + (****************************************************************************) + function IBM_sock_errno: APIRET; + (****************************************************************************) + function IBM_shutdown(SSocket: ULong; + SFlags: ULong): APIRET; + (****************************************************************************) + function IBM_sock_init: APIRET; + (****************************************************************************) + function IBM_so_cancel(SProtocol: ULong): APIRET; + (****************************************************************************) +{$CDECL-} + +implementation + +const + Version = '00.90'; + UseString: string = '@(#)import interface unit for IBM TCP/IP so32dll.dll'+#0; + CopyRight1: string = '@(#)ibmso32dll Version '+Version+' - 10.10.96'+#0; + CopyRight2: string = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'+#0; + +const + sockets = 'SO32DLL'; + network = 'TCP32DLL'; + +{$CDECL+} + function IBM_accept; external sockets index 1; + function IBM_bind; external sockets index 2; + function IBM_connect; external sockets index 3; + function IBM_gethostid; external sockets index 4; + function IBM_getsockname; external sockets index 6; + function IBM_ioctl; external sockets index 8; + function IBM_listen; external sockets index 9; + function IBM_recv; external sockets index 10; + function IBM_send; external sockets index 13; + function IBM_socket; external sockets index 16; + function IBM_soclose; external sockets index 17; + function IBM_sock_errno; external sockets index 20; + function IBM_shutdown; external sockets index 25; + function IBM_sock_init; external sockets index 26; + function IBM_so_cancel; external sockets index 18; + function IBM_getsockopt; external sockets index 7; + function IBM_setsockopt; external sockets index 15; + function IBM_select; external sockets index 12; +{$CDECL-} + +end. diff --git a/SOURCE/ELECOM/IBMTCP32.PAS b/SOURCE/ELECOM/IBMTCP32.PAS new file mode 100644 index 0000000..4b97627 --- /dev/null +++ b/SOURCE/ELECOM/IBMTCP32.PAS @@ -0,0 +1,53 @@ +unit IBMTCP32; + +{$OrgName+ } + +interface + +uses OS2Def, SockDef; + +{$CDECL+} + (****************************************************************************) + function IBM_gethostbyname(HName: pointer): pointer; + (****************************************************************************) + function IBM_gethostbyaddr(HAddr: pointer; + HAddrLen: longint; + HAddrType: ULong): pointer; + (****************************************************************************) + function IBM_gethostname(HName: pointer; + HLength:ULong): APIRET; + (****************************************************************************) + function IBM_getservbyname(_Name, _Proto: pChar): pServEnt; + function inet_addr(_s: pChar): ULONG; + + function getprotobyname(_Name: pChar): pProtoEnt; + + function htonl(_a: LongInt): LongInt; + function ntohl(_a: LongInt): LongInt; +{ function htons(_a: LongInt): LongInt; } +{ function ntohs(_a: SmallInt): SmallInt; } +{$CDECL-} + +implementation + +const + Version = '00.90'; + UseString: string = '@(#)import interface unit for IBM TCP/IP tcp32dll.dll'+#0; + CopyRight1: string = '@(#)ibmTCP32 Version '+Version+' - 10.10.96'+#0; + CopyRight2: string = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'+#0; + +const + sockets = 'SO32DLL'; + network = 'TCP32DLL'; + +{$CDECL+} + function inet_addr; external network index 5; + function IBM_gethostbyname; external network index 11; + function IBM_gethostbyaddr; external network index 12; + function IBM_gethostname; external network index 44; + function getprotobyname; external network index 21; + function IBM_getservbyname; external network index 24; + function htonl; external network index 3; + function ntohl; external network index 3; +{$CDECL-} +end. diff --git a/SOURCE/ELECOM/OS2COM.PAS b/SOURCE/ELECOM/OS2COM.PAS new file mode 100644 index 0000000..57f620f --- /dev/null +++ b/SOURCE/ELECOM/OS2COM.PAS @@ -0,0 +1,786 @@ +unit OS2COM; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 21-May-1998 +** Last update : 12-May-1999 +** +** Note: (c) 1998-1999 by Maarten Bekers +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses Combase, BufUnit, Threads, + {$IFDEF OS2} + Os2Base + {$ENDIF} + + {$IFDEF VirtualPascal} + ,Use32 + {$ENDIF}; + +Const WriteTimeout = 20000; { Wait max. 20 secs } + ReadTimeOut = 5000; { General event, 5 secs max } + + InBufSize = 1024 * 32; + OutBufSize = 1024 * 32; + +type TOs2Obj = Object(TCommObj) + ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + ThreadsInitted: Boolean; { Are the thread(s) up and running? } + + ClientHandle : Longint; + + InBuffer : ^BufArrayObj; { Buffer system internally used } + OutBuffer : ^BufArrayObj; + + DoTxEvent : PSysEventObj; { Event manually set when we have to transmit } + DoRxEvent : PSysEventObj; { Event manually set when we need data } + + TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed } + RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed } + + CriticalTx : PExclusiveObj; { Critical sections } + CriticalRx : PExclusiveObj; + + TxThread : PThreadsObj; { The Transmit and Receive threads } + RxThread : PThreadsObj; + + EndThreads : Boolean; { Set to true when we have to end the threads } + + constructor Init; + destructor Done; + + function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; virtual; + function Com_OpenKeep(Comport: Byte): Boolean; virtual; + function Com_GetChar: Char; virtual; + function Com_CharAvail: Boolean; virtual; + function Com_Carrier: Boolean; virtual; + function Com_SendChar(C: Char): Boolean; virtual; + function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual; + function Com_GetBPSrate: Longint; virtual; + function Com_GetHandle: Longint; virtual; + + procedure Com_OpenQuick(Handle: Longint); virtual; + procedure Com_Close; virtual; + procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual; + procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual; + procedure Com_SetDtr(State: Boolean); virtual; + procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual; + procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual; + procedure Com_PurgeInBuffer; virtual; + procedure Com_PurgeOutBuffer; virtual; + procedure Com_FlushOutBuffer(Slice: SliceProc); virtual; + + procedure Com_PauseCom(CloseCom: Boolean); virtual; + procedure Com_ResumeCom(OpenCom: Boolean); virtual; + procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual; + + procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual; + + procedure Com_ReadProc(var TempPtr: Pointer); + procedure Com_WriteProc(var TempPtr: Pointer); + + function Com_StartThread: Boolean; + procedure Com_InitVars; + procedure Com_StopThread; + end; { object TOs2Obj } + +Type POs2Obj = ^TOs2Obj; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses SysUtils; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TOs2Obj.Init; +begin + inherited Init; + + Com_InitVars; + ThreadsInitted := FALSE; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TOs2Obj.Done; +begin + inherited done; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_ReadProc(var TempPtr: Pointer); +Type TBuffRec = Record + BytesIn : SmallWord; { Number of bytes in the buffer } + MaxSize : SmallWord; { Full size of the buffer } + end; { TBuffRec } + +var Available : Boolean; + BytesRead : Longint; + BlockLen : Longint; + ReturnCode: Longint; + BufferRec : TBuffRec; +begin + repeat + if DoRxEvent.WaitForEvent(ReadTimeOut) then + if NOT EndThreads then + begin + CriticalRx.EnterExclusive; + ReturnCode := 0; + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_GetInQueCount, { Function } + nil, { Params } + ReturnCode, { Max param length } + @ReturnCode, { Param Length } + @BufferRec, { Returned data } + SizeOf(TBuffRec), { Max data length } + @ReturnCode); { Data length } + + Available := (BufferRec.BytesIn > 00); + + DoRxEvent.ResetEvent; + + if Available then + begin + {----------- Start reading the gathered date -------------------} + + if InBuffer^.BufRoom > 0 then + begin + BlockLen := BufferRec.BytesIn; + if BlockLen > InBuffer^.BufRoom then + BlockLen := InBuffer^.BufRoom; + if BlockLen > 1024 then + BlockLen := 1024; + + if BlockLen > 00 then + begin + DosRead(ClientHandle, + InBuffer^.TmpBuf, + BlockLen, + BytesRead); + + InBuffer^.Put(InBuffer^.TmpBuf, BytesRead); + end; { if } + + end; { if } + end; { if available } + + CriticalRx.LeaveExclusive; + end; { if RxEvent } + until EndThreads; + + RxClosedEvent.SignalEvent; + ExitThisThread; +end; { proc. ComReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_WriteProc(var TempPtr: Pointer); +var BlockLen : Longint; + Written : Longint; + ReturnCode : Longint; + TempBuf : ^CharBufType; +begin + New(TempBuf); + + repeat + if DoTxEvent.WaitForEvent(WriteTimeOut) then + if NOT EndThreads then + begin + CriticalTx.EnterExclusive; + DoTxEvent.ResetEvent; + + if OutBuffer^.BufUsed > 00 then + begin + Written := 00; + BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false); + + DosWrite(ClientHandle, + OutBuffer^.TmpBuf, + BlockLen, + Written); + + ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true); + if Written <> BlockLen then + DoTxEvent.SignalEvent; + end; { if } + + CriticalTx.LeaveExclusive; + end; { if } + + until EndThreads; + + Dispose(TempBuf); + TxClosedEvent.SignalEvent; + ExitThisThread; +end; { proc. ComWriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_StartThread: Boolean; +begin + Result := false; + EndThreads := false; + if ThreadsInitted then EXIT; + ThreadsInitted := true; + + {----------------------- Create all the events ----------------------------} + New(DoTxEvent, Init); + if NOT DoTxEvent.CreateEvent(false) then EXIT; + + New(DoRxEvent, Init); + if NOT DoRxEvent.CreateEvent(false) then EXIT; + + New(RxClosedEvent, Init); + if NOT RxClosedEvent.CreateEvent(false) then EXIT; + + New(TxClosedEvent, Init); + if NOT TxClosedEvent.CreateEvent(false) then EXIT; + + + {-------------- Startup the buffers and overlapped events -----------------} + New(InBuffer, Init(InBufSize)); + New(OutBuffer, Init(OutBufSize)); + + {-------------------- Startup a seperate write thread ---------------------} + New(CriticalTx, Init); + CriticalTx.CreateExclusive; + + New(TxThread, Init); + if NOT TxThread.CreateThread(16384, { Stack size } + WriteProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + {-------------------- Startup a seperate read thread ----------------------} + New(CriticalRx, Init); + CriticalRx.CreateExclusive; + + New(RxThread, Init); + if NOT RxThread.CreateThread(16384, { Stack size } + ReadProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + Result := true; +end; { proc. Com_StartThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_InitVars; +begin + DoTxEvent := nil; + DoRxEvent := nil; + RxClosedEvent := nil; + TxClosedEvent := nil; + TxThread := nil; + RxThread := nil; + + InBuffer := nil; + OutBuffer := nil; + CriticalRx := nil; + CriticalTx := nil; +end; { proc. Com_InitVars } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_StopThread; +begin + EndThreads := true; + ThreadsInitted := false; + + if DoTxEvent <> nil then DoTxEvent.SignalEvent; + if DoTxEvent <> nil then DoRxEvent.SignalEvent; + + + if TxThread <> nil then TxThread.CloseThread; + if RxThread <> nil then RxThread.CloseThread; + + if TxClosedEvent <> nil then + if NOT TxClosedEvent^.WaitForEvent(1000) then + TxThread.TerminateThread(0); + + if RxClosedEvent <> nil then + if NOT RxClosedEvent^.WaitForEvent(1000) then + RxThread.TerminateThread(0); + + if TxThread <> nil then TxThread.Done; + if RxThread <> nil then RxThread.Done; + + if DoTxEvent <> nil then Dispose(DoTxEvent, Done); + if DoRxEvent <> nil then Dispose(DoRxEvent, Done); + if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done); + if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done); + + if CriticalTx <> nil then Dispose(CriticalTx, Done); + if CriticalRx <> nil then Dispose(CriticalRx, Done); + + if InBuffer <> nil then Dispose(InBuffer, Done); + if OutBuffer <> nil then Dispose(OutBuffer, Done); + + Com_InitVars; +end; { proc. Com_StopThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_GetHandle: Longint; +begin + Result := ClientHandle; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_OpenQuick(Handle: Longint); +begin + ClientHandle := Handle; + + InitFailed := NOT Com_StartThread; +end; { proc. TOs2Obj.Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_OpenKeep(Comport: Byte): Boolean; +var ReturnCode: Longint; + OpenAction: Longint; + Temp : Array[0..15] of Char; +begin + InitFailed := NOT Com_StartThread; + + if NOT InitFailed then + begin + OpenAction := file_Open; + StrpCopy(Temp, 'COM' + IntToStr(ComPort)); + + ReturnCode := + DosOpen(Temp, { Filename, eg: COM2 } + ClientHandle, + OpenAction, + 0, { Filesize } + 0, { Attributes } + FILE_OPEN or OPEN_ACTION_OPEN_IF_EXISTS, { Open flags } + OPEN_ACCESS_READWRITE or OPEN_SHARE_DENYNONE or { OpenMode } + OPEN_FLAGS_FAIL_ON_ERROR, + nil); { Extended attributes } + + InitFailed := (ReturnCode <> 0); + end; { if } + + Com_OpenKeep := NOT InitFailed; +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + InitFailed := true; + + if Com_OpenKeep(Comport) then + begin + Com_SetLine(BaudRate, Parity, DataBits, StopBits); + + InitFailed := false; + end; { if } + + Com_Open := NOT InitFailed; +end; { func. TOs2Obj.Com_OpenCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +type TBpsRec = Record + Rate : Longint; + Frac : Byte; + end; { record } + +var TempRec : Array[1..3] of Byte; + BpsRec : TBpsRec; + RetLength : Longint; + Temp_Parity : Byte; + Temp_StopBits: Byte; +begin + if NOT (DataBits in [5,7,8]) then DataBits := 8; + if NOT (Parity in ['O', 'E', 'N', 'M', 'S']) then Parity := 'N'; + if NOT (StopBits in [0..2]) then StopBits := 1; + + Temp_Parity := 00; + Case Parity of + 'N' : Temp_Parity := 00; + 'O' : Temp_Parity := 01; + 'E' : Temp_Parity := 02; + 'M' : Temp_Parity := 03; + 'S' : Temp_Parity := 04; + end; { case } + + Temp_Stopbits := 00; + Case StopBits of + 1 : StopBits := 0; + 2 : StopBits := 2; + end; { case } + + Fillchar(TempRec, SizeOf(TempRec), 00); + TempRec[01] := DataBits; + TempRec[02] := Temp_Parity; + TempRec[03] := Temp_StopBits; + + {------------------------- Set line parameters ----------------------------} + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_SetLineCtrl, { Function } + @TempRec, { Params } + SizeOf(TempRec), { Max param length } + @RetLength, { Param Length } + @TempRec, { Returned data } + SizeOf(TempRec), { Max data length } + @RetLength); { Data length } + + {------------------------- Set speed parameters ---------------------------} + BpsRec.Rate := BpsRate; + BpsRec.Frac := 00; + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_ExtSetBaudRate, { Function } + @BpsRec, { Params } + SizeOf(BpsRec), { Max param length } + @RetLength, { Param Length } + @BpsRec, { Returned data } + SizeOf(BpsRec), { Max data length } + @RetLength); { Data length } +end; { proc. TOs2Obj.Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_Close; +begin + if DontClose then EXIT; + + if ClientHandle <> -1 then + begin + Com_StopThread; + DosClose(ClientHandle); + + ClientHandle := -1; + end; { if } + +end; { func. TOs2Obj.Com_CloseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_SendChar(C: Char): Boolean; +var Written: Longint; +begin + Com_SendBlock(C, SizeOf(C), Written); + Com_SendChar := (Written = SizeOf(c)); +end; { proc. TOs2Obj.Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_GetChar: Char; +var Reads: Longint; +begin + Com_ReadBlock(Result, SizeOf(Result), Reads); +end; { func. TOs2Obj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +begin + if OutBuffer^.BufRoom < BlockLen then + repeat + {$IFDEF OS2} + DosSleep(1); + {$ENDIF} + until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier); + + CriticalTx.EnterExclusive; + Written := OutBuffer^.Put(Block, BlockLen); + CriticalTx.LeaveExclusive; + + DoTxEvent.SignalEvent; +end; { proc. TOs2Obj.Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin + if InBuffer^.BufUsed < BlockLen then + begin + repeat + if Com_CharAvail then + DoRxEvent.SignalEvent; + + DosSleep(1); + until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier); + end; { if } + + CriticalRx.EnterExclusive; + Reads := InBuffer^.Get(Block, BlockLen, true); + CriticalRx.LeaveExclusive; +end; { proc. TOs2Obj.Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_CharAvail: Boolean; + +Type TBuffRec = Record + BytesIn : SmallWord; { Number of bytes in the buffer } + MaxSize : SmallWord; { Full size of the buffer } + end; { TBuffRec } + +var ReturnCode: Longint; + BufferRec : TBuffRec; +begin + if InBuffer^.BufUsed < 1 then + begin + ReturnCode := 0; + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_GetInQueCount, { Function } + nil, { Params } + ReturnCode, { Max param length } + @ReturnCode, { Param Length } + @BufferRec, { Returned data } + SizeOf(TBuffRec), { Max data length } + @ReturnCode); { Data length } + + if (BufferRec.BytesIn > 0) then + DoRxEvent.SignalEvent; + end; { if } + + Result := (InBuffer^.BufUsed > 0); +end; { func. TOs2Obj.Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_Carrier: Boolean; +var Status : Byte; + RetLength : Longint; +begin + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_GetModemInput, { Function } + nil, { Params } + 00, { Max param length } + @RetLength, { Param Length } + @Status, { Returned data } + SizeOf(Status), { Max data length } + @RetLength); { Data length } + + Com_Carrier := Status AND 128 <> 00; +end; { func. TOs2Obj.Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +begin + LineStatus := 00; + ModemStatus := 08; + + if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7); +end; { proc. TOs2Obj.Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_SetDtr(State: Boolean); +type + TRtsDtrRec = record + Onmask, + Offmask : Byte; + end; { record } + +var MaskRec : TRtsDtrRec; + RetLength : Longint; +begin + if State then + begin + MaskRec.OnMask := $01; + MaskRec.OffMask := $FF; + end + else begin + MaskRec.OnMask := $00; + MaskRec.OffMask := $FE; + end; { if } + + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_SetModemCtrl, { Function } + @MaskRec, { Params } + SizeOf(MaskRec), { Max param length } + @RetLength, { Param Length } + @MaskRec, { Returned data } + SizeOf(MaskRec), { Max data length } + @RetLength); { Data length } +end; { proc. TOs2Obj.Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TOs2Obj.Com_GetBpsRate: Longint; +type + TBpsRec = record + CurBaud : Longint; { Current BaudRate } + CurFrac : Byte; { Current Fraction } + MinBaud : Longint; { Minimum BaudRate } + MinFrac : Byte; { Minimum Fraction } + MaxBaud : Longint; { Maximum BaudRate } + MaxFrac : Byte; { Maximum Fraction } + end; { TBpsRec } + +var BpsRec : TBpsRec; + Status : Byte; + RetLength: Longint; +begin + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_ExtGetBaudRate, { Function } + nil, { Params } + 00, { Max param length } + @RetLength, { Param Length } + @BpsRec, { Returned data } + SizeOf(BpsRec), { Max data length } + @RetLength); { Data length } + + Com_GetBpsRate := BpsRec.CurBaud; +end; { func. TOs2Obj.Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +begin + DoRxEvent.SignalEvent; + DoTxEvent.SignalEvent; + + InFree := InBuffer^.BufRoom; + OutFree := OutBuffer^.BufRoom; + InUsed := InBuffer^.BufUsed; + OutUsed := OutBuffer^.BufUsed; +end; { proc. TOs2Obj.Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_PurgeInBuffer; +begin + CriticalRx.EnterExclusive; + + InBuffer^.Clear; + + CriticalRx.LeaveExclusive; +end; { proc. TOs2Obj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_PurgeOutBuffer; +begin + CriticalTx.EnterExclusive; + + OutBuffer^.Clear; + + CriticalTx.LeaveExclusive; +end; { proc. TOs2Obj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_FlushOutBuffer(Slice: SliceProc); +begin + DosResetBuffer(ClientHandle); + + inherited Com_FlushOutBuffer(Slice); +end; { proc. Com_FlushOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + + +function TOs2Obj.Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Result := OutBuffer^.BufRoom >= BlockLen; +end; { func. ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_PauseCom(CloseCom: Boolean); +begin + if CloseCom then Com_Close + else Com_StopThread; +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_ResumeCom(OpenCom: Boolean); +begin + if OpenCom then Com_OpenKeep(0) + else Com_StartThread; +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); +var Dcb : DCBINFO; + RetLength: Longint; +begin + FillChar(Dcb, SizeOF(Dcb), 0); + + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_GetDcbInfo, { Function } + nil, { Params } + 00, { Max param length } + @RetLength, { Param Length } + @Dcb, { Returned data } + SizeOf(DcbInfo), { Max data length } + @RetLength); { Data length } + + if (SoftTX) or (SoftRX) then + begin + dcb.fbFlowReplace := dcb.fbFlowReplace + MODE_AUTO_RECEIVE + MODE_AUTO_TRANSMIT; + end + else begin + dcb.fbFlowReplace := MODE_RTS_HANDSHAKE; + dcb.fbCtlHndShake := dcb.fbCtlHndShake + MODE_CTS_HANDSHAKE; + end; { if } + + dcb.fbTimeout := MODE_NO_WRITE_TIMEOUT + MODE_WAIT_READ_TIMEOUT; + dcb.bXONChar := $11; + dcb.bXOFFChar := $13; + + RetLength := SizeOf(DcbInfo); + DosDevIoCtl(ClientHandle, { File-handle } + ioctl_Async, { Category } + async_SetDcbInfo, { Function } + @Dcb, { Params } + SizeOf(DcbInfo), { Max param length } + @RetLength, { Param Length } + nil, { Returned data } + RetLength, { Max data length } + @RetLength); { Data length } + +end; { proc. Com_SetFlow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TOs2Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer); +begin + ReadProcPtr := ReadPtr; + WriteProcPtr := WritePtr; +end; { proc. Com_SetDataProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/PROCS.TXT b/SOURCE/ELECOM/PROCS.TXT new file mode 100644 index 0000000..c745fc8 --- /dev/null +++ b/SOURCE/ELECOM/PROCS.TXT @@ -0,0 +1,109 @@ +Procedure overview +================== + ++---------------------+---------------+----------------------------------------+ +| Name | Parameters | Explanation | ++---------------------+---------------+----------------------------------------+ +| Com_OpenQuick | | Open the comport without init. | +| | Handle | Use these two handles for quickinit | ++------------------------------------------------------------------------------+ +| Com_Open | | Opens the connection and set params | +| | Comport | Comport to open (COM1 = 1) | +| | BaudRate | | +| | DataBits, | | +| | Parity | | +| | StopBits | | ++------------------------------------------------------------------------------+ +| Com_Openkeep | | Open the comport without setting params| +| | Comport | | ++------------------------------------------------------------------------------+ +| Com_GetModemStatus | | Get the line/modem parameters | +| | LineStatus | | +| | ModemStatus | | ++------------------------------------------------------------------------------+ +| Com_SetLine | | Set the comm. parameters | +| | BPSrate | | +| | Parity | | +| | DataBits | | +| | StopBits | | ++------------------------------------------------------------------------------+ +| Com_GetBPSrate | | Returns the current line-speed | +| | | | ++------------------------------------------------------------------------------+ +| Com_GetBufferStatus | | Get the current buffer statusses | +| | InFree | Bytes free in input buffer | +| | OutFree | Bytes free in output buffer | +| | InUsed | Bytes currently used in input buffer | +| | OutUsed | Bytes currently used in output buffer | ++------------------------------------------------------------------------------+ +| Com_SetDTR | | Set DTR setting | +| | State | ++------------------------------------------------------------------------------+ +| Com_CharAvail | | Returns TRUE if there's a char avail. | +| | | | ++------------------------------------------------------------------------------+ +| Com_Carrier | | Returns TRUE if the DTR signal is high | +| | | | ++------------------------------------------------------------------------------+ +| Com_ReadyToSend | | Room enough for this block? | +| | Blocklen | Number of bytes we want to send | ++------------------------------------------------------------------------------+ +| Com_GetChar | | Get one character from the input buffer| +| | | | ++------------------------------------------------------------------------------+ +| Com_SendChar | | Send one character to the remote | +| | | | ++------------------------------------------------------------------------------+ +| Com_GetDriverInfo | | Returns the driver info (FOSSIL only) | +| | | | ++------------------------------------------------------------------------------+ +| Com_GetHandle | | Get the current used handle | +| | | | ++------------------------------------------------------------------------------+ +| Com_InitSucceeded | | Returns TRUE if the initialization | +| | | succeeded | ++------------------------------------------------------------------------------+ +| Com_Close | | Closes the comport and stop the | +| | | threads | ++------------------------------------------------------------------------------+ +| Com_SendBlock | | Sends a block to the remote. | +| | Block | Warning: Make sure that the block you | +| | BlockLen | send isn't larger than the | +| | Written | available buffer size, else | +| | | this routine will block | +| | | indefinitaly | ++------------------------------------------------------------------------------+ +| Com_SendWait | | Sends a block to the remote, this | +| | Block | routine will wait till all the size is | +| | BlockLen | sent under FOSSIL, else it's the same | +| | Written | as Com_SendBlock. | +| | Slice | Slice is called when waiting for all to| +| | | get out. | ++------------------------------------------------------------------------------+ +| Com_ReadBlock | | Gets a block from the remote | +| | Block | Block to read into | +| | BlockLen | Amount of bytes we want (will block!) | +| | Reads | Amount of bytes we actually gotten | ++------------------------------------------------------------------------------+ +| Com_PurgeOutBuffer | | Kill all the pending output | +| | | | ++------------------------------------------------------------------------------+ +| Com_PurgeInBuffer | | Kill all the pending input | +| | | | ++------------------------------------------------------------------------------+ +| Com_PauseCom | | Pause the communications. Stop threads | +| | CloseCom | ++------------------------------------------------------------------------------+ +| Com_ResumeCom | | Resums communications. Start threads | +| | CloseCom | | ++------------------------------------------------------------------------------+ +| Com_FlushOutBuffer | | Wait till all pending output is done | +| | SliceProc | Procedure is called while waiting.. | ++------------------------------------------------------------------------------+ +| Com_SendString | | Send this string to the remote | +| | Temp | String to send | ++------------------------------------------------------------------------------+ +| Com_SetDataProc | | Set read/write thread handlers | +| | ReadPtr | Pointer to read thread procedure | +| | WritePtr | Pointer to write thread procedure | ++----------------------------------------------------(c)2000 by Maarten Bekers-+ diff --git a/SOURCE/ELECOM/README.TXT b/SOURCE/ELECOM/README.TXT new file mode 100644 index 0000000..4b4ae4f --- /dev/null +++ b/SOURCE/ELECOM/README.TXT @@ -0,0 +1,17 @@ +ELECOM v1.03 - release notes +============================ + +These communication routines are released as freeware. You are free to do with +these routines whatever you want, but please give me proper credit when you do +use them (a small email to me mentioning that you are using them would be +great as well). + +When you make any changes, enhancements or additions, please send me a copy +of the changes so I can include them in the next release. + +Have fun, + +groeten, Maarten Bekers + +website: www.elebbs.com +email : maarten@elebbs.com diff --git a/SOURCE/ELECOM/SOCKDEF.PAS b/SOURCE/ELECOM/SOCKDEF.PAS new file mode 100644 index 0000000..fa52e1a --- /dev/null +++ b/SOURCE/ELECOM/SOCKDEF.PAS @@ -0,0 +1,606 @@ +unit SockDef; +(* +** +** SOCKDEF routines +** +** Copyright (c) 1998 by Thomas W. Mueller +** +** Created : 24-Oct-1998 +** Last update : 24-Oct-1998 +** +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses + Sysutils, +{$IFDEF OS2} + Os2def; +{$ENDIF} +{$IFDEF LINUX} + Linux; +{$ENDIF} +{$IFDEF WIN32} + Windows; +{$ENDIF} + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +{$IFDEF VER0_99_13} +type pInteger = ^Integer; + tFarProc = pointer; + SmallInt = System.Integer; +{$ENDIF} + +{$IFDEF LINUX} +type ULONG = longint; +{$ENDIF} + +type + tSockDesc = LongInt; + SmallWord = System.Word; + +type + eSocketErr = class(Exception); + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +const + MaxHostNameLen = 120; + +(* +** Option flags per-socket. +*) +{$IFNDEF LINUX} +(* +** Level number for (get/set)sockopt() to apply to socket itself. +*) + SOL_SOCKET =$ffff; // options for socket level + + SO_DEBUG =$0001; // turn on debugging info recording + SO_ACCEPTCONN =$0002; // socket has had listen() + SO_REUSEADDR =$0004; // allow local address reuse + SO_KEEPALIVE =$0008; // keep connections alive + SO_DONTROUTE =$0010; // just use interface addresses + SO_BROADCAST =$0020; // permit sending of broadcast msgs + SO_USELOOPBACK =$0040; // bypass hardware when possible + SO_LINGER =$0080; // linger on close if data present + SO_OOBINLINE =$0100; // leave received OOB data in line + +(* +** Additional options, not kept in so_options. +*) + SO_SNDBUF =$1001; // send buffer size + SO_RCVBUF =$1002; // receive buffer size + SO_SNDLOWAT =$1003; // send low-water mark + SO_RCVLOWAT =$1004; // receive low-water mark + SO_SNDTIMEO =$1005; // send timeout + SO_RCVTIMEO =$1006; // receive timeout + SO_ERROR =$1007; // get error status and clear + SO_TYPE =$1008; // get socket type + +{$ELSE} + SOL_SOCKET = 1; + + SO_DEBUG = 1; + SO_REUSEADDR = 2; + SO_TYPE = 3; + SO_ERROR = 4; + SO_DONTROUTE = 5; + SO_BROADCAST = 6; + SO_SNDBUF = 7; + SO_RCVBUF = 8; + SO_KEEPALIVE = 9; + SO_OOBINLINE = 10; + SO_NO_CHECK = 11; + SO_PRIORITY = 12; + SO_LINGER = 13; + SO_BSDCOMPAT = 14; +{$ENDIF} + + +(* +** Address families. +*) + AF_UNSPEC = 0; // unspecified + AF_UNIX = 1; // local to host (pipes, portals) + AF_INET = 2; // internetwork: UDP, TCP, etc. + AF_IMPLINK = 3; // arpanet imp addresses + AF_PUP = 4; // pup protocols: e.g. BSP + AF_CHAOS = 5; // mit CHAOS protocols + AF_NS = 6; // XEROX NS protocols + AF_NBS = 7; // nbs protocols + AF_ECMA = 8; // european computer manufacturers + AF_DATAKIT = 9; // datakit protocols + AF_CCITT = 10; // CCITT protocols, X.25 etc + AF_SNA = 11; // IBM SNA + AF_DECnet = 12; // DECnet + AF_DLI = 13; // Direct data link interface + AF_LAT = 14; // LAT + AF_HYLINK = 15; // NSC Hyperchannel + AF_APPLETALK = 16; // Apple Talk + + AF_OS2 = AF_UNIX; + + AF_NB = 17; // Netbios + AF_NETBIOS = AF_NB; + + AF_MAX = 18; + +(* +** Protocol families, same as address families for now. +*) + PF_UNSPEC = AF_UNSPEC; + PF_UNIX = AF_UNIX; + PF_INET = AF_INET; + PF_IMPLINK = AF_IMPLINK; + PF_PUP = AF_PUP; + PF_CHAOS = AF_CHAOS; + PF_NS = AF_NS; + PF_NBS = AF_NBS; + PF_ECMA = AF_ECMA; + PF_DATAKIT = AF_DATAKIT; + PF_CCITT = AF_CCITT; + PF_SNA = AF_SNA; + PF_DECnet = AF_DECnet; + PF_DLI = AF_DLI; + PF_LAT = AF_LAT; + PF_HYLINK = AF_HYLINK; + PF_APPLETALK = AF_APPLETALK; + PF_NETBIOS = AF_NB; + PF_NB = AF_NB; + PF_OS2 = PF_UNIX; + PF_MAX = AF_MAX; + +(* +** Maximum queue length specifiable by listen. +*) + + SOMAXCONN = 5; + + FREAD =1; + FWRITE =2; + + MSG_OOB =$1; // process out-of-band data + MSG_PEEK =$2; // peek at incoming message + MSG_DONTROUTE =$4; // send without using routing tables + MSG_FULLREAD =$8; // send without using routing tables + + MSG_MAXIOVLEN =16; + +const +{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" } + + WSABASEERR = 10000; + +{ Windows Sockets definitions of regular Microsoft C error constants } + + WSAEINTR = (WSABASEERR+4); + WSAEBADF = (WSABASEERR+9); + WSAEACCES = (WSABASEERR+13); + WSAEFAULT = (WSABASEERR+14); + WSAEINVAL = (WSABASEERR+22); + WSAEMFILE = (WSABASEERR+24); + +{ Windows Sockets definitions of regular Berkeley error constants } + +{$IFNDEF LINUX} + WSAEWOULDBLOCK = (WSABASEERR+35); + WSAEINPROGRESS = (WSABASEERR+36); + WSAEALREADY = (WSABASEERR+37); + WSAENOTSOCK = (WSABASEERR+38); + WSAEDESTADDRREQ = (WSABASEERR+39); + WSAEMSGSIZE = (WSABASEERR+40); + WSAEPROTOTYPE = (WSABASEERR+41); + WSAENOPROTOOPT = (WSABASEERR+42); + WSAEPROTONOSUPPORT = (WSABASEERR+43); + WSAESOCKTNOSUPPORT = (WSABASEERR+44); + WSAEOPNOTSUPP = (WSABASEERR+45); + WSAEPFNOSUPPORT = (WSABASEERR+46); + WSAEAFNOSUPPORT = (WSABASEERR+47); + WSAEADDRINUSE = (WSABASEERR+48); + WSAEADDRNOTAVAIL = (WSABASEERR+49); + WSAENETDOWN = (WSABASEERR+50); + WSAENETUNREACH = (WSABASEERR+51); + WSAENETRESET = (WSABASEERR+52); + WSAECONNABORTED = (WSABASEERR+53); + WSAECONNRESET = (WSABASEERR+54); + WSAENOBUFS = (WSABASEERR+55); + WSAEISCONN = (WSABASEERR+56); + WSAENOTCONN = (WSABASEERR+57); + WSAESHUTDOWN = (WSABASEERR+58); + WSAETOOMANYREFS = (WSABASEERR+59); + WSAETIMEDOUT = (WSABASEERR+60); + WSAECONNREFUSED = (WSABASEERR+61); + WSAELOOP = (WSABASEERR+62); + WSAENAMETOOLONG = (WSABASEERR+63); + WSAEHOSTDOWN = (WSABASEERR+64); + WSAEHOSTUNREACH = (WSABASEERR+65); + WSAENOTEMPTY = (WSABASEERR+66); + WSAEPROCLIM = (WSABASEERR+67); + WSAEUSERS = (WSABASEERR+68); + WSAEDQUOT = (WSABASEERR+69); + WSAESTALE = (WSABASEERR+70); + WSAEREMOTE = (WSABASEERR+71); + + WSAEDISCON = (WSABASEERR+101); +{$ENDIF} + +{$IFDEF LINUX} + WSAEWOULDBLOCK = 11; + WSAEINPROGRESS = 115; + WSAEALREADY = 114; + WSAENOTSOCK = 88; + WSAEDESTADDRREQ = 89; + WSAEMSGSIZE = 90; + WSAEPROTOTYPE = 91; + WSAENOPROTOOPT = 92; + WSAEPROTONOSUPPORT = 93; + WSAESOCKTNOSUPPORT = 94; + WSAEOPNOTSUPP = 95; + WSAEPFNOSUPPORT = 96; + WSAEAFNOSUPPORT = 97; + WSAEADDRINUSE = 98; + WSAEADDRNOTAVAIL = 99; + WSAENETDOWN = 100; + WSAENETUNREACH = 101; + WSAENETRESET = 102; + WSAECONNABORTED = 103; + WSAECONNRESET = 104; + WSAENOBUFS = 105; + WSAEISCONN = 106; + WSAENOTCONN = 107; + WSAESHUTDOWN = 108; + WSAETOOMANYREFS = 109; + WSAETIMEDOUT = 110; + WSAECONNREFUSED = 111; + WSAELOOP = 40; + WSAENAMETOOLONG = 36; + WSAEHOSTDOWN = 112; + WSAEHOSTUNREACH = 113; + WSAENOTEMPTY = 39; + WSAEPROCLIM = 00; + WSAEUSERS = 87; + WSAEDQUOT = 122; + WSAESTALE = 116; + WSAEREMOTE = 66; +{$ENDIF} + +{ Extended Windows Sockets error constant definitions } + + WSASYSNOTREADY = (WSABASEERR+91); + WSAVERNOTSUPPORTED = (WSABASEERR+92); + WSANOTINITIALISED = (WSABASEERR+93); + +{ Error return codes from gethostbyname() and gethostbyaddr() + (when using the resolver). Note that these errors are + retrieved via WSAGetLastError() and must therefore follow + the rules for avoiding clashes with error numbers from + specific implementations or language run-time systems. + For this reason the codes are based at WSABASEERR+1001. + Note also that [WSA]NO_ADDRESS is defined only for + compatibility purposes. } + +{ Authoritative Answer: Host not found } + + WSAHOST_NOT_FOUND = (WSABASEERR+1001); + HOST_NOT_FOUND = WSAHOST_NOT_FOUND; + +{ Non-Authoritative: Host not found, or SERVERFAIL } + + WSATRY_AGAIN = (WSABASEERR+1002); + TRY_AGAIN = WSATRY_AGAIN; + +{ Non recoverable errors, FORMERR, REFUSED, NOTIMP } + + WSANO_RECOVERY = (WSABASEERR+1003); + NO_RECOVERY = WSANO_RECOVERY; + +{ Valid name, no data record of requested type } + + WSANO_DATA = (WSABASEERR+1004); + NO_DATA = WSANO_DATA; + +{ no address, look for MX record } + + WSANO_ADDRESS = WSANO_DATA; + NO_ADDRESS = WSANO_ADDRESS; + +{ Windows Sockets errors redefined as regular Berkeley error constants. + These are commented out in Windows NT to avoid conflicts with errno.h. + Use the WSA constants instead. } + + EWOULDBLOCK = WSAEWOULDBLOCK; + EINPROGRESS = WSAEINPROGRESS; + EALREADY = WSAEALREADY; + ENOTSOCK = WSAENOTSOCK; + EDESTADDRREQ = WSAEDESTADDRREQ; + EMSGSIZE = WSAEMSGSIZE; + EPROTOTYPE = WSAEPROTOTYPE; + ENOPROTOOPT = WSAENOPROTOOPT; + EPROTONOSUPPORT = WSAEPROTONOSUPPORT; + ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; + EOPNOTSUPP = WSAEOPNOTSUPP; + EPFNOSUPPORT = WSAEPFNOSUPPORT; + EAFNOSUPPORT = WSAEAFNOSUPPORT; + EADDRINUSE = WSAEADDRINUSE; + EADDRNOTAVAIL = WSAEADDRNOTAVAIL; + ENETDOWN = WSAENETDOWN; + ENETUNREACH = WSAENETUNREACH; + ENETRESET = WSAENETRESET; + ECONNABORTED = WSAECONNABORTED; + ECONNRESET = WSAECONNRESET; + ENOBUFS = WSAENOBUFS; + EISCONN = WSAEISCONN; + ENOTCONN = WSAENOTCONN; + ESHUTDOWN = WSAESHUTDOWN; + ETOOMANYREFS = WSAETOOMANYREFS; + ETIMEDOUT = WSAETIMEDOUT; + ECONNREFUSED = WSAECONNREFUSED; + ELOOP = WSAELOOP; + ENAMETOOLONG = WSAENAMETOOLONG; + EHOSTDOWN = WSAEHOSTDOWN; + EHOSTUNREACH = WSAEHOSTUNREACH; + ENOTEMPTY = WSAENOTEMPTY; + EPROCLIM = WSAEPROCLIM; + EUSERS = WSAEUSERS; + EDQUOT = WSAEDQUOT; + ESTALE = WSAESTALE; + EREMOTE = WSAEREMOTE; + + SockAddr_Len = 16; + In_Addr_Len = 4; + InAddr_Any = 0; + InAddr_Loopback = $7F000001; + InAddr_Broadcast = $FFFFFFFF; + InAddr_None = $FFFFFFFF; + + SOCK_NULL = 0; + SOCK_STREAM = 1; // stream socket + SOCK_DGRAM = 2; // datagram socket + SOCK_RAW = 3; // raw-protocol interface + SOCK_RDM = 4; // reliably-delivered message + SOCK_SEQPACKET = 5; // sequenced packet stream + + IPPROTO_NULL = 0; + IPPROTO_UDP = 17; + IPPROTO_TCP = 6; + + +const + IOCPARM_MASK = $7f; + IOC_VOID = $20000000; + IOC_OUT = $40000000; + IOC_IN = $80000000; + IOC_INOUT = (IOC_IN or IOC_OUT); + +{$IFNDEF LINUX} + FIONREAD = IOC_OUT or { get # bytes to read } + ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or + (Longint(Byte('f')) shl 8) or 127; + FIONBIO = IOC_IN or { set/clear non-blocking i/o } + ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or + (Longint(Byte('f')) shl 8) or 126; + FIOASYNC = IOC_IN or { set/clear async i/o } + ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or + (Longint(Byte('f')) shl 8) or 125; +{$ENDIF} + +type + pLongInt = ^LongInt; + + pIoVec = ^tIoVec; + tIoVec = packed record + iov_base: POINTER; + iov_len: LongInt; + end; + +(* +** Structure used for manipulating linger option. +*) + tLinger = packed record + l_onoff: LongInt; // option on/off + l_linger: LongInt; // linger time + END; + +(* +** Structure used by kernel to pass protocol +** information in raw sockets. +*) + + tSockProto = packed record + sp_family: WORD; // address family + sp_protocol: WORD; // protocol + END; + + off_t = LongInt; + + tuio = packed record + uio_iov: pIoVec; + uio_iovcnt: LongInt; + uio_offset: off_t; + uio_segflg: LongInt; + uio_resid: LongInt; + END; + + pIn_Addr = ^tIn_Addr; + tIn_Addr = packed record + case integer of + 0: (IPAddr: ULong); + 1: (ClassA: byte; + ClassB: byte; + ClassC: byte; + ClassD: byte) + end; + +(* +** Structure used by kernel to store most +** addresses. +*) + pSockAddr=^tSockAddr; + tSockAddr=packed record + case integer of + 0: (Sin_Family: SmallWord; + Sin_Port: SmallWord; + Sin_Addr: tIn_Addr; + Sin_Zero: array[1.. 8] of byte); + 1: (Sa_Family: SmallWord; + Sa_Addr: array[1..14] of byte); + end; + +(* +** Message header for recvmsg and sendmsg calls. +*) + pMsgHdr = ^tMsgHdr; + tMsgHdr = packed record + msg_name: pChar; // optional address + msg_namelen: LongInt; // size of address + msg_iov: pIoVec; // scatter/gather array + msg_iovlen: LongInt; // # elements in msg_iov + msg_accrights: pChar; // access rights sent/received + msg_accrightslen: LongInt; + END; + + uio_rw = ( UIO_READ, UIO_WRITE ); + + pHostEnt = ^tHostEnt; + tHostEnt = packed record + H_Name: ^string; + H_Alias: pointer; +{$IFNDEF WIN32} + H_AddrType: longint; + H_Length: longint; +{$ELSE} + h_addrtype: Smallint; + h_length: Smallint; +{$ENDIF} + H_Addr_List: ^pIn_Addr; + END; + + pProtoEnt = ^tProtoEnt; + TProtoEnt = packed record + p_name: pChar; (* official protocol name *) + p_aliases: ^pChar; (* alias list *) + p_proto: SmallInt; (* protocol # *) + end; + + pServEnt = ^tServEnt; + tServEnt = packed record + s_name: pChar; // official service name + s_aliases: ^pChar; // alias list + s_port: SmallInt; // port # + s_proto: pChar; // protocol to use + END; + +// these types are only used in windows version +const + FD_SETSIZE = 64; + +type + PFDSet = ^TFDSet; + TFDSet = packed record + fd_count: ULONG; + fd_array: array[0..FD_SETSIZE-1] of ULONG; + end; + + PTimeVal = ^TTimeVal; + TTimeVal = packed record + tv_sec: Longint; + tv_usec: Longint; + end; + +const + WSADESCRIPTION_LEN = 256; + WSASYS_STATUS_LEN = 128; + +type + PWSAData = ^TWSAData; + TWSAData = packed record + wVersion: Word; + wHighVersion: Word; + szDescription: array[0..WSADESCRIPTION_LEN] of Char; + szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; + iMaxSockets: Word; + iMaxUdpDg: Word; + lpVendorInfo: PChar; + end; + +(* +** The re-defination of error constants are necessary to avoid conflict with +** standard IBM C Set/2 V1.0 error constants. +** +** All OS/2 SOCKET API error constants are biased by SOCBASEERR from the "normal" +** +*) + +const + SOCBASEERR = 10000; + +(* +** OS/2 SOCKET API definitions of regular Microsoft C 6.0 error constants +*) + +const + SOCEPERM = (SOCBASEERR+1); (* Not owner *) + SOCESRCH = (SOCBASEERR+3); (* No such process *) + SOCEINTR = (SOCBASEERR+4); (* Interrupted system call *) + SOCENXIO = (SOCBASEERR+6); (* No such device or address *) + SOCEBADF = (SOCBASEERR+9); (* Bad file number *) + SOCEACCES = (SOCBASEERR+13); (* Permission denied *) + SOCEFAULT = (SOCBASEERR+14); (* Bad address *) + SOCEINVAL = (SOCBASEERR+22); (* Invalid argument *) + SOCEMFILE = (SOCBASEERR+24); (* Too many open files *) + SOCEPIPE = (SOCBASEERR+32); (* Broken pipe *) + + SOCEOS2ERR = (SOCBASEERR+100); (* OS/2 Error *) + +(* +** OS/2 SOCKET API definitions of regular BSD error constants +*) + +const + SOCEWOULDBLOCK = (SOCBASEERR+35); (* Operation would block *) + SOCEINPROGRESS = (SOCBASEERR+36); (* Operation now in progress *) + SOCEALREADY = (SOCBASEERR+37); (* Operation already in progress *) + SOCENOTSOCK = (SOCBASEERR+38); (* Socket operation on non-socket *) + SOCEDESTADDRREQ = (SOCBASEERR+39); (* Destination address required *) + SOCEMSGSIZE = (SOCBASEERR+40); (* Message too long *) + SOCEPROTOTYPE = (SOCBASEERR+41); (* Protocol wrong type for socket *) + SOCENOPROTOOPT = (SOCBASEERR+42); (* Protocol not available *) + SOCEPROTONOSUPPORT = (SOCBASEERR+43); (* Protocol not supported *) + SOCESOCKTNOSUPPORT = (SOCBASEERR+44); (* Socket type not supported *) + SOCEOPNOTSUPP = (SOCBASEERR+45); (* Operation not supported on socket *) + SOCEPFNOSUPPORT = (SOCBASEERR+46); (* Protocol family not supported *) + SOCEAFNOSUPPORT = (SOCBASEERR+47); (* Address family not supported by protocol family *) + SOCEADDRINUSE = (SOCBASEERR+48); (* Address already in use *) + SOCEADDRNOTAVAIL = (SOCBASEERR+49); (* Can't assign requested address *) + SOCENETDOWN = (SOCBASEERR+50); (* Network is down *) + SOCENETUNREACH = (SOCBASEERR+51); (* Network is unreachable *) + SOCENETRESET = (SOCBASEERR+52); (* Network dropped connection on reset *) + SOCECONNABORTED = (SOCBASEERR+53); (* Software caused connection abort *) + SOCECONNRESET = (SOCBASEERR+54); (* Connection reset by peer *) + SOCENOBUFS = (SOCBASEERR+55); (* No buffer space available *) + SOCEISCONN = (SOCBASEERR+56); (* Socket is already connected *) + SOCENOTCONN = (SOCBASEERR+57); (* Socket is not connected *) + SOCESHUTDOWN = (SOCBASEERR+58); (* Can't send after socket shutdown *) + SOCETOOMANYREFS = (SOCBASEERR+59); (* Too many references: can't splice *) + SOCETIMEDOUT = (SOCBASEERR+60); (* Connection timed out *) + SOCECONNREFUSED = (SOCBASEERR+61); (* Connection refused *) + SOCELOOP = (SOCBASEERR+62); (* Too many levels of symbolic links *) + SOCENAMETOOLONG = (SOCBASEERR+63); (* File name too long *) + SOCEHOSTDOWN = (SOCBASEERR+64); (* Host is down *) + SOCEHOSTUNREACH = (SOCBASEERR+65); (* No route to host *) + SOCENOTEMPTY = (SOCBASEERR+66); (* Directory not empty *) + +(* +** OS/2 SOCKET API errors redefined as regular BSD error constants +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. { unit SockDef } diff --git a/SOURCE/ELECOM/SOCKFUNC.PAS b/SOURCE/ELECOM/SOCKFUNC.PAS new file mode 100644 index 0000000..af25063 --- /dev/null +++ b/SOURCE/ELECOM/SOCKFUNC.PAS @@ -0,0 +1,831 @@ +unit SockFunc; +(* +** +** SOCKFUNC routines +** +** Copyright (c) 1998 by Thomas W. Mueller +** Linux additions (c)1999 by Maarten Bekers +** +** Created : 24-Oct-1998 +** Last update : 24-Oct-1998 +** +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*- +** Copyright (c) 1982, 1985, 1986 Regents of the University of California. +** All rights reserved. +** +** Redistribution and use in source and binary forms are permitted +** provided that this notice is preserved and that due credit is given +** to the University of California at Berkeley. The name of the University +** may not be used to endorse or promote products derived from this +** software without specific prior written permission. This software +** is provided ``as is'' without express or implied warranty. +s** +** @(#)socket.h 7.2 (Berkeley) 12/30/87 +-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses +{$IFDEF OS2} + OS2Def, + IBMSO32, + IBMTCP32, +{$ENDIF} + +{$IFDEF WIN32} + windows, + W32Sock, +{$ENDIF} + +{$IFDEF LINUX} + linux, + Linsock, +{$ENDIF} + + Sysutils, + SockDef; + +Const SockInitted : Boolean = false; + +function SockErrorNo: Longint; +function SockGetErrStr(_ErrNo: integer): ShortString; +procedure SockRaiseError(const _prefix: String; _ErrNo: integer); +procedure SockRaiseLastError(const _prefix: String); + +function SockAccept(_SockDesc: tSockDesc; _SockAddr: pSockAddr; + var _SockAddrLen: Longint): tSockDesc; +function SockBind(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint; +function SockCancel(_SockDesc: tSockDesc): Longint; +function SockConnect(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint; +function SockGetHostByName(Hostname: ShortString): phostent; +function SockShutdown(_SockDesc: tSockDesc; _how: ULong): Longint; +function SockGetSockAddr(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint; +function SockGetSockOpt(_SockDesc: tSockDesc; _Level, _OptName: Integer; + _OptVal: PChar; var _OptLen: Integer): Longint; +function SockSetSockOpt(_SockDesc: tSockDesc; _Level: uLong; _OptName: Ulong; + _OptVal: pChar; _OptLen: uLong ): Longint; +function SockSetBlockingIO(_SockDesc: tSockDesc; _BlockingIO: boolean): Longint; +function SockIoCtlSocket(_SockDesc: tSockDesc; Func: Longint): Longint; +function SockListen(_SockDesc: tSockDesc; _SockQueue: ULong): Longint; +function SockRecv(_SockDesc: tSockDesc; _SockBuffer: pointer; + _SockBufLen: ULong; _SockFlags: ULong): Longint; +function SockSend(_SockDesc: tSockDesc; _SockBuffer: pointer; + _SockBufLen: ULong; _SockFlags: ULong ): Longint; +function SockSocket(_SockFamily: word; _SockType: word; + _SockProtocol: word ): tSockDesc; +function SockClose(_SockDesc: tSockDesc): Longint; +function SockInit: Longint; +function SockClientAlive(_SockDesc: tSockDesc): Boolean; + +function SockGetHostAddrByName(_HostName: ShortString): ULONG; +function SockGetHostNameByAddr(_HostAddr: pIn_Addr): ShortString; +function SockGetHostname: ShortString; + +function SockGetServByName(_Name, _Proto: ShortString): pServEnt; +function SockGetServPortByName(_Name, _Proto: ShortString): Longint; + +function SockHtonl(_Input: LongInt): longint; +function SockHtons(_Input: SmallWord): SmallWord; + +function SockNtohl(_Input: LongInt): longint; +function SockNtohs(_Input: SmallWord): longint; +function SockDataAvail(_SockDesc: tSockDesc): Boolean; +function SockSelect(_SockDesc: tSockDesc): Longint; +function SockInetAddr(_s: ShortString):tIn_Addr; + +{$IFNDEF LINUX} + {$IFNDEF FPC} + {$R SOCKFUNC.RES} + {$ENDIF} +{$ENDIF} + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +Const + Version = '1.00'; + UseString: ShortString = '@(#)socket interface unit for IBM TCP/IP and WinSock'#0; + CopyRight1: ShortString = '@(#)socket Version '+Version+' - 26.08.1998'#0; + CopyRight2: ShortString = '@(#}(C) Thomas Mueller 1998'#0; + CopyRight3: ShortString = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'#0; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + + +function SockErrorNo: Longint; +begin + {$IFDEF OS2} + Result := IBM_sock_errno; + {$ENDIF} + + {$IFDEF WIN32} + Result := WsaGetLastError; + {$ENDIF} + + {$IFDEF LINUX} + Result := SocketError; + {$ENDIF} +end; { func. SockErrorNo } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetErrStr(_ErrNo: integer): ShortString; +begin + Result:=LoadStr(_ErrNo); +end; { func. SockGetErrStr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure SockRaiseError(const _prefix: String; _ErrNo: integer); +begin + raise eSocketErr.CreateFmt('%s: %s (%d)', + [_prefix, SockGetErrStr(_ErrNo), _ErrNo]); +end; { proc. SockRaiseError } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure SockRaiseLastError(const _prefix: String); +begin + SockRaiseError(_Prefix, SockErrorNo); +end; { proc. SockRaiseLastError } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + + +function SockGetServByName(_Name, _Proto: ShortString): pServEnt; +begin + _Name := _Name + #00; + _Proto := _Proto + #00; + + {$IFDEF WIN32} + Result := getservbyname(@_Name[01], @_Proto[01]); + {$ENDIF} + + {$IFDEF OS2} + Result := ibm_getservbyname(@_Name[01], @_Proto[01]); + {$ENDIF} + + {$IFDEF LINUX} + Result := getservbyname(@_Name[1], @_Proto[01]); + {$ENDIF} +end; { func. SockGetServByName } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetServPortByName(_Name, _Proto: ShortString): longint; +var ServEnt: pServEnt; +begin + ServEnt := SockGetServByName(_Name, _Proto); + + if Assigned(ServEnt) then + Result := ServEnt^.s_Port + else Result := -01; +end; { func. SockGetServPortByName } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockHtonl( _Input: longint): longint; +type SwapLong = packed record + case integer of + 0: (SLong: longint); + 1: (SArray: packed array[1..4] of byte); + end; +var Inp, + Tmp: SwapLong; +begin + Inp.SLong := _Input; + Tmp.SArray[1] := Inp.SArray[4]; + Tmp.SArray[2] := Inp.SArray[3]; + Tmp.SArray[3] := Inp.SArray[2]; + Tmp.SArray[4] := Inp.SArray[1]; + result := Tmp.SLong; +end; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockHtons( _Input: SmallWord): SmallWord; +type SwapWord = packed record + case integer of + 0: (SWord: SmallWord); + 1: (SArray: packed array[1..2] of byte); + end; +var Inp,Tmp: SwapWord; +begin + Inp.SWord := _Input; + Tmp.SArray[1] := Inp.SArray[2]; + Tmp.SArray[2] := Inp.SArray[1]; + Result := Tmp.SWord; +end; { func. SockhToNl } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockNtohl( _Input: longint): longint; +begin + {$IFNDEF LINUX} + Result:=ntohl(_Input); + {$ELSE} + {!!!!!!!!!!!!!!!!!!!!!!!} + Result := _Input; + {$ENDIF} +end; { func. sockNToHl } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockNtohs( _Input: SmallWord): longint; +begin + {$IFDEF WIN32} + Result := ntohs( _input); + {$ENDIF} + + {$IFDEF OS2} +{!!!!! Result := ntohs( _input);} + Result := Lo(_Input) * 256 + Hi(_Input); + {$ENDIF} + + {$IFDEF LINUX} + Result := ntohs(_input); + {$ENDIF} +end; { func. SockNToHs } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockAccept(_SockDesc: tSockDesc; + _SockAddr: pSockAddr; + var _SockAddrLen: Longint): longint; +begin + {$IFDEF WIN32} + Result := Accept(_SockDesc, _SockAddr, @_SockAddrLen); + {$ENDIF} + + {$IFDEF OS2} + Result := IBM_Accept(_SockDesc, _SockAddr, @_SockAddrLen); + {$ENDIF} + + {$IFDEF LINUX} + Result := Accept(_SockDesc, _SockAddr^, _SockAddrLen); + {$ENDIF} +end; { func. SockAccept } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockBind(_SockDesc: tSockDesc; + var _SockAddr: tSockAddr ): Longint; +begin + {$IFDEF WIN32} + SockBind := Bind(_SockDesc, @_SockAddr, SockAddr_Len); + {$ENDIF} + + {$IFDEF OS2} + SockBind := IBM_Bind(_SockDesc, @_SockAddr, SockAddr_Len); + {$ENDIF} + + {$IFDEF LINUX} + SockBind := Longint(Bind(_SockDesc, _SockAddr, SockAddr_Len)); + {$ENDIF} +end; { func. SockBind } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockConnect(_SockDesc: tSockDesc; + var _SockAddr: tSockAddr): Longint; +begin + {$IFDEF WIN32} + SockConnect := connect(_SockDesc, @_SockAddr, SockAddr_Len); + {$ENDIF} + + {$IFDEF OS2} + SockConnect := ibm_connect(_SockDesc, @_SockAddr, SockAddr_Len); + {$ENDIF} + + {$IFDEF LINUX} + SockConnect := connect(_SockDesc, _SockAddr, sockAddr_Len); + {$ENDIF} +end; { func. SockConnect } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockCancel(_SockDesc: tSockDesc): Longint; +begin + {$IFDEF WIN32} + Result := SockCancel(_SockDesc); + {$ENDIF} + + {$IFDEF OS2} + Result := IBM_So_Cancel(_SockDesc); + {$ENDIF} + + {$IFDEF LINUX} + Result := longint(true); + if _SockDesc=0 then ; + + {$WARNING SockCancel function not implemented } + {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!} + {$ENDIF} +end; { func. SockCancel } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockShutdown(_SockDesc: tSockDesc; + _how: ULong): Longint; +begin + {$IFDEF WIN32} + SockShutdown := ShutDown(_SockDesc, _How); + {$ENDIF} + + {$IFDEF OS2} + SockShutDown := IBM_ShutDown(_SockDesc, _How); + {$ENDIF} + + {$IFDEF LINUX} + SockShutDown := ShutDown(_SockDesc, _How); + {$ENDIF} +end; { func. SockShutDown } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetSockAddr(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint; +var sLength: Integer; +begin + FillChar(_SockAddr, SizeOf(_SockAddr), #00); + sLength := SizeOf(_SockAddr); + + {$IFDEF WIN32} + Result := GetSockName(_SockDesc, @_SockAddr, sLength); + {$ENDIF} + + {$IFDEF OS2} + Result := IBM_GetSockName(_SockDesc, @_SockAddr, @sLength); + {$ENDIF} + + {$IFDEF LINUX} + Result := GetSocketName(_SockDesc, _SockAddr, sLength); + {$ENDIF} +end; { func. sockGetSockAddr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockSetBlockingIO(_SockDesc: tSockDesc; + _BlockingIO: boolean): Longint; +var Arg: ULONG; +begin + {$IFDEF OS2} + if _BlockingIO then Arg := 00 + else Arg := 01; + + Result := IBM_IOCtl(_SockDesc, FIONBIO, @Arg, SizeOf(Arg)); + {$ENDIF} + + {$IFDEF WIN32} + if _BlockingIO then Arg := 00 + else Arg := 01; + + Result := IOCtlSocket(_SockDesc, FIONBIO, Arg); + {$ENDIF} + + {$IFDEF LINUX} + if _BlockingIO then Arg := 00 + else Arg := 01; + + Result := Longint(ioctl(_SockDesc, Linux.FIONBIO, @Arg)); + {$ENDIF} +end; { func. SockSetBlockingIO } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockIoCtlSocket(_SockDesc: tSockDesc; Func: Longint): Longint; +var Arg: ULONG; +begin + Arg := 0; + + {$IFDEF OS2} + Result := IBM_IOCtl(_SockDesc, FUNC, @Arg, SizeOf(Arg)); + {$ENDIF} + + {$IFDEF WIN32} + Result := IOCtlSocket(_SockDesc, FUNC, Arg); + {$ENDIF} + + {$IFDEF LINUX} + Result := Longint(IoCtl(_SockDesc, Func, @Arg)); + {$ENDIF} +end; { func. SockIoCtlSocket } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetSockOpt(_SockDesc: tSockDesc; _Level, _OptName: Integer; + _OptVal: PChar; var _OptLen: Integer): Longint; +begin + {$IFDEF WIN32} + Result := GetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen); + {$ENDIF} + + {$IFDEF OS2} + Result := IBM_GetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen); + {$ENDIF} + + {$IFDEF LINUX} + Result := SetSocketOptions(_SockDesc, _Level, _OptName, _OptVal, _OptLen); + {$ENDIF} +end; { func. SockGetSockOpt } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockSetSockOpt(_SockDesc: tSockDesc; _Level: uLong; _OptName: Ulong; + _OptVal: pChar; _OptLen: uLong ): Longint; +begin + {$IFDEF WIN32} + Result := SetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen); + {$ENDIF} + + {$IFDEF OS2} + Result := IBM_SetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen); + {$ENDIF} + + {$IFDEF LINUX} + Result := SetSocketOptions(_SockDesc, _Level, _OptName, _OptVal, _OptLen); + {$ENDIF} +end; { func. SockSetSockOpt } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockDataAvail(_SockDesc: tSockDesc): Boolean; +{$IFDEF LINUX} + var ReadFDS : FDSet; + Temp : Longint; +{$ENDIF} +begin + {$IFNDEF LINUX} + Result := (SockSelect(_SockDesc) > 00); + {$ELSE} + fd_Zero(ReadFDS); + fd_Set(_SockDesc, ReadFDS); + + Temp := Select(_SockDesc + 01, @ReadFDS, nil, nil, 0); + if (Temp > 0) then + begin + SockDataAvail := FD_ISSET(_SockDesc, ReadFDS); + end { if } + else SockDataAvail := false; + {$ENDIF} +(* + {$IFDEF OS2} + Arg := 00; + Result := IBM_IOCTL(_SockDesc, FIONREAD, @Arg, SizeOf(Arg)); + + if Arg > 00 then Result := Arg + else Result := $FFFFFFFF; + {$ENDIF} + + {$IFDEF WIN32} + Result := IOCtlSocket(_SockDesc, FIONREAD, Arg); + if Arg > 00 then Result := Arg + else Result := $FFFFFFFF; + {$ENDIF} +*) +end; { func. SockDataAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockListen(_SockDesc: tSockDesc; + _SockQueue: ULong): Longint; +begin + {$IFDEF WIN32} + SockListen := listen(_SockDesc, _SockQueue); + {$ENDIF} + + {$IFDEF OS2} + SockListen := ibm_listen(_SockDesc, _SockQueue); + {$ENDIF} + + {$IFDEF LINUX} + SockListen := Longint(Listen(_SockDesc, _SockQueue)); + {$ENDIF} +end; { func. SockListen } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockSelect(_SockDesc: tSockDesc ): Longint; +{$IFDEF OS2} +var SockCopy: ULONG; +{$ENDIF} + +{$IFDEF WIN32} +var SockArr : TFDSet; + Timeout : TTimeVal; +{$ENDIF} + +{$IFDEF LINUX} +var ReadFDS : FDSet; +{$ENDIF} +begin + {$IFDEF OS2} + SockCopy := _SockDesc; + Result := IBM_Select(@SockCopy, 1, 0, 0, 0); + {$ENDIF} + + {$IFDEF WIN32} + SockArr.fd_Count := 01; + SockArr.fd_Array[00] := _SockDesc; + Timeout.tv_sec := 00; + Timeout.tv_usec := 00; + + Result := Select(00, @SockArr, NIL, NIL, @Timeout); + {$ENDIF} + + {$IFDEF LINUX} + fd_Zero(ReadFDS); + fd_Set(_SockDesc, ReadFDS); + + SockSelect := Select(_SockDesc + 01, @ReadFDS, nil, nil, 0); + {$ENDIF} +end; { func. SockSelect } + +(*-+-*-+-*-+-*-+-*-+-*-+ -*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockRecv(_SockDesc: tSockDesc; + _SockBuffer: pointer; + _SockBufLen: ULong; + _SockFlags: ULong): Longint; +var Counter: Longint; +begin + {$IFDEF WIN32} + SockRecv := recv(_SockDesc, + _SockBuffer, + _SockBufLen, + _SockFlags); + {$ENDIF} + + {$IFDEF OS2} + SockRecv := ibm_recv(_SockDesc, + _SockBuffer, + _SockBufLen, + _SockFlags); + {$ENDIF} + + {$IFDEF LINUX} + SockRecv := Recv(_SockDesc, + _SockBuffer^, + _SockBufLen, + _SockFlags); + {$ENDIF} +end; { func. SockRecv } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockSend(_SockDesc: tSockDesc; + _SockBuffer: pointer; + _SockBufLen: ULong; + _SockFlags: ULong): Longint; +begin + {$IFDEF WIN32} + SockSend := Send(_SockDesc, + _SockBuffer, + _SockBufLen, + _SockFlags); + {$ENDIF} + + {$IFDEF OS2} + SockSend := IBM_Send(_SockDesc, + _SockBuffer, + _SockBufLen, + _SockFlags); + {$ENDIF} + + {$IFDEF LINUX} + SockSend := Send(_SockDesc, + _SockBuffer^, + _SockBufLen, + _SockFlags); + {$ENDIF} +end; { func. SockSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockSocket(_SockFamily: word; + _SockType: word; + _SockProtocol: word): tSockDesc; +begin + {$IFDEF WIN32} + SockSocket := Socket(_SockFamily, _SockType, _SockProtocol); + {$ENDIF} + + {$IFDEF OS2} + SockSocket := ibm_Socket(_SockFamily, _SockType, _SockProtocol); + {$ENDIF} + + {$IFDEF LINUX} + SockSocket := Socket(_SockFamily, _SockType, _SockProtocol); + {$ENDIF} +end; { func. SockSocket } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockClose(_SockDesc: tSockDesc): Longint; +begin + {$IFDEF OS2} + Result := IBM_soclose(_SockDesc); + {$ENDIF} + + {$IFDEF WIN32} + Result := Closesocket(_SockDesc); + {$ENDIF} + + {$IFDEF LINUX} + Result := Longint(fdClose(_SockDesc)); + {$ENDIF} +end; { func. SockClose } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockInit: Longint; +{$IFDEF WIN32} +var Data: TWSAData; +{$ENDIF} +begin + if SockInitted then EXIT; + SockInitted := true; + + {$IFDEF OS2} + SockInit := IBM_Sock_Init; + {$ENDIF} + + {$IFDEF WIN32} + SockInit := WsaStartup($0101, Data); + {$ENDIF} + + {$IFDEF LINUX} + SockInit := 0; + {$ENDIF} +end; { func. SockInit } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetHostByName(Hostname: ShortString): phostent; +begin + HostName := HostName + #00; + {$IFDEF WIN32} + Result := GetHostByName(@HostName[01]); + {$ENDIF} + + {$IFDEF OS2} + Result := IBM_GetHostByName(@HostName[01]); + {$ENDIF} + + {$IFDEF LINUX} + Result := GetHostByName(@HostName[1]); + {$ENDIF} +end; { func. SockGetHostByName } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetHostAddrByName(_HostName: ShortString): ULong; +var ReturnCode: pHostEnt; + InAddr : tIn_Addr; +begin + ReturnCode := SockGetHostbyName(_HostName); + if Assigned(ReturnCode) then + begin + InAddr := ReturnCode^.H_Addr_List^^; + Result := InAddr.IpAddr; + end + else Result:=$FFFFFFFF; +end; { func. SockGetHostAddrByName } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetHostByAddr(HostAddr: pIn_Addr; + HostAddrLen: ULong; + HostAddrType: ULong): pointer; +begin + {$IFDEF WIN32} + SockGetHostByAddr := GetHostbyAddr(HostAddr, + HostAddrLen, + HostAddrType); + {$ENDIF} + + {$IFDEF OS2} + SockGetHostByAddr := IBM_GetHostbyAddr(HostAddr, + HostAddrLen, + HostAddrType); + {$ENDIF} + + {$IFDEF LINUX} + Result := GetHostByAddr(HostAddr, HostAddrLen, HostAddrtype); + {$ENDIF} +end; { func. SockGetHostbyAddr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetHostNameByAddr(_HostAddr: pIn_Addr): ShortString; +var Counter : Integer; + ReturnCode: pHostEnt; + HName : ShortString; +begin + ReturnCode := SockGetHostByAddr(_HostAddr, + In_Addr_Len, + AF_INET); + + if (ULong(ReturnCode) <> 00) then + begin + HName := ''; + Counter := 00; + + While ReturnCode^.H_Name^[Counter] <> #00 do + begin + HName := HName + ReturnCode^.H_Name^[Counter]; + Inc(Counter); + end; { while } + end + else HName := 'Hostname not found'; + + SockGetHostNameByAddr := HName; +end; { func. SockGetHostNameByAddr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockGetHostname: ShortString; +var Counter : Longint; + sResult : Longint; + HostName : ShortString; + InAddr : TIn_Addr; +begin + FillChar(HostName, SizeOf(HostName), #00); + + {$IFDEF WIN32} + sResult := GetHostName(@HostName[01], SizeOf(HostName)); + {$ENDIF} + + {$IFDEF OS2} + sResult := IBM_GetHostName(@HostName[01], SizeOf(HostName)); + {$ENDIF} + + {$IFDEF LINUX} + {!!!!!!!!!!!!!!!!!!!} + InAddr.ClassA := 127; + InAddr.ClassB := 0; + InAddr.ClassC := 0; + InAddr.ClassD := 1; + + HostName := SockGetHostNameByAddr(@InAddr) + #00; + sResult := Length(HostName); + {$ENDIF} + + Counter := 01; + While (Counter < SizeOf(HostName)) AND (HostName[Counter] <> #00) do + Inc(Counter); + + if (Counter > 01) then + SetLength(HostName, Counter) + else HostName := 'amnesiac'; + + SockGetHostname := HostName; +end; { func. SockGetHostName } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockInetAddr(_s: ShortString): tIn_Addr; +begin + _s := _s + #00; + + {$IFNDEF LINUX} + Result.IpAddr := INet_Addr(@_S[01]); + {$ELSE} + {$WARNING SockInetAddr function not implemented! } + Result.IpAddr := INADDR_NONE; + {$ENDIF} +end; { func. SockInetAddr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function SockClientAlive(_SockDesc: tSockDesc): Boolean; +var TempCH : Char; + Returncode : Longint; + TempError : Longint; + TempStr : String; +begin + Result := true; + + ReturnCode := SockRecv(_SockDesc, @TempCH, SizeOf(TempCH), MSG_PEEK); + TempError := SockErrorNo; + + TempStr := SockGetErrStr(TempError); + + if ReturnCode = 0 then Result := false; { was: = 0 } + if (TempError <> WSAEWOULDBLOCK) AND (TempError <> 00) then + Result := false; +end; { func. SockClientAlive } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +initialization + {!! SockInit; } + +finalization + {$IFDEF WIN32} + //WsaCleanUp; + {$ENDIF} +end. { unit SockFunc } diff --git a/SOURCE/ELECOM/SOCKFUNC.RC b/SOURCE/ELECOM/SOCKFUNC.RC new file mode 100644 index 0000000..7123018 --- /dev/null +++ b/SOURCE/ELECOM/SOCKFUNC.RC @@ -0,0 +1,92 @@ +#define SOCEPERM 10001 +#define SOCESRCH 10003 +#define SOCEINTR 10004 +#define SOCENXIO 10006 +#define SOCEBADF 10009 +#define SOCEACCES 10013 +#define SOCEFAULT 10014 +#define SOCEINVAL 10022 +#define SOCEMFILE 10024 +#define SOCEPIPE 10032 +#define SOCEOS2ERR 10100 +#define SOCEWOULDBLOCK 10035 +#define SOCEINPROGRESS 10036 +#define SOCEALREADY 10037 +#define SOCENOTSOCK 10038 +#define SOCEDESTADDRREQ 10039 +#define SOCEMSGSIZE 10040 +#define SOCEPROTOTYPE 10041 +#define SOCENOPROTOOPT 10042 +#define SOCEPROTONOSUPPORT 10043 +#define SOCESOCKTNOSUPPORT 10044 +#define SOCEOPNOTSUPP 10045 +#define SOCEPFNOSUPPORT 10046 +#define SOCEAFNOSUPPORT 10047 +#define SOCEADDRINUSE 10048 +#define SOCEADDRNOTAVAIL 10049 +#define SOCENETDOWN 10050 +#define SOCENETUNREACH 10051 +#define SOCENETRESET 10052 +#define SOCECONNABORTED 10053 +#define SOCECONNRESET 10054 +#define SOCENOBUFS 10055 +#define SOCEISCONN 10056 +#define SOCENOTCONN 10057 +#define SOCESHUTDOWN 10058 +#define SOCETOOMANYREFS 10059 +#define SOCETIMEDOUT 10060 +#define SOCECONNREFUSED 10061 +#define SOCELOOP 10062 +#define SOCENAMETOOLONG 10063 +#define SOCEHOSTDOWN 10064 +#define SOCEHOSTUNREACH 10065 +#define SOCENOTEMPTY 10066 + + +STRINGTABLE +{ + SOCEPERM, "Not owner" + SOCESRCH, "No such process" + SOCEINTR, "Interrupted system call" + SOCENXIO, "No such device or address" + SOCEBADF, "Bad file number" + SOCEACCES, "Permission denied" + SOCEFAULT, "Bad address" + SOCEINVAL, "Invalid argument" + SOCEMFILE, "Too many open files" + SOCEPIPE, "Broken pipe" + SOCEOS2ERR, "OS/2 Error" + SOCEWOULDBLOCK, "Operation would block" + SOCEINPROGRESS, "Operation now in progress" + SOCEALREADY, "Operation already in progress" + SOCENOTSOCK, "Socket operation on non-socket" + SOCEDESTADDRREQ, "Destination address required" + SOCEMSGSIZE, "Message too long" + SOCEPROTOTYPE, "Protocol wrong type for socket" + SOCENOPROTOOPT, "Protocol not available" + SOCEPROTONOSUPPORT, "Protocol not supported" + SOCESOCKTNOSUPPORT, "Socket type not supported" + SOCEOPNOTSUPP, "Operation not supported on socket" + SOCEPFNOSUPPORT, "Protocol family not supported" + SOCEAFNOSUPPORT, "Address family not supported by protocol family" + SOCEADDRINUSE, "Address already in use" + SOCEADDRNOTAVAIL, "Can't assign requested address" + SOCENETDOWN, "Network is down" + SOCENETUNREACH, "Network is unreachable" + SOCENETRESET, "Network dropped connection on reset" + SOCECONNABORTED, "Software caused connection abort" + SOCECONNRESET, "Connection reset by peer" + SOCENOBUFS, "No buffer space available" + SOCEISCONN, "Socket is already connected" + SOCENOTCONN, "Socket is not connected" + SOCESHUTDOWN, "Can't send after socket shutdown" + SOCETOOMANYREFS, "Too many references: can't splice" + SOCETIMEDOUT, "Connection timed out" + SOCECONNREFUSED, "Connection refused" + SOCELOOP, "Too many levels of symbolic links" + SOCENAMETOOLONG, "File name too long" + SOCEHOSTDOWN, "Host is down" + SOCEHOSTUNREACH, "No route to host" + SOCENOTEMPTY, "Directory not empty" +} + diff --git a/SOURCE/ELECOM/SOCKFUNC.RES b/SOURCE/ELECOM/SOCKFUNC.RES new file mode 100644 index 0000000..272dc2d Binary files /dev/null and b/SOURCE/ELECOM/SOCKFUNC.RES differ diff --git a/SOURCE/ELECOM/TELNET.PAS b/SOURCE/ELECOM/TELNET.PAS new file mode 100644 index 0000000..dcf5485 --- /dev/null +++ b/SOURCE/ELECOM/TELNET.PAS @@ -0,0 +1,863 @@ +unit TELNET; +{$h-} +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 21-May-1998 +** Last update : 04-Apr-1999 +** +** Note: (c) 1998-1999 by Maarten Bekers +** +** Note: Same story of what we said in Win32, only we have here 2 seperate +** threads. The Write-thread has no problems, the read-thread is run +** max every 5 seconds, or whenever a carrier-check is performed. This +** carrier check is run on most BBS programs each second. You can +** optimize this by making the ReadThread a blocking select() call on +** the fd_read socket, but this can have other issues. A better approach +** on Win32 would be to call the WsaAsyncSelect() call, but this is +** non portable. +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses SockFunc, SockDef, Combase, BufUnit, Threads + + {$IFDEF WIN32} + ,Windows + {$ENDIF} + + {$IFDEF OS2} + ,Os2Base + {$ENDIF} + + {$IFDEF VirtualPascal} + ,Use32 + {$ENDIF}; + +Const WriteTimeout = 5000; { Wait max. 5 secs } + ReadTimeOut = 5000; { General event, 5 secs max } + + InBufSize = 1024 * 32; + OutBufSize = 1024 * 32; + + +type TTelnetObj = Object(TCommObj) + ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + ThreadsInitted : Boolean; + NeedNewCarrier : Boolean; + TelnetCarrier : Boolean; + + IacDontDo : Longint; { ugly hack to prevent missed IACs } + IacState : Longint; { 0 = nothing } + { 1 = received IAC } + { 2 = handing the IAC } + ClientRC : Longint; + + InBuffer : ^BufArrayObj; { Buffer system internally used } + OutBuffer : ^BufArrayObj; + + DoTxEvent : PSysEventObj; { Event manually set when we have to transmit } + DoRxEvent : PSysEventObj; { Event manually set when we need data } + + TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed } + RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed } + + CriticalTx : PExclusiveObj; { Critical sections } + CriticalRx : PExclusiveObj; + + TxThread : PThreadsObj; { The Transmit and Receive threads } + RxThread : PThreadsObj; + + EndThreads : Boolean; { Set to true when we have to end the threads } + + constructor Init; + destructor Done; + + function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; virtual; + function Com_OpenKeep(Comport: Byte): Boolean; virtual; + function Com_GetChar: Char; virtual; + function Com_PeekChar: Char; virtual; + function Com_CharAvail: Boolean; virtual; + function Com_Carrier: Boolean; virtual; + function Com_SendChar(C: Char): Boolean; virtual; + function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual; + function Com_GetBPSrate: Longint; virtual; + function Com_GetHandle: Longint; virtual; + + procedure Com_OpenQuick(Handle: Longint); virtual; + procedure Com_Close; virtual; + procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual; + procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_PeekBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual; + procedure Com_SetDtr(State: Boolean); virtual; + procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual; + procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual; + procedure Com_PurgeInBuffer; virtual; + procedure Com_PurgeOutBuffer; virtual; + + procedure Com_PauseCom(CloseCom: Boolean); virtual; + procedure Com_ResumeCom(OpenCom: Boolean); virtual; + + procedure Com_ReadProc(var TempPtr: Pointer); + procedure Com_WriteProc(var TempPtr: Pointer); + + procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual; + + function Com_StartThread: Boolean; + procedure Com_InitVars; + procedure Com_StopThread; + + function Com_SendWill(Option: Char): String; + function Com_SendWont(Option: Char): String; + function Com_SendDo(Option: Char): String; + procedure Com_SendRawStr(TempStr: String); + procedure Com_PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint); + procedure Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint); + end; { object TTelnetObj } + +Type PTelnetObj = ^TTelnetObj; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses SysUtils; + +{$IFDEF FPC} + {$I WINDEF.FPC} +{$ENDIF} + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + + +Const + { Telnet Options } + TELNET_IAC = #255; { Interpret as Command } + TELNET_DONT = #254; { Stop performing, or not expecting him to perform } + TELNET_DO = #253; { Perform, or expect him to perform } + TELNET_WONT = #252; { Refusal to perform } + TELNET_WILL = #251; { Desire to perform } + + TELNET_SB = #250; { What follow is sub-negotiation of indicated option } + TELNET_GA = #249; { Go ahead signal } + TELNET_EL = #248; { Erase Line function } + TELNET_EC = #247; { Erase Character function } + TELNET_AYT = #246; { Are You There function } + TELNET_AO = #245; { Abort Output function } + TELNET_IP = #244; { Interrupt Process function } + TELNET_BRK = #243; { NVT break character } + TELNET_DM = #242; { Data stream portion of a Synch } + TELNET_NOP = #241; { No operation } + TELNET_SE = #240; { End of sub-negotiation parameters } + TELNET_EOR = #239; { End of record } + TELNET_ABORT = #238; { Abort process } + TELNET_SUSP = #237; { Suspend current process } + TELNET_EOF = #236; { End of file } + + TELNETOPT_BINARY = #0; { Transmit binary } + TELNETOPT_ECHO = #1; { Echo mode } + TELNETOPT_SUPGA = #3; { Suppress Go-Ahead } + TELNETOPT_TERM = #24; { Terminal Type } + TELNETOPT_SPEED = #32; { Terminal Speed } + TELNETOPT_FLOWCNT= #33; { Toggle flow-control } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TTelnetObj.Init; +begin + inherited Init; + + ThreadsInitted := false; + NeedNewCarrier := true; + TelnetCarrier := TRUE; + IacState := 0; { default to none } + Com_InitVars; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TTelnetObj.Done; +begin + inherited done; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_SendRawStr(TempStr: String); +var BytesSnt: Longint; + TmpByte : Longint; + BufFlag : Longint; + TmpError: Longint; +begin + BufFlag := 00; + TmpByte := 01; + + REPEAT + BytesSnt := SockSend(ClientRC, + @TempStr[TmpByte], + Length(TempStr), + BufFlag); + + if BytesSnt > 0 then + Inc(TmpByte, BytesSnt) + else begin + TmpError := SockErrorNo; + if TmpError <> WSAEWOULDBLOCK then EXIT; + end; { else } + + UNTIL (TmpByte > Length(TempStr)); +end; { proc. Com_SendRawStr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_SendWill(Option: Char): String; +begin + Result[1] := TELNET_IAC; + Result[2] := TELNET_WILL; + Result[3] := Option; + SetLength(Result, 3); +end; { func. Com_SendWill } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_SendWont(Option: Char): String; +begin + Result[1] := TELNET_IAC; + Result[2] := TELNET_WONT; + Result[3] := Option; + SetLength(Result, 3); +end; { func. Com_SendWont } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_SendDo(Option: Char): String; +begin + Result[1] := TELNET_IAC; + Result[2] := TELNET_DO; + Result[3] := Option; + SetLength(Result, 3); +end; { func. Com_SendDo } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint); +var Counter : Longint; +begin + Counter := 00; + if BlockLen = 0 then EXIT; + + While Counter <= (Blocklen - 01) do + begin + {-- and now handle the IAC state ---------------------------------------} + Case IacState of + 1 : begin { DO / DONT } + {-- we received an IAC, and this is the next char --------------} + if CurBuffer[Counter] = TELNET_IAC then + begin + TempOut.Put(CurBuffer[Counter], 1); + IacState := 0; { reset parser state } + end + else begin + IacState := 2; + + Case CurBuffer[Counter] of + TELNET_DONT, + TELNET_DO : IacDontDo := 1; + else IacDontDo := 0; + end; { case } + end; { else } + end; { DO/DONT } + 2 : begin { WHAT } +{ if IacDontDo = 1 then } + begin + Case CurBuffer[Counter] of + TELNETOPT_BINARY, + TELNETOPT_SUPGA, + TELNETOPT_ECHO : begin + Com_SendRawStr(Com_SendWill(CurBuffer[Counter])); + end + else begin + Com_SendRawStr(Com_SendWont(CurBuffer[Counter])); + end; { if } + end; { case } + end; { if this is a state we will reply to } + + IacState := 0; { reset IAC state machine } + end; { WHAT } + else begin + if CurBuffer[Counter] = TELNET_IAC then + begin + IacState := 1 + end + else TempOut.Put(CurBuffer[Counter], 1); + end; { else } + end; { case } + + {-- and loop through the buffer ----------------------------------------} + Inc(Counter); + end; { while } + +end; { proc. Com_PrepareBufferRead } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint); +var Counter : Longint; + NewCounter: Longint; +begin + Counter := 00; + NewCounter := 00; + if BlockLen = 0 then EXIT; + + While Counter <= Blocklen do + begin + Case CurBuffer[Counter] of + TELNET_IAC : begin { Escape command character } + TmpOutBuffer[NewCounter] := TELNET_IAC; + Inc(NewCounter); + TmpOutBuffer[NewCounter] := TELNET_IAC; + Inc(NewCounter); + end; { if } + else begin + TmpOutBuffer[NewCounter] := CurBuffer[Counter]; + Inc(NewCounter); + end; { if } + end; { case } + + Inc(Counter); + end; { while } + + BlockLen := NewCounter - 1; +end; { proc. Com_PrepareBufferWrite } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_ReadProc(var TempPtr: Pointer); +var Available : Boolean; + BytesRead : Longint; + BlockLen : Longint; + ReturnCode: Longint; +begin + repeat + if DoRxEvent^.WaitForEvent(ReadTimeOut) then + if NOT EndThreads then + begin + CriticalRx^.EnterExclusive; + Available := (SockSelect(ClientRC) > 00); + + DoRxEvent^.ResetEvent; + + if (Available) OR (NeedNewCarrier) then + begin + {----------- Start reading the gathered date -------------------} + NeedNewCarrier := false; + + if InBuffer^.BufRoom > 0 then + begin + BlockLen := InBuffer^.BufRoom; + if BlockLen > 1024 then + BlockLen := 1024; + + if BlockLen > 00 then + begin + BytesRead := SockRecv(ClientRC, + @InBuffer^.TmpBuf, + BlockLen, + 0); + + if BytesRead = 0 then + begin + TelnetCarrier := false; + + ReturnCode := SockErrorNo; + + ErrorStr := 'Error in communications(1), #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode); + end; { if } + + if BytesRead = -1 then + begin + ReturnCode := SockErrorNo; + + if ReturnCode <> WSAEWOULDBLOCK then + begin + TelnetCarrier := false; + + ErrorStr := 'Error in communications(2), #'+IntToStr(ReturnCode)+ ' / '+SysErrorMessage(ReturnCode); + EndThreads := true; + end; { if } + end; { error } + + if BytesRead > 00 then + begin + Com_PrepareBufferRead(InBuffer^.TmpBuf, InBuffer^, BytesRead); + end; { if } + end; { if } + end; { if } + end; { if available } + + CriticalRx^.LeaveExclusive; + end; { if RxEvent } + until EndThreads; + + RxClosedEvent^.SignalEvent; + ExitThisThread; +end; { proc. Com_ReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_WriteProc(var TempPtr: Pointer); +var BlockLen : Longint; + Written : Longint; + ReturnCode : Longint; + TempBuf : ^CharBufType; +begin + New(TempBuf); + + repeat + if DoTxEvent^.WaitForEvent(WriteTimeOut) then + if NOT EndThreads then + begin + CriticalTx^.EnterExclusive; + DoTxEvent^.ResetEvent; + + if OutBuffer^.BufUsed > 00 then + begin + BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false); + + Com_PrepareBufferWrite(OutBuffer^.TmpBuf, TempBuf^, BlockLen); + Written := SockSend(ClientRC, + TempBuf, + BlockLen, + 0); + {-- remove the data from the buffer, but only remove the data ---} + {-- thats actually written --------------------------------------} + ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true); + + if ReturnCode <> Longint(Written) then + begin + { not everything is removed! } + end; { if } + + {-- if theres data in the buffer left, run this event again -----} + if Written <> BlockLen then + begin + DoTxEvent^.SignalEvent; + end; { if } + end; { if } + + CriticalTx^.LeaveExclusive; + end; { if } + + until EndThreads; + + Dispose(TempBuf); + + TxClosedEvent^.SignalEvent; + ExitThisThread; +end; { proc. Com_WriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_StartThread: Boolean; +begin + Result := false; + EndThreads := false; + if ThreadsInitted then EXIT; + ThreadsInitted := true; + + {----------------------- Create all the events ----------------------------} + New(DoTxEvent, Init); + if NOT DoTxEvent^.CreateEvent(false) then EXIT; + + New(DoRxEvent, Init); + if NOT DoRxEvent^.CreateEvent(false) then EXIT; + + New(RxClosedEvent, Init); + if NOT RxClosedEvent^.CreateEvent(false) then EXIT; + + New(TxClosedEvent, Init); + if NOT TxClosedEvent^.CreateEvent(false) then EXIT; + + {-------------- Startup the buffers and overlapped events -----------------} + New(InBuffer, Init(InBufSize)); + New(OutBuffer, Init(OutBufSize)); + + {-------------------- Startup a seperate write thread ---------------------} + New(CriticalTx, Init); + CriticalTx^.CreateExclusive; + + New(TxThread, Init); + if NOT TxThread^.CreateThread(16384, { Stack size } + WriteProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + {-------------------- Startup a seperate read thread ----------------------} + New(CriticalRx, Init); + CriticalRx^.CreateExclusive; + + New(RxThread, Init); + if NOT RxThread^.CreateThread(16384, { Stack size } + ReadProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + Result := true; +end; { proc. Com_StartThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_InitVars; +begin + DoTxEvent := nil; + DoRxEvent := nil; + RxClosedEvent := nil; + TxClosedEvent := nil; + TxThread := nil; + RxThread := nil; + + InBuffer := nil; + OutBuffer := nil; + CriticalRx := nil; + CriticalTx := nil; +end; { proc. Com_InitVars } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_StopThread; +begin + EndThreads := true; + ThreadsInitted := false; + + if DoTxEvent <> nil then DoTxEvent^.SignalEvent; + if DoTxEvent <> nil then DoRxEvent^.SignalEvent; + + if TxThread <> nil then TxThread^.CloseThread; + if RxThread <> nil then RxThread^.CloseThread; + + if TxClosedEvent <> nil then + if NOT TxClosedEvent^.WaitForEvent(1000) then + TxThread^.TerminateThread(0); + + if RxClosedEvent <> nil then + if NOT RxClosedEvent^.WaitForEvent(1000) then + RxThread^.TerminateThread(0); + + if TxThread <> nil then Dispose(TxThread, Done); + if RxThread <> nil then Dispose(RxThread, Done); + + if DoTxEvent <> nil then Dispose(DoTxEvent, Done); + if DoRxEvent <> nil then Dispose(DoRxEvent, Done); + if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done); + if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done); + + if CriticalTx <> nil then Dispose(CriticalTx, Done); + if CriticalRx <> nil then Dispose(CriticalRx, Done); + + if InBuffer <> nil then Dispose(InBuffer, Done); + if OutBuffer <> nil then Dispose(OutBuffer, Done); + + Com_InitVars; +end; { proc. Com_StopThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_GetHandle: Longint; +begin + Result := ClientRC; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_OpenQuick(Handle: Longint); +var ReturnCode: Longint; +begin + ClientRC := Handle; + + if (NOT (SockInit=0)) then + begin + ReturnCode := SockErrorNo; + + ErrorStr := 'Error in initializing socket, #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode); + InitFailed := true; + end + else InitFailed := NOT Com_StartThread; + + { Set the telnet to binary transmission } + Com_SendRawStr(Com_SendWill(TELNETOPT_ECHO)); + Com_SendRawStr(Com_SendWill(TELNETOPT_BINARY)); +end; { proc. TTelnetObj.Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_OpenKeep(Comport: Byte): Boolean; +begin + InitFailed := NOT Com_StartThread; + Com_OpenKeep := InitFailed; +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + Com_Open := true; +end; { func. TTelnetObj.Com_OpenCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +begin + // Duhhh ;) +end; { proc. TTelnetObj.Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_Close; +begin + if DontClose then EXIT; + + if ClientRC <> -1 then + begin + Com_StopThread; + SockShutdown(ClientRC, 02); + SockClose(ClientRC); + + ClientRC := -1; + end; { if } + +end; { func. TTelnetObj.Com_CloseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_SendChar(C: Char): Boolean; +var Written: Longint; +begin + Com_SendBlock(C, SizeOf(C), Written); + Com_SendChar := (Written = SizeOf(c)); +end; { proc. TTelnetObj.Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_GetChar: Char; +var Reads: Longint; +begin + Com_ReadBlock(Result, SizeOf(Result), Reads); +end; { func. TTelnetObj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_PeekChar: Char; +var Reads: Longint; +begin + Com_PeekBlock(Result, SizeOf(Result), Reads); +end; { func. TTelnetObj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +begin + if OutBuffer^.BufRoom < BlockLen then + repeat + {$IFDEF WIN32} + Sleep(1); + {$ENDIF} + + {$IFDEF OS2} + DosSleep(1); + {$ENDIF} + until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier); + + CriticalTx^.EnterExclusive; + Written := OutBuffer^.Put(Block, BlockLen); + CriticalTx^.LeaveExclusive; + + DoTxEvent^.SignalEvent; +end; { proc. TTelnetObj.Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin + if InBuffer^.BufUsed < BlockLen then + begin + DoRxEvent^.SignalEvent; + + repeat + {$IFDEF OS2} + DosSleep(1); + {$ENDIF} + + {$IFDEF WIN32} + Sleep(1); + {$ENDIF} + + if Com_CharAvail then + DoRxEvent^.SignalEvent; + until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier); + end; { if } + + Reads := InBuffer^.Get(Block, BlockLen, true); +end; { proc. TTelnetObj.Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_PeekBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin + if InBuffer^.BufUsed < BlockLen then + begin + DoRxEvent^.SignalEvent; + + repeat + {$IFDEF OS2} + DosSleep(1); + {$ENDIF} + + {$IFDEF WIN32} + Sleep(1); + {$ENDIF} + + if Com_CharAvail then + DoRxEvent^.SignalEvent; + until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier); + end; { if } + + Reads := InBuffer^.Get(Block, BlockLen, false); +end; { proc. TTelnetObj.Com_PeekBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_CharAvail: Boolean; +begin + if InBuffer^.BufUsed < 1 then + begin + if (SockSelect(ClientRC) > 0) then + DoRxEvent^.SignalEvent; + end; { if } + + Result := (InBuffer^.BufUsed > 0); +end; { func. TTelnetObj.Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_Carrier: Boolean; +begin + if TelnetCarrier then { Carrier is only lost in 'read' sections } + begin + DoRxEvent^.SignalEvent; + NeedNewCarrier := true; + end; { if } + + Result := TelnetCarrier; +end; { func. TTelnetObj.Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +begin + LineStatus := 00; + ModemStatus := 08; + + if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7); +end; { proc. TTelnetObj.Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_SetDtr(State: Boolean); +begin + if NOT State then + begin + Com_Close; + end; { if } +end; { proc. TTelnetObj.Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_GetBpsRate: Longint; +begin + Com_GetBpsRate := 115200; +end; { func. TTelnetObj.Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +begin + DoRxEvent^.SignalEvent; + DoTxEvent^.SignalEvent; + + InFree := InBuffer^.BufRoom; + OutFree := OutBuffer^.BufRoom; + InUsed := InBuffer^.BufUsed; + OutUsed := OutBuffer^.BufUsed; +end; { proc. TTelnetObj.Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_PurgeInBuffer; +begin + CriticalRx^.EnterExclusive; + + InBuffer^.Clear; + + CriticalRx^.LeaveExclusive; +end; { proc. TTelnetObj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_PurgeOutBuffer; +begin + CriticalTx^.EnterExclusive; + + OutBuffer^.Clear; + + CriticalTx^.LeaveExclusive; +end; { proc. TTelnetObj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TTelnetObj.Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Result := OutBuffer^.BufRoom >= BlockLen; +end; { func. ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_PauseCom(CloseCom: Boolean); +begin + if CloseCom then Com_Close + else Com_StopThread; +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_ResumeCom(OpenCom: Boolean); +begin + if OpenCom then Com_OpenKeep(0) + else Com_StartThread; +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TTelnetObj.Com_SetDataProc(ReadPtr, WritePtr: Pointer); +begin + ReadProcPtr := ReadPtr; + WriteProcPtr := WritePtr; +end; { proc. Com_SetDataProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/THREADS.PAS b/SOURCE/ELECOM/THREADS.PAS new file mode 100644 index 0000000..2928452 --- /dev/null +++ b/SOURCE/ELECOM/THREADS.PAS @@ -0,0 +1,421 @@ +unit THREADS; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.12 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 07-Mar-1999 +** Last update : 26-Sep-1999 +** +** Note: (c) 1998-1999 by Maarten Bekers +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +{$IFDEF OS2} + uses Os2Base; +{$ENDIF} + +{$IFDEF WIN32} + uses Windows; +{$ENDIF} + +{$IFDEF OS2} + Type THandle = Longint; + DWORD = Longint; +{$ENDIF} + +{$IFDEF WIN32} + {$IFDEF FPC} + Type THandle = Handle; + {$ENDIF} +{$ENDIF} + +type TSysEventObj = Object + {$IFDEF OS2} + SemHandle: HEV; + {$ENDIF} + + {$IFDEF WIN32} + SemHandle: THandle; + {$ENDIF} + + constructor init; + destructor done; + + procedure DisposeEvent; + procedure SignalEvent; + procedure ResetEvent; + function CreateEvent(InitialState: Boolean): Boolean; + function WaitForEvent(TimeOut: Longint): Boolean; + end; { TSysEventObj } + +Type PSysEventObj = ^TSysEventObj; + +type TExclusiveObj = Object + {$IFDEF OS2} + Exclusive: PHMtx; + {$ENDIF} + + {$IFDEF WIN32} + Exclusive: PRTLCriticalSection; + {$ENDIF} + + constructor Init; + destructor Done; + + procedure CreateExclusive; + procedure DisposeExclusive; + + procedure EnterExclusive; + procedure LeaveExclusive; + end; { TExclusiveObj } + +Type PExclusiveObj = ^TExclusiveObj; + + +type TThreadsObj = Object + ThreadHandle : THandle; + ThreadID : DWORD; + ThreadClosed : Boolean; + + constructor Init; + destructor Done; + + function CreateThread(StackSize : Longint; + CallProc, + Parameters : Pointer; + CreationFlags: Longint): Boolean; + procedure CloseThread; + procedure TerminateThread(ExitCode: Longint); + end; { TThreadsObj } + +Type PThreadsObj = ^TThreadsObj; + +procedure ExitThisThread; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TSysEventObj.Init; +begin + SemHandle := 0; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TSysEventObj.Done; +begin + if Longint(SemHandle) <> -1 then + begin + SignalEvent; + DisposeEvent; + end; { if } +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TSysEventObj.CreateEvent(InitialState: Boolean): Boolean; +{$IFDEF OS2} +var Returncode: longint; +{$ENDIF} +begin + CreateEvent := true; + + {$IFDEF WIN32} + SemHandle := Windows.CreateEvent(nil, true, InitialState, nil); + if Longint(SemHandle) = -1 then CreateEvent := false; + {$ENDIF} + + {$IFDEF OS2} + returncode := DosCreateEventSem(nil, SemHandle, 0, InitialState); + CreateEvent := (returncode=0); + {$ENDIF} +end; { func. CreateEvent } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TSysEventObj.SignalEvent; +{$IFDEF OS2} +var RC: Longint; +{$ENDIF} +begin + {$IFDEF WIN32} + if Longint(SemHandle) <> -1 then + SetEvent(SemHandle); + {$ENDIF} + + {$IFDEF OS2} + if SemHandle <> -1 then + RC := DosPostEventSem(SemHandle); + {$ENDIF} +end; { proc. SignalEvent } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TSysEventObj.ResetEvent; +{$IFDEF OS2} +var Flag: Longint; + RC : Longint; +{$ENDIF} +begin + {$IFDEF WIN32} + if SemHandle <> THandle(-1) then + Windows.ResetEvent(SemHandle); + {$ENDIF} + + {$IFDEF OS2} + Flag := 0; + if SemHandle <> -1 then + RC := DosResetEventSem(SemHandle, Flag); + {$ENDIF} +end; { proc. ResetEvent } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TSysEventObj.WaitForEvent(TimeOut: Longint): Boolean; +var ReturnCode: Longint; +{$IFDEF OS2} + Flag : Longint; +{$ENDIF} +begin + {$IFDEF WIN32} + if SemHandle <> THandle(-1) then + ReturnCode := WaitForSingleObject(SemHandle, Timeout) + else ReturnCode := 0; + + WaitForEvent := (ReturnCode = WAIT_OBJECT_0); + {$ENDIF} + + {$IFDEF OS2} + if SemHandle <> -1 then + ReturnCode := DosWaitEventSem(SemHandle, TimeOut); + + Flag := 0; + DosResetEventSem(SemHandle, Flag); + WaitForEvent := (ReturnCode = 0); +{$ENDIF} +end; { func. WaitForEvent } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TSysEventObj.DisposeEvent; +{$IFDEF OS2} +var Flag: Longint; +{$ENDIF} +begin + {$IFDEF WIN32} + if SemHandle <> THandle(-1) then CloseHandle(SemHandle); + SemHandle := 0; + {$ENDIF} + + {$IFDEF OS2} + Flag := 0; + if SemHandle <> -1 then DosCloseEventSem(SemHandle); + SemHandle := -1; + {$ENDIF} +end; { proc. DisposeEvent } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TExclusiveObj.Init; +begin + Exclusive := nil; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TExclusiveObj.Done; +begin + if Exclusive <> nil then + DisposeExclusive; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TExclusiveObj.CreateExclusive; +begin + {$IFDEF WIN32} + New(Exclusive); + InitializeCriticalSection(Exclusive^); + {$ENDIF} + + {$IFDEF OS2} + New(Exclusive); + DosCreateMutexSem(nil, Exclusive^, dcmw_Wait_All, false); + {$ENDIF} +end; { proc. CreateExclusive } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TExclusiveObj.DisposeExclusive; +begin + {$IFDEF WIN32} + if Exclusive <> nil then + begin + DeleteCriticalSection(Exclusive^); + Dispose(Exclusive); + end; { if } + + Exclusive := nil; + {$ENDIF} + + {$IFDEF OS2} + if Exclusive <> nil then + begin + DosCloseMutexSem(Exclusive^); + Dispose(Exclusive); + end; { if } + + Exclusive := nil; + {$ENDIF} +end; { proc. DisposeExclusive } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TExclusiveObj.EnterExclusive; +begin + {$IFDEF WIN32} + EnterCriticalSection(Exclusive^); + {$ENDIF} + + {$IFDEF OS2} + DosRequestMutexSem(Exclusive^, sem_Indefinite_Wait); + {$ENDIF} +end; { proc. EnterExclusive } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TExclusiveObj.LeaveExclusive; +begin + {$IFDEF WIN32} + LeaveCriticalSection(Exclusive^); + {$ENDIF} + + {$IFDEF OS2} + DosReleaseMutexSem(Exclusive^); + {$ENDIF} +end; { proc. LeaveExclusive } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TThreadsObj.Init; +begin + ThreadHandle := 0; + ThreadId := 0; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TThreadsObj.Done; +begin + CloseThread; + ThreadHandle := 0; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TThreadsObj.CreateThread(StackSize : Longint; + CallProc, + Parameters : Pointer; + CreationFlags: Longint): Boolean; +var ReturnCode: Longint; +begin + ThreadClosed := FALSE; + + {$IFNDEF VirtualPascal} + {$IFDEF WIN32} + ThreadHandle := Windows.CreateThread(nil, { Security attrs } + StackSize, { Stack size } + CallProc, { Actual procedure } + Parameters, { Parameters } + CreationFlags, { Creation flags } + ThreadID); { Thread ID ?? } + + CreateThread := (ThreadHandle <> THandle(-1)); + {$ENDIF} + + {$IFDEF OS2} + ReturnCode := + DosCreateThread(ThreadHandle, { ThreadHandle } + CallProc, { Actual procedure } + Longint(Parameters), { Parameters } + CreationFlags, { Creation flags } + StackSize); { Stacksize } + + CreateThread := (ReturnCode = 0); + if ReturnCode <> 0 then ThreadHandle := -1; + {$ENDIF} + + {$IFDEF LINUX} + + {$ENDIF} + + + {$ELSE} + ThreadHandle := BeginThread(nil, StackSize, CallProc, Parameters, 0, ReturnCode); + CreateThread := (ThreadHandle > THandle(-1)); + {$ENDIF} +end; { proc. CreateThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TThreadsObj.CloseThread; +begin + ThreadClosed := TRUE; + + {$IFDEF WIN32} + if ThreadHandle <> Thandle(-1) then CloseHandle(ThreadHandle); + ThreadHandle := 0; + {$ENDIF} + + {$IFDEF OS2} + {!! DosClose() on a ThreadHandle doesn't work - will eventually close } + {!! other handles ... } + { if ThreadHandle <> -1 then DosClose(ThreadHandle); } + ThreadHandle := -1; + {$ENDIF} +end; { proc. CloseThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TThreadsObj.TerminateThread(ExitCode: Longint); +begin + ThreadClosed := TRUE; + + {$IFDEF WIN32} + if ThreadHandle <> Thandle(-1) then + Windows.TerminateThread(ThreadHandle, ExitCode); + ThreadHandle := 00; + {$ENDIF} + + {$IFDEF OS2} + if ThreadHandle <> -1 then DosKillThread(ThreadHandle); + ThreadHandle := -1; + {$ENDIF} +end; { proc. TerminateThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure ExitThisThread; +begin + {$IFDEF WIN32} + Windows.ExitThread(0); + {$ENDIF} + + {$IFDEF OS2} + Os2Base.DosExit(exit_Thread, 0); + {$ENDIF} +end; { proc. ExitThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/W32SNGL.PAS b/SOURCE/ELECOM/W32SNGL.PAS new file mode 100644 index 0000000..c1afec6 --- /dev/null +++ b/SOURCE/ELECOM/W32SNGL.PAS @@ -0,0 +1,824 @@ +unit W32SNGL; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.1, (OS/2, Win32) +** FreePascal v0.99.15 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.02 +** Created : 09-Sep-1999 +** Last update : 21-Jul-2001 +** +** Note: (c) 1998-2000 by Maarten Bekers +** +** Note2: The problem with this approach that we only retrieve the data when +** we want to. If data arrives and we dont call either Com_ReadBlock(), +** Com_CharAvail or Com_GetBufferStatus() we dont receive the data. +** Therefore, we rely on Windows to actually buffer the data. We do this +** by calling SetupComm() with the buffer-sizes as defined by +** Win32OutBufSize and Win32InBufSize. +** If you want to avoid this, you can implement another mutex that you +** let set by Win32's API calls SetEventMask() and WaitCommEvent(). +** That way, you can also monitor other events which would eliminate +** some overhead. In general, this approach will suffice. +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses Windows, Combase, BufUnit, Threads + {$IFDEF VirtualPascal} + ,Use32 + {$ENDIF}; + +Const DataTimeout = 20000; { Wait max. 20 secs } + + InBufSize = 1024 * 32; + OutBufSize = 1024 * 32; + Win32OutBufSize = 1024 * 3; + Win32InBufSize = 1024 * 3; + + +type TWin32Obj = Object(TCommObj) + DataProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + ThreadsInitted: Boolean; { Are the thread(s) up and running? } + + SaveHandle : THandle; + + InitPortNr : Longint; + InitHandle : Longint; + + ReadOL : TOverLapped; { Overlapped structure for ReadFile } + WriteOL : TOverLapped; { Overlapped structure for WriteFile } + + InBuffer : ^BufArrayObj; { Buffer system internally used } + OutBuffer : ^BufArrayObj; + + ReadEvent : PSysEventObj; { Event set by ReadFile overlapped routine } + WriteEvent : PSysEventObj; { Event set by WriteFile overlapped routine } + + DoTxEvent : PSysEventObj;{ Event manually set when we have to transmit } + DoRxEvent : PSysEventObj; { Event manually set when we want data } + + DataClosedEvent: PSysEventObj; { Event set when the Tx thread is closed } + + CriticalTx : PExclusiveObj; { Critical sections } + CriticalRx : PExclusiveObj; + + DataThread : PThreadsObj; + EndThreads : Boolean; { Set to true when we have to end the threads } + + + constructor Init; + destructor Done; + + function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; virtual; + function Com_OpenKeep(Comport: Byte): Boolean; virtual; + function Com_GetChar: Char; virtual; + function Com_CharAvail: Boolean; virtual; + function Com_Carrier: Boolean; virtual; + function Com_SendChar(C: Char): Boolean; virtual; + function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual; + function Com_GetBPSrate: Longint; virtual; + function Com_GetHandle: Longint; virtual; + + procedure Com_OpenQuick(Handle: Longint); virtual; + procedure Com_Close; virtual; + procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual; + procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual; + procedure Com_SetDtr(State: Boolean); virtual; + procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual; + procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual; + procedure Com_PurgeInBuffer; virtual; + procedure Com_PurgeOutBuffer; virtual; + procedure Com_FlushOutBuffer(Slice: SliceProc); virtual; + + procedure Com_PauseCom(CloseCom: Boolean); virtual; + procedure Com_ResumeCom(OpenCom: Boolean); virtual; + procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual; + + procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual; + procedure Com_DataProc(var TempPtr: Pointer); virtual; + + function Com_StartThread: Boolean; + procedure Com_InitVars; + procedure Com_StopThread; + procedure Com_InitDelayTimes; + end; { object TWin32Obj } + +type PWin32Obj = ^TWin32Obj; + + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses SysUtils; + +{$IFDEF FPC} + {$I WINDEF.FPC} +{$ENDIF} + +const + dcb_Binary = $00000001; + dcb_ParityCheck = $00000002; + dcb_OutxCtsFlow = $00000004; + dcb_OutxDsrFlow = $00000008; + dcb_DtrControlMask = $00000030; + dcb_DtrControlDisable = $00000000; + dcb_DtrControlEnable = $00000010; + dcb_DtrControlHandshake = $00000020; + dcb_DsrSensivity = $00000040; + dcb_TXContinueOnXoff = $00000080; + dcb_OutX = $00000100; + dcb_InX = $00000200; + dcb_ErrorChar = $00000400; + dcb_NullStrip = $00000800; + dcb_RtsControlMask = $00003000; + dcb_RtsControlDisable = $00000000; + dcb_RtsControlEnable = $00001000; + dcb_RtsControlHandshake = $00002000; + dcb_RtsControlToggle = $00003000; + dcb_AbortOnError = $00004000; + dcb_Reserveds = $FFFF8000; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TWin32Obj.Init; +begin + inherited Init; + + InitPortNr := -1; + InitHandle := -1; + ThreadsInitted := false; + Com_Initvars; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TWin32Obj.Done; +begin + inherited done; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_DataProc(var TempPtr: Pointer); +var Success : Boolean; + Props : TCommProp; + ObjectCode : Longint; + ReturnCode : Longint; + DidRead : DWORD; + Written : DWORD; + BlockLen : DWORD; + ObjectArray : Array[0..1] of THandle; + TryReading : Boolean; + Stats : TComStat; + ErrMask : DWORD; +begin + ObjectArray[0] := DoTxEvent^.SemHandle; + ObjectArray[1] := DoRxEvent^.SemHandle; + + repeat + ObjectCode := WaitForMultipleObjects(2, + @ObjectArray, + false, + DataTimeOut); + if EndThreads then EXIT; + + {-----------------------------------------------------------------------} + {-------------------------- Receive signalled --------------------------} + {-----------------------------------------------------------------------} + if (ObjectCode - WAIT_OBJECT_0) = 1 then { DoReceive } + begin + DidRead := 00; + if (EndThreads) then EXIT; + + {-- Make sure there is something to be read ------------------------} + ErrMask := 0; + TryReading := FALSE; + + if ClearCommError(SaveHandle, ErrMask, @Stats) then + if Stats.cbInQue > 0 then + TryReading := TRUE; + + + {----------------- Start reading the gathered date -----------------} + if TryReading then + begin + CriticalRx^.EnterExclusive; + + FillChar(Props, SizeOf(TCommProp), 0); + if GetCommProperties(SaveHandle, Props) then + if InBuffer^.BufRoom > 0 then + begin + BlockLen := Props.dwCurrentRxQueue; + { We want the complete BUFFER size, and not } + { the actual queue size. The queue may have } + { grown since last query, and we always } + { want as much data as possible } + + if Longint(BlockLen) > InBuffer^.BufRoom then + BlockLen := InBuffer^.BufRoom; + + Success := ReadFile(SaveHandle, + InBuffer^.TmpBuf, + BlockLen, + DidRead, + @ReadOL); + + if NOT Success then + begin + ReturnCode := GetLastError; + + if ReturnCode = ERROR_IO_PENDING then + begin + ReturnCode := WaitForSingleObject(ReadOL.hEvent, DataTimeOut); + + if ReturnCode = WAIT_OBJECT_0 then + begin + GetOverLappedResult(SaveHandle, ReadOL, DidRead, false); + end; { if } + end; { if } + end + else GetOverlappedResult(SaveHandle, ReadOL, DidRead, false); + + if DidRead > 00 then + begin + InBuffer^.Put(InBuffer^.TmpBuf, DidRead); + DoRxEvent^.ResetEvent; + end; { if } + end; { if } + + CriticalRx^.LeaveExclusive; + end; { try reading } + end; { DoReceive call } + + {-----------------------------------------------------------------------} + {-------------------------- Transmit signalled -------------------------} + {-----------------------------------------------------------------------} + if (ObjectCode - WAIT_OBJECT_0) = 0 then { DoTransmit } + begin + CriticalTx^.EnterExclusive; + DoTxEvent^.ResetEvent; + + if OutBuffer^.BufUsed > 00 then + begin + Written := 00; + BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false); + + Success := WriteFile(SaveHandle, + OutBuffer^.TmpBuf, + BlockLen, + Written, + @WriteOL); + if NOT Success then + begin + ReturnCode := GetLastError; + + if ReturnCode = ERROR_IO_PENDING then + begin + ReturnCode := WaitForSingleObject(WriteOL.hEvent, DataTimeOut); + + if ReturnCode = WAIT_OBJECT_0 then + begin + if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then + begin + ResetEvent(WriteOL.hEvent); + end; { if } + end; { if } + end; { result is pending } + end { if } + else begin + + if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then + begin + ResetEvent(WriteOL.hEvent); + end; { if } + end; { if (did succeed) } + + {-- remove the data from the buffer, but only remove the data ---} + {-- thats actually written --------------------------------------} + ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true); + if ReturnCode <> Longint(Written) then + begin + { not everything is removed! } + end; { if } + + {-- if theres data in the buffer left, run this event again -----} + if Written <> BlockLen then + DoTxEvent^.SignalEvent; + end; { if } + + CriticalTx^.LeaveExclusive; + end; { DoTransmit call } + + + until EndThreads; + + DataClosedEvent^.SignalEvent; + ExitThisThread; +end; { proc. ComDataProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_StartThread: Boolean; +begin + Result := false; + EndThreads := false; + if ThreadsInitted then EXIT; + ThreadsInitted := true; + + {----------------------- Create all the events ----------------------------} + New(ReadEvent, Init); + if NOT ReadEvent^.CreateEvent(true) then EXIT; + + New(WriteEvent, Init); + if NOT WriteEvent^.CreateEvent(true) then EXIT; + + New(DoTxEvent, Init); + if NOT DoTxEvent^.CreateEvent(false) then EXIT; + + New(DoRxEvent, Init); + if NOT DoRxEvent^.CreateEvent(false) then EXIT; + + New(DataClosedEvent, Init); + if NOT DataClosedEvent^.CreateEvent(false) then EXIT; + + {-------------- Startup the buffers and overlapped events -----------------} + FillChar(WriteOL, SizeOf(tOverLapped), 0); + FillChar(ReadOL, SizeOf(tOverLapped), 0); + WriteOl.hEvent := WriteEvent^.SemHandle; + ReadOl.hEvent := ReadEvent^.SemHandle; + + New(InBuffer, Init(InBufSize)); + New(OutBuffer, Init(OutBufSize)); + + {-------------------- Startup the critical section objects ----------------} + New(CriticalTx, Init); + CriticalTx^.CreateExclusive; + + New(CriticalRx, Init); + CriticalRx^.CreateExclusive; + + {-------------------- Startup a seperate tx / rx thread -------------------} + New(DataThread, Init); + if NOT DataThread^.CreateThread(16384, { Stack size } + DataProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + Result := true; +end; { proc. Com_StartThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_InitVars; +begin + DoTxEvent := nil; + DoRxEvent := nil; + DataClosedEvent := nil; + DataThread := nil; + ReadEvent := nil; + WriteEvent := nil; + + InBuffer := nil; + OutBuffer := nil; + CriticalRx := nil; + CriticalTx := nil; +end; { proc. Com_InitVars } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_StopThread; +begin + EndThreads := true; + ThreadsInitted := false; + + if DoTxEvent <> nil then DoTxEvent^.SignalEvent; + if DoTxEvent <> nil then DoRxEvent^.SignalEvent; + if DataThread <> nil then DataThread^.CloseThread; + + if DataClosedEvent <> nil then + if NOT DataClosedEvent^.WaitForEvent(1000) then + DataThread^.TerminateThread(0); + + if DataThread <> nil then Dispose(DataThread, Done); + if DoTxEvent <> nil then Dispose(DoTxEvent, Done); + if DoRxEvent <> nil then Dispose(DoRxEvent, Done); + if DataClosedEvent <> nil then Dispose(DataClosedEvent, Done); + if ReadEvent <> nil then Dispose(ReadEvent, Done); + if WriteEvent <> nil then Dispose(WriteEvent, Done); + + if CriticalTx <> nil then Dispose(CriticalTx, Done); + if CriticalRx <> nil then Dispose(CriticalRx, Done); + + if InBuffer <> nil then Dispose(InBuffer, Done); + if OutBuffer <> nil then Dispose(OutBuffer, Done); + + Com_InitVars; +end; { proc. Com_StopThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_InitDelayTimes; +var CommTimeOut: TCommTimeouts; + RC : Longint; +begin + FillChar(CommTimeOut, SizeOf(TCommTimeOuts), 00); + CommTimeOut.ReadIntervalTimeout := MAXDWORD; + + if NOT SetCommTimeOuts(SaveHandle, CommTimeOut) then + begin + RC := GetLastError; + ErrorStr := 'Error setting communications timeout: #'+IntToStr(RC) + ' / ' + SysErrorMessage(rc); + end; { if } + +end; { proc. InitDelayTimes } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_GetHandle: Longint; +begin + Result := SaveHandle; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_OpenQuick(Handle: Longint); +var LastError: Longint; +begin + SaveHandle := Handle; + InitHandle := Handle; + + FillChar(ReadOl, SizeOf(ReadOl), 00); + FillChar(WriteOl, SizeOf(WriteOl), 00); + + if NOT SetupComm(Com_GetHandle, Win32InBufSize, Win32OutBufSize) then + begin + LastError := GetLastError; + + ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); + end; { if } + + Com_InitDelayTimes; + InitFailed := NOT Com_StartThread; + Com_SetLine(-1, 'N', 8, 1); +end; { proc. TWin32Obj.Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_OpenKeep(Comport: Byte): Boolean; +var TempSave : THandle; + Security : TSECURITYATTRIBUTES; + LastError : Longint; +begin + InitPortNr := Comport; + + FillChar(ReadOl, SizeOf(ReadOl), 00); + FillChar(WriteOl, SizeOf(WriteOl), 00); + + FillChar(Security, SizeOf(TSECURITYATTRIBUTES), 0); + Security.nLength := SizeOf(TSECURITYATTRIBUTES); + Security.lpSecurityDescriptor := nil; + Security.bInheritHandle := true; + + TempSave := CreateFile(PChar('\\.\COM' + IntToStr(ComPort)), + GENERIC_READ or GENERIC_WRITE, + 0, + @Security, { No Security } + OPEN_EXISTING, { Creation action } + FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, + 0); { No template } + LastError := GetLastError; + if LastError <> 0 then + ErrorStr := 'Unable to open communications port'; + + SaveHandle := TempSave; + Result := (TempSave <> INVALID_HANDLE_VALUE); + + if Result then { Make sure that "CharAvail" isn't going to wait } + begin + Com_InitDelayTimes; + end; { if } + + if NOT SetupComm(Com_GetHandle, Win32InBufSize, Win32OutBufSize) then + begin + LastError := GetLastError; + + ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); + end; { if } + + InitFailed := NOT Com_StartThread; +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + Com_Open := Com_OpenKeep(Comport); + Com_SetLine(Baudrate, Parity, DataBits, StopBits); +end; { func. TWin32Obj.Com_OpenCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +var DCB : TDCB; + BPSID : Longint; +begin + if BpsRate = 11520 then { small fix for EleBBS inability to store the bps } + BpsRate := 115200; { rate in anything larger than a 16-bit integer } + + GetCommState(Com_GetHandle, DCB); + + if NOT (Parity in ['N', 'E', 'O', 'M']) then Parity := 'N'; + if BpsRate >= 0 then dcb.BaudRate := BpsRate; + dcb.StopBits := ONESTOPBIT; + + Case Parity of + 'N' : dcb.Parity := NOPARITY; + 'E' : dcb.Parity := EVENPARITY; + 'O' : dcb.Parity := ODDPARITY; + 'M' : dcb.Parity := MARKPARITY; + end; { case } + + Case StopBits of + 1 : dcb.StopBits := ONESTOPBIT; + 2 : dcb.StopBits := TWOSTOPBITS; + 3 : dcb.StopBits := ONE5STOPBITS; + end; { case } + + dcb.ByteSize := DataBits; + dcb.Flags := dcb.Flags OR dcb_Binary OR Dcb_DtrControlEnable; + + if not SetCommState (Com_GetHandle, DCB) then + begin + BPSId := GetLastError; + + ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); + end; { if } +end; { proc. TWin32Obj.Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_Close; +begin + if DontClose then EXIT; + + if DWORD(Com_GetHandle) <> INVALID_HANDLE_VALUE then + begin + Com_StopThread; + CloseHandle(Com_GetHandle); + + SaveHandle := INVALID_HANDLE_VALUE; + end; + +end; { func. TWin32Obj.Com_CloseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_SendChar(C: Char): Boolean; +var Written: Longint; +begin + Com_SendBlock(C, SizeOf(C), Written); + Com_SendChar := (Written = SizeOf(c)); +end; { proc. TWin32Obj.Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_GetChar: Char; +var Reads: Longint; +begin + Com_ReadBlock(Result, SizeOf(Result), Reads); +end; { func. TWin32Obj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +begin + if OutBuffer^.BufRoom < BlockLen then + repeat + {$IFDEF WIN32} + Sleep(1); + {$ENDIF} + until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier); + + CriticalTx^.EnterExclusive; + Written := OutBuffer^.Put(Block, BlockLen); + CriticalTx^.LeaveExclusive; + + DoTxEvent^.SignalEvent; +end; { proc. TWin32Obj.Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin + if InBuffer^.BufUsed < BlockLen then + begin + DoRxEvent^.SignalEvent; + + while (InBuffer^.BufUsed < BlockLen) AND (Com_Carrier) do + begin + Sleep(1); + + if Com_CharAvail then + DoRxEvent^.SignalEvent; + end; { while } + end; { if } + + CriticalRx^.EnterExclusive; + Reads := InBuffer^.Get(Block, BlockLen, true); + CriticalRx^.LeaveExclusive; +end; { proc. TWin32Obj.Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_CharAvail: Boolean; +var Props : TComStat; + ErrMask : DWORD; +begin + if InBuffer^.BufUsed < 1 then + begin + ErrMask := 0; + + if ClearCommError(Com_GetHandle, ErrMask, @Props) then + if Props.cbInQue > 0 then + DoRxEvent^.SignalEvent; + end; { if } + + Result := (InBuffer^.BufUsed > 0); +end; { func. TWin32Obj.Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_Carrier: Boolean; +var Status: DWORD; +begin + if Com_GetHandle <> INVALID_HANDLE_VALUE then + begin + GetCommModemStatus(Com_GetHandle, + Status); + + Result := (Status AND MS_RLSD_ON) <> 00; + end + else Result := FALSE; +end; { func. TWin32Obj.Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +var Data: DWORD; +begin + GetCommModemStatus(Com_GetHandle, Data); + + ModemStatus := ModemStatus and $0F; + ModemStatus := ModemStatus or Byte(Data); +end; { proc. TWin32Obj.Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetDtr(State: Boolean); +begin + if State then + EscapeCommFunction(Com_GetHandle, SETDTR) + else EscapeCommFunction(Com_GetHandle, CLRDTR); +end; { proc. TWin32Obj.Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_GetBpsRate: Longint; +var DCB : TDCB; +begin + GetCommState(Com_GetHandle, DCB); + + Com_GetBpsRate := dcb.Baudrate; +end; { func. TWin32Obj.Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +var Stats : TComStat; + ErrMask : DWORD; +begin + if ClearCommError(Com_GetHandle, ErrMask, @Stats) then + begin + if Stats.cbInQue > 0 then + begin + DoRxEvent^.SignalEvent; + Sleep(1); + end; { if } + end; { if } + + + InFree := InBuffer^.BufRoom; + OutFree := OutBuffer^.BufRoom; + InUsed := InBuffer^.BufUsed; + OutUsed := OutBuffer^.BufUsed; +end; { proc. TWin32Obj.Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_PurgeInBuffer; +begin + CriticalRx^.EnterExclusive; + + InBuffer^.Clear; + PurgeComm(Com_GetHandle, PURGE_RXCLEAR); + + CriticalRx^.LeaveExclusive; +end; { proc. TWin32Obj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_PurgeOutBuffer; +begin + CriticalTx^.EnterExclusive; + + OutBuffer^.Clear; + PurgeComm(Com_GetHandle, PURGE_TXCLEAR); + + CriticalTx^.LeaveExclusive; +end; { proc. TWin32Obj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Result := OutBuffer^.BufRoom >= BlockLen; +end; { func. ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_PauseCom(CloseCom: Boolean); +begin + if CloseCom then Com_Close + else Com_StopThread; +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_ResumeCom(OpenCom: Boolean); +begin + if OpenCom then + begin + if InitPortNr <> -1 then Com_OpenKeep(InitPortNr) + else Com_OpenQuick(InitHandle); + end + else InitFailed := NOT Com_StartThread; +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_FlushOutBuffer(Slice: SliceProc); +begin + Windows.FlushFileBuffers(Com_GetHandle); + + inherited Com_FlushOutBuffer(Slice); +end; { proc. Com_FlushOutBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); +var DCB : TDCB; + BPSID : Longint; +begin + GetCommState(Com_GetHandle, DCB); + + if Hard then + dcb.Flags := dcb.Flags OR NOT dcb_OutxCtsFlow OR NOT dcb_RtsControlHandshake; + + if SoftTX then + dcb.Flags := dcb.Flags OR NOT dcb_OutX; + + if SoftRX then + dcb.Flags := dcb.Flags OR NOT dcb_InX; + + if not SetCommState(Com_GetHandle, DCB) then + begin + BPSId := GetLastError; + + ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); + end; { if } + + Com_InitDelayTimes; +end; { proc. Com_SetFlow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer); +begin + DataProcPtr := ReadPtr; +end; { proc. Com_SetDataProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/W32SOCK.PAS b/SOURCE/ELECOM/W32SOCK.PAS new file mode 100644 index 0000000..7885dbb --- /dev/null +++ b/SOURCE/ELECOM/W32SOCK.PAS @@ -0,0 +1,205 @@ +unit W32sock; +{&Orgname+} +(* +** +** WINDOWS TCP/IP routines +** +** Copyright (c) 1998 by Thomas W. Mueller +** +** Created : 24-Oct-1998 +** Last update : 20-Feb-2000 +** +** +*) + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses + Windows, + SockDef; + +type + u_char = Char; + u_short = Word; + u_int = Integer; + u_long = Longint; + +{$IFDEF FPC} + type pInteger = ^Integer; +{$ENDIF} + + +{ Socket function prototypes } + +function accept(_s: ULONG; _addr: pSockAddr; _addrlen: PInteger): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF} +function bind(_s: ULONG; _addr: pSockAddr; _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function connect(_s: ULONG; _name: pSockAddr; _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function closesocket(s: ULONG): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; + timeout: PTimeVal): Longint; {$IFNDEF FPC} stdcall; {$ENDIF} +function ioctlsocket(_s: ULONG; _cmd: Longint; var _arg: ULONG): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function getpeername(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function getsockname(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function getsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar; var _optlen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function htonl(_hostlong: ULONG): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF} +function htons(_hostshort: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function inet_addr(_cp: PChar): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF} +function inet_ntoa(_inaddr: tIn_Addr): PChar; {$IFNDEF FPC} stdcall; {$ENDIF} +function listen(_s: ULONG; _backlog: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function ntohl(_netlong: ULONG): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF} +function ntohs(_netshort: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function recv(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} + +function recvfrom(s: ULONG; _Buf: pointer; _len, _flags: Integer; + var _from: TSockAddr; var _fromlen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function send(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function sendto(_s: ULONG; _Buf: pointer; _len, _flags: Integer; var _addrto: TSockAddr; + _tolen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function setsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar; + _optlen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function shutdown(_s: ULONG; _how: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function socket(_af, _struct, _protocol: Integer): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF} + +function gethostbyaddr(_addr: Pointer; _len, _struct: Integer): PHostEnt; {$IFNDEF FPC} stdcall; {$ENDIF} +function gethostbyname(_name: PChar): PHostEnt; {$IFNDEF FPC} stdcall; {$ENDIF} +function gethostname(_name: PChar; _len: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function getservbyport(_port: Integer; _proto: PChar): PServEnt; {$IFNDEF FPC} stdcall; {$ENDIF} +function getservbyname(_name, _proto: PChar): PServEnt; {$IFNDEF FPC} stdcall; {$ENDIF} +function getprotobynumber(_proto: Integer): PProtoEnt; {$IFNDEF FPC} stdcall; {$ENDIF} +function getprotobyname(_name: PChar): PProtoEnt; {$IFNDEF FPC} stdcall; {$ENDIF} + +function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSACleanup: Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +procedure WSASetLastError(iError: Integer); {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAGetLastError: Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAIsBlocking: BOOL; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAUnhookBlockingHook: Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSACancelBlockingCall: Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int; + name, proto, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int; + proto, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int; + name, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer; + buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int; + name, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar; + len, struct: Integer; buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSAAsyncSelect(s: ULONG; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} +function WSARecvEx(s: ULONG; var buf; len: Integer; var flags: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF} + +function WSAMakeSyncReply(Buflen, Error: Word): Longint; +function WSAMakeSelectReply(Event, Error: Word): Longint; +function WSAGetAsyncBuflen(Param: Longint): Word; +function WSAGetAsyncError(Param: Longint): Word; +function WSAGetSelectEvent(Param: Longint): Word; +function WSAGetSelectError(Param: Longint): Word; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +const + winsocket = 'wsock32.dll'; + +function WSAMakeSyncReply(Buflen, Error: Word): Longint; +begin + WSAMakeSyncReply:= MakeLong(Buflen, Error); +end; + +function WSAMakeSelectReply(Event, Error: Word): Longint; +begin + WSAMakeSelectReply:= MakeLong(Event, Error); +end; + +function WSAGetAsyncBuflen(Param: Longint): Word; +begin + WSAGetAsyncBuflen:= LOWORD(Param); +end; + +function WSAGetAsyncError(Param: Longint): Word; +begin + WSAGetAsyncError:= HIWORD(Param); +end; + +function WSAGetSelectEvent(Param: Longint): Word; +begin + WSAGetSelectEvent:= LOWORD(Param); +end; + +function WSAGetSelectError(Param: Longint): Word; +begin + WSAGetSelectError:= HIWORD(Param); +end; + +function accept(_s: ULONG; _addr: pSockAddr; _addrlen: PInteger): ULONG; external winsocket name 'accept'; +function bind(_s: ULONG; _addr: pSockAddr; _namelen: Integer): Integer; external winsocket name 'bind'; +function connect(_s: ULONG; _name: pSockAddr; _namelen: Integer): Integer; external winsocket name 'connect'; +function closesocket(s: ULONG): Integer; external winsocket name 'closesocket'; +function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; + timeout: PTimeVal): Longint; external winsocket name 'select'; +function ioctlsocket(_s: ULONG; _cmd: Longint; var _arg: ULONG): Integer; external winsocket name 'ioctlsocket'; +function getpeername(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; external winsocket name 'getpeername'; +function getsockname(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; external winsocket name 'getsockname'; +function getsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar; var _optlen: Integer): Integer; external winsocket name 'getsockopt'; +function htonl(_hostlong: ULONG): ULONG; external winsocket name 'htonl'; +function htons(_hostshort: Integer): Integer; external winsocket name 'htons'; +function inet_addr(_cp: PChar): ULONG; external winsocket name 'inet_addr'; +function inet_ntoa(_inaddr: tIn_Addr): PChar; external winsocket name 'inet_ntoa'; +function listen(_s: ULONG; _backlog: Integer): Integer; external winsocket name 'listen'; +function ntohl(_netlong: ULONG): ULONG; external winsocket name 'ntohl'; +function ntohs(_netshort: Integer): Integer; external winsocket name 'ntohs'; +function recv(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; external winsocket name 'recv'; + + +function recvfrom(s: ULONG; _Buf: pointer; _len, _flags: Integer; + var _from: TSockAddr; var _fromlen: Integer): Integer; external winsocket name 'recvfrom'; +function send(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; external winsocket name 'send'; +function sendto(_s: ULONG; _Buf: pointer; _len, _flags: Integer; var _addrto: TSockAddr; + _tolen: Integer): Integer; external winsocket name 'sendto'; +function setsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar; + _optlen: Integer): Integer; external winsocket name 'setsockopt'; +function shutdown(_s: ULONG; _how: Integer): Integer; external winsocket name 'shutdown'; +function socket(_af, _struct, _protocol: Integer): ULONG; external winsocket name 'socket'; + + +function gethostbyaddr(_addr: Pointer; _len, _struct: Integer): PHostEnt; external winsocket name 'gethostbyaddr'; +function gethostbyname(_name: PChar): PHostEnt; external winsocket name 'gethostbyname'; +function gethostname(_name: PChar; _len: Integer): Integer; external winsocket name 'gethostname'; +function getservbyport(_port: Integer; _proto: PChar): PServEnt; external winsocket name 'getservbyport'; +function getservbyname(_name, _proto: PChar): PServEnt; external winsocket name 'getservbyname'; +function getprotobynumber(_proto: Integer): PProtoEnt; external winsocket name 'getprotobynumber'; +function getprotobyname(_name: PChar): PProtoEnt; external winsocket name 'getprotobyname'; + + +function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; external winsocket name 'WSAStartup'; +function WSACleanup: Integer; external winsocket name 'WSACleanup'; +procedure WSASetLastError(iError: Integer); external winsocket name 'WSASetLastError'; +function WSAGetLastError: Integer; external winsocket name 'WSAGetLastError'; +function WSAIsBlocking: BOOL; external winsocket name 'WSAIsBlocking'; +function WSAUnhookBlockingHook: Integer; external winsocket name 'WSAUnhookBlockingHook'; +function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; external winsocket name 'WSASetBlockingHook'; +function WSACancelBlockingCall: Integer; external winsocket name 'WSACancelBlockingCall'; +function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int; + name, proto, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetServByName'; +function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int; + proto, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetServByPort'; +function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int; + name, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetProtoByName'; +function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer; + buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetProtoByNumber'; +function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int; + name, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetHostByName'; +function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar; + len, struct: Integer; buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetHostByAddr'; +function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; external winsocket name 'WSACancelAsyncRequest'; +function WSAAsyncSelect(s: ULONG; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; external winsocket name 'WSAAsyncSelect'; +function WSARecvEx(s: ULONG; var buf; len: Integer; var flags: Integer): Integer; external winsocket name 'WSARecvEx'; + +end. { unit. W32SOCK } diff --git a/SOURCE/ELECOM/WIN32COM.PAS b/SOURCE/ELECOM/WIN32COM.PAS new file mode 100644 index 0000000..008434b --- /dev/null +++ b/SOURCE/ELECOM/WIN32COM.PAS @@ -0,0 +1,790 @@ +unit WIN32COM; +(* +** +** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT. +** Tested with: TurboPascal v7.0, (DOS) +** VirtualPascal v2.0, (OS/2, Win32) +** FreePascal v0.99.15 (DOS, Win32) +** Delphi v4.0. (Win32) +** +** Version : 1.01 +** Created : 21-May-1998 +** Last update : 20-Feb-2000 +** +** Note: (c) 1998-2000 by Maarten Bekers +** +*) + +This unit is not supported anymore. +Remove this in order to be compiled anyway. The next release of EleCOM will +not include WIN32COM.PAS anymore. W32SNGL.PAS is the replacement unit. + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + INTERFACE +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses Windows, Combase, BufUnit, Threads + {$IFDEF VirtualPascal} + ,Use32 + {$ENDIF}; + +Const WriteTimeout = 20000; { Wait max. 20 secs } + ReadTimeOut = 20000; { General event, 20 secs max } + + InBufSize = 1024 * 32; + OutBufSize = 1024 * 32; + + +type TWin32Obj = Object(TCommObj) + ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) } + ThreadsInitted: Boolean; { Are the thread(s) up and running? } + + SaveHandle : THandle; + + InitPortNr : Longint; + InitHandle : Longint; + + ReadOL : TOverLapped; { Overlapped structure for ReadFile } + WriteOL : TOverLapped; { Overlapped structure for WriteFile } + + InBuffer : ^BufArrayObj; { Buffer system internally used } + OutBuffer : ^BufArrayObj; + + ReadEvent : PSysEventObj; { Event set by ReadFile overlapped routine } + WriteEvent : PSysEventObj; { Event set by WriteFile overlapped routine } + RecvEvent : PSysEventObj; + + DoTxEvent : PSysEventObj;{ Event manually set when we have to transmit } + + TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed } + RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed } + + CriticalTx : PExclusiveObj; { Critical sections } + CriticalRx : PExclusiveObj; + + TxThread : PThreadsObj; { The Transmit and Receive threads } + RxThread : PThreadsObj; + + EndThreads : Boolean; { Set to true when we have to end the threads } + + constructor Init; + destructor Done; + + function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; virtual; + function Com_OpenKeep(Comport: Byte): Boolean; virtual; + function Com_GetChar: Char; virtual; + function Com_CharAvail: Boolean; virtual; + function Com_Carrier: Boolean; virtual; + function Com_SendChar(C: Char): Boolean; virtual; + function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual; + function Com_GetBPSrate: Longint; virtual; + function Com_GetHandle: Longint; virtual; + + procedure Com_OpenQuick(Handle: Longint); virtual; + procedure Com_Close; virtual; + procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual; + procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual; + procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual; + procedure Com_SetDtr(State: Boolean); virtual; + procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual; + procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual; + procedure Com_PurgeInBuffer; virtual; + procedure Com_PurgeOutBuffer; virtual; + + procedure Com_PauseCom(CloseCom: Boolean); virtual; + procedure Com_ResumeCom(OpenCom: Boolean); virtual; + procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual; + + procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual; + + procedure Com_ReadProc(var TempPtr: Pointer); + procedure Com_WriteProc(var TempPtr: Pointer); + + function Com_StartThread: Boolean; + procedure Com_InitVars; + procedure Com_StopThread; + procedure Com_InitDelayTimes; + end; { object TWin32Obj } + +type PWin32Obj = ^TWin32Obj; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + IMPLEMENTATION +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +uses SysUtils; + +{$IFDEF FPC} + {$I WINDEF.FPC} +{$ENDIF} + +const + dcb_Binary = $00000001; + dcb_ParityCheck = $00000002; + dcb_OutxCtsFlow = $00000004; + dcb_OutxDsrFlow = $00000008; + dcb_DtrControlMask = $00000030; + dcb_DtrControlDisable = $00000000; + dcb_DtrControlEnable = $00000010; + dcb_DtrControlHandshake = $00000020; + dcb_DsrSensivity = $00000040; + dcb_TXContinueOnXoff = $00000080; + dcb_OutX = $00000100; + dcb_InX = $00000200; + dcb_ErrorChar = $00000400; + dcb_NullStrip = $00000800; + dcb_RtsControlMask = $00003000; + dcb_RtsControlDisable = $00000000; + dcb_RtsControlEnable = $00001000; + dcb_RtsControlHandshake = $00002000; + dcb_RtsControlToggle = $00003000; + dcb_AbortOnError = $00004000; + dcb_Reserveds = $FFFF8000; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +constructor TWin32Obj.Init; +begin + inherited Init; + + InitPortNr := -1; + InitHandle := -1; + ThreadsInitted := false; + Com_InitVars; +end; { constructor Init } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +destructor TWin32Obj.Done; +begin + inherited done; +end; { destructor Done } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_ReadProc(var TempPtr: Pointer); +var EventMask : DWORD; + Success : Boolean; + Props : TCommProp; + ReturnCode: Longint; + DidRead : DWORD; + BlockLen : Longint; + + RecvOL : tOverlapped; +begin + New(RecvEvent, Init); + if NOT RecvEvent^.CreateEvent(true) then EXIT; + + FillChar(RecvOL, SizeOf(tOverLapped), 0); + RecvOL.hEvent := RecvEvent^.SemHandle; + + EventMask := EV_RXCHAR; + SetCommMask(SaveHandle, EventMask); { Signal us if anything is received } + + repeat + WaitCommEvent(SaveHandle, EventMask, @RecvOL); + if EndThreads then EXIT; + + repeat + ReturnCode := WaitForSingleObject(RecvOL.hEvent, 500); + if ReturnCode = WAIT_OBJECT_0 then + begin + Success := true + end { if } + else Success := false; + + if EndThreads then BREAK; + until (Success); + + DidRead := 00; + + if (NOT Success) OR (EventMask = 0) then EXIT; + if (EndThreads) then EXIT; + + {----------------- Start reading the gathered date ---------------------} + CriticalRx^.EnterExclusive; + + FillChar(Props, SizeOf(TCommProp), 0); + + if GetCommProperties(SaveHandle, Props) then + if InBuffer^.BufRoom > 0 then + begin + BlockLen := Props.dwCurrentRxQueue; + + if BlockLen > InBuffer^.BufRoom then + BlockLen := InBuffer^.BufRoom; + + Success := ReadFile(SaveHandle, + InBuffer^.TmpBuf^, + BlockLen, + DidRead, + @ReadOL); + + if NOT Success then + begin + ReturnCode := GetLastError; + + if ReturnCode = ERROR_IO_PENDING then + begin + ReturnCode := WaitForSingleObject(ReadOL.hEvent, ReadTimeOut); + + if ReturnCode = WAIT_OBJECT_0 then + begin + GetOverLappedResult(SaveHandle, ReadOL, DidRead, false); + end; { if } + end; { if } + end + else GetOverlappedResult(SaveHandle, ReadOL, DidRead, false); + + if DidRead > 00 then + InBuffer^.Put(InBuffer^.TmpBuf^, DidRead); + end; { if } + + CriticalRx^.LeaveExclusive; + until EndThreads; + + RxClosedEvent^.SignalEvent; + ExitThisThread; +end; { proc. ComReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_WriteProc(var TempPtr: Pointer); +var BlockLen : Longint; + Written : DWORD; + ReturnCode: Longint; + Success : Boolean; +begin + repeat + if DoTxEvent^.WaitForEvent(WriteTimeOut) then + if NOT EndThreads then + begin + CriticalTx^.EnterExclusive; + DoTxEvent^.ResetEvent; + + if OutBuffer^.BufUsed > 00 then + begin + Written := 00; + BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf^, OutBuffer^.BufUsed, false); + + Success := WriteFile(SaveHandle, + OutBuffer^.TmpBuf^, + BlockLen, + Written, + @WriteOL); + if NOT Success then + begin + ReturnCode := GetLastError; + + if ReturnCode = ERROR_IO_PENDING then + begin + ReturnCode := WaitForSingleObject(WriteOL.hEvent, WriteTimeOut); + + if ReturnCode = WAIT_OBJECT_0 then + begin + if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then + begin + ResetEvent(WriteOL.hEvent); + end; { if } + end; { if } + end; { result is pending } + end { if } + else begin + + if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then + begin + ResetEvent(WriteOL.hEvent); + end; { if } + end; { if (did succeed) } + + ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf^, Written, true); + if Written <> BlockLen then + DoTxEvent^.SignalEvent; + end; { if } + + CriticalTx^.LeaveExclusive; + end; { if } + + until EndThreads; + + TxClosedEvent^.SignalEvent; + ExitThisThread; +end; { proc. ComWriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_StartThread: Boolean; +begin + Result := false; + EndThreads := false; + if ThreadsInitted then EXIT; + ThreadsInitted := true; + + {----------------------- Create all the events ----------------------------} + New(ReadEvent, Init); + if NOT ReadEvent^.CreateEvent(true) then EXIT; + + New(WriteEvent, Init); + if NOT WriteEvent^.CreateEvent(true) then EXIT; + + New(DoTxEvent, Init); + if NOT DoTxEvent^.CreateEvent(false) then EXIT; + + New(RxClosedEvent, Init); + if NOT RxClosedEvent^.CreateEvent(false) then EXIT; + + New(TxClosedEvent, Init); + if NOT TxClosedEvent^.CreateEvent(false) then EXIT; + + {-------------- Startup the buffers and overlapped events -----------------} + FillChar(WriteOL, SizeOf(tOverLapped), 0); + FillChar(ReadOL, SizeOf(tOverLapped), 0); + WriteOl.hEvent := WriteEvent^.SemHandle; + ReadOl.hEvent := ReadEvent^.SemHandle; + + New(InBuffer, Init(InBufSize)); + New(OutBuffer, Init(OutBufSize)); + + if (InBuffer^.TxtArr=nil) OR (InBuffer^.TmpBuf=nil) then EXIT; + if (OutBuffer^.TxtArr=nil) OR (OutBuffer^.TmpBuf=nil) then EXIT; + + {-------------------- Startup a seperate write thread ---------------------} + New(CriticalTx, Init); + CriticalTx^.CreateExclusive; + + New(TxThread, Init); + if NOT TxThread^.CreateThread(16384, { Stack size } + @WriteProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + {-------------------- Startup a seperate read thread ----------------------} + New(CriticalRx, Init); + CriticalRx^.CreateExclusive; + + New(RxThread, Init); + if NOT RxThread^.CreateThread(16384, { Stack size } + @ReadProcPtr, { Actual procedure } + nil, { Parameters } + 0) { Creation flags } + then EXIT; + + Result := true; +end; { proc. Com_StartThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_InitVars; +begin + DoTxEvent := nil; + RxClosedEvent := nil; + TxClosedEvent := nil; + RecvEvent := nil; + ReadEvent := nil; + WriteEvent := nil; + TxThread := nil; + RxThread := nil; + + InBuffer := nil; + OutBuffer := nil; + CriticalRx := nil; + CriticalTx := nil; +end; { proc. Com_InitVars } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_StopThread; +begin + EndThreads := true; + ThreadsInitted := false; + + if DoTxEvent <> nil then DoTxEvent^.SignalEvent; + + if TxThread <> nil then TxThread^.CloseThread; + if RxThread <> nil then RxThread^.CloseThread; + + if TxClosedEvent <> nil then + if NOT TxClosedEvent^.WaitForEvent(1000) then + TxThread^.TerminateThread(0); + + if RxClosedEvent <> nil then + if NOT RxClosedEvent^.WaitForEvent(1000) then + RxThread^.TerminateThread(0); + + if TxThread <> nil then Dispose(TxThread, Done); + if RxThread <> nil then Dispose(RxThread, Done); + if DoTxEvent <> nil then Dispose(DoTxEvent, Done); + if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done); + if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done); + + if CriticalTx <> nil then Dispose(CriticalTx, Done); + if CriticalRx <> nil then Dispose(CriticalRx, Done); + + if InBuffer <> nil then Dispose(InBuffer, Done); + if OutBuffer <> nil then Dispose(OutBuffer, Done); + + if RecvEvent <> nil then Dispose(RecvEvent, Done); + if ReadEvent <> nil then Dispose(ReadEvent, Done); + if WriteEvent <> nil then Dispose(WriteEvent, Done); + + Com_InitVars; +end; { proc. Com_StopThread } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_InitDelayTimes; +var CommTimeOut: TCommTimeouts; + RC : Longint; +begin + FillChar(CommTimeOut, SizeOf(TCommTimeOuts), 00); + CommTimeOut.ReadIntervalTimeout := MAXDWORD; + + if NOT SetCommTimeOuts(SaveHandle, CommTimeOut) then + begin + RC := GetLastError; + { ErrorStr := 'Error setting communications timeout: #'+IntToStr(RC) + ' / ' + SysErrorMessage(rc)); } + end; { if } + +end; { proc. InitDelayTimes } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_GetHandle: Longint; +begin + Result := SaveHandle; +end; { func. Com_GetHandle } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_OpenQuick(Handle: Longint); +var LastError: Longint; +begin + SaveHandle := Handle; + InitHandle := Handle; + + FillChar(ReadOl, SizeOf(ReadOl), 00); + FillChar(WriteOl, SizeOf(WriteOl), 00); + + Com_InitDelayTimes; + + if NOT SetupComm(Com_GetHandle, 1024, 1024) then + begin + LastError := GetLastError; + + { ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); } + end; { if } + + InitFailed := NOT Com_StartThread; + Com_SetLine(-1, 'N', 8, 1); +end; { proc. TWin32Obj.Com_OpenQuick } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_OpenKeep(Comport: Byte): Boolean; +var TempSave : THandle; + Security : TSECURITYATTRIBUTES; + LastError : Longint; +begin + InitPortNr := Comport; + + FillChar(ReadOl, SizeOf(ReadOl), 00); + FillChar(WriteOl, SizeOf(WriteOl), 00); + + FillChar(Security, SizeOf(TSECURITYATTRIBUTES), 0); + Security.nLength := SizeOf(TSECURITYATTRIBUTES); + Security.lpSecurityDescriptor := nil; + Security.bInheritHandle := true; + + TempSave := CreateFile(PChar('\\.\COM' + IntToStr(ComPort)), + GENERIC_READ or GENERIC_WRITE, + 0, + @Security, { No Security } + OPEN_EXISTING, { Creation action } + FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, + 0); { No template } + LastError := GetLastError; + if LastError <> 0 then + ErrorStr := 'Unable to open communications port'; + + SaveHandle := TempSave; + Result := (TempSave <> INVALID_HANDLE_VALUE); + + if Result then { Make sure that "CharAvail" isn't going to wait } + begin + Com_InitDelayTimes; + end; { if } + + if NOT SetupComm(Com_GetHandle, 1024, 1024) then + begin + LastError := GetLastError; + + { ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); } + end; { if } + + InitFailed := NOT Com_StartThread; +end; { func. Com_OpenKeep } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte; + Parity: Char; StopBits: Byte): Boolean; +begin + Com_Open := Com_OpenKeep(Comport); + Com_SetLine(Baudrate, Parity, DataBits, StopBits); +end; { func. TWin32Obj.Com_OpenCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); +var DCB : TDCB; + BPSID : Longint; +begin + if BpsRate = 11520 then + BpsRate := 115200; + + GetCommState(Com_GetHandle, DCB); + + if NOT (Parity in ['N', 'E', 'O', 'M']) then Parity := 'N'; + if BpsRate >= 0 then dcb.BaudRate := BpsRate; + dcb.StopBits := ONESTOPBIT; + + Case Parity of + 'N' : dcb.Parity := NOPARITY; + 'E' : dcb.Parity := EVENPARITY; + 'O' : dcb.Parity := ODDPARITY; + 'M' : dcb.Parity := MARKPARITY; + end; { case } + + if StopBits = 1 then + dcb.StopBits := ONESTOPBIT; + dcb.ByteSize := DataBits; + dcb.Flags := dcb.Flags OR dcb_Binary or Dcb_DtrControlEnable; + + if not SetCommState (Com_GetHandle, DCB) then + begin + BPSId := GetLastError; + + { ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); } + end; { if } +end; { proc. TWin32Obj.Com_SetLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_Close; +begin + if DontClose then EXIT; + + if Com_GetHandle <> INVALID_HANDLE_VALUE then + begin + Com_StopThread; + CloseHandle(Com_GetHandle); + + SaveHandle := INVALID_HANDLE_VALUE; + end; + +end; { func. TWin32Obj.Com_CloseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_SendChar(C: Char): Boolean; +var Written: Longint; +begin + Com_SendBlock(C, SizeOf(C), Written); + Com_SendChar := (Written = SizeOf(c)); +end; { proc. TWin32Obj.Com_SendChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_GetChar: Char; +var Reads: Longint; +begin + Com_ReadBlock(Result, SizeOf(Result), Reads); +end; { func. TWin32Obj.Com_GetChar } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); +begin + if OutBuffer^.BufRoom < BlockLen then + repeat + {$IFDEF WIN32} + Sleep(1); + {$ENDIF} + + {$IFDEF OS2} + DosSleep(1); + {$ENDIF} + until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier); + + CriticalTx^.EnterExclusive; + Written := OutBuffer^.Put(Block, BlockLen); + CriticalTx^.LeaveExclusive; + + DoTxEvent^.SignalEvent; +end; { proc. TWin32Obj.Com_SendBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); +begin + if InBuffer^.BufUsed < BlockLen then + begin + repeat + Sleep(1); + until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier); + end; { if } + + CriticalRx^.EnterExclusive; + Reads := InBuffer^.Get(Block, BlockLen, true); + CriticalRx^.LeaveExclusive; +end; { proc. TWin32Obj.Com_ReadBlock } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_CharAvail: Boolean; +begin + Result := (InBuffer^.BufUsed > 0); +end; { func. TWin32Obj.Com_CharAvail } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_Carrier: Boolean; +var Status: DWORD; +begin + GetCommModemStatus(Com_GetHandle, + Status); + + Result := (Status AND MS_RLSD_ON) <> 00; +end; { func. TWin32Obj.Com_Carrier } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte); +var Data: DWORD; +begin + GetCommModemStatus(Com_GetHandle, Data); + + ModemStatus := ModemStatus and $0F; + ModemStatus := ModemStatus or Byte(Data); +end; { proc. TWin32Obj.Com_GetModemStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetDtr(State: Boolean); +begin + if State then + EscapeCommFunction(Com_GetHandle, SETDTR) + else EscapeCommFunction(Com_GetHandle, CLRDTR); +end; { proc. TWin32Obj.Com_SetDtr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_GetBpsRate: Longint; +var DCB : TDCB; + BPSID : Longint; +begin + GetCommState(Com_GetHandle, DCB); + + Com_GetBpsRate := dcb.Baudrate; +end; { func. TWin32Obj.Com_GetBpsRate } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); +begin + InFree := InBuffer^.BufRoom; + OutFree := OutBuffer^.BufRoom; + InUsed := InBuffer^.BufUsed; + OutUsed := OutBuffer^.BufUsed; +end; { proc. TWin32Obj.Com_GetBufferStatus } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_PurgeInBuffer; +begin + CriticalRx^.EnterExclusive; + + InBuffer^.Clear; + PurgeComm(Com_GetHandle, PURGE_RXCLEAR); + + CriticalRx^.LeaveExclusive; +end; { proc. TWin32Obj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_PurgeOutBuffer; +begin + CriticalTx^.EnterExclusive; + + OutBuffer^.Clear; + PurgeComm(Com_GetHandle, PURGE_TXCLEAR); + + CriticalTx^.LeaveExclusive; +end; { proc. TWin32Obj.Com_PurgeInBuffer } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +function TWin32Obj.Com_ReadyToSend(BlockLen: Longint): Boolean; +begin + Result := OutBuffer^.BufRoom >= BlockLen; +end; { func. ReadyToSend } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_PauseCom(CloseCom: Boolean); +begin + if CloseCom then Com_Close + else Com_StopThread; +end; { proc. Com_PauseCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_ResumeCom(OpenCom: Boolean); +begin + if OpenCom then + begin + if InitPortNr <> -1 then Com_OpenKeep(InitPortNr) + else Com_OpenQuick(InitHandle); + end + else InitFailed := NOT Com_StartThread; +end; { proc. Com_ResumeCom } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); +var DCB : TDCB; + BPSID : Longint; +begin + GetCommState(Com_GetHandle, DCB); + + if Hard then + dcb.Flags := dcb.Flags OR dcb_OutxCtsFlow OR dcb_RtsControlHandshake; + + if SoftTX then + dcb.Flags := dcb.Flags OR dcb_OutX; + + if SoftRX then + dcb.Flags := dcb.Flags OR dcb_InX; + + if not SetCommState (Com_GetHandle, DCB) then + begin + BPSId := GetLastError; + + { ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); } + end; { if } +end; { proc. Com_SetFlow } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure TWin32Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer); +begin + ReadProcPtr := ReadPtr; + WriteProcPtr := WritePtr; +end; { proc. Com_SetDataProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +end. diff --git a/SOURCE/ELECOM/WINDEF.FPC b/SOURCE/ELECOM/WINDEF.FPC new file mode 100644 index 0000000..c8b4756 --- /dev/null +++ b/SOURCE/ELECOM/WINDEF.FPC @@ -0,0 +1,79 @@ +(* +** +** Include file to make FPC more Delphi compatible +** +*) + +{$IFDEF FPC} +type DCB = record + DCBlength : DWORD; + BaudRate : DWORD; + flags : longint; + wReserved : WORD; + XonLim : WORD; + XoffLim : WORD; + ByteSize : BYTE; + Parity : BYTE; + StopBits : BYTE; + XonChar : char; + XoffChar : char; + ErrorChar : char; + EofChar : char; + EvtChar : char; + wReserved1 : WORD; + end; + + TDcb = DCB; + pInteger = ^Integer; + + PSecurityAttributes = ^TSecurityAttributes; + TSecurityAttributes = record + nLength: Longint; + lpSecurityDescriptor: Pointer; + bInheritHandle: Bool; + end; + + function GetCommState(hFile:HANDLE; var lpDCB:TDCB):WINBOOL; external 'kernel32' name 'GetCommState'; + function SetCommState(hFile:HANDLE; var lpDCB:TDCB):WINBOOL; external 'kernel32' name 'SetCommState'; + function WaitForMultipleObjects(nCount:DWORD; lpHandles:Pointer; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'WaitForMultipleObjects'; + + +{-- Apparently, FPC 1.0 doesnt have the "SysErrorMessage" defined in its ------} +{-- SYSUTILS unit. We create this function here. ------------------------------} +function FormatMessageA(dwFlags : DWORD; + lpSource : Pointer; + dwMessageId : DWORD; + dwLanguageId: DWORD; + lpBuffer : PCHAR; + nSize : DWORD; + Arguments : Pointer): DWORD; external 'kernel32' name 'FormatMessageA'; + + +function SysErrorMessage(ErrorCode: Integer): String; +const + MaxMsgSize = Format_Message_Max_Width_Mask; + +var MsgBuffer: pChar; +begin + {-- Allocate memory for error message ---------------------------------------} + GetMem(MsgBuffer, MaxMsgSize); + FillChar(MsgBuffer^, MaxMsgSize, #0); + + {-- Retrieve the message ----------------------------------------------------} + FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, + nil, + ErrorCode, + MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT), + MsgBuffer, { This function allocs the memory } + MaxMsgSize, { Maximum message size } + nil); + + {-- Return the string and release the memory --------------------------------} + SysErrorMessage := StrPas(MsgBuffer); + + FreeMem(MsgBuffer, MaxMsgSize); +end; { func. SysErrorMessage } + +{$ENDIF} + + diff --git a/SOURCE/ELECOM/dllexam.pas b/SOURCE/ELECOM/dllexam.pas new file mode 100644 index 0000000..0ef7dc2 --- /dev/null +++ b/SOURCE/ELECOM/dllexam.pas @@ -0,0 +1,86 @@ +program DLLEXAM; +{$H-} { important, turn off Ansi-Strings } +(* +** +** Example how to use communications with the DLL file +** You can install this program from within EleBBS and test how it works :) +** +** version: 1.02 +** Created: 13-Jun-1999 +** +** EleBBS install lines: +** +** DOS install line: DLLEXAM.EXE -H*P +** Win32 install line: DLLEXAM.EXE -H*W +** Win32 (telnet) install line: DLLEXAM.EXE -H*W -XT +** OS/2 install line: DLLEXAM.EXE -H*W +** OS/2 (telnet) install line: DLLEXAM.EXE -H*W -XT +** +*) + +uses EleDEF; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +var IsTelnet : Boolean; + ComHandle : Longint; + ReadCH : Char; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure ParseCommandLine; +var Counter: Longint; + TempStr: String; + {$IFDEF MSDOS} + Code : Integer; + {$ELSE} + Code : Longint; + {$ENDIF} +begin + for Counter := 01 to ParamCount do + begin + TempStr := ParamStr(Counter); + + if TempStr[1] in ['/', '-'] then + Case UpCase(TempStr[2]) of + 'H' : begin + + TempStr := Copy(TempStr, 3, Length(TempStr) - 2); + Val(TempStr, ComHandle, Code); + + + end; { 'H' } + 'X' : begin + + if UpCase(TempStr[3]) = 'T' then { XT } + IsTelnet := true; + + end; { 'X' } + end; { case } + + end; { for } +end; { proc. ParseCommandLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +begin + IsTelnet := false; + ParseCommandLine; + + Case IsTelnet of + FALSE : Com_StartUp(1); + TRUE : Com_StartUp(2); + end; { case } + + Com_SetDontClose(true); { We use an inherited handle, never close it! } + Com_OpenQuick(ComHandle); { Open the comport using the handle } + + Com_SendString('Hello there!' + #13#10); + Com_SendString('Press [ENTER]'); + + repeat + ReadCH := Com_GetChar; + until (ReadCH = #13) OR (NOT Com_Carrier); + + Com_ShutDown; +end. diff --git a/SOURCE/ELECOM/example.pas b/SOURCE/ELECOM/example.pas new file mode 100644 index 0000000..159cfd4 --- /dev/null +++ b/SOURCE/ELECOM/example.pas @@ -0,0 +1,181 @@ +program Example; +(* +** +** EXAMPLE how to use communications +** You can install this program from within EleBBS and test how it works :) +** This is only an example of how to use EleCOM for writing so-called "doors", +** to see an example how to use EleCOM independent off a BBS program, see +** EXAM2.PAS +** +** version: 1.01 +** Created: 08-Apr-1999 +** +** EleBBS install lines: +** +** DOS install line: EXAMPLE.EXE -H*P +** Win32 install line: EXAMPLE.EXE -H*W +** Win32 (telnet) install line: EXAMPLE.EXE -H*W -XT +** OS/2 install line: EXAMPLE.EXE -H*W +** OS/2 (telnet) install line: EXAMPLE.EXE -H*W -XT +** +*) + +{.DEFINE FOSSIL} +{.DEFINE OS2COM} +{$DEFINE W32COM} + +{$IFNDEF FOSSIL} + {$IFNDEF OS2COM} + {$IFNDEF W32COM} + You need to define one of these.. + {$ENDIF} + {$ENDIF} +{$ENDIF} + +uses Combase, + {$IFDEF FOSSIL} + Fos_Com + {$ENDIF} + + {$IFDEF OS2COM} + Os2Com, + Telnet + {$ENDIF} + + {$IFDEF W32COM} + W32SNGL, + Telnet + {$ENDIF} ; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +var ComObj : PCommObj; + IsTelnet : Boolean; + ComHandle : Longint; + ReadCH : Char; + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComReadProc(var TempPtr: Pointer); +begin + {$IFDEF WIN32} + Case IsTelnet of + FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + TRUE : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case IsTelnet of + FALSE : POs2Obj(ComObj)^.Com_ReadProc(TempPtr); + TRUE : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComReadProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure Int_ComWriteProc(var TempPtr: Pointer); +begin + {$IFDEF WIN32} + Case IsTelnet of + FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr); + TRUE : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} + + {$IFDEF OS2} + Case IsTelnet of + FALSE : POs2Obj(ComObj)^.Com_WriteProc(TempPtr); + TRUE : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr); + end; { case } + {$ENDIF} +end; { proc. Int_ComWriteProc } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +procedure ParseCommandLine; +var Counter: Longint; + TempStr: String; + {$IFDEF MSDOS} + Code : Integer; + {$ELSE} + Code : Longint; + {$ENDIF} +begin + for Counter := 01 to ParamCount do + begin + TempStr := ParamStr(Counter); + + if TempStr[1] in ['/', '-'] then + Case UpCase(TempStr[2]) of + 'H' : begin + + TempStr := Copy(TempStr, 3, Length(TempStr) - 2); + Val(TempStr, ComHandle, Code); + + + end; { 'H' } + 'X' : begin + + if UpCase(TempStr[3]) = 'T' then { XT } + IsTelnet := true; + + end; { 'X' } + end; { case } + + end; { for } +end; { proc. ParseCommandLine } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +Function FStr (N : LongInt) : String; { Convert integer to string } +var Temp: String; +begin + Str(n,temp); + FStr:=Temp; +end; { func. FStr } + +(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*) + +begin + IsTelnet := false; + ParseCommandLine; + + {$IFDEF W32COM} + if IsTelnet then ComObj := New(PTelnetObj, Init) + else ComObj := New(PWin32Obj, Init); + {$ENDIF} + + {$IFDEF FOSSIL} + ComObj := New(PFossilObj, Init); + {$ENDIF} + + {$IFDEF OS2COM} + if IsTelnet then ComObj := New(PTelnetObj, Init) + else ComObj := New(POs2Obj, Init); + {$ENDIF} + + {$IFDEF WIN32} + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); + {$ENDIF} + + {$IFDEF OS2} + ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc); + {$ENDIF} + + ComObj^.DontClose := true; { We use an inherited handle, never close it! } + ComObj^.Com_OpenQuick(ComHandle); { Open the comport using the handle } + ComObj^.Com_SendString('Hello there!' + #13#10); + ComObj^.Com_SendString('We are using handle #' + FStr(ComHandle) + #13#10); + + + repeat + ReadCH := ComObj^.Com_GetChar; + + if ReadCH <> #13 then + Writeln('Other..'); + until (ReadCH = #13) OR (NOT ComObj^.Com_Carrier); + + Dispose(ComObj, Done); { Dispose the communications object } +end. diff --git a/SOURCE/EMAIL.PAS b/SOURCE/EMAIL.PAS new file mode 100644 index 0000000..0d835ec --- /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..24ed03e --- /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..fa586db --- /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..2487204 --- /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..473e66d --- /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..916a0e0 --- /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..43e08b0 --- /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..85009d5 --- /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..afb2f13 --- /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..4f383df --- /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..3d2d1ef --- /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..b456986 --- /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..7f84b2a --- /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..6ded087 --- /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..15ef0b2 --- /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..b2ea1b3 --- /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..818404b --- /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..beeeac2 --- /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..0a4e0a3 --- /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..8581121 --- /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..788e826 --- /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..0584a25 --- /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..f45e300 --- /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..299c1bc --- /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..6203d12 --- /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..69cbd4c --- /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..dee28e5 --- /dev/null +++ b/SOURCE/MENUS.PAS @@ -0,0 +1,1071 @@ +{$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 + mem[Seg0040:$0017] := mem[Seg0040:$0017] XOR 16; + 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..4b483f4 --- /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..e2f22c5 --- /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..bc6ca04 --- /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..8652eaf --- /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..e64a6a4 --- /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..71e471b --- /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..d9b0313 --- /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..684380e --- /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..a4c9003 --- /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..10ec8e2 --- /dev/null +++ b/SOURCE/RECORDS.PAS @@ -0,0 +1,1012 @@ +CONST + Build = '1.20'; + +{$IFDEF MSDOS} + OS = '/DOS'; +{$ENDIF} + +{$IFDEF WIN32} + OS = '/Win32'; +{$ENDIF} + +{$IFDEF OS/2} + OS = '/2'; +{$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} + 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..376cc69 --- /dev/null +++ b/SOURCE/RENEGADE.PAS @@ -0,0 +1,578 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$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..5e89a56 --- /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: SmallWord; + DestNode: SmallWord; + OrigNode: SmallWord; + Cost: SmallWord; + OrigNet: SmallWord; + DestNet: SmallWord; + Filler: ARRAY[1..8] OF Char; + ReplyTo: SmallWord; + Attribute: SmallWord; + NextReply: SmallWord; + 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: SmallWord; +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: SmallWord); +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/RGLNG.PAS b/SOURCE/RGLNG.PAS new file mode 100644 index 0000000..7145258 --- /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/RGQUOTE.PAS b/SOURCE/RGQUOTE.PAS new file mode 100644 index 0000000..768943b --- /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/RPSCREEN.PAS b/SOURCE/RPSCREEN.PAS new file mode 100644 index 0000000..16aab0d --- /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: SmallWord); +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: SmallWord); +procedure RPShowCursor; +function RPWhereXY: SmallWord; + +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: SmallWord); +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: SmallWord); +var + NumWritten: Longint; + 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: SmallWord; +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..1952fde --- /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..e03108b --- /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..f6b74fa --- /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..acf8018 --- /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..f6758a7 --- /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..9fa37e3 --- /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..932fa84 --- /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..46c9a31 --- /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..75c1275 --- /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..eeff6f1 --- /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..0081f3f --- /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..15fdb69 --- /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..9fd6ba7 --- /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..4e6acab --- /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..ca2451b --- /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..4dd3acf --- /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..5366472 --- /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..b4c18ef --- /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..0339b04 --- /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..9fae3ba --- /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..8817666 --- /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..204250f --- /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..0e39cde --- /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..80cfc35 --- /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..2c6241d --- /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..0e93253 --- /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..2c9cd55 --- /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..3af822c --- /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..5b7faa1 --- /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..45f7ed8 --- /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..2672772 --- /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..0ffd8be --- /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..cc6f551 --- /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/UNUSED/ACFLAGS.ASC b/SOURCE/UNUSED/ACFLAGS.ASC new file mode 100644 index 0000000..c573735 --- /dev/null +++ b/SOURCE/UNUSED/ACFLAGS.ASC @@ -0,0 +1,14 @@ + +^3Restrictions: + +^1(^3L^1)Can logon ONLY once/day ^1(^3C^1)Can't page SysOp +^1(^3V^1)Posts marked unvalidated ^1(^3U^1)Can't list users +^1(^3A^1)Can't add to BBS list ^1(^3*^1)Can't post/send anon. +^1(^3P^1)Can't post at all ^1(^3E^1)Can't send email +^1(^3K^1)Can't vote ^1(^3M^1)anditory mail deletion + +^3Special: + +^1(^31^1)No UL/DL ratio check ^1(^32^1)No post/call ratio check +^1(^33^1)No credits check ^1(^34^1)Protection from deletion + diff --git a/SOURCE/UNUSED/ARCHIVE1.TPU b/SOURCE/UNUSED/ARCHIVE1.TPU new file mode 100644 index 0000000..3fc338b Binary files /dev/null and b/SOURCE/UNUSED/ARCHIVE1.TPU differ diff --git a/SOURCE/UNUSED/ARCHIVE2.TPU b/SOURCE/UNUSED/ARCHIVE2.TPU new file mode 100644 index 0000000..c8d3fb5 Binary files /dev/null and b/SOURCE/UNUSED/ARCHIVE2.TPU differ diff --git a/SOURCE/UNUSED/ARCHIVE3.TPU b/SOURCE/UNUSED/ARCHIVE3.TPU new file mode 100644 index 0000000..f0f7a4a Binary files /dev/null and b/SOURCE/UNUSED/ARCHIVE3.TPU differ diff --git a/SOURCE/UNUSED/ARCVIEW.TPU b/SOURCE/UNUSED/ARCVIEW.TPU new file mode 100644 index 0000000..e4b7ec0 Binary files /dev/null and b/SOURCE/UNUSED/ARCVIEW.TPU differ diff --git a/SOURCE/UNUSED/AUTOMSG.TPU b/SOURCE/UNUSED/AUTOMSG.TPU new file mode 100644 index 0000000..c843ab0 Binary files /dev/null and b/SOURCE/UNUSED/AUTOMSG.TPU differ diff --git a/SOURCE/UNUSED/BATCH6.LST b/SOURCE/UNUSED/BATCH6.LST new file mode 100644 index 0000000..1100d7b --- /dev/null +++ b/SOURCE/UNUSED/BATCH6.LST @@ -0,0 +1 @@ +C:\RG\TEMP6.LOG diff --git a/SOURCE/UNUSED/BBSLIST.TPU b/SOURCE/UNUSED/BBSLIST.TPU new file mode 100644 index 0000000..4d1d8bc Binary files /dev/null and b/SOURCE/UNUSED/BBSLIST.TPU differ diff --git a/SOURCE/UNUSED/BOOT.TPU b/SOURCE/UNUSED/BOOT.TPU new file mode 100644 index 0000000..5623b7a Binary files /dev/null and b/SOURCE/UNUSED/BOOT.TPU differ diff --git a/SOURCE/UNUSED/BULLETIN.TPU b/SOURCE/UNUSED/BULLETIN.TPU new file mode 100644 index 0000000..b0a51a9 Binary files /dev/null and b/SOURCE/UNUSED/BULLETIN.TPU differ diff --git a/SOURCE/UNUSED/CHAIN.TXT b/SOURCE/UNUSED/CHAIN.TXT new file mode 100644 index 0000000..c3ac583 --- /dev/null +++ b/SOURCE/UNUSED/CHAIN.TXT @@ -0,0 +1,32 @@ +2 +John Smith +John Smith + +47 +M +00.00 +09/16/07 +80 +24 +255 +1 +0 +1 +0 +359992 +C:\RG\DATA\ +C:\RG\DATA\ +C:\RG\LOGS\SYSOP.LOG +0 +0 +Renegade Bbs +Renegade SysOp +8 +-732954620 +0 +0 +26450 +98 +8N1 + +0 diff --git a/SOURCE/UNUSED/CHAINT~1.TXT b/SOURCE/UNUSED/CHAINT~1.TXT new file mode 100644 index 0000000..d863ab5 --- /dev/null +++ b/SOURCE/UNUSED/CHAINT~1.TXT @@ -0,0 +1,33 @@ +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 + diff --git a/SOURCE/UNUSED/CHANGE.TXT b/SOURCE/UNUSED/CHANGE.TXT new file mode 100644 index 0000000..51e1234 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE.TXT @@ -0,0 +1,212 @@ +Renegade Bug Fixes/Enhancements: + +Batch Uploads: + + 1. Duplicate files can no longer be added to the batch upload queue. + + 2. The number of files that can be added to the batch upload queue + is now limited by the "Max Batch Uploads" setting in the System + Configuration. + + 3. You will now see SysOp Log entries when a user adds, removes, + clears or lists the batch upload queue. + + 4. Changed batch upload listing header/footers from '-' to '=' to + match header/footers in other listings. + + 5. The minimum/maximum batch uploads can now be between 1-255. + + 6. You can now force a user to batch upload all files in the + batch upload queue. This is controlled by the System Configuration + setting "Force batch uploads at login". + + 7. Previously, files were added to the batch upload queue and were + stored in memory utilizing the following: + + TYPE + BatchULRecordType = RECORD + BULFileName: STRING[12]; + BULSection: Integer; + BULDescription: STRING[50]; + BULVPointer: Byte; + END; + + VAR + BatchULArray: ARRAY [1..100] OF ^BatchULRecordType; + NumBatchULFiles: Byte; + + TYPE + ExtendedArray = ARRAY [1..99] OF STRING[50]; + + BatchULV: ARRAY [1..100] OF ^ExtendedArray; + BatchULVPointer: Byte; + + Now, this system has been revamped so that all files added to the + batch upload queue are stored in the external file "BATCHUL.DAT" + and "BATCHUL.EXT". These files are updated by adding, removing, + clearing or uploading batch queued files. This system utilizes + the following: + + TYPE + BatchULRecordType = RECORD + BULFileName: Str12; + BULUserNum, + BULSection: Integer; + BULDescription: Str50; + BULVPointer: LongInt; + BULVTextSize: Integer; + END; + + VAR + BatchULFile: FILE OF BatchULRecordType; + BatchUL: BatchULRecordType; + NumBatchULFiles: Byte; + + TYPE + ExtendedArray = ARRAY [1..99] OF Str50; + + VAR + BatchULF: FILE; + + +Batch Downloads: + + 1. The minimum/maximum batch downloads can now be between 1-255. + + 2. You will now see SysOp Log entries when a user lists the + batch download queue. + + 3. Removed a section of code that would reaccess the *.DIR file to + obtain the file information to a add a file to the batch download + queue. The file information is now passed from the download + command. Of course, numerous variables were no longer required + and were removed. + + 4. Removed a section of code that would reaccess the file to be + downloaded to obtain the filesize of the file for a ratio check. + The filesize is now passed from the download command. Of course, + numerous variables were no longer required and were removed. + + 5. Previously, files were added to the batch download queue and were + stored in memory and in the external file "BATCHDL.DAT" utilizing + the following: + + TYPE + StorageType = + (Disk, + CD, + Copied); + + TransferFlagType = + (lIsAddDLBatch, + IsFileAttach, + IsUnlisted, + IsTempArc, + IsQWK, + IsNoFilePoints, + IsNoRatio, + IsCheckRatio, + IsCDRom, + IsPaused, + IsAutoLogOff, + IsKeyboardAbort, + IsTransferOk); + + BatchDLRecordType = RECORD + BDLFileName: STRING[52]; + BDLStorage: StorageType; + BDLUserNum, + BDLSection, + BDLPoints, + BDLUploader: Integer; + BDLFSize, + BDLTime, + BDLOwnerCRC: LongInt; + BDLFlags: TransferFlagSet; + END; + + VAR + BatchDLArray: ARRAY [1..101] OF ^BatchDLRecordType; + BatchDLFile: FILE OF BatchDLRecordType; + BatchDL: BatchDLRecordType; + BatchDLSize, + BatchDLPoints, + BatchDLTime: LongInt; + NumBatchDLFiles: Byte; + + Now, this system has been revamped so that all files added to the + batch upload queue are stored in the external file "BATCHDL.DAT" + and not in memory. This file is updated by adding, removing, + clearing or downloading batch queued files. This system utilizes + the following: + + TYPE + StorageType = + (Disk, + CD, + Copied); + + TransferFlagType = + (lIsAddDLBatch, + IsFileAttach, + IsUnlisted, + IsTempArc, + IsQWK, + IsNoFilePoints, + IsNoRatio, + IsCheckRatio, + IsCDRom, + IsPaused, + IsAutoLogOff, + IsKeyboardAbort, + IsTransferOk); + + BatchDLRecordType = RECORD + BDLFileName: Str52; + BDLOwnerName: Str36; + BDLStorage: StorageType; + BDLUserNum, + BDLSection, + BDLPoints, + BDLUploader: Integer; + BDLFSize, + BDLTime: LongInt; + BDLFlags: TransferFlagSet; + END; + + VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDL: BatchDLRecordType; + NumBatchDLFiles: Byte; + BatchDLSize, + BatchDLPoints, + BatchDLTime: LongInt; + + +File Points: + + 1. The file credit/debit system has now been changed to a standalone + file point system. As a result, a new variable was added to the + user record for awarding/removing file points. No internal change + was made to how these file points are awarded or removed. Initial + file points can be awarded thru the New User Configuration and/or + the Validation Editor. Some minor verbage changes were made + thru-out the code to accomodate this change. + + +Light Bar Support: + + 1. You can now toggle lightbar support on or off in the System + Configuration for the file area with the option "Use file + area lightbar" or for the message area with the option "Use + message area light bar". + + 2. Menu commands were also added to allow the user to toggle file or + message lightbar support on or off (Assuming these options are + available - See above). + + File Area LightBar Support: CmdKeys = OP, Options = 31 + Message Area LightBar Support: CmdKeys = OP, Options = 32 + + +Enjoy!!! diff --git a/SOURCE/UNUSED/CHANGE1.TXT b/SOURCE/UNUSED/CHANGE1.TXT new file mode 100644 index 0000000..f7e732f --- /dev/null +++ b/SOURCE/UNUSED/CHANGE1.TXT @@ -0,0 +1,27 @@ +Renegade Bug Fixes/Enhancements: + +Variables: + + 1. Numerous local variables that were referenced thru-out the code were + moved to global variables. Hopefully, this will reduce the overall + memory requirements. + + 2. Numerous variables were modified to prevent variable overrun + thru-out the code. + +File Validation: + + 1. Corrected a few places that utilized the SysOp or FileSysOp access + level instead of the global ULValReq System Settings as in other + instances to determine if a file should be validated or not. + +Files.BBS Processing: + + 1. Reduced the total variables required to process a hatched file. + + 2. A successful upload will now show "Hatched" instead of "Added" + in the SysOp Log Entry. As before, you will still see "Duplicate" + if the file already exists or "Missing" if the hatched file can + not be found. + +Enjoy! diff --git a/SOURCE/UNUSED/CHANGE10.TXT b/SOURCE/UNUSED/CHANGE10.TXT new file mode 100644 index 0000000..046cffc --- /dev/null +++ b/SOURCE/UNUSED/CHANGE10.TXT @@ -0,0 +1,53 @@ +Renegade Bug Fix's/Enhancements: + + 1. Fixed a bug that would not allowing the saving of an added voting + answer by the user. + + 2. The Voting Topic Editor has made modified with the following: + + A. The Voting Topic Editor has been modified to have pretty much + the same look and feel of the Menu Editor. + + B. The Voting Topic and Topic Choice Editor Listing will now + display one page at a time verses scrolling to the prompt. + + C. The Voting Topic and Topic Choice Editor question and answer + can not be blank or the default of << New Voting Topic >> or + << New Topic Choice >>. + + D. Unused fields in the Voting Topic and Topic Choice Editor + Insert/Modify command will now display *None*. + + E. The Voting Topic and Topic Choice Editor Insert command will + now display the Topic and Choice Record information for editing + verses just inserting the new record and then requiring you to + go to the modify command to edit. You will not be able to save + the new topic or choice record until all of the above items + are correct. Upon completion of editing the inserted record, + you will be prompted to save or discard the new Topic record. + + F. The Reset Topic option has been moved to the Voting Topic Editor + Main screen and is accessed by pressing "R". You will then be + prompted to enter the record number of the topic you want to + reset. + + G. A Recalculate Voting Topics command has also been added to the + Voting Topic Editor main screen and is accessed by pressing "S". + This option will clear all voting data from the voting topic + records. It will then access the vote array for all User Records + and update the voting topic records based on what question the + user voted on and the choice the user made. This option excludes + deleted users and will ensure that the values in the user.vote + array are set to zero. Depending on Sysop Input, locked out users + could also be excluded per above. + + E. Other changes included adding some missing help data for + certain commands and color changes. + + 3. I recommend that you access the Voting Topic Modify Command + once you have installed this update and toggle thru all + of the voting topic records and make corrections as they are + presented to you. + + + diff --git a/SOURCE/UNUSED/CHANGE11.TXT b/SOURCE/UNUSED/CHANGE11.TXT new file mode 100644 index 0000000..dc4c1a7 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE11.TXT @@ -0,0 +1,28 @@ +Renegade Bug Fix's/Enhancements: + + 1. The Archive Editor has made modified with the following: + + A. The Archive Editor extension can not be blank or the default + of "AAA". + + B. Unused fields in the Archive Editor Insert/Modify command + will now display *None*. + + C. The Archive Editor Insert command will now display the + archive record information for editing verses just inserting + the new record and then requiring you to go to the modify + command to edit. You will not be able to save the new archive + record until all of the above items are correct. Upon completion + of editing the inserted record, you will be prompted to save + or discard the new archive record. + + D. Other changes included adding some missing help data for + certain commands and color changes. + + 2. I recommend that you access the Archive Modify Command + once you have installed this update and toggle thru all + of the archive records and make corrections as they are + presented to you. + + + diff --git a/SOURCE/UNUSED/CHANGE12.TXT b/SOURCE/UNUSED/CHANGE12.TXT new file mode 100644 index 0000000..705af58 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE12.TXT @@ -0,0 +1,28 @@ +Renegade Bug Fix's/Enhancements: + + 1. The Scheme Editor has made modified with the following: + + A. The Scheme Editor description can not be blank or the default + of << New Color Scheme >>. + + B. Unused fields in the Scheme Editor Insert/Modify command + will now display *None*. + + C. The Scheme Editor Insert command will now display the + scheme record information for editing verses just inserting + the new record and then requiring you to go to the modify + command to edit. You will not be able to save the new scheme + record until all of the above items are correct. Upon completion + of editing the inserted record, you will be prompted to save + or discard the new scheme record. + + D. Other changes included adding some missing help data for + certain commands and color changes. + + 2. I recommend that you access the Scheme Modify Command + once you have installed this update and toggle thru all + of the scheme records and make corrections as they are + presented to you. + + + diff --git a/SOURCE/UNUSED/CHANGE13.TXT b/SOURCE/UNUSED/CHANGE13.TXT new file mode 100644 index 0000000..9e1d46f --- /dev/null +++ b/SOURCE/UNUSED/CHANGE13.TXT @@ -0,0 +1,5 @@ + Scan All new public messages + + SAPM[Node#].DAT + + FoundMap: ARRAY [0..4095] OF SET OF 0..7; diff --git a/SOURCE/UNUSED/CHANGE14.TXT b/SOURCE/UNUSED/CHANGE14.TXT new file mode 100644 index 0000000..9b2aa38 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE14.TXT @@ -0,0 +1,29 @@ +Renegade Bug Fix's/Enhancements: + + 1. The History Editor has made modified with the following: + + A. You can not delete the history record for the current date. + + B. You will not be able to insert a new history record for + a date beyond the current date. You can only insert missing + history dates and or dates prior to the first History date. + + C. The History Editor Insert command will now display the + history record information for editing verses just inserting + the new record and then requiring you to go to the modify + command to edit. Upon completion of editing the inserted + record, you will be prompted to save or discard the new + history record. + + D. You can not change a history record date if the date is + utilized by another history record. + + E. The history editor listing will now display one page at a time + verses scrolling to the prompt. + + F. Other changes included adding some missing help data for + certain commands and color changes. + + + + diff --git a/SOURCE/UNUSED/CHANGE2.TXT b/SOURCE/UNUSED/CHANGE2.TXT new file mode 100644 index 0000000..55b2fb4 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE2.TXT @@ -0,0 +1,8 @@ +Renegade Enhancements/Bug Fix's: + + 1. Message Header Editing Option - + + 1. The MAScanOut Flag will no longer be set if the message status + is changed to Un-Sent by a MsgSysOp (or above) if the message + is in the private message area or the message area is not an + Echomail or Groupmail area. diff --git a/SOURCE/UNUSED/CHANGE3.TXT b/SOURCE/UNUSED/CHANGE3.TXT new file mode 100644 index 0000000..c63814b --- /dev/null +++ b/SOURCE/UNUSED/CHANGE3.TXT @@ -0,0 +1,7 @@ +Renegade Bug Fix's/Enhancements: + + 1. The update GIF specifications cmd will now allow updating of + all file areas vice just the current file area. The total GIF + files updated is also now sent to the SysOp.Log. I was also + able to reduce a number of vars utilized in 3 different + procedures down to just one. diff --git a/SOURCE/UNUSED/CHANGE4.TXT b/SOURCE/UNUSED/CHANGE4.TXT new file mode 100644 index 0000000..7585cf6 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE4.TXT @@ -0,0 +1,70 @@ +Renegade Bug Fix's/Enhancements: + + 1. You will now be prompt to set the upload path to the download + path when editing the download path in the File Area Editor. The + 'D' option has been removed due to drive conflicts. + + 2. The File Area Delete has been modified to prompt you to delete + the download/upload directory if they are not being utilized by + another file area. + + 3. The Message Area Editor has made modified with the following: + + A. The message area listing will now display one page at a time + verses scrolling to the prompt. + + B. The File Area Name can not be blank or the default of + << New Message Area >>. + + C. The File Area File Name can not be blank or the default of + NEWBOARD. + + D. The Message Path for Echomail/Groupmail can not be blank. + + E. The Message AKA Address must be an active address setup in + the System Configuration. + + F. The Message Origin for Echomail/Groupmail/QWKmail can not be + blank. + + G. Unused fields in the Insert/Modify command will now + display *None*. + + H. The Message Area Insert command will now display the Message + Area information for editing verses just inserting the + new record and then requiring you to go to the modify + command to edit. You will not be able to save the + new message area until all of the above items are correct. + Upon completion of editing the inserted record, you will + be prompted to save or discard the new message area. The + message directory and the data files will be auto-created + after the new message area is saved. The *.SCN file will + also be updated for all users to scan this file area. + + I. The Message Area Delete command will no longer prompt to + delete the data files if the message area file name is being + utilized by another file area. This option has also been + modified to prompt you to delete the message directory if it + is not being utilized by another message area. + + J. The Message Area Modify command will auto-create the + message directory and data files after editing or + changing to another file area. The *.SCN file will + also be updated to ensure all users are toggled to + scan this message area. You will not be able to save the + message area you are editing until all of the above items + are correct. This command has also been modified + to scan the user file for deleted users and to set the + *.SCN file to allow new scan for the next user to utilize + this message area. + + K. Other changes included added some missing help data for + certain commands and color changes. + + 4. I recommend that you access the File Area Modify command + once you have installed this update and toggle thru all + file areas and make corrections to your file areas as they + are presented to you. + + + diff --git a/SOURCE/UNUSED/CHANGE5.TXT b/SOURCE/UNUSED/CHANGE5.TXT new file mode 100644 index 0000000..2b5a462 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE5.TXT @@ -0,0 +1,42 @@ +Renegade Updates/Enhancements: + + 1. The message area display header was off by one character, fixed. + + 2. In the past, the maximum number of message areas allowed was 2048 with + compression turned on and 32767 with it turned off. Renegade will + now support 32767 message areas with compression on or off. + + 3. The message area listing will now display the message areas one page + at a time vice scrolling thru the entire list. The '?' will now + re-list the message areas starting from message area 1. Pressing + will now display the next page (it will also restart the listing from + message area 1 when the last message area is reached). Pressing 'Q' + will exit the message area display. Previously, this procedure opened + all 3 files associated to a message (*.HDR, *.DAT & *.SCN) to read + the message area scan flag. This process sould now be faster since it + now only opens the *.SCN file. + + 4. The message area change listing will now display the message areas + one page at a time vice scrolling thru the entire list. The '?' will + now re-list the message areas starting from message area 1. Pressing + will now display the next page (it will also restart the listing + from message area 1 when the last message area is reached). Pressing + 'Q' will exit the message area display. Entering an invalid message + area will redisplay the current page. + + 5. The message area set scan listing will now display the message areas + one page at a time vice scrolling thru the entire list. The '?' will + now re-list the message areas starting from message area 1. Pressing + will now display the next page (it will also restart the listing + from message area 1 when the last message area is reached). Pressing + 'Q' will exit the message area display. Previously, this procedure + opened all 3 files associated to a message area (*.HDR, *.DAT & *.SCN) + to set the message area scan flag on or off. This process sould now be + faster since it now only opens the *.SCN file. Also, this procedure + will now only set the scan on message areas the user has access to. + The message area scan char has been moved to the left of the message + area number vice between it and the message area description. + + 6. The file area delete command will now prompt to remove the download + and upload directory if they are not being utilized by another file + area. diff --git a/SOURCE/UNUSED/CHANGE6.TXT b/SOURCE/UNUSED/CHANGE6.TXT new file mode 100644 index 0000000..80499ce --- /dev/null +++ b/SOURCE/UNUSED/CHANGE6.TXT @@ -0,0 +1,70 @@ +Renegade Bug Fix's/Enhancements: + + 1. You will now be prompted to set the upload path to the download + path when editing the download path in the File Area Editor. The + 'D' option has been removed due to drive conflicts. + + 2. The File Area Delete option has been modified to prompt you to + delete the download/upload directory if they are not being utilized + by another file area. + + 3. The Message Area Editor has made modified with the following: + + A. The message area listing will now display one page at a time + verses scrolling to the prompt. + + B. The File Area Name can not be blank or the default of + << New Message Area >>. + + C. The File Area File Name can not be blank or the default of + NEWBOARD. + + D. The Message Path for Echomail/Groupmail can not be blank. + + E. The Message AKA Address for Echomail/Groupmail must be an + active address setup in the System Configuration. + + F. The Message Origin for Echomail/Groupmail/QWKmail can not be + blank. + + G. Unused fields in the Insert/Modify command will now + display *None*. + + H. The Message Area Insert command will now display the Message + Area information for editing verses just inserting the + new record and then requiring you to go to the modify + command to edit. You will not be able to save the + new message area until all of the above items are correct. + Upon completion of editing the inserted record, you will + be prompted to save or discard the new message area. The + message directory and the data files will be auto-created + after the new message area is saved. The *.SCN file will + also be updated for all users to scan this file area. + + I. The Message Area Delete command will no longer prompt to + delete the data files if the message area file name is being + utilized by another file area. This option has also been + modified to prompt you to delete the message directory if it + is not being utilized by another message area. + + J. The Message Area Modify command will auto-create the + message directory and data files after editing or + changing to another file area. The *.SCN file will + also be updated to ensure all users are toggled to + scan this message area. You will not be able to save the + message area you are editing until all of the above items + are correct. This command has also been modified + to scan the user file for deleted users and to set the + *.SCN file to allow new scan for the next user to utilize + this message area. + + K. Other changes included added some missing help data for + certain commands and color changes. + + 4. I recommend that you access the Message Area Modify command + once you have installed this update and toggle thru all + message areas and make corrections to your message areas as they + are presented to you. + + + diff --git a/SOURCE/UNUSED/CHANGE7.TXT b/SOURCE/UNUSED/CHANGE7.TXT new file mode 100644 index 0000000..2ea4747 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE7.TXT @@ -0,0 +1,75 @@ +Renegade bug enhancements: + +1. The file/message area compression routines have been replaced + completely. In the previous version the following variables, + functions and procedures were utilized: + + VAR - "FileCompArray = ARRAY[0..4095] OF SET OF 0..7" + VAR - "MsgCompArray = ARRAY[0..4095] OF SET OF 0..7" + Procedure - "NewCompTables: + Function - "CompFileArea(FArea: Integer): Integer" + Function - "CompMsgArea(MArea: Integer): Integer" + Function - "AFBase(FArea: Integer): Integer" + Function - "AMBase(MArea: Integer): Integer" + + The FileCompArray/MsgCompArray were previously updated by the + NewCompTables Procedure. The NewCompTables Procedure would + simply read in all file/message areas and set a bit to on or off. + The CompFileArea/CompMsgArea Functions would then display the proper + File/Message area after counting from the first file/message area to + the file/message area that needed to be displayed based on the user + access and compression setting in System Configuration. The + AFBase/AMBase Functions were utilized to return the proper file/message + area after counting from the first file/message area to the + file/message area the user actually selected based on the user access + and compression settings in System Confguration. + + As you can see from the above discription, this required alot of + memory to maintain the FileCompArray/MsgCompArray. It also required + four functions for area number display and access. Not to mention + that the real area number for both display and access had to be + counted up to every time an area was displayed or accessed. + + The following varibales, functions and procedures are being + utilized in this release: + + FILE - "FACT[Node].DAT" (Stored in the Node Temp Directory) + FILE - "MACT[Node].DAT" (Stored in the Node Temp Directory) + TYPE - "CompArrayType = ARRAY[0..1] OF INTEGER" + VAR - "LowFileArea: Integer" + VAR - "HighFileArea: Integer" + VAR - "LowMsgArea: Integer" + VAR - "HighMsgArea: Integer" + Procedure - "NewCompTables" + Function - "CompFileArea(FArea,ArrayNum: Integer): Integer" + Function - "CompMsgArea(MArea,ArrayNum: Integer): Integer" + + Two new files (FACT[Node].DAT/MACT[Node].DAT have been created and + are temporarily stored in the Node temp directory. A record of type + ARRAY[0..1] OF Integer is the storage method utilized for the + individual file areas. ARRAY 0 is utilized for storage of the + file/message area to display and ARRAY 1 is utilized for the storage + of the file/message area being accessed. Each record takes up 2 bytes + of space on your harddrive and the above file will only contain + records for the actual number of message/file areas you actually have + available. Both of these files are created at user logon and updated + at other appropriate times as Renegade requires and then deleted when + the user logs off. The NewCompTables Procedure creates and updates + the actual file/message area for display (ARRAY 0) and the actual + file/message area to access (ARRAY 1). This saves on the need to + have the FileCompArray/MsgCompArray and the need for the + CompFileArea/CompMsgArea And AFBase/AMBAse to count everytime + from 1 to the file/message area displayed or accessed. The + CompFileArea/CompMsgArea Functions have been modified to access the + record contained in the FACT[Node].DAT/MACT[Node].DAT file for the + file/message area being display/accessed. This eliminated the need + for the AFBase/AMBase Functions. CompFileArea(FArea,0) or + CompMsgArea(FArea,0) is called to obtained the display area number + and CompFileArea(FArea,1) or CompMsgArea(FArea,1) is called for + the area number to access. NewCompTables will now also return the + LowFileArea, HighFile, LowMsgArea & HighMsgArea for trapping correct + or incorrect file/message area user input. + + As you can see, this enhancement saved alot of memory. Display and + access to a file/message areas should now be faster. Adding the + low/high File/Messae variables will also help trap user input errors. \ No newline at end of file diff --git a/SOURCE/UNUSED/CHANGE8.TXT b/SOURCE/UNUSED/CHANGE8.TXT new file mode 100644 index 0000000..a8121d7 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE8.TXT @@ -0,0 +1,25 @@ +Renegade Enhancements: + + 1. The Conference Editor has made modified with the following: + + A. The Conference Name can not be blank or the default of + << New Conference Record >>. + + B. Unused fields in the Insert/Modify command will now + display *None*. + + C. The Conference Insert option command will now display the + Conference information for editing verses just inserting the + new record and then requiring you to go to the modify + command to edit. You will not be able to save the + new conference until the item above is correct. + Upon completion of editing the inserted record, you will + be prompted to save or discard the new conference area. + + D. The Conference Modify command will also require that the + above item is correct before saving the record being edited. + + 2. I recommend that you access the Conference Modify command + once you have installed this update and toggle thru all + conferences and make corrections to your conferences as they + are presented to you. diff --git a/SOURCE/UNUSED/CHANGE9.TXT b/SOURCE/UNUSED/CHANGE9.TXT new file mode 100644 index 0000000..a9c6bd2 --- /dev/null +++ b/SOURCE/UNUSED/CHANGE9.TXT @@ -0,0 +1,33 @@ +Renegade Bug Fix's/Enhancements: + + 1. The 'Q' and 'q' are no longer available for Validation Keys. + + 2. The Validation Editor has made modified with the following: + + A. The Validation Editor Listing will now display one page at + a time verses scrolling to the prompt. + + B. The Validation Level Description can not be blank or the + default of << New Validation Record >>. + + C. Unused fields in the Validation Editor Insert/Modify command + will now display *None*. + + D. The Validation Editor Insert command will now display the + Validation Record information for editing verses just inserting + the new record and then requiring you to go to the modify + command to edit. You will not be able to save the + new validation record until all of the above items are correct. + Upon completion of editing the inserted record, you will + be prompted to save or discard the new validation record. + + E. Other changes included added some missing help data for + certain commands and color changes. + + 3. I recommend that you access the Validation Modify command + once you have installed this update and toggle thru all + the validation records and make corrections as they are presented + to you. + + + diff --git a/SOURCE/UNUSED/CHANGES.TXT b/SOURCE/UNUSED/CHANGES.TXT new file mode 100644 index 0000000..ca402c3 --- /dev/null +++ b/SOURCE/UNUSED/CHANGES.TXT @@ -0,0 +1,38 @@ +Renegade changes/bug fixes: + +1. File Downloads - + + A. If an actual protocol (Like ZModem) was the first protocol + (or record zero), the downloaded file would not have the UL/DL + ratio checked. This was do to the ratio being set to look for + protocol records from [1..200]. Also, the maximum protocols + allowed at present is 120. The above should have been [0..120] + to be correct. + + B. For the ratio check, the FindFirst procedure would look for the + file on the harddrive even if the ratio didn't need to be checked. + This procedure was moved to only get the filesize if the ratio + needs to be checked. This applies to unlisted downloads, etc. + + NOTE: The FindFirst procedure would allow searching of any type + of file on the hardrive. This has been changed to not allow + searching of Directory, VolumnID, Hidden & SysFiles. + + C. In the present version, duplicate files could be added to the + batch download queue. This alpha release no longer allows + duplicate files in the queue. + + D. Downloading any file locally would place an entry in + the sysop.log that the DL was successfull, fixed. + + E. Adding a file to the batch DL queue will no loner indicate in the + sysop.log that the file was downloaded successfully. Now, it + will either indicate that the file was added to the batch queue or + that an unlisted file was added to the batch queue. Adding a file + to the queue doesn't complete the DL. + + F. The ASCII download of a file has been modified. The allow + continue prompt and a pause after the DL has been added. + +Enjoy!!! + diff --git a/SOURCE/UNUSED/CHANGES1.TXT b/SOURCE/UNUSED/CHANGES1.TXT new file mode 100644 index 0000000..9381d28 --- /dev/null +++ b/SOURCE/UNUSED/CHANGES1.TXT @@ -0,0 +1,44 @@ +File download buf fixes/enhancements: + + 1. The Star procedure would carry the last color to the next + line, fixed. + + 2. Downloading a file locally would increment various dl statistics, + fixed. + + 3. Downloading an unlisted file locally will now prompt the sysop + or user for a path to copy the file to (Like a regular download + currently does). + + 4. The copy command for local downloads, local unlisted downloads + and copy from CDRom now gives more detail as to the status of + the copy both to the user and sysop.log. + + 5. Viewing a text file will now indicate that it was viewed vice + downloaded both to the user and sysop.log. + + 6. Attemtping to view a text file that is missing will no longer + increment the DL statistics. + + 7. The system should no longer allow downloading or uploading of + batch files locally. It should also no longer increment DL/UL + statistics for batch transfers. + + 8. The user record was saved everytime a file was selected for + download even if the download was aborted or not completed, + fixed. + + 9. There was an error in the checking of DL codes against the + returncode when downloading files. The DL codes in the + protocol record are currently strings. This string was being + converted to a numeric value internally even if it were empty. + The string to numeric conversion routine would interpret this + empty string as a value of zero. Since the value for success + was set to a zero also, the system would assume a successful + result. Now, if the DLCode is a null string, it is not compared + against the return code. You may now have to input a zero into + one of the DLCodes in the protocol record for a proper comparison. + This also applies to the ULCodes in the protocol record. + + 10. Removed an extra file area initialization procedure in the DLX + procedure. \ No newline at end of file diff --git a/SOURCE/UNUSED/CHANGES2.TXT b/SOURCE/UNUSED/CHANGES2.TXT new file mode 100644 index 0000000..6fb01fa --- /dev/null +++ b/SOURCE/UNUSED/CHANGES2.TXT @@ -0,0 +1,57 @@ + +Additional Message Editor Changes: + + 1. Non-abortable message changes (New User, etc): + + A. File attachment not allowed - Attaching a file + would change the original subject of the message. + + B. Title change not allowed - The original receiver and + subject should remain the same. + + Note: The user can not abort or save a message that + contains no text. + + 2. File attachment changes: + + A. In previous releases, a user with file attachment access + was not warned if they tried to attach a file when a file + was already attached. However, this basically allowed the + user to swap out the file should they attach an incorrect + file. In this release, if a file is already attached, the + attached file will be displayed and the user will be prompted + to replace the file. I took this a step further, a user may + also want to remove the attached file all together. Presently, + there is no option for this without aborting the message. + Therefore, an option has been added for removing the attached + file. In this case, the user is also prompted to change the + message subject. If the subject contains no text, removing + the attached file is aborted. + + 3. Error messages: + + A. I did not feel there was adequate messages to the user as to + certain editor options. So, this area has been greatly + expanded. For example: Pressing "C" to clear a message + when the message contains no text, now informs the user of + this situation rather then nothing at all. + + 4. Empty messages: + + A. In an effort to reduce the possibilty of an empty message being + saved, the following apply: + + 1. All null lines at the end of a message are deleted. + 2. All lines at the end of a message containing nothing + but spaces are deleted. + + NOTE: Lines are reviewed in reverse order up to the first + line containing text. The user will not be able to + save the message unless it contains some kind of + text. + + 5. Title change: + + A. In certain cases, changing the title would actually remove + the subject of the message. I believe this error has now + been corrected. \ No newline at end of file diff --git a/SOURCE/UNUSED/CHANGES3.TXT b/SOURCE/UNUSED/CHANGES3.TXT new file mode 100644 index 0000000..94d494a --- /dev/null +++ b/SOURCE/UNUSED/CHANGES3.TXT @@ -0,0 +1,18 @@ +Renegade enhancements/bug fix's: + + 1. Removed a duplicate procedure for crediting the uploader for a + file that was downloaded by another user. + + 2. During a batch download, if no DL/Temp log was specified in the + protocol editor, the uploader did not receive credit for the + download. Other system/user statistics were updated though, + fixed. + + 3. The above credit procedure never worked anyway due to some + calculation errors in the code, fixed. + + 4. A message telling the user to enjoy the file was only displayed + if the user was charged file points, fixed. + + 5. Messages to the user and the sysop.log provide additonal + information about the Single Download. \ No newline at end of file diff --git a/SOURCE/UNUSED/CHANGES4.TXT b/SOURCE/UNUSED/CHANGES4.TXT new file mode 100644 index 0000000..c8608c5 --- /dev/null +++ b/SOURCE/UNUSED/CHANGES4.TXT @@ -0,0 +1,133 @@ +Renegade BBS Enhancements/Bug Fix's: + + 1. Before the posting of a message or uploading of a file + (Batch/Single), the available drive space was checked to + ensure adequate space exists according to the system setup. + This section of the code was duplicated in 3 places. I converted + this section to a function reducing numerous lines of code and + extra variabes whenever it was utilized in the code. + + 2. The copy/move procedures are now combined into one function. + Variables for failure, no space and success were required + external to the procedures everytime they were called. Various + messages to the user/sysop.log were also reported external + to these procedures. I also noticed that the move procedure + called the copy procedure if renaming a file was not successfull. + Now, no variables are required externally for the function and + messages to the user/sysop.log are handled internally within + the copy/move function. + + 3. I noticed that a section of the code for executing file + transfer's was duplicated in 4 places. This has been moved to + a single procedure reducing numerous lines of code and + variables. + + 4. I noticed that a section of the code for checking the return + code on file transfer's was duplicated in 3 places. This has + been moved to a single procedure reducing numerous lines of code + and variables. + + 5. The FILES.BBS selected for download during a batch transfer by + the user now contains this starting entry: + + "(BBS Name) Batch Download File Listing" + + Previously, unlisted files were not written to the above list. + Now, they are with "[No Description Available]" as the description. + Also, files in the batch download queue with a bad path download + path will have "[Bad Download Path]" as the description. These + additions help account for files selected for Batch DL by the + user. + + 6. The max dos character field in the protocol editor has now been + limited to 127 characters (Was 255). I always thought it was 128, + however I couldn't type in any more then 127 characters on the + command line in DOS. Please feel free to check this out for + yoursele and change you editor accordingly. + + 7. Removed spaces from the file name written to the protocol file + list for batch downloads. + + 8. The procedure that reads the success/failure codes and file name + from the protocol temp log has been modified. The starting + position of the code and file name is specified in the protocol + editor. Assumming you set this up correctly, the success/failure + code and the filename are copied to temporary strings. The success + code is compared against the returncode from dos for single + download/upload protocols or the DLCode specified in the protocol + editor for batch downloads and the temp log. This code is not + utilized for batch uploads, the file is simply checked for existance. + The temporary file name is compared against the batch queue for + existance. Since different protocol programs like dsz, etc utilize + different log formats, it's impossible to tell the actual length of + the success code or filename read from the temp log. RG would simply + read each string from the starting position and then chop off any + trailing spaces and compared them as per above. However, with ZM + protocol, the file name ends with ",". Therefore, I changed the + comparison to look for the success code/filename to a String POS + procedure rather then String = String. In local tests (Both Single + and Batch) it seemed to work without issue, we will see? The way it + was handled before did not work with ZM protocol. Hopefully, this + solves it for all others (assuming you set things up correctly in the + protocol editor. + + Here's a few things I learned about protocols while editing the + RG code: + + 1. If you set the option "Codes mean" in the protocol editor + to "Transfer Successfull", you must specify a return dlcode + and or ulcode for single protocols of zero. Zero is hard + coded into the procedure that executes the protocol. A + return code of zero from DOS indicates a successfull result. + Of course, you could also reverse the above and specify + "Codes mean" as "Transfer Failed" and specify all possible + DLCodes/ULCodes as something other then zero. + + 2. If you do not specify a temp log for batch downloads, no + error checking occurs within RG. RG assumes the files were + downloaded and increments statistics, etc. RG does not create + the temp log, you must add it to the DL/UL command line. You + must also specify the proper file name and status starting + positions within the log for RG to locate them. Please + read the protocol document for a description of the log + entries and then count out the status & filename positions + for the protocol editor. + + Here's what you need for the ZM protocol: + + 1. Specify a Temp Log. + 2. Add -lz%L to the DL/UL Command Line to create a ZM + style log. + 3. Set "Codes mean" to "Transfer Successfull". + 4. Set DL/UL Code 1 as Z, Set DL/UL Code 2 as z. + 5. Set "File name" to 22. + 6. Set "Status" to 1. + + OR + + 1. Specify a Temp Log. + 2. Add -ld%L to the DL/UL Command Line to create a DSZ + style log. + 3. Set "Codes mean" to "Transfer Successfull". + 4. Set DL/UL Code 1 as Z, Set DL/UL Code 2 as z. + 5. Set "File name" to 51. + 6. Set "Status" to 1. + + 3. The temp log is deleted by RG automatically, if you need + or want a permanent log please specify a UL or DL Log. + + NOTE: I realize some of you may know all there is to know + about protocols and how they are handled by RG. However, + some do not. Remember, if you do not specify all the above, + your files will be transferred without error checking and + statistics will not be updated. Of course, you could forgo + the above setup and RG will assume all files tranferred + successfully. + + 4. Using the above setup may or may not work with currently + released versions of RG or all external protocol programs. + +Please feel free to drop me an email if you require any further +explanation of the above! + +Enjoy!!! \ No newline at end of file diff --git a/SOURCE/UNUSED/CHANGES7.TXT b/SOURCE/UNUSED/CHANGES7.TXT new file mode 100644 index 0000000..cb20b72 --- /dev/null +++ b/SOURCE/UNUSED/CHANGES7.TXT @@ -0,0 +1,42 @@ +Renegade Updates/Enhancements: + + 1. A file can no longer be copied onto itself or moved to the same + directory it currently resides in. + + 2. In local mode, you must have CoSysOp access to move or copy an + attached file or file selected for download. + + 3. I noticed that download and upload statistics were displayed for + batch transfers even if "Log-off after file transfer was selected", + but not for single download or upload transfers, fixed. + + 4. Some items selected for download went thru the DLX procedure and + some went directly to the send procedure. Alot of extra code and + variables were required for the send procedures everytime it was + called. Now, all download requests go thru the DLX procedure and + then to the send procedure. With this change, file downloading + can be tracked for all downloads thru the same statistcal process. + This includes, File attach, QWK, Unlisted and user archive. + + 5. All regular downloads were checked to ensure the user met all + security requirements, ratio, etc prior to the download. However, + if a user was exempt from certain ratio checks, the user was + charged anyway for the download unless the file area was marked + as No-Ratio. This applied to users flagged as No UL/DL Ratio in + the User Record, No UL/DL Ratio in the System record, etc. + + 6. You will now be asked if the file exists on a CDROM for unlisted + downloads. This will alow for faster file transfers since the + file is copied from the CDRom to the Temp Node Directory for + download. + + 7. The default file name for extracting text from a message has been + changed from "MSG.TXT" to MSG.TXT. Of course, you still + have the option of changing this to whatever you like at the + prompt. + + 8. For Offline mail transfers, the bbs will no longer attempt to copy + the WELCOME, NEWS or GOODBYE file if they path to the file is + blank. + +Enjoy!!! \ No newline at end of file diff --git a/SOURCE/UNUSED/CHANGES8.TXT b/SOURCE/UNUSED/CHANGES8.TXT new file mode 100644 index 0000000..43ab41d --- /dev/null +++ b/SOURCE/UNUSED/CHANGES8.TXT @@ -0,0 +1,35 @@ +Renegade updates/enhancements: + + 1. Fixed a bug related to the length of the dlcode/ulcode in the + protocol editor. The maximum length of this string is 6 chars. + + 2. No process was in place to prevent ul/dl statistical variable + overrun, fixed. + + 3. The color from the auto-logoff countdown procedure carried the + last color to the next line, fixed. This would only be noticed + if the user escaped or cancelled the auto-logoff. + + 5. The color from the scaninput procedure carried the last color to + the next line, fixed. I noticed this with the batch download file + remove command. + + 6. Since files added to the batch downloaded queue are listed as such + in the sysop.log, it only made since to list files removed from + the batch download queue in the sysop.log as well. An entry to + the sysop.log is also made when the batch download queue is + cleared. + + 8. The uploader name/date and the message to the user to continue a + resume file did not redisplay the file name when wrapped to the + next page while utlizing the file list command, fixed. + + 9. I think I finally have some issues corrected with the file + listing display. Every now and then an extra file area + header would display when not needed. Also, sometimes the line + counter would be off by one or two lines and push the file area + header up one or two lines or completely off the screen. I also + noticed a line feed missing when the listing was aborted or + exited normally. + +Enjoy!!! diff --git a/SOURCE/UNUSED/CHANGES9.TXT b/SOURCE/UNUSED/CHANGES9.TXT new file mode 100644 index 0000000..3d00d14 --- /dev/null +++ b/SOURCE/UNUSED/CHANGES9.TXT @@ -0,0 +1,29 @@ +Renegade bug fix's/enhancements: + + 1. Due to space limitations, the file listing display will utilize + bytes or kbytes depending on the file point settings in the + system configuration. To be consistant, this process is now + also being utilized for the file size displayed when a file is + selected for download. + + 2. When a file is selected for viewing, the user will be cautioned + that the file is not checked to ensure it is an ascii text file + and then asked if they would like to continue. + + 3. The file listing download and add batch prompt has been cleaned + up. It would formally allow input of '-' by itself or the '-' + proceeding or following a file number and alpha characters. The + input of an invalid file number will now display a message to the + user. + + 4. Adding a file to the batch queue from the file listing display + will now display all the file information related to that file. + It will also now properly check the file to ensure it is ok to + download and send it thru the proper ratio checks. I have to + admit that this was an oversite on my part when I added the + ability to select a file by number. Basically it now goes + directly thru the DLX procedure vice being added directly to + the batch download queue. + +Enjoy!!! + diff --git a/SOURCE/UNUSED/CHNAGE2.TXT b/SOURCE/UNUSED/CHNAGE2.TXT new file mode 100644 index 0000000..56cc9e3 --- /dev/null +++ b/SOURCE/UNUSED/CHNAGE2.TXT @@ -0,0 +1,27 @@ +Renegade Enhancements/Bug Fix's: + + 1. Close Mail Box/Mail Forwarding - + + A. Both of these procedures have been cleaned up with + slight verbage changes and a reduction of variables + required. + + B. A user with access to the User Editor can no longer + setup a user with mail forwarding back to the same + user. + + C. Mail can no longer be forwarded to a locked out user. + + 2. Private Message Read - + + A. This procedure has been cleaned up with slight verbage + changes and a reduction of variables required. + + B. The Message Listing will now display one screen at a + time vice scrolling to the prompt. Entering a "?" + will redisplay the message listing starting at the + first message. Pressing will display the + next screen of messages and or start back at the + first message. A valid message number must be entered + in order to exit to read the message. + diff --git a/SOURCE/UNUSED/COMMON.TPU b/SOURCE/UNUSED/COMMON.TPU new file mode 100644 index 0000000..3c0b306 Binary files /dev/null and b/SOURCE/UNUSED/COMMON.TPU differ diff --git a/SOURCE/UNUSED/COMMON1.TPU b/SOURCE/UNUSED/COMMON1.TPU new file mode 100644 index 0000000..b85e329 Binary files /dev/null and b/SOURCE/UNUSED/COMMON1.TPU differ diff --git a/SOURCE/UNUSED/COMMON2.TPU b/SOURCE/UNUSED/COMMON2.TPU new file mode 100644 index 0000000..c48da15 Binary files /dev/null and b/SOURCE/UNUSED/COMMON2.TPU differ diff --git a/SOURCE/UNUSED/COMMON3.TPU b/SOURCE/UNUSED/COMMON3.TPU new file mode 100644 index 0000000..519138f Binary files /dev/null and b/SOURCE/UNUSED/COMMON3.TPU differ diff --git a/SOURCE/UNUSED/COMMON4.TPU b/SOURCE/UNUSED/COMMON4.TPU new file mode 100644 index 0000000..d582b49 Binary files /dev/null and b/SOURCE/UNUSED/COMMON4.TPU differ diff --git a/SOURCE/UNUSED/COMMON5.TPU b/SOURCE/UNUSED/COMMON5.TPU new file mode 100644 index 0000000..b25e171 Binary files /dev/null and b/SOURCE/UNUSED/COMMON5.TPU differ diff --git a/SOURCE/UNUSED/CRC32.ASM b/SOURCE/UNUSED/CRC32.ASM new file mode 100644 index 0000000..3d120b9 --- /dev/null +++ b/SOURCE/UNUSED/CRC32.ASM @@ -0,0 +1,193 @@ +IDEAL +; This CRC-32 routine and tables were converted from code discovered +; in the DEZIP.PAS V2.0 by R. P. Byrne. The comments there are: +; +; Converted to Turbo Pascal (tm) V4.0 March, 1988 by J.R.Louvau +; COPYRIGHT (C) 1986 Gary S. Brown. You may use this program, or +; code or tables extracted from it, as desired without restriction. +; +; First, the polynomial itself and its table of feedback terms. The +; polynomial is +; X^32+X^26+X^23+X^22+X^16+X^12+X^11+X^10+X^8+X^7+X^5+X^4+X^2+X^1+X^0 +; +; Note that we take it "backwards" and put the highest-order term in +; the lowest-order bit. The X^32 term is "implied"; the LSB is the +; X^31 term, etc. The X^0 term (usually shown as "+1") results in +; the MSB being 1. +; +; Note that the usual hardware shift register implementation, which +; is what we're using (we're merely optimizing it by doing eight-bit +; chunks at a time) shifts bits into the lowest-order term. In our +; implementation, that means shifting towards the right. Why do we +; do it this way? Because the calculated CRC must be transmitted in +; order from highest-order term to lowest-order term. UARTs transmit +; characters in order from LSB to MSB. By storing the CRC this way, +; we hand it to the UART in the order low-byte to high-byte; the UART +; sends each low-bit to high-bit; and the result is transmission bit +; by bit from highest- to lowest-order term without requiring any bit +; shuffling on our part. Reception works similarly. +; +; The feedback terms table consists of 256, 32-bit entries. Notes: +; +; The table can be generated at runtime if desired; code to do so +; is shown later. It might not be obvious, but the feedback +; terms simply represent the results of eight shift/xor opera- +; tions for all combinations of data and CRC register values. +; +; The values must be right-shifted by eight bits by the "updcrc" +; logic; the shift must be unsigned (bring in zeroes). On some +; hardware you could probably optimize the shift in assembler by +; using byte-swap instructions. +; polynomial $edb88320 +; +; +; +; The Pascal logic is: +; +; Function UpdC32(Octet: Byte; Crc: LongInt) : LongInt; +; Begin +; +; UpdC32 := CRC_32_TAB[Byte(Crc XOR LongInt(Octet))] XOR ((Crc SHR 8) +; AND $00FFFFFF); +; +; End {UpdC32}; +; +; This routine computes the 32 bit CRC used by PKZIP and its derivatives, +; and by Chuck Forsberg's "ZMODEM" protocol. The block CRC computation +; should start with high-values (0ffffffffh), and finish by inverting all +; bits. +; +; This TASM conversion done by: +; +; Edwin T. Floyd [76067,747] +; #9 Adams Park Ct. +; Columbus, GA 31909 +; 404-576-3305 (work) +; 404-322-0076 (home) +; +; Borland's Turbo Assembler - TASM is required to assemble this program. +; +SEGMENT code BYTE PUBLIC + ASSUME cs:code + +; 0 +crc32tab dd 000000000h, 077073096h, 0ee0e612ch, 0990951bah + dd 0076dc419h, 0706af48fh, 0e963a535h, 09e6495a3h + dd 00edb8832h, 079dcb8a4h, 0e0d5e91eh, 097d2d988h + dd 009b64c2bh, 07eb17cbdh, 0e7b82d07h, 090bf1d91h +; 1 + dd 01db71064h, 06ab020f2h, 0f3b97148h, 084be41deh + dd 01adad47dh, 06ddde4ebh, 0f4d4b551h, 083d385c7h + dd 0136c9856h, 0646ba8c0h, 0fd62f97ah, 08a65c9ech + dd 014015c4fh, 063066cd9h, 0fa0f3d63h, 08d080df5h +; 2 + dd 03b6e20c8h, 04c69105eh, 0d56041e4h, 0a2677172h + dd 03c03e4d1h, 04b04d447h, 0d20d85fdh, 0a50ab56bh + dd 035b5a8fah, 042b2986ch, 0dbbbc9d6h, 0acbcf940h + dd 032d86ce3h, 045df5c75h, 0dcd60dcfh, 0abd13d59h +; 3 + dd 026d930ach, 051de003ah, 0c8d75180h, 0bfd06116h + dd 021b4f4b5h, 056b3c423h, 0cfba9599h, 0b8bda50fh + dd 02802b89eh, 05f058808h, 0c60cd9b2h, 0b10be924h + dd 02f6f7c87h, 058684c11h, 0c1611dabh, 0b6662d3dh +; 4 + dd 076dc4190h, 001db7106h, 098d220bch, 0efd5102ah + dd 071b18589h, 006b6b51fh, 09fbfe4a5h, 0e8b8d433h + dd 07807c9a2h, 00f00f934h, 09609a88eh, 0e10e9818h + dd 07f6a0dbbh, 0086d3d2dh, 091646c97h, 0e6635c01h +; 5 + dd 06b6b51f4h, 01c6c6162h, 0856530d8h, 0f262004eh + dd 06c0695edh, 01b01a57bh, 08208f4c1h, 0f50fc457h + dd 065b0d9c6h, 012b7e950h, 08bbeb8eah, 0fcb9887ch + dd 062dd1ddfh, 015da2d49h, 08cd37cf3h, 0fbd44c65h +; 6 + dd 04db26158h, 03ab551ceh, 0a3bc0074h, 0d4bb30e2h + dd 04adfa541h, 03dd895d7h, 0a4d1c46dh, 0d3d6f4fbh + dd 04369e96ah, 0346ed9fch, 0ad678846h, 0da60b8d0h + dd 044042d73h, 033031de5h, 0aa0a4c5fh, 0dd0d7cc9h +; 7 + dd 05005713ch, 0270241aah, 0be0b1010h, 0c90c2086h + dd 05768b525h, 0206f85b3h, 0b966d409h, 0ce61e49fh + dd 05edef90eh, 029d9c998h, 0b0d09822h, 0c7d7a8b4h + dd 059b33d17h, 02eb40d81h, 0b7bd5c3bh, 0c0ba6cadh +; 8 + dd 0edb88320h, 09abfb3b6h, 003b6e20ch, 074b1d29ah + dd 0ead54739h, 09dd277afh, 004db2615h, 073dc1683h + dd 0e3630b12h, 094643b84h, 00d6d6a3eh, 07a6a5aa8h + dd 0e40ecf0bh, 09309ff9dh, 00a00ae27h, 07d079eb1h +; 9 + dd 0f00f9344h, 08708a3d2h, 01e01f268h, 06906c2feh + dd 0f762575dh, 0806567cbh, 0196c3671h, 06e6b06e7h + dd 0fed41b76h, 089d32be0h, 010da7a5ah, 067dd4acch + dd 0f9b9df6fh, 08ebeeff9h, 017b7be43h, 060b08ed5h +; A + dd 0d6d6a3e8h, 0a1d1937eh, 038d8c2c4h, 04fdff252h + dd 0d1bb67f1h, 0a6bc5767h, 03fb506ddh, 048b2364bh + dd 0d80d2bdah, 0af0a1b4ch, 036034af6h, 041047a60h + dd 0df60efc3h, 0a867df55h, 0316e8eefh, 04669be79h +; B + dd 0cb61b38ch, 0bc66831ah, 0256fd2a0h, 05268e236h + dd 0cc0c7795h, 0bb0b4703h, 0220216b9h, 05505262fh + dd 0c5ba3bbeh, 0b2bd0b28h, 02bb45a92h, 05cb36a04h + dd 0c2d7ffa7h, 0b5d0cf31h, 02cd99e8bh, 05bdeae1dh +; C + dd 09b64c2b0h, 0ec63f226h, 0756aa39ch, 0026d930ah + dd 09c0906a9h, 0eb0e363fh, 072076785h, 005005713h + dd 095bf4a82h, 0e2b87a14h, 07bb12baeh, 00cb61b38h + dd 092d28e9bh, 0e5d5be0dh, 07cdcefb7h, 00bdbdf21h +; D + dd 086d3d2d4h, 0f1d4e242h, 068ddb3f8h, 01fda836eh + dd 081be16cdh, 0f6b9265bh, 06fb077e1h, 018b74777h + dd 088085ae6h, 0ff0f6a70h, 066063bcah, 011010b5ch + dd 08f659effh, 0f862ae69h, 0616bffd3h, 0166ccf45h +; E + dd 0a00ae278h, 0d70dd2eeh, 04e048354h, 03903b3c2h + dd 0a7672661h, 0d06016f7h, 04969474dh, 03e6e77dbh + dd 0aed16a4ah, 0d9d65adch, 040df0b66h, 037d83bf0h + dd 0a9bcae53h, 0debb9ec5h, 047b2cf7fh, 030b5ffe9h +; F + dd 0bdbdf21ch, 0cabac28ah, 053b39330h, 024b4a3a6h + dd 0bad03605h, 0cdd70693h, 054de5729h, 023d967bfh + dd 0b3667a2eh, 0c4614ab8h, 05d681b02h, 02a6f2b94h + dd 0b40bbe37h, 0c30c8ea1h, 05a05df1bh, 02d02ef8dh + + + MODEL TPASCAL + +PUBLIC UpdateCRC32 +PROC UpdateCRC32 FAR initcrc:DWORD,inbuf:DWORD,inlen:WORD +; UpdateCRC32 takes an initial CRC value and updates it with inlen bytes from +; inbuf. The updated CRC is returned in DX:AX. The Pascal declaration is: +; Function UpdateCRC32(InitCRC : LongInt; Var InBuf; InLen : Word) : LongInt; +; Stomps registers: AX,BX,CX,DX,ES,SI + push ds + lds si,[inbuf] ; ds:si := ^inbuf + les ax,[initcrc] ; dx:ax := initcrc + mov dx,es + mov cx,[inlen] ; cx := inlen + or cx,cx + jz @@done +@@loop: + xor bh,bh + mov bl,al + lodsb + xor bl,al + mov al,ah + mov ah,dl + mov dl,dh + xor dh,dh + shl bx,1 + shl bx,1 + les bx,[crc32tab+bx] + xor ax,bx + mov bx,es + xor dx,bx + loop @@loop +@@done: + pop ds + ret +ENDP + +ENDS +END + \ No newline at end of file diff --git a/SOURCE/UNUSED/CRC32A.PAS b/SOURCE/UNUSED/CRC32A.PAS new file mode 100644 index 0000000..0b8480c --- /dev/null +++ b/SOURCE/UNUSED/CRC32A.PAS @@ -0,0 +1,132 @@ +unit crc32a; +{ + /* ============================================================= */ + /* COPYRIGHT (C) 1986 Gary S. Brown. You may use this program, or */ + /* code or tables extracted from it, as desired without restriction. */ + /* */ + /* First, the polynomial itself and its table of feedback terms. The */ + /* polynomial is */ + /* X^32+X^26+X^23+X^22+X^16+X^12+X^11+X^10+X^8+X^7+X^5+X^4+X^2+X^1+X^0 */ + /* */ + /* Note that we take it "backwards" and put the highest-order term in */ + /* the lowest-order bit. The X^32 term is "implied"; the LSB is the */ + /* X^31 term, etc. The X^0 term (usually shown as "+1") results in */ + /* the MSB being 1. */ + /* */ + /* Note that the usual hardware shift register implementation, which */ + /* is what we're using (we're merely optimizing it by doing eight-bit */ + /* chunks at a time) shifts bits into the lowest-order term. In our */ + /* implementation, that means shifting towards the right. Why do we */ + /* do it this way? Because the calculated CRC must be transmitted in */ + /* order from highest-order term to lowest-order term. UARTs transmit */ + /* characters in order from LSB to MSB. By storing the CRC this way, */ + /* we hand it to the UART in the order low-byte to high-byte; the UART */ + /* sends each low-bit to hight-bit; and the result is transmission bit */ + /* by bit from highest- to lowest-order term without requiring any bit */ + /* shuffling on our part. Reception works similarly. */ + /* */ + /* The feedback terms table consists of 256, 32-bit entries. Notes: */ + /* */ + /* The table can be generated at runtime if desired; code to do so */ + /* is shown later. It might not be obvious, but the feedback */ + /* terms simply represent the results of eight shift/xor opera- */ + /* tions for all combinations of data and CRC register values. */ + /* */ + /* The values must be right-shifted by eight bits by the "updcrc" */ + /* logic; the shift must be unsigned (bring in zeroes). On some */ + /* hardware you could probably optimize the shift in assembler by */ + /* using byte-swap instructions. */ + /* polynomial $edb88320 */ + /* */ + /* -------------------------------------------------------------------- */ +} + +interface + +type + pbyte = ^byte; + longrec = record + lo,hi : word; + end; + +var + crc32val : longint; + + +procedure updatecrc(s : pchar; len : integer); + +implementation + +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); + +procedure updatecrc(s : pchar; len : integer); +(* update running CRC calculation with contents of a buffer *) + +var + crcl : longrec absolute crc32val; + x : integer; + +begin + for x := 1 to len do + begin + crc32val := crc_32_tab[lo(crcl.lo) xor byte(s^)] xor ((crc32val +shr 8) and $00ffffff); + inc(s); + end; +end; + + +end. diff --git a/SOURCE/UNUSED/CUSER.TPU b/SOURCE/UNUSED/CUSER.TPU new file mode 100644 index 0000000..22373fb Binary files /dev/null and b/SOURCE/UNUSED/CUSER.TPU differ diff --git a/SOURCE/UNUSED/DEZIP.PAS b/SOURCE/UNUSED/DEZIP.PAS new file mode 100644 index 0000000..507419d --- /dev/null +++ b/SOURCE/UNUSED/DEZIP.PAS @@ -0,0 +1,1192 @@ +Program DeZip; + +{ DeZip v1.5 (C) Copyright 1989 by R. P. Byrne } +{ } +{ This is a "bare-bones" program to extract files from ZIP archives. } +{ By "bare-bones", I mean that there is no facility included to do anything } +{ but extraction (ie. no echo to console, no send to printer, etc.). } +{ If relative pathnames are stored in the Zip file, make sure all of the } +{ required directories exist on your system before attempting an } +{ extraction. } + +{$M 10240, 0, 0} { Stack, Min. Heap, Max. Heap} +{$F+} { Force far calls } + +Uses + Dos, + Crt, + MemAlloc, + StrProcs; + +Const + COPYRIGHT = 'DeZip (C) Copyright 1989 by R. P. Byrne'; + VERSION = 'Version 1.5 - Compiled on March 11, 1989'; + +{ Stuff needed generically by all uncompression methods } + +Const + MAXNAMES = 20; + +Var + InFileSpecs : Array[1..MAXNAMES] of String; { Input file specifications } + MaxSpecs : Word; { Total number of entries in InFileSpecs array } + OutPath : String; { Output path specification } + + TenPercent : LongInt; + +{ Define ZIP file header types } + +Const + LOCAL_FILE_HEADER_SIGNATURE = $04034B50; + +Type + Local_File_Header_Type = Record + { Signature : LongInt; } + Extract_Version_Reqd : Word; + Bit_Flag : Word; + Compress_Method : Word; + Last_Mod_Time : Word; + Last_Mod_Date : Word; + Crc32 : LongInt; + Compressed_Size : LongInt; + Uncompressed_Size : LongInt; + Filename_Length : Word; + Extra_Field_Length : Word; + end; + +Const + CENTRAL_FILE_HEADER_SIGNATURE = $02014B50; + +Type + Central_File_Header_Type = Record + { Signature : LongInt; } + MadeBy_Version : Word; + Extract_Version_Reqd : Word; + Bit_Flag : Word; + Compress_Method : Word; + Last_Mod_Time : Word; + Last_Mod_Date : Word; + Crc32 : LongInt; + Compressed_Size : LongInt; + Uncompressed_Size : LongInt; + Filename_Length : Word; + Extra_Field_Length : Word; + File_Comment_Length : Word; + Starting_Disk_Num : Word; + Internal_Attributes : Word; + External_Attributes : LongInt; + Local_Header_Offset : LongInt; + End; + +Const + END_OF_CENTRAL_DIR_SIGNATURE = $06054B50; + +Type + End_of_Central_Dir_Type = Record + { Signature : LongInt; } + Disk_Number : Word; + Central_Dir_Start_Disk : Word; + Entries_This_Disk : Word; + Total_Entries : Word; + Central_Dir_Size : LongInt; + Start_Disk_Offset : LongInt; + ZipFile_Comment_Length : Word; + end; + +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 +); + +Const + BUFSIZE = 8192; { Size of buffers for I/O } + +Type + BufPtr = ^BufType; + BufType = Array[1..BUFSIZE] of Byte; + +Var + ZipName : String; { Name of Zip file to be processed } + ZipFile : File; { Zip file variable } + EndFile : Boolean; { End of file indicator for ZipFile } + ZipBuf : BufPtr; { Input buffer for ZipFile } + ZipPtr : Word; { Index for ZipFile input buffer } + ZipCount : Word; { Count of bytes in ZipFile input buffer } + + ExtFile : File; { Output file variable } + ExtBuf : BufPtr; { Output buffer for ExtFile } + ExtPtr : Word; { Index for ExtFile output buffer } + ExtCount : LongInt; { Count of characters written to output } + + LocalHdr : Local_File_Header_Type; { Storage for a local file hdr } + Hdr_FileName : String; + Hdr_ExtraField : String; + Hdr_Comment : String; + + Crc32Val : LongInt; { Running CRC (32 bit) value } + + Bytes_To_Go : LongInt; { Bytes left to process in compressed file } + + +{ Stuff needed for unSHRINKing } + +Const + MINCODESIZE = 9; + MAXCODESIZE = 13; + SPECIAL = 256; + FIRSTFREE = 257; + LZW_TABLE_SIZE = (1 SHL MAXCODESIZE) - 1; { 0..8191 } + LZW_STACK_SIZE = (1 SHL MAXCODESIZE) - 1; { 0..8191 } + +Type + + LZW_Table_Rec = Record + Prefix : Integer; + Suffix : Byte; + ChildCount : Word; { If ChildCount = 0 then leaf node } + end; + LZW_Table_Ptr = ^LZW_Table_Type; + LZW_Table_Type = Array[0..LZW_TABLE_SIZE] of LZW_Table_Rec; + + FreeListPtr = ^FreeListArray; + FreeListArray = Array[FIRSTFREE..LZW_TABLE_SIZE] of Word; + + StackPtr = ^StackType; + StackType = Array[0..LZW_STACK_SIZE] of Word; + +Var + LZW_Table : LZW_Table_Ptr; { Code table for LZW decoding } + FreeList : FreeListPtr; { List of free table entries } + NextFree : Word; { Index for free list array } + { FreeList^[NextFree] always contains the } + { index of the next available entry in } + { the LZW Prefix:Suffix table (LZW_Table^) } + LZW_Stack : StackPtr; { A stack used to build decoded strings } + StackIdx : Word; { Stack array index variable } + { StackIdx always points to the next } + { available entry in the stack } + SaveByte : Byte; { Our input code buffer - 1 byte long } + BitsLeft : Byte; { Unprocessed bits in the input code buffer } + FirstCh : Boolean; { Flag indicating first char being processed } + + +{ Stuff needed for unREDUCEing } + +Type + FollowerSet = Record + SetSize : Word; + FSet : Array[0..31] of Byte; + end; + FollowerPtr = ^FollowerArray; + FollowerArray = Array[0..255] of FollowerSet; + + StreamPtr = ^StreamArray; + StreamArray = Array[0..4095] of Byte; + +Var + Followers : FollowerPtr; + Stream : StreamPtr; { The output stream } + StreamIdx : Word; { Always points to next pos. to be filled } + State : Byte; + Len : Word; + V : Byte; + +{ --------------------------------------------------------------------------- } + +Procedure Abort(Msg : String); +Begin + Writeln; + Writeln(Msg); + Writeln('Returning to DOS'); + Writeln; + Halt; +end {Abort}; + +{ --------------------------------------------------------------------------- } + +Procedure Syntax; +Begin + Writeln('Usage: DeZip ZipFileName [OutPathSpec] [FileSpec [...]]'); + Writeln; + Writeln('Optional file specifications may contain DOS '); + Writeln('wildcard characters.'); + Writeln; + Writeln('If no filespecs are entered, *.* is assumed.'); + Writeln; + Halt; +End; + +{ --------------------------------------------------------------------------- } + +Function HexLInt(L : LongInt) : String; +Type + HexType = Array [0..15] of Char; +Const + HexChar : HexType = ('0','1','2','3','4','5','6','7', + '8','9','A','B','C','D','E','F'); +Begin + HexLInt := HexChar[(L AND $F0000000) SHR 28] + + HexChar[(L AND $0F000000) SHR 24] + + HexChar[(L AND $00F00000) SHR 20] + + HexChar[(L AND $000F0000) SHR 16] + + HexChar[(L AND $0000F000) SHR 12] + + HexChar[(L AND $00000F00) SHR 8] + + HexChar[(L AND $000000F0) SHR 4] + + HexChar[(L AND $0000000F) ] + + 'h'; +end {HexLInt}; + +{ --------------------------------------------------------------------------- } + +Function IO_Test : Boolean; +Var + ErrorCode : Word; + CodeStr : String; + Ok : Boolean; +Begin + Ok := TRUE; + ErrorCode := IOResult; + If ErrorCode <> 0 then begin + Ok := FALSE; + Case ErrorCode of + 2 : Writeln('File Not Found'); + 3 : Writeln('Path Not Found'); + 5 : Writeln('Access Denied'); + 101 : Writeln('Disk Full'); + else Writeln('I/O Error # ', ErrorCode); + end {Case}; + end {if}; + IO_Test := Ok; +end {IO_Test}; + +{ --------------------------------------------------------------------------- } + +Procedure Load_Parms; +Var + I : Word; + Name : String; + DosDTA : SearchRec; +Begin + I := ParamCount; + If I < 1 then + Syntax; + + ZipName := ParamStr(1); + For I := 1 to Length(ZipName) do + ZipName[I] := UpCase(ZipName[I]); + If Pos('.', ZipName) = 0 then + ZipName := ZipName + '.ZIP'; + + MaxSpecs := 0; + OutPath := ''; + I := 1; + While I < ParamCount do begin + Inc(I); + Name := ParamStr(I); + If Name[length(Name)] = '\' then + Delete(Name, length(Name), 1); + FindFirst(Name, DIRECTORY, DosDTA); { outpath spec? } + If DosError = 0 then begin + If (DosDTA.Attr AND DIRECTORY) <> 0 then begin { yup } + OutPath := Name; + If OutPath[Length(OutPath)] <> '\' then + OutPath := OutPath + '\'; + end {then} + else begin + If MaxSpecs < MAXNAMES then begin + Inc(MaxSpecs); + InFileSpecs[MaxSpecs] := Name; + end {if}; + end {if}; + end {then} + else begin + If MaxSpecs < MAXNAMES then begin + Inc(MaxSpecs); + InFileSpecs[MaxSpecs] := Name; + end {if}; + end {if} + end {while}; + + If MaxSpecs = 0 then begin + MaxSpecs := 1; + InFileSpecs[1] := '*.*'; + end {if}; + +end {Load_Parms}; + +{ --------------------------------------------------------------------------- } + +Procedure Initialize; +Var + Code : Integer; +Begin + Code := Malloc(ZipBuf, SizeOf(ZipBuf^)) OR + Malloc(ExtBuf, SizeOf(ExtBuf^)); + If Code <> 0 then + Abort('Not enough memory available to allocate I/O buffers!'); +end {Initialize}; + +{ --------------------------------------------------------------------------- } + +{ Converted to Turbo Pascal (tm) V4.0 March, 1988 by J.R.Louvau } +{ COPYRIGHT (C) 1986 Gary S. Brown. You may use this program, or } +{ code or tables extracted from it, as desired without restriction. } +{ } +{ First, the polynomial itself and its table of feedback terms. The } +{ polynomial is } +{ X^32+X^26+X^23+X^22+X^16+X^12+X^11+X^10+X^8+X^7+X^5+X^4+X^2+X^1+X^0 } +{ } +{ Note that we take it "backwards" and put the highest-order term in } +{ the lowest-order bit. The X^32 term is "implied"; the LSB is the } +{ X^31 term, etc. The X^0 term (usually shown as "+1") results in } +{ the MSB being 1. } +{ } +{ Note that the usual hardware shift register implementation, which } +{ is what we're using (we're merely optimizing it by doing eight-bit } +{ chunks at a time) shifts bits into the lowest-order term. In our } +{ implementation, that means shifting towards the right. Why do we } +{ do it this way? Because the calculated CRC must be transmitted in } +{ order from highest-order term to lowest-order term. UARTs transmit } +{ characters in order from LSB to MSB. By storing the CRC this way, } +{ we hand it to the UART in the order low-byte to high-byte; the UART } +{ sends each low-bit to hight-bit; and the result is transmission bit } +{ by bit from highest- to lowest-order term without requiring any bit } +{ shuffling on our part. Reception works similarly. } +{ } +{ The feedback terms table consists of 256, 32-bit entries. Notes: } +{ } +{ The table can be generated at runtime if desired; code to do so } +{ is shown later. It might not be obvious, but the feedback } +{ terms simply represent the results of eight shift/xor opera- } +{ tions for all combinations of data and CRC register values. } +{ } +{ The values must be right-shifted by eight bits by the "updcrc" } +{ logic; the shift must be unsigned (bring in zeroes). On some } +{ hardware you could probably optimize the shift in assembler by } +{ using byte-swap instructions. } +{ polynomial $edb88320 } +{ } + +Function UpdC32(Octet: Byte; Crc: LongInt) : LongInt; +Var + L : LongInt; + W : Array[1..4] of Byte Absolute L; +Begin + + UpdC32 := CRC_32_TAB[Byte(Crc XOR LongInt(Octet))] XOR ((Crc SHR 8) AND $00FFFFFF); + +end {UpdC32}; + +{ --------------------------------------------------------------------------- } + +Procedure Read_Zip_Block; +Begin + BlockRead(ZipFile, ZipBuf^, BUFSIZE, ZipCount); + If ZipCount = 0 then + EndFile := TRUE; + ZipPtr := 1; +End {Read_Zip_Block}; + +{ --------------------------------------------------------------------------- } + +Procedure Write_Ext_Block; +Begin + If ExtPtr > 1 then begin + BlockWrite(ExtFile, ExtBuf^, Pred(ExtPtr)); + If NOT IO_Test then + Halt; + ExtPtr := 1; + end {if}; +End {Write_Ext_Block}; + +{ --------------------------------------------------------------------------- } + +Procedure Open_Zip; +Begin + Assign(ZipFile, ZipName); + FileMode := 64; { Read Only / Deny None } + {$I-} Reset(ZipFile, 1) {$I+}; + If NOT IO_Test then + Halt; + EndFile := FALSE; + Read_Zip_Block; +End {Open_Zip}; + +{ --------------------------------------------------------------------------- } + +Function Open_Ext : Boolean; +Begin + Assign(ExtFile, OutPath + Hdr_FileName); + FileMode := 66; { Read & Write / Deny None } + {$I-} Rewrite(ExtFile, 1) {$I+}; + If NOT IO_Test then + Open_Ext := FALSE + else begin + ExtPtr := 1; + Open_Ext := TRUE; + end {if}; +end {Open_Ext}; + +{ --------------------------------------------------------------------------- } + +Function Get_Zip : Integer; +Begin + If ZipPtr > ZipCount then + Read_Zip_Block; + + If EndFile then + Get_Zip := -1 + else begin + Get_Zip := ZipBuf^[ZipPtr]; + Inc(ZipPtr); + end {if}; +end {Get_Zip}; + +{ --------------------------------------------------------------------------- } + +Procedure Put_Ext(C : Byte); +Begin + Crc32Val := UpdC32(C, Crc32Val); + ExtBuf^[ExtPtr] := C; + Inc(ExtPtr); + Inc(ExtCount); + If ExtPtr > BUFSIZE then + Write_Ext_Block; +end {Put_Ext}; + +{ --------------------------------------------------------------------------- } + +Procedure Close_Zip; +Begin + {$I-} Close(Zipfile) {$I+}; + If IO_Test then ; +end {Close_Zip}; + +{ --------------------------------------------------------------------------- } + +Procedure Close_Ext; +Type + TimeDateRec = Record + Time : Word; + Date : Word; + end {record}; +Var + TimeDate : TimeDateRec; + TimeDateStamp : LongInt Absolute TimeDate; +Begin + Write_Ext_Block; + TimeDate.Time := LocalHdr.Last_Mod_Time; + TimeDate.Date := LocalHdr.Last_Mod_Date; + SetFTime(ExtFile, TimeDateStamp); + {$I-} Close(ExtFile) {$I+}; + If IO_Test then ; + GotoXY(1, WhereY); + Write(ExtCount); + GotoXY(1, WhereY); +end {Close_Ext}; + +{ --------------------------------------------------------------------------- } + +Procedure FSkip(Offset : LongInt); +Var + Rec : LongInt; +Begin + If (Offset + ZipPtr) <= ZipCount then + Inc(ZipPtr, Offset) + else begin + Rec := FilePos(ZipFile) + (Offset - (ZipCount - ZipPtr) - 1); + {$I-} Seek(ZipFile, Rec) {$I+}; + If NOT IO_Test then + Halt; + Read_Zip_Block; + end {if}; +end {FSkip}; + +{ --------------------------------------------------------------------------- } + +Procedure FRead(Var Buf; RecLen : Word); +Var + I : Word; + B : Array[1..MaxInt] of Byte Absolute Buf; +Begin + For I := 1 to RecLen do + B[I] := Get_Zip; +end {FRead}; + +{ --------------------------------------------------------------------------- } + +Function Read_Local_Hdr : Boolean; +Var + Sig : LongInt; +Begin + If EndFile then + Read_Local_Hdr := FALSE + else begin + FRead(Sig, SizeOf(Sig)); + If Sig = CENTRAL_FILE_HEADER_SIGNATURE then begin + Read_Local_Hdr := FALSE; + EndFile := TRUE; + end {then} + else begin + If Sig <> LOCAL_FILE_HEADER_SIGNATURE then + Abort('Missing or invalid local file header in ' + ZipName); + FRead(LocalHdr, SizeOf(LocalHdr)); + With LocalHdr do begin + If FileName_Length > 255 then + Abort('Filename of compressed file exceeds 255 characters!'); + FRead(Hdr_FileName[1], FileName_Length); + Hdr_FileName[0] := Chr(FileName_Length); + If Extra_Field_Length > 255 then + Abort('Extra field of compressed file exceeds 255 characters!'); + FRead(Hdr_ExtraField[1], Extra_Field_Length); + Hdr_ExtraField[0] := Chr(Extra_Field_Length); + end {with}; + Read_Local_Hdr := TRUE; + end {if}; + end {if}; +end {Read_Local_Hdr}; + +{ --------------------------------------------------------------------------- } + +Function Get_Compressed : Integer; +Var + PctDone : Integer; +Begin + If Bytes_To_Go = 0 then + Get_Compressed := -1 + else begin + Get_Compressed := Get_Zip; + If Bytes_To_Go mod TenPercent = 0 then begin + PctDone := 100 - Round( 100 * (Bytes_To_Go / LocalHdr.Compressed_Size)); + GotoXY(WhereX - 4, WhereY); + Write(PctDone:3, '%'); + end {if}; + Dec(Bytes_To_Go); + end {if}; +end {Get_Compressed}; + +{ --------------------------------------------------------------------------- } + +Function LZW_Init : Boolean; +Var + RC : Word; + I : Word; +Label + Exit; +Begin + { Initialize LZW Table } + RC := Malloc(LZW_Table, SizeOf(LZW_Table^)); + If RC <> 0 then begin + LZW_Init := FALSE; + Goto Exit; + end {if}; + For I := 0 to LZW_TABLE_SIZE do begin + With LZW_Table^[I] do begin + Prefix := -1; + If I < 256 then + Suffix := I + else + Suffix := 0; + ChildCount := 0; + end {with}; + end {for}; + + RC := Malloc(FreeList, SizeOf(FreeList^)); + If RC <> 0 then begin + LZW_Init := FALSE; + Goto Exit; + end {if}; + For I := FIRSTFREE to LZW_TABLE_SIZE do + FreeList^[I] := I; + NextFree := FIRSTFREE; + + { Initialize the LZW Character Stack } + RC := Malloc(LZW_Stack, SizeOf(LZW_Stack^)); + If RC <> 0 then begin + LZW_Init := FALSE; + Goto Exit; + end {if}; + StackIdx := 0; + LZW_Init := TRUE; + +Exit: +end {LZW_Init}; + +{ --------------------------------------------------------------------------- } + +Procedure LZW_Cleanup; +Var + Code : Word; +Begin + Code := Dalloc(LZW_Table); + Code := Dalloc(FreeList); + Code := Dalloc(LZW_Stack); +end {LZW_Cleanup}; + +{ --------------------------------------------------------------------------- } + +Procedure Clear_LZW_Table; +Var + I : Word; +Begin + StackIdx := 0; + + For I := FIRSTFREE to LZW_TABLE_SIZE do begin { Find all leaf nodes } + If LZW_Table^[I].ChildCount = 0 then begin + LZW_Stack^[StackIdx] := I; { and put each on stack } + Inc(StackIdx); + end {if}; + end {for}; + + NextFree := Succ(LZW_TABLE_SIZE); + + While StackIdx > 0 do begin { clear all leaf nodes } + Dec(StackIdx); + I := LZW_Stack^[StackIdx]; + With LZW_Table^[I] do begin + If LZW_Table^[I].Prefix <> -1 then + Dec(LZW_Table^[Prefix].ChildCount); + Prefix := -1; + Suffix := 0; + ChildCount := 0; + end {with}; + Dec(NextFree); { add cleared nodes to freelist } + FreeList^[NextFree] := I; + end {while}; + +End {Clear_LZW_Table}; + +{ --------------------------------------------------------------------------- } + +Procedure Add_To_LZW_Table(Prefix : Integer; Suffix : Byte); +Var + I : Word; +Begin + + If NextFree <= LZW_TABLE_SIZE then begin + I := FreeList^[NextFree]; + Inc(NextFree); + LZW_Table^[I].Prefix := Prefix; + LZW_Table^[I].Suffix := Suffix; + Inc(LZW_Table^[Prefix].ChildCount); + end {if}; + +End {Add_To_LZW_Table}; + +{ --------------------------------------------------------------------------- } + +Function Get_Code(CodeSize : Byte) : Integer; +Const + Mask : Array[1..8] of Byte = ($01, $03, $07, $0F, $1F, $3F, $7F, $FF); + TmpInt : Integer = 0; +Var + BitsNeeded : Byte; + HowMany : Byte; + HoldCode : Integer; +Label + Exit; +Begin + If FirstCh then begin { If first time through ... } + TmpInt := Get_Compressed; { ... then prime the code buffer } + If TmpInt = -1 then begin { If EOF on fill attempt ... } + Get_Code := -1; { ... then return EOF indicator ... } + Goto Exit; { ... and return to caller. } + end {if}; + SaveByte := TmpInt; + BitsLeft := 8; { there's now 8 bits in our buffer } + FirstCh := FALSE; + end {if}; + + BitsNeeded := CodeSize; + HoldCode := 0; + + While (BitsNeeded > 0) And (TmpInt <> -1) do begin + + If BitsNeeded >= BitsLeft + then HowMany := BitsLeft { HowMany <-- Min(BitsLeft, BitsNeeded) } + else HowMany := BitsNeeded; + + HoldCode := HoldCode OR ((SaveByte AND Mask[HowMany]) SHL (CodeSize - BitsNeeded)); + SaveByte := SaveByte SHR HowMany; + Dec(BitsNeeded, HowMany); + Dec(BitsLeft, HowMany); + + If BitsLeft <= 0 then begin { If no bits left in buffer ... } + TmpInt := Get_Compressed; { ... then attempt to get 8 more. } + If TmpInt = -1 then + Goto Exit; + SaveByte := TmpInt; + BitsLeft := 8; + end {if}; + + end {while}; + +Exit: + + If (BitsNeeded = 0) then { If we got what we came for ... } + Get_Code := HoldCode { ... then return it } + else + Get_Code := -1; { ... Otherwise, return EOF } + +end {Get_Code}; + +{ --------------------------------------------------------------------------- } + +Procedure UnShrink; +Var + Ch : Char; + CodeSize : Byte; { Current size (in bits) of codes coming in } + CurrCode : Integer; + SaveCode : Integer; + PrevCode : Integer; + BaseChar : Byte; +Label + Exit; +Begin + CodeSize := MINCODESIZE; { Start with the smallest code size } + + PrevCode := Get_Code(CodeSize); { Get first code from file } + If PrevCode = -1 then { If EOF already, then ... } + Goto Exit; { ... just exit without further ado } + BaseChar := PrevCode; + Put_Ext(BaseChar); { Unpack the first character } + + CurrCode := Get_Code(CodeSize); { Get next code to prime the while loop } + + While CurrCode <> -1 do begin { Repeat for all compressed bytes } + + If CurrCode = SPECIAL then begin { If we've got a "special" code ... } + + CurrCode := Get_Code(CodeSize); + Case CurrCode of + 1 : Begin { ... and if followed by a 1 ... } + Inc(CodeSize); { ... then increase code size } + end {1}; + 2 : Begin { ... and if followed by a 2 ... } + Clear_LZW_Table; { ... clear leaf nodes in the table } + end {2}; + else begin { ... if neither 1 or 2, discard } + Writeln; + Writeln('Encountered code 256 not followed by 1 or 2!'); + Writeln; + Write('Press a key to continue ...'); + Ch := ReadKey; + DelLine; + GotoXY(1, WhereY); + end {else}; + end {case}; + + end {then} + else begin { Not a "special" code } + + SaveCode := CurrCode; { Save this code someplace safe... } + + If CurrCode > LZW_TABLE_SIZE then + Abort('Invalid code encountered!'); + + If (CurrCode >= FIRSTFREE) and (LZW_Table^[CurrCode].Prefix = -1) then begin + If StackIdx > LZW_STACK_SIZE then begin + Write_Ext_Block; + Writeln; + Writeln('Stack Overflow (', StackIdx, ')!'); + Halt; + end {if}; + LZW_Stack^[StackIdx] := BaseChar; + Inc(StackIdx); + CurrCode := PrevCode; + end {if}; + + While CurrCode >= FIRSTFREE do begin + If StackIdx > LZW_STACK_SIZE then begin + Write_Ext_Block; + Writeln; + Writeln('Stack Overflow (', StackIdx, ')!'); + Halt; + end {if}; + LZW_Stack^[StackIdx] := LZW_Table^[CurrCode].Suffix; + Inc(StackIdx); + CurrCode := LZW_Table^[CurrCode].Prefix; + end {while}; + + BaseChar := LZW_Table^[CurrCode].Suffix; { Get last character ... } + Put_Ext(BaseChar); + + While (StackIdx > 0) do begin + Dec(StackIdx); + Put_Ext(LZW_Stack^[StackIdx]); + end {while}; { ... until there are none left } + + Add_to_LZW_Table(PrevCode, BaseChar); { Add new entry to table } + + PrevCode := SaveCode; + + end {if}; + + CurrCode := Get_Code(CodeSize); { Get next code from input stream } + + end {while}; +Exit: +end {UnShrink}; + +{ --------------------------------------------------------------------------- } + +Function Init_UnReduce : Boolean; +Var + Code : Word; +Label + Exit; +Begin + Code := Malloc(Followers, SizeOf(Followers^)); + If Code <> 0 then begin + Init_UnReduce := FALSE; + Goto Exit; + end {if}; + + Code := Malloc(Stream, SizeOf(Stream^)); + If Code <> 0 then begin + Init_UnReduce := FALSE; + Goto Exit; + end {if}; + + Init_UnReduce := TRUE; + +Exit: +end {Init_UnReduce}; + +{ --------------------------------------------------------------------------- } + +Procedure Cleanup_UnReduce; +Var + Code : Word; +Begin + Code := Dalloc(Followers); + Code := Dalloc(Stream); +end {Cleanup_UnReduce}; + +{ --------------------------------------------------------------------------- } + +Function D(X, Y : Byte) : Word; +Var + tmp : LongInt; +Begin + X := X SHR (8 - Pred(LocalHdr.Compress_Method)); + Tmp := X * 256; + D := Tmp + Y + 1; +end {D}; + +{ --------------------------------------------------------------------------- } + +Function F(X : Word) : Byte; +Const + TestVal : Array[1..4] of Byte = (127, 63, 31, 15); +Begin + If X = TestVal[Pred(LocalHdr.Compress_Method)] then + F := 2 + else + F := 3; +end {F}; + +{ --------------------------------------------------------------------------- } + +Function L(X : Byte) : Byte; +Const + Mask : Array[1..4] of Byte = ($7F, $3F, $1F, $0F); +Begin + L := X AND Mask[Pred(LocalHdr.Compress_Method)]; +end {L}; + +{ --------------------------------------------------------------------------- } + +Procedure StreamOut(C : Byte); +Begin + Put_Ext(C); + Stream^[StreamIdx] := C; + StreamIdx := Succ(StreamIdx) MOD 4096; +end {StreamOut}; + +{ --------------------------------------------------------------------------- } + +Procedure ScrnchInit; +Begin + State := 0; + For StreamIdx := 0 to 4095 do + Stream^[StreamIdx] := 0; + StreamIdx := 0; +end {ScrnchInit}; + +{ --------------------------------------------------------------------------- } + +Procedure UnScrnch(C : Byte); +Const + DLE = $90; +Var + S : Integer; + Count : Word; + OneByte : Byte; + Tmp1 : LongInt; +Begin + Case State of + 0 : begin + If C = DLE then + State := 1 + else + StreamOut(C); + end {0}; + 1 : begin + If C = 0 then begin + StreamOut(DLE); + State := 0; + end {then} + else begin + V := C; + Len := L(V); + State := F(Len); + end {if}; + end {1}; + 2 : begin + Inc(Len, C); + State := 3; + end {2}; + 3 : begin + Tmp1 := D(V, C); + S := StreamIdx - Tmp1; + If S < 0 then + S := S + 4096; + Count := Len + 3; + While Count > 0 do begin + OneByte := Stream^[S]; + StreamOut(OneByte); + S := Succ(S) MOD 4096; + Dec(Count); + end {while}; + State := 0; + end {3}; + end {case}; + +end {UnScrnch}; + +{ --------------------------------------------------------------------------- } + +Function MinBits(Val : Byte) : Byte; +Begin + Dec(Val); + Case Val of + 0..1 : MinBits := 1; + 2..3 : MinBits := 2; + 4..7 : MinBits := 3; + 8..15 : MinBits := 4; + 16..31 : MinBits := 5; + else MinBits := 6; + end {case}; +end {MinBits}; + +{ --------------------------------------------------------------------------- } + +Procedure UnReduce; +Var + LastChar : Byte; + N : Byte; + I, J : Word; + Code : Integer; + Ch : Char; +Begin + For I := 255 downto 0 do begin { Load follower sets } + N := Get_Code(6); { Get size of 1st set } + Followers^[I].SetSize := N; + If N > 0 then + For J := 0 to Pred(N) do + Followers^[I].FSet[J] := Get_Code(8); + end {for}; + + ScrnchInit; + + LastChar := 0; + Repeat + + If Followers^[LastChar].SetSize = 0 then begin + Code := Get_Code(8); + UnScrnch(Code); + LastChar := Code; + end {then} + else begin + Code := Get_Code(1); + If Code <> 0 then begin + Code := Get_Code(8); + UnScrnch(Code); + LastChar := Code; + end {then} + else begin + I := MinBits(Followers^[LastChar].SetSize); + Code := Get_Code(I); + UnScrnch(Followers^[LastChar].FSet[Code]); + LastChar := Followers^[LastChar].FSet[Code]; + end {if}; + end {if}; + Until (ExtCount = LocalHdr.Uncompressed_Size); + Code := Dalloc(Followers); +end {UnReduce}; + +{ --------------------------------------------------------------------------- } + +Procedure UnZip; +Var + C : Integer; +Begin + Crc32Val := $FFFFFFFF; + Bytes_To_Go := LocalHdr.Compressed_Size; + FirstCh := TRUE; + + ExtCount := 0; + + TenPercent := LocalHdr.Compressed_Size DIV 10; + + Case LocalHdr.Compress_Method of + 0 : Begin + While Bytes_to_go > 0 do + Put_Ext(Get_Compressed); + end {0 = Stored}; + 1 : Begin + If LZW_Init then + UnShrink + else begin + Writeln('Not enough memory available to unshrink!'); + Writeln('Skipping ', Hdr_FileName, ' ...'); + FSkip(LocalHdr.Compressed_Size); + Crc32Val := NOT LocalHdr.Crc32; + end {if}; + LZW_Cleanup; + end {1 = shrunk}; + 2..5 : Begin + If Init_UnReduce then + UnReduce + else begin + Writeln('Not enough memory available to unreduce!'); + Writeln('Skipping ', Hdr_FileName, ' ...'); + FSkip(LocalHdr.Compressed_Size); + Crc32Val := NOT LocalHdr.Crc32; + end {if}; + Cleanup_UnReduce; + end {2..5}; + else Begin + Writeln('Unknown compression method used on ', Hdr_FileName); + Writeln('Skipping ', Hdr_FileName, ' ...'); + FSkip(LocalHdr.Compressed_Size); + Crc32Val := NOT LocalHdr.Crc32; + end {else}; + end {case}; + + Crc32Val := NOT Crc32Val; + If Crc32Val <> LocalHdr.Crc32 then begin + Writeln; + Writeln('WARNING: File ', OutPath + Hdr_FileName, ' fails CRC check!'); + Writeln(' Stored CRC = ', HexLInt(LocalHdr.Crc32), + ' Calculated CRC = ', HexLInt(Crc32Val)); + end {if}; + +end {UnZip}; + +{ --------------------------------------------------------------------------- } + +Procedure Extract_File; +Var + YesNo : Char; + DosDTA : SearchRec; +Label + Exit; +Begin + FindFirst(OutPath + Hdr_FileName, ANYFILE, DosDTA); + If DosError = 0 then begin + Write('WARNING: ', OutPath + Hdr_FileName, ' already exists. Overwrite (Y/N)? '); + YesNo := ReadKey; + Writeln(YesNo); + If UpCase(YesNo) <> 'Y' then begin + FSkip(LocalHdr.Compressed_Size); + Goto Exit; + end {if}; + end {if}; + + If Open_Ext then begin + Write('Extracting: ', OutPath + Hdr_FileName, ' ... '); + UnZip; + GotoXY(WhereX - 4, WhereY); + ClrEol; + Writeln(' done'); + Close_Ext; + end {then} + else begin + Writeln('Could not open output file ', OutPath + Hdr_FileName, '! Skipping to next file ...'); + FSkip(LocalHdr.Compressed_Size); + end {If}; +Exit: +end {Extract_File}; + +{ --------------------------------------------------------------------------- } + +Procedure Extract_Zip; +Var + Match : Boolean; + I : Word; +Begin + Open_Zip; + While Read_Local_Hdr do begin + Match := FALSE; + I := 1; + Repeat + If SameFile(InFileSpecs[I], Hdr_FileName) then + Match := TRUE; + Inc(I); + Until Match or (I > MaxSpecs); + If Match then + Extract_File + else + FSkip(LocalHdr.Compressed_Size); + end {while}; + Close_Zip; + GotoXY(1, WhereY); + ClrEOL; +end; + +{ --------------------------------------------------------------------------- } + +Begin + Assign(Output, ''); + Rewrite(Output); + Writeln; + Writeln(COPYRIGHT); + Writeln(VERSION); + Writeln; + Load_Parms; { get command line parameters } + Initialize; { one-time initialization } + Extract_Zip; { de-arc the file } +end. diff --git a/SOURCE/UNUSED/DOOR.SYS b/SOURCE/UNUSED/DOOR.SYS new file mode 100644 index 0000000..bbdb6c0 --- /dev/null +++ b/SOURCE/UNUSED/DOOR.SYS @@ -0,0 +1,52 @@ +COM0: +0 +8 +6 +0 +Y +N +Y +N +Lee Palmer +Kellogg, ID +000 000-0000 +000 000-0000 +PASSWORD +255 +32 +10/02/09 +1965732 +32762 +GR +24 +Y +@,A +@ +01/01/70 +2 +Z +0 +0 +0 +32767 +02/04/60 +F:\RG\DATA\ +F:\RG\DATA\ +Renegade SysOp +Lee Palmer +00:00 +N +N +Y +3 +0 +10/02/09 +17:58 +15:56 +32767 +0 +0 +0 + +0 +0 diff --git a/SOURCE/UNUSED/DOOR32.SYS b/SOURCE/UNUSED/DOOR32.SYS new file mode 100644 index 0000000..f15fdb5 --- /dev/null +++ b/SOURCE/UNUSED/DOOR32.SYS @@ -0,0 +1,11 @@ +0 + +0 +Renegade BBS 09-17-07/Alpha +2 +John Smith +John Smith +255 +5998 +1 +6 diff --git a/SOURCE/UNUSED/DOOR32~1.TXT b/SOURCE/UNUSED/DOOR32~1.TXT new file mode 100644 index 0000000..4a20054 --- /dev/null +++ b/SOURCE/UNUSED/DOOR32~1.TXT @@ -0,0 +1,121 @@ +.--------------------------------------------------------------------------. + | DOOR32 Revision 1 Specifications Updated: Feb 23rd, 2001 | + `--------------------------------------------------------------------------' + + What is Door32? + --------------- + + Door32 is a standard text-based drop file designed to take advantage of + 32-bit operating systems. Supporting handle inheritance, it will allow + for doors to work under multiple platforms and over both serial and + socket (telnet) connections. + + Programming Door32 Doors + ------------------------ + There are several freeware door libraries which support Door32 although + most if not all of them are for Pascal at this time. These libraries are + able to compile doors for DOS, Windows, OS/2, and Linux. + + I personally suggest the D32 library which is freeware and comes with + source code. It can compile doors for DOS, Windows, OS/2 and Linux using + various Pascal compilers. There are other great door libraries as well, + so give them all a try! + + Testing Door32 Support in BBS Software + -------------------------------------- + Included in the Door32 specification archive is a Win32 executable by the + name of SAMPLE.EXE. This is a very simple Door32 compatible door compiled + with the Pascal library mentioned above. BBS authors may find this + program useful for testing their Door32 support. + + Notes about Door32 Programming + ------------------------------ + At this point, there seems to be two things which need to be kept + in mind when doing Door32 programming: + + 1. Under Linux or any operating system with case sensitive file names, + the Door32 drop file (DOOR32.SYS) will be created with all lower + cased lettering. IE: door32.sys + + 2. There appears to be a bug in the Win32 programming API (ie, a bug in + Windows) which prevents Door32 programs from running from a batch + file. This means that the doors have to be executed directly from + the software. Instead of running MYDOOR.BAT which eventually + executes MYDOOR.EXE, you must run MYDOOR.EXE directly. This problem + has said to have been fixed in Windows NT, but still exists under + the Windows 9x platforms. + + What does this mean to BBS authors? Not much. + + What does this mean to DOOR authors? Maybe some changes... + + Because Door32 doors must be executed directly, there is a good + chance that the current directory will NOT be the directory that + your door executable is stored. When porting an old DOS door, + the door might assume that the system is in the same directory + as the .EXE when loading data files. Because of this, it is + recommended that you have your Door switch to the directory where + the door .EXE is located, or read that directory and use it when + accessing door related files. In Pascal, this is a sample of + getting the directory where the door .EXE is found: + + Function ProgPath : String; + Var + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + Begin + FSplit (ParamStr(0), Dir, Name, Ext); + ProgPath := Dir + '\'; + End; + + The above example will return the path where your door is located. + Some door libraries might already switch to the directory of the + executable, so you may not have to worry about it. + + The DOOR32.SYS Drop file + ------------------------ + + Below is the final Revision 1 version of DOOR32.SYS. It is a straight + DOS-style text file in all lower cased letters under operating systems + with case sensitive file systems: + +[cut here]------------------------------------------------------------------- + +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 + +[cut here]------------------------------------------------------------------- + + * The following are values we've predefined for the emulation: + + 0 = Ascii + 1 = Ansi + 2 = Avatar + 3 = RIP + 4 = Max Graphics + + Avatar, RIP, and Max Graphics all have ANSI fallback support, so most door + libraries that don't support those emulations can just use ANSI if emulation + 2, 3, or 4 is encountered. + + Conclusion + ---------- + + Thats it for the Revision 1 specifications of DOOR32.SYS. You can find the + latest information at the official Door32 web page: + + http://www.mysticbbs.com/door32 + + You can e-mail mysticbbs@geocities.com for any questions or suggestions + relating to Door32 or post a message in the FidoNet DOORGAMES echo + diff --git a/SOURCE/UNUSED/DOORS.TPU b/SOURCE/UNUSED/DOORS.TPU new file mode 100644 index 0000000..3837f43 Binary files /dev/null and b/SOURCE/UNUSED/DOORS.TPU differ diff --git a/SOURCE/UNUSED/DOORSY~1.DOC b/SOURCE/UNUSED/DOORSY~1.DOC new file mode 100644 index 0000000..34a8f3a Binary files /dev/null and b/SOURCE/UNUSED/DOORSY~1.DOC differ diff --git a/SOURCE/UNUSED/DORINFO1.DEF b/SOURCE/UNUSED/DORINFO1.DEF new file mode 100644 index 0000000..1d20586 --- /dev/null +++ b/SOURCE/UNUSED/DORINFO1.DEF @@ -0,0 +1,13 @@ +The Renegade BBS +Renegade +SysOp +COM0 +0 BAUD,N,8,1 +0 +LEE +PALMER +Kellogg, ID +1 +255 +32762 +0 diff --git a/SOURCE/UNUSED/DORINF~1.TXT b/SOURCE/UNUSED/DORINF~1.TXT new file mode 100644 index 0000000..fd5d47c --- /dev/null +++ b/SOURCE/UNUSED/DORINF~1.TXT @@ -0,0 +1,29 @@ +Lines are ended with carriage return and linefeed combination. The fields are: +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. + +-------------------------------------------------------------------------------- diff --git a/SOURCE/UNUSED/DRAG_010.PAS b/SOURCE/UNUSED/DRAG_010.PAS new file mode 100644 index 0000000..6f81ba6 --- /dev/null +++ b/SOURCE/UNUSED/DRAG_010.PAS @@ -0,0 +1,1333 @@ +{***************************************************************************} +{* Dragon Bulletin Board System *} +{* Copyright (c) 1998 By Dragon Software *} +{* All rights reserved. *} +{* *} +{* ----------------------------------- *} +{* Dragon Version .010 Data Structures *} +{* ----------------------------------- *} +{* *} +{***************************************************************************} + +CONST + {**************************************************************************} + {* The following values are used by the system for user fields *} + {* "ask" values will be asked of the user the next time they logon if *} + {* the question is part of the new user logon *} + {* "none" values are normally for optional fields where the user simply *} + {* pressed *} + {**************************************************************************} + User_String_Ask = ' '; {Ask for user string fields} + User_String_None = ''; {None for user string fields} + + User_Date_Ask = $fe21; {Ask for user date fields - 1/1/2027} + User_Date_None = $0021; {None for user date fields - 1/1/0} + + 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 + DefaultYesNoType = ( {Default/yes/no type} + dyn_default, {Default} + dyn_yes, {Yes} + dyn_no {No} + ); {1 byte} + + ArFlagType = '@'..'Z'; {AR flags} + + ArFlagset = SET OF ArFlagType; {Set of AR flags} + + FlagRec = ( {User special flags} + AutoPrivDel, {A = Force user to delete private mail} + NoPostCall, {B = No post call ratio} + ForceULScan, {C = Force this user to automatically scan when uploading} + Ranon, {D = Restrict from posting anonymous} + RbbsList, {E = Restrict from adding to other BBS list} + Rchat, {F = Restrict from chatting} + NoDLlimit, {G = No download ratio limit} + RpubMsg, {H = Restrict from posting public mail} + RprivMsg, {I = Restrict from sending private mail} + Rvoting, {J = Restrict from voting} + OneCall, {K = One call per day allowed} + PubNotVal, {L = Public posts are not validated} + ProtDel, {M = Protect from deletion} + NoFilePts, {N = No file point checks} + RfileVal, {O = Credit from upload on validation} + Pause, {P = [PAUSE] active} + Ansi, {Q = ANSI graphics active} + Color, {R = Color active if ANSI present} + OneKey, {S = Onekey input used instead of line input} + Alert, {T = Alert active from user's next call} + FlagRecUnused, {U = Unused} + MboxClosed, {V = Mail box closed to all but SysOp's} + Tabs, {W = VT100 tabs are used to optimize display} + ClsChar {X = Clear screen characters used} + ); {3 bytes used for 24 flags in set} + + FlagSet = SET OF FlagRec; {Set of special flags} + + UlRecFlagType = ( {File section flags} + IsCdRom, {Section is on a CD-ROM (read only device)} + uuUlRecFlag1, {Reserved} + uuUlRecFlag2, {Reserved} + uuUlRecFlag3, {Reserved} + uuUlRecFlag4, {Reserved} + uuUlRecFlag5, {Reserved} + uuUlRecFlag6, {Reserved} + uuUlRecFlag7 {Reserved} + ); {1 byte} + + UlRecFlagSet = {Set of file section flags} + SET OF UlRecFlagType; + + ConfigFlagRec = ( {User configuration flags} + UseCustomMenus, {A = Allow custom ANSI menus} + ClsMsgRead, {B = Clear screen between reading messages} + DoNotDisturbUser, {C = Do not disturb user (multi-user only)} + LogonScanAllMsgSections, {D = Scan all msg sections at logon for mail} + QWKNewBulletins, {E = Put new bulletins in QWK packet} + QWKNewFiles, {F = Put new files list in QWK packet} + uuCFFlag18, {G = Reserved} + uuCFFlag17, {H = Reserved} + uuCFFlag16, {I = Reserved} + uuCFFlag15, {J = Reserved} + uuCFFlag14, {K = Reserved} + uuCFFlag13, {L = Reserved} + uuCFFlag12, {M = Reserved} + uuCFFlag11, {N = Reserved} + uuCFFlag10, {O = Reserved} + uuCFFlag9, {P = Reserved} + uuCFFlag8, {Q = Reserved} + uuCFFlag7, {R = Reserved} + uuCFFlag6, {S = Reserved} + uuCFFlag5, {T = Reserved} + uuCFFlag4, {U = Reserved} + uuCFFlag3, {V = Reserved} + uuCFFlag2, {W = Reserved} + uuCFFlag1 {X = Reserved} + ); {3 bytes used for 24 flags in set} + + ConfigFlagSet = {Set of configuration flags} + SET OF ConfigFlagRec; + + {**********************************************************************} + {* ColorRec = Array of B&W / Color Color Bytes *} + {**********************************************************************} + ColorRec = ARRAY[FALSE..TRUE, {False = B&W, True = Color} + 0..9] {0..9 = Color number} + OF BYTE; + + SmalRec = RECORD {User name index - NAMES.LST} + Name : STRING[36]; {User name} + + Number : INTEGER; {User number} + END; + + UserRec = RECORD {User log - USER.LST} + Uname, {User name} + Rname : STRING[36]; {Real name} + + ADDR, {Address} + ComType, {Computer type} + CityState, {City/State} + Snote : STRING[30]; {SysOp note} + + LastDate, {Last date on - Semi-MS-DOS 1900 based format} + LastTime : WORD; {Last time on - MS-DOS format} + + PW : STRING[16]; {Password} + + Phone : STRING[12]; {Phone number 1} + + Zcode : STRING[10]; {Zip code} + + Phone2 : STRING[12]; {Phone number 2} + + ExtraStr1, {Extra string 1} + ExtraStr2, {Extra string 2} + ExtraStr3 : STRING[40]; {Extra string 3} + + ExtraDate1, {Extra date 1 - Semi-MS-DOS 1900 based format} + ExtraDate2 : WORD; {Extra date 2 - Semi-MS-DOS 1900 based format} + + ExtraWord1, {Extra word 1} + ExtraWord2, {Extra word 2} + ExtraWord3, {Extra word 3} + ExtraWord4 : WORD; {Extra word 4} + + ExtraChar1, {Extra character 1} + ExtraChar2, {Extra character 2} + ExtraChar3, {Extra character 3} + ExtraChar4 : CHAR; {Extra character 4} + + ExtraPhone : STRING[12]; {Extra phone} + + uureserved {Reserved} + : ARRAY[1..3] OF BYTE; + + {**********************************************************************} + {* Vote = An array of Voting Answers, One for each question *} + {**********************************************************************} + Vote : ARRAY[1..20] OF BYTE; {Voting} + + {**********************************************************************} + {* Call spread for last 15 calls - Number of days between each call: *} + {* 0 = Called the same day *} + {* 1..253 = X number of days between *} + {* 254 = 254 or more days between *} + {* 255 = Element not used yet *} + {**********************************************************************} + CallSpr {Call spread} + : ARRAY[1..15] OF BYTE; + + Ttimeon, {Total time on system in minutes} + UlK, {UL K-Bytes} + Dlk : REAL; {DL K-Bytes} + + {**********************************************************************} + {* UserNum = The User number *} + {* 0 -----------------------------> Deleted *} + {* Same as Record Number ----------> Normal *} + {* Different from Record Number ---> Locked Out *} + {**********************************************************************} + UserNum : INTEGER; {User number} + + PrivPost, {Private posts} + PubPost, {Public posts} + FeedBack, {Feedback sent to SysOp} + NumCalls, {Total number of calls to system} + NumUL, {Number of uploads} + NumDL : WORD; {Number of downloads} + + {**********************************************************************} + {* Fmail = Status of Mail Forwarding *} + {* 0 --------> Forwarding inactive *} + {* Other ----> User Number to forward mail to *} + {**********************************************************************} + Fmail : INTEGER; {Forward mail to which user number} + + Hbaud, {Highest baud rate user supports} + TimeToday, {Minutes on system date of last call} + Credit, {Credit for mail in cents} + Debit, {Debit for mail in cents} + Points, {File points} + TimeBank, {Minutes in time bank} + Bday, {Birthdate of user - Semi-MS-DOS format} + LastChange : WORD; {Reserved} + + StrtMenu, {Reserved} + SL, {Security level - SL} + DSL, {Download security level - DSL} + Hlvl, {Help level} + Colms, {Number of screen columns} + Lines, {Number of screen lines} + Callstoday, {Number of calls to system today} + Illegal : BYTE; {Illegal logon attempts} + + Gender : CHAR; {User gender M/F/' '=not specified} + + uulMsgBase, {Reserved} + uuLdlBase, {Reserved} + Cls : BYTE; {Reserved} + + FullEdit : defaultyesnotype; {Full screen editor status} + + Ar : ArFlagset; {AR flag set} + + Flags : FlagSet; {Special flag set} + + FirstOn, {Date first on - Semi-MS-DOS format} + Expires : WORD; {Date expires - Semi-MS-DOS format} + + UserRecUnused : {Reserved} + ARRAY[1..29] OF BYTE; + + Colors : ColorRec; {User colors} + + TBdeposit, {Time deposited in bank today} + TBwithdraw : BYTE; {Time withdraw from bank today} + + AdjTime : INTEGER; {Adjusted time date of last call} + + ConfigFlags : ConfigFlagSet; {Configuration Flags} + + lMbase, {Last message section} + lFbase : WORD; {Last file section} + + LastQWKCRC : LongInt; {CRC of last QWK .REP packet uploaded} + + Unused : Byte; {Reserved} + END; + + SmallMessageRec = RECORD {Short messages - SHORTMSG.DAT} + Msg : STRING[160]; {Message text} + + Destin : INTEGER; {User number of who message is to} + END; + + Vdatar = RECORD {Voting questions - VOTING.DAT} + Question : STRING[74]; {Question} + + NumA : WORD; {Number of answers in below array} + + Answ : ARRAY[0..9] OF RECORD {Array of answer data} + Ans : STRING[40]; {Answer} + + NumRes : WORD; {Number of users who choose this response} + END; + END; + + + UlRec = RECORD {File section - FBOARDS.DAT} + Name : STRING[39]; {Section name 26 Real Len, Rest Colors} + + Filename : STRING[8]; {Listing filename (does not include ".DIR")} + {If UL and DL paths are different,} + {filename for upload section is "FILES"} + {If first character is "@" then *.DIR file} + {is found in main data files directory} + + DlPathname, {Download pathname} + UlPathName : STRING[30]; {Upload pathname} + + Password : STRING[15]; {Password required} + + Flags : UlRecFlagSet; {File section flags} + + DSL, {DSL required} + SeeNames : BYTE; {DSL required to see uploader names} + + ArLvl : ArFlagType; {AR flag required} + + NoRatioGroupNum : BYTE; {bit 0 : Ratio disabled} + {bits 1-7 : Group number } + END; + + Filerec = ( {File flags} + NotValidated, {File is not validated} + OwnerRestricted, {Uploader did not receive credit on upload} + LocalUpload, {File existed locally} { Added } + uuF5, {Reserved} + uuF4, {Reserved} + uuF3, {Reserved} + uuF2, {Reserved} + uuF1 {Reserved} + ); {1 byte used for 8 flags in set} + + FlagRecSet = SET OF Filerec; {Set of file flags} + + UlfRec = RECORD {File listing - *.DIR} + Filename : STRING[12]; {File name} + + Description : STRING[78]; {Description} + + Nacc : WORD; {Number of times file downloaded} + + Unused : BYTE; {Reserved} + + Blocks : WORD; {Number of 128 byte blocks in file} + + Owner : STRING[36]; {Uploader of file} + + Date : STRING[8]; {Date file uploaded} + + DateN : WORD; {Date uploaded in days since Jan 1, 1985} + + Flag : FlagRecSet; {File status} + + Points : BYTE; {File points} + END; + + Range = ARRAY[0..255] OF WORD; {Range of values for all security levels} + + +CONST + numshellfiles = 13; {Number of defined internal shell files} + maxshelldesclength = 29; {Maximum shell file description length} + + + shellfiledesc : {Array of shell file descriptions} + ARRAY[1..numshellfiles] OF + STRING[maxshelldesclength] = ( + 'Front end mailer', {mailer.bat / binkley.bat} + 'External editor', {extedit.bat} + 'External SysOp function key', {extern#.bat} + 'Archive file testing', {filetest.bat} + 'Logon', {logon.bat} + 'New logon', {newlogon.bat} + 'Post download', {postdl.bat} + 'Post upload', {postul.bat} + 'Wait screen special function', {special.bat} + 'TAGMail external reader', {tagmail.bat} + 'Wait screen terminal function', {term.bat} + 'Welcome', {welcome.bat} + 'Logoff' {logoff.bat} + ); + + +TYPE + shellfileflagtype = ( {Shell file flags} + shellshowcall, {Display shell message on screen} + shelllogcall {Log shell message} + ); + + shellfileflagset = {Shell file flag set} + SET OF shellfileflagtype; + + shellfilerec = RECORD + UseSwap : defaultyesnotype; {Swap shell setting} + + Flags : shellfileflagset; {Shell file flags} + END; + + shellfilelist = {Array of shell files} + ARRAY[1..numshellfiles] OF + shellfilerec; + + +CONST + numnewuserquests = 29; {Number of current new user questions} + + maxnewuserdesclength = 15; {Maximum new user description length} + + newuserquestdesc : {Array of new user question descriptions} + ARRAY[0..numnewuserquests] OF + STRING[maxnewuserdesclength] = ( + 'Inactive', + 'Real Name', + 'Address', + 'City State', + 'Zip Code', + 'Phone Number 1', + 'Phone Number 2', + 'Computer Type', + 'Gender', + 'Birthday', + 'Maximum Baud', + 'Extra String 1', + 'Extra String 2', + 'Extra String 3', + 'Extra Date 1', + 'Extra Date 2', + 'Extra Number 1', + 'Extra Number 2', + 'Extra Number 3', + 'Extra Number 4', + 'Extra Char 1', + 'Extra Char 2', + 'Extra Char 3', + 'Extra Char 4', + 'Extra Phone', + 'Columns/Lines*', + 'Pause*', + 'ANSI/Color*', + 'Tabs*', + 'Password*' + ); + + +TYPE + newuserquestrec = RECORD + itemnum : BYTE; {Item number to ask or 0=inactive} + + required : BOOLEAN; {Required/optional} + END; + + newuserquestlist = {Array of new user questions} + ARRAY[1..numnewuserquests] OF + newuserquestrec; + + {*************************************************************************} + {* Provide for full 4D awareness (And point support) *} + {*************************************************************************} + AddressType = RECORD {Fidonet Style Address (24 Bytes)} + Zone, {Zone, 1 = N. America} + Net, {Net, 120 = SE Michigan} + Node, {Node, 116 = CRIMP BBS} + Point : WORD; {Point, 99% of the time = 0} + + Domain : STRING[15]; {As in FIDONET.ORG} + END; + + SystatRec = RECORD {System status - STATUS.DAT} + AltPath, {Alternate file path} + DictPath : STRING[40]; {Dictionary path} + + DefReadMsgMenu : BYTE; {Wait screen read message menu} + + dynamicmsg, {Dynamic message numbering active} + dynamicfile, {Dynamic file numbering active} + waitscreendisable, {Wait screen activity disable} + requiredvoting : BOOLEAN; {Require voting when user logs on} + + automsglines, {Auto message number of lines} + uunewuserexpdays, {Reserved} + addwordsl : BYTE; {Add word to dictionary SL} + + expvalkey : CHAR; {User expired validation key (#13=None)} + + expwarning, {Number of days to give warning before expires} + modifymailflags, {SL when allowed to modify mail flags} + netmailfilerequest, {SL for net mail file requests} + netmailfileattach : BYTE; {SL for net mail file attach} + + ModemDebug, {Modem debug information written to log} + UseXMS, {Use XMS memory for swap shell} + ShowFilesOpen, {Show Files Open on Top Screen} + LocalSysopWindow, {SysOp window when on locally} + AllowSuperFast, {Allow SHIFT password override} + WaitSend, {FOSSIL buffer inactive} + OverlayEMS, {Attempt EMS of overlays} + EMSOverXMS, {Use EMS over XMS memory for swap} + DirectScreen, {Direct screen writes} + UseEMS, {Use EMS memory for swap shell} + useswap, {Use swap shell} + UseFossil, {Use FOSSIL driver} + SnowCheck : BOOLEAN; {Snow checking active} + + BrowseDSL : BYTE; {DSL to have U/D commands on File Browse Menu} + + BbsID : String[8]; {!2.6f - ID used for Qwk Packets} + + TempDlPath : STRING[40]; {Temp File Download Path} + + MinKpost, {Minimum K-Bytes to post} + MinKul : WORD; {Minimum K-Bytes to upload} + + AutoChatBufOpen : BOOLEAN; {Auto chat buffer open} + + nettype : STRING[20]; {Multi-user network type} + + uusystatrec2 : {Reserved} + ARRAY[1..15] OF BYTE; + + LogonPassword, {SL when SysOp PW #1 needed to logon} + ReadTextMsg : BYTE; {SL when allowed to use /READ command} + + AlertChatOnly, {Alert active only when chat on} + genericinfo, {Generic mode active} + LogonPhone : BOOLEAN; {Logon requires phone number} + + DefMsgGroup : STRING[20]; {Default msg section group mask} + DefFileGroup : STRING[20]; {Default file section group mask} + + MaxQWKMsgsSection:Word; {Maximum QWK messages allowed per section} + MaxQWKMsgsTotal :Word; {Maximum QWK messages allowed total} + + uusystatrec3 : + ARRAY[1..9] OF BYTE; {Reserved} + + LastCaller : STRING[42]; {Name and number of last caller} + + MenuFastKeys : STRING[20]; {Menu fast keys (e.g. "/")} + + BoardPW : STRING[16]; {New user password (Null=None)} + + BoardPhone : STRING[12]; {Board phone number} + + SysopColor, {Chat SysOp color} + UserColor : BYTE; {Chat user color} + + PostCallFlag : ArFlagType; {Post call ratio AR flag} + + NoPostCallChk, {SL when post call ratio ignored} + ReinitTime, {Minutes to re-init modem when no calls} + StartMenu : BYTE; {Unused} + + UseAutoMsg, {Display auto-message during logon} + LogonOffHook : BOOLEAN; {Take phone off-hook on local logon} + + NoPointChk : BYTE; {DSL when file points ignored} + + LastDate : STRING[8]; {Date last user logged on} + + Address : AddressType; {Zone/Net/Node/Point/Domain} + + UserOn11x : Boolean; {Use USERON.BBS version 1.1x} + + shellfile : shellfilelist; {Shell file information} + + uushellfile : {Reserved for shell files} + ARRAY[1..10] OF BYTE; + + newuserquest : {New user question information} + newuserquestlist; + + uunewuserquest : {Reserved} + ARRAY[1..270] OF BYTE; + + ActiveModemRecNum : BYTE; {Active Modem Record Number} + + MultiUserPath : STRING[40]; {Multi-user path} + + defusereditlist : BYTE; {Default user editor list mode} + {0=short, 1=normal, 2=extended, 3=info} + + uusystatrec5 : {Reserved} + ARRAY[1..10] OF BYTE; + + GfilesPath : STRING[40]; {Main data files path} + + StoreBadLogon : BOOLEAN; {Store bad logon info in SysOp log} + + MaxBdNum, {Maximum number of batch DL files} + MaxBuNum : BYTE; {Maximum number of batch UL files} + + BoardName : STRING[48]; {Board name} + + SysopMenuSL : BYTE; {SL required for SysOp Control-Q menu} + + SysopMenuAR : ArFlagType; {AR flag required from Control-Q menu} + + SysopName : STRING[36]; {SysOp name} + + SwapPath : STRING[40]; {Swap shell path} + + ChatPW : STRING[16]; {Chat password} + + LastDragonVersion : STRING[20]; {Last version of Dragon to run} { Changed } + + nodelistpath : STRING[40]; {Nodelist directory} + + BoardCityState : String[32]; {Board City, State for QWK Pkt} + + QWKPath : String[40]; {QWK Path} + RIPPath : String[40]; {RIP Path} + + uusystatrec6 : {Reserved} + ARRAY[1..2193] OF BYTE; + + SysopPW : {Array of SysOp passwords} + ARRAY[1..3] OF STRING[16]; + + uusystatrec7 : {Reserved} + ARRAY[1..120] OF BYTE; + + CallerNum, {Total number of calls to system} + UlKtoday, {K-Bytes uploaded today} + DlkToday, {K-Bytes downloaded today} + uur1, {Reserved} + uur2, {Reserved} + uur3 : REAL; {Reserved} + + Users, {Number of active users} + ActiveToday, {Minutes active today} + Callstoday, {Calls today} + MsgPostToday, {Public messages posted today} + EmailToday, {Private messages posted today} + FbackToday, {Feedback sent to SysOp today} + UlToday, {Number of uploads today} + uuw1, {Reserved} + uuw2, {Reserved} + uuw3, {Reserved} + MaxUsers, {Maximum users allowed to be active} + ErrorsToday, {Number of errors today} + NusersToday, {Number of new users today} + DlToday : WORD; {Number of downloads today} + + NewUserMsgTo, {User number new user message sent to} + uui1, {Reserved} + SysopMailTo, {User number mail to "SYSOP" is sent to} + GuestUser, {Guest user number (0=None)} + FailedLogonMsgTo : INTEGER; {Failed logon message sent to} + + uuw5, {Reserved} + UsageLogDays, {Number of days to keep USAGE.LOG} + WaitMailUser : INTEGER; {Mail waiting on wait screen (0=none)} + + UEditJumpSL : BYTE; {SL required for SysOp Control-U menu} + UEditJumpAR : ArFlagType; {AR flag required from Control-U menu} + + NoviceDisplay : BYTE; {Number of calls to display novice msg} + + NodeNumber : BYTE; {Multi-user node number} + + UEditJumpPassword, {Use System pswd for Quick User Edit} + ScanOnUploads : BOOLEAN; {System permits forced scan on uploads} + + MaxTimeInBank : WORD; {Maximum minutes in time bank} + + ShowGifRes, {Show GIF resolution} + CheckUploadSpace, {Show upload drive space} + SystemSecur : BOOLEAN; {Full keyboard security active} + + MultiUser : BOOLEAN; {Board in multi-user mode} + + TBmaxDeposit, {Maximum daily time bank deposit} + TBmaxWithdraw, {Maximum daily time bank withdraw} + SysopLvl, {SL for SysOp} + CoSysopLvl, {SL for CoSysOp} + uub1, {Reserved} + AddBbsLvl, {SL for adding boards to bbs listing} + EmailLvl, {SL for sending normal private mail} + uub2, {Reserved} + uub3, {Reserved} + SeeUnvalLvl, {DSL for seeing unvalidated files} + DlCoSysopLvl, {DSL for Download CoSysOp} + NoRatioChk, {DSL for no ratio} + ReadAnon, {SL to know see anonymous real name } + ReplyAnon, {SL to reply to anonymous private mail } + PublicAnonAny, {SL to post anonymous on any public base} + PrivateAnonAny, {SL to send private anonymous mail } + MaxPublicCall, {Maximum public posts per call} + MaxPrivCall, {Maximum private messages per call} + MaxFbackCall, {Maximum feedback to SysOp per call} + uub4, {Reserved} + SeePasswords, {SL to see user passwords remotely} + uub5, {Reserved} + uub6, {Reserved} + ComPort, {Communications port} + TimeOut, {Minutes for inactivity time-out} + TimeOutBell, {Minutes for inactivity bell} + Backlogdays, {Number of days to keep SYSOP.LOG's} + PrivilegeSL, {Privilege SL} + PrivilegeDSL, {Privilege DSL} + CDmask, {Carrier detect mask} + MaxLogonTries, {Maximum logon attempts per call} + uub7, {Reserved} + uub8, {Reserved} + UlTimePercent, {UL time percent refund} + MaxChats, {Maximum chat pages per call} + uub9, {Reserved} + TagLineSL : BYTE; {Reserved} + + ClosedSystem, {System closed} + TitlePause, {Allow [PAUSE] on welcome screen} + LogonBulletin, {Logon to the bulletin section} + BlankWait, {Blank the wait screen if no activity} + Handles, {Allow handles} + AutoANSIDetect, {Logon auto-detect ANSI} + SecureSystem, {Keyboard security active} + TimePerDay, {Time limits represent time per day} + Mailer, {External mailer active} + SysopFemale, {SysOp is female} + scantosysoplog : BOOLEAN; {File scans are saved in SysOp log} + + TimeAllowed, {SL array of time per call/per day} + UlDlNumRatio, {DSL array of number of file UL ratios} + UlDlKratio, {DSL array of K-Byte UL ratios} + CallsAllowed, {SL array of calls allowed per day} + PostCall : Range; {SL array of posts per 1/10 call} + + AutoRIPDetect : BOOLEAN; {Logon auto-detect RIP} + + uusystatrec8 : + ARRAY[1..7] OF BYTE; {Reserved} + END; + + + MenuFlagType = ( {Menu flag type} + MenuOrCheck, {SL/DSL or AR - When off SL/DSL and AR} + MenuTimeHelpDisplay, {Time/Help display} + MenuBoardDisplayOverride, {Board display override} + MenuNamePrompt, {Menu name prompt} + AscIIClearBeforeMenu, {ASCII Clear screen before printing menu} + AnsiClearBeforeMenu, {ANSI Clear screen before printing menu} + RipClearBeforeMenu, {RIP Clear screen before printing menu} + UUMF9, {Reserved} + UUMF8, {Reserved} + UUMF7, {Reserved} + UUMF6, {Reserved} + UUMF5, {Reserved} + UUMF4, {Reserved} + UUMF3, {Reserved} + UUMF2, {Reserved} + UUMF1 {Reserved} + ); {1 byte} + + MenuFlagSet = {Set of menu flags} + SET OF MenuFlagType; + + CmdFlagType = ( + CmdOrCheck, {SL or AR - When off SL and AR} + CmdHidden, {Hidden status} + CmdLinkToNext, {Link to next} + AscIIClearBeforeCmd, {ASCII clear screen before command} + AscIIPauseAfterCmd, {ASCII pause after command completed} + AnsiClearBeforeCmd, {ANSI clear screen before command} + AnsiPauseAfterCmd, {ANSI pause after command completed} + RipClearBeforeCmd, {RIP clear screen before command} + RipPauseAfterCmd, {RIP pause after command completed} + AnsiOnly, {Command requires ANSI or RIP} + RipOnly, {Command requires RIP} + UUCF5, {Reserved} + UUCF4, {Reserved} + UUCF3, {Reserved} + UUCF2, {Reserved} + UUCF1 {Reserved} + ); {2 bytes} + + CmdFlagSet = {Set of command flags} + SET OF CmdFlagType; + + MenuRec = RECORD {Menus - MENUS.LST} + LongD : STRING[80]; {Menu desc (menu) or Long command desc (cmd)} + + SL, {Security level (SL)} + DSL : Byte; {Download security level (DSL)} + + ArFlags : ArFlagSet; {AR flag set} + + UUMenu:Array[1..10] of byte; {Reserved} + + CASE Menu : BOOLEAN OF {Menu or command - Variant section} +{80} TRUE : + (MenuFlags : MenuFlagSet; {Menu flag set} + + MenuNum : BYTE; {Menu number} + + mPrompt : STRING[48]; {Menu prompt unless MenuNamePrompt active} + + Password : STRING[16]; {Menu password} + + FallBack : BYTE; {Fallback menu number} + + HelpFile : STRING[7]; {Help file ID name} + + StartHelp : BYTE; {Starting help level 0=default} + + Location : BYTE); {Menu location (0=Main, 1=File, 2=ReadMessage)} +{80} FALSE : + (CmdFlags : CmdFlagSet; {Command flag set} + + Pkey : BYTE; {Command PKey} + + Pdata : STRING[30]; {Command PData} + + Shortd : STRING[32]; {Command short description} + + CmdKey : STRING[12]); {Command execution key} + END; {case/record} + + + MacroRec = RECORD {Macro list - MACROS.LST} + UserN : INTEGER; {User number of macro owner} + + Key : {Txt for each of the macros} + ARRAY[1..4] OF STRING[160]; + END; + + + SprotocolRec = RECORD {Single protocols - SPROT.DAT} + Key : STRING[12]; {Execution key} + + Desc : STRING[60]; {Description} + + MinBaud, {Minimum baud rate to use} + MaxBaud : WORD; {Maximum baud rate to use} + + DSL : BYTE; {DSL required} + + TempLog, {Temp log path and name} + UlLog, {UL log path and name} + DlLog : STRING[52]; {DL log path and name} + + UlString, {UL string for DOS call} + DlString : STRING[70]; {DL string for DOS call} + + GoodCode : BOOLEAN; {Result codes mean good transfer} + + DlCode, {DL error level result codes} + ULcode : ARRAY[1..6] OF BYTE; {DL error level result codes} + END; + + BprotocolRec = RECORD {Batch protocols - BPROT.DAT} + Key : STRING[12]; {Execution key} + + Desc : STRING[60]; {Description} + + MinBaud, {Minimum baud rate to use} + MaxBaud : WORD; {Maximum baud rate to use} + + DSL : BYTE; {DSL required} + + UlString, {UL string for DOS call} + DlString : STRING[70]; {DL string for DOS call} + + UlList, {UL file list file path and name} + DlList, {DL file list file path and name} + TempLog, {Temp log path and name} + UlLog, {UL log path and name} + DlLog : STRING[52]; {DL log path and name} + + MaxCmdLen, {Maximum command line length} + PosFn, {Position of filename in log} + PosStatus : BYTE; {Position of status in log} + + GoodCode : BOOLEAN; {Result codes mean good transfer} + + DlCode, {DL status result codes} + ULcode : {UL status result codes} + ARRAY[1..6] OF STRING[10]; + END; + + ValidationRec = RECORD {Validation information - VALIDATE.DAT} + Key : CHAR; {Execution key} + + Desc : STRING[160]; {Descrip sent to user after validation} + {76 max real length - Rest for color} + + SL, {SL to set on validation} + DSL : BYTE; {DSL to set on validation} + + Credit, {Credit in cents to set on validation} + Points, {File points to set on validation} + TimeBank : WORD; {Time bank minutes to set on validation} + + Ar : ArFlagset; {AR flags to set on validation} + + Flags : FlagSet; {Special flags to set on validation} + + UnusedWord : WORD; {Reserved} + END; + + EventType = ( {Event flags} + UnknownEvent, {1 Unknown} + EventIsExternal, {2 External/Internal} + EventIsActive, {3 Active/InActive} + EventIsShell, {4 Shell/Error} + EventIsMonthly, {5 Monthly/Daily} + EventIsPermission, {6 Permission/Restriction} + EventIsChat, {7 Chat Event} + EventIsSoft, {8 Soft/Hard} + + BaudIsActive, {9 Baud Rate Flag} + SLisActive, {10 SL Flag} + DSLisActive, {11 DSL Flag} + ARisActive, {12 ARflag required} + InRatioIsActive, {13 InRatioFlag} + TimeIsActive, {14 Time Flag} + SetARisActive, {15 Set AR flag} + ClearARisActive, {16 Clear AR Flag} + + uuEvent24, {17 Reserved} + uuEvent23, {18 Reserved} + uuEvent22, {19 Reserved} + uuEvent21, {20 Reserved} + uuEvent20, {21 Reserved} + uuEvent19, {22 Reserved} + uuEvent18, {23 Reserved} + uuEvent17, {24 Reserved} + + uuEvent16, {25 Reserved} + uuEvent15, {26 Reserved} + uuEvent14, {27 Reserved} + uuEvent13, {28 Reserved} + uuEvent12, {29 Reserved} + uuEvent11, {30 Reserved} + uuEvent10, {31 Reserved} + uuEvent9, {32 Reserved} + + uuEvent8, {33 Reserved} + uuEvent7, {34 Reserved} + uuEvent6, {35 Reserved} + uuEvent5, {36 Reserved} + uuEvent4, {37 Reserved} + uuEvent3, {38 Reserved} + uuEvent2, {39 Reserved} + uuEvent1 {40 Reserved} + ); + + EventFlagSet = SET OF EventType; { Added } + + EventDaysType = SET OF 0..6; {Set of event days} + + {*************************************************************************} + {* The Record Structure of the EventFile *} + {*************************************************************************} + EventRecordType = RECORD {Events - EVENTS.DAT} + EventFlags : EventFlagSet; {Kinds of Events Supported} { Changed } + + EventDayOfMonth : BYTE; {If monthly, the Day of Month} + + EventDays : EventDaysType; {If Daily, the Days Active} + + EventStartTime, {Start Time in Min from Mid.} + EventFinishTime : WORD; {Finish Time} + + EventDesc : STRING[32]; {Description of the Event} + + EventQualMsg, {Msg/Path if he qualifies} + EventNotQualMsg : STRING[64]; {Msg/Path if he doesn't} + + EventPreTime : BYTE; {Min. B4 event to rest. Call} + + EventOffHook : BOOLEAN; {Take phone Offhook ?} + + EventLastDate : STRING[8]; {Last Date Executed} + + EventErrorLevel : BYTE; {For Ext Event ErrorLevel} + + EventShellPath : STRING[8]; {File for Ext Event Shell} + + LoBaud, {Low baud rate limit} + HiBaud : WORD; {High baud rate limit} + + LoSL, {Low SL limit} + HiSL, {High SL limit} + LoDSL, {Low DSL limit} + HiDSL : BYTE; {High DSL limit} + + ARflagRequired : CHAR; {AR flag required} + + MaxTimeAllowed : WORD; {Max Time per user this event} + + SetARflag, {AR Flag to Set} + ClearARflag : CHAR; {AR Flag to Clear} + + EventUnused : {Reserved} + ARRAY[1..128] OF BYTE; + END; + +CONST + maxmodemresultcodes = 45; {Maximum number of modem result codes} + +TYPE + modemresulttype = ( {Modem result types} + resulterror, {Command error} + resultok, {Command accepted} + resultring, {Phone ringing} + resultnocarrier, {Connect attempt failed} + resultconnect, {Connect succcessful} + resultwaitscreen, {Go to wait screen} + resultlocallogon, {Logcal logon} + resultshellbatch, {Shell to batch file} + resultexiterrorlevel, {Exit system with error level} + resultexitsystem, {Exit system with error level 255} + + {The following are not supported} + resultnodialtone, {Reserved} + resultringing, {Reserved} + resultbusy, {Reserved} + resultnoanswer, {Reserved} + resultvoice {Reserved} + ); + + modemresultset = {Set to modem results - Used intenally} + SET OF modemresulttype; + + + resultrec = RECORD + typeofresult : {Type of result} + modemresulttype; + + result : STRING[50]; {Test of result} + + connectrate, {Connect rate modem to modem} + realrate, {Real rate computer to modem} + controlcode : LONGINT; {Error level or startup code} + + fullduplex, {Full duplex operation?} + errorcorrecting : BOOLEAN; {Error correcting modem?} + + Unused : ARRAY[1..8] OF CHAR; {Reserved} + END; + +{ +Modem string mapping codes: + +Char. Name Action +----- --------------- ------------------------------ + ^ Carat Control code of next character + | Pipe, Split Bar Carriage return sent + ` Accent Mark 1/20th second delay + ~ Tilde 1/2 second delay + ^- Carat & Minus Lower DTR line + ^+ Carat & Plus Raise DTR line +} + + modemrec = RECORD {Modem record - MODEM.DAT} + uuunused : BOOLEAN; {Unused} + + modemdescription : {Description on modem} + STRING[64]; + + characterdelay : BYTE; {Miliseconds} + + ctsrts, {Hardware flow control active} + samering, {Reserved} + nocollide : BOOLEAN; {Reserved} + + numberresults : BYTE; {Number of modem result codes defined} + + result : {Array of results} + ARRAY[1..maxmodemresultcodes] OF + resultrec; + + preinitialization, {Pre-initialization string} + initialization, {Initialization string} + answer, {Answer string} + busy, {Busy string} + hangupprimary, {Hangup primary string} + hangupsecondary, {Hangup secondard string} + afterhangup, {After hangup string} + exitsystem, {Exit system string} + predial, {Reserved} + dialprefix, {Reserved} + dialsuffix : STRING[64]; {Reserved} + + waitbaud : LONGINT; {Init modem speed} + + lockedbaud : BOOLEAN; {Is baud rate locked - Not used by Dragon} + + ecefficiency, {Error correcting efficiency} + ncefficiency : BYTE; {Normal connect efficiency} + + Unused : + ARRAY[1..249] OF CHAR; {Reserved} + END; + +CONST + MaxSubOps = 10; {Maximum number of message section SubOps} + +TYPE + NoYesForcedType = ( {Message section type} + No, {Anonymous messages not allowed} + Yes, {Anonymous messages allowed} + Forced, {Messages forced anonymous} + AtUnused {Reserved} + ); + + {*************************************************************************} + {* Standard Attributes for Messages *} + {*************************************************************************} + MessageAttrFlagType = ( + Msg_Private, {1 fPrivate,RaPrivate,JamPrivate} + Msg_Crash, {2 fCrash,Crash,JamCrash} + Msg_Received, {3 fReceived,Received,JamRead} + Msg_Sent, {4 fSent,Sent,JamSent} + Msg_FileAttached, {5 fFileAttached,FileAttach, + JamFileAttach} + Msg_KillSent, {6 fKillSent,KillSent,JamKillSent} + Msg_Local, {7 fLocal,LocalMessage,JamLocal} + Msg_ReturnReceiptRequest, {8 fReportReceiptRequest,RequestReceipt, + JamReceiptReq} + Msg_IsReturnReceipt, {9 fIsReturnReceipt,ReturnReceipt} + Msg_AuditRequest, {10 fAuditRequest,AuditRequest} + + Msg_InTransit, {11 fInTransit,JamIntransit} + Msg_Orphan, {12 fOrphan,JamOrphan} + Msg_HoldForPickup, {13 fHoldForPickup,JamHold} + Msg_Fido_UnusedBit10, {14 fUnusedBit10} + Msg_FileRequest, {15 fFileRequest,JamFileRequest} + Msg_Fido_FileUpdateRequest, {16 fFileUpdateRequest} + + Msg_Deleted, {17 Deleted,JamDeleted} + Msg_Ra_NetmailPendingExport, {18 NetmailPendingExport} + Msg_NetMailMessage, {19 NetMailMessage,JamTypeNet} + Msg_Ra_EchomailPendingExport, {20 EchomailPendingExport} + Msg_Ra_UnusedMsgBit7, {21 UnusedMsgBit7} + Msg_Ra_UnusedNetBit7, {22 UnusedNetBit7} + + Msg_Jam_ArchiveSent, {23 JamArchiveSent} + Msg_Jam_Immediate, {24 JamImmediate} + Msg_Jam_Direct, {25 JamDirect} + Msg_Jam_Gate, {26 JamGate} + Msg_Jam_ConfirmRequest, {27 JamConfirmReq} + Msg_Jam_ForcePickUp, {28 JamFpu} + Msg_Jam_TypeLocal, {29 JamTypeLocal} + Msg_Jam_TypeEcho, {30 JamTypeEcho} + Msg_Jam_NoDisplay, {31 JamNoDisp} + Msg_Jam_Locked {32 JamLocked} + ); {4 Bytes Total} + + MessageAttrFlagSet = {Set of message attributes} + Set of MessageAttrFlagType; + + MBstyle = ( {Message section style flags} + uumbbstyle, {Was For Private Mail Board} + LocalStyle, {Local} + EchoStyle, {Echomail} + NetmailStyle, {Netmail} + GroupStyle {Groupmail} + ); + + MBtype = ( {Message section type flags} + uumbtype, {Was For Netmail Board} + FidoFormat, {Fido 1.Msg Format} + RaFormat, {Remote Access Format} + JamFormat); {Jam Format} + + MboardType = RECORD {Message boards - MBOARDS.DAT} + Name : STRING[64]; {Name of the Board} + + Mstyle : MBstyle; {Local/Echo/Netmail} + + Mtype : MBtype; {Message Board Type} + + RaBoard : BYTE; {Board Number if RA/QBBS type} + + Path : STRING[64]; {Directory PathName} + + OriginLine : STRING[65]; {Origin Line} + + AccessAR, {AR flag Required to Access} + PostAR : ArFlagType; {AR flag required to Post} + + AccessSL, {Security Level Required to Access} + PostSL : BYTE; {Security Level Required to Post} + + MsgCount, {Count of Msgs on the Board} + MaxMsgs, {Max Number of Messages} + uuMaxOld : WORD; {Max Days for Messages} + + Password : STRING[16]; {Password Required} + + Anon : NoYesForcedType; {Anonymous Type} + + AllowAnsi : BOOLEAN; {Should we allow ANSI} + + AllowHandle : {Should we allow handles} + NoYesForcedType; + + {*********************************************************} + {* Message Board SubOpts List - Up to 10 - User Numbers *} + {*********************************************************} + SubOps : {SubOps - Item 0 = How many} + ARRAY[0..MaxSubOps] OF + INTEGER; + + EchoTag : STRING[32]; {Echo Tag for Writing ECHOMAIL.BBS} + + UseOtherAddress: BOOLEAN; {Use something other than system} + + JamBoard : STRING[8]; {JAM 8 character file name} + + AskPrivate : Boolean; {Ask if in area private message (echos)} + + Reserved: {Unused} + ARRAY[1..13] of byte; + + MenuNumber : BYTE; {Default read message number (if 0, use system default} + + PrePostFile : STRING[8]; {Prepost file name} + + MinMsgs : BYTE; {Minimum number of messages} + + QuoteStart, {Override starting quote} + QuoteEnd : STRING[70]; {Override ending quote} + + QwkConf : WORD; {QWK Conference Number} + + GroupNumber : BYTE; {What group the board belongs} + + OtherAddress : AddressType; {The Address to use!} + + RestrictPrivate: {Private mail status} + NoYesForcedType; + + DefaultAttr : {Default message flags} + MessageAttrFlagSet; + + QwkName : String[10]; {QWK Conference Name} + + Filter7Bit : Boolean; {Only allow 7 bit characters} + END; + +TYPE + LastOnType = {Last Few Callers - LASTON.DAT} + Array[1..8] of String[160]; + +Const + MaxBits = 1024; {Means a 128 Byte BitSet Bits 0 to 1023} + +Type + BitSetType = {Board Flags - ?ZSCAN.DAT} + Array[0..(MaxBits Div 8)-1] of + Byte; + + + WhoRecType = RECORD {Who's online - $WHO.DAT} + Active : Boolean; + + Node : Byte; {Node number for this record} + + Available : Boolean; {Is he available for anything} + + Uname : String[36]; {Users Name} + + CityState : String[30]; {City and State} + + Baud : LongInt; {Baud Rate} + + Paging : Byte; {Paging Node Number} + + InPrivateChat : Byte; {Node in private chat with} + + InGroupChat : Boolean; {Is he in Group Chat} + + Desc : String[64]; {Long Description} + END; + + UserOnType100 = RECORD {USERON.BBS file version 1.00} + Name : String[35]; {User name} + + Line : Byte; {Node number} + + Baud : Word; {Connect rate} + + City : String[25]; {City/State} + + DoNotDisturb : Boolean; {Do not disturb} + + Status : Byte; {Status} + END; + + UserOnType11x = RECORD {USERON.BBS file version 1.1x} + Name : String[35]; {Real name} + + Handle : String[35]; {User name} + + Line : Byte; {Node number} + + Baud : Word; {Connect rate} + + City : String[25]; {City/State} + + DoNotDisturb : Boolean; {Do not disturb} + + Status : Byte; {Status} + + Attribute : Byte; {Attribute} + END; + + Type200Attr = (RA_Hidden, {Bit 0} + RA_WantsChat, {Bit 1} + RA_Netmgr, {Bit 2} + RA_DoNotDisturb, {Bit 3} + RA_Bit4, {Bit 4} + RA_Bit5, {Bit 5} + RA_Ready, {Bit 6} + RA_Bit7); {Bit 7} + + UserOnType200 = RECORD {USERON.BBS file version 2.00 Gamma} + Name : String[35]; {Real name} + Handle : String[35]; {User name} + Line : Byte; {Node number} + Baud : Word; {Connect rate} + City : String[25]; {City/State} + Status : Byte; {Status} + + { Status byte - 0 : Browsing (in a menu) + 1 : Uploading/downloading + 2 : Reading/posting messages + 3 : In a door/external utility + 4 : Chatting with sysop + 5 : Answering questionnaire + 6 : RTC + 7 : New user logon + 255 : User-defined - display StatDesc + } + Attribute : Type200Attr; {Attribute} + StatDesc : String[10]; {Status Description} + FreeSpace : Array[1..98] of Byte; {For Expansion} + NoCalls : Word; + END; + diff --git a/SOURCE/UNUSED/EC.PAS b/SOURCE/UNUSED/EC.PAS new file mode 100644 index 0000000..05d03e9 --- /dev/null +++ b/SOURCE/UNUSED/EC.PAS @@ -0,0 +1,55 @@ +uses crt; + +var verline:array [0..3] of string; + s3:string; + f:text; + i:byte; + loop:integer; + +function encrypt(s:string):string; +var b:byte; + s2:string; + t:byte; +begin + s2:=''; + s2[0] := s[0]; t := 0; + for b:=1 to length(s) do + begin + s2[b] := chr(ord(s[b]) + ord(s2[b-1])); + inc(t, ord(s2[b])); + end; + writeln('Total: ',t); + encrypt:=s2; +end; + +function decrypt(s:string):string; +var b:byte; + s2:string; +begin + s2:=''; + for b:=1 to length(s) do + s2:=s2+chr(ord(s[b]) - ord(s[b-1])); + decrypt:=s2; +end; + +begin + clrscr; + {verline[0]:='|03The |11Renegade Bulletin Board System|03 Version ';} + verline[1]:= ('|03Copyright (C) 2003-2005 |03.'); + verline[2]:= ('|03Copyright (C) 2003-2005 |03.'); + verline[3]:= ('|03Copyright (C) 2003-2005 |03.'); + {verline:='--- Renegade v';} + assign(f,'ec.txt'); + s3:=''; + rewrite(f); +{ for loop := 0 to 3 do + begin} + writeln(verline[3]); + writeln(f,verline[3]); + s3:=encrypt(verline[3]); + writeln(s3); + writeln(f,s3); +{ end;} + close(f); +end. + diff --git a/SOURCE/UNUSED/EC.TXT b/SOURCE/UNUSED/EC.TXT new file mode 100644 index 0000000..fcea237 --- /dev/null +++ b/SOURCE/UNUSED/EC.TXT @@ -0,0 +1,2 @@ +|03Copyright (C) 2003-2005 |03. +쎤�A� � t�C롼�Bk떭�P}��Dd�Cq diff --git a/SOURCE/UNUSED/EMAIL.TPU b/SOURCE/UNUSED/EMAIL.TPU new file mode 100644 index 0000000..75ebfb5 Binary files /dev/null and b/SOURCE/UNUSED/EMAIL.TPU differ diff --git a/SOURCE/UNUSED/ERROR.LOG b/SOURCE/UNUSED/ERROR.LOG new file mode 100644 index 0000000..10a69a3 --- /dev/null +++ b/SOURCE/UNUSED/ERROR.LOG @@ -0,0 +1,33 @@ +袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴� +Critical error Log file - Contains screen images at instant of error. +The "�" character shows the cursor position at time of error. +袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴� + + +�>� error #207 at 10-13-2009 9:44 pm version: 1.10/Alpha +�>� User "LEE PALMER #2" was on Locally + 1 Test Area 1 2 Test Area 2 + 3 Test Area 3 4 Test Area 4 + 5 Test Area 5 6 Test Area 6 + 7 Test Area 7 8 Test Area 8 + 9 Test Area 9 10 Test Area 10 + 11 Test Area 11 12 Test Area 12 + 13 Test Area 13 14 Test Area 14 + 15 Test Area 15 16 Test Area 16 + 17 Test Area 17 18 Test Area 18 + 19 Test Area 19 20 Test Area 20 + 21 Test Area 21 22 Test Area 22 + 23 Test Area 23 24 Test Area 24 + 25 Test Area 25 26 Test Area 26 + 27 Test Area 27 28 Test Area 28 + 29 Test Area 29 30 Test Area 30 + 31 Test Area 31 32 Test Area 32 + 33 Test Area 33 34 Test Area 34 + 35 Test Area 35 36 Test Area 36 + +Change file area? (1-69) [#,?=Help,Q=Quit]: + +Invalid command keys: +� + Lee Palmer AR: ABCDEFGHIJKLMNOPQRSTUVWXYZ NSL: 255 Time: 32759 + Lee Palmer #2 AC: LCVUA*PEKM1234 Baud: 0 DSL: 255 Node: 6 diff --git a/SOURCE/UNUSED/EVENT.PAS b/SOURCE/UNUSED/EVENT.PAS new file mode 100644 index 0000000..98cfd3a --- /dev/null +++ b/SOURCE/UNUSED/EVENT.PAS @@ -0,0 +1,248 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Event; + +INTERFACE + +FUNCTION InTime(Tim,Tim1,Tim2: LongInt): Boolean; +FUNCTION CheckEventDay(EventNum: Integer; T: 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; + +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 CheckEventDay(EventNum: Integer; T: LongInt): Boolean; +VAR + DayOfWeek, + Day: Byte; + DeleteMeTimer: Longint; +BEGIN + CheckEventDay := FALSE; + WITH MemEventArray[EventNum]^ DO + BEGIN + IF (NOT (EventIsActive IN EFlags)) THEN + Exit; + Day := 0; + GetDayOfWeek(DayOfWeek); + DeleteMeTimer := Timer + T; + IF ((Timer + T) >= 86400.0) 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) = EventDayOfMonth) THEN + CheckEventDay := TRUE; + END + ELSE IF (DayOfWeek IN EventDays) THEN + CheckEventDay := 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 (CheckEventDay(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; +VAR + DeleteMe: AStr; +BEGIN + DeleteMe := PD2Date(MemEventArray[EventNum]^.EventLastDate); + WITH MemEventArray[EventNum]^ DO + IF (PD2Date(EventLastDate) = DateStr) OR + ((EventNode > 0) AND (EventNode <> ThisNode)) OR + (NOT (EventIsActive IN EFlags)) OR + NOT (CheckEventDay(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 (CheckEventDay(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 + A: Byte ABSOLUTE $0000:$0417; + EventNum: Integer; + ChatOk: Boolean; +BEGIN + + ChatOk := ((A AND 16) = 0); + + 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/UNUSED/EVENT.TPU b/SOURCE/UNUSED/EVENT.TPU new file mode 100644 index 0000000..28d638a Binary files /dev/null and b/SOURCE/UNUSED/EVENT.TPU differ diff --git a/SOURCE/UNUSED/EVENTS.TPU b/SOURCE/UNUSED/EVENTS.TPU new file mode 100644 index 0000000..10ade6c Binary files /dev/null and b/SOURCE/UNUSED/EVENTS.TPU differ diff --git a/SOURCE/UNUSED/EXECBAT.TPU b/SOURCE/UNUSED/EXECBAT.TPU new file mode 100644 index 0000000..7862a11 Binary files /dev/null and b/SOURCE/UNUSED/EXECBAT.TPU differ diff --git a/SOURCE/UNUSED/FAELNG.EXE b/SOURCE/UNUSED/FAELNG.EXE new file mode 100644 index 0000000..596f30c Binary files /dev/null and b/SOURCE/UNUSED/FAELNG.EXE differ diff --git a/SOURCE/UNUSED/FAELNG.PAS b/SOURCE/UNUSED/FAELNG.PAS new file mode 100644 index 0000000..b938cf1 --- /dev/null +++ b/SOURCE/UNUSED/FAELNG.PAS @@ -0,0 +1,267 @@ +PROGRAM RGLNG; + +USES + Crt, + Dos, + Common; + +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 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 File Area Editor Compiler Version 1.0'); + Writeln('Copyright 2009 - The Renegade Developement Team'); + IF (NOT Exist('FAELNG.TXT')) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'FAELNG.TXT does not exist!'); + Exit; + END; + CompileFileAreaEditorStrings; +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/FAELNG.TXT b/SOURCE/UNUSED/FAELNG.TXT new file mode 100644 index 0000000..12e3e96 --- /dev/null +++ b/SOURCE/UNUSED/FAELNG.TXT @@ -0,0 +1,312 @@ +$FILE_AREA_HEADER_TOGGLE_ONE +^0#####^4:^3File area name ^4:^3Flags ^4:^3ACS ^4:^3UL ACS ^4:^3DL ACS ^4:^3MaxF +^4=====:=========================:========:==========:==========:==========:===== +$ + +$FILE_AREA_HEADER_TOGGLE_TWO +^0#####^4:^3File area name ^4:^3FileName^4:^3Download path ^4:^3Upload path +^4=====:================:========:=======================:======================= +$ + +$FILE_AREA_HEADER_NO_FILE_AREAS +^7*** No file areas defined ***^1 +$ + +$FILE_AREA_EDITOR_PROMPT +%LFFile area editor [^5?^4=^5Help^4]: @ +$ + +$FILE_AREA_EDITOR_HELP +%LF^1<^3CR^1>Next screen or redisplay current screen +^1(^3?^1)Help/First file area +^1(^3C^1)hange file area storage drive +^1(^3D^1)elete file area ^1(^3I^1)nsert file area +^1(^3M^1)odify file area ^1(^3P^1)osition file area +^1(^3Q^1)uit ^1(^3T^1)oggle display format +$ + +$NO_FILE_AREAS +%LF^7No file areas exist!^1 +%PA +$ + +$FILE_CHANGE_DRIVE_START +%LFFile area to start at?@ +$ + +$FILE_CHANGE_DRIVE_END +%LFFile area to end at?@ +$ + +$FILE_CHANGE_DRIVE_DRIVE +%LFChange to which drive? (^5A^4-^5Z^4): @ +$ + +$FILE_CHANGE_INVALID_ORDER +%LF^7Invalid record number order!^1 +%PA +$ + +$FILE_CHANGE_INVALID_DRIVE +%LF^7Invalid drive!^1 +%PA +$ + +$FILE_CHANGE_UPDATING_DRIVE +%LFUpdating the drive for file area %FR to %LR ... @ +$ + +$FILE_CHANGE_UPDATING_DRIVE_DONE +Done! +$ + +$FILE_CHANGE_UPDATING_SYSOPLOG +* Changed file areas: ^5%FR^1-^5%LR^1 to ^5%DD:\ +$ + +$FILE_DELETE_PROMPT +%LFFile area to delete?@ +$ + +$FILE_DELETE_DISPLAY_AREA +%LFFile area: ^5%AN^1 +$ + +$FILE_DELETE_VERIFY_DELETE +%LFAre you sure you want to delete it? @ +$ + +$FILE_DELETE_NOTICE +%LF[> Deleting file area record ... +$ + +$FILE_DELETE_SYSOPLOG +* Deleted file area: ^5%AN +$ + +$FILE_DELETE_DATA_FILES +%LFDelete file area data files also? @ +$ + +$FILE_DELETE_REMOVE_DL_DIRECTORY +%LFRemove the download directory? @ +$ + +$FILE_DELETE_REMOVE_UL_DIRECTORY +%LFRemove the upload directory? @ +$ + +$FILE_INSERT_MAX_FILE_AREAS +^7No more then %MA file areas can exist!^1 +%PA +$ + +$FILE_INSERT_PROMPT +%LFFile area to insert before?@ +$ + +$FILE_INSERT_AFTER_ERROR_PROMPT +%LFContinue inserting file area? @ +$ + +$FILE_INSERT_CONFIRM_INSERT +%LFIs this what you want? @ +$ + +$FILE_INSERT_NOTICE +%LF[> Inserting file area record ... +$ + +$FILE_INSERT_SYSOPLOG +* Inserted file area: ^5%AN +$ + +$FILE_MODIFY_PROMPT +%LFFile area to modify?@ +$ + +$FILE_MODIFY_SYSOPLOG +* Modified file area: ^5%AN +$ + +$FILE_POSITION_NO_AREAS +%LF^7No file areas to position!^1 +%PA +$ + +$FILE_POSITION_PROMPT +%LFPosition which file area?@ +$ + +$FILE_POSITION_NUMBERING +%LFAccording to the current numbering system. +$ + +$FILE_POSITION_BEFORE_WHICH +%LFPosition before which file area?@ +$ + +$FILE_POSITION_NOTICE +%LF[> Positioning file area records ... +$ + +$FILE_EDITING_AREA_HEADER +^5Editing file area #%RE of %NA +$ + +$FILE_INSERTING_AREA_HEADER +^5Inserting file area #%RE of %NF +$ + +$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 +$ + +$FILE_EDITING_INSERTING_PROMPT +%LFModify menu [^5?^4=^5Help^4]: @ +$ + +$FILE_AREA_NAME_CHANGE +%LFNew area name: @ +$ + +$FILE_FILE_NAME_CHANGE +%LFNew file name (^5Do not enter ^4"^5.EXT^4"): @ +$ + +$FILE_DUPLICATE_FILE_NAME_ERROR +%LF^7The file name is already in use!^1 +$ + +$FILE_USE_DUPLICATE_FILE_NAME +%LFUse this file name anyway? @ +$ + +$FILE_OLD_DATA_FILES_PATH +%LFOld DIR/EXT/SCN file names: "^5%OP.*^1" +$ + +$FILE_NEW_DATA_FILES_PATH +%LFNew DIR/EXT/SCN file names: "^5%NP.*^1" +$ + +$FILE_RENAME_DATA_FILES +%LFRename old data files? @ +$ + +$FILE_DL_PATH +%LF^1New download path (^5End with a ^1"^5\^1"):%LF^4:@ +$ + +$FILE_SET_DL_PATH_TO_UL_PATH +%LFSet the upload path to the download path? @ +$ + +$FILE_UL_PATH +%LF^1New upload path (^5End with a ^1"^5\^1"):%LF^4:@ +$ + +$FILE_ACS +%LFNew ACS: @ +$ + +$FILE_DL_ACCESS +%LFNew download ACS: @ +$ + +$FILE_UL_ACCESS +%LFNew upload ACS: @ +$ + +$FILE_MAX_FILES +%LFNew max files@ +$ + +$FILE_PASSWORD +%LFNew password: @ +$ + +$FILE_ARCHIVE_TYPE +%LFNew archive type (^50^4=^5None^4)@ +$ + +$FILE_COMMENT_TYPE +%LFNew comment type (^50^4=^5None^4)@ +$ + +$FILE_TOGGLE_FLAGS +%LFToggle which flag (%FT^4) [^5?^4=^5Help^4,^5^4=^5Quit^4]: @ +$ + +$FILE_MOVE_DATA_FILES +%LFMove old data files to new directory? @ +$ + +$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 +$ + +$FILE_JUMP_TO +%LFJump to entry?@ +$ + +$FILE_FIRST_VALID_RECORD +%LF^7You are at the first valid record!^1 +%PA +$ + +$FILE_LAST_VALID_RECORD +%LF^7You are at the last valid record!^1 +%PA +$ + +$FILE_INSERT_EDIT_HELP +%LF^1<^3CR^1>Redisplay current screen +^31^1-^39^1,^3T^1:Modify item +$ + +$FILE_INSERT_HELP +^1(^3Q^1)uit and save +$ + +$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 +$ + +$CHECK_AREA_NAME_ERROR +%LF^7The area name is invalid!^1 +$ + +$CHECK_FILE_NAME_ERROR +%LF^7The file name is invalid!^1 +$ + +$CHECK_DL_PATH_ERROR +%LF^7The download path is invalid!^1 +$ + +$CHECK_UL_PATH_ERROR +%LF^7The upload path is invalid!^1 +$ + +$CHECK_ARCHIVE_TYPE_ERROR +%LF^7The archive type is invalid!^1 +$ + +$CHECK_COMMENT_TYPE_ERROR +%LF^7The comment type is invalid!^1 +$ \ No newline at end of file diff --git a/SOURCE/UNUSED/FAEPR.DAT b/SOURCE/UNUSED/FAEPR.DAT new file mode 100644 index 0000000..c6dad9a Binary files /dev/null and b/SOURCE/UNUSED/FAEPR.DAT differ diff --git a/SOURCE/UNUSED/FAETX.DAT b/SOURCE/UNUSED/FAETX.DAT new file mode 100644 index 0000000..8ac1cbb --- /dev/null +++ b/SOURCE/UNUSED/FAETX.DAT @@ -0,0 +1 @@ +h^0#####^4:^3File area name ^4:^3Flags ^4:^3ACS ^4:^3UL ACS ^4:^3DL ACS ^4:^3MaxFQ^4=====:=========================:========:==========:==========:==========:=====U^0#####^4:^3File area name ^4:^3FileName^4:^3Download path ^4:^3Upload pathQ^4=====:================:========:=======================:=======================!^7*** No file areas defined ***^1'%LFFile area editor [^5?^4=^5Help^4]: @4%LF^1<^3CR^1>Next screen or redisplay current screen^1(^3?^1)Help/First file area&^1(^3C^1)hange file area storage drive3^1(^3D^1)elete file area ^1(^3I^1)nsert file area5^1(^3M^1)odify file area ^1(^3P^1)osition file area8^1(^3Q^1)uit ^1(^3T^1)oggle display format%LF^7No file areas exist!^1%PA%LFFile area to start at?@%LFFile area to end at?@*%LFChange to which drive? (^5A^4-^5Z^4): @#%LF^7Invalid record number order!^1%PA%LF^7Invalid drive!^1%PA4%LFUpdating the drive for file area %FR to %LR ... @Done!0* Changed file areas: ^5%FR^1-^5%LR^1 to ^5%DD:\%LFFile area to delete?@%LFFile area: ^5%AN^1(%LFAre you sure you want to delete it? @#%LF[> Deleting file area record ...* Deleted file area: ^5%AN&%LFDelete file area data files also? @#%LFRemove the download directory? @!%LFRemove the upload directory? @*^7No more then %MA file areas can exist!^1%PA%LFFile area to insert before?@"%LFContinue inserting file area? @%LFIs this what you want? @$%LF[> Inserting file area record ...* Inserted file area: ^5%AN%LFFile area to modify?@* Modified file area: ^5%AN!%LF^7No file areas to position!^1%PA%LFPosition which file area?@-%LFAccording to the current numbering system.$%LFPosition before which file area?@'%LF[> Positioning file area records ...^5Editing file area #%RE of %NA!^5Inserting file area #%RE of %NF%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"%LFModify menu [^5?^4=^5Help^4]: @%LFNew area name: @1%LFNew file name (^5Do not enter ^4"^5.EXT^4"): @'%LF^7The file name is already in use!^1%LFUse this file name anyway? @*%LFOld DIR/EXT/SCN file names: "^5%OP.*^1"*%LFNew DIR/EXT/SCN file names: "^5%NP.*^1"%LFRename old data files? @7%LF^1New download path (^5End with a ^1"^5\^1"):%LF^4:@.%LFSet the upload path to the download path? @5%LF^1New upload path (^5End with a ^1"^5\^1"):%LF^4:@ %LFNew ACS: @%LFNew download ACS: @%LFNew upload ACS: @%LFNew max files@%LFNew password: @%%LFNew archive type (^50^4=^5None^4)@%%LFNew comment type (^50^4=^5None^4)@B%LFToggle which flag (%FT^4) [^5?^4=^5Help^4,^5^4=^5Quit^4]: @*%LFMove old data files to new directory? @*%LF^1(^3N^1)oRatio ^1(^3U^1)nhidden4^1(^3G^1)ifSpecs ^1(^3I^1)*.DIR file in DLPath1^1(^3C^1)D-ROM ^1(^3S^1)how uploader Name0^1(^3D^1)ate uploaded ^1du(^3P^1)e checking off%LFJump to entry?@)%LF^7You are at the first valid record!^1%PA(%LF^7You are at the last valid record!^1%PA%%LF^1<^3CR^1>Redisplay current screen^31^1-^39^1,^3T^1:Modify item^1(^3Q^1)uit and save3^1(^3[^1)Back entry ^1(^3]^1)Forward entry2^1(^3F^1)irst entry in list ^1(^3J^1)ump to entry2^1(^3L^1)ast entry in list ^1(^3Q^1)uit and save %LF^7The area name is invalid!^1 %LF^7The file name is invalid!^1$%LF^7The download path is invalid!^1"%LF^7The upload path is invalid!^1#%LF^7The archive type is invalid!^1#%LF^7The comment type is invalid!^1 \ No newline at end of file diff --git a/SOURCE/UNUSED/FILE0.TPU b/SOURCE/UNUSED/FILE0.TPU new file mode 100644 index 0000000..1735fe2 Binary files /dev/null and b/SOURCE/UNUSED/FILE0.TPU differ diff --git a/SOURCE/UNUSED/FILE1.TPU b/SOURCE/UNUSED/FILE1.TPU new file mode 100644 index 0000000..775251b Binary files /dev/null and b/SOURCE/UNUSED/FILE1.TPU differ diff --git a/SOURCE/UNUSED/FILE10.LEE b/SOURCE/UNUSED/FILE10.LEE new file mode 100644 index 0000000..729a127 --- /dev/null +++ b/SOURCE/UNUSED/FILE10.LEE @@ -0,0 +1,835 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT File10; + +INTERFACE + +USES + Common; + +PROCEDURE CreditFile(VAR User: UserRecordType; F: FileInfoRecordType; Credit: Boolean; GotPts: Integer); +PROCEDURE EditFiles; +PROCEDURE ValidateFiles; + +IMPLEMENTATION + +USES + Dos, + ArcView, + File0, + File1, + File2, + File9, + Mail1, + SysOp3, + TimeFunc, + MiscUser; + +PROCEDURE CreditFile(VAR User: UserRecordType; F: FileInfoRecordType; Credit: Boolean; GotPts: Integer); +VAR + FilePointsReceived: Integer; +BEGIN + IF (AllCaps(F.OwnerName) <> AllCaps(User.Name)) THEN + BEGIN + Print('Uploader name does not match user name!'); + Print('Cannot add/remove credit from user.'); + Exit; + END; + IF (NOT General.FileCreditRatio) THEN + GotPts := 0 + ELSE IF (GotPts = 0) THEN + BEGIN + FilePointsReceived := 0; + IF (General.FileCreditCompBaseSize <> 0) THEN + FilePointsReceived := ((F.Blocks DIV 8) DIV General.FileCreditCompBaseSize); + GotPts := (FilePointsReceived * General.FileCreditComp); + IF (GotPts < 1) THEN + GotPts := 1; + END; + Print(AOnOff(Credit,'^5Awarding upload','^5Removing upload')+ + ' credits: 1 file, '+ConvertKB(F.Blocks DIV 8,FALSE)+', '+IntToStr(GotPts)+' credits.'); + IF (Credit) THEN + BEGIN + IF (User.Uploads < 2147483647) THEN + Inc(User.Uploads); + IF ((User.UK + (F.Blocks DIV 8)) < 2147483647) THEN + Inc(User.UK,(F.Blocks DIV 8)) + ELSE + User.UK := 2147483647; + IF ((User.Credit + GotPts) < 2147483647) THEN + Inc(User.Credit,GotPts) + ELSE + User.UK := 2147483647; + END + ELSE + BEGIN + IF (User.Uploads > 0) THEN + Dec(User.Uploads); + IF ((User.UK - (F.Blocks DIV 8)) > 0) THEN + Dec(User.UK,(F.Blocks DIV 8)) + ELSE + User.UK := 0; + IF ((User.Credit - GotPts) > 0) THEN + Dec(User.Credit,GotPts) + ELSE + User.Credit := 0; + END; + SaveURec(User,F.OwnerNum); +END; + +PROCEDURE EditFile(DirFileRecNum: Integer; VAR Cmd: Char; NoPrompt,IsPoints: Boolean; VAR BackUp: Boolean); +VAR + FF: FILE; + ExtText: Text; + User: UserRecordType; + F: FileInfoRecordType; + V: VerbRec; + Mheader: MheaderRec; + InputStr, + MoveFromDir, + MoveToDir: AStr; + LineNum, + NumExtDesc: Byte; + UNum, + NewFileArea, + SaveFileArea, + Totload: Integer; + FSize: Longint; + SaveConfSystem, + DontShowList, + Done, + Ok, + NoSpace: 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(DirFile,DirFileRecNum); + Read(DirFile,F); + IF (IOResult <> 0) THEN + Exit; + IF (F.OwnerNum > (MaxUsers - 1)) THEN + F.OwnerNum := 1; + LoadURec(User,F.OwnerNum); + IF (IsPoints) THEN + BEGIN + NL; + FileInfo(F,TRUE); + NL; + Prt('Credits for file (0-999) ([Enter]=Skip,Q=Quit): '); + Input(InputStr,3); + NL; + IF (InputStr = '') OR (InputStr = 'Q') THEN + BEGIN + Print('Aborted.'); + Abort := TRUE + END + ELSE IF (StrToInt(InputStr) >= 0) AND (StrToInt(InputStr) <= 999) THEN + BEGIN + F.FilePoints := StrToInt(InputStr); + Exclude(F.FIFlagS,FINotVal); + Seek(DirFile,DirFileRecNum); + Write(DirFile,F); + CreditFile(User,F,TRUE,F.FilePoints); + NL; + Prt('Credits for ^5'+Caps(F.OwnerName)+'^4 (-999 to 999): '); + Input(InputStr,4); + IF (InputStr <> '') AND (StrToInt(InputStr) >= -999) AND (StrToInt(InputStr) <= 999) THEN + BEGIN + IF (F.OwnerNum = UserNum) THEN + AdjustBalance(-StrToInt(InputStr)) + ELSE IF (StrToInt(InputStr) > 0) THEN + Inc(User.Debit,StrToInt(InputStr)) + ELSE + Dec(User.Credit,StrToInt(InputStr)); + SaveURec(User,F.OwnerNum); + END; + END; + NL; + Exit; + END; + IF (NoPrompt) THEN + BEGIN + Exclude(F.FIFlagS,FINotVal); + Seek(DirFile,DirFileRecNum); + Write(DirFile,F); + CreditFile(User,F,TRUE,0); + Exit; + END; + DontShowList := FALSE; + REPEAT + Abort := FALSE; + Next := FALSE; + IF (NOT DontShowList) THEN + BEGIN + NL; + FileInfo(F,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); + IF (NOT (Cmd IN ['H','I','M','N','P','R','T','U',^M])) THEN + NL; + END; + CASE Cmd OF + '1' : BEGIN + Prt('New file name: '); + MPL((SizeOf(F.FileName) - 1)); + Input(InputStr,(SizeOf(F.FileName) - 1)); + IF (InputStr = '') THEN + BEGIN + NL; + Print('Aborted.'); + END + ELSE + BEGIN + IF (SQOutSp(InputStr) = SQOutSp(F.FileName)) THEN + BEGIN + NL; + Print('You must specify a different file name.'); + END + ELSE + BEGIN + Ok := TRUE; + IF (Exist(MemFileArea.DLPath+InputStr) OR Exist(MemFileArea.ULPath+InputStr)) THEN + BEGIN + NL; + Print('That file name exists in the download or upload path.'); + Ok := FALSE; + END; + IF (Ok) THEN + IF (NOT Exist(MemFileArea.DLPath+F.FileName)) OR (NOT Exist(MemFileArea.ULPath+F.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 F.FIFlagS)) THEN + BEGIN + NL; + IF (PYNQ('Do you want to set this file to Offline? ',0,FALSE)) THEN + BEGIN + F.Blocks := 0; + F.SizeMod := 0; + Include(F.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+F.FileName)) THEN + BEGIN + Assign(FF,MemFileArea.DLPath+F.FileName); + ReName(FF,MemFileArea.DLPath+InputStr); + END + ELSE IF (Exist(MemFileArea.ULPath+F.FileName)) THEN + BEGIN + Assign(FF,MemFileArea.ULPath+F.FileName); + ReName(FF,MemFileArea.ULPath+InputStr); + END; + LastError := IOResult; + F.FileName := Align(InputStr); + END; + END; + END; + END; + '2' : BEGIN + Print('Limit on file size restricted to 1.9 Gig.'); + OK := TRUE; + IF (NOT Exist(MemFileArea.DLPath+F.FileName)) OR (NOT Exist(MemFileArea.ULPath+F.FileName)) THEN + BEGIN + NL; + IF (PYNQ('File does not exist, set to Offline? ',0,FALSE)) THEN + BEGIN + FSize := 0; + Include(F.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+F.FileName)) THEN + FSize := GetFileSize(MemFileArea.DLPath+SQOutSp(F.FileName)) + ELSE IF (Exist(MemFileArea.ULPath+F.FileName)) THEN + FSize := GetFileSize(MemFileArea.ULPath+SqOutSp(F.FileName)); + END + ELSE + BEGIN + FSize := ((F.Blocks * 128) + F.SizeMod); + NL; + InputLongIntWOC('/New file size in bytes',FSize,0,2147483647); + END; + END; + IF (FSize >= 0) AND (FSize <= 2147483647) THEN + BEGIN + F.Blocks := (FSize DIV 128); + F.SizeMod := (FSize MOD 128); + END; + END; + '3' : BEGIN + Print('New description: '); + Prt(': '); + MPL((SizeOf(F.Description) - 1)); + InputMain(F.Description,(SizeOf(F.Description) - 1),[InteractiveEdit]); + END; + '4' : BEGIN + LoadURec(User,F.OwnerNum); + IF (AllCaps(F.OwnerName) <> AllCaps(User.Name)) THEN + BEGIN + Print('Previous owner was '+Caps(F.OwnerName)+' #'+IntToStr(F.OwnerNum)); + NL; + LoadURec(User,1); + F.OwnerNum := 1; + F.OwnerName := AllCaps(User.Name); + END; + Print('New owner user number or name ('+Caps(F.OwnerName)+' #'+IntToStr(F.OwnerNum)+'): '); + Prt(': '); + MPL((SizeOf(F.OwnerName) - 1)); + FindUser(UNum); + IF (UNum <= 0) THEN + BEGIN + NL; + Print('User not found.'); + END + ELSE + BEGIN + LoadURec(User,UNum); + F.OwnerNum := UNum; + F.OwnerName := AllCaps(User.Name); + END; + END; + '5' : BEGIN + Prt('New upload file date ('+PD2Date(F.Date)+'): '); + 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('Invalid date entered.'); + END + ELSE + BEGIN + F.Date := Date2PD(InputStr); + F.DateN := DayNum(PD2Date(F.Date)); + END; + END; + END; + '6' : InputLongIntWOC('/New number of downloads',F.DownLoaded,0,2147483647); + '7' : InputIntegerWOC('/New amount of credits',F.FilePoints,0,999); + 'D' : IF PYNQ('Are you sure? ',0,FALSE) THEN + BEGIN + Deleteff(F,DirFileRecNum); + Dec(LastDIRRecNum); + InputStr := 'Removed "'+SQOutSp(F.FileName)+'" from '+MemFileArea.AreaName; + IF (Exist(MemFileArea.DLPath+F.FileName) OR Exist(MemFileArea.ULPath+F.FileName)) THEN + BEGIN + NL; + IF PYNQ('Erase file also? ',0,FALSE) THEN + BEGIN + Kill(MemFileArea.DLPath+F.FileName); + Kill(MemFileArea.ULPath+F.FileName); + InputStr := InputStr+' [FILE DELETED]' + END; + END; + IF (NOT (FINotVal IN F.FIFlagS)) THEN + BEGIN + NL; + IF PYNQ('Remove from ^5'+Caps(User.Name)+' #'+IntToStr(F.OwnerNum)+'^7''s ratio? ',0,FALSE) THEN + BEGIN + NL; + CreditFile(User,F,FALSE,F.FilePoints); + END; + END; + SysOpLog(InputStr); + Cmd := 'N'; + END; + 'E' : BEGIN + OK := TRUE; + IF (F.VPointer <> -1) THEN + BEGIN + IF (NOT PYNQ('Delete the extended description for this file? ',0,FALSE)) THEN + LoadVerbArray(F,V,NumExtDesc) + ELSE + BEGIN + F.VPointer := -1; + F.VTextSize := 0; + OK := FALSE; + END; + END + ELSE + BEGIN + IF (NOT PYNQ('Create an extended description for this file? ',0,FALSE)) THEN + BEGIN + F.VPointer := -1; + F.VTextSize := 0; + OK := FALSE + END + ELSE + BEGIN + FillChar(V,SizeOf(V),0); + NumExtDesc := 1; + END; + END; + IF (Ok) THEN + BEGIN + Assign(ExtText,TempDir+MemFileArea.FileName+'.TMP'); + ReWrite(ExtText); + LineNum := 0; + REPEAT + Inc(LineNum); + IF (V[LineNum] <> '') THEN + WriteLn(ExtText,V[LineNum]); + UNTIL (LineNum = NumExtDesc); + Close(ExtText); + MHeader.Status := []; + InResponseTo := ''; + IF (InputMessage(TRUE,FALSE,FALSE,'Extended Description', + MHeader,TempDir+MemFileArea.FileName+'.TMP')) then + IF Exist(TempDir+MemFileArea.FileName+'.TMP') THEN + BEGIN + FillChar(V,SizeOf(V),0); + Assign(ExtText,TempDir+MemFileArea.FileName+'.TMP'); + Reset(ExtText); + NumExtDesc := 0; + REPEAT + ReadLn(ExtText,InputStr); + IF (InputStr <> '') THEN + BEGIN + Inc(NumExtDesc); + V[NumExtDesc] := InputStr; + END; + UNTIL (NumExtDesc = MaxExtDesc) OR EOF(ExtText); + Close(ExtText); + IF (V[1] <> '') THEN + SaveVerbArray(F,V,NumExtDesc); + END; + Kill(TempDir+MemFileArea.FileName+'.TMP'); + END; + Cmd := #0; + END; + 'G' : IF (NOT General.FileDiz) THEN + Print('This option is not active in the System Configuration.') + ELSE + BEGIN + IF (Exist(MemFileArea.ULPath+F.FileName)) THEN + InputStr := MemFileArea.ULPath+SQOutSp(F.FileName) + ELSE + InputStr := MemFileArea.DLPath+SQOutSp(F.FileName); + IF (NOT DizExists(InputStr)) THEN + Print('File has no internal description.') + ELSE + BEGIN + GetDiz(F,V,NumExtDesc); + IF (V[1] <> '') THEN + SaveVerbArray(F,V,NumExtDesc) + ELSE + BEGIN + F.VPointer := -1; + F.VTextSize := 0; + END; + END; + END; + 'H' : ToggleFIFlags('H',F.FIFlagS); + 'I' : IF (NOT ValidIntArcType(F.FileName)) THEN + BEGIN + NL; + Print('Not a valid archive type or not supported.') + END + ELSE + BEGIN + OK := FALSE; + IF Exist(MemFileArea.DLPath+F.FileName) THEN + BEGIN + LFI(MemFileArea.DLPath+SQOutSp(F.FileName)); + OK := TRUE; + END + ELSE IF Exist(MemFileArea.ULPath+F.FileName) THEN + BEGIN + LFI(MemFileArea.ULPath+SQOutSp(F.FileName)); + OK := TRUE; + END; + IF (NOT Ok) THEN + BEGIN + NL; + IF (PYNQ('File does not exist, set to offline? ',0,FALSE)) THEN + BEGIN + F.Blocks := 0; + F.SizeMod := 0; + ToggleFIFlags('T',F.FIFlagS); + END; + END; + Abort := FALSE; + END; + 'M' : BEGIN + SaveConfSystem := ConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + InputStr := ''; + Done := FALSE; + REPEAT + IF (InputStr <> '?') THEN + NL; + Prt('Move file to which file area (1-'+IntToStr(NumFileAreas)+') [?=List,Q=Quit]: '); + MPL(Length(IntToStr(NumFileAreas))); + Input(InputStr,Length(IntToStr(NumFileAreas))); + NewFileArea := AFBase(StrToInt(InputStr)); + IF (InputStr = '') THEN + BEGIN + NL; + Print('Aborted.'); + Done := TRUE; + END + ELSE IF (InputStr = 'Q') THEN + Done := TRUE + ELSE IF (InputStr = '?') THEN + BEGIN + FileAreaList(FALSE); + Abort := FALSE; + END + ELSE IF (NewFileArea < 1) OR (NewFileArea > NumFileAreas) THEN + BEGIN + NL; + Print('The range must be from 1 to '+IntToStr(NumFileAreas)+'.'); + END + ELSE IF (NewFileArea = FileArea) THEN + BEGIN + NL; + Print('This file can not be moved to the same file area.'); + END + ELSE + BEGIN + SaveFileArea := FileArea; + IF (FileArea <> NewFileArea) THEN + ChangeFileArea(NewFileArea); + IF (FileArea = NewFileArea) THEN + BEGIN + Done := TRUE; + FileArea := SaveFileArea; + LoadFileArea(FileArea); + IF Exist(MemFileArea.DLPath+F.FileName) THEN + InputStr := MemFileArea.DLPath+F.FileName + ELSE + InputStr := MemFileArea.ULPath+F.FileName; + MoveFromDir := BSlash(MemFileArea.DLPath,FALSE); + LoadFileArea(NewFileArea); + NL; + Print('^5Moving file to: ^3'+MemFileArea.AreaName+'^5'); + MoveToDir := BSlash(MemFileArea.ULPath,FALSE); + Ok := TRUE; + IF Exist(MemFileArea.ULPath+F.FileName) THEN + BEGIN + NL; + Print('There is already a file by that name there.'); + NL; + IF (NOT PYNQ('Overwrite it? ',0,FALSE)) THEN + BEGIN + FileArea := SaveFileArea; + InitFileArea(FileArea); + Exit; + END; + END; + IF (MoveFromDir = MoveToDir) THEN + BEGIN + NL; + Print('^7No move: directory paths are the same.'); + Ok := TRUE; + END + ELSE IF (NOT Exist(InputStr)) THEN + BEGIN + NL; + Print('File does not actually exist.'); + END + ELSE + BEGIN + NL; + Prompt('^5Progress: '); + MoveFile(Ok,NoSpace,TRUE,InputStr,MemFileArea.ULPath+F.FileName); + IF (Ok) THEN + NL; + IF (NOT Ok) THEN + BEGIN + Prompt('^7Move Failed'); + IF (NOT NoSpace) THEN + NL + ELSE + Prompt(' - Insuffient space on drive '+Chr(ExtractDriveNumber(MemFileArea.ULPath) + 64)+':'); + Print('!'); + END; + END; + IF ((Ok)) OR (NOT Exist(InputStr)) THEN + BEGIN + Prompt('^5Moving file records ... '); + FileArea := SaveFileArea; + InitFileArea(FileArea); + IF (BadDownloadPath) THEN + Exit; + IF (F.VPointer <> -1) THEN + LoadVerbArray(F,V,NumExtDesc); + Deleteff(F,DirFileRecNum); + FileArea := NewFileArea; + InitFileArea(FileArea); + IF (BadDownloadPath) THEN + Exit; + IF (F.VPointer <> - 1) THEN + SaveVerbArray(F,V,NumExtDesc); + Seek(DirFile,FileSize(DirFile)); + Write(DirFile,F); + FileArea := SaveFileArea; + InitFileArea(FileArea); + IF (BadDownloadPath) THEN + Exit; + SysOpLog('Moved '+SQOutSp(F.FileName)+' from Dir#'+IntToStr(FileArea)+' to Dir#'+IntToStr(NewFileArea)); + Print('^5Done.'); + Dec(LastDIRRecNum); + Cmd := 'N'; + END; + END; + END; + UNTIL ((Done) OR (HangUp)); + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + END; + 'P' : BackUp := TRUE; + 'Q' : Abort := TRUE; + 'R' : ToggleFIFlags('R',F.FIFlagS); + 'T' : ToggleFIFlags('T',F.FIFlagS); + 'U' : IF (NOT CoSysOp) THEN + BEGIN + NL; + Print('You do not have the required access level for this option.') + END + ELSE + BEGIN + IF (F.OwnerNum < 1) OR (F.OwnerNum > (MaxUsers - 1)) THEN + BEGIN + LoadURec(User,1); + F.OwnerNum := 1; + F.OwnerName := AllCaps(User.Name); + END; + UserEditor(F.OwnerNum); + END; + 'V' : BEGIN + ToggleFIFlags('V',F.FIFlagS); + CreditFile(User,F,(NOT (FINotVal IN F.FIFlagS)),0) + END; + 'W' : BEGIN + Print('^8WARNING: ^5User may not have received credit for upload!'); + NL; + IF PYNQ('Withdraw credit? ',0,FALSE) THEN + BEGIN + NL; + CreditFile(User,F,FALSE,F.FilePoints); + END; + END; + '?' : BEGIN + 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(DirFile,DirFileRecNum); + Write(DirFile,F); + END; + UNTIL (Cmd IN ['P','Q','N']) OR (Abort) OR (Next) OR (HangUp); +END; + +PROCEDURE EditFiles; +VAR + F: FileInfoRecordType; + FN: Str12; + Cmd: Char; + DirFileRecNum: Integer; + BackUp: Boolean; +BEGIN + NL; + Print('File editor:'); + GetFileName(FN); + IF (FN = '') OR (Pos('.',FN) = 0) THEN + BEGIN + NL; + Print('Aborted.'); + END + ELSE + BEGIN + RecNo(F,FN,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,BackUp); + IF (Cmd = 'Q') THEN + Abort := TRUE + ELSE + BEGIN + IF (Cmd = 'P') THEN + LRecNo(F,FN,DirFileRecNum) + ELSE + NRecNo(F,FN,DirFileRecNum); + END; + WKey; + END; + END; + Close(DirFile); + Close(VerbF); + 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 + F: FileInfoRecordType; + DirFileRecNum: Integer; + BackUp, + ShownAlready: Boolean; + BEGIN + IF (FileArea <> FArea) THEN + ChangeFileArea(FArea); + IF (FileArea = FArea) THEN + BEGIN + RecNo(F,'*.*',DirFileRecNum); + IF (BadDownloadPath) THEN + Exit; + ShownAlready := FALSE; + WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(DirFile,DirFileRecNum); + Read(DirFile,F); + BackUp := FALSE; + IF (FINotVal IN F.FIFlagS) AND (NOT (FIResumeLater IN F.FIFlagS)) THEN + BEGIN + IF (NOT ShownAlready) THEN + BEGIN + NL; + Print('^1Unvalidated files present in ^5'+MemFileArea.AreaName+'^5 #'+IntToStr(FileArea)); + ShownAlready := TRUE; + END; + EditFile(DirFileRecNum,Cmd1,NoPrompt,IsPoints,BackUp); + END; + IF (BackUp) THEN + BEGIN + REPEAT + LRecNo(F,'*.*',DirFileRecNum); + UNTIL (DirFileRecNum = -1) OR ((FINotVal IN F.FIFlags) AND NOT (FIResumeLater IN F.FIFlags)); + END + ELSE + NRecNo(F,'*.*',DirFileRecNum); + WKey; + END; + Close(DirFile); + Close(VerbF); + 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 <= 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/UNUSED/FILE10.TPU b/SOURCE/UNUSED/FILE10.TPU new file mode 100644 index 0000000..655b79a Binary files /dev/null and b/SOURCE/UNUSED/FILE10.TPU differ diff --git a/SOURCE/UNUSED/FILE11.TPU b/SOURCE/UNUSED/FILE11.TPU new file mode 100644 index 0000000..5c94845 Binary files /dev/null and b/SOURCE/UNUSED/FILE11.TPU differ diff --git a/SOURCE/UNUSED/FILE12.TPU b/SOURCE/UNUSED/FILE12.TPU new file mode 100644 index 0000000..3a5e896 Binary files /dev/null and b/SOURCE/UNUSED/FILE12.TPU differ diff --git a/SOURCE/UNUSED/FILE13.TPU b/SOURCE/UNUSED/FILE13.TPU new file mode 100644 index 0000000..bd1c379 Binary files /dev/null and b/SOURCE/UNUSED/FILE13.TPU differ diff --git a/SOURCE/UNUSED/FILE14.TPU b/SOURCE/UNUSED/FILE14.TPU new file mode 100644 index 0000000..5bc6b49 Binary files /dev/null and b/SOURCE/UNUSED/FILE14.TPU differ diff --git a/SOURCE/UNUSED/FILE2.TPU b/SOURCE/UNUSED/FILE2.TPU new file mode 100644 index 0000000..3eb261f Binary files /dev/null and b/SOURCE/UNUSED/FILE2.TPU differ diff --git a/SOURCE/UNUSED/FILE3.TPU b/SOURCE/UNUSED/FILE3.TPU new file mode 100644 index 0000000..4d4a622 Binary files /dev/null and b/SOURCE/UNUSED/FILE3.TPU differ diff --git a/SOURCE/UNUSED/FILE4.TPU b/SOURCE/UNUSED/FILE4.TPU new file mode 100644 index 0000000..ca723cd Binary files /dev/null and b/SOURCE/UNUSED/FILE4.TPU differ diff --git a/SOURCE/UNUSED/FILE5.TPU b/SOURCE/UNUSED/FILE5.TPU new file mode 100644 index 0000000..4a18e34 Binary files /dev/null and b/SOURCE/UNUSED/FILE5.TPU differ diff --git a/SOURCE/UNUSED/FILE6.TPU b/SOURCE/UNUSED/FILE6.TPU new file mode 100644 index 0000000..5730496 Binary files /dev/null and b/SOURCE/UNUSED/FILE6.TPU differ diff --git a/SOURCE/UNUSED/FILE7.TPU b/SOURCE/UNUSED/FILE7.TPU new file mode 100644 index 0000000..eddb4d0 Binary files /dev/null and b/SOURCE/UNUSED/FILE7.TPU differ diff --git a/SOURCE/UNUSED/FILE8.TPU b/SOURCE/UNUSED/FILE8.TPU new file mode 100644 index 0000000..069da4f Binary files /dev/null and b/SOURCE/UNUSED/FILE8.TPU differ diff --git a/SOURCE/UNUSED/FILE9.TPU b/SOURCE/UNUSED/FILE9.TPU new file mode 100644 index 0000000..c42afb0 Binary files /dev/null and b/SOURCE/UNUSED/FILE9.TPU differ diff --git a/SOURCE/UNUSED/FILES.BBS b/SOURCE/UNUSED/FILES.BBS new file mode 100644 index 0000000..ee3b5f1 --- /dev/null +++ b/SOURCE/UNUSED/FILES.BBS @@ -0,0 +1,63 @@ +The Renegade BBS Batch Download File Listing + +RG0930F .ZIP -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- + + The Renegade Bulletin Board System + v09-30.6 FULL INSTALL!! + + Download This To Start You Own BBS!! + + -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +ACTIONS .ASC 1 +ACTIONS .LST 1 +ARFLAGS .ASC 1 +AUTO .ASC 1 +BATCHUL0.ASC 1 +BBSEH .ASC 1 +BBSET .ASC 1 +BBSLEM .ASC 1 +BBSLET .ASC 1 +BBSLIST .SCR 1 +BBSME .ASC 1 +BBSMN .ASC 1 +BBSNH .ASC 1 +BBSNT .ASC 1 +BULLET1 .ASC 1 +BULLET2 .ASC 1 +BULLET3 .ASC 1 +COLOR .ASC 1 +FILEHN .ANS 1 +FILEHN .ASC 1 +FILEHP .ANS 1 +FILEHP .ASC 1 +FSHELP .ASC 1 +LASTH .ASC 1 +LASTM .ASC 1 +LASTT .ASC 1 +MAIN .ASC 1 +MAIN25 .ASC 1 +MAIN250 .ASC 1 +MAIN255 .ASC 1 +MENUCMD .ASC 1 +NEWINFO .ASC 1 +NODELH .ASC 1 +NODELM .ASC 1 +NODELT .ASC 1 +PRELOGON.ANS 1 +PRELOGON.ASC 1 +PRHELP .ASC 1 +PROTLIST.ASC 1 +PSEUDOS .ASC 1 +QUOTEFTR.ANS 1 +QUOTEFTR.ASC 1 +QUOTEHDR.ANS 1 +QUOTEHDR.ASC 1 +SYSTEM .ASC 1 +TELEHELP.ASC 1 +TIMEDOUT.ANS 1 +TIMEDOUT.ASC 1 +USERH .ASC 1 +USERM .ASC 1 +USERT .ASC 1 +YOURINFO.ASC 1 + diff --git a/SOURCE/UNUSED/FSHELP.ASC b/SOURCE/UNUSED/FSHELP.ASC new file mode 100644 index 0000000..53d83c4 --- /dev/null +++ b/SOURCE/UNUSED/FSHELP.ASC @@ -0,0 +1,10 @@ +|08컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +^1Press ^3ENTER ^1to get a blank line and press ^3/ +^1and one of the following command keys. + + ^1(^3^1)Continue message + ^1(^3A^1)bort message ^1(^3C^1)lear message + ^1(^3F^1)ile attach ^1(^3M^1)CI codes Yes/No + ^1(^3Q^1)uote message ^1(^3S^1)ave message + ^1(^3T^1)itle change ^1(^3U^1)pload message +|08컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�^1 diff --git a/SOURCE/UNUSED/FSTR.PAS b/SOURCE/UNUSED/FSTR.PAS new file mode 100644 index 0000000..e94ab7b --- /dev/null +++ b/SOURCE/UNUSED/FSTR.PAS @@ -0,0 +1,136 @@ +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-} + +unit fstr; + +interface + +procedure read_in_fstrings; + +implementation + +uses + common; + +procedure read_in_fstrings; +var + lang : text; + WhichNum : String; + WhichStr : Longint; + InString : String; +begin + if not exist(general.datapath+'renegade.lng') then + begin + sysoplog('Bad or missing language file. Obtain a new one from the distribution package.'); + writeln ('Bad or missing language file. Obtain a new one from the distribution package.'); + halt; + end; + + fillchar(fstring,sizeof(fstring),#0); + + assign(lang,general.datapath+'renegade.lng'); + reset(lang); + while not eof(Lang) do begin + + readln(lang,InString); + + if InString[1] = '[' then begin + + + WhichNum := Copy(InString,Pos('[',InString)+1,Pos(']',InString)-2); + WhichStr := StrToInt(WhichNum); + if Pos(']',InString) = Length(InString) then InString := '' + else InString := Copy(InString,Pos(']',InString)+1,Length(InString)); + + + with fstring do begin + case WhichStr of + 1: anonymous := InString; + 2: note[1] := InString; + 3: note[2] := InString; + 4: lprompt := InString; + 5: echoc := InString[1]; + 6: yourpassword := InString; + 7: yourphonenumber := InString; + 8: engage := InString; + 9: endchat := InString; + 10: wait := InString; + 11: pause := InString; + 12: entermsg1 := InString; + 13: entermsg2 := InString; + 14: newscan1 := InString; + 15: newscan2 := InString; + 16: newuserpassword := InString; + 17: automsgt := InString; + 18: autom := InString[1]; + 19: shelldos1 := InString; + 20: readingemail := InString; + 21: chatcall1 := InString; + 22: chatcall2 := InString; + 23: shuttleprompt := Instring; + 24: namenotfound := Instring; + 25: bulletinline := Instring; + 26: protocolp := Instring; + 27: listline := Instring; + 28: newline := Instring; + 29: searchline := Instring; + 30: findline1 := Instring; + 31: findline2 := Instring; + 32: downloadline := Instring; + 33: uploadline := Instring; + 34: viewline := Instring; + 35: nofilecredits := Instring; + 36: unbalance := Instring; + 37: ilogon := Instring; + 38: gfnline1 := Instring; + 39: gfnline2 := Instring; + 40: batchadd := Instring; + 41: addbatch := Instring; + 42: readq := Instring; + 43: sysopprompt := Instring; + 44: default := Instring; + 45: newscanall := Instring; + 46: newscandone := Instring; + 47: chatreason := Instring; + 48: quote_line[1] := Instring; + 49: quote_line[2] := Instring; + 50: userdefques[1] := Instring; + 51: userdefques[2] := Instring; + 52: userdefques[3] := Instring; + 53: userdefed[1] := Instring; + 54: userdefed[2] := Instring; + 55: userdefed[3] := Instring; + 56: continue := Instring; + 57: waitfortelnet := Instring; + 58: stringtwo := Instring; + 59: AskInvisibleLoginStr := Instring; + 60: cantemail := Instring; + 61: sendemail := Instring; + 62: nodenotavail := Instring; + 63: massemail := Instring; + 64: massemailall := Instring; + 65: nonetmail := Instring; + 66: isnetmail := Instring; + 67: nomailwaiting := Instring; + 68: sorryreply := Instring; + 69: FileNewScan := Instring; + 70: ScanCharCheck := InString; + 71: ShowBulletins := InString; + 72: QuickLogon := InString; + 73: LogonAsNew := InString; + 74: MsgHeader := InString; + 75: MsgAreaHeader := InString; + 76: FileAreaHeader := InString; + 77: EmailSenderHeader := InString; + 78: VoteListTopicsHeader := InString; + 79: votetopicresultheader := InString; + 80: FileBoardNameHeader := InString; + 81: syschathelp := InString; + end;{case} + end; + end;{if = [} + end;{while} + close(lang); +end; + + +end. diff --git a/SOURCE/UNUSED/FTS-0001.016 b/SOURCE/UNUSED/FTS-0001.016 new file mode 100644 index 0000000..93908d5 --- /dev/null +++ b/SOURCE/UNUSED/FTS-0001.016 @@ -0,0 +1,1239 @@ +Document: FTS-0001 +Version: 016 +Date: 30-Sep-95 + + + + + A Basic FidoNet(r) Technical Standard +| Revision 16 + Formerly known as FSC001, FSC-0001 +| Randy Bush, Pacific Systems Group +| September 30, 1995 + + + + +Status of this document: + + This FTS (FidoNet(r) Technical Standard) specifies a standard for + the FidoNet community. FidoNet nodes are expected to adopt and implement + this standard. Distribution is subject to the restrictions stated in the + copyright paragraph below. + + Fido and FidoNet are registered marks of Tom Jennings and Fido Software. + + Copyright 1986-95, Randy Bush. All rights reserved. A right to + distribute only without modification and only at no charge is granted. + Under no circumstances is this document to be reproduced or distributed + as part of or packaged with any product or other sales transaction for + which any fee is charged. Any and all other reproduction or excerpting + requires the explicit written consent of the author. + + + A. Introduction + + FidoNet has grown beyond most peoples' fantasies, and new FidoNet + implementations are appearing regularly. Unfortunately, the scattered + nature of the documentation and absence of clear testing procedures have + made implementation difficult. FidoNet, in its desire to promote and + encourage FidoNet implementations, suggested a project to create a + technical standard for FidoNet. The author did not design or specify + the data formats or protocols, only attempted to document them. + + This document defines the data structures and communication protocols + which a FidoNet implementation must provide. The implementor of FidoNet + compatible systems is the intended audience of this document. + + The layered metaphor of the ISO Open Systems Interface reference model + has been used to view FidoNet from a standard perspective. As with most + prospective ISO/OSI descriptions, FidoNet does not always make this + easy. + + The content of this document was gleaned from the references given at + the end. + + Please direct technical comments and errata to +| Randy Bush randy@psg.com +| Pacific Systems Group + 9501 S.W. Westhaven Drive + Portland, Oregon US-97225 +| + + 1. Basic Requirements for a FidoNet Implementation + + Compatibility is a set of abilities which, when taken as a whole, make + it safe to list a net or node in the FidoNet nodelist. In other words, + if another node should attempt contact, does it have a reasonable + chance of successful communication? This is a social obligation, as + the calling system pays money for the attempt. Conversely, an + implementation should be able to successfully contact other systems, + as life is not a one-way street. + + A FidoNet implementation must be able to call other nodes and transfer + messages and files in both directions. This includes pickup and poll. + A FidoNet implementation must be able to accept calls from other nodes + and transfer messages and files in both directions. This includes + pickup. + + FidoNet implementations must be able to receive and process the FidoNet + format nodelist, and transfer nodelists to other nodes. A companion + document, FTS-0005, defines the FidoNet format nodelist and how to + interpret and process it. + + A FidoNet implementation must route messages which do not have files + attached through net hosts as shown in a FidoNet format nodelist. + + + 2. Levels of Compliance + + This documents represents the most basic FidoNet implementation. A + future document will define well tested extensions which are optional + but provide sufficient additional function that implementors should + seriously consider them. SEAdog(tm), from System Enhancement + Associates, is an excellent example of such an extended FidoNet + implementation. + + + 3. The ISO/OSI Reference Model (cribbed from "Protocol Verification via + Executable Logic Specifications", D. P. Sidhu, in Rudin & West) + + In the ISO/OSI model, a distributed system consists of entities that + communicate with each other according to a set of rules called a + protocol. The model is layered, and there are entities associated + with each layer of the model which provide services to higher layers + by exchanging information with their peer entities using the services + of lower layers. The only actual physical communication between two + systems is at the lowest level. + + Several techniques have been used in the specification of such + protocols. A common ingredient in all techniques is the notion of the + extended finite state automata or machine. Extensions include the + addition of state variables for the storing of state information about + the protocol. The state of an automation can change as a result of + one of the following events: + + o Request from an upper network layer for service + + o Response to the upper layer + + o Request to the lower network layer to perform a service + + o Response from the lower layer + + o Interaction with the system and environment in which the protocol is + implemented (e.g. timeouts, host operating system aborts, ...) + + A protocol specification, in a large part, consists of specifying + state changes in automata which model protocol entities and in + describing the data which they exchange. + + For historical reasons, the term packet is used in FidoNet to + represent a bundle of messages, as opposed to the more common use as a + unit of communication, which is known as a block in FidoNet. + + + 4. Data Description + + A language specific notation was avoided. Please help stamp out + environmental dependencies. Only you can prevent PClone market + dominance. Don't panic, there are rectangular record layouts too. + + (* non-terminals *) + UpperCaseName - to be defined further on + + (* literals *) + "ABC" - ASCII character string, no termination implied + nnH - byte in hexadecimal + + (* terminals *) + someName - 16-bit integer, low order byte first (8080 style) + someName[n] - field of n bytes + someName[.n] - field of n bits + someName(n) - Null terminated string allocated n chars (incl Null) + someName{max} - Null terminated string of up to max chars (incl Null) + + (* punctuation *) + a b - one 'a' followed by one 'b' + ( a | b ) - either 'a' or 'b', but not both + { a } - zero or more 'a's + [ b ] - zero or one 'b' + (* comment *) - ignored + + (* predeclared constant *) + Null = 00H + + + + 5. Finite State Machine Notation + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | fnn*| | | | | + `-----+----------+-------------------------+-------------------------+-----' + + State # - Number of this state (e.g. R13). + f - FSM initial (Window, Sender, Receiver, ...) + nn - state number + * - state which represents a lower level protocol which + is represented by yet another automation. + + State Name - Descriptive name of this state. + + Predicate(s) - Conditions which terminate the state. If predicates are + non-exclusive, consider them ordered. + + Action(s) - Action(s) corresponding to predicate(s) + + Next State - Subsequent state corresponding to predicate(s) + + Ideally, there should be a supporting section for each state which + should give a prose description of the state, its predicates, actions, + etc. So much for ideals. + + + B. Application Layer : the System from the User's View + + The application layer is outside the domain of a FidoNet standard, as it + is the layer that the user's application sees as opposed to what FidoNet + sees. In recent months, there has been sufficient confusion and + discussion about the format of data at this level to warrant the + description of the data structure, the message as it is stored by Fido, + SEAdog, and Rover. + + Perfectly valid FidoNet systems may be implemented whose stored messages + differ greatly from this format. + + + 1. Application Layer Data Definition : a Stored Message + + Stored Message + + Offset + dec hex + .-----------------------------------------------. + 0 0 | | + ~ fromUserName ~ + | 36 bytes | + +-----------------------+-----------------------+ + 36 24 | | + ~ toUserName ~ + | 36 bytes | + +-----------------------+-----------------------+ + 72 48 | | + ~ subject ~ + | 72 bytes | + +-----------------------+-----------------------+ + 144 90 | | + ~ DateTime ~ + | 20 bytes | + +-----------------------+-----------------------+ + 164 A4 | timesRead (low order) | timesRead (high order)| + +-----------------------+-----------------------+ + 166 A6 | destNode (low order) | destNode (high order) | + +-----------------------+-----------------------+ + 168 A8 | origNode (low order) | origNode (high order) | + +-----------------------+-----------------------+ + 170 AA | cost (low order) | cost (high order) | + +-----------------------+-----------------------+ + 172 AC | origNet (low order) | origNet (high order) | + +-----------------------+-----------------------+ + 174 AE | destNet (low order) | destNet (high order) | + +-----------------------+-----------------------+ + 176 B0 | destZone (optional) | destZone (optional) | + +-----------------------+-----------------------+ + 178 B2 | origZone (optional) | origZone (optional) | + +-----------------------+-----------------------+ + 180 B4 | destPoint(optional) | destPoint(optional) | + +-----------------------+-----------------------+ + 182 B6 | origPoint(optional) | origPoint(optional) | + +-----------------------+-----------------------+ + 184 B8 | replyTo (low order) | replyTo (high order) | + +-----------------------+-----------------------+ + 186 BA | Attribute (low order) | Attribute (high order)| + +-----------------------+-----------------------+ + 188 BC | nextReply (low order) | nextReply (high order)| + +-----------------------+-----------------------+ + 190 BE | text | + ~ unbounded ~ + | null terminated | + `-----------------------------------------------' + + Message = fromUserName(36) (* Null terminated *) + toUserName(36) (* Null terminated *) + subject(72) (* see FileList below *) + DateTime (* message body was last edited *) + timesRead (* number of times msg has been read *) + destNode (* of message *) + origNode (* of message *) + cost (* in lowest unit of originator's + currency *) + origNet (* of message *) + destNet (* of message *) + destZone (* of message *) + origZone (* of message *) + destPoint (* of message *) + origPoint (* of message *) + replyTo (* msg to which this replies *) + AttributeWord + nextReply (* msg which replies to this *) + text(unbounded) (* Null terminated *) + + DateTime = (* a character string 20 characters long *) + (* 01 Jan 86 02:34:56 *) + DayOfMonth " " Month " " Year " " + " " HH ":" MM ":" SS + Null + + DayOfMonth = "01" | "02" | "03" | ... | "31" (* Fido 0 fills *) + Month = "Jan" | "Feb" | "Mar" | "Apr" | "May" | "Jun" | + "Jul" | "Aug" | "Sep" | "Oct" | "Nov" | "Dec" + Year = "01" | "02" | .. | "85" | "86" | ... | "99" | "00" + HH = "00" | .. | "23" + MM = "00" | .. | "59" + SS = "00" | .. | "59" + + AttributeWord bit meaning + --- -------------------- + 0 + Private + 1 + s Crash + 2 Recd + 3 Sent + 4 + FileAttached + 5 InTransit + 6 Orphan + 7 KillSent + 8 Local + 9 s HoldForPickup + 10 + unused + 11 s FileRequest + 12 + s ReturnReceiptRequest + 13 + s IsReturnReceipt + 14 + s AuditRequest + 15 s FileUpdateReq + + s - need not be recognized, but it's ok + + - not zeroed before packeting + + Bits numbers ascend with arithmetic significance of bit position. + + + Message Text + + Message text is unbounded and null terminated (note exception below). + + A 'hard' carriage return, 0DH, marks the end of a paragraph, and must + be preserved. + + So called 'soft' carriage returns, 8DH, may mark a previous + processor's automatic line wrap, and should be ignored. Beware that + they may be followed by linefeeds, or may not. + + All linefeeds, 0AH, should be ignored. Systems which display message + text should wrap long lines to suit their application. + + If the first character of a physical line (e.g. the first character of + the message text, or the character immediately after a hard carriage + return (ignoring any linefeeds)) is a ^A (, 01H), then that + line is not displayed as it contains control information. The + convention for such control lines is: + o They begin with ^A + o They end at the end of the physical line (i.e. ignore soft s). + o They begin with a keyword followed by a colon. + o The keywords are uniquely assigned to applications. + o They keyword/colon pair is followed by application specific data. + + Current ^A keyword assignments are: +| o TOPT - destination point address + o FMPT - origin point address + o INTL - used for inter-zone address + + + File Specifications + + If one or more of FileAttached, FileRequest, or FileUpdateReq are + asserted in an AttributeWord, the subject{72} field is interpreted as + a list of file specifications which may include wildcards and other + system-dependent data. This list is of the form + + FileList = [ FileSpec { Sep FileSpec } ] Null + + FileSpec = (* implementation dependent file specification. may + not contain Null or any of the characters in Sep. *) + + Sep = ( " " | "," ) { " " } + + + There are deviations from and additions to these specifications + + 1 - Fido does not necessarily terminate the message text with a Null, + but uses an empty line (0DH 0AH 0DH 0AH). Some Fido utilities + use an EOF (1AH). + + 2 - SEAdog zeros the message cost field when building a message. + + 4 - SEAdog uses a different format for dates, e.g. + + DateTime = (* a character string 20 characters long *) + (* SEAdog format Mon 1 Jan 86 02:34 *) + DayOfWk " " DayOfMo " " Month " " Year " " HH ":" MM Null + + DayOfWk = "Mon" | "Tue" | "Wed" | "Thu" | "Fri" | "Sat" | "Sun" + DayOfMo = " 1" | " 2" | " 3" | ... | "31" (* blank fill *) + + + + 2. Application Layer Protocol : Schedules and Events + + At the application level, FidoNet imposes few protocol requirements. + An implementation must automatically originate and receive + node-to-node FidoNet connections. Some implementations do this in + 'windows' or time slots. Routing of messages will usually be + different and customizable for each scheduled window. + + The ability to send to and receive from any FidoNet listed node during + the Zone Mail Hour (eg. 9:00-10:00 UCT in Z1) is considered mandatory. + + Current implementations assemble all data for outbound connections at + the start of a window, and disassemble inbound data at the end of a + window. Due to performance considerations on small machines, this is + considered a valid optimization. Observe that it somewhat inhibits + dynamic routing. + + + C. Presentation Layer : the User from the System's View + + 1. Presentation Layer Data Definition : the Packed Message + + To conserve space and eliminate fields which would be meaningless if + sent (e.g. timesRead), messages are packed for transmission. As this + is a data structure which is actually transferred, its definition is + critical to FidoNet. A packed message has a number of fixed length + fields followed by four null terminated strings. + + While most of the string fields in a stored message are fixed length, + to conserve space strings are variable length when in a packet. All + variable length strings are all Null terminated, including especially + the message text. + + + Packed Message + + Offset + dec hex + .-----------------------------------------------. + 0 0 | 0 | 2 | 0 | 0 | + +-----------------------+-----------------------+ + 2 2 | origNode (low order) | origNode (high order) | + +-----------------------+-----------------------+ + 4 4 | destNode (low order) | destNode (high order) | + +-----------------------+-----------------------+ + 6 6 | origNet (low order) | origNet (high order) | + +-----------------------+-----------------------+ + 8 8 | destNet (low order) | destNet (high order) | + +-----------------------+-----------------------+ + 10 A | Attribute (low order) | Attribute (high order)| + +-----------------------+-----------------------+ + 12 C | cost (low order) | cost (high order) | + +-----------------------+-----------------------+ + 14 E | | + ~ DateTime ~ + | 20 bytes | + +-----------------------+-----------------------+ + 34 22 | toUserName | + ~ max 36 bytes ~ + | null terminated | + +-----------------------+-----------------------+ + | fromUserName | + ~ max 36 bytes ~ + | null terminated | + +-----------------------+-----------------------+ + | subject | + ~ max 72 bytes ~ + | null terminated | + +-----------------------+-----------------------+ + | text | + ~ unbounded ~ + | null terminated | + `-----------------------------------------------' + + Due to routing, the origin and destination net and node of a packet + are often quite different from those of the messages within it, nor + need the origin and destination nets and nodes of the messages within + a packet be homogenous. + + PakdMessage = 02H 00H (* message type, old type-1 obsolete *) + origNode (* of message *) + destNode (* of message *) + origNet (* of message *) + destNet (* of message *) + AttributeWord + cost (* in lowest unit of originator's + currency *) + DateTime (* message body was last edited *) + toUserName{36} (* Null terminated *) + fromUserName{36} (* Null terminated *) + subject{72} (* Null terminated *) + text{unbounded} (* Null terminated *) + + + + + + + + 2. Presentation Layer Protocol : a Mail Window + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | W0 | WindTop | 1 end of window reached | reset modem to not answr| exit| + | | | 2 time remains in window| ensure modem can answer | W1 | + |-----+----------+-------------------------+-------------------------+-----| + | W1 | WindIdle | 1 incoming call | | W2 | + | | | 2 receive-only mode | | W0 | + | | | 3 send-only mode | | W3 | + | | | 4 60-180 secs & no call | | W3 | + |-----+----------+-------------------------+-------------------------+-----| + | W2* | WindRecv | | (receive call R0) | W3 | + |-----+----------+-------------------------+-------------------------+-----| + | W3 | WindCall | 1 select outgoing call | increment try count | W4 | + | | | 2 no outgoing calls | | W0 | + |-----+----------+-------------------------+-------------------------+-----| + | W4* | WindSend | | (make call S0) | W5 | + |-----+----------+-------------------------+-------------------------+-----| + | W5 | WindMark | 1 call successful | remove node fr call list| W0 | + | | | 2 no connect | remove if try cnt > lim | W0 | + | | | 3 call failed | incr conn cnt, remove | W0 | + | | | | if con cnt > lim | | + `-----+----------+-------------------------+-------------------------+-----' + + + The length of the inter-call delay time at W1.4 is not critical. It is + important that this not be a constant, so two systems calling each other + do not incur infinite busy signals. Sophisticated implementations may + vary the inter-call delay depending on number of calls to be made, + window width, user specification, etc. + + + D. Session Layer Protocol : Connecting to Another FidoNet Machine + + A session is a connection between two FidoNet machines. It is currently + assumed to be over the DDD telephone network via modems. The calling + machine starts out as the sender and the called machine as the receiver. + The pickup feature is described by the sender and receiver changing + roles midway through the session, after the sender has transferred the + message packet and any attached files. Due to the lack of security in + the pickup protocol (danger of pickup by a fake node), a change in the + protocol may be expected in the near future. + + Once a connection has been established, each system should ensure that + the physical connection remains throughout the session. For physical + layers implemented through modems, this means monitoring the carrier + detect signal, and terminating the session if it is lost. + + Error detection at the physical layer should be monitored for both sent + and received characters. Parity, framing, and other physical errors + should be detected. + + Sender + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | S0 | SendInit | | dial modem | S1 | + |-----+----------+-------------------------+-------------------------+-----| + | S1 | WaitCxD | 1 carrier detected | delay 1-5 seconds | S2 | + | | | 2 busy, etc. | report no connection | exit| + | | | 3 voice | report no carrier | exit| + | | | 4 carrier not detected | report no connection | exit| + | | | within 60 seconds | | | + |-----+----------+-------------------------+-------------------------+-----| + | S2 | WhackCRs | 1 over 30 seconds | report no response | exit| + | | | 2 ?? s received | delay 1 sec | S3 | + | | | 3 s not received | send | S2 | + | | | | delay ??? secs | | + |-----+----------+-------------------------+-------------------------+-----| + | S3 | WaitClear| 1 no input for 0.5 secs | send TSYNCH = AEH | S4 | + | | | 2 over 60 seconds | hang up, report garbage | exit| + | | | and line not clear | | | + |-----+----------+-------------------------+-------------------------+-----| + | S4* | TSyncChk | 1 'C' or NAK (peeked at)| (XMODEM send packet XS1)| S5 | + | | | 2 over 2 seconds | eat noise, resend TSYNCH| S4 | + | | | 3 over 30 seconds | hang up report not Fido | exit| + |-----+----------+-------------------------+-------------------------+-----| + | S5 | CheckMail| 1 XMODEM successful | (Fido registers success)| S6 | + | | | 2 XMODEM fail or timeout| hang up, report mail bad| exit| + |-----+----------+-------------------------+-------------------------+-----| + | S6* | SendFiles| | (BATCH send files BS0) | S7 | + |-----+----------+-------------------------+-------------------------+-----| + | S7 | CheckFile| 1 BATCH send successful | | S8 | + | | | 2 BATCH send failed | hang up, rept files fail| exit| + |-----+----------+-------------------------+-------------------------+-----| + | S8 | TryPickup| 1 wish to pickup | note send ok | R2* | + | | | 2 no desire to pickup | delay 5 secs | exit| + | | | | hang up, rept send ok | | + `-----+----------+-------------------------+-------------------------+-----' + + Although the above shows the sender emitting only one TSYNCH, it is + recommended that a timeout of 5-20 seconds should initiate another TSYNCH. + The receiver should tolerate multiple TSYNCHs. + + In state S4, the phrase "peeked at" means that the character is not removed + from the buffer. Therefore when XS1 is started the proper character for + beginning the Xmodem transfer will be detected. + + Receiver + + The receiving FSM is given an external timer, the expiration of which + will cause termination with a result of 'no calls' (R0.2). + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | R0 | WaitCxD | 1 carrier detected | | R1 | + | | | 2 external timer expires| report no calls | exit| + |-----+----------+-------------------------+-------------------------+-----| + | R1 | WaitBaud | 1 baud rate detected | send signon with s | R2 | + | | | 2 no detect in ?? secs | hang up, report no baud | exit| + |-----+----------+-------------------------+-------------------------+-----| + | R2 | WaitTsync| 1 TSYNCH received | ignore input not TSYNCH | R3 | + | | | 2 60 seconds timeout | hang up, report not Fido| exit| + |-----+----------+-------------------------+-------------------------+-----| + | R3* | RecMail | | (XMODEM rec packet XR0) | R4 | + |-----+----------+-------------------------+-------------------------+-----| + | R4 | XRecEnd | 1 XMODEM successful | delay 1 second | R5 | + | | | | flush input | | + | | | 2 XMODEM failed | hang up, rept mail fail | exit| + |-----+----------+-------------------------+-------------------------+-----| + | R5* | RecFiles | | (BATCH rec files BR0) | R6 | + |-----+----------+-------------------------+-------------------------+-----| + | R6 | ChkFiles | 1 BATCH recv successful | delay 2 secs | R7 | + | | | 2 BATCH recv failed | hang up, report bad file| exit| + |-----+----------+-------------------------+-------------------------+-----| + | R7 | AllowPkup| 1 have pickup for sender| receiver becomes sender | S3* | + | | | 2 nothing to pickup | hang up, rept recv ok | exit| + `-----+----------+-------------------------+-------------------------+-----' + + + E. Transport Layer : ????? + + 1. Data Definitions + + 2. Transport Layer Protocol : Routing + + FidoNet does not necessarily send a message directly to its + destination. To reduce the number of network connections, mail to a + subset of the nodelist may be routed to one node for further + distribution within that subset. In addition, custom routing is + possible. Routing of a message is determined in one of three ways. + + o If there are files attached, then a message must be sent directly to + its destination. + + o Messages without attached files should be routed through the inbound + host of the destination node's subnet as specified by a FidoNet + format nodelist. + + o To prevent overloading of inbound hosts, a system should provide for + host routing to be disabled for a target node, or nodes. + + + F. Network Layer : the Network's View of the System, Routing and Packets + + + 1. Network Layer Data Definition : the Packet Header + + The packet contains messages in packed format to be transferred over + the net during a connection. As this data structure is transferred, + its definition is critical to FidoNet. + + A packet may contain zero or more packed messages. A packet without + messages is often generated as a poll packet. + + Every packet begins with a packet header. The fields of the packet + header are of fixed length. + + + Packet Header + Offset + dec hex + .-----------------------------------------------. + 0 0 | origNode (low order) | origNode (high order) | + +-----------------------+-----------------------+ + 2 2 | destNode (low order) | destNode (high order) | + +-----------------------+-----------------------+ + 4 4 | year (low order) | year (high order) | + +-----------------------+-----------------------+ + 6 6 | month (low order) | month (high order) | + +-----------------------+-----------------------+ + 8 8 | day (low order) | day (high order) | + +-----------------------+-----------------------+ + 10 A | hour (low order) | hour (high order) | + +-----------------------+-----------------------+ + 12 C | minute (low order) | minute (high order) | + +-----------------------+-----------------------+ + 14 E | second (low order) | second (high order) | + +-----------------------+-----------------------+ + 16 10 | baud (low order) | baud (high order) | + +-----------------------+-----------------------+ + 18 12 | 0 | 2 | 0 | 0 | + +-----------------------+-----------------------+ + 20 14 | origNet (low order) | origNet (high order) | + +-----------------------+-----------------------+ + 22 16 | destNet (low order) | destNet (high order) | + +-----------------------+-----------------------+ + 24 18 | prodCode | serialNo | + +-----------------------+-----------------------+ + 26 1A | | + | password (some impls) | + | eight bytes | + | null padded | + | | + +-----------------------+-----------------------+ + 34 22 | origZone (low) (opt) | origZone (high) (opt) | + +-----------------------+-----------------------+ + 36 24 | destZone (low) (opt) | destZone (high) (opt) | + +-----------------------+-----------------------+ + 38 26 | fill | + ~ 20 bytes ~ + | | + +-----------------------+-----------------------+ + 58 3A | zero or more | + ~ packed ~ + | messages | + +-----------------------+-----------------------+ + | 0 | 0 | 0 | 0 | + `-----------------------+-----------------------' + + + Packet = PacketHeader { PakdMessage } 00H 00H + + PacketHeader = origNode (* of packet, not of messages in packet *) + destNode (* of packet, not of messages in packet *) + year (* of packet creation, e.g. 1986 *) + month (* of packet creation, 0-11 for Jan-Dec *) + day (* of packet creation, 1-31 *) + hour (* of packet creation, 0-23 *) + minute (* of packet creation, 0-59 *) + second (* of packet creation, 0-59 *) + baud (* max baud rate of orig and dest, 0=SEA *) + PacketType (* old type-1 packets now obsolete *) + origNet (* of packet, not of messages in packet *) + destNet (* of packet, not of messages in packet *) + prodCode (* 0 for Fido, write to FTSC for others *) + serialNo (* binary serial number (otherwise null)*) + password (* session password (otherwise null) *) + origZone (* zone of pkt sender (otherwise null) *) + destZone (* zone of pkt receiver (otherwise null)*) + fill[20] + + PacketType = 02H 00H (* 01H 00H was used by Fido versions before 10 + which did not support local nets. The packed + message header was also different for those + versions *) + + prodCode = ( 00H (* Fido *) + | ... + | ??H (* Please apply for new codes *) + ) + + + The remainder of the packet consists of packed messages. Each packed + message begins with a message type word 0200H. A pseudo-message + beginning with the word 0000H signifies the end of the packet. + + + 2. Network Layer Data Description : a File with Attributes + + The BATCH protocol uses the MODEM7 filename and TeLink/XMODEM file + transfer protocols to transfer the file with attributes. + + When a file is transferred via FidoNet, an attempt is made to also + pass the operating system's attributes for the file such as length, + modification date, etc. FidoNet does this via a special prefix block + to the XMODEM file transfer using a protocol known as TeLink. As the + TeLink protocol relies on a modification to the XMODEM file transfer + protocol, it is documented at the data link layer level. + + The MODEM7 file name is redundant if there is also a TeLink block, in + which case the name may be taken from either or both. + + FileName as Sent + Offset + dec hex + .-----------------------------------------------. + 0 0 | fileName | + ~ 8 bytes ~ + | left adjusted blank filled | + +-----------------------+-----------------------+ + 8 8 | fileExt | + ~ 3 bytes ~ + | left adjusted blank filled | + `-----------------------------------------------' + + + 3. Network Layer Protocol : BATCH File Finite State Machines + + + BATCH File Sender + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | BS0*| MoreFiles| 1 more files to send | (MODEM7 FName send MS0) | BS1 | + | | | 2 no more files to send | | BS3 | + |-----+----------+-------------------------+-------------------------+-----| + | BS1 | CheckFNm | 1 MODEM7 Filename ok | (TeLink send file XS0) | BS2 | + | | | 2 MODEM7 Filename bad | report name send bad | exit| + |-----+----------+-------------------------+-------------------------+-----| + | BS2 | CheckFile| 1 TeLink send ok | | BS0 | + | | | 2 TeLink send bad | report file send bad | exit| + |-----+----------+-------------------------+-------------------------+-----| + | BS3 | EndSend | 1 rec NAK for next file | send EOT, report send ok| exit| + | | | 2 10 seconds no NAK | send EOT, report no NAK | exit| + `-----+----------+-------------------------+-------------------------+-----' + + When no files remain, the sender responds to the receiver's NAK with an + EOT. The EOT is not ACK/NAKed by the receiver. + + Filenames must be upper case ASCII. The data link layer uses "u" as a + control character. + + + BATCH File Receiver + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | BR0*| RecvName | | (MODEM7 FName recv MR0) | BR1 | + |-----+----------+-------------------------+-------------------------+-----| + | BR1 | CheckFNm | 1 MODEM7 no more files | report files recd ok | exit| + | | | 2 MODEM7 Filename ok | (TeLink recv file XR0) | BR2 | + | | | 2 MODEM7 Filename bad | report name recv bad | exit| + |-----+----------+-------------------------+-------------------------+-----| + | BR2 | CheckFile| 1 TeLink recv ok | | BR0 | + | | | 2 TeLink recv bad | report file recv bad | exit| + `-----+----------+-------------------------+-------------------------+-----' + + + G. Data Link Layer : Error-Free Data Transfer + + 1. Data Link Layer Data Definition : XMODEM/TeLink Blocks + + XMODEM transfers are in blocks of 128 uninterpreted data bytes + preceded by a three byte header and followed by either a one byte + checksum or a two byte crc remainder. XMODEM makes no provision for + data streams which are not an integral number of blocks long. + Therefore, the sender pads streams whose length is not a multiple of + 128 bytes with the end-of-file character (^Z for MS-DOS), and use some + other means to convey the true data length to the receiver (e.g. + TeLink file info block). + + Data blocks contain sequence numbers so the receiver can ensure it has + the correct block. Block numbers are sequential unsigned eight bit + integers beginning with 01H and wrapping to 00H, except that a TeLink + block is given sequence number 00H. + + For files which are attached to the mail packet, not the mail packet + itself, if the sending system is aware of the file attributes as they + are known to the operating system, then the first block of the XMODEM + transfer may be a special TeLink block to transfer that information. + This block differs in that the first byte is a SYN character as + opposed to an SOH, and it is always sent checksum as opposed to CRC. + Should the receiver be unwilling to handle such information, after two + NAKs (or "C"s), the sender skips this special block and goes on to the + data itself. + + + + XMODEM Data Block (CRC mode) + Offset + dec hex + .-----------------------------------------------. + 0 0 | SOH - Start Of Header - 01H | + +-----------------------------------------------+ + 1 1 | BlockNumber | + +-----------------------------------------------+ + 2 2 | BlockComplement | + +-----------------------------------------------+ + 3 3 | 128 bytes of | + ~ uninterpreted ~ + | data | + +-----------------------------------------------+ + 131 83 | CRC high order byte | + +-----------------------------------------------+ + 132 84 | CRC low order byte | + `-----------------------------------------------' + + + + XMODEM Data Block (Checksum mode) + Offset + dec hex + .-----------------------------------------------. + 0 0 | SOH - Start Of Header - 01H | + +-----------------------------------------------+ + 1 1 | BlockNumber | + +-----------------------------------------------+ + 2 2 | BlockComplement | + +-----------------------------------------------+ + 3 3 | 128 bytes of | + ~ uninterpreted ~ + | data | + +-----------------------------------------------+ + 131 83 | Checksum byte | + `-----------------------------------------------' + + + TeLink File Descriptor Block + Offset + dec hex + .-----------------------------------------------. + 0 0 | SYN - File Info Header - 16H | + +-----------------------------------------------+ + 1 1 | 00H | + +-----------------------------------------------+ data offset + 2 2 | FFH | dec hex + +-----------------------------------------------+ + 3 3 | File Length, least significant byte | 0 0 + +-----------------------------------------------+ + 4 4 | File Length, second to least significant byte | 1 1 + +-----------------------------------------------+ + 5 5 | File Length, second to most significant byte | 2 2 + +-----------------------------------------------+ + 6 6 | File Length, most significant byte | 3 3 + +-----------------------------------------------+ + 7 7 | Creation Time of File | 4 4 + | "DOS Format" | + +-----------------------------------------------+ + 9 9 | Creation Date of File | 6 6 + | "DOS Format" | + +-----------------------------------------------+ + 11 B | File Name | 8 8 + ~ 16 chars ~ + | left justified blank filled | + +-----------------------------------------------+ + 27 1B | 00H | 24 18 + +-----------------------------------------------+ + 28 1C | Sending Program Name | 25 19 + ~ 16 chars ~ + | left justified Null filled | + +-----------------------------------------------+ + 44 2C | 01H (for CRC) or 00H | 41 29 + +-----------------------------------------------+ + 45 2D | fill | 42 2A + ~ 86 bytes ~ + | all zero | + +-----------------------------------------------+ + 132 84 | Checksum byte | + `-----------------------------------------------' + + + + XMODEMData = XMODEMBlock (* block of data with header and + trailer *) + | TeLinkBlock (* TeLink File Descriptor Block *) + | ACK (* acknowledge data received ok *) + | NAK (* negative ACK & poll 1st block *) + | EOT (* end of xfer, after last block *) + | "C" (* 43H *) + + XMODEMBlock = SOH (* Start of Header, XMODEM Block *) + blockNumber[1] (* sequence, i'=mod( i+1, 256 ) *) + blockCompl[1] (* one's compl of BlockNumber *) + data[128] (* uninterpreted user data block *) + (CRC | Checksum) (* error detect/correction code *) + + TeLinkBlock = SYN (* File Info Header *) + 00H (* block no, must be first block *) + FFH (* one's complement of block no *) + fileLength[4] (* length of data in bytes *) + CreationTime[2] (* time file last modified or zero *) + CreationDate[2] (* date file last modified or zero *) + fileName(16) (* name of file, not vol or dir *) + 00H (* header version number *) + sendingProg(16) (* name of program on send side *) + crcMode[1] (* 01H for CRC 00H for Checksum *) + fill[87] (* zeroed *) + Checksum (* error detect/correction code *) + + ACK = 06H (* acknowledge data received ok *) + NAK = 15H (* negative ACK & poll 1st block *) + SOH = 01H (* start of header, begins block *) + SYN = 16H (* start of TeLink file info blk *) + EOT = 04H (* end of xfer, after last block *) + + CRC = crc[2] (* CCITT Cyclic Redundancy Check *) + + Checksum = checksum[1] (* low 8 bits of sum of data bytes + using unsigned 8 bit arithmetic *) + + CreationDate = year[.7] (* 7 bits, years since 1980, 0-127 *) + month[.4] (* 4 bits, month of year, 1-12 *) + day[.5] (* 5 bits, day of month, 1-31 *) + + CreationTime = hour[.5] (* 5 bits, hour of day, 0-23 *) + minute[.6] (* 6 bits, minute of hour, 0-60 *) + biSeconds[.2] (* 6 bits, seconds/2, 0-29 *) + + + Note that the crcMode is always set to 01H in current implementations + as all TeLink/XMODEM implementations use the CRC method. Therefore, + it is always set to 01H by the sender, and is ignored by the receiver. + + + 2. Data Link Layer Protocol : XMODEM/TeLink Finite State Machines + + The protocol is receiver driven, the receiver polling the sender for + each block. If the receiver polls for the first block using a "C" + (43H) as the poll character, it would prefer to have the CRC-CCITT + polynomial remainder error detection code at the end of each block as + opposed to a one byte unsigned checksum. The sender will respond to + the "C" poll iff it can comply. If the sender chooses checksum as + opposed to CRC, it waits for the receiver to poll with NAK (15H). + Should the checksum method be preferable to the receiver, it polls + with NAK rather than "C". + + The sender returns an EOT instead of a data block when no data remain. + + Neither the sender nor the receiver should send the block or ACK/NAK + response while there is data being received. They should wait for the + line to settle, and possibly time out. + + It is suggested that one's input buffer be cleared immediately after + sending block or ACK/NAK response, before waiting for the response from + the other end. This clears any line garbage which occurred during + transmit. + + + XMODEM/TeLink Sender + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | XS0 | WaitTeLnk| 1 over 40-60 seconds | report sender timeout | exit| + | | | 2 over 2 tries | note TeLink block failed| XS1 | + | | | 3 NAK or "C" received | send TeLink, incr tries | XS0 | + | | | 4 ACK received | TeLink ok, set crc/cksm | XS2 | + |-----+----------+-------------------------+-------------------------+-----| + | XS1 | WaitStart| 1 over 40-60 seconds | report sender timeout | exit| + | | | 2 over 20 tries | report send failed | exit| + | | | 3 NAK received | set checksum mode | XS2 | + | | | 4 "C" recd, I can crc | set crc mode | XS2 | + | | | 5 "C" recd, I can't crc | | XS1 | + |-----+----------+-------------------------+-------------------------+-----| + | XS2 | SendBlock| 1 more data available | send next data block | XS3 | + | | | | as checksum or crc | | + | | | 2 last block has gone | send EOT | XS4 | + |-----+----------+-------------------------+-------------------------+-----| + | XS3 | WaitACK | 1 10 retries or 1 minute| report send failed | exit| + | | | 2 ACK received | | XS2 | + | | | 3 NAK (or C if 1st blk) | resend last block | XS3 | + |-----+----------+-------------------------+-------------------------+-----| + | XS4 | WaitEnd | 1 10 retries or 1 minute| report send failed | exit| + | | | 2 ACK received | report send successful | exit| + | | | 3 NAK received | resend EOT | XS4 | + `-----+----------+-------------------------+-------------------------+-----' + + + XMODEM/TeLink Receiver + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | XR0 | RecStart | 1 prefer crc mode | Send "C" | XR1 | + | | | 2 want checksum mode | send NAK | XR1 | + |-----+----------+-------------------------+-------------------------+-----| + | XR1 | WaitFirst| 1 10 retries or 1 minute| report receive failure | exit| + | | | 2 > 3 retries or 30 secs| set want checksum mode | XR0 | + | | | 3 EOT received | delay < sec, purge input| exit| + | | | | send ACK, report no file| | + | | | 4 TeLink block recd | send ACK, set crc/cksm | XR2 | + | | | 5 data block recd | send ACK, set crc/cksm | XR2 | + | | | 6 bad block or 2-10 secs| incr retry count | XR0 | + |-----+----------+-------------------------+-------------------------+-----| + | XR2 | WaitBlock| 1 10 retries or 1 minute| report receive failure | exit| + | | | 2 EOT received | send ACK, report recd ok| exit| + | | | | send ACK, report recd ok| | + | | | 3 data block received | send ACK | XR2 | + | | | 4 bad block or 2-10 secs| send NAK, incr retry cnt| XR2 | + `-----+----------+-------------------------+-------------------------+-----' + + + A number of checks should be made to ensure a valid data block has been + received. + + o The physical layer should have encountered no errors, e.g. parity, + framing, etc. + + o The length of the block should not be less than expected. + + o If the blocks sequence number does not match the complement, then + respond with a NAK and attempt to read the block again. + + o If the block's sequence number is one previous (remember wrap around) + to that of the expected block, respond with an ACK and read again. + + o If the sequence number fits neither of the above criteria, and is yet + not the expected sequence number, abort the receive. + + o The checksum or CRC should be correct. + + + + 3. Data Link Layer Protocol : MODEM7 Filename Finite State Machines + + + MODEM7 Filename Sender + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | MS0 | WaitNak | 1 20 retries or 1 minute| filename send failed | exit| + | | | 2 NAK received | send ACK & 1st ch of fn | MS1 | + | | (note 1) | 3 C received | return fn skipped | exit| + |-----+----------+-------------------------+-------------------------+-----| + | MS1 | WaitChAck| 1 ACK rcd, fname done | send SUB = 1AH | MS2 | + | | | 2 ACK rcd, fname ~done | send next ch of fname | MS1 | + | | | 3 other char or 1 sec | send "u", incr retry cnt| MS0 | + |-----+----------+-------------------------+-------------------------+-----| + | MS2 | WaitCksm | 1 cksum recd and ok | send ACK, report fn ok | exit| + | | | 2 cksum recd but bad | send "u", incr retry cnt| MS0 | + | | | 3 no cksum in 1 sec | send "u", incr retry cnt| MS0 | + `-----+----------+-------------------------+-------------------------+-----' + + + MODEM7 Filename Receiver + + .-----+----------+-------------------------+-------------------------+-----. + |State| State | Predicate(s) | Action(s) | Next| + | # | Name | | | St | + |-----+----------+-------------------------+-------------------------+-----| + | MR0 | SendNak | 1 20 tries or 1 minute | report filename failure | exit| + | | | 2 | send NAK, incr try cnt | MR1 | + |-----+----------+-------------------------+-------------------------+-----| + | MR1 | WaitAck | 1 rcd ACK | | MR2 | + | | | 2 rcd EOT | report no files remain | exit| + | | | 3 5 secs & no ACK/EOT | | MR0 | + |-----+----------+-------------------------+-------------------------+-----| + | MR2 | WaitChar | 1 recd EOT (can happen?)| report no files remain | exit| + | | | 2 recd SUB | send checksum byte | MR3 | + | | | 3 recd "u" | | MR0 | + | | | 4 recd char of name | send ACK | MR2 | + | | | 5 no char in 1 second | | MR0 | + |-----+----------+-------------------------+-------------------------+-----| + | MR3 | WaitOkCk | 1 recd ACK within 1 sec | report recd filename ok | exit| + | | | 2 recd "u" or other char| | MR0 | + `-----+----------+-------------------------+-------------------------+-----' + + SUB is the ASCII character ^Z or 1AH. The checksum is the unsigned low + order eight bits of the sum of the characters in the transferred filename + including the SUB. + + Although one second timeouts are used successfully by Fido and SEAdog, + some fear that this is too small a timeout for some satellite and packet + network links. + + Note 1 - MS0.3 is a common addition to accommodate a common noncompliance. + Support of MS0.3 is optional for a compliant mailer. This hack + also requires modification of a number of state tables, see + FSC-0011. + + + H. Physical Layer : the Actual Connection of Two FidoNet Systems + + Will one of the more hardware-oriented comm types give me some idea of + what's needed here? Can we leave it open enough to allow implementation + over a non-dial net? Thanks. + + + I. Revisions since FTS-0001 + + 89 Oct 25 (rev 13) + o packet header: optional serialNo, password, and orig/dest zone + o stored message to/from zone/point info added as option per + Fido-12 and Dutchie + o XR1 and XR2 changes per FSC-0011 + o reference to FSC-0011 for the MODEM7-avoidance hack, MS0.3 + o dropped enumeration of product codes + o S4 modification from FSC-0011 + o Nodelist and EID reference appropriate documents + o various cosmetics + 90 July 1-5 (rev 14) + o spelling errors caught by Ray Gardner + o references to the now dead IFNA elided + o offset at end of Packed Message was 10 as opposed to 20 bytes + o Packed Message and Packet Header corrections by Roland Gautschi + o Offsets in TeLink header caught by Rick Moore + 90 August 30 (rev 15) + o corrected offsets in packet header + 95 September 30 (rev 16) + o TOPT corrected + o contact info changed + + + J. Acknowledgements + + Ben Baker, Thom Henderson, Tom Jennings, Ken Kaplan, and Gee Wong + suggested, informed, reviewed, and encouraged. Tom and Thom gave me + all the basics, and even allowed me to look at actual code. Bob Hartman + was foolish enough to implement the specification, and was generous + with useful feedback. Ray Gardner caught my spelling errors , + and Roland Gautschi and Rick Moore found offset and length errors. + + My employer, Pacific Systems Group was kind enough to donate my time to + research and to write this document. + + Fido and FidoNet are registered trademarks of Tom Jennings. + + SEAdog is a trademark of System Enhancement Associates. + + + K. Bibliography + + Documentation for the protocols and data formats are scattered. Some + are unattributed, some even untitled. + + Anonymous, changes to MODEM to implement CRC option XMDM-CRC.TXT + + Baker, Ken and Moore, Rick, Nodelist Definition, currently FTS-0005 + + Christensen, Ward, "MODEM Protocol Overview" of 1 January 82 XMODEM.TXT + + Hartman, Bob, "Some thoughts that I had on FSC001", FSC-0011 + + Henderson, Thom, "SEAdog Electronic Mail System Version 3" of April 86 + + International Standards Organization, "Data Processing - Open Systems + Interconnection - Basic Reference Model" ISO/DIS 7498 April 82 + + Jennings, Tom, "FidoNet Electronic Mail Protocol" 8 February 85 + FIDOMAIL.DOC + + Jennings, Tom, "Fido's Internal Structures" of 13 September 85 + STRUCT.TXT aka STRUCT.APX + + Jennings, Tom, "Extending XMODEM/MODEM File Transfer Protocol to support + DOS" 20 September 83 FILEXFER.DOC + + Jordan, Larry, "XMODEM File Transfer Protocol" XMDM-LJ.TXT + + Rudin, H and West, C, "Protocol Specification, Testing, and + Verification, III" Proceedings of the IFIP WG 6.1 Third International + Workshop on Protocol Specification, Testing, and Verification, + Rueschlikon Switzerland 31 May - 2 June 1983. + + Tanenbaum, Andrew, "Computer Networks" Prentice Hall 1981 + + Messages generated by Fido 11w, SEAdog 3.8, and QMail 1.01 diff --git a/SOURCE/UNUSED/GREP.COM b/SOURCE/UNUSED/GREP.COM new file mode 100644 index 0000000..2cc1258 Binary files /dev/null and b/SOURCE/UNUSED/GREP.COM differ diff --git a/SOURCE/UNUSED/INSTALL.EXE b/SOURCE/UNUSED/INSTALL.EXE new file mode 100644 index 0000000..751ee31 Binary files /dev/null and b/SOURCE/UNUSED/INSTALL.EXE differ diff --git a/SOURCE/UNUSED/INSTALL.PAS b/SOURCE/UNUSED/INSTALL.PAS new file mode 100644 index 0000000..18ace3d --- /dev/null +++ b/SOURCE/UNUSED/INSTALL.PAS @@ -0,0 +1,201 @@ +{$M $4000,0,0 } { 16K stack, no heap } +PROGRAM RGINSTAL; + +USES + Crt, + Dos; + +{$I records.pas} + +CONST + DYNY: BOOLEAN = FALSE; + +VAR + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + F: FILE; + S: STRING; + +function bslash(b: boolean; s: STRING): 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(Fn: STRING): Boolean; +VAR + DirInfo: SearchRec; +BEGIN + Fn := BSlash(FALSE,FN); + IF (Length(Fn) = 2) AND (Fn[2] = ':') THEN + ExistDir := TRUE + ELSE + BEGIN + findfirst(Fn,AnyFile,DirInfo); + ExistDir := (DOSError = 0) AND (DirInfo.Attr AND $10 = $10); + END; +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 + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: STRING): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +PROCEDURE UnArc(FileName,Path: STRING); +BEGIN + SwapVectors; + Exec('PKUNZIP.EXE','-EN '+FileName+' '+Path); + SwapVectors; +END; + +procedure Kill(const fn: STRING); +var + f:file; +begin + assign(f,fn); + erase(f); +end; + +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; + +BEGIN + ClrScr; + WriteLn('Renegade Version 1.10 Install Utility'); + WriteLn; + WriteLn('This utility will install Renegade BBS Version 1.10.'); + WriteLn('Please make sure that PKUNZIP.EXE and this file are located'); + WriteLn('in the same directory as the archive RGV110.ZIP.'); + Writeln; + WriteLn('You will only be asked to enter the main path for the BBS'); + WriteLn('directory.'); + WriteLn; + IF PYNQ('Install Renegade BBS Version 1.10? ') THEN + BEGIN + Writeln; + WriteLn('Please enter main path for the bbs (Example: C:\RG'); + Write(': '); + ReadLn(S); + IF (S <> '') THEN + BEGIN + S := AllCaps(S); + IF (S[Length(S)] = '\') THEN + Dec(S[0]); + IF (S <> '') AND (NOT ExistDir(S)) THEN + MkDir(S); + IF (Exist(S+'\RENEGADE.DAT')) THEN + BEGIN + WriteLn; + Writeln(^G^G^G'Renegade is already installed in directory "'+S+'"'); + Exit; + END + ELSE + BEGIN + UnArc('RGV10.ZIP',S); + MkDir(S+'\ARCS'); + MkDir(S+'\DATA'); + MKDir(S+'\LOGS'); + MkDir(S+'\MISC'); + MkDir(S+'\MSGS'); + MkDir(S+'\NETFOSS'); + MkDir(S+'\PROTOCOL'); + UNArc(S+'\BBS.RGD',S); + UnArc(S+'\DATA.RGD',S+'\DATA'); + UnArc(S+'\MISC.RGD',S+'\MISC'); + UnArc(S+'\MSGS.RGD',S+'\MSGS'); + UnArc(S+'\NETFOSS.RGD',S+'\NETFOSS'); + UnArc(S+'\PROT.RGD',S+'\PROTOCOL'); + Kill(S+'\BBS.RGD'); + Kill(S+'\DATA.RGD'); + Kill(S+'\MISC.RGD'); + Kill(S+'\MSGS.RGD'); + Kill(S+'\NETFOSS.RGD'); + Kill(S+'\PROT.RGD'); + Assign(GeneralFile,S+'\RENEGADE.DAT'); + Reset(GeneralFile); + Seek(GeneralFile,0); + Read(GeneralFile,General); + WITH General Do + BEGIN + General.Version := '1.10'; (* <-- Update this with version *) + DataPath := S+'\DATA\'; + MiscPath := S+'\MISC\'; + MsgPath := S+'\MSGS\'; + LogsPath := S+'\LOGS\'; + TempPath := S+'\TEMP\'; + ProtPath := S+'\PROTOCOL\'; + ArcsPath := S+'\ARCS\'; + FileAttachPath := S+'\TEMP\'; + MultPath := S+'\DATA\'; + NodePath := S+'\NODELIST\'; + NetMailPath := S+'\NETMAIL\'; + DefEchoPath := S+'\ECHOMAIL\'; + END; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(GeneralFile); + END; + Writeln; + WriteLn(^G^G^G'Installation complete!'); + END; + END; +END. diff --git a/SOURCE/UNUSED/IS286.PAS b/SOURCE/UNUSED/IS286.PAS new file mode 100644 index 0000000..3281bc1 --- /dev/null +++ b/SOURCE/UNUSED/IS286.PAS @@ -0,0 +1,33 @@ +unit is286; + +{$G-} + +interface + +implementation + +function a286or_better:boolean; assembler; +asm + pushf + pop bx + and bx,0fffh + push bx + popf + pushf + pop bx + and bx,0f000h + cmp bx,0f000h + mov ax,0 + jz @@1 + mov ax,1 + @@1: +end; + +begin + if not a286or_better then begin + writeln; + writeln('Renegade requires an 80286 or better processor.'); + halt; + end; +end. +{$G+} diff --git a/SOURCE/UNUSED/LEE.EXE b/SOURCE/UNUSED/LEE.EXE new file mode 100644 index 0000000..0542eca Binary files /dev/null and b/SOURCE/UNUSED/LEE.EXE differ diff --git a/SOURCE/UNUSED/LEE.PAS b/SOURCE/UNUSED/LEE.PAS new file mode 100644 index 0000000..483962e --- /dev/null +++ b/SOURCE/UNUSED/LEE.PAS @@ -0,0 +1,17 @@ +Var + Name: String[35]; + name1: string[35]; + Current: Integer; + Done: Boolean; +BEGIN + Name := '12345678901234567890123456789012345'; + Name1 := Copy('123456789012345678901234567890123456',1,35); + IF (Name < Name) THEN + Current := 1 + ELSE IF (Name > Name1) THEN + Current := 2 + ELSE + Done := TRUE; + IF (Done) THEN + Writeln('Matches!'); +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/LEE.TXT b/SOURCE/UNUSED/LEE.TXT new file mode 100644 index 0000000..0c0d7ff --- /dev/null +++ b/SOURCE/UNUSED/LEE.TXT @@ -0,0 +1,35 @@ +As I work my thru the editors, something stood out that could reduce the +overall size of the code and memory requirements. The InputWN1 +Procedure was utilized in every editor just as you see it below and +utilized four lines of code: + +NL; +Print('New description: '); +MPL(SizeOf(Name) - 1)); +InputWN1(Name,(SizeOf(Name) - 1),Changed); + +The above procedure has made modified to require only one line of code +to do the same job. I added the NL as %LF to the Print Procedure. I +then added an extra var to the InputWN1 to pass the Print procedure text +into the InputWN1 Procedure. I also added the MPL internal to the +InputWN1 Procedure (See Below). + +InputWN1('%LFNew description: ',Name,(SizeOf(Name) - 1),Changed); + + +The InputWNWC required 3 lines of code every time it was called (MPL +isn't used for color input prompts). + +NL; +Print('New description: '); +InputWNWC(Name,(SizeOf(Name) - 1),Changed); + +The above procedure has made modified to require only one line of code +to do the same job. I added the NL as %LF to the Print Procedure. I +then added an extra var to the InputWNWC to pass the Print procedure text +into the InputWNWC Procedure (See below). + +InputWNWC('%LFNew description: ',Name,(SizeOf(Name) - 1),Changed); + +I modified all numeric input routines in accordance with the above in +a previous release of Renegade. diff --git a/SOURCE/UNUSED/LGNQUOTE.DAT b/SOURCE/UNUSED/LGNQUOTE.DAT new file mode 100644 index 0000000..49358cf --- /dev/null +++ b/SOURCE/UNUSED/LGNQUOTE.DAT @@ -0,0 +1,5 @@ +7It takes a big man to cry, but it takes a bigger man tolaugh at that man.8If you ever fall off the Sears Tower, just go real limp,:because maybe you'll look like a dummy and people will try'to catch you, because, hey, free dummy. +:: %4 - Dropfile path (DOOR.SYS is dropped) +:: %5 - Username +:: +:: +:: Note: For %5 to be the username, dropfile path for node must not +:: be "", which is what Renegade tries to default to at this time. +:: This is not hard to fix. Also, username is passed just as Renegade +:: stores it, in all uppercase. This means %5 is likely NOT the full +:: username. 4DOS allows you to get the whole thing as %5&, those +:: without 4DOS will have to find other batch tricks. + diff --git a/SOURCE/UNUSED/LOGON.TPU b/SOURCE/UNUSED/LOGON.TPU new file mode 100644 index 0000000..b6ed9f6 Binary files /dev/null and b/SOURCE/UNUSED/LOGON.TPU differ diff --git a/SOURCE/UNUSED/MAIL0.TPU b/SOURCE/UNUSED/MAIL0.TPU new file mode 100644 index 0000000..ccf804d Binary files /dev/null and b/SOURCE/UNUSED/MAIL0.TPU differ diff --git a/SOURCE/UNUSED/MAIL1.LEE b/SOURCE/UNUSED/MAIL1.LEE new file mode 100644 index 0000000..dfa317e --- /dev/null +++ b/SOURCE/UNUSED/MAIL1.LEE @@ -0,0 +1,2345 @@ +{$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): Boolean; +PROCEDURE InputLine(VAR S: Astr); +PROCEDURE Anonymous(Offline: Boolean; VAR MHeader: MHeaderRec); + +IMPLEMENTATION + +USES + Crt, + File8, + File0, + Mail0, + TimeFunc; + +CONST + TopScreen = 3; {first screen line for Text entry} + ScrollSize = 5; {number OF lines to scroll by} + LineMaxLen = 78; + +VAR + InportFile: Text; + InportFileOpen: Boolean; + ScreenLines: Integer; + Escp: Boolean; + +PROCEDURE Anonymous(Offline: Boolean; VAR MHeader: MHeaderRec); +VAR + An: Anontyp; + HeaderL: Astr; + UName: 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); + 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; + +FUNCTION Inputmessage(Pub, + IsReply: Boolean; + CONST MsgTitle: Str40; + VAR MHeader: MHeaderRec; + CONST ReadInMsg: Astr): Boolean; +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, + UserName: Str36; + + MaxLines, + LastQuoteLine, + MaxQuoteLines, + CurrentLine, + TopLine, + CCol: Integer; + + DisableMCI, + CantAbort, + Insert_Mode, + SaveMsg: Boolean; + + 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 DoLines; + BEGIN + IF (OkANSI OR OkAvatar) THEN + Print('^4旼컴:컴컴:컴컴:컴컴:컴컴:컴컴:컴컴:컴컴쩡컴�:컴컴:컴컴:컴컴:컴컴:컴컴:컴컴:컴커^1') + ELSE + Print('[---:----:----:----:----:----:----:----|----:----:----:----:----:----:----:---]'); + 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,LineMaxLen)); + 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 := 79; (* Should this be 78 *) + 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) < LineMaxLen) 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,LineMaxLen); + {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])) >= LineMaxLen) 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,LineMaxLen); + 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 FS_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 >= LineMaxLen)) OR (CCol > LineMaxLen) THEN + BEGIN + IF (CCol <= LineMaxLen) 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,LineMaxLen)); + 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,LineMaxLen)+' '); + 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_Insert_Line; + {open a blank line, update display} + BEGIN + Insert_Line(''); + IF ((CurrentLine - TopLine) > (ScreenLines - 2)) THEN + Scroll_Screen(ScrollSize) + ELSE + Refresh_Screen; + 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,LineMaxLen); + 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..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 : FS_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 + CLS; + (* + 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; + Cmd, + Drive: Char; + HelpCounter: Byte; + LineNum1, + LineNum2: Integer; + ShowCont, + ExitMsg, + SaveLine, + AbortMsg: Boolean; + + PROCEDURE AddressMessage(CantAbort2: Boolean); + VAR + User: UserRecordType; + TempMsgTo: Str36; + TempMsgSubj: Str40; + UNum: Integer; + BEGIN + { Print(FString.default + ^M^J); } + lRGLngStr(34,FALSE); + IF (Pub) AND (NOT (MAInternet IN MemMsgArea.MAFlags)) THEN + BEGIN + Prt('To: '); + IF (MsgTo <> '') THEN + InputDefault(TempMsgTo,MsgTo,36,[NoLineFeed,CapWords],FALSE) + ELSE + BEGIN + MPL(36); + InputMain(TempMsgTo,36,[NoLineFeed,CapWords]); + END; + MsgTo := TempMsgTo; + UserColor(6); + FOR UNum := 1 TO LennMCI(MsgTo) DO + BackSpace; + UNum := StrToInt(MsgTo); + IF (UNum >= 1) AND (UNum <= (MaxUsers - 1)) AND NOT (NetMail IN MHeader.Status) THEN + BEGIN + LoadURec(User,UNum); + MsgTo := Caps(User.Name); + MHeader.MTO.UserNum := UNum; + MHeader.MTO.Real := User.RealName; + IF (Pub) AND (MARealName IN MemMsgArea.MAFlags) THEN + MsgTo := Caps(User.RealName) + ELSE + MsgTo := Caps(User.Name); + END; + IF (SQOutSp(MsgTo) = '') THEN + MsgTo := 'All'; + IF (MsgTo <> '') THEN + BEGIN + Prompt(MsgTo); + UserColor(1); + NL; + END; + NL; + END + ELSE IF (NOT (MAInternet IN MemMsgArea.MAFlags)) THEN + BEGIN + Print(PadLeftStr('^4To: ^6'+Caps(MsgTo),40)); + NL; + END; + IF (MHeader.FileAttached = 0) AND (NOT CantAbort2) THEN + BEGIN + Prt('Subject: '); + IF (MsgSubj <> '') THEN + InputDefault(TempMsgSubj,MsgSubj,40,[NoLineFeed],FALSE) + ELSE + BEGIN + MPL(40); + InputMain(TempMsgSubj,40,[NoLineFeed]); + NL; + END; + IF (TempMsgSubj <> '') THEN + BEGIN + UserColor(1); + NL; + MsgSubj := TempMsgSubj; + END + ELSE + BEGIN + IF (MsgSubj <> '') THEN + Print('^6'+MsgSubj+'^1') + ELSE + Exit; + END; + END + ELSE + MsgSubj := MHeader.Subject; + END; + + PROCEDURE FileAttach; + VAR + FName: Str40; + DOk, + KAbort, + AddBatch: Boolean; + TookTime: LongInt; + BEGIN + IF PYNQ('Attach a file to this message? ',0,FALSE) THEN + BEGIN + NL; + Prt('File name: '); + MPL(40); + Input(FName,40); + NL; + IF (NOT CoSysOp) OR (NOT IsUL(FName)) THEN + FName := General.FileAttachPath+StripName(FName); + IF (NOT Exist(FName)) AND (NOT InCom) AND (NOT Exist(FName)) AND (FName <> '') THEN + Print('^7That file does not exist!^1') + ELSE + BEGIN + IF Exist(FName) AND (NOT CoSysOp) THEN + Print('^7You cannot use that file name!^1') + ELSE + BEGIN + IF NOT Exist(FName) AND (InCom) THEN + BEGIN + Receive(FName,TempDir+'\UP',FALSE,DOk,KAbort,AddBatch,TookTime); + MHeader.FileAttached := 1; + END + ELSE IF Exist(FName) THEN + BEGIN + DOk := TRUE; + MHeader.FileAttached := 2; + END; + IF (DOk) THEN + BEGIN + MsgSubj := FName; + 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; + 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; + TookTime: LongInt; + BEGIN + IF PYNQ('Import a file to this message? ',0,FALSE) THEN + BEGIN + NL; + TempStr1 := ''; + IF (CoSysOp) THEN + BEGIN + Prt('Enter file to import [Enter=Upload]: '); + MPL(40); + InputL(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,TookTime); + TempStr1 := TempDir+'UP\'+TempStr1; + END; + IF ((TempStr1 <> '') AND (NOT HangUp)) THEN + BEGIN + Assign(InportFile,TempStr1); + Reset(InportFile); + IF (IOResult = 0) THEN + InportFileOpen := TRUE; + END; + END; + UserColor(1); + END; + + BEGIN + FillChar(LinePtr^,(MaxLines * 121),0); + Abort := FALSE; + Next := FALSE; + AbortMsg := FALSE; + SaveMsg1 := FALSE; + DisableMCI1 := FALSE; + TotalLines := 1; + LastLineStr := ''; + + IF (DiskKBFree(General.MsgPath) < General.MinSpaceForPost) THEN + BEGIN + NL; + Print('Not enough disk space to save a message.'); + Drive := Chr(ExtractDriveNumber(General.MsgPath) + 64); + IF (Drive = '@') THEN + SysOpLog('^8--->^3 Message save failure: Drive full.') + ELSE + SysOpLog('^8--->^3 Message save failure: '+Drive+' Drive full.'); + MsgSubj := ''; + END + 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 + AddressMessage(CantAbort1); + END; + + IF (MsgSubj = '') THEN + IF (NOT CantAbort1) THEN + BEGIN + SaveMsg1 := FALSE; + Exit; + END; + + IF (FSEditor IN ThisUser.SFlags) THEN + BEGIN + REPEAT + FS_Editor; + REPEAT + 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'); + Cmd := #0; + END + ELSE IF PYNQ('Abort message? ',0,FALSE) THEN + BEGIN + AbortMsg := TRUE; + SaveMsg1 := FALSE; + NL; + Print('Aborted!'); + END; + + 'C' : BEGIN + IF PYNQ('Are you sure? ',0,FALSE) THEN + FOR LineNum1 := 1 TO (TotalLines - 1) DO + LinePtr^[LineNum1][0] := #0; + END; + + 'F' : IF (NOT AACS(General.FileAttachACS)) THEN + BEGIN + Print('^7You do not have access to this command!^1'); + Cmd := #0; + END + ELSE + FileAttach; + + 'M' : IF (NOT AACS(MemMsgArea.MCIACS)) THEN + BEGIN + Print('^7You do not have access to this command!^1'); + Cmd := #0; + END + ELSE + DisableMCI1 := PYNQ('Disable MCI Codes for this message ['+SQOutSp(ShowYesNo(DisableMCI1))+']? ',0,FALSE); + + 'Q' : BEGIN + InvisEdit := TRUE; + DoQuote(FALSE); + InvisEdit := FALSE; + END; + + (* + 'S' : BEGIN + WHILE (((TotalLines - 1) >= 1) AND ((LinePtr^[TotalLines - 1] = '') OR + (LinePtr^[TotalLines - 1] = ^J))) DO + Dec(TotalLines); + IF ((TotalLines - 1) = 1) THEN + BEGIN + LineNum2 := 0; + FOR LineNum1 := 1 TO Length(LinePtr^[1]) DO + IF (LinePtr^[1][LineNum1] <> ' ') THEN + Inc(LineNum2); + IF (LineNum2 = 0) THEN + Dec(TotalLines); + 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; + *) + + 'A','S': IF (CantAbort1) AND ((TotalLines = 0) OR (Cmd = 'A')) THEN + BEGIN + Cmd := #0; + Print('You cannot abort this message.'); + END + ELSE IF (Cmd = 'A') THEN + BEGIN + IF (NOT PYNQ('Are you sure? ',0,FALSE)) THEN + Cmd := #0 + ELSE + BEGIN + SaveMsg1 := FALSE; + AbortMsg := TRUE; + NL; + Print('Aborted!'); + Exit; + END; + END + ELSE IF (Cmd = 'A') THEN + Cmd := #0; + + 'T' : AddressMessage(CantAbort1); + + 'U' : UploadFile; + + '?' : BEGIN + Print('^1(^3^1)Continue message'); + LCmds(16,3,'Abort message','Clear message'); + LCmds(16,3,'File attach','MCI Codes Yes/No'); + LCmds(16,3,'Quote message','Save message'); + LCmds(16,3,'Title change','Upload message'); + END; + + END; + + UNTIL (Pos(Cmd,^M'ACFMQSTU') > 0) OR (HangUp); + + UNTIL (HangUp) OR (Pos(Cmd,'AS') > 0); + + Inc(TotalLines); + + IF (TotalLines > 1) AND (NOT HangUp) THEN + SaveMsg := TRUE + + END + ELSE + BEGIN + + PrintMsgTitle; + + TotalLines := 0; + + HelpCounter := 1; + + REPEAT + + SaveLine := TRUE; + + ExitMsg := TRUE; + + InputLine(LineStr); + + 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 UpCase(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 = 0) THEN + Print('^7Nothing to clear!^1') + ELSE IF PYNQ('Clear message? ',0,FALSE) THEN + BEGIN + IF (TotalLines = MaxLines) THEN + ExitMsg := TRUE; + FOR LineNum1 := 1 TO TotalLines DO + LinePtr^[LineNum1][0] := #0; + TotalLines := 0; + Escp := FALSE; + ShowCont := FALSE; + NL; + Print('^0Message cleared ... Start over ...^1'); + NL; + END; + 'D' : IF (TotalLines = 0) THEN + Print('^7No lines to delete!^1') + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('Delete which line',LineNum1,1,TotalLines); + IF (LineNum1 >= 1) AND (LineNum1 <= TotalLines) 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 = 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 + FileAttach; + '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,1,TotalLines); + IF (LineNum1 >= 1) AND (LineNum1 <= TotalLines) THEN + BEGIN + NL; + Print('^3Line '+IntToStr(LineNum1)+':'); + UserColor(1); + InputLine(TempStr1); + 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; + NL; + InputIntegerWOC('Staring line number',LineNum1,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,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,LineMaxLen); + 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,LineMaxLen); + 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); + IF ((TotalLines - 1) = 1) THEN + BEGIN + LineNum2 := 0; + FOR LineNum1 := 1 TO Length(LinePtr^[1]) DO + IF (LinePtr^[1][LineNum1] <> ' ') THEN + Inc(LineNum2); + IF (LineNum2 = 0) THEN + Dec(TotalLines); + 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('^7Message subject can not be changed!^1') + ELSE + AddressMessage(CantAbort1); + 'U' : IF ((TotalLines - 1) >= MaxLines) THEN + Print('^7You have reached the maximum line limit!^1') + ELSE + UploadFile; + 'Z' : IF ((TotalLines - 1) < 1) THEN + Print('^7No lines to replace!') + ELSE + BEGIN + LineNum1 := -1; + InputIntegerWOC('Line number to replace',LineNum1,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); + 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; + 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,FALSE); + + 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 := '... '+TagLine; + 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 := Decode(';h빑l�?�k圻f',183) + General.Version; + Inc(MHeader.TextSize,(Length(LineStr) + 1)); + BlockWrite(MsgTxtF,LineStr,(Length(LineStr) + 1)); + + LineStr := ' * Origin: '; + IF (MemMsgArea.Origin <> '') THEN + LineStr := LineStr + MemMsgArea.Origin + ELSE + LineStr := LineStr + General.Origin; + + IF (MemMsgArea.AKA > 19) THEN + MemMsgArea.AKA := 0; + + 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 > 500) THEN + MaxLines := 500; + 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 (Copy(MsgSubj,1,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; + +PROCEDURE InputLine(VAR S: Astr); +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) = LineMaxLen) 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; + +END. diff --git a/SOURCE/UNUSED/MAIL1.TPU b/SOURCE/UNUSED/MAIL1.TPU new file mode 100644 index 0000000..695c967 Binary files /dev/null and b/SOURCE/UNUSED/MAIL1.TPU differ diff --git a/SOURCE/UNUSED/MAIL2.TPU b/SOURCE/UNUSED/MAIL2.TPU new file mode 100644 index 0000000..4c43392 Binary files /dev/null and b/SOURCE/UNUSED/MAIL2.TPU differ diff --git a/SOURCE/UNUSED/MAIL3.TPU b/SOURCE/UNUSED/MAIL3.TPU new file mode 100644 index 0000000..d913fdd Binary files /dev/null and b/SOURCE/UNUSED/MAIL3.TPU differ diff --git a/SOURCE/UNUSED/MAIL4.TPU b/SOURCE/UNUSED/MAIL4.TPU new file mode 100644 index 0000000..d71f6a0 Binary files /dev/null and b/SOURCE/UNUSED/MAIL4.TPU differ diff --git a/SOURCE/UNUSED/MAIL5.PAS b/SOURCE/UNUSED/MAIL5.PAS new file mode 100644 index 0000000..de6017f --- /dev/null +++ b/SOURCE/UNUSED/MAIL5.PAS @@ -0,0 +1,1160 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Mail5; + +INTERFACE + +USES + Common; + +PROCEDURE Post(ReplyTo: LongInt; VAR TToI: FromToInfo; PvtMsg: Boolean); +PROCEDURE ReadMessages(MenuOption: Str50); +PROCEDURE ScanMessages(MArea: Integer; AskUpDate: Boolean; MenuOption: Str50); +PROCEDURE StartNewScan(MenuOption: Str50); +PROCEDURE ScanYours; +FUNCTION FirstNew: Word; + +IMPLEMENTATION + +USES + Dos, + Mail0, + Mail1, + EMail, + Mail6, + Menus, + ShortMsg, + SysOp3, + TimeFunc; + +VAR + TempLastRead: LongInt; + +PROCEDURE Post(ReplyTo: LongInt; VAR TToI: FromToInfo; PvtMsg: Boolean); +VAR + MHeader, + MHeader2: MHeaderRec; + ok: Boolean; + + PROCEDURE Nope(DisplayStr: AStr); + BEGIN + IF (ok) THEN + BEGIN + NL; + Print(DisplayStr); + NL; + END; + ok := FALSE; + END; + +BEGIN + ok := TRUE; + LoadMsgArea(MsgArea); + IF (NOT AACS(MemMsgArea.PostACS)) THEN + Nope('Your access level does not allow you to post in this area.'); + IF (AccountBalance < General.CreditPost) AND NOT (FNoCredits IN ThisUser.Flags) THEN + Nope('Insufficient account balance to post a message.'); + IF ((RPost IN ThisUser.Flags) OR (NOT AACS(General.NormPubPost))) THEN + Nope('Your access priviledges do not include posting.'); + IF ((PToday >= General.MaxPubPost) AND (NOT MsgSysOp)) THEN + Nope('Too many messages posted today.'); + IF (ok) THEN + BEGIN + InitMsgArea(MsgArea); + MHeader.FileAttached := 0; + MHeader.Status := []; + 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),TRUE,'',MHeader,'')) THEN + BEGIN + IF (ReplyTo <> -1) THEN + MHeader.ReplyTo := ((HiMsg + 1) - ReplyTo); + IF (PvtMsg) THEN + Include(MHeader.Status,Prvt); + SaveHeader((HiMsg + 1),MHeader); + IF (ReplyTo <> -1) THEN + BEGIN + LoadHeader(ReplyTo,MHeader2); + Inc(MHeader2.Replies); + SaveHeader(ReplyTo,MHeader2); + END; + SysOpLog(MHeader.Subject+' posted on ^5'+MemMsgArea.Name); + IF (MHeader.MTo.A1S <> '') THEN + SysOpLog(' To: "'+MHeader.MTo.A1S+'"'); + Print('^9Message posted on ^5'+MemMsgArea.Name+'^9.'); + NL; + Inc(ThisUser.MsgPost); + Inc(PToday); + IF NOT (FNoCredits IN ThisUser.Flags) THEN + AdjustBalance(General.CreditPost); + SaveURec(ThisUser,UserNum); + Update_Screen; + END; + END; +END; + +PROCEDURE ListMessages; +VAR + MHeader: MheaderRec; + S, + S1: STRING; + TempHiMsg: Word; + ADate: DateTime; + NumDone: Byte; +BEGIN + NumDone := 0; + TempHiMsg := HiMsg; + IF ((Msg_On < 1) OR (Msg_On > TempHiMsg)) THEN + Exit; + Abort := FALSE; + Next := FALSE; (* Added *) + Cls; + PrintACR('旼컴컴컫컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴컴컴컴컴컴쩡컴컴컴커'); + PrintACR('� Msg# � Sender � Receiver � '+'Subject �! Posted �'); + PrintACR('읕컴컴컨컴컴컴컴컴컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴컴컴컴컴컴좔컴컴컴켸'); + Dec(Msg_On); + WHILE ((NumDone < (PageLength - 7)) AND (Msg_On >= 0) AND (Msg_On < TempHiMsg) AND (NOT Next) 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 (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; + IF (Next) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + END; + END; + IF (Msg_On = TempHiMsg) THEN + BEGIN + Dec(Msg_On); + LoadHeader(Msg_On,MHeader); + END; +END; + +PROCEDURE MainRead(OncOnly,AskUpdate,Pub: Boolean); +VAR + User: UserRecordType; + MHeader: MHeaderRec; + LastReadRecord: ScanRec; + Cmd, + NewMenuCmd: AStr; + 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; + 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 (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; + AskPost := TRUE; + END + ELSE + BEGIN + IF ((CLSMsg IN ThisUser.SFlags) AND (NOT Contlist)) THEN + Cls + ELSE + NL; + ReadMsg(Msg_On,Msg_On,HiMsg); + IF (TempLastRead < MHeader.Date) AND (MHeader.Date <= GetPackDateTime) THEN + TempLastRead := MHeader.Date; + IF (Pub) THEN + Inc(MRead); + 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('You do not have the required access level for this option.') + ELSE + MoveMsg(Msg_On); + 4 : IF (NOT CoSysOp) THEN + Print('You do not have the required access level for this option.') + ELSE + ExtractMsgToFile(Msg_On); + 5 : IF (MsgSysOp) OR FromYou(MHeader) THEN + BEGIN + REPEAT + NL; + Prt('Message editing (^5?^4=^5Help^4): '); + MPL(1); + IF (MsgSysOp) THEN + Onek(Cmd1,'QVPRAFTSEOD?'^M) + ELSE + Onek(Cmd1,'QFTSEOD?'^M); + IF (NOT (Cmd1 IN ['Q',^M])) THEN + NL; + CASE Cmd1 OF + '?' : BEGIN + LCmds(15,5,'From','To'); + LCmds(15,5,'Subject','Edit text'); + LCmds(15,5,'Oops','Display header'); + IF (MsgSysOp) THEN + BEGIN + LCmds(15,5,'Permanent','Validation'); + LCmds(15,5,'Rescan','Anonymous'); + END; + LCmds(15,5,'Quit',''); + END; + 'D' : FOR Counter := 1 TO 6 DO + IF (HeaderLine(MHeader,Msg_On,HiMsg,Counter) <> '') THEN + PrintACR(Headerline(MHeader,Msg_On,HiMsg,Counter)); + 'O' : IF PYNQ('Reload old information? ',0) 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); + 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); + 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; + 'R' : IF (MsgSysOp) THEN + BEGIN + IF (Sent IN MHeader.Status) THEN + BEGIN + Exclude(MHeader.Status,Sent); + IF NOT (MAScanOut IN MemMsgArea.MAFlags) THEN + UpdateBoard; + END + ELSE + Include(MHeader.Status,Sent); + Print('Message '+AOnOff((Sent IN MHeader.Status),'','not ')+'marked as scanned.'); + SysOpLog('Message '+AOnOff((Sent IN MHeader.Status),'','not ')+'marked as scanned.'); + END; + 'P' : IF (MsgSysOp) THEN + BEGIN + IF (Permanent IN MHeader.Status) THEN + Exclude(MHeader.Status,Permanent) + ELSE + Include(MHeader.Status,Permanent); + Print('Message is '+AOnOff((Permanent IN MHeader.Status),'','not ')+'permanent.'); + SysOpLog('Message is '+AOnOff((Permanent IN MHeader.Status),'','not ')+'permanent.'); + END; + 'V' : IF (MsgSysOp) THEN + BEGIN + IF (UnValidated IN MHeader.Status) THEN + Exclude(MHeader.Status,UnValidated) + ELSE + Include(MHeader.Status,UnValidated); + Print('Message '+AOnOff((UnValidated IN MHeader.Status),'un','')+'validated.'); + SysOpLog('Message '+AOnOff((UnValidated IN MHeader.Status),'un','')+'validated.'); + 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 (Prvt IN MHeader.Status) THEN + Dyny := TRUE; + IF (MHeader.From.Anon = 0) OR (AACS(General.Anonpubread)) THEN + IF PYNQ('Is this to be a private reply? ',0) THEN + IF (MAPrivate IN MemMsgArea.MAFlags) THEN + IF PYNQ('Reply in Email? ',0) 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); + LoadHeader(HiMsg,MHeader); + IF (MHeader.Date <= GetPackDateTime) THEN + TempLastRead := MHeader.Date; + Next := FALSE; + END; + 8 : IF ((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 ((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('This is a permanent public message.'); + 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 '+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 '+MHeader.Subject); + END; + END + ELSE + BEGIN + NL; + Print('You can only delete public messages from you.'); + 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('* Uneleted private message from '+MHeader.From.A1S) + ELSE IF ToYou(MHeader) OR (MsgSysOp) THEN + SysOpLog('* Undeleted private message to '+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 '+MHeader.From.A1S) + ELSE IF ToYou(MHeader) OR (MsgSysOp) THEN + SysOpLog('* Deleted private message to '+MHeader.MTo.A1S); + END; + END + ELSE + BEGIN + NL; + Print('You can only delete private messages from/to you.'); + END; + END; + 12 : IF (NOT Pub) THEN + BEGIN + NL; + Print('This option is not available when reading private messages.'); + 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 (AskUpdate) THEN + BEGIN + NL; + IF PYNQ('Update message read pointers for this area? ',0) THEN + SaveLastRead(GetPackDateTime); + END; + DoneScan := TRUE; + Next := TRUE; + END; + 14 : BEGIN + DoneScan := TRUE; + Abort := TRUE; + END; + 15 : ListMessages; + 16 : IF (NOT CoSysOp) THEN + Print('You do not have the required access level for this option.') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('The sender of this message does not have an account on this BBS.') + ELSE IF (CheckPW) THEN + UserEditor(LastAuthor); + 17 : IF (NOT PUB) THEN + BEGIN + NL; + Print('This option is not available when reading private messages.'); + END + ELSE + BEGIN + IF (MAForceRead IN MemMsgArea.MAFlags) THEN + BEGIN + NL; + Print('^5'+MemMsgArea.Name+'^3 cannot be removed from your NewScan.') + END + ELSE + BEGIN + NL; + Print('^5'+MemMsgArea.Name+'^3 '+AOnOff(NewScanMsgArea,'will NOT','WILL')+ + ' be scanned in future new scans.'); + SysOpLog('* Toggled ^5'+MemMsgArea.Name+ '^1 '+AOnOff(NewScanMsgArea,'out of','back in')+ ' new scan.'); + Reset(MsgAreaScanFile); + Seek(MsgAreaScanFile,(UserNum - 1)); + Read(MsgAreaScanFile,LastReadRecord); + LastReadRecord.NewScan := NOT LastReadRecord.NewScan; + NewScanMsgArea := LastReadRecord.NewScan; + Seek(MsgAreaScanFile,(UserNum - 1)); + Write(MsgAreaScanFile,LastReadRecord); + Close(MsgAreaScanFile); + END; + END; + 18 : Inc(Msg_On); + 19 : IF (NOT CoSysOp) THEN + Print('You do not have the required access level for this option.') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('The sender of this message does not have an account on this BBS.') + ELSE + BEGIN + LoadURec(User,LastAuthor); + ShowUserInfo(1,LastAuthor,User); + END; + 20 : IF (NOT CoSysOp) THEN + Print('You do not have the required access level for this option.') + ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN + Print('The sender of this message does not have an account on this BBS.') + 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 + BEGIN + NL; + IF PYNQ('Validate messages here? ',0) 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; + END; + + IF ((Pub) AND (AskPost) AND (AACS(MemMsgArea.PostACS)) AND + (NOT (RPost IN ThisUser.Flags)) AND (PToday < General.MaxPubPost)) THEN + BEGIN + NL; + IF (TReadPrompt <> 7) THEN + IF PYNQ('Post on ^5'+MemMsgArea.Name+'^7? ',0) THEN + IF (MAPrivate IN MemMsgArea.MAFlags) THEN + BEGIN + NL; + Post(-1,MHeader.From,PYNQ('Is this to be a private message? ',0)); + END + ELSE + Post(-1,MHeader.From,FALSE); + END; +END; + +PROCEDURE ReadMessages(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 + NL; + Print('No messages on ^5'+MemMsgArea.Name+'^1.'); + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + END + ELSE + BEGIN + Msg_On := 1; + REPEAT + ListMessages; + NL; + { Prompt(FString.ReadQ); } + lRGLngStr(32,FALSE); + ScanInput(InputStr,'Q'^M); + IF (InputStr = ^M) THEN + IF ((Msg_On + 1) = HiMsg) THEN + Msg_On := 1 + ELSE + Inc(Msg_On); + UNTIL (InputStr <> ^M) OR (HangUp); + IF (InputStr <> 'Q') AND (NOT HangUp) THEN + BEGIN + IF (StrToInt(InputStr) < 1) OR (StrToInt(InputStr) > HiMsg) THEN + Msg_On := 1 + ELSE + Msg_On := StrToInt(InputStr); + IF (MsgArea <> -1) THEN + TempLastRead := LastMsgRead; + MainRead(FALSE,FALSE,(MsgArea <> -1)); + IF (MsgArea <> - 1) THEN + SaveLastRead(TempLastRead); + END; + END; + MsgArea := SaveReadMsgArea; + LoadMsgArea(MsgArea); +END; + +FUNCTION FirstNew: Word; +VAR + MHeader: MHeaderRec; + MaxMsgs, + Cn: Word; + Done: Boolean; +BEGIN + MaxMsgs := HiMsg; + Cn := 0; + IF (MaxMsgs > 0) THEN + BEGIN + Done := FALSE; + Cn := 1; + WHILE (CN <= MaxMsgs) AND (NOT Done) DO + BEGIN + LoadHeader(Cn,MHeader); + IF (LastMsgRead < MHeader.Date) THEN + Done := TRUE + ELSE + BEGIN + IF (CN < MaxMsgs) THEN + Inc(Cn,1) + ELSE + BEGIN + CN := 0; + Done := TRUE; + END; + END; + END; + END; + FirstNew := Cn; +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))+'^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; + 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) ) ) ); + 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,'FTSAY?Q'^M); + 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 (Cmd <> 'Q') AND (Cmd <> ^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 + BEGIN + Dyny := TRUE; + ScanNew := PYNQ('Scan new messages only? ',0); + END; + IF (ScanGlobal) OR ((MenuOption = '') AND PYNQ('Global scan? ',0)) THEN + BEGIN + MArea := 1; + WHILE (MArea <= NumMsgAreas) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (CompMsgArea(MArea) > 0) THEN + Searchboard(MArea,Cmd); + Wkey; + IF (Next) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + END; + Inc(MArea); + END; + END + ELSE + Searchboard(MArea,Cmd); + END; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); +END; + +PROCEDURE ScanYours; +VAR + FoundMap: ARRAY [0..255] OF SET OF 0..7; + MsgHeader: MHeaderRec; + SaveMsgArea, + MArea: Integer; + MsgNum, + Found: Word; + SaveConfSystem, + AnyFound, + FirstTime: Boolean; +BEGIN + FillChar(FoundMap,SizeOf(FoundMap),0); + SaveMsgArea := MsgArea; + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + NL; + Prompt('^5Scanning for your new public messages ... '); + FirstTime := TRUE; + AnyFound := FALSE; + MArea := 1; + WHILE (MArea <= NumMsgAreas) AND (NOT HangUp) DO + BEGIN + IF (CompMsgArea(MArea) > 0) THEN + BEGIN + IF (MsgArea <> MArea) THEN + ChangeMsgArea(MArea); + IF (MsgArea = MArea) THEN + BEGIN + InitMsgArea(MsgArea); + IF (NewScanMsgArea) THEN + BEGIN + Reset(MsgHdrF); + Reset(MsgTxtF,1); + IF (IOResult = 0) THEN + BEGIN + Found := 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 + FoundMap[MArea DIV 8] := FoundMap[MArea DIV 8] + [MArea MOD 8]; + Inc(Found); + END; + Inc(MsgNum); + END; + Close(MsgHdrF); + Close(MsgTxtF); + IF (Found > 0) THEN + BEGIN + IF (FirstTime) THEN + BEGIN + NL; + NL; + FirstTime := FALSE; + END; + Print(PadLeftStr(MemMsgArea.Name,30)+' ^1'+IntToStr(Found)); + AnyFound := TRUE; + END; + END; + END; + END; + END; + Inc(MArea); + END; + IF (NOT AnyFound) THEN + Print('^5No messages found.') + ELSE + BEGIN + Abort := FALSE; + Next := FALSE; + NL; + IF PYNQ('Read these now? ',0) THEN + BEGIN + MArea := 1; + WHILE (MArea <= NumMsgAreas) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (MArea MOD 8) IN FoundMap[MArea DIV 8] THEN + ScanMessages(MArea,TRUE,'N'); + WKey; + IF (Next) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + END; + Inc(MArea); + END; + 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); + TempLastRead := LastMsgRead; + Lil := 0; + { Prompt('^3'+FString.NewScan1);} + lRGLngStr(8,FALSE); + Msg_On := FirstNew; + IF (Msg_On > 0) THEN + MainRead(FALSE,FALSE,(MsgArea <> -1)); + (* Add backarase *) + END; + SaveLastRead(TempLastRead); + END; + +BEGIN + SaveMsgArea := MsgArea; + MArea := MsgArea; + Abort := FALSE; + Next := FALSE; + Global := 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 + BEGIN + NL; + Global := PYNQ('Scan all message areas? ',0) + END; + IF (NOT Global) THEN + NewScan(MArea) + ELSE + BEGIN + MArea := 1; + WHILE (MArea <= NumMsgAreas) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (CompMsgArea(MArea) > 0) THEN + BEGIN + InitMsgArea(MArea); + IF (NewScanMsgArea) OR ((MAForceRead IN MemMsgArea.MAFlags) AND (NOT CoSysOp)) THEN + NewScan(MArea); + END; + WKey; + IF (Next) THEN + BEGIN + Abort := FALSE; + Next := FALSE; + END; + Inc(MArea); + END; + SysOpLog('Global new scan of message areas'); + END; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); +END; + +END. diff --git a/SOURCE/UNUSED/MAIL5.TPU b/SOURCE/UNUSED/MAIL5.TPU new file mode 100644 index 0000000..9558f07 Binary files /dev/null and b/SOURCE/UNUSED/MAIL5.TPU differ diff --git a/SOURCE/UNUSED/MAIL6.PAS b/SOURCE/UNUSED/MAIL6.PAS new file mode 100644 index 0000000..705b2b8 --- /dev/null +++ b/SOURCE/UNUSED/MAIL6.PAS @@ -0,0 +1,583 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Mail6; + +INTERFACE + +PROCEDURE EditMessageText(MsgNum: Word); +PROCEDURE ForwardMessage(MsgNum: Word); +PROCEDURE MoveMsg(MsgNum: Word); +PROCEDURE ToggleMsgAreaScanFlags; + +IMPLEMENTATION + +USES + Dos, + Common, + Mail0, + Mail1, + Mail7, + MsgPack, + MiscUser; + +PROCEDURE EditMessageText(MsgNum: Word); +VAR + TempQuoteFile: Text; + MHeader: MHeaderRec; + TempStr: STRING; + SaveFileAttached: Byte; + TotLoad: 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)); + TotLoad := 0; + REPEAT + BlockRead(MsgTxtF,TempStr[0],1); + BlockRead(MsgTxtF,TempStr[1],Ord(TempStr[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.'); + TotLoad := MHeader.TextSize; + END; + Inc(TotLoad,(Length(TempStr) + 1)); + WriteLn(TempQuoteFile,TempStr); + 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.'); + TotLoad := MHeader.TextSize; + END; + UNTIL (TotLoad >= MHeader.TextSize); + Close(MsgTxtF); + Close(TempQuoteFile); + FileDateTime1 := GetFileDateTime('TEMPQ'+IntToStr(ThisNode)+'.MSG'); + SaveFileAttached := MHeader.FileAttached; + IF NOT (InputMessage((ReadMsgArea <> -1),FALSE,TRUE,'',MHeader,'TEMPQ'+IntToStr(ThisNode)+'.MSG')) THEN + BEGIN + Kill('TEMPQ'+IntToStr(ThisNode)+'.MSG'); + Exit; + END; + MHeader.FileAttached := SaveFileAttached; + FileDateTime2 := GetFileDateTime('TEMPQ'+IntToStr(ThisNode)+'.MSG'); + 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,TempStr); + 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(TempStr) + 1)); + BlockWrite(MsgTxtF,TempStr,(Length(TempStr) + 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; + TempStr: STRING; + SaveReadMsgArea, + Unum: Integer; + TempTextSize, + TotLoad: Word; + TempPtr, + TempPtr1: LongInt; + SaveConfSystem: Boolean; +BEGIN + SaveReadMsgArea := ReadMsgArea; + + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + + NL; + Print('Forward message to which user (1-'+(IntToStr(MaxUsers - 1))+')?'); + NL; + Print('Enter User Number, Name, or Partial Search String.'); + Prt(': '); + lFindUserWS(UNum); + IF (UNum > 0) THEN + BEGIN + IF (UNum = UserNum) THEN + BEGIN + NL; + Print('You can not forward messages to yourself.'); + END + ELSE + BEGIN + LoadURec(User,UNum); + IF ((User.Waiting < General.MaxWaiting) AND NOT (NoMail IN User.Flags)) OR (CoSysOp) THEN + 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; + + TempStr := 'Message forwarded from '+Caps(ThisUser.Name); + Inc(UNum,(Length(TempStr) + 1)); + IF (SaveReadMsgArea <> -1) THEN + BlockWrite(MsgTxtF1,TempStr,(Length(TempStr) + 1)) + ELSE + BlockWrite(MsgTxtF,TempStr,(Length(TempStr) + 1)); + + TempStr := 'Message forwarded on '+DateStr+' at '+TimeStr; + Inc(UNum,(Length(TempStr) + 1)); + IF (SaveReadMsgArea <> -1) THEN + BlockWrite(MsgTxtF1,TempStr,(Length(TempStr) + 1)) + ELSE + BlockWrite(MsgTxtF,TempStr,(Length(TempStr) + 1)); + + TempStr := ''; + Inc(UNum,(Length(TempStr) + 1)); + IF (SaveReadMsgArea <> -1) THEN + BlockWrite(MsgTxtF1,TempStr,(Length(TempStr) + 1)) + ELSE + BlockWrite(MsgTxtF,TempStr,(Length(TempStr) + 1)); + + TotLoad := 0; + + REPEAT + Seek(MsgTxtF,(TempPtr + TotLoad)); + + BlockRead(MsgTxtF,TempStr[0],1); + + BlockRead(MsgTxtF,TempStr[1],Ord(TempStr[0])); + + LastError := IOResult; + + Inc(TotLoad,(Length(TempStr) + 1)); + + IF (SaveReadMsgArea <> - 1) THEN + BEGIN + Seek(MsgTxtF1,FileSize(MsgTxtF1)); + BlockWrite(MsgTxtF1,TempStr,(Length(TempStr) + 1)); + END + ELSE + BEGIN + Seek(MsgTxtF,FileSize(MsgTxtF)); + BlockWrite(MsgTxtF,TempStr,(Length(TempStr) + 1)); + END; + + UNTIL (TotLoad >= 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('A copy of this message has been forwarded.'); + + SysOpLog('Forwarded message to '+Caps(User.Name)); + END; + END; + END; + + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + + InitMsgArea(SaveReadMsgArea); +END; + +PROCEDURE MoveMsg(MsgNum: Word); +VAR + MsgHdrF1: File of MHeaderRec; + MsgTxtF1: File; + MHeader: MHeaderRec; + TempStr: STRING; + NewMsgArea, + SaveReadMsgArea: Integer; + TotLoad: Word; + Done, + SaveConfSystem: Boolean; +BEGIN + SaveReadMsgArea := ReadMsgArea; + + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + + NewMsgArea := 0; + Done := FALSE; + REPEAT + NL; + Prt('Move to which area? (^50^4-^5'+IntToStr(AmBase(NumMsgAreas))+'^4) [^5?^4=^5List^4] [^5Q^4=^5Quit^4]: '); + ScanInput(TempStr,'?Q'^M); + IF (TempStr = 'Q') OR (TempStr = ^M) OR (TempStr = '') THEN + Done := TRUE + ELSE IF (TempStr = '?') THEN + MessageAreaList(FALSE) + ELSE + BEGIN + IF (TempStr = '0') THEN + NewMsgArea := -1 + ELSE + NewMsgArea := AMBase(StrToInt(TempStr)); + IF (NewMsgArea = ReadMsgArea) THEN + BEGIN + NL; + Print('You can not move a message to the same area.'); + END + ELSE IF (NewMsgArea = -1) OR (NewMsgArea >= 1) AND (NewMsgArea <= NumMsgAreas) THEN + Done := TRUE + ELSE + BEGIN + NL; + Print('You can not move a message to this area.'); + END; + END; + UNTIL ((Done) OR (HangUp)); + IF ((NewMsgArea >= 1) AND (NewMsgArea <= NumMsgAreas)) OR (NewMsgArea = -1) THEN + BEGIN + IF (MsgAreaAC(NewMsgArea)) THEN + BEGIN + InitMsgArea(SaveReadMsgArea); + + LoadHeader(MsgNum,MHeader); + + LoadMsgArea(NewMsgArea); + + 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); + + Seek(MsgHdrF1,FileSize(MsgHdrF1)); + 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); + TotLoad := 0; + + REPEAT + BlockRead(MsgTxtF,TempStr[0],1); + BlockRead(MsgTxtF,TempStr[1],Ord(TempStr[0])); + LastError := IOResult; + Inc(TotLoad,(Length(TempStr) + 1)); + BlockWrite(MsgTxtF1,TempStr,(Length(TempStr) + 1)); + LastError := IOResult; + UNTIL (TotLoad >= MHeader.TextSize); + Close(MsgTxtF1); + Close(MsgTxtF); + InitMsgArea(SaveReadMsgArea); + LoadHeader(MsgNum,MHeader); + Include(MHeader.Status,MDeleted); + SaveHeader(MsgNum,MHeader); + NL; + Print('The message was moved successfully.'); + END; + END; + + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + + InitMsgArea(SaveReadMsgArea); +END; + +(* +PROCEDURE ToggleFileAreaScanFlags; +VAR + InputStr: STRING[9]; + Temp, + First, + Last, + SaveFileBoard: Integer; + SaveConfSystem: Boolean; + + PROCEDURE ToggleScanFlags(Start,Finish: Integer; ScanType: Byte); + VAR + ScanArea: Boolean; + BEGIN + FOR FileBoard := Start TO Finish DO + BEGIN + InitFileArea(FileBoard); + Reset(ScnFile); + Seek(ScnFile,(UserNum - 1)); + IF (ScanType = 1) THEN + ScanArea := TRUE + ELSE IF (ScanType = 2) THEN + ScanArea := FALSE + ELSE IF (ScanType = 3) THEN + ScanArea := NOT NewScanFBase; + Write(ScnFile,ScanArea); + Close(ScnFile); + END; + IF (ScanType IN [1..2]) OR (ScanType = 3) AND (First = Last) THEN + NL; + IF (ScanType = 1) THEN + Print('You are now scanning all file areas.') + ELSE IF (ScanType = 2) THEN + Print('You are now not scanning any file areas.') + ELSE IF (ScanType = 3) THEN + IF (First = Last) THEN + Print('^5'+MemFileArea.Name+'^3 will '+AOnOff(ScanArea,'','not ')+'be scanned.'); + IF (ScanType IN [1..2]) OR (ScanType = 3) AND (First = Last) THEN + NL; + END; + +BEGIN + SaveFileBoard := FileBoard; + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + IF (Novice IN ThisUser.Flags) THEN + FileAreaList(TRUE) + ELSE + NL; + REPEAT + Prt('Range to toggle (^5x^4-^5y^4), [^5F^4]lag or [^5U^4]nflag all, [^5?^4=^5List^4]: '); + MPL(9); + ScanInput(InputStr,'FU-?'^M); + IF (InputStr = '-') THEN + InputStr := ^M + ELSE IF (InputStr = '?') THEN + FileAreaList(TRUE) + ELSE IF (InputStr = 'F') THEN + ToggleScanFlags(1,NumFileAreas,1) + ELSE IF (InputStr = 'U') THEN + ToggleScanFlags(1,NumFileAreas,2) + ELSE IF (StrToInt(InputStr) > 0) THEN + BEGIN + First := AFBase(StrToInt(InputStr)); + IF (Pos('-',InputStr) = 0) THEN + Last := First + ELSE + BEGIN + Last := AFBase(StrToInt(Copy(InputStr,(Pos('-',InputStr) + 1),(Length(InputStr) - Pos('-',InputStr))))); + IF (First > Last) THEN + BEGIN + Temp := First; + First := Last; + Last := Temp; + END; + END; + IF (First >= 1) AND (Last <= NumFileAreas) THEN + ToggleScanFlags(First,Last,3) + ELSE + BEGIN + NL; + Print('Invalid range entered.'); + NL; + END; + END; + UNTIL (InputStr = ^M) OR (HangUp); + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + FileBoard := SaveFileBoard; + InitFileArea(FileBoard); + LastError := IOResult; + LastCommandOvr := TRUE; +END; +*) + +PROCEDURE ToggleMsgAreaScanFlags; +VAR + InputStr: Str9; + First, + Last, + Temp, + SaveMsgArea: Integer; + SaveConfSystem: Boolean; +BEGIN + SaveMsgArea := MsgArea; + SaveConfSystem := ConfSystem; + ConfSystem := FALSE; + IF (SaveConfSystem) THEN + NewCompTables; + MessageAreaList(TRUE); + REPEAT + Prt('Range to toggle (^5X^4-^5Y^4,^5F^4lag or ^5U^4nflag all,^5?^4=^5List^4,^5^4=^5Quit^4): '); + MPL(9); + ScanInput(InputStr,'FU-?'^M); + IF (InputStr = '-') THEN + InputStr := ^M + ELSE IF (InputStr = '?') THEN + MessageAreaList(TRUE) + ELSE IF (InputStr = 'F') THEN + BEGIN + FOR MsgArea := 1 TO NumMsgAreas DO + BEGIN + InitMsgArea(MsgArea); + IF (NOT NewScanMsgArea) THEN + NewScanMsgArea := ToggleNewScan; + END; + NL; + Print('You are now reading all message areas.'); + NL; + END + ELSE IF (InputStr = 'U') THEN + BEGIN + FOR MsgArea := 1 TO NumMsgAreas DO + BEGIN + InitMsgArea(MsgArea); + IF (NewScanMsgArea) AND NOT (MAForceRead IN MemMsgArea.MAFlags) THEN + NewScanMsgArea := ToggleNewScan; + END; + NL; + Print('You are now not reading any message areas.'); + NL; + END + ELSE IF (StrToInt(InputStr) > 0) THEN + BEGIN + First := AMBase(StrToInt(InputStr)); + IF (Pos('-',InputStr) > 0) THEN + BEGIN + Last := AMBase(StrToInt(Copy(InputStr,(Pos('-',InputStr) + 1),255))); + IF (First > Last) THEN + BEGIN + Temp := First; + First := Last; + Last := Temp; + END; + END + ELSE + Last := First; + IF (First < 1) AND (Last > NumMsgAreas) THEN + BEGIN + NL; + Print('Invalid range.'); + NL; + END + ELSE + BEGIN + FOR MsgArea := First TO Last DO + BEGIN + InitMsgArea(MsgArea); + IF NOT (MAForceRead IN MemMsgArea.MAFlags) THEN + BEGIN + NewScanMsgArea := ToggleNewScan; + IF (First = Last) THEN + BEGIN + NL; + Print('^5' + MemMsgArea.Name + '^3 will ' + AOnOff(NewScanMsgArea, 'not ','')+ 'be scanned.'); + NL; + END; + END + ELSE + BEGIN + NL; + Print('^5' + MemMsgArea.Name + '^3 cannot be removed from your newscan.'); + NL; + END; + END; + END; + END; + UNTIL (InputStr = ^M) OR (HangUp); + ConfSystem := SaveConfSystem; + IF (SaveConfSystem) THEN + NewCompTables; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); + LastCommandOvr := TRUE; +END; + +END. diff --git a/SOURCE/UNUSED/MAIL6.TPU b/SOURCE/UNUSED/MAIL6.TPU new file mode 100644 index 0000000..489f1e7 Binary files /dev/null and b/SOURCE/UNUSED/MAIL6.TPU differ diff --git a/SOURCE/UNUSED/MAIL7.PAS b/SOURCE/UNUSED/MAIL7.PAS new file mode 100644 index 0000000..8cb9af9 --- /dev/null +++ b/SOURCE/UNUSED/MAIL7.PAS @@ -0,0 +1,165 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT Mail7; + +INTERFACE + +USES + Common; + +PROCEDURE MessageAreaList(ShowScan: Boolean); +PROCEDURE MessageAreaChange(VAR Done: Boolean; CONST MenuOption: Str50); + +IMPLEMENTATION + +USES + Mail0; + +(* Done - 06/21/07 - Lee Palmer *) +PROCEDURE MessageAreaList(ShowScan: Boolean); +VAR + ScanChar, + TempStr: AStr; + NumOnline: Byte; + MArea, + NumMAreas, + SaveMsgArea: Integer; +BEGIN + SaveMsgArea := MsgArea; + Abort := FALSE; + Next := FALSE; + AllowContinue := TRUE; + NumOnline := 0; + NumMAreas := 0; + TempStr := ''; + ScanChar := lRGLngStr(55,TRUE); {FString.ScanCharCheck} + (* + CLS; + IF (FString.MsgAreaHeader <> '') THEN + PrintMain(FString.MsgAreaHeader) + ELSE + BEGIN + PrintACR('7旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커'); + PrintACR('7�8 Num 7�9 Name 7�8 Num 7�9 Name 7�'); + PrintACR('7읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸'); + END; + *) + lRGLngStr(58,FALSE); + Reset(MsgAreaFile); + MArea := 1; + WHILE (MArea <= NumMsgAreas) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + IF (ShowScan) THEN + InitMsgArea(Marea) + ELSE + LoadMsgArea(MArea); + IF (AACS(MemMsgArea.ACS)) OR (MAUnHidden IN MemMsgArea.MAFlags) THEN + BEGIN + TempStr := TempStr + PadLeftStr(PadRightStr(';'+IntToStr(CompMsgArea(MArea)),5)+ + ' '+AOnOff(ShowScan AND NewScanMsgArea,':'+ScanChar[1],' ')+ + '< '+MemMsgArea.Name,39); + Inc(NumOnline); + IF (NumOnline = 2) THEN + BEGIN + PrintaCR(TempStr); + NumOnline := 0; + TempStr := ''; + END; + Inc(NumMAreas); + END; + WKey; + Inc(MArea); + END; + Close(MsgAreaFile); + AllowContinue := FALSE; + IF (NumOnline = 1) AND (NOT Abort) THEN + PrintaCR(TempStr); + IF (NumMAreas = 0) AND (NOT Abort) THEN + Print('^7No message areas.'); + NL; + MsgArea := SaveMsgArea; + LoadMsgArea(MsgArea); +END; + +(* Done - 06/21/2007 - Lee Palmer *) +PROCEDURE MessageAreaChange(VAR Done: Boolean; CONST MenuOption: Str50); +VAR + InputStr: Str4; + MArea: Integer; +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 + NL; + Print('Highest accessible message area.'); + END + ELSE + LastCommandOvr := TRUE; + END; + '-' : BEGIN + MArea := MsgArea; + IF (MsgArea <= 0) THEN + MArea := NumMsgAreas + ELSE + REPEAT + Dec(MArea); + ChangeMsgArea(MArea); + UNTIL (MsgArea = MArea) OR (MArea <= 0); + IF (MsgArea <> MArea) THEN + BEGIN + NL; + Print('Lowest accessible message area.'); + END + ELSE + LastCommandOvr := TRUE; + END; + 'L' : BEGIN + MessageAreaList(FALSE); + IF (Novice IN ThisUser.Flags) THEN + PauseScr(FALSE); + 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 + InputStr := '?'; + REPEAT + IF (InputStr = '?') THEN + MessageAreaList(FALSE); + Prt('Change message area (^5?^4=^5List^4,^5^4=^5Quit^4): '); + MPL(4); + ScanInput(InputStr,'?'^M); + MArea := AMBase(StrToInt(InputStr)); + IF (MArea <> MsgArea) THEN + ChangeMsgArea(MArea); + UNTIL (InputStr <> '?') OR (HangUp); + LastCommandOvr := TRUE; + END; +END; + +END. diff --git a/SOURCE/UNUSED/MAIL7.TPU b/SOURCE/UNUSED/MAIL7.TPU new file mode 100644 index 0000000..f134700 Binary files /dev/null and b/SOURCE/UNUSED/MAIL7.TPU differ diff --git a/SOURCE/UNUSED/MAINT.TPU b/SOURCE/UNUSED/MAINT.TPU new file mode 100644 index 0000000..5c2f46b Binary files /dev/null and b/SOURCE/UNUSED/MAINT.TPU differ diff --git a/SOURCE/UNUSED/MARRIAGE.DAT b/SOURCE/UNUSED/MARRIAGE.DAT new file mode 100644 index 0000000..564231a Binary files /dev/null and b/SOURCE/UNUSED/MARRIAGE.DAT differ diff --git a/SOURCE/UNUSED/MARRIAGE.PTR b/SOURCE/UNUSED/MARRIAGE.PTR new file mode 100644 index 0000000..19d880a Binary files /dev/null and b/SOURCE/UNUSED/MARRIAGE.PTR differ diff --git a/SOURCE/UNUSED/MARRIAGE.TXT b/SOURCE/UNUSED/MARRIAGE.TXT new file mode 100644 index 0000000..04d8324 --- /dev/null +++ b/SOURCE/UNUSED/MARRIAGE.TXT @@ -0,0 +1,364 @@ +$ +Ambrose Bierce: + +Love: a temporary insanity, curable by marriage. +%PA +$ + +$ +Amy Bloom: + +Love at first sight is easy to understand; it's when two people have been +looking at each other for a lifetime that it becomes a +miracle. +%PA +$ + +$ +Ann Landers: + +All married couples should learn the art of battle as they should learn +the art of making love. Good battle is objective and honest--never vicious +or cruel. Good battle is healthy and constructive, and brings to a marriage +the principle of equal partnership. + +Ann Landers Says Truth Is Stranger..., 1968 +%PA +$ + +$ +Anna Garlin Spencer: + +The friendship between a man and a woman which does not lead to marriage +or desire for marriage may be a life long experience of the greatest value +to themselves and to all their circle of acquaintance and of activity; but +for this type of friendship both a rare man and a rare woman are needed. +Perhaps it should be added that either the man or the woman thus deeply +bound in lifelong friendship who seeks marriage must find a still rarer +man or woman to wed, to make such a three cornered comradeship a permanent +success. +%PA +$ + +$ +Anne Bradstreet: + +If ever two were one, then surely we. +If ever man were loved by wife, then thee. +%PA +$ + +$ +Betty Friedan: + +If divorce has increased by one thousand percent, don't blame the women's +movement. Blame the obsolete sex roles on which our marriages were based. + +Speech, New York City, January 20, 1974 +%PA +$ + + +$ +Bill Cosby: + +For two people in a marriage to live together day after day is +unquestionably the one miracle the Vatican has overlooked. +%PA +$ + +$ +Danny DeVito: + +There are two dilemmas that rattle the human skull: How do you hang on to +someone who won't stay? And how do you get rid of someone who won't go? + +The War of the Roses +%PA +$ + +$ +Francis Bacon: + +He that hath a wife and children hath given hostages to fortune. +%PA +$ + +$ +Friedrich Nietzsche: + +It is not a lack of love, but a lack of friendship that makes unhappy marriages. +%PA +$ + +$ +Gloria Steinem: + +I have yet to hear a man ask for advice on how to combine marriage and a +career. +%PA +$ + +$ +Groucho Marx: + +Some people claim that marriage interferes with romance. There's no doubt +about it. Anytime you have a romance, your wife is bound to interfere. + +The Groucho Phile, 1976 +%PA +$ + +$ +Hannah Arendt: + +The right to marry whoever one wishes is an elementary human right compared +to which "the right to attend an integrated school, the right to sit where +one pleases on a bus, the right to go into any hotel or recreation area or +place of amusement, regardless of one's skin or color or race" are minor +indeed. Even political rights, like the right to vote, and nearly all other +rights enumerated in the Constitution, are secondary to the inalienable +human rights to "life, liberty and the pursuit of happiness" proclaimed in +the Declaration of Independence; and to this category the right to home and +marriage unquestionably belongs. [Dissent, Winter 1959] +%PA +$ + +$ +Harriet Martineau: + +Any one must see at a glance that if men and women marry those whom they +do not love, they must love those whom they do not marry. +%PA +$ + +$ +Helen Rowland: + +Never trust a husband too far, nor a bachelor too near. +%PA +$ + +$ +Homer: + +There is nothing nobler or more admirable than when two people who see eye +to eye keep house as man and wife, confounding their enemies and delighting +their friends. +%PA +$ + +$ +John Berger: + +All weddings are similar, but every marriage is different. +%PA +$ + +$ +Joseph Barth: + +Marriage is our last, best chance to grow up. +%PA +$ + +$ +Josh McDowell: + +What you are as a single person, you will be as a married person, only to +a greater degree. Any negative character trait will be intensified in a +marriage relationship, because you will feel free to let your guard +down -- that person has committed himself to you and you no longer have to +worry about scaring him off. +%PA +$ + +$ +Joyce Brothers: + +Marriage is not just spiritual communion, it is also remembering to take +out the trash. +%PA +$ + +$ +Joyce Brothers: + +My husband and I have never considered divorce... murder sometimes, but +never divorce. +%PA +$ + +$ +Katharine Hepburn: + +If you want to sacrifice the admiration of many men for the criticism of +one, go ahead, get married. +%PA +$ + +$ +Louis K. Anspacher: + +Marriage is that relation between man and woman in which the independence +is equal, the dependence mutual, and the obligation reciprocal. +%PA +$ + +$ +Mark Twain: + +After all these years, I see that I was mistaken about Eve in the +beginning; it is better to live outside the Garden with her than +inside it without her. + +Adam, in Adam's Diary +%PA +$ + +$ +Mark Twain: + +Love seems the swiftest, but it is the slowest of all growths. No man or +woman really knows what perfect love is until they have been married a +quarter of a century. +%PA +$ + +$ +Mignon McLaughlin: + +A successful marriage requires falling in love many times, always with +the same person. +%PA +$ + +$ +Mohandas K. Gandhi: + +I first learned the concepts of non-violence in my marriage. +%PA +$ + +$ +Nanette Newman: + +A good marriage is at least 80 percent good luck in finding the right +person at the right time. The rest is trust. +%PA +$ + +$ +Ogden Nash: + +To keep your marriage brimming, +With love in the loving cup, +Whenever you're wrong admit it; +Whenever you're right shut up. +%PA +$ + +$ +Ogden Nash: + +Marriage is the alliance of two people, one of whom never remembers +birthdays and the other who never forgets. +%PA +$ + +$ +Oscar Wilde: + +Marriage is the triumph of imagination over intelligence. +%PA +$ + +$ +Pearl S. Buck: + +A good marriage is one which allows for change and growth in the +individuals and in the way they express their love. +%PA +$ + +$ +Rainer Maria Rilke: + +A good marriage is that in which each appoints the other guardian of +his solitude. +%PA +$ + +$ +Ralph Waldo Emerson: + +Is not marriage an open question, when it is alleged, from the beginning +of the world, that such as are in the institution wish to get out, and +such as are out wish to get in? +%PA +$ + +$ +Rita Rudner: + +I think men who have a pierced ear are better prepared for marriage. +They've experienced pain and bought jewelry. +%PA +$ + +$ +Robert C. Dodds: + +The goal in marriage is not to think alike, but to think together. +%PA +$ + +$ +Samuel Johnson: + +Marriage is the triumph of hope over experience. +%PA +$ + +$ +Simone Signoret: + +Chains do not hold a marriage together. It is threads, hundreds of tiny +threads which sew people together through the years. That is what makes +a marriage last --more than passion or even sex! +%PA +$ + +$ +Socrates: + +My advice to you is to get married. If you find a good wife, you'll be +happy; if not, you'll become a philosopher. +%PA +$ + +$ +Tom Mullen: + +Happy marriages begin when we marry the ones we love, and they blossom +when we love the ones we marry. +%PA +$ + +$ +W. H. Auden: + +Like everything which is not the involuntary result of fleeting emotion +but the creation of time and will, any marriage, happy or unhappy, is +infinitely more interesting than any romance, however passionate. +%PA +$ + +$ +Will Stanton: + +Getting a dog is like getting married. It teaches you to be less +self-centered, to accept sudden, surprising outbursts of affection, +and not to be upset by a few scratches on your car. +%PA +$ \ No newline at end of file diff --git a/SOURCE/UNUSED/MENUS.TPU b/SOURCE/UNUSED/MENUS.TPU new file mode 100644 index 0000000..fdab704 Binary files /dev/null and b/SOURCE/UNUSED/MENUS.TPU differ diff --git a/SOURCE/UNUSED/MENUS2.TPU b/SOURCE/UNUSED/MENUS2.TPU new file mode 100644 index 0000000..5072044 Binary files /dev/null and b/SOURCE/UNUSED/MENUS2.TPU differ diff --git a/SOURCE/UNUSED/MENUS3.TPU b/SOURCE/UNUSED/MENUS3.TPU new file mode 100644 index 0000000..6eff82e Binary files /dev/null and b/SOURCE/UNUSED/MENUS3.TPU differ diff --git a/SOURCE/UNUSED/MENUS4.PAS b/SOURCE/UNUSED/MENUS4.PAS new file mode 100644 index 0000000..39923a9 --- /dev/null +++ b/SOURCE/UNUSED/MENUS4.PAS @@ -0,0 +1,50 @@ +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +UNIT Menus4; + +INTERFACE + +USES + Common; + +PROCEDURE AutoValidationCmd(CONST PW: AStr; Level: Char); + +IMPLEMENTATION + +PROCEDURE AutoValidationCmd(CONST PW: AStr; Level: Char); +VAR + TempStr: AStr; +BEGIN + NL; + IF (ThisUser.SL = General.Validation[Level].NewSL) AND (ThisUser.DSL = General.Validation[Level].NewDSL) THEN + BEGIN + Print('You''ve been validated! You do not need to use this command.'); + Exit; + END; + Print('Press [Enter] to abort.'); + NL; + Prt('Password: '); + Input(TempStr,50); + NL; + IF (TempStr = '') THEN + Print('^7Function aborted.'^G) + ELSE + BEGIN + IF (TempStr <> AllCaps(PW)) THEN + BEGIN + Print('^7Wrong!'^G); + SysOpLog('Wrong password for auto-validation: "'+TempStr+'"'); + END + ELSE + BEGIN + AutoValidate(ThisUser,UserNum,Level); + lStatus_Screen(100,'This user has auto-validated himself.',FALSE,TempStr); + PrintF('AUTOVAL'); + IF (NoFile) THEN + Print('Correct. You are now validated.'); + SysOpLog('Used auto-validation password.'); + END; + END; +END; + +END. diff --git a/SOURCE/UNUSED/MENUS4.TPU b/SOURCE/UNUSED/MENUS4.TPU new file mode 100644 index 0000000..ed4a409 Binary files /dev/null and b/SOURCE/UNUSED/MENUS4.TPU differ diff --git a/SOURCE/UNUSED/MISCCHAT.PAS b/SOURCE/UNUSED/MISCCHAT.PAS new file mode 100644 index 0000000..3f3d1c1 --- /dev/null +++ b/SOURCE/UNUSED/MISCCHAT.PAS @@ -0,0 +1,184 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT MiscChat; + +INTERFACE + +USES + Common; + +PROCEDURE RequestSysOpChat(CONST MenuOption: STr50); +PROCEDURE ChatFileLog(b: Boolean); + +IMPLEMENTATION + +USES + Crt, + Dos, + Email, + Event, + 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 + 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; + END; + NoSound; + 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; + +END. diff --git a/SOURCE/UNUSED/MISCUSER.TPU b/SOURCE/UNUSED/MISCUSER.TPU new file mode 100644 index 0000000..71f6cd5 Binary files /dev/null and b/SOURCE/UNUSED/MISCUSER.TPU differ diff --git a/SOURCE/UNUSED/MSGPACK.TPU b/SOURCE/UNUSED/MSGPACK.TPU new file mode 100644 index 0000000..37e215b Binary files /dev/null and b/SOURCE/UNUSED/MSGPACK.TPU differ diff --git a/SOURCE/UNUSED/MSGQUOTE.DAT b/SOURCE/UNUSED/MSGQUOTE.DAT new file mode 100644 index 0000000..561d3ce --- /dev/null +++ b/SOURCE/UNUSED/MSGQUOTE.DAT @@ -0,0 +1 @@ +0Love: a temporary insanity, curable by marriage.@He that hath a wife and children hath given hostages to fortune.7Never trust a husband too far, nor a bachelor too near.:All weddings are similar, but every marriage is different.-Marriage is our last, best chance to grow up. 0 then HandleError('Can''t find Renegade.dat',True,1); + ReadFromRenegadeDat(RGIn,WhichErr); + If WhichErr <> 0 then HandleError('Can''t read from Renegade.dat',True,2); + CloseRenegadeDat; + end; + +Procedure GetMultNodeDatPath; + begin + if paramstr(2) = '' then MultNodeDatPath := rgin.datapath + else MultNodeDatPath := ParamStr(2); + end; + +procedure SetWhichNode; + begin + if paramstr(1) = '' then HandleError('Which node do you want me to apply this to..',True,3) + else Node := paramstr(1); + end; + +procedure initnoder; + begin + FillChar(Noder,SizeOf(Noder),' '); + OpenMultNodeDat(MultNodeDatPath,WhichErr); + If WhichErr <> 0 then HandleError('Can''t find multnode.dat',True,4); + ReadFromMultNodeDat(Noder,StrToInt(Node)); + end; + +Procedure MainProgram; + begin + with noder do begin + User := 1; + UserName := 'The Titantic BBS'; + Status := []; + Status := [NActive]; + CityState := 'Internet'; + LogonTime := TodayinUnix; +{ 12345678901234567890} + Description := 'Waiting for Call'; + Activity := 255; + end; + end; + +Procedure WriteToCloseNoder; + begin + WriteToMultNodeDat(Noder,StrToInt(Node)); + CloseMultNodeDat; + end; + +procedure DoProgram; + begin + OpenReadCloseRenegadeDat; + GetMultNodeDatPath; + SetWhichNode; + InitNoder; + MainProgram; + WriteToCloseNoder; + end; + + +Begin + DoProgram; +End. diff --git a/SOURCE/UNUSED/MULTNODE.TPU b/SOURCE/UNUSED/MULTNODE.TPU new file mode 100644 index 0000000..8e91c7b Binary files /dev/null and b/SOURCE/UNUSED/MULTNODE.TPU differ diff --git a/SOURCE/UNUSED/MYIO.TPU b/SOURCE/UNUSED/MYIO.TPU new file mode 100644 index 0000000..b326b56 Binary files /dev/null and b/SOURCE/UNUSED/MYIO.TPU differ diff --git a/SOURCE/UNUSED/NEWMCI.TXT b/SOURCE/UNUSED/NEWMCI.TXT new file mode 100644 index 0000000..0db36d3 --- /dev/null +++ b/SOURCE/UNUSED/NEWMCI.TXT @@ -0,0 +1,40 @@ +36 New MCI Codes (08/25/06): + +CD - Time allowed per (day/call) +CS - SysOp Chat Hours (Always Available or Low Time....High Time) +BL - Baud Hours (Always Available or Low Time....High Time) +DH - DL Hours (Always Available or Low Time....High Time) +BM - Min Baud DL Hours (Always Available or Low Time....High Time) +ET - Event Warning Time (Seconds) +PB - Bulletin Prefix (8 Characters) +MN - Multinode (On/Off) +PD - Data Path (Complete Path) +PM - Misc Path (Complete Path) +P1 - Msg Path (Complete Path) +P2 - Node Path (Complete Path) +PL - Logs Path (Complete Path) +PT - Temp Path (Complete Path) +PP - Prot Path (Complete Path) +PA - Acs Path (Complete Path) +PF - File AttachPath (Complete Path) +P3 - Mult Path (Complete Path) +M1 - Global Menu (Menu Number) +M2 - All Start Menu (Menu Number) +M3 - Shuttle Logon Menu (Menu Number) +M4 - New User Information Menu (Menu Number) +M5 - Message Read Menu (Menu Number) +M6 - File Listing Menu (Menu Number) +P4 - SysOp PW +P5 - NewUser PW +P6 - MinBaudOverride PW +H1 - SysOp Low Time +H2 - SysOp Hi Time +H3 - Minimum Baud Low Time +H4 - Minimum Baud High Time +H5 - Download Low Time +H6 - Download High Time +H7 - Minimum Baud Download Low Time +H8 - Minimum Baud Download High Time +M7 - Minimum Baud +CA - Calls Allowed Per Day +T1 - Time Allowed Per Day/Call \ No newline at end of file diff --git a/SOURCE/UNUSED/NEWUSERS.TPU b/SOURCE/UNUSED/NEWUSERS.TPU new file mode 100644 index 0000000..6e1d162 Binary files /dev/null and b/SOURCE/UNUSED/NEWUSERS.TPU differ diff --git a/SOURCE/UNUSED/NODELIST.TPU b/SOURCE/UNUSED/NODELIST.TPU new file mode 100644 index 0000000..b860cc2 Binary files /dev/null and b/SOURCE/UNUSED/NODELIST.TPU differ diff --git a/SOURCE/UNUSED/NONAME00.EXE b/SOURCE/UNUSED/NONAME00.EXE new file mode 100644 index 0000000..563ae7c Binary files /dev/null and b/SOURCE/UNUSED/NONAME00.EXE differ diff --git a/SOURCE/UNUSED/OFFLINE.TPU b/SOURCE/UNUSED/OFFLINE.TPU new file mode 100644 index 0000000..7e5e7c3 Binary files /dev/null and b/SOURCE/UNUSED/OFFLINE.TPU differ diff --git a/SOURCE/UNUSED/OVRUMB.DOC b/SOURCE/UNUSED/OVRUMB.DOC new file mode 100644 index 0000000..f4c4b25 --- /dev/null +++ b/SOURCE/UNUSED/OVRUMB.DOC @@ -0,0 +1,220 @@ + OvrUMB version 1.2 + by Jean-Marc Lasgouttes + 컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + + + +Overview +컴컴컴컴� + +The purpose of this unit for Turbo Pascal 6/7 is to allow your programs +that use overlays to free more conventional memory. This is made possible +by the relocation of the overlay buffer in upper memory on systems that +support that kind of memory. + +This unit should be compatible with the use of OvrInitEMS, OvrInitXMS (from +the unit OverXMS - overxms.zip at garbo.uwasa.fi) or the procedures from the +Streams unit (streams15.zip by Duncan Murdoch). The purpose of all these +procedures is to speed up the overlay reading by keeping the overlay file in +EMS or XMS memory. It is recommended to use OvrInitEMS/XMS or the streams +unit in conjunction with OvrUMB. + +This unit is released to the Public Domain. Feel free to use it in your +applications and distribute it, as long as this documentation is included. +You can distribute a modified version of it, as long as credit is given to me +as the original author; in this case, I would appreciate to get a copy of +your modifications. Although this unit has been tested on several systems, +there is no warranty that it will work for your application and I should +not be liable of any damage that it may cause. However, I would be glad +to try to correct any problem that you may encounter (see my address at the +end of this document). + + + +Why you should use OvrUMB +컴컴컴컴컴컴컴컴컴컴컴컴컴 + +If you use overlays in your applications, you are probably aware that +all the free memory that you can get will be welcome. One way to gain +memory is to use the upper memory which is accessible for real-mode +programs on a wide range of systems (most 80386/486/... and some +8086/286). With this unit, your applications will make use of upper +memory if it is available, with a slight modification of your code. + +The idea of this unit is very simple: Borland Pascal overlay manager +uses a part of the heap as a buffer where it loads the overlaid code +that needs to be executed. OvrMovBufToUMB tries to allocate a buffer +of at least the same size in upper memory and to set the variables of +the overlay manager to point to this new buffer. The old block can +then be disposed of and is added to the heap. The gains in memory will +be equal to the size of the biggest overlaid unit (20-30k in my case) +if you use the default buffer. But I find it more efficient to +overlay as many units as possible and to declare a buffer of 60-80k +with OvrSetBuf. This will free more memory and the slowdown will be +hardly noticeable. In this case, OvrUMB will free even more +conventional memory (as long as there is a 60-80k contiguous upper +memory block on the host computer). + +There are other means to use upper memory in your Turbo Pascal +applications; one of them is the unit UMB_Heap published in PC +Magazine (vol. 11 no. 20). This unit will map the existing upper +memory blocks in the regular Turbo Pascal heap. Although this is the +most transparent way to use upper memory, this unit has some +shortcomings: + + - a program using this unit could have big problems when trying to + execute child DOS processes, since Turbo Pascal does not expect its + memory to be allocated as several DOS memory blocks; + - the unit itself has some bugs concerning the restoration of the DOS + memory allocation strategy and tests for the presence of an XMS driver, + which cannot be installed on a 8086 based computer. + + + +System Requirements +컴컴컴컴컴컴컴컴컴컴 + + - TP6 or TP7/BP7 + - A program that uses overlays... + - Some free UMBs in the system on which your program is to be executed. + Note that your program will work without UMB, except that no memory + will be gained. Since the overhead of the unit is about 320 bytes, + decrease in available memory will hardly noticeable. + + + +Contents +컴컴컴컴� + +The complete package contains: + + - ovrumb.doc This file + + - ovrumb.pas The main unit source + + - ovrtest.pas A test program that demonstrates the use of the + ovr1.pas OvrUMB unit. + ovr2.pas + + + +How to use this unit in your programs +컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + +This is very easy : the modifications must be done in the main program +or in the initialization part of a unit that is declared before any +overlaid unit. + + - Add "OvrUMB" in your uses statement; + - Instead of code like + + ... + OvrInit('MYPROG.OVR'); {Opens the overlay files} + OvrSetBuf(MyBufSize); {Sets the overlay buffer size to MyBufSize, + since the default value is often too small} + ... + + use: + + ... + OvrInit('MYPROG.OVR'); {Opens the overlay files} + OvrSetBuf(MyBufSize); {Sets the overlay buffer size to MyBufSize, + since the default value is often too small} + OvrMovBufToUMB; {Tries to move the overlay buffer in upper + memory. It this is not possible, + nothing happens} + ... + + - That's all : OvrUMB will automatically free the UMB on exit. + + +You can also use the procedure OvrSetBufUMB(Size:longint) that allows +you to specify the size of the wanted buffer. This function can be +useful if you want to change the buffer size when it is in upper +memory. + +In order to help you to select the best block size, OvrUMB provides +the function umb_MaxAvail which returns the size of the biggest upper +memory block as a longint. + +In fact, OvrMovBufToUMB is logically equivalent to: + + if umb_MaxAvail>OvrGetBuf then OvrSetBufUMB(umb_MaxAvail); + +But of course it is more efficient and generate less code. + +These two procedure will do nothing if they detect any problem and +return an error value in OvrResult. I have tried to map the error +conditions to existing error codes. + +The procedures return ovrError when: + - the overlay file has not be opened (use OvrInit to open it) + - there are some overlays loaded (use OvrClearBuf to unload them) + - the heap is not empty + - the buffer has already been reallocated somewhere + - you tried to allocate a buffer smaller than the minimum allowed + (only with OvrSetBufUMB). + +The procedures return ovrNoMemory when: + - There is no upper memory manager running + - There is no big enough upper memory block to contain the overlay + buffer. + + + +Acknowledgments +컴컴컴컴컴컴컴컴 + +I would like to thank the testers without whom I could not have +written this unit, since I have no upper memory dispenser on my 286 :-( +In particular, my thanks go to Mike McWhinney (elja.inc@mixcom.com), +Herbert Zarb (hzarb@unimt.mt) and Jack Nomssi +(Nomssi@Physik.TU-Chemnitz.DE). + + + +Revision history +컴컴컴컴컴컴컴컴� + + version 1.0 (27/10/93) + First public version. + version 1.1 (21/07/94) + Added function umb_MaxAvail; + OvrMovBufToUMB now tries to allocate the biggest possible block. + version 1.2 (15/09/94) + Fixed bug that could make program fail in some cases where there + are no UMB available. + Changed the compilation directives of the test program so that + they compile on Timo Salmi's PC :-) + + + +Known Bugs and limitations +컴컴컴컴컴컴컴컴컴컴컴컴컴� + + - The system will crash if you try to call OvrSetBuf after reallocating + the overlay buffer in upper memory (however, I don't know why you + would want to do that...) + - There might be a compatibility problem with ExecWithSwap (from + TurboPower Software) + +If you use this unit (or even if you don't like it), please send me a +message at the address below. Any feedback that I can get is welcome. + + + +Contacting me +컴컴컴컴컴컴컴 + +Report bugs and send comments and suggestions to: + + Jean-Marc Lasgouttes + + e-mail Jean-Marc.Lasgouttes@inria.fr + + tel. (33) 1 39 63 56 40 + + postal address + 118, rue Marcadet + 75018 Paris + FRANCE diff --git a/SOURCE/UNUSED/OVRUMB.PAS b/SOURCE/UNUSED/OVRUMB.PAS new file mode 100644 index 0000000..90a2ba9 --- /dev/null +++ b/SOURCE/UNUSED/OVRUMB.PAS @@ -0,0 +1,224 @@ +unit OvrUMB; + + { Unit OvrUMB : Uses an upper memory block as overlay buffer } + { } + { Version 1.2 (15/09/94) } + { } + { Author : Jean-Marc Lasgouttes } + { } + { e-mail : Jean-Marc.Lasgouttes@inria.fr } + + +{$A+,F-,O-,S-} + + +interface + + uses Overlay; + + Procedure OvrSetBufUMB(Size:longint); + {Frees the current overlay buffer (which must be before the heap), + allocates a new buffer of Size bytes in upper memory and sets the + overlay manager to use this buffer. This is only possible if the + heap is empty and no overlays are currently loaded. This procedure + must not be used if the buffer has been already reallocated + somewhere + + #OvrMovBufToUMB# is an automatic version of this procedure that generate + more efficient code.} + + Procedure OvrMovBufToUMB; + {Same procedure as #OvrSetBufUMB#, except that the size of the UMB buffer + is the biggest available upper memory block. No rellocation occurs if + the biggest block is smaller than the current overlay buffer. This is the + most convenient procedure to use.} + + Function UMB_MaxAvail:longint; + {Returns the size of the biggest available upper memory block} + +implementation + + const OvrUMBSeg:word=0; {The Segment of the overlay buffer} + + var OldExitProc:Pointer; {The old ExitProc (surprise!)} + SaveMemStrat, {Temporary variables to save system state} + SaveUMBLink:word; + + Function ChangeMemStrat:boolean; assembler; + {Save the current memory allocation strategy and change it in order + to allocate upper memory} + asm + MOV AX, 5800h {Save memory allocation strategy} + INT 21h + MOV SaveMemStrat, AX + MOV AX, 5802h {Save UMB Link state} + INT 21h + MOV SaveUMBLink, AX + JC @@1 {If this function is not recognized} + { then DOS version <5 : Error} + MOV AX, 5801h {Set memory allocation strategy to} + MOV BX, 40h { use only upper memory} + INT 21h + MOV AX, 5803h {Add UMB to DOS memory chain} + MOV BX, 1 + INT 21h + JNC @@2 {Error: no UMB provider} +@@1:MOV AX, false {Return an error} + JMP @@3 +@@2:MOV AX, true {Return success} +@@3: + end; + + Procedure ResetMemStrat; assembler; + {Restore the memory allocation strategy as it was before the call to + ChangeMemStrat} + asm + MOV AX, 5801h {Reset the memory allocation strategy} + MOV BX, SaveMemStrat + INT 21h + MOV AX, 5803h {Reset the UMB link state} + MOV BX, SaveUMBLink + INT 21h + end; + + Procedure ReleaseUMB(UMBSeg:word); assembler; + {Releases the block corresponding to UMBSeg if UMBSeg<>0} + asm + MOV AX, UMBSeg {If the segment is zero, do nothing} + CMP AX, 0 + JZ @@1 + MOV AX, 5802h {Save UMB Link state} + INT 21h + MOV SaveUMBLink, AX + MOV AX, 5803h + MOV BX, 0 {Remove UMB from DOS memory chain} + INT 21h + MOV AH, 49h {Free block used by UMBSeg} + MOV ES, UMBSeg + INT 21h + MOV AX, 5803h {Reset UMB link state} + MOV BX, SaveUMBLink + INT 21h +@@1: + end; + + Procedure PrimSetBufUMB(Size:word); assembler; + {The basic procedure called by OvrSetBufUMB and OvrMovBufToUMB. Size + is given in paragraphs.} + asm + XOR AX, AX {Check for errors: } + CMP AX, OvrDOSHandle { Is the Overlay file opened?} + JZ @@3 + CMP AX, OvrLoadList { Are there some Overlays loaded?} + JNZ @@3 + MOV AX, OvrHeapEnd { Is the buffer already rellocated?} + CMP AX, WORD PTR HeapOrg+2 + JNZ @@3 + CMP AX, WORD PTR HeapPtr+2 { Is there something in the heap?} + JNZ @@3 + MOV AH, 48h {Allocate UMBSize segments of memory} + MOV BX, Size + INT 21h + JNC @@1 + MOV AX, ovrNoMemory {Not enough UMB} + JMP @@2 +@@1:MOV OvrUMBSeg, AX {Keep the segment in OvrUMBSeg} + MOV AX, OvrHeapOrg + MOV WORD PTR HeapOrg+2, AX {Seg(HeapOrg):=OvrHeapOrg} + MOV WORD PTR HeapPtr+2, AX {Seg(HeapPtr):=OvrHeapOrg} + MOV WORD PTR FreeList+2, AX {Seg(FreeList):=OvrHeapOrg} + XOR AX, AX + MOV WORD PTR HeapOrg, AX {Ofs(HeapOrg):=0} + MOV WORD PTR HeapPtr, AX {Ofs(HeapPtr):=0} + MOV WORD PTR FreeList, AX {Ofs(FreeList):=0} + MOV AX, OvrUMBSeg + MOV OvrHeapOrg, AX {OvrHeapOrg:=OvrUMBSeg } + MOV OvrHeapPtr, AX {OvrHeapPtr:=OvrUMBSeg } + ADD AX, Size + MOV OvrHeapEnd, AX {OvrHeapEnd:=OvrUMBSeg+Size} + MOV AX, ovrOK {Success} + JMP @@2 +@@3:MOV AX, ovrError +@@2:MOV OvrResult, AX {Put the result in OvrResult} + end; + + Function UMB_MaxAvail:longint; assembler; + asm + CALL ChangeMemStrat {Allow the use of upper memory} + CMP AX, false + JZ @@1 {if it not possible, return 0} + MOV AH, 48h {Try to allocate too much memory} + MOV BX, 0FFFFh + INT 21h {BX contains the size of the biggest} + MOV AX, BX { available block} + XOR DX, DX + SHL AX, 1 {Multiply by 16 and put the result} + RCL DX, 1 { in DX:AX} + SHL AX, 1 + RCL DX, 1 + SHL AX, 1 + RCL DX, 1 + SHL AX, 1 + RCL DX, 1 + JMP @@2 +@@1:XOR AX, AX + XOR DX, DX +@@2:PUSH AX + PUSH DX + CALL ResetMemStrat {Reset the memory allocation strategy} + POP DX + POP AX + end; + + Procedure OvrSetBufUMB(Size:longint); assembler; + asm + CALL ChangeMemStrat {Allow the use of upper memory} + CMP AX, false + JZ @@1 {If it is impossible, abort} + MOV AX, WORD PTR Size {Transform Size} + MOV DX, WORD PTR Size+2 { into a number of paragraphs} + MOV CL, 04h + SHR AX, CL + ROR DX, CL + AND DX, 0F000h + OR AX, DX { the result is in AX} + CMP AX, OvrHeapSize {If AX < OvrHeapSize --> Error} + JB @@1 + PUSH AX + CALL PrimSetBufUMB {Actually allocate and set the buffer} + JMP @@2 +@@1:MOV AX, ovrError {Report an Error} + MOV OvrResult, AX +@@2:CALL ResetMemStrat + end; + + Procedure OvrMovBufToUMB; assembler; + asm + CALL ChangeMemStrat {Allow the use of upper memory} + CMP AX, false + JZ @@1 {If it is impossible, abort} + MOV AH, 48h {Try to allocate too much memory} + MOV BX, 0FFFFh + INT 21h {BX contains the size of the biggest} + { available upper memory block} + MOV AX, OvrHeapEnd {Compute the size of the} + SUB AX, OvrHeapOrg { current Overlay buffer} + CMP AX, BX {Is the UMB bigger than the current buffer?} + JNB @@1 {If not, abort} + PUSH BX + CALL PrimSetBufUMB {Actually allocate and set the buffer} + JMP @@2 +@@1:MOV OvrResult, OvrNoMemory +@@2:CALL ResetMemStrat + end; + + Procedure OvrUMBExitProc; far; + begin + ExitProc:=OldExitProc; {Chain to the old exit handler} + ReleaseUMB(OvrUMBSeg); {Release the overlay buffer} + end; + +begin + OldExitProc:=ExitProc; + ExitProc:=@OvrUMBExitProc; {Release the UMB on exit} +end. diff --git a/SOURCE/UNUSED/OVRUMB.TPU b/SOURCE/UNUSED/OVRUMB.TPU new file mode 100644 index 0000000..25bca06 Binary files /dev/null and b/SOURCE/UNUSED/OVRUMB.TPU differ diff --git a/SOURCE/UNUSED/PCBOAR~1.TXT b/SOURCE/UNUSED/PCBOAR~1.TXT new file mode 100644 index 0000000..2289eae --- /dev/null +++ b/SOURCE/UNUSED/PCBOAR~1.TXT @@ -0,0 +1,57 @@ +FeatherNet PRO! v1.01 Documentation +Page 44.15 + +This is the exit to DOS information FeatherNet PRO! uses to maintain a caller's stats and the system's configuration upon exit to DOS when running a DOOR, during file transfers, or viewing some archives + +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? + +-------------------------------------------------------------------------------- diff --git a/SOURCE/UNUSED/PKUNZIP.EXE b/SOURCE/UNUSED/PKUNZIP.EXE new file mode 100644 index 0000000..3efd9f3 Binary files /dev/null and b/SOURCE/UNUSED/PKUNZIP.EXE differ diff --git a/SOURCE/UNUSED/PKZIP.EXE b/SOURCE/UNUSED/PKZIP.EXE new file mode 100644 index 0000000..1206250 Binary files /dev/null and b/SOURCE/UNUSED/PKZIP.EXE differ diff --git a/SOURCE/UNUSED/PRHELP.ASC b/SOURCE/UNUSED/PRHELP.ASC new file mode 100644 index 0000000..116168a --- /dev/null +++ b/SOURCE/UNUSED/PRHELP.ASC @@ -0,0 +1,14 @@ +|08컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +^1Press ^3ENTER ^1to get a blank line and press ^3/ +^1and one of the following command keys. + + ^1(^3^1)Continue message + ^1(^3A^1)bort message ^1(^3C^1)lear message + ^1(^3D^1)elete line ^1(^3F^1)ile attach + ^1(^3I^1)nsert line ^1(^3L^1)ist message + ^1(^3M^1)CI codes ^1(^3O^1)Color help + ^1(^3P^1)Replace string ^1(^3Q^1)uote message + ^1(^3R^1)Delete last line ^1(^3S^1)ave message + ^1(^3T^1)itle change ^1(^3U^1)pload message + ^1(^3Z^1)Replace line +|08컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�^1 diff --git a/SOURCE/UNUSED/RENEGADE.DAT b/SOURCE/UNUSED/RENEGADE.DAT new file mode 100644 index 0000000..54f307c Binary files /dev/null and b/SOURCE/UNUSED/RENEGADE.DAT differ diff --git a/SOURCE/UNUSED/RENEGADE.EXE b/SOURCE/UNUSED/RENEGADE.EXE new file mode 100644 index 0000000..d55b588 Binary files /dev/null and b/SOURCE/UNUSED/RENEGADE.EXE differ diff --git a/SOURCE/UNUSED/RENEGADE.LNG b/SOURCE/UNUSED/RENEGADE.LNG new file mode 100644 index 0000000..829e9ae --- /dev/null +++ b/SOURCE/UNUSED/RENEGADE.LNG @@ -0,0 +1,283 @@ +$Anonymous_String +^4[^0� Anonymous �^4] +$ + +$Echo_Char_For_Passwords +� +$ + +$Engage_Chat +%LF^0Your SysOp, ^5%SN^0, Is Here To Chat With You!%LF%LF +$ + +$End_Chat +%LF^0Welcome Back To ^9%BN. +$ + +$SysOp_Working +^4[^0� Please Wait �^4]@ +$ + +$Pause +^4[^0� Press any key �^4]@ +$ + +$Enter_Message_Line_One +%LF|03Press |11ENTER |03to get a |11BLANK LINE |03and press the following: +$ + +$Enter_Message_Line_Two +|03To Save: |11/S |03To Quote: |11/Q |03To Abort: |11/A |03Help: |11/? +$ + +$NewScan_Begin +%CL|09Scanning ... |01[|11%MB |01- |11%HM|01]@ +$ + +$NewScan_Done +@ +$ + +$Auto_Message_Title +^9AutoMessage Posted Here By: ^3 +$ + +$Auto_Message_Border_Characters +� +$ + +$SysOp_Shelling_To_DOS +|09[|15� Please Wait �|09]@ +$ + +$Read_Mail +|09Read Mail (|14?|09=|14Help|09): @ +$ + +$Paging_SysOp +^9I will now attempt to call ^0%SN ^9to his computer! +$ + +$Chat_Call +|09[|11(|15<|14*|15>|11)|09] @ +$ + + +$Bulletin_Prompt +^4Time Left [^3%TL^4] (^3?^4=^3Help^4) %LFBulletin Menu^2: @ +$ + +$Protocol_Prompt +%DFPROTLIST%^4Selection^2: @ +$ + +$List_Files +|03List Files - |11P |03to Pause +$ + +$Search_For_New_Files +|03Search for new files - +$ + +$Search_All_Dirs_For_File_Mask +|03Search All Directories For a File Name|01: |11 +$ + +$Search_For_Descriptions +|03Enter a Description to Search For|01: |01[|11No Wildcards!|01]|01: |11 +$ + +$Enter_The_String_To_Search_For +|03Press |01[|11ENTER|01] |03to abort.%LF|11 +$ + +$Download +^3Download - From File Area %FB. +$ + +$Upload +^3Upload - To File Area %FB^3. +$ + +$View_Interior_Files +%LF^9Enter the name of the archive(s) you would like to view: +%LF^4File name:^3 @ +$ + +$Insufficient_File_Credits +^5You have insufficient file points to download this. +$ + +$Ratio_Is_Unbalanced +^5Your upload/download ratio is too poor to download this. +$ + +$All_Files + +$ + +$File_Mask +|03Press |01[|11ENTER|01] |03For |11ALL |03Files |01: |11@ +$ + +$File_Added_To_Batch_Queue +^5File added to Batch Queue +$ + +$Batch_Download_Flagging +^9Enter filename(s) for addition to the batch queue. +$ + +$Read_Question_Prompt +^4[^5%MB^4]%LFBegin reading at [^51^4-^5%HM^4] (^5Q^4=^5Quit^4): @ +$ + +$System_Password_Prompt +%LF|03SysOp Password|01: |11@ +$ + +$Default_Message_To +|03Press |01[|11ENTER|01] |03for |11ALL|03:%LF +$ + +$Newscan_All +|01[= |11Global NewScan Beginning |01=] +$ + +$Newscan_Done +%CL|01[= |11Global NewScan Completed |01=] +$ + +$Chat_Reason +^9%UN^0, State your reason for a Chat Session. +$ + +$User_Defined_Question_One +Is ALL of your information REAL & CORRECT? (Yes/No) +$ + +$User_Defined_Question_Two +Do you run a Telnet BBS? (If so, type in address below) +$ + +$User_Defined_Question_Three +What BBS or Web Site did you hear about this BBS? (Specific Please) +$ + +$User_Defined_Question_Editor_One +Info Real +$ + +$User_Defined_Question_Editor_Two +Telnet BBS +$ + +$User_Defined_Question_Editor_Three +Reference +$ + +$Continue_Prompt +|10� |15Continue: [^5Y^0]es, [N]o, [C]ontinuous: @ +$ + +$Invisible_Login +Invisible Login: @ +$ + +$Cant_Email +|11Can't send mail to that user. +$ + +$Send_Email +%CL|03Press |01[|11ENTER|01] |03to |11ABORT|03: +$ + +$Sending_Mass_Mail_To +|01Sending Mail-Mass to: +$ + +$Sending_Mass_Mail_To_All_Users +|01Sending mass-mail to ALL USERS. +$ + +$No_Netmail +|01You are not allowed to send netmail. +$ + +$Netmail_Prompt +%LF|09Is this to be a netmail message? @ +$ + +$No_Mail_Waiting +%LF^5You have no mail waiting. +$ + +$Must_Read_Message +Sorry, you must read and reply to (or delete) your mail. +$ + +$Scan_For_New_Files + |11S|03can |11F|03or |11NEW |11F|03iles |11S|03ince |11MM|03/|11DD|03/|11YYYY|03: @ +$ + +$New_Scan_Char_File +� +$ + +$Bulletins_Prompt +^5There are new bulletins read them: @ +$ + +$Quick_Logon +Quick Logon: @ +$ + +$Message_Area_Select_Header +%CL7旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 +7�8 Num 7�9 Name 7�8 Num 7�9 Name 7� +7읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 +$ + + +$File_Area_Select_Header +%CL-旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 +-�. Num -�/ Name -�. Num -�/ Name -� +-읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 +$ + +$Receive_Email_Header +%CL뉅컴컴컫컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴커 +눛� Num 눛� Date/Time 눛� Sender 눛� Subject 눛 +눩컴컴컨컴컴컴컴컴컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴켸 +$ + +$Vote_List_Topics_Header +%CL|03旼컴컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +�|11|17 Num |03|16�|11|17Votes|03|16�|11|17 Choice |03|16� +읕컴컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Vote_Topic_Result_Header +|03旼컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +�|11|17 N |03|16�|11|17 % |03|16�|11|17 Choice |03|16� +읕컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$File_Area_Name_Header_No_Ratio +%CL 旼컫컴컴컴컴컴컴쩡컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � ## � File Name  � Size  � Description %FB{32  � + 읕컨컴컴컴컴컴컴좔컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$File_Area_Name_Header_Ratio +%CL 旼컫컴컴컴컴컴컴쩡컴쩡컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � ## � �File Name  �Pts � Size  � Description %FB{30  � + 읕컨컴컴컴컴컴컴좔컴좔컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Sysop_Chat_Help +^5/BYE^3: Hang up +^5/CLS^3: Clear the screen +^5/PAGE^3: Page the SysOp and User +^5/Q^3: Exit chat mode%LF +$ diff --git a/SOURCE/UNUSED/RENEGADE.OVR b/SOURCE/UNUSED/RENEGADE.OVR new file mode 100644 index 0000000..3553d39 Binary files /dev/null and b/SOURCE/UNUSED/RENEGADE.OVR differ diff --git a/SOURCE/UNUSED/RENEGADE.PIF b/SOURCE/UNUSED/RENEGADE.PIF new file mode 100644 index 0000000..953eab2 Binary files /dev/null and b/SOURCE/UNUSED/RENEGADE.PIF differ diff --git a/SOURCE/UNUSED/RENEGADE.TPH b/SOURCE/UNUSED/RENEGADE.TPH new file mode 100644 index 0000000..1f536ac Binary files /dev/null and b/SOURCE/UNUSED/RENEGADE.TPH differ diff --git a/SOURCE/UNUSED/RENEMAIL.EXE b/SOURCE/UNUSED/RENEMAIL.EXE new file mode 100644 index 0000000..4ac04fc Binary files /dev/null and b/SOURCE/UNUSED/RENEMAIL.EXE differ diff --git a/SOURCE/UNUSED/RENEMAIL.TPH b/SOURCE/UNUSED/RENEMAIL.TPH new file mode 100644 index 0000000..c39df7b Binary files /dev/null and b/SOURCE/UNUSED/RENEMAIL.TPH differ diff --git a/SOURCE/UNUSED/REUPDATE.PAS b/SOURCE/UNUSED/REUPDATE.PAS new file mode 100644 index 0000000..ae15277 --- /dev/null +++ b/SOURCE/UNUSED/REUPDATE.PAS @@ -0,0 +1 @@ +wcwc \ No newline at end of file diff --git a/SOURCE/UNUSED/RGAPI.PAS b/SOURCE/UNUSED/RGAPI.PAS new file mode 100644 index 0000000..67fb721 --- /dev/null +++ b/SOURCE/UNUSED/RGAPI.PAS @@ -0,0 +1,1335 @@ +UNIT RGApi; +{ Renegade Bulletin Board Software & Turbo Pascal/Borland Pascal API unit. } +{ This unit uses commonly used routines in building a utility to work } +{ with the Renegade BBS. } +{ } +{ Copyright 2003 - 2013 Chris Hoppman & T.J. McMillian } + +{ + + This unit will be gave out and will there will never be a charge to use + the API for Renegade. This unit may be changed as wished and alter'd to + suit the needs of the programmer that is using it. Feel free to summit + any changes or updates you might have for this unit to the Programmer of + the Renegade BBS for thanks and for future releases of this API from other + programmers + +} + +{ + Special thanks goes out to the orginal programmer (owner: see below) + Copyright 1994 By Jeff Fanjoy and MatrixSoft(tm). All Rights Reserved. + Upon tring to contact and not being able to contact the authors we + have decided to update and release new releases to the public ourselves. + If the perivous owers would like for us to stop please let us know and + we will comply with your wishes. We regeat that we can't keep the orginal + documention in as it's whole, because the lack of explaination of uses and + the way to use the source. + + Here is a excert of the orginal documentation. + "RGAPI is a PUBLIC DOMAIN product. That means that anybody is free to + modify and use this product at their own personal whim. I would greatly + appreciate it if myself and MatrixSoft(tm) were recognized in the + documentation if this unit is used in any way." +} + +{ + We would like to thank Swag for providing the RunTime Error Libary. + Also, would like to thank the unknow author of the unit and if they + wish to come forward and request for us to stop using the source we + will respect the wishes of the author. + + Thank-you swag again for providing the Time Slice Routines. +} + +INTERFACE + +USES CRT, {Turbo Pascal's standard CRT unit } + DOS; {Turbo Pascal's standard DOS unit } + +{$I RECORDS.PAS} + + +{*** UNIX TIME CONVERSIONS *********************************************} + +FUNCTION LZero(W: Word) : String; +FUNCTION GetTimeZone : ShortInt; +FUNCTION IsLeapYear(Source : Word) : Boolean; +FUNCTION Norm2Unix(Y, M, D, H, Min, S : Word) : LongInt; +PROCEDURE Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word); +FUNCTION TodayInUnix : LongInt; +FUNCTION AddSlash(Str: String): String; + +{*** RENEGADE COLOR CODE HANDLING **************************************} + +FUNCTION StripColor ( Var InStr ): String; + +{*** MISC ROUTINES *****************************************************} +function IntToStr ( IntIn: LongInt ) : String; +function StrToInt ( InStr: String ) : LongInt; +function DirExists ( InDir: DirStr ) : Boolean; +function FileExists ( InFile: String ) : Boolean; +procedure pipe ( InStr : String ); +procedure pipexy ( x,y : byte; instr : string ); +procedure HandleError ( ErrStr : String; ProgHalt : Boolean; StopWith : Byte ); +function takeoutblanks ( instr : string ) : string; +function detectOS : string; +procedure timeslice; +PROCEDURE FindRGDir; +{ +function InputStrxy ( x,y: byte ) : string; +function InputIntxy ( x,y: byte ) : integer; + + +{*** RENEGADE.DAT ******************************************************} + +PROCEDURE OpenRenegadeDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromRenegadeDat ( Var RenegadeDatIn: GeneralRecordType; Var Err: Byte ); +PROCEDURE WriteToRenegadeDat ( Var RenegadeDatIn: GeneralRecordType; Var Err: Byte ); +PROCEDURE CloseRenegadeDat; + +{*** CONVERENC.DAT *****************************************************} + +PROCEDURE OpenConferencDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromConferencDat ( Var ConferencDatIn: ConferenceRecordType ); +PROCEDURE WriteToConferencDat ( Var ConferencDatIn: ConferenceRecordType ); +PROCEDURE CloseConferencDat; + +{*** SCHEME.DAT ********************************************************} + +PROCEDURE OpenSchemeDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromSchemeDat ( Var SchemeDatIn: SchemeRec ); +PROCEDURE WriteToSchemeDat ( Var SchemeDatIn: SchemeRec ); +PROCEDURE CloseSchemeDat; + +{*** MBASES.DAT ********************************************************} + +PROCEDURE OpenMBasesDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromMBasesDat ( Var MBasesDatIn: MessageAreaRecordType; Rec: Integer ); +PROCEDURE WriteToMBasesDat ( Var MBasesDatIn: MessageAreaRecordType; Rec: Integer ); +PROCEDURE CloseMBasesDat; + +{*** *.HDR *************************************************************} + +PROCEDURE OpenHdr ( FileName: String; Path: String; Var Err: Byte ); +PROCEDURE ReadFromHdr ( Var HdrIn: MHeaderRec; Rec: Integer ); +PROCEDURE WriteToHdr ( Var HdrIn: MHeaderRec; Rec: Integer ); +PROCEDURE CloseHdr; + +{*** *.DAT *************************************************************} + +PROCEDURE OpenDat ( FileName: String; Path: String; Var Err: Byte ); +PROCEDURE CloseDat; + +{*** USERS.DAT *********************************************************} + +PROCEDURE OpenUsersDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromUsersDat ( Var UsersDatIn: UserRecordType; Rec: Integer ); +PROCEDURE WriteToUsersDat ( Var UsersDatIn: UserRecordType; Rec: Integer ); +PROCEDURE CloseUsersDat; + +{*** USERS.IDX *********************************************************} +PROCEDURE OpenUsersIdx(Path: String; VAR Err: Byte); +PROCEDURE ReadFromUsersIdx(VAR UsersIdxIn: UserIdxRec; Rec: Integer); +PROCEDURE WriteToUsersIdx(VAR UsersIdxIn: UserIdxRec; Rec: Integer); +PROCEDURE CloseUsersIdx; + +{*** HISTORY.DAT *******************************************************} + +PROCEDURE OpenHistoryDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromHistoryDat ( Var HistoryDatIn: HistoryRecordType; Rec: Integer ); +PROCEDURE WriteToHistoryDat ( Var HistoryDatIn: HistoryRecordType; Rec: Integer ); +PROCEDURE CloseHistoryDat; + +{*** VOTING.DAT ********************************************************} + +PROCEDURE OpenVotingDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromVotingDat ( Var VotingDatIn: VotingRecordType; Rec: Integer ); +PROCEDURE WriteToVotingDat ( Var VotingDatIn: VotingRecordType; Rec: Integer ); +PROCEDURE CloseVotingDat; + +{*** FBASES.DAT ********************************************************} + +PROCEDURE OpenFBasesDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromFBasesDat ( Var FBasesDatIn: FileAreaRecordType; Rec: Integer ); +PROCEDURE WriteToFBasesDat ( Var FBasesDatIn: FileAreaRecordType; Rec: Integer ); +PROCEDURE CloseFBasesDat; + +{*** *.DIR *************************************************************} + +PROCEDURE OpenDir ( FileName: String; Path: String; Var Err: Byte ); +PROCEDURE ReadFromDir ( Var DirIn: FileInfoRecordType; Rec: Integer ); +PROCEDURE WriteToDir ( Var DirIn: FileInfoRecordType; Rec: Integer ); +PROCEDURE CloseDir; + +{*** FILE DATE CONVERSION FROM STRING FORMAT ***************************} + +PROCEDURE StrDate2FileDate ( S: String; Var Y: Word; Var M: Word; Var D: Word ); + +{*** EXTENDED.DAT ******************************************************} + +PROCEDURE OpenExtendedDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromExtendedDat ( Var ExtendedDatIn: VerbRec; Rec: LongInt ); +PROCEDURE WriteToExtendedDat ( Var ExtendedDatIn: VerbRec; Rec: LongInt ); +PROCEDURE CloseExtendedDat; + +{*** LASTON.DAT ********************************************************} + +PROCEDURE OpenLastOnDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromLastOnDat ( Var LastOnDatIn: LastCallerRec; Rec: Integer ); +PROCEDURE WriteToLastOnDat ( Var LastOnDatIn: LastCallerRec; Rec: Integer ); +PROCEDURE CloseLastOnDat; + +{*** EVENTS.DAT ********************************************************} + +PROCEDURE OpenEventsDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromEventsDat ( Var EventsDatIn: EventRec; Rec: Integer ); +PROCEDURE WriteToEventsDat ( Var EventsDatIn: EventRec; Rec: Integer ); +PROCEDURE CloseEventsDat; + +{*** PROTOCOL.DAT ******************************************************} + +PROCEDURE OpenProtocolDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromProtocolDat ( Var ProtocolDatIn: ProtRec; Rec: Integer ); +PROCEDURE WriteToProtocolDat ( Var ProtocolDatIn: ProtRec; Rec: Integer ); +PROCEDURE CloseProtocolDat; + +{*** MULTNODE.DAT ******************************************************} + +PROCEDURE OpenMultNodeDat ( Path: String; Var Err: Byte ); +PROCEDURE ReadFromMultNodeDat ( Var MultNodeDatIn: NodeRec; Rec: Integer ); +PROCEDURE WriteToMultNodeDat ( Var MultNodeDatIn: NodeRec; Rec: Integer ); +PROCEDURE CloseMultNodeDat; + +{*** *.SCN *************************************************************} + +PROCEDURE OpenScn ( FileName: String; Path: String; Var Err: Byte ); +PROCEDURE ReadFromScn ( Var ScnIn: ScanRec; Rec: Integer ); +PROCEDURE WriteToScn ( Var ScnIn: ScanRec; Rec: Integer ); +PROCEDURE CloseScn; + +{***********************************************************************} + +CONST + RGApiVer = '12-27.3 - DOS'; + RGApiAuthor = 'Bluewolf'; + MonthArray: Array[1..12] OF String[3] = + ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct', + 'Nov','Dec'); + DowArray: Array[0..6] OF String[3] = + ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); + +{*** USED BY UNIX-TIME CONVERTING PROCEDURES ***************************} + + DaysPerMonth : + Array[1..12] of ShortInt = + (031,028,031,030,031,030,031,031,030,031,030,031); + DaysPerYear : + Array[1..12] of Integer = + (031,059,090,120,151,181,212,243,273,304,334,365); + DaysPerLeapYear : + Array[1..12] of Integer = + (031,060,091,121,152,182,213,244,274,305,335,366); + SecsPerYear : LongInt = 31536000; + SecsPerLeapYear : LongInt = 31622400; + SecsPerDay : LongInt = 86400; + SecsPerHour : Integer = 3600; + SecsPerMinute : ShortInt = 60; + +(***************************************************************************) + +type + TaskRec = record + OS : Word; + Version : Word; {writeln('Version ',hi(Version), '.', lo(Version) );} + Delay : Word; + end; + + +const + Task : TaskRec = ( + OS : 0; + Version : 0; + Delay : 100 + ); + +Var + OldExit : Pointer; + SchemeDat : FILE of SchemeRec; + MBasesDat : FILE of MessageAreaRecordType; + RenegadeDat : FILE Of GeneralRecordType; + StringDat : FILE OF FStringRec; + ConferencDat : FILE OF ConfRec; + UsersDat : FILE OF UserRecordType; + Hdr : FILE of MHeaderRec; + HistoryDat : FILE OF HistoryRec; + Dat : FILE; + VotingDat : FILE OF VotingR; + FBasesDat : FILE OF FileAreaRecordType; + Dir : FILE OF UlfRec; + ExtendedDat : FILE OF VerbRec; + LastOnDat : FILE OF LastCallerRec; + EventsDat : FILE OF EventRec; + ProtocolDat : FILE OF ProtRec; + MultNodeDat : FILE OF NodeRec; + Scn : FILE OF ScanRec; + UsersIdx : FILE OF UserIdxRec; + + RGDir : String; + CurrDir : String; + OSVer : String; + +IMPLEMENTATION + +Procedure RunTimeExitProc;Far; +var Message : string; +begin + if ErrorAddr<>Nil then { If error occurs } + begin + case ExitCode of { Pick the appropriate message } + 2:Message:='File not found '; + 3:Message:='Path not found '; + 4:Message:='Too many open files '; + 5:Message:='File access denied '; + 6:Message:='Invalid file handle '; + 8:Message:='Insufficient memory '; + 12:Message:='Invalid file access code '; + 15:Message:='Invalid drive number '; + 16:Message:='Cannot remove current directory '; + 17:Message:='Cannot rename across drives '; + 100:Message:='Disk read error '; + 100:Message:='Disk write error '; + 102:Message:='File not assigned '; + 103:Message:='File not open '; + 104:Message:='File not open for input '; + 105:Message:='File not open for output '; + 106:Message:='Invalid numeric format '; + 150:Message:='Disk is write-protected '; + 151:Message:='Unknown unit '; + 152:Message:='Drive not ready '; + 153:Message:='Unknown command '; + 154:Message:='CRC error in data '; + 155:Message:='Bad drive request structure length '; + 156:Message:='Disk seek error '; + 157:Message:='Unknown media type '; + 158:Message:='Sector not found '; + 159:Message:='Printer out of paper '; + 160:Message:='Device write fault '; + 161:Message:='Device read fault '; + 162:Message:='Hardware failure '; + 200:Message:='Division by zero '; + 201:Message:='Range check error '; + 202:Message:='Stack overflow error '; + 203:Message:='Heap overflow error '; + 204:Message:='Invalid pointer operation '; + 205:Message:='Floating-point overflow '; + 206:Message:='Floating-point underflow '; + 207:Message:='Invalid floating-point operation '; + 208:Message:='Overlay manager not installed '; + 209:Message:='Overlay file read error '; + 210:Message:='Object not initialized '; + 211:Message:='Call to abstract method '; + 212:Message:='Stream register error '; + 213:Message:='Collection index out of range '; + 214:Message:='Collection overflow error '; + end; + writeln; + writeln('Error : ',ExitCode,' - ',Message); + writeln; + + ErrorAddr:=nil; + ExitCode:=1; { End program with errorlevel 1 } + end; + ExitProc:=OldExit; { Restore the original exit procedure } +end; + +FUNCTION AddSlash(Str: String): String; +BEGIN + IF Str <> '' THEN + BEGIN + IF Str[Length(Str)] <> '\' THEN AddSlash := Str + '\' + ELSE AddSlash := Str; + END + ELSE AddSlash := ''; +END; + + +FUNCTION LZero( W: Word ) : String; +Var S1: String; +BEGIN + Str(W:0,S1); + IF LENGTH(S1) = 1 THEN S1 := '0' + S1; + LZero := S1; +END; + + +FUNCTION GetTimeZone : ShortInt; +Var + Environment : String; + Index : Integer; +BEGIN + GetTimeZone := 0; {Assume UTC} + Environment := GetEnv('TZ'); {Grab TZ string} + For Index := 1 TO Length(Environment) DO + Environment[Index] := UpCase(Environment[Index]); + IF Environment = 'EST05' THEN GetTimeZone := -05; {USA EASTERN} + IF Environment = 'EST05EDT' THEN GetTimeZone := -06; + IF Environment = 'CST06' THEN GetTimeZone := -06; {USA CENTRAL} + IF Environment = 'CST06CDT' THEN GetTimeZone := -07; + IF Environment = 'MST07' THEN GetTimeZone := -07; {USA MOUNTAIN} + IF Environment = 'MST07MDT' THEN GetTimeZone := -08; + IF Environment = 'PST08' THEN GetTimeZone := -08; + IF Environment = 'PST08PDT' THEN GetTimeZone := -09; + IF Environment = 'YST09' THEN GetTimeZone := -09; + IF Environment = 'AST10' THEN GetTimeZone := -10; + IF Environment = 'BST11' THEN GetTimeZone := -11; + IF Environment = 'CET-1' THEN GetTimeZone := 01; + IF Environment = 'CET-01' THEN GetTimeZone := 01; + IF Environment = 'EST-10' THEN GetTimeZone := 10; + IF Environment = 'WST-8' THEN GetTimeZone := 08; {Perth, W. Aust.} + IF Environment = 'WST-08' THEN GetTimeZone := 08; +END; + +FUNCTION IsLeapYear( Source : Word ) : Boolean; +BEGIN + IF (Source MOD 400 = 0) OR ((Source Mod 4 = 0) AND + (Source MOD 100 <> 0)) THEN + IsLeapYear := TRUE + ELSE + IsLeapYear := FALSE; +END; + + +FUNCTION Norm2Unix( Y,M,D,H,Min,S : Word ) : LongInt; +Var + UnixDate : LongInt; + Index : Word; +BEGIN + UnixDate := 0; {initialize} + Inc(UnixDate,S); {add seconds} + Inc(UnixDate,(SecsPerMinute * Min)); {add minutes} + Inc(UnixDate,(SecsPerHour * H)); {add hours} + (*************************************************************************) + (* If UTC = 0, and local time is -06 hours of UTC, then *) + (* UTC := UTC - (-06 * SecsPerHour) *) + (* Remember that a negative # minus a negative # yields a positive value *) + (*************************************************************************) + UnixDate := UnixDate - (GetTimeZone * SecsPerHour); + + IF D > 1 THEN + Inc(UnixDate,(SecsPerDay * (D-1))); + + IF IsLeapYear(Y) THEN + DaysPerMonth[02] := 29 + ELSE + DaysPerMonth[02] := 28; + + Index := 1; + IF M > 1 THEN FOR Index := 1 TO (M-1) DO + Inc(UnixDate,(DaysPerMonth[Index] * SecsPerDay)); + + WHILE Y > 1970 DO + BEGIN + IF IsLeapYear((Y-1)) THEN + Inc(UnixDate,SecsPerLeapYear) + ELSE + Inc(UnixDate,SecsPerYear); + Dec(Y,1); + END; + + Norm2Unix := UnixDate; +END; + +PROCEDURE Unix2Norm( Date : LongInt; Var Y, M, D, H, Min, S : Word ); +Var + LocalDate : LongInt; + Done : Boolean; + X : ShortInt; + TotDays : Integer; +BEGIN + Y := 1970; + M := 1; + D := 1; + H := 0; + Min := 0; + S := 0; + LocalDate := Date + (GetTimeZone * SecsPerHour); + Done := FALSE; + WHILE NOT (Done) DO + BEGIN + IF LocalDate >= SecsPerYear THEN + BEGIN + Inc(Y,1); + Dec(LocalDate,SecsPerYear); + END + ELSE + Done := TRUE; + IF (IsLeapYear(Y+1)) AND (LocalDate >= SecsPerLeapYear) AND + (NOT (Done)) THEN + BEGIN + Inc(Y,1); + Dec(LocalDate,SecsPerLeapYear); + END; + END; + M := 1; + D := 1; + Done := FALSE; + TotDays := LocalDate DIV SecsPerDay; + IF IsLeapYear(Y) THEN + BEGIN + DaysPerMonth[02] := 29; + X := 1; + REPEAT + IF (TotDays <= DaysPerLeapYear[x]) THEN + BEGIN + M := X; + Done := TRUE; + Dec(LocalDate,(TotDays * SecsPerDay)); + D := DaysPerMonth[M]-(DaysPerLeapYear[M]-TotDays) + 1; + END + ELSE + Done := FALSE; + Inc(X); + UNTIL (Done) or (X > 12); + END + ELSE + BEGIN + DaysPerMonth[02] := 28; + X := 1; + REPEAT + IF (TotDays <= DaysPerYear[x]) THEN + BEGIN + M := X; + Done := TRUE; + Dec(LocalDate,(TotDays * SecsPerDay)); + D := DaysPerMonth[M]-(DaysPerYear[M]-TotDays) + 1; + END + ELSE + Done := FALSE; + Inc(X); + UNTIL Done = TRUE or (X > 12); + END; + H := LocalDate DIV SecsPerHour; + Dec(LocalDate,(H * SecsPerHour)); + Min := LocalDate DIV SecsPerMinute; + Dec(LocalDate,(Min * SecsPerMinute)); + S := LocalDate; +END; + +FUNCTION TodayInUnix : LongInt; +Var + Year, Month, Day, DayOfWeek: Word; + Hour, Minute, Second, Sec100: Word; +BEGIN + GetDate(Year, Month, Day, DayOfWeek); + GetTime(Hour, Minute, Second, Sec100); + TodayInUnix := Norm2Unix(Year,Month,Day,Hour,Minute,Second); +END; + +FUNCTION StripColor( Var InStr ):String; +Var + Temp: String; + S: String Absolute InStr; + I, + Len: Integer; +BEGIN + Len := Length(S); + I := 1; + Temp := ''; + REPEAT + IF (S[I] = '|') THEN Inc(I,3) + ELSE IF (S[I] = '^') THEN Inc(I,2) + ELSE + BEGIN + Temp := Temp + S[I]; + Inc(I); + END; + UNTIL (I > Len); + StripColor := Temp; +END; + +function IntToStr( intin : longint) : string; +var s : string; +begin + s:=''; + Str(intin, S); + IntToStr := s; +end; + +function StrToInt( InStr: String ) : LongInt; +var i : longint; + code : integer; +begin + Val(InStr, I, Code); + StrToInt := I; +end; + + + +FUNCTION DirExists(inDir : dirstr) : boolean; + var + woFattr : word; + fiTemp : file; + begin + assign(fiTemp, (inDir + '.')); + getfattr(fiTemp, woFattr); + if (doserror <> 0) then DirExists := false + else DirExists := ((woFattr and directory) <> 0) + end; + + +function FileExists( inFile : string) : Boolean; + var + woFattr : word; + fiTemp : file; + begin + assign(fiTemp,inFile); + getfattr(fiTemp, woFattr); + if (doserror <> 0) then FileExists := false + else FileExists := ((woFattr and Archive) <> 0) + end; + +PROCEDURE Pipe(InStr : String ); +Var + S : String; + I, Err : Integer; + Col : byte; +BEGIN + S := InStr; + I := 1; + REPEAT + IF (S[I] = '|') THEN + BEGIN + Val(COPY(S,I+1,2),Col,Err); + IF (Err = 0) AND (Col IN [0..22]) THEN + IF Col IN [0..15] THEN TextColor(Col) + ELSE IF Col IN [16..22] THEN TextBackground(Col - 16); + Inc(I,3); + END + ELSE BEGIN + Write(S[I]); + Inc(I); + END; + UNTIL (I > Length(S)); + Writeln; +END; + +PROCEDURE Pipexy(x,y : byte; InStr : String ); +BEGIN + gotoxy(x,y); + pipe(instr); +END; + +{ + ErrStr : String to display when a error occurs + ProgHalt : 0: No, display the string and keep running + 1: Yes, stop the application + HaltWith : if you want to halt the application you can + provide a RunTime Error. + } +Procedure HandleError(ErrStr : String; ProgHalt : Boolean; StopWith : Byte ); + + begin + pipe('|11� |12ERROR |11� |14: |06#'++IntToStr(StopWith)+'|07'); + pipe(ErrStr+'|07'); + if ProgHalt then Halt(StopWith); + end; + +function takeoutblanks( instr : string) : string; +var t : string; + a : byte; +begin + t := ''; + for a := 1 to length(instr) do + if instr[a] <> ' ' then t := t + instr[a]; + + takeoutblanks := t; +end; + +function detectOS : string; + Procedure InitMulti; Assembler; + Asm + mov Task.OS, 0 + mov Task.Version, 0 + mov Ah, 30h + mov Al, 01h + int 21h + cmp Al, 20 + je @OS2 + + mov Ax, 160Ah + int 2Fh + cmp Ax, 0 + je @Windows + + mov Ax, 1022h + mov Bx, 0000h + int 15h + cmp Bx, 0 + jne @DESQview + + + mov Ah, 2Bh + mov Al, 01h + mov Cx, 4445h + mov Dx, 5351h + int 21h + cmp Al, $FF + jne @TopView + + jmp @Fin + + @Windows: + Mov Task.OS, 1 + Mov Task.Version, BX + jmp @Fin + + @OS2: + Mov Task.OS, 2 + Mov Bh, Ah + Xor Ah, Ah + Mov Cl, 10 + Div Cl + Mov Ah, Bh + Xchg Ah, Al + Mov Task.Version, AX + jmp @Fin + + @DESQview: + mov Task.OS, 3 + jmp @Fin + + @TopView: + mov Task.OS, 4 + + @Fin: + End; +begin + InitMulti; + case Task.OS of + 0 : detectOS := 'No MultiTasking'; + 1 : detectOS := 'Windows'; + 2 : detectOS := 'OS/2'; + 3 : detectOS := 'DESQview'; + 4 : detectOS := 'TopView'; + end; +end; +procedure TimeSlice; +var Regs : Registers; + Procedure TimeSliceASM; Assembler; + Asm + cmp Task.OS, 0 + je @Fin + cmp Task.OS, 1 + je @Win_OS2 + cmp Task.OS, 2 + je @Win_OS2 + @DV_TV: + mov Ax, 1000h + int 15h + jmp @Fin + @Win_OS2: + mov Ax, 1680h + int 2Fh + @Fin: + End; + +begin + if Task.OS <> 0 then TimeSliceASM + else with Regs do Intr($28,Regs); +end; + +PROCEDURE FindRGDir; +BEGIN + GetDir(0,CurrDir); + if paramstr(1) <> '' then RGDir := ParamStr(1); + if (paramstr(1) = '') or (RGDir[2] <> ':') then RGDir := GetEnv('RENEGADE'); + if RGDir = '' then RGDir := GetEnv('RG'); + if RGDir = '' then RGDir := GetEnv('BBS'); + { work on more ..fexpand.. + if RGDir = '' then RGDir := FSearch('RENEGADE.DAT',GetEnv('PATH')) + else if RGDir = '' then RGDir := FSearch('RENEGADE.EXE',GetEnv('PATH')); + if RGDir = '' then RGDir := FSearch('RENEGADE.DAT',CurrDir) + else if RGDir = '' then RGDir := FSearch('RENEGADE.EXE',CurrDir); + } + if (RGDir <> '') and (RGDir[length(RGDir)] <> '\') then RGDir := RGDir + '\'; + if (RGDir = '') or (not DirExists(RGDir)) then begin handleerror('� Renegade.dat not found..',True,15); halt; end; +END; + +PROCEDURE OpenRenegadeDat( Path: String; Var Err: Byte ); +BEGIN + If Path = '' then begin + FindRGDir; + if RGDir <> '' then Path := RGDir; + end; + Assign(RenegadeDat,AddSlash(Path) + 'RENEGADE.DAT'); + {$I-} Reset(RenegadeDat); {$I+} + Err := IoResult; +END; + +PROCEDURE ReadFromRenegadeDat( Var RenegadeDatIn: GeneralRecordType; Var Err: Byte ); +BEGIN + {$I-}Seek(RenegadeDat,0);{$I+} + if ioresult = 0 then Read(RenegadeDat,RenegadeDatIn); + Err := IOResult; +END; + +PROCEDURE WriteToRenegadeDat(Var RenegadeDatIn: GeneralRecordType; Var Err: Byte ); +BEGIN + {$I-}Seek(RenegadeDat,0);{$I+} + if ioresult = 0 then Write(RenegadeDat,RenegadeDatIn); + Err := IOResult; +END; + +PROCEDURE CloseRenegadeDat; +BEGIN + Close(RenegadeDat); +END; + +PROCEDURE OpenConferencDat(Path: String; Var Err: Byte); +BEGIN + Assign(ConferencDat,AddSlash(Path) + 'CONFERENC.DAT'); + {$I-} Reset(ConferencDat); {$I+} + Err := IoResult; +END; + +PROCEDURE ReadFromConferencDat(Var ConferencDatIn: ConfRec); +BEGIN + Seek(ConferencDat,0); + Read(ConferencDat,ConferencDatIn); +END; + +PROCEDURE WriteToConferencDat(Var ConferencDatIn: ConfRec); +BEGIN + Seek(ConferencDat,0); + Read(ConferencDat,ConferencDatIn); +END; + +PROCEDURE CloseConferencDat; +BEGIN + Close(ConferencDat); +END; + +PROCEDURE OpenSchemeDat(Path: String; Var Err: Byte); + +BEGIN + Assign(SchemeDat,AddSlash(Path) + 'SCHEME.DAT'); + {$I-} Reset(SchemeDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromSchemeDat(Var SchemeDatIn: SchemeRec); + +BEGIN + Seek(SchemeDat,0); + Read(SchemeDat,SchemeDatIn); +END; + + +PROCEDURE WriteToSchemeDat(Var SchemeDatIn: SchemeRec); + +BEGIN + Seek(SchemeDat,0); + Read(SchemeDat,SchemeDatIn); +END; + + +PROCEDURE CloseSchemeDat; + +BEGIN + Close(SchemeDat); +END; + + +PROCEDURE OpenMBasesDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(MBasesDat,AddSlash(Path) + 'MBASES.DAT'); + {$I-} Reset(MBasesDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromMBasesDat(Var MBasesDatIn: MessageAreaRecordType; + Rec: Integer); + +BEGIN + Seek(MBasesDat,Rec); + Read(MBasesDat,MBasesDatIn); +END; + + +PROCEDURE WriteToMBasesDat(Var MBasesDatIn: MessageAreaRecordType; + Rec: Integer); + +BEGIN + Seek(MBasesDat,Rec); + Write(MBasesDat,MBasesDatIn); +END; + + +PROCEDURE CloseMBasesDat; + +BEGIN + Close(MBasesDat); +END; + + +PROCEDURE OpenHdr(FileName: String; + Path: String; + Var Err: Byte); + +BEGIN + Assign(Hdr,AddSlash(Path) + FileName); + {$I-} Reset(Hdr); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromHdr(Var HdrIn: MHeaderRec; + Rec: Integer); + +BEGIN + Seek(Hdr,Rec); + Read(Hdr,HdrIn); +END; + + +PROCEDURE WriteToHdr(Var HdrIn: MHeaderRec; + Rec: Integer); + +BEGIN + Seek(Hdr,Rec); + Write(Hdr,HdrIn); +END; + + +PROCEDURE CloseHdr; + +BEGIN + Close(Hdr); +END; + + +PROCEDURE OpenDat(FileName: String; + Path: String; + Var Err: Byte); + +BEGIN + Assign(Dat,AddSlash(Path) + FileName); + {$I-} Reset(Dat); {$I+} + Err := IoResult; +END; + + +PROCEDURE CloseDat; + +BEGIN + Close(Dat); +END; + + +PROCEDURE OpenUsersDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(UsersDat,AddSlash(Path) + 'USERS.DAT'); + {$I-} Reset(UsersDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromUsersDat(Var UsersDatIn: UserRecordType; + Rec: Integer); + +BEGIN + Seek(UsersDat,Rec); + Read(UsersDat,UsersDatIn); +END; + + +PROCEDURE WriteToUsersDat(Var UsersDatIn: UserRecordType; + Rec: Integer); + +BEGIN + Seek(UsersDat,Rec); + Read(UsersDat,UsersDatIn); +END; + + +PROCEDURE CloseUsersDat; + +BEGIN + Close(UsersDat); +END; + +{*** USERS.IDX *********************************************************} +PROCEDURE OpenUsersIdx(Path: String; VAR Err: Byte); +BEGIN + Assign(UsersIdx,AddSlash(Path) + 'users.idx'); + {$I-} Reset(UsersIdx); {$I+} + Err := IoResult; +END; +PROCEDURE ReadFromUsersIdx(VAR UsersIdxIn: UserIdxRec; Rec: Integer); +BEGIN + Seek(UsersIdx,Rec); + Read(UsersIdx,UsersIdxIn); +END; +PROCEDURE WriteToUsersIdx(VAR UsersIdxIn: UserIdxRec; Rec: Integer); +BEGIN + Seek(UsersIdx,Rec); + Write(UsersIdx,UsersIdxIn); +END; +PROCEDURE CloseUsersIdx; +BEGIN + Close(UsersIdx); +END; + + + + +PROCEDURE OpenHistoryDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(HistoryDat,AddSlash(Path) + 'HISTORY.DAT'); + {$I-} Reset(HistoryDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromHistoryDat(Var HistoryDatIn: HistoryRec; + Rec: Integer); + +BEGIN + Seek(HistoryDat,Rec); + Read(HistoryDat,HistoryDatIn); +END; + + +PROCEDURE WriteToHistoryDat(Var HistoryDatIn: HistoryRec; + Rec: Integer); + +BEGIN + Seek(HistoryDat,Rec); + Write(HistoryDat,HistoryDatIn); +END; + + +PROCEDURE CloseHistoryDat; + +BEGIN + Close(HistoryDat); +END; + + +PROCEDURE OpenVotingDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(VotingDat,AddSlash(Path) + 'VOTING.DAT'); + {$I-} Reset(VotingDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromVotingDat(Var VotingDatIn: VotingR; + Rec: Integer); + +BEGIN + Seek(VotingDat,Rec); + Read(VotingDat,VotingDatIn); +END; + + +PROCEDURE WriteToVotingDat(Var VotingDatIn: VotingR; + Rec: Integer); + +BEGIN + Seek(VotingDat,Rec); + Read(VotingDat,VotingDatIn); +END; + + +PROCEDURE CloseVotingDat; + +BEGIN + Close(VotingDat); +END; + +(* FBASES.DAT *) +PROCEDURE OpenFBasesDat(Path: String; Var Err: Byte); +BEGIN + Assign(FBasesDat,AddSlash(Path) + 'FBASES.DAT'); + {$I-} Reset(FBasesDat); {$I+} + Err := IoResult; +END; + +PROCEDURE ReadFromFBasesDat(Var FBasesDatIn: FileAreaRecordType; Rec: Integer); +BEGIN + Seek(FBasesDat,Rec); + Read(FBasesDat,FBasesDatIn); +END; + +PROCEDURE WriteToFBasesDat(Var FBasesDatIn: FileAreaRecordType; Rec: Integer); +BEGIN + Seek(FBasesDat,Rec); + Write(FBasesDat,FBasesDatIn); +END; + +PROCEDURE CloseFBasesDat; + +BEGIN + Close(FBasesDat); +END; + + +PROCEDURE OpenDir(FileName: String; + Path: String; + Var Err: Byte); + +BEGIN + Assign(Dir,AddSlash(Path) + FileName); + {$I-} Reset(Dir); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromDir (Var DirIn: UlfRec; Rec: Integer ); +BEGIN + Seek(Dir,Rec); + Read(Dir,DirIn); +END; + +PROCEDURE WriteToDir ( Var DirIn: UlfRec; Rec: Integer ); +BEGIN + Seek(Dir,Rec); + Write(Dir,DirIn); +END; + + +PROCEDURE CloseDir; +BEGIN + Close(Dir); +END; + + +PROCEDURE StrDate2FileDate ( S: String; Var Y: Word; Var M: Word; Var D: Word ); +Var Err: Integer; + +BEGIN + VAL(COPY(S,1,2),D,Err); + VAL(COPY(S,4,2),M,Err); + VAL(COPY(S,7,4),Y,Err); +END; + + +PROCEDURE OpenExtendedDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(ExtendedDat,AddSlash(Path) + 'EXTENDED.DAT'); + {$I-} Reset(ExtendedDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromExtendedDat(Var ExtendedDatIn: VerbRec; + Rec: LongInt); + +BEGIN + Seek(ExtendedDat,Rec); + Read(ExtendedDat,ExtendedDatIn); +END; + + +PROCEDURE WriteToExtendedDat(Var ExtendedDatIn: VerbRec; + Rec: LongInt); + +BEGIN + Seek(ExtendedDat,Rec); + Write(ExtendedDat,ExtendedDatIn); +END; + + +PROCEDURE CloseExtendedDat; + +BEGIN + Close(ExtendedDat); +END; + + +PROCEDURE OpenLastOnDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(LastOnDat,AddSlash(Path) + 'LASTON.DAT'); + {$I-} Reset(LastOnDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromLastOnDat(Var LastOnDatIn: LastCallerRec; Rec: Integer); +BEGIN + Seek(LastOnDat,Rec); + Read(LastOnDat,LastOnDatIn); +END; + +PROCEDURE WriteToLastOnDat(Var LastOnDatIn: LastCallerRec; Rec: Integer); +BEGIN + Seek(LastOnDat,Rec); + Write(LastOnDat,LastOnDatIn); +END; + +PROCEDURE CloseLastOnDat; +BEGIN + Close(LastOnDat); +END; + +PROCEDURE OpenEventsDat(Path: String; Var Err: Byte); +BEGIN + Assign(EventsDat,AddSlash(Path) + 'EVENTS.DAT'); + {$I-} Reset(EventsDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromEventsDat(Var EventsDatIn: EventRec; + Rec: Integer); + +BEGIN + Seek(EventsDat,Rec); + Read(EventsDat,EventsDatIn); +END; + + +PROCEDURE WriteToEventsDat(Var EventsDatIn: EventRec; + Rec: Integer); + +BEGIN + Seek(EventsDat,Rec); + Write(EventsDat,EventsDatIn); +END; + + +PROCEDURE CloseEventsDat; + +BEGIN + Close(EventsDat); +END; + + +PROCEDURE OpenProtocolDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(ProtocolDat,AddSlash(Path) + 'PROTOCOL.DAT'); + {$I-} Reset(ProtocolDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromProtocolDat(Var ProtocolDatIn: ProtRec; + Rec: Integer); + +BEGIN + Seek(ProtocolDat,Rec); + Read(ProtocolDat,ProtocolDatIn); +END; + + +PROCEDURE WriteToProtocolDat(Var ProtocolDatIn: ProtRec; + Rec: Integer); + +BEGIN + Seek(ProtocolDat,Rec); + Write(ProtocolDat,ProtocolDatIn); +END; + + +PROCEDURE CloseProtocolDat; + +BEGIN + Close(ProtocolDat); +END; + + +PROCEDURE OpenMultNodeDat(Path: String; + Var Err: Byte); + +BEGIN + Assign(MultNodeDat,AddSlash(Path) + 'MULTNODE.DAT'); + {$I-} Reset(MultNodeDat); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromMultNodeDat(Var MultNodeDatIn: NodeRec; + Rec: Integer); + +BEGIN + Seek(MultNodeDat,Rec); + Read(MultNodeDat,MultNodeDatIn); +END; + + +PROCEDURE WriteToMultNodeDat(Var MultNodeDatIn: NodeRec; + Rec: Integer); + +BEGIN + Seek(MultNodeDat,Rec); + Write(MultNodeDat,MultNodeDatIn); +END; + + +PROCEDURE CloseMultNodeDat; + +BEGIN + Close(MultNodeDat); +END; + + +PROCEDURE OpenScn(FileName: String; + Path: String; + Var Err: Byte); + +BEGIN + Assign(Scn,AddSlash(Path) + FileName); + {$I-} Reset(Scn); {$I+} + Err := IoResult; +END; + + +PROCEDURE ReadFromScn(Var ScnIn: ScanRec; + Rec: Integer); + +BEGIN + Seek(Scn,Rec); + Read(Scn,ScnIn); +END; + + +PROCEDURE WriteToScn(Var ScnIn: ScanRec; + Rec: Integer); + +BEGIN + Seek(Scn,Rec); + Write(Scn,ScnIn); +END; + + +PROCEDURE CloseScn; + +BEGIN + Close(Scn); +END; + + +BEGIN + OldExit:=ExitProc; { Save the original exit procedure } + ExitProc:=@RunTimeExitProc; { Insert the RunTime exit procedure } + OSVer := detectOS; +END. + diff --git a/SOURCE/UNUSED/RGFLIST.PAS b/SOURCE/UNUSED/RGFLIST.PAS new file mode 100644 index 0000000..7ae5bee --- /dev/null +++ b/SOURCE/UNUSED/RGFLIST.PAS @@ -0,0 +1,55 @@ +PROGRAM RGFLIST; + + + +PROCEDURE DownloadFileListing; +VAR + FArea: Integer; + + PROCEDURE SearchFileAreaSpec(FArea: Integer; FName: Str12; VAR FArrayRecNum: Byte); + VAR + F: FileInfoRecordType; + DirFileRecNum: Integer; + BEGIN + IF (FileArea <> FArea) THEN + ChangeFileArea(FArea); + IF (FileArea = FArea) THEN + BEGIN + RecNo(F,FName,DirFileRecNum); + IF (BadDownloadPath) THEN + Exit; + WHILE (DirFileRecNum <> -1) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO + BEGIN + Seek(DirFile,DirFileRecNum); + Read(DirFile,F); + IF (CanSee(F)) THEN + BEGIN + WITH FArray[FArrayRecNum] DO + BEGIN + FArrayFileArea := FileArea; + FArrayDirFileRecNum := DirFileRecNum; + END; + DisplayFileAreaHeader; + Display_File(F,FArrayRecNum,'',FALSE); + Inc(FArrayRecNum); + IF (FArrayRecNum = 100) THEN + FArrayRecNum := 0; + END; + NRecNo(F,FName,DirFileRecNum); + END; + Close(DirFile); + Close(VerbF); + END; + END; + +BEGIN + FArea := 1; + WHILE (FArea <= NumFileAreas) DO + BEGIN + SearchFileAreaSpec(FArea,FName,FArrayRecNum); + Inc(FArea); + END; +END; + +BEGIN +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGINTRO.ANS b/SOURCE/UNUSED/RGINTRO.ANS new file mode 100644 index 0000000..bff568d --- /dev/null +++ b/SOURCE/UNUSED/RGINTRO.ANS @@ -0,0 +1,19 @@ +[?7h旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +� Renegade Bulletin Board Sysop Upgrade � +읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + ��複複�� 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� ��複複�� + ��複��� Welcome to the Renegade Bulletin Board System ���複�� + ��複��쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴���複�� + ��栢������栢�� + ��栢������栢�� + ��栢������栢�� + ��栢������栢�� + ��栢������栢�� + ��栢������栢�� + ��栢������栢�� + ��栢������栢�� + ��栢��읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴���栢�� + ��栢����栢�� + ��複�� �� 賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽� �� ��複�� + ��複複�� �� 賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽賽� �� ��複複�� + diff --git a/SOURCE/UNUSED/RGLNG.EXE b/SOURCE/UNUSED/RGLNG.EXE new file mode 100644 index 0000000..2e0276f Binary files /dev/null and b/SOURCE/UNUSED/RGLNG.EXE differ diff --git a/SOURCE/UNUSED/RGLNG.TXT b/SOURCE/UNUSED/RGLNG.TXT new file mode 100644 index 0000000..cf0f58c --- /dev/null +++ b/SOURCE/UNUSED/RGLNG.TXT @@ -0,0 +1,424 @@ +$Anonymous_String +^4[^0� Anonymous �^4] +$ + +$Echo_Char_For_Passwords +� +$ + +$Engage_Chat +%LF^0Your SysOp, ^5%SN^0, is here to chat with you!%LF%LF +$ + +$End_Chat +%LF^0Welcome back to ^9%BN. +$ + +$SysOp_Working +^4[^0� Please Wait �^4]@ +$ + +$Pause +^4[^0� Press any key �^4]@ +$ + +$Enter_Message_Line_One +|03Press |11ENTER |03to get a |11BLANK LINE |03and press the following: +$ + +$Enter_Message_Line_Two +|03To Save: |11/S |03To Quote: |11/Q |03To Abort: |11/A |03Help: |11/? +$ + +$NewScan_Begin +%CL|09Scanning ... |01[|11%MB |01- |11%HM|01]@ +$ + +$NewScan_Done +@ +$ + +$Auto_Message_Title +^9AutoMessage posted here by: ^3 +$ + +$Auto_Message_Border_Characters +� +$ + +$SysOp_Shelling_To_DOS +|09[|15� Please Wait �|09]@ +$ + +$Read_Mail +%LF|09Read Mail (|14?|09=|14Help|09): @ +$ + +$Paging_SysOp +^9I will now attempt to call ^0%SN ^9to his computer! +$ + +$Chat_Call +|09[|11(|15<|14*|15>|11)|09] @ +$ + +$Bulletin_Prompt +^4Time Left [^3%TL^4] (^3?^4=^3Help^4) %LFBulletin Menu^2: @ +$ + +$Protocol_Prompt +|09Press |09[|11ENTER|09] to Transfer, [|11B|09]atch, [|11N|09]ext, [|11Q|09]uit|13: |00@ +$ + +$List_Files +|03List Files - |11P |03to Pause +$ + +$Search_For_New_Files +%LF|03Search for new files - +$ + +$Search_All_Dirs_For_File_Mask +|03Search all directories for a file name|01: |11 +$ + +$Search_For_Descriptions +|03Enter a description to search for|01: |01[|11No Wildcards!|01]|01: |11 +$ + +$Enter_The_String_To_Search_For +|03Press |01[|11ENTER|01] |03to abort.%LF|11 +$ + +$Download +%LF^3Download - from file area %FB^1. +%LF^4File name:^3 @ +$ + +$Upload +%LF^3Upload - to file area %FB^1. +%LF^4File name:^3 @ +$ + +$View_Interior_Files +%LF^3Enter the name of the archive(s) you would like to view:^1 +$ + +$Insufficient_File_Credits +^7You have insufficient file points to download this file!^1 +$ + +$Ratio_Is_Unbalanced +^7Your upload/download ratio is too poor to download this!^1 +$ + +$All_Files + +$ + +$File_Mask +|03Press |01[|11ENTER|01] |03For |11ALL |03Files|01: |11@ +$ + +$File_Added_To_Batch_Queue +%LF^5File added to batch download queue. +$ + +$Batch_Download_Flagging +%LF^3Enter filename(s) for addition to the batch queue. +%LF^4File name:^3 @ +$ + +$Read_Question_Prompt +^4[^5%MB^4]%LFBegin reading at [^51^4-^5%HM^4] (^5Q^4=^5Quit^4): @ +$ + +$System_Password_Prompt +%LF|03SysOp password|01: |11@ +$ + +$Default_Message_To +|03Press |01[|11ENTER|01] |03for |11ALL|03:%LF +$ + +$Newscan_All +|01[= |11Global NewScan Beginning |01=] +$ + +$Newscan_Done +%CL|01[= |11Global NewScan Completed |01=] +$ + +$Chat_Reason +^9%UN^0, State your reason for a Chat Session. +$ + +$User_Defined_Question_One +Is ALL of your information REAL & CORRECT? (Yes/No) +$ + +$User_Defined_Question_Two +Do you run a Telnet BBS? (If so, type in address below) +$ + +$User_Defined_Question_Three +What BBS or Web Site did you hear about this BBS? (Specific Please) +$ + +$User_Defined_Question_Editor_One +Info Real +$ + +$User_Defined_Question_Editor_Two +Telnet BBS +$ + +$User_Defined_Question_Editor_Three +Reference +$ + +$Continue_Prompt +|10� |15Continue: [^5Y^0]es, [N]o, [C]ontinuous: @ +$ + +$Invisible_Login +Invisible Login: @ +$ + +$Cant_Email +|11Can't send mail to that user. +$ + +$Send_Email +%CL^5User to send private message to (1-%UM)?^1 +$ + +$Sending_Mass_Mail_To +|01Sending mass-mail to: +$ + +$Sending_Mass_Mail_To_All_Users +|01Sending mass-mail to ALL USERS. +$ + +$No_Netmail +|01You are not allowed to send netmail. +$ + +$Netmail_Prompt +%LF|09Is this to be a netmail message? @ +$ + +$No_Mail_Waiting +%LF^5You have no mail waiting. +%PA +$ + +$Must_Read_Message +%LF^7Sorry, you must read and reply to (or delete) your mail!^1 +%PA +$ + +$Scan_For_New_Files + |11S|03can |11F|03or |11NEW |11F|03iles |11S|03ince |11MM|03/|11DD|03/|11YYYY|03: @ +$ + +$New_Scan_Char_File +� +$ + +$Bulletins_Prompt +^5There are new bulletins read them: @ +$ + +$Quick_Logon +Quick Logon: @ +$ + +$Message_Area_Select_Header +%CL7旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +7�8 Num 7�9 Name 7�8 Num 7�9 Name 7� +7읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + + +$File_Area_Select_Header +%CL-旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +-�. Num -�/ Name -�. Num -�/ Name -� +-읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Receive_Email_Header +%CL뉅컴컴컫컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴커 +눛� Num 눛� Date/Time 눛� Sender 눛� Subject 눛 +눩컴컴컨컴컴컴컴컴컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴켸 +$ + +$Vote_List_Topics_Header +%CL|03旼컴컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +�|11|17 Num |03|16�|11|17Votes|03|16�|11|17 Choice |03|16� +읕컴컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Vote_Topic_Result_Header +|03旼컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +�|11|17 N |03|16�|11|17 % |03|16�|11|17 Choice |03|16� +읕컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$File_Area_Name_Header_No_Ratio +%CL 旼컫컴컴컴컴컴컴쩡컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � ## � File Name  � Size  � Description %FB{32  � + 읕컨컴컴컴컴컴컴좔컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$File_Area_Name_Header_Ratio +%CL 旼컫컴컴컴컴컴컴쩡컴쩡컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � ## � �File Name  �Pts � Size  � Description %FB{30  � + 읕컨컴컴컴컴컴컴좔컴좔컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Sysop_Chat_Help +^5/BYE^3: Hang up +^5/CLS^3: Clear the screen +^5/PAGE^3: Page the SysOp and User +^5/Q^3: Exit chat mode%LF +$ + +$New_Scan_Char_Message +� +$ + +$File_Area_Select_No_Files +%LF^7No file areas!^1 +$ + +$Message_Area_Select_No_Files +%LF^7No message areas!^1 +$ + +$Message_Area_List_Prompt +%LFMessage area list? [^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ +$ + +$File_Area_List_Prompt +%LFFile area list? [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ +$ + +$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 +$ + +$File_Area_Change_Prompt +%LFChange file area? [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ +$ + +$Message_Area_Change_Prompt +%LFChange message area? [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ +$ + +$File_Area_New_Scan_Toggle_Prompt +%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]: @ +$ + +$Message_Area_New_Scan_Toggle_Prompt +%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]: @ +$ + +$File_Area_Move_File_Prompt +%LFMove to which file area? (^5%A1^4-^5%A2^4) [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ +$ + +$Message_Area_Move_Message_Prompt +%LFMove to which area? (^50^4=^5Private^4,^5%A3^4-^5%A3^4) [^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @ +$ + +$File_Area_Change_Min_Max_Error +%LF^7The range must be from %A1 to %A2!^1 +%PA +$ + +$Message_Area_Change_Min_Max_Error +%LF^7The range must be from %A3 to %A4!^1 +%PA +$ + +$File_Area_Change_No_Area_Access +%LF^7You do not have access to this file area!^1 +%PA +$ + +$Message_Area_Change_No_Area_Access +%LF^7You do not have access to this message area!^1 +%PA +$ + +$File_Area_Change_Lowest_Area +%LFLowest accessible file area. +%PA +$ + +$File_Area_Change_Highest_Area +%LFHighest accessible file area. +%PA +$ + +$Message_Area_Change_Lowest_Area +%LFLowest accessible message area. +%PA +$ + +$Message_Area_Change_Highest_Area +%LFHighest accessible message area. +%PA +$ + +$File_Area_New_Scan_Scanning_All_Areas +%LFYou are now scanning all file areas. +%PA +$ + +$Message_Area_New_Scan_Scanning_All_Areas +%LFYou are now reading all message areas. +%PA +$ + +$File_Area_New_Scan_Not_Scanning_All_Areas +%LFYou are now not scanning any file areas. +%PA +$ + +$Message_Area_New_Scan_Not_Scanning_All_Areas +%LFYou are now not reading any message areas. +%PA +$ + +$File_Area_New_Scan_Min_Max_Error +%LF^7The range must be from %A1 to %A2!^1 +%PA +$ + +$Message_Area_New_Scan_Min_Max_Error +%LF^7The range must be from %A3 to %A4!^1 +%PA +$ + +$File_Area_New_Scan_Area_On_Off +%LF^5%FB^3 will %FSbe scanned. +%PA +$ + +$Message_Area_New_Scan_Area_On_Off +%LF^5%MB^3 will %MSbe scanned. +%PA +$ + +$Message_Area_New_Scan_Area_Not_Removed +%LF^5%MB^3 cannot be removed from your newscan. +%PA +$ \ No newline at end of file diff --git a/SOURCE/UNUSED/RGLNGNEW.TXT b/SOURCE/UNUSED/RGLNGNEW.TXT new file mode 100644 index 0000000..65ebaeb --- /dev/null +++ b/SOURCE/UNUSED/RGLNGNEW.TXT @@ -0,0 +1,288 @@ +$Anonymous_String +^4[^0� Anonymous �^4] +$ + +$Echo_Char_For_Passwords +� +$ + +$Engage_Chat +%LF^0Your SysOp, ^5%SN^0, is here to chat with you!%LF%LF +$ + +$End_Chat +%LF^0Welcome back to ^9%BN. +$ + +$SysOp_Working +^4[^0� Please Wait �^4]@ +$ + +$Pause +^4[^0� Press any key �^4]@ +$ + +$Enter_Message_Line_One +|03Press |11ENTER |03to get a |11BLANK LINE |03and press the following: +$ + +$Enter_Message_Line_Two +|03To Save: |11/S |03To Quote: |11/Q |03To Abort: |11/A |03Help: |11/? +$ + +$NewScan_Begin +%CL|09Scanning ... |01[|11%MB |01- |11%HM|01]@ +$ + +$NewScan_Done +@ +$ + +$Auto_Message_Title +^9AutoMessage posted here by: ^3 +$ + +$Auto_Message_Border_Characters +� +$ + +$SysOp_Shelling_To_DOS +|09[|15� Please Wait �|09]@ +$ + +$Read_Mail +%LF|09Read Mail (|14?|09=|14Help|09): @ +$ + +$Paging_SysOp +^9I will now attempt to call ^0%SN ^9to his computer! +$ + +$Chat_Call +|09[|11(|15<|14*|15>|11)|09] @ +$ + + +$Bulletin_Prompt +^4Time Left [^3%TL^4] (^3?^4=^3Help^4) %LFBulletin Menu^2: @ +$ + +$Protocol_Prompt +|09Press |09[|11ENTER|09] to Transfer, [|11B|09]atch, [|11N|09]ext, [|11Q|09]uit|13: |00@ +$ + +$List_Files +|03List Files - |11P |03to Pause +$ + +$Search_For_New_Files +%LF|03Search for new files - +$ + +$Search_All_Dirs_For_File_Mask +|03Search all directories for a file name|01: |11 +$ + +$Search_For_Descriptions +|03Enter a description to search for|01: |01[|11No Wildcards!|01]|01: |11 +$ + +$Enter_The_String_To_Search_For +|03Press |01[|11ENTER|01] |03to abort.%LF|11 +$ + +$Download +%LF^3Download - from file area %FB^1. +%LF^4File name:^3 @ +$ + +$Upload +%LF^3Upload - to file area %FB^1. +%LF^4File name:^3 @ +$ + +$View_Interior_Files +%LF^3Enter the name of the archive(s) you would like to view:^1 +%LF^4File name:^3 @ +$ + +$Insufficient_File_Credits +^5You have insufficient file points to download this.^1 +$ + +$Ratio_Is_Unbalanced +^5Your upload/download ratio is too poor to download this.^1 +$ + +$All_Files + +$ + +$File_Mask +|03Press |01[|11ENTER|01] |03For |11ALL |03Files|01: |11@ +$ + +$File_Added_To_Batch_Queue +%LF^5File added to batch download queue. +$ + +$Batch_Download_Flagging +%LF^3Enter filename(s) for addition to the batch queue. +%LF^4File name:^3 @ +$ + +$Read_Question_Prompt +^4[^5%MB^4]%LFBegin reading at [^51^4-^5%HM^4] (^5Q^4=^5Quit^4): @ +$ + +$System_Password_Prompt +%LF|03SysOp Password|01: |11@ +$ + +$Default_Message_To +|03Press |01[|11ENTER|01] |03for |11ALL|03:%LF +$ + +$Newscan_All +|01[= |11Global NewScan Beginning |01=] +$ + +$Newscan_Done +%CL|01[= |11Global NewScan Completed |01=] +$ + +$Chat_Reason +^9%UN^0, State your reason for a Chat Session. +$ + +$User_Defined_Question_One +Is ALL of your information REAL & CORRECT? (Yes/No) +$ + +$User_Defined_Question_Two +Do you run a Telnet BBS? (If so, type in address below) +$ + +$User_Defined_Question_Three +What BBS or Web Site did you hear about this BBS? (Specific Please) +$ + +$User_Defined_Question_Editor_One +Info Real +$ + +$User_Defined_Question_Editor_Two +Telnet BBS +$ + +$User_Defined_Question_Editor_Three +Reference +$ + +$Continue_Prompt +|10� |15Continue: [^5Y^0]es, [N]o, [C]ontinuous: @ +$ + +$Invisible_Login +Invisible Login: @ +$ + +$Cant_Email +|11Can't send mail to that user. +$ + +$Send_Email +%CL^5User to send private message to (1-%UM)?^1 +$ + +$Sending_Mass_Mail_To +|01Sending mass-mail to: +$ + +$Sending_Mass_Mail_To_All_Users +|01Sending mass-mail to ALL USERS. +$ + +$No_Netmail +|01You are not allowed to send netmail. +$ + +$Netmail_Prompt +%LF|09Is this to be a netmail message? @ +$ + +$No_Mail_Waiting +%LF^5You have no mail waiting. +%PA +$ + +$Must_Read_Message +%LF^7Sorry, you must read and reply to (or delete) your mail!^1 +%PA +$ + +$Scan_For_New_Files + |11S|03can |11F|03or |11NEW |11F|03iles |11S|03ince |11MM|03/|11DD|03/|11YYYY|03: @ +$ + +$New_Scan_Char_File +� +$ + +$Bulletins_Prompt +^5There are new bulletins read them: @ +$ + +$Quick_Logon +Quick Logon: @ +$ + +$Message_Area_Select_Header +%CL7旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +7�8 Num 7�9 Name 7�8 Num 7�9 Name 7� +7읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + + +$File_Area_Select_Header +%CL-旼컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컫컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +-�. Num -�/ Name -�. Num -�/ Name -� +-읕컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컨컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ 12345678901234567890123456789012 1234567890123456789012345678901 + +$Receive_Email_Header +%CL뉅컴컴컫컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴커 +눛� Num 눛� Date/Time 눛� Sender 눛� Subject 눛 +눩컴컴컨컴컴컴컴컴컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴켸 +$ + +$Vote_List_Topics_Header +%CL|03旼컴컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +�|11|17 Num |03|16�|11|17Votes|03|16�|11|17 Choice |03|16� +읕컴컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Vote_Topic_Result_Header +|03旼컴쩡컴컴쩡컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +�|11|17 N |03|16�|11|17 % |03|16�|11|17 Choice |03|16� +읕컴좔컴컴좔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$File_Area_Name_Header_No_Ratio +%CL 旼컫컴컴컴컴컴컴쩡컴컴컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � ## � File Name  � Size  � Description %FB{32  � + 읕컨컴컴컴컴컴컴좔컴컴컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$File_Area_Name_Header_Ratio +%CL 旼컫컴컴컴컴컴컴쩡컴쩡컴컴컫컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � ## � �File Name  �Pts � Size  � Description %FB{30  � + 읕컨컴컴컴컴컴컴좔컴좔컴컴컨컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� +$ + +$Sysop_Chat_Help +^5/BYE^3: Hang up +^5/CLS^3: Clear the screen +^5/PAGE^3: Page the SysOp and User +^5/Q^3: Exit chat mode%LF +$ diff --git a/SOURCE/UNUSED/RGLNGPR.DAT b/SOURCE/UNUSED/RGLNGPR.DAT new file mode 100644 index 0000000..e9331a6 Binary files /dev/null and b/SOURCE/UNUSED/RGLNGPR.DAT differ diff --git a/SOURCE/UNUSED/RGLNGTX.DAT b/SOURCE/UNUSED/RGLNGTX.DAT new file mode 100644 index 0000000..e15a509 Binary files /dev/null and b/SOURCE/UNUSED/RGLNGTX.DAT differ diff --git a/SOURCE/UNUSED/RGMAIN.EXE b/SOURCE/UNUSED/RGMAIN.EXE new file mode 100644 index 0000000..5b503cd Binary files /dev/null and b/SOURCE/UNUSED/RGMAIN.EXE differ diff --git a/SOURCE/UNUSED/RGMAIN.PAS b/SOURCE/UNUSED/RGMAIN.PAS new file mode 100644 index 0000000..8c9dbad --- /dev/null +++ b/SOURCE/UNUSED/RGMAIN.PAS @@ -0,0 +1,122 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +PROGRAM RGMAIN; + +USES + Crt; + +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; + +BEGIN + CLrScr; + WriteLn('Renegade Main String Compiler Version 1.0'); + Writeln('Copyright 2006 - The Renegade Developement Team'); + WriteLn; + Write('Compiling 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. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGMAIN.TXT b/SOURCE/UNUSED/RGMAIN.TXT new file mode 100644 index 0000000..86ec4c3 --- /dev/null +++ b/SOURCE/UNUSED/RGMAIN.TXT @@ -0,0 +1,46 @@ +$Baud_Override_PW +%LFBaud rate override password: @ +$ + +$Caller_Logon +%LF|01[|03Node |11%ND|01] |03Login|01: |11@ +$ + +$Logon_As_New +%LFLogon as new? @ +$ + +$User_Logon_Password +%LF|03Enter Password|01: |11@ +$ + +$User_Logon_Phone_Number +%LF|03Last 4 Digits of phone #|01: |08###-###-|11@ +$ + +$SysOp_Logon_Password +%LF|03SysOp Password|01: |11@ +$ + +$Forgot_PW_Question +%LF|03Please answer the following question to logon to the BBS. + +|03What is your mothers maiden name? +: @ +$ + +$Verify_Birth_Date +%LFPlease verify your date of birth (mm/dd/yyyy): @ +$ + +$Logon_Withdraw_Bank +Withdraw from Time Bank? @ +$ + +$Shuttle_Logon +%LF|01[|09Node %ND|01] |09Login|11: @ +$ + +$New_User_Password +%LF|03New User Password|01: @ +$ \ No newline at end of file diff --git a/SOURCE/UNUSED/RGMAINPR.DAT b/SOURCE/UNUSED/RGMAINPR.DAT new file mode 100644 index 0000000..e862cac Binary files /dev/null and b/SOURCE/UNUSED/RGMAINPR.DAT differ diff --git a/SOURCE/UNUSED/RGMAINT.EXE b/SOURCE/UNUSED/RGMAINT.EXE new file mode 100644 index 0000000..d458ad7 Binary files /dev/null and b/SOURCE/UNUSED/RGMAINT.EXE differ diff --git a/SOURCE/UNUSED/RGMAINT.PAS b/SOURCE/UNUSED/RGMAINT.PAS new file mode 100644 index 0000000..6764cc4 --- /dev/null +++ b/SOURCE/UNUSED/RGMAINT.PAS @@ -0,0 +1,1566 @@ +{$M 35500,0,131072} +PROGRAM RGMAINT; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +TYPE + StorageType = + ( + Disk, + CD, + Copied + ); + + TransferFlagType = + (IsAddDLBatch, + IsFileAttach, + IsUnlisted, + IsTempArc, + IsQWK, + IsNoFilePoints, + IsNoRatio, + IsCheckRatio, + IsCDRom, + IsPaused, + IsAutoLogOff, + IsKeyboardAbort, + IsTransferOk); + + TransferFlagSet = SET OF TransferFlagType; + + BatchDLRecordType = RECORD + BDLFileName: STRING[52]; + BDLStorage: StorageType; + BDLUserNum, + BDLSection, + BDLPoints, + BDLUploader: Integer; + BDLFSize, + BDLTime, + BDLOwnerCRC: LongInt; + BDLFlags: TransferFlagSet; + END; + + DirF = FILE OF FileInfoRecordType; + SF = FILE OF UserIDXRec; + +CONST + DYNY: BOOLEAN = FALSE; + +FUNCTION AllCaps(S: STRING): STRING; +VAR + Counter: Byte; +BEGIN + FOR Counter := 1 TO Length(S) DO + IF (S[Counter] IN ['a'..'z']) THEN + S[Counter] := Chr(Ord(S[Counter]) - Ord('a')+Ord('A')); + AllCaps := S; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := s; +END; + +FUNCTION SQOutSp(S: STRING): STRING; +BEGIN + WHILE (Pos(' ',S) > 0) DO + Delete(S,Pos(' ',S),1); + SQOutSp := S; +END; + +FUNCTION Exist(fn: AStr): Boolean; +VAR + DirInfo: SearchRec; +BEGIN + FindFirst(SQOutSp(fn),AnyFile,DirInfo); + Exist := (DOSError = 0); +END; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +END; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +FUNCTION StrToInt(S: STRING): LongInt; +VAR + I: Integer; + L: LongInt; +BEGIN + Val(S,L,I); + IF (I > 0) THEN + BEGIN + S[0] := Chr(I - 1); + Val(S,L,I) + END; + IF (S = '') THEN + StrToInt := 0 + ELSE + StrToInt := L; +END; + +FUNCTION GetFileSize(FileName: AStr): LongInt; +VAR + F: FILE OF Byte; + FSize: LongInt; +BEGIN + FSize := 0; + IF (Exist(SQOutSp(FileName))) THEN + BEGIN + Assign(F,SQOutSp(FileName)); + Reset(F); + FSize := FileSize(F); + Close(F); + END; + GetFileSize := FSize; +END; + +PROCEDURE KillUserVotes(DataPath: STRING; VAR User: UserRecordType); +VAR + VotingFile: FILE OF VotingRecordType; + Topic: VotingRecordType; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter] > 0) THEN + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + IF (Topic.NumVotedQuestion > 0) THEN + Dec(Topic.NumVotedQuestion); + IF (Topic.Answers[User.Vote[Counter]].NumVotedAnswer > 0) THEN + Dec(Topic.Answers[User.Vote[Counter]].NumVotedAnswer); + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + User.Vote[Counter] := 0; + END; + Close(VotingFile); + END; +END; + +PROCEDURE ResetVotes(DataPath: STRING); +VAR + VotingFile: FILE OF VotingRecordType; + Topic: VotingRecordType; + Counter, + Counter1: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + Topic.NumVotedQuestion := 0;; + FOR Counter1 := 1 TO 25 DO + Topic.Answers[Counter1].NumVotedAnswer := 0; + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + END; + Close(VotingFile); + END; +END; + +PROCEDURE ReScanUserVotes(DataPath: STRING; VAR User: UserRecordType); +VAR + VotingFile: FILE OF VotingRecordType; + Topic: VotingRecordType; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter] > 0) THEN + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + Inc(Topic.NumVotedQuestion); + Inc(Topic.Answers[User.Vote[Counter]].NumVotedAnswer); + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + END; + Close(VotingFile); + END; +END; + +PROCEDURE KillShortMsgs(DataPath: STRING; VAR User: UserRecordType); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'SHORTMSG.DAT')) THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin = User.UserID) THEN + ShortMsg.Destin := -1; + Seek(ShortMsgFile,(Counter - 1)); + Write(ShortMsgFile,ShortMsg); + END; + Close(ShortMsgFile); + END; +END; + +PROCEDURE UpdateShortMsgs(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'SHORTMSG.DAT') THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin = User.UserID) THEN + ShortMsg.Destin := NewUserNumber; + Seek(ShortMsgFile,(Counter - 1)); + Write(ShortMsgFile,ShortMsg); + END; + Close(ShortMsgFile); + END; +END; + +PROCEDURE PurgingShortMsgs(DataPath: STRING); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsgFile1: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'SHORTMSG.DAT') THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + Assign(ShortMsgFile1,DataPath+'SHORTMSG.BAK'); + ReWrite(ShortMsgFile1); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin <> -1) THEN + BEGIN + Seek(ShortMsgFile1,FileSize(ShortMsgFile1)); + Write(ShortMsgFile1,ShortMsg); + END; + END; + Close(ShortMsgFile); + Erase(ShortMsgFile); + Close(ShortMsgFile1); + ReName(ShortMsgFile1,DataPath+'SHORTMSG.DAT'); + END; +END; + +PROCEDURE KillBatchQueue(DataPath: STRING; VAR User: UserRecordType); +VAR + BatchDLFile: FILE OF BatchDlRecordType; + BatchDL: BatchDlRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum = User.UserID) THEN + BatchDL.BDLUserNum := -1; + Seek(BatchDLFile,(Counter - 1)); + Write(BatchDLFile,BatchDL); + END; + Close(BatchDLFile); + END; +END; + +PROCEDURE UpdateBatchQueue(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer); +VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDL: BatchDlRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum = User.UserID) THEN + BatchDL.BDLUserNum := NewUserNumber; + Seek(BatchDLFile,(Counter - 1)); + Write(BatchDLFile,BatchDL); + END; + Close(BatchDLFile); + END; +END; + +PROCEDURE PurgingBatchQueue(DataPath: STRING); +VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDLFile1: FILE OF BatchDLRecordType; + BatchDL: BatchDLRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + Assign(BatchDLFile1,DataPath+'BATCHDL.BAK'); + ReWrite(BatchDLFile1); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum <> -1) THEN + BEGIN + Seek(BatchDLFile1,FileSize(BatchDLFile1)); + Write(BatchDLFile1,BatchDL); + END; + END; + Close(BatchDLFile); + Erase(BatchDLFile); + Close(BatchDLFile1); + ReName(BatchDLFile1,DataPath+'BATCHDL.DAT'); + END; +END; + +PROCEDURE KillUserEMail(DataPath,MsgPath: STRING; VAR User: UserRecordType); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF ((MHeader.MTO.UserNum = User.UserID) OR (MHeader.From.UserNum = User.UserID)) THEN + Include(MHeader.Status,MDeleted); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := 0; + IF (MHeader.FROM.UserNum = User.UserID) THEN + MHeader.FROM.UserNum := 0; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + User.Waiting := 0; + END; +END; + +PROCEDURE UpdateUserEMail(MsgPath: STRING; VAR User: UserRecordType; NewUserNum: Integer); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := NewUserNum; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := NewUserNum; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + END; +END; + +PROCEDURE ReScanUserEMail(MsgPath: STRING; VAR User: UserRecordType; UserNum: Integer); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + User.Waiting := 0; + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = UserNum) THEN + IF (NOT (MDeleted IN MHeader.Status)) THEN + Inc(User.Waiting); + END; + Close(MsgHdrF); + END; +END; + +PROCEDURE UpdateDIRFilesDeletedUsers(DataPath: STRING; User,SysOpUser: UserRecordType); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF FileInfoRecordType; + FileArea: FileAreaRecordType; + VerbF: FILE; + F: FileInfoRecordType; + Counter, + Counter1: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.DLPath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + IF (F.OwnerNum = User.UserID) THEN + BEGIN + F.OwnerNum := SysOpUser.UserID; + F.OwnerName := AllCaps(SysOpUser.Name); + END; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateDIRFilesExistingUsers(DataPath: STRING; User: UserRecordType; NewUserNum: Integer); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF FileInfoRecordType; + VerbF: FILE; + FileArea: FileAreaRecordType; + F: FileInfoRecordType; + Counter, + Counter1: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + IF (F.OwnerNum = User.UserID) THEN + F.OwnerNum := NewUserNum; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateDIRFileSize(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF FileInfoRecordType; + FileArea: FileAreaRecordType; + VerbF: FILE; + F: FileInfoRecordType; + Counter, + Counter1: Integer; + FSize: Longint; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + FSize := GetFileSize(FileArea.DLPath+F.FileName); + IF (FSize = 0) THEN + BEGIN + F.FileSize := 0; + Include(F.FIFlags,FIIsRequest); + END + ELSE + F.FileSize := FSize; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateFileSCNFilesExistingUsers(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + UserFile: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + ScnFile: FILE OF Boolean; + ScnFile1: FILE OF Boolean; + FileArea: FileAreaRecordType; + User: UserRecordType; + Path: STRING; + Counter, + Counter1, + NumUsers: Integer; + NewScanFBase: Boolean; +BEGIN + Assign(UserFile,DataPath+'USERS.DAT'); + Reset(UserFile); + Assign(UserFile2,DataPath+'USERS.BAK'); + Reset(UserFile2); + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Path := FileArea.Dlpath+FileArea.FileName + ELSE + Path := Datapath+FileArea.FileName; + Assign(ScnFile,Path+'.SCN'); + Reset(ScnFile); + IF (IOResult = 2) THEN + ReWrite(ScnFile); + Assign(ScnFile1,Path+'.SCB'); + ReWrite(ScnFile1); + NumUsers := (FileSize(UserFile) - 1); + IF (NumUsers > FileSize(ScnFile)) THEN + BEGIN + Seek(ScnFile,FileSize(ScnFile)); + NewScanFBase := TRUE; + FOR Counter1 := FileSize(ScnFile) TO (NumUsers - 1) DO + Write(ScnFile,NewScanFBase); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(ScnFile1,FileSize(ScnFile1)); + NewScanFBase := TRUE; + Write(ScnFile1,NewScanFBase); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter1); + Read(UserFile2,User); + Seek(ScnFile,(User.UserID - 1)); + Read(ScnFile,NewScanFBase); + Seek(ScnFile1,(Counter1 - 1)); + Write(ScnFile1,NewScanFBase); + END; + Close(ScnFile); + Erase(ScnFile); + Close(ScnFile1); + ReName(ScnFile1,Path+'.SCN'); + END; + Close(FileAreaFile); + Close(UserFile); + Close(UserFile2); +END; + +PROCEDURE UpdateMsgFilesDeletedUsers(DataPath,MsgPath: STRING; User: UserRecordType); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgHdrF: FILE OF MHeaderRec; + MsgTxtF: FILE; + MsgArea: MessageAreaRecordType; + MHeader: MHeaderRec; + Counter: Integer; + MsgNum: Word; +BEGIN + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,Counter); + Read(MsgAreaFile,MsgArea); + Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR'); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT'); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := 0; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := 0; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END; + Close(MsgAreaFile); +END; + +PROCEDURE UpdateMsgFilesExistingUsers(DataPath,MsgPath: STRING; User: UserRecordType; NewUserNum: Integer); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgHdrF: FILE OF MHeaderRec; + MsgTxtF: FILE; + MsgArea: MessageAreaRecordType; + MHeader: MHeaderRec; + Counter: Integer; + MsgNum: Word; +BEGIN + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,Counter); + Read(MsgAreaFile,MsgArea); + Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR'); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT'); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := NewUserNum; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := NewUserNum; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END; + Close(MsgAreaFile); +END; + +PROCEDURE UpdateMsgSCNFilesExistingUsers(DataPath,MsgPath: STRING); +VAR + MessageFile: FILE OF MessageAreaRecordType; + UserFile: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + MsgScanFile: FILE OF ScanRec; + MsgScanFile1: FILE OF ScanRec; + MsgArea: MessageAreaRecordType; + User: UserRecordType; + LastReadRecord: ScanRec; + Path: STRING; + Counter, + Counter1, + NumUsers: Integer; +BEGIN + Assign(UserFile,DataPath+'USERS.DAT'); + Reset(UserFile); + Assign(UserFile2,DataPath+'USERS.BAK'); + Reset(UserFile2); + Assign(MessageFile,DataPath+'MBASES.DAT'); + Reset(MessageFile); + FOR Counter := 0 TO (FileSize(MessageFile) - 1) DO + BEGIN + Seek(MessageFile,Counter); + Read(MessageFile,MsgArea); + Path := MsgPath+MsgArea.FileName; + Assign(MsgScanFile,Path+'.SCN'); + Reset(MsgScanFile); + IF (IOResult = 2) THEN + ReWrite(MsgScanFile); + Assign(MsgScanFile1,Path+'.SCB'); + ReWrite(MsgScanFile1); + NumUsers := (FileSize(UserFile) - 1); + IF (NumUsers > FileSize(MsgScanFile)) THEN + BEGIN + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgScanFile,FileSize(MsgScanFile)); + FOR Counter1 := FileSize(MSGScanFile) TO (NumUsers - 1) DO + Write(MsgScanFile,LastReadRecord); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgScanFile1,FileSize(MsgScanFile1)); + Write(MsgScanFile1,LastReadRecord); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter1); + Read(UserFile2,User); + Seek(MsgScanFile,(User.UserID - 1)); + Read(MsgScanFile,LastReadRecord); + Seek(MsgScanFile1,(Counter1 - 1)); + Write(MsgScanFile1,LastReadRecord); + END; + Close(MsgScanFile); + Erase(MsgScanFile); + Close(MsgScanFile1); + ReName(MsgScanFile1,Path+'.SCN'); + END; + Close(MessageFile); + Close(UserFile); + Close(UserFile2); +END; + +PROCEDURE PackMessageArea(MsgPath,FN: STRING; MaxM: LongInt); +VAR + Buffer: ARRAY [1..4096] OF Char; + MsgHdrF1, + MsgHdrF2: FILE OF MheaderRec; + BrdF1, + BrdF2: FILE; + MHeader: MheaderRec; + Numm, + i, + IDX, + TotLoad, + Buffered: Word; + NeedPack: Boolean; + + PROCEDURE ErrMsg; + BEGIN + Writeln('Error renaming temp files while packing.'); + END; + + PROCEDURE Kill(CONST FN: AStr); + VAR + F: FILE; + BEGIN + IF Exist(FN) THEN + BEGIN + Assign(F,FN); + Erase(F); + END; + END; + +BEGIN + NeedPack := FALSE; + FN := AllCaps(FN); + FN := MsgPath + FN; + + Assign(BrdF1,FN+'.DAT'); + Reset(BrdF1,1); + IF (IOResult <> 0) THEN + Exit; + + Assign(MsgHdrF1,FN+'.HDR'); + Reset(MsgHdrF1); + + IF (IOResult <> 0) THEN + BEGIN + Close(BrdF1); + Exit + END; + + IF (MaxM <> 0) AND (FileSize(MsgHdrF1) > MaxM) THEN + BEGIN + Numm := 0; + IDX := FileSize(MsgHdrF1); + WHILE (IDX > 0) DO + BEGIN + Seek(MsgHdrF1,(IDX - 1)); + Read(MsgHdrF1,MHeader); + IF NOT (MDeleted IN MHeader.Status) THEN + Inc(Numm); + IF (Numm > MaxM) AND NOT (Permanent IN MHeader.Status) THEN + BEGIN + MHeader.Status := [MDeleted]; + Seek(MsgHdrF1,(IDX - 1)); + Write(MsgHdrF1,MHeader); + END; + Dec(IDX); + END; + END + ELSE + BEGIN + + WHILE (FilePos(MsgHdrF1) < FileSize(MsgHdrF1)) AND (NOT NeedPack) DO + BEGIN + Read(MsgHdrF1,MHeader); + IF (MDeleted IN MHeader.Status) THEN + NeedPack := TRUE; + END; + + IF (NOT NeedPack) THEN + BEGIN + Close(MsgHdrF1); + Close(BrdF1); + Exit; + END; + END; + + Assign(BrdF2,FN+'.DA1'); + ReWrite(BrdF2,1); + + Assign(MsgHdrF2,FN+'.HD2'); + ReWrite(MsgHdrF2); + + Kill(FN+'.HD3'); + Kill(FN+'.DA3'); + + IDX := 1; + i := 0; + + WHILE (i <= FileSize(MsgHdrF1) - 1) DO + BEGIN + Seek(MsgHdrF1,i); + Read(MsgHdrF1,MHeader); + + IF (MHeader.Pointer - 1 + MHeader.TextSize > FileSize(BrdF1)) OR + (MHeader.Pointer < 1) THEN + MHeader.Status := [MDeleted]; + + IF NOT (MDeleted IN MHeader.Status) THEN + BEGIN + Inc(IDX); + Seek(BrdF1,MHeader.Pointer - 1); + MHeader.Pointer := (FileSize(BrdF2) + 1); + Write(MsgHdrF2,MHeader); + + TotLoad := 0; + IF (MHeader.TextSize > 0) THEN + WHILE (MHeader.TextSize > 0) DO + BEGIN + Buffered := MHeader.TextSize; + IF (Buffered > 4096) THEN + Buffered := 4096; + Dec(MHeader.TextSize,Buffered); + BlockRead(BrdF1,Buffer[1],Buffered); + BlockWrite(BrdF2,Buffer[1],Buffered); + END; + END; + Inc(i); + END; + + Close(BrdF1); + Close(BrdF2); + Close(MsgHdrF1); + Close(MsgHdrF2); + + ReName(BrdF1,FN+'.DA3'); { ReName .DAT to .DA3 } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Exit; + END; + + ReName(BrdF2,FN+'.DAT'); { ReName .DA2 to .DAT } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + Exit; + END; + + ReName(MsgHdrF1,FN+'.HD3'); { ReName .HDR to .HD3 } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Erase(BrdF2); { Erase .DA2 } + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + Exit; + END; + + ReName(MsgHdrF2,FN+'.HDR'); { ReName .HD2 to .HDR } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Erase(BrdF2); { Erase .DAT (new) } + Erase(MsgHdrF2); { Erase .HD2 (new) } + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + ReName(MsgHdrF1,FN+'.HDR'); { ReName .HD3 to .HDR } + Exit; + END; + + Erase(MsgHdrF1); + Erase(BrdF1); +END; + +PROCEDURE PackMessageAreas(DataPath,MsgPath: STRING); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgArea: MessageAreaRecordType; + MArea: Integer; +BEGIN + PackMessageArea(MsgPath,'EMAIL',0); + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR MArea := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,MArea); + Read(MsgAreaFile,MsgArea); + PackMessageArea(MsgPath,MsgArea.FileName,MsgArea.MaxMsgs); + END; + Close(MsgAreaFile); +END; + +PROCEDURE SortFileArea(VAR DirFile1: DirF; NumFiles: Integer); +VAR + F1, + F2: FileInfoRecordType; + NumSorted, + RecNum, + RecNum1, + Gap: Integer; +BEGIN + Gap := NumFiles; + REPEAT; + Gap := (Gap DIV 2); + IF (Gap = 0) THEN + Gap := 1; + NumSorted := 0; + FOR RecNum := 1 TO (NumFiles - Gap) DO + BEGIN + RecNum1 := (RecNum + Gap); + Seek(DirFile1,(RecNum - 1)); + Read(DirFile1,F1); + Seek(DirFile1,(RecNum1 - 1)); + Read(DirFile1,F2); + IF (F1.FileName > F2.FileName) THEN + BEGIN + Seek(DirFile1,(RecNum - 1)); + Write(DirFile1,F2); + Seek(DirFile1,(RecNum1 - 1)); + Write(DirFile1,F1); + Inc(NumSorted); + END; + END; + UNTIL (NumSorted = 0) AND (Gap = 1); +END; + +PROCEDURE SortAllFileAreas(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: DirF; + FileArea: FileAreaRecordType; + F: FileInfoRecordType; + NumFiles, + Counter: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + NumFiles := FileSize(DirFile); + IF (NumFiles <> 0) THEN + SortFileArea(DirFile,NumFiles); + Close(DirFile); + END; + Close(FileAreaFile); +END; + +PROCEDURE InsertIndex(VAR UserIndexFile1: SF; Uname: AStr; UserNum: Integer; IsReal,IsDeleted: Boolean); +VAR + IndexR: UserIDXRec; + Current, + InsertAt: Integer; + Done: Boolean; + + PROCEDURE WriteIndex; + BEGIN + FillChar(IndexR,SizeOf(IndexR),0); + WITH IndexR DO + BEGIN + Name := Uname; + Number := UserNum; + RealName := IsReal; + Deleted := IsDeleted; + Left := -1; + Right := -1; + Write(UserIndexFile1,IndexR); + END + END; + +BEGIN + Done := FALSE; + Uname := Allcaps(Uname); + Current := 0; + Reset(UserIndexFile1); + IF (FileSize(UserIndexFile1) = 0) THEN + WriteIndex + ELSE + REPEAT + Seek(UserIndexFile1,Current); + InsertAt := Current; + Read(UserIndexFile1,IndexR); + IF (Uname < IndexR.Name) THEN + Current := IndexR.Left + ELSE IF (Uname > IndexR.Name) THEN + Current := IndexR.Right + ELSE IF (IndexR.Deleted <> IsDeleted) THEN + BEGIN + Done := TRUE; + IndexR.Deleted := IsDeleted; + IndexR.RealName := IsReal; + IndexR.Number := UserNum; + Seek(UserIndexFile1,Current); + Write(UserIndexFile1,IndexR); + END + ELSE + BEGIN + IF (UserNum <> IndexR.Number) THEN + WriteLn('Note: Duplicate user '+UName+' #'+IntToStr(IndexR.Number)+' and '+UName+' #'+IntToStr(UserNum)) + ELSE + BEGIN + IndexR.RealName := FALSE; + Seek(UserIndexFile1,Current); { Make it be his handle IF it's BOTH } + Write(UserIndexFile1,IndexR); + END; + Done := TRUE; + END; + UNTIL (Current = -1) OR (Done); + IF (Current = -1) THEN + BEGIN + IF (Uname < IndexR.Name) THEN + IndexR.Left := FileSize(UserIndexFile1) + ELSE + IndexR.Right := FileSize(UserIndexFile1); + Seek(UserIndexFile1,InsertAt); + Write(UserIndexFile1,IndexR); + Seek(UserIndexFile1,FileSize(UserIndexFile1)); + WriteIndex; + END; + Close(UserIndexFile1); +END; + +PROCEDURE PackUsers; +VAR + GeneralFile: FILE OF GeneralRecordType; + UserFile: FILE OF UserRecordType; + UserFile1: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + UserIndexFile: SF; + F: FILE; + General: GeneralRecordType; + User, + SysOpUser: UserRecordType; + DeleteDateStr: STRING; + TotalUsers, + Counter: Integer; + Year: Word; + PackedDeleteDate: LongInt; + UsersToDelete, + DeleteByDate, + InvalidDate: Boolean; +BEGIN + DeleteByDate := FALSE; + + IF (ParamCount > 0) THEN + FOR Counter := 1 TO ParamCount DO + IF (AllCaps(Copy(ParamStr(Counter),1,2)) = AllCaps('-D')) THEN + BEGIN + DeleteDateStr := Copy(ParamStr(Counter),3,Length(ParamStr(Counter))); + InvalidDate := FALSE; + IF (Length(DeleteDateStr) <> 10) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 0) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) > 12) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,4,2)) = 0) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [1,3,5,7,8,10,12]) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 31) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [4,6,9,11]) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 30) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) <> 0) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 28) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) = 0) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 29) THEN + InvalidDate := TRUE; + GetYear(Year); + IF (StrToInt(Copy(DeleteDateStr,7,4)) > Year) THEN + InvalidDate := TRUE; + + IF (InvalidDate) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'Invalid date or format, valid format is "00/00/0000'); + Exit; + END + ELSE + BEGIN + PackedDeleteDate := Date2PD(DeleteDateStr); + DeleteByDate := TRUE; + END; + END; + + ClrScr; + WriteLn('Renegade User Packer Version 2.0'); + Writeln('Copyright 2009 - The Renegade Developement Team'); + WriteLn; + Writeln('This utility will pack your Renegade BBS Version 1.0'); + WriteLn('USERS.DAT file and update all required data files.'); + WriteLn; + WriteLn('User''s to be packed:'); + WriteLn(' - All user''s currently marked for deletion'); + IF (DeleteByDate) THEN + WriteLn(' - All user''s that have not logged on since '+DeleteDateStr); + WriteLn; + WriteLn('This process could take awhile depending on the total number'); + WriteLn('of files on your BBS that require update.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + IF (NOT Exist('RENEGADE.DAT')) THEN + WriteLn('This utility must be executed in the same directory as RENEGADE.DAT!') + ELSE + BEGIN + Write('Reading RENEGADE.DAT ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done!'); + + WriteLn; + Write('Checking USERS.DAT for user''s to pack ... '); + Assign(UserFile,General.DataPath+'USERS.DAT'); + Reset(UserFile); + UsersToDelete := FALSE; + Counter := 2; + WHILE (Counter <= (FileSize(UserFile) - 1)) AND (NOT UsersToDelete) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags)) + AND (User.LastOn < PackedDeleteDate) THEN + UsersToDelete := TRUE; + Inc(Counter); + END; + WriteLn('Done!'); + + IF (NOT UsersToDelete) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'No deleted user''s found to pack!'); + END + ELSE + BEGIN + + Write('Updating USERS.DAT "UserID" with record number for all user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile) - 1) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + User.UserID := Counter; + Seek(UserFile,Counter); + Write(UserFile,User); + END; + WriteLn('Done!'); + + Write('Locating deleted user''s and creating USERS.DEL and USERS.BAK ... '); + Assign(UserFile1,General.DataPath+'USERS.DEL'); + ReWrite(UserFile1); + Assign(UserFile2,General.DataPath+'USERS.BAK'); + ReWrite(UserFile2); + Seek(UserFile,0); + Read(UserFile,User); + User.UserID := 0; + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + Seek(UserFile,1); + Read(UserFile,User); + User.UserID := 1; + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + FOR Counter := 2 TO (FileSize(UserFile) - 1) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags)) + AND (User.LastOn < PackedDeleteDate) THEN + BEGIN + Seek(UserFile1,FileSize(UserFile1)); + Write(UserFile1,User); + END + ELSE + BEGIN + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + END; + END; + Close(UserFile); + Close(UserFile2); + WriteLn('Done!'); + + Write('Removing voting records for deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillUserVotes(General.DataPath,User); + Seek(UserFile1,Counter); + Write(UserFile1,User); + END; + WriteLn('Done!'); + + Write('Setting SHORTMSG.DAT "Destin" to -1 for deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillShortMsgs(General.DataPath,User); + END; + WriteLn('Done!'); + + Write('Updating SHORTMSG.DAT "Destin" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateShortMsgs(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + (* + Write('Setting BATCHDL.DAT "BDLUserNum" to -1 for all deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillBatchQueue(General.DataPath,User); + END; + WriteLn('Done!'); + + Write('Updating BATCHDL.DAT "BDLUserNum" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateBatchQueue(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting EMAIL.HDR "MDeleted" for email to/from deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillUserEMail(General.DataPath,General.MsgPath,User); + Seek(UserFile1,Counter); + Write(UserFile1,User); + END; + WriteLn('Done!'); + + Write('Updating EMAIL.HDR "MTO/FROM" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateUserEMail(General.MsgPath,User,Counter); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating *.DIR files with sysop name/number for all deleted user''s ... '); + Assign(UserFile2,General.DataPath+'USERS.BAK'); + Reset(UserFile2); + Seek(UserFile2,1); + Read(UserFile2,SysOpUser); + Close(UserFile2); + Reset(UserFile1); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + UpdateDIRFilesDeletedUsers(General.DataPath,User,SysOpUser); + END; + WriteLn('Done!'); + + Write('Updating *.DIR files with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateDIRFilesExistingUsers(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting *.HDR files "MTO/FROM" to 0 for all deleted user''s ... '); + Reset(UserFile1); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + UpdateMsgFilesDeletedUsers(General.DataPath,General.MsgPath,User); + END; + WriteLn('Done!'); + + Write('Updating *.HDR files with new user number for existing user''s ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateMsgFilesExistingUsers(General.DataPath,General.MsgPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating file area scan flags for existing user''s ... '); + UpdateFileSCNFilesExistingUsers(General.DataPath); + WriteLn('Done!'); + + Write('Updating message area scan flags for existing user''s ... '); + UpdateMsgSCNFilesExistingUsers(General.DataPath,General.MsgPath); + WriteLn('Done!'); + + Write('Re-Scaning email waiting for existing user''s ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + ReScanUserEMail(General.MsgPath,User,Counter); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Re-Scaning voting for existing user''s ... '); + ResetVotes(General.DataPath); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + ReScanUserVotes(General.DataPath,User); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Updating UserID with record number for existing user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + User.UserID := Counter; + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Purging SHORTMSG.DAT of deleted records ... '); + PurgingShortMsgs(General.DataPath); + WriteLn('Done!'); + + Write('Purging BATCHDL.DAT of deleted records ... '); + PurgingBatchQueue(General.DataPath); + WriteLn('Done!'); + + Write('Updating all File Area file size ... '); + UpdateDIRFileSize(General.DataPath); + WriteLn('Done!'); + + Write('Sorting all file areas ... '); + SortAllFileAreas(General.DataPath); + WriteLn('Done!'); + + Write('Packing all message areas ... '); + PackMessageAreas(General.DataPath,General.MsgPath); + WriteLn('Done!'); + + Write('Deleting USERS.DEL ... '); + Close(UserFile1); + Erase(UserFile1); + WriteLn('Done!'); + + Write('Deleting USERS.DAT ... '); + Erase(UserFile); + WriteLn('Done!'); + + Write('Re-Naming USERS.BAK to USERS.DAT ... '); + ReName(UserFile2,General.DataPath+'USERS.DAT'); + WriteLn('Done!'); + + Write('Deleting USERS.IDX ... '); + Assign(F,General.DataPath+'USERS.IDX'); + Erase(F); + WriteLn('Done!'); + + Write('Creating and re-indexing USERS.IDX ... '); + TotalUsers := 0; + Assign(UserIndexFile,General.DataPath+'USERS.IDX'); + ReWrite(UserIndexFile); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + IF NOT (Deleted IN User.SFLags) THEN + Inc(TotalUsers); + InsertIndex(UserIndexFile,User.Name,Counter,FALSE,(Deleted IN User.SFLags)); + InsertIndex(UserIndexFile,User.RealName,Counter,TRUE,(Deleted IN User.SFLags)); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating RENEGADE.DAT "NumUsers" ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + General.NumUsers := TotalUsers; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done!'); + *) + + WriteLn; + WriteLn(^G^G^G'Your USERS.DAT file has been packed and associated files have been updated.'); + END; + END; + END; +END; + +BEGIN + PackUsers; +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGMAINT1.PAS b/SOURCE/UNUSED/RGMAINT1.PAS new file mode 100644 index 0000000..ebc4608 --- /dev/null +++ b/SOURCE/UNUSED/RGMAINT1.PAS @@ -0,0 +1,1584 @@ +{$M 35500,0,131072} +PROGRAM RGMAINT; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +TYPE + StorageType = + ( + Disk, + CD, + Copied + ); + + BatchDLRecordType = RECORD + BDLFileName: STRING[52]; + BDLStorage: StorageType; + BDLUserNum, + BDLSection, + BDLPoints, + BDLUploader: Integer; + BDLFSize, + BDLTime, + BDLOwnerCRC: LongInt; + BDLNoRatio: Boolean; + END; + + ULFRec = { *.DIR : File records } +{$IFDEF WIN32} packed {$ENDIF} RECORD + FileName: STRING[12]; { Filename } + LDescription: STRING[60]; { File description } + Credits: Integer; { File points } + Downloaded: Word; { Number DLs } + SizeMod: Word; { # chars over last 128 byte block } + Blocks: LongInt; { # 128 byte blks } + Owner: Word; { ULer of file } + StOwner: STRING[36]; { ULer's name } + Date: STRING[10]; { Date ULed } + DateN: Word; { Numeric Date ULed } + VPointer: LongInt; { Pointer to verbose descr, -1 if none } + FileStat: FiFlagSet; { File status } + Res: ARRAY [1..10] OF Byte; { RESERVED } + END; + + VotingR = { VOTING.DAT : Voting records } +{$IFDEF WIN32} packed {$ENDIF} RECORD + Description: STRING[65]; { voting question } + ACS: ACString; { ACS required to vote on this } + ChoiceNumber: Word; { number of choices } + NumVoted: Word; { number of votes on it } + MadeBy: STRING[35]; { who created it } + AddChoicesACS: ACString; { ACS required to add choices } + Choices: ARRAY [1..25] OF + {$IFDEF WIN32} packed {$ENDIF} RECORD + Description: STRING[65]; { answer description } + Description2: STRING[65]; { answer description #2 } + NumVoted: Integer; { # user's who picked this answer } + END; + END; + + DirF = FILE OF ULFRec; + SF = FILE OF UserIDXRec; + +CONST + DYNY: BOOLEAN = FALSE; + +FUNCTION AllCaps(S: STRING): STRING; +VAR + Counter: Byte; +BEGIN + FOR Counter := 1 TO Length(S) DO + IF (S[Counter] IN ['a'..'z']) THEN + S[Counter] := Chr(Ord(S[Counter]) - Ord('a')+Ord('A')); + AllCaps := S; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := s; +END; + +FUNCTION SQOutSp(S: STRING): STRING; +BEGIN + WHILE (Pos(' ',S) > 0) DO + Delete(S,Pos(' ',S),1); + SQOutSp := S; +END; + +FUNCTION Exist(fn: AStr): Boolean; +VAR + DirInfo: SearchRec; +BEGIN + FindFirst(SQOutSp(fn),AnyFile,DirInfo); + Exist := (DOSError = 0); +END; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +END; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +FUNCTION StrToInt(S: STRING): LongInt; +VAR + I: Integer; + L: LongInt; +BEGIN + Val(S,L,I); + IF (I > 0) THEN + BEGIN + S[0] := Chr(I - 1); + Val(S,L,I) + END; + IF (S = '') THEN + StrToInt := 0 + ELSE + StrToInt := L; +END; + +FUNCTION GetFileSize(FileName: AStr): LongInt; +VAR + F: FILE OF Byte; + FSize: LongInt; +BEGIN + FSize := 0; + IF (Exist(SQOutSp(FileName))) THEN + BEGIN + Assign(F,SQOutSp(FileName)); + Reset(F); + FSize := FileSize(F); + Close(F); + END; + GetFileSize := FSize; +END; + +PROCEDURE KillUserVotes(DataPath: STRING; VAR User: UserRecordType); +VAR + VotingFile: FILE OF VotingR; + Topic: VotingR; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter] > 0) THEN + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + IF (Topic.NumVoted > 0) THEN + Dec(Topic.NumVoted); + IF (Topic.Choices[User.Vote[Counter]].NumVoted > 0) THEN + Dec(Topic.Choices[User.Vote[Counter]].NumVoted); + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + User.Vote[Counter] := 0; + END; + Close(VotingFile); + END; +END; + +PROCEDURE ResetVotes(DataPath: STRING); +VAR + VotingFile: FILE OF VotingR; + Topic: VotingR; + Counter, + Counter1: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + Topic.NumVoted := 0;; + FOR Counter1 := 1 TO 25 DO + Topic.Choices[Counter1].NumVoted := 0; + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + END; + Close(VotingFile); + END; +END; + +PROCEDURE ReScanUserVotes(DataPath: STRING; VAR User: UserRecordType); +VAR + VotingFile: FILE OF VotingR; + Topic: VotingR; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter] > 0) THEN + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + Inc(Topic.NumVoted); + Inc(Topic.Choices[User.Vote[Counter]].NumVoted); + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + END; + Close(VotingFile); + END; +END; + +PROCEDURE KillShortMsgs(DataPath: STRING; VAR User: UserRecordType); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'SHORTMSG.DAT')) THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin = User.UserID) THEN + ShortMsg.Destin := -1; + Seek(ShortMsgFile,(Counter - 1)); + Write(ShortMsgFile,ShortMsg); + END; + Close(ShortMsgFile); + END; +END; + +PROCEDURE UpdateShortMsgs(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'SHORTMSG.DAT') THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin = User.UserID) THEN + ShortMsg.Destin := NewUserNumber; + Seek(ShortMsgFile,(Counter - 1)); + Write(ShortMsgFile,ShortMsg); + END; + Close(ShortMsgFile); + END; +END; + +PROCEDURE PurgingShortMsgs(DataPath: STRING); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsgFile1: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'SHORTMSG.DAT') THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + Assign(ShortMsgFile1,DataPath+'SHORTMSG.BAK'); + ReWrite(ShortMsgFile1); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin <> -1) THEN + BEGIN + Seek(ShortMsgFile1,FileSize(ShortMsgFile1)); + Write(ShortMsgFile1,ShortMsg); + END; + END; + Close(ShortMsgFile); + Erase(ShortMsgFile); + Close(ShortMsgFile1); + ReName(ShortMsgFile1,DataPath+'SHORTMSG.DAT'); + END; +END; + +PROCEDURE KillBatchQueue(DataPath: STRING; VAR User: UserRecordType); +VAR + BatchDLFile: FILE OF BatchDlRecordType; + BatchDL: BatchDlRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum = User.UserID) THEN + BatchDL.BDLUserNum := -1; + Seek(BatchDLFile,(Counter - 1)); + Write(BatchDLFile,BatchDL); + END; + Close(BatchDLFile); + END; +END; + +PROCEDURE UpdateBatchQueue(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer); +VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDL: BatchDlRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum = User.UserID) THEN + BatchDL.BDLUserNum := NewUserNumber; + Seek(BatchDLFile,(Counter - 1)); + Write(BatchDLFile,BatchDL); + END; + Close(BatchDLFile); + END; +END; + +PROCEDURE PurgingBatchQueue(DataPath: STRING); +VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDLFile1: FILE OF BatchDLRecordType; + BatchDL: BatchDLRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + Assign(BatchDLFile1,DataPath+'BATCHDL.BAK'); + ReWrite(BatchDLFile1); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum <> -1) THEN + BEGIN + Seek(BatchDLFile1,FileSize(BatchDLFile1)); + Write(BatchDLFile1,BatchDL); + END; + END; + Close(BatchDLFile); + Erase(BatchDLFile); + Close(BatchDLFile1); + ReName(BatchDLFile1,DataPath+'BATCHDL.DAT'); + END; +END; + +PROCEDURE KillUserEMail(DataPath,MsgPath: STRING; VAR User: UserRecordType); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF ((MHeader.MTO.UserNum = User.UserID) OR (MHeader.From.UserNum = User.UserID)) THEN + Include(MHeader.Status,MDeleted); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := 0; + IF (MHeader.FROM.UserNum = User.UserID) THEN + MHeader.FROM.UserNum := 0; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + User.Waiting := 0; + END; +END; + +PROCEDURE UpdateUserEMail(MsgPath: STRING; VAR User: UserRecordType; NewUserNum: Integer); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := NewUserNum; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := NewUserNum; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + END; +END; + +PROCEDURE ReScanUserEMail(MsgPath: STRING; VAR User: UserRecordType; UserNum: Integer); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + User.Waiting := 0; + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = UserNum) THEN + IF (NOT (MDeleted IN MHeader.Status)) THEN + Inc(User.Waiting); + END; + Close(MsgHdrF); + END; +END; + +PROCEDURE UpdateDIRFilesDeletedUsers(DataPath: STRING; User,SysOpUser: UserRecordType); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF ULFRec; + FileArea: FileAreaRecordType; + VerbF: FILE; + F: ULFRec; + Counter, + Counter1: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + IF (F.Owner = User.UserID) THEN + BEGIN + F.Owner := SysOpUser.UserID; + F.StOwner := AllCaps(SysOpUser.Name); + END; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateDIRFilesExistingUsers(DataPath: STRING; User: UserRecordType; NewUserNum: Integer); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF ULFRec; + VerbF: FILE; + FileArea: FileAreaRecordType; + F: ULFRec; + Counter, + Counter1: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + IF (F.Owner = User.UserID) THEN + F.Owner := NewUserNum; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateDIRFileSize(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF ULFRec; + FileArea: FileAreaRecordType; + VerbF: FILE; + F: ULFRec; + Counter, + Counter1: Integer; + FSize: Longint; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + FSize := GetFileSize(FileArea.DLPath+F.FileName); + IF (FSize = 0) THEN + BEGIN + F.SizeMod := 0; + F.Blocks := 0; + Include(F.FileStat,FIIsRequest); + END + ELSE + BEGIN + F.Blocks := FSize DIV 128; + F.SizeMod := FSize MOD 128; + END; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateFileSCNFilesExistingUsers(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + UserFile: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + ScnFile: FILE OF Boolean; + ScnFile1: FILE OF Boolean; + FileArea: FileAreaRecordType; + User: UserRecordType; + Path: STRING; + Counter, + Counter1, + NumUsers: Integer; + NewScanFBase: Boolean; +BEGIN + Assign(UserFile,DataPath+'USERS.DAT'); + Reset(UserFile); + Assign(UserFile2,DataPath+'USERS.BAK'); + Reset(UserFile2); + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Path := FileArea.Dlpath+FileArea.FileName + ELSE + Path := Datapath+FileArea.FileName; + Assign(ScnFile,Path+'.SCN'); + Reset(ScnFile); + IF (IOResult = 2) THEN + ReWrite(ScnFile); + Assign(ScnFile1,Path+'.SCB'); + ReWrite(ScnFile1); + NumUsers := (FileSize(UserFile) - 1); + IF (NumUsers > FileSize(ScnFile)) THEN + BEGIN + Seek(ScnFile,FileSize(ScnFile)); + NewScanFBase := TRUE; + FOR Counter1 := FileSize(ScnFile) TO (NumUsers - 1) DO + Write(ScnFile,NewScanFBase); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(ScnFile1,FileSize(ScnFile1)); + NewScanFBase := TRUE; + Write(ScnFile1,NewScanFBase); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter1); + Read(UserFile2,User); + Seek(ScnFile,(User.UserID - 1)); + Read(ScnFile,NewScanFBase); + Seek(ScnFile1,(Counter1 - 1)); + Write(ScnFile1,NewScanFBase); + END; + Close(ScnFile); + Erase(ScnFile); + Close(ScnFile1); + ReName(ScnFile1,Path+'.SCN'); + END; + Close(FileAreaFile); + Close(UserFile); + Close(UserFile2); +END; + +PROCEDURE UpdateMsgFilesDeletedUsers(DataPath,MsgPath: STRING; User: UserRecordType); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgHdrF: FILE OF MHeaderRec; + MsgTxtF: FILE; + MsgArea: MessageAreaRecordType; + MHeader: MHeaderRec; + Counter: Integer; + MsgNum: Word; +BEGIN + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,Counter); + Read(MsgAreaFile,MsgArea); + Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR'); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT'); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := 0; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := 0; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END; + Close(MsgAreaFile); +END; + +PROCEDURE UpdateMsgFilesExistingUsers(DataPath,MsgPath: STRING; User: UserRecordType; NewUserNum: Integer); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgHdrF: FILE OF MHeaderRec; + MsgTxtF: FILE; + MsgArea: MessageAreaRecordType; + MHeader: MHeaderRec; + Counter: Integer; + MsgNum: Word; +BEGIN + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,Counter); + Read(MsgAreaFile,MsgArea); + Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR'); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT'); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := NewUserNum; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := NewUserNum; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END; + Close(MsgAreaFile); +END; + +PROCEDURE UpdateMsgSCNFilesExistingUsers(DataPath,MsgPath: STRING); +VAR + MessageFile: FILE OF MessageAreaRecordType; + UserFile: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + MsgScanFile: FILE OF ScanRec; + MsgScanFile1: FILE OF ScanRec; + MsgArea: MessageAreaRecordType; + User: UserRecordType; + LastReadRecord: ScanRec; + Path: STRING; + Counter, + Counter1, + NumUsers: Integer; +BEGIN + Assign(UserFile,DataPath+'USERS.DAT'); + Reset(UserFile); + Assign(UserFile2,DataPath+'USERS.BAK'); + Reset(UserFile2); + Assign(MessageFile,DataPath+'MBASES.DAT'); + Reset(MessageFile); + FOR Counter := 0 TO (FileSize(MessageFile) - 1) DO + BEGIN + Seek(MessageFile,Counter); + Read(MessageFile,MsgArea); + Path := MsgPath+MsgArea.FileName; + Assign(MsgScanFile,Path+'.SCN'); + Reset(MsgScanFile); + IF (IOResult = 2) THEN + ReWrite(MsgScanFile); + Assign(MsgScanFile1,Path+'.SCB'); + ReWrite(MsgScanFile1); + NumUsers := (FileSize(UserFile) - 1); + IF (NumUsers > FileSize(MsgScanFile)) THEN + BEGIN + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgScanFile,FileSize(MsgScanFile)); + FOR Counter1 := FileSize(MSGScanFile) TO (NumUsers - 1) DO + Write(MsgScanFile,LastReadRecord); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgScanFile1,FileSize(MsgScanFile1)); + Write(MsgScanFile1,LastReadRecord); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter1); + Read(UserFile2,User); + Seek(MsgScanFile,(User.UserID - 1)); + Read(MsgScanFile,LastReadRecord); + Seek(MsgScanFile1,(Counter1 - 1)); + Write(MsgScanFile1,LastReadRecord); + END; + Close(MsgScanFile); + Erase(MsgScanFile); + Close(MsgScanFile1); + ReName(MsgScanFile1,Path+'.SCN'); + END; + Close(MessageFile); + Close(UserFile); + Close(UserFile2); +END; + +PROCEDURE PackMessageArea(MsgPath,FN: STRING; MaxM: LongInt); +VAR + Buffer: ARRAY [1..4096] OF Char; + MsgHdrF1, + MsgHdrF2: FILE OF MheaderRec; + BrdF1, + BrdF2: FILE; + MHeader: MheaderRec; + Numm, + i, + IDX, + TotLoad, + Buffered: Word; + NeedPack: Boolean; + + PROCEDURE ErrMsg; + BEGIN + Writeln('Error renaming temp files while packing.'); + END; + + PROCEDURE Kill(CONST FN: AStr); + VAR + F: FILE; + BEGIN + IF Exist(FN) THEN + BEGIN + Assign(F,FN); + Erase(F); + END; + END; + +BEGIN + NeedPack := FALSE; + FN := AllCaps(FN); + FN := MsgPath + FN; + + Assign(BrdF1,FN+'.DAT'); + Reset(BrdF1,1); + IF (IOResult <> 0) THEN + Exit; + + Assign(MsgHdrF1,FN+'.HDR'); + Reset(MsgHdrF1); + + IF (IOResult <> 0) THEN + BEGIN + Close(BrdF1); + Exit + END; + + IF (MaxM <> 0) AND (FileSize(MsgHdrF1) > MaxM) THEN + BEGIN + Numm := 0; + IDX := FileSize(MsgHdrF1); + WHILE (IDX > 0) DO + BEGIN + Seek(MsgHdrF1,(IDX - 1)); + Read(MsgHdrF1,MHeader); + IF NOT (MDeleted IN MHeader.Status) THEN + Inc(Numm); + IF (Numm > MaxM) AND NOT (Permanent IN MHeader.Status) THEN + BEGIN + MHeader.Status := [MDeleted]; + Seek(MsgHdrF1,(IDX - 1)); + Write(MsgHdrF1,MHeader); + END; + Dec(IDX); + END; + END + ELSE + BEGIN + + WHILE (FilePos(MsgHdrF1) < FileSize(MsgHdrF1)) AND (NOT NeedPack) DO + BEGIN + Read(MsgHdrF1,MHeader); + IF (MDeleted IN MHeader.Status) THEN + NeedPack := TRUE; + END; + + IF (NOT NeedPack) THEN + BEGIN + Close(MsgHdrF1); + Close(BrdF1); + Exit; + END; + END; + + Assign(BrdF2,FN+'.DA1'); + ReWrite(BrdF2,1); + + Assign(MsgHdrF2,FN+'.HD2'); + ReWrite(MsgHdrF2); + + Kill(FN+'.HD3'); + Kill(FN+'.DA3'); + + IDX := 1; + i := 0; + + WHILE (i <= FileSize(MsgHdrF1) - 1) DO + BEGIN + Seek(MsgHdrF1,i); + Read(MsgHdrF1,MHeader); + + IF (MHeader.Pointer - 1 + MHeader.TextSize > FileSize(BrdF1)) OR + (MHeader.Pointer < 1) THEN + MHeader.Status := [MDeleted]; + + IF NOT (MDeleted IN MHeader.Status) THEN + BEGIN + Inc(IDX); + Seek(BrdF1,MHeader.Pointer - 1); + MHeader.Pointer := (FileSize(BrdF2) + 1); + Write(MsgHdrF2,MHeader); + + TotLoad := 0; + IF (MHeader.TextSize > 0) THEN + WHILE (MHeader.TextSize > 0) DO + BEGIN + Buffered := MHeader.TextSize; + IF (Buffered > 4096) THEN + Buffered := 4096; + Dec(MHeader.TextSize,Buffered); + BlockRead(BrdF1,Buffer[1],Buffered); + BlockWrite(BrdF2,Buffer[1],Buffered); + END; + END; + Inc(i); + END; + + Close(BrdF1); + Close(BrdF2); + Close(MsgHdrF1); + Close(MsgHdrF2); + + ReName(BrdF1,FN+'.DA3'); { ReName .DAT to .DA3 } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Exit; + END; + + ReName(BrdF2,FN+'.DAT'); { ReName .DA2 to .DAT } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + Exit; + END; + + ReName(MsgHdrF1,FN+'.HD3'); { ReName .HDR to .HD3 } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Erase(BrdF2); { Erase .DA2 } + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + Exit; + END; + + ReName(MsgHdrF2,FN+'.HDR'); { ReName .HD2 to .HDR } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Erase(BrdF2); { Erase .DAT (new) } + Erase(MsgHdrF2); { Erase .HD2 (new) } + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + ReName(MsgHdrF1,FN+'.HDR'); { ReName .HD3 to .HDR } + Exit; + END; + + Erase(MsgHdrF1); + Erase(BrdF1); +END; + +PROCEDURE PackMessageAreas(DataPath,MsgPath: STRING); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgArea: MessageAreaRecordType; + MArea: Integer; +BEGIN + PackMessageArea(MsgPath,'EMAIL',0); + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR MArea := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,MArea); + Read(MsgAreaFile,MsgArea); + PackMessageArea(MsgPath,MsgArea.FIleName,MsgArea.MaxMsgs); + END; + Close(MsgAreaFile); +END; + +PROCEDURE SortFileArea(VAR DirFile1: DirF; NumFiles: Integer); +VAR + F1, + F2: ULFRec; + NumSorted, + RecNum, + RecNum1, + Gap: Integer; +BEGIN + Gap := NumFiles; + REPEAT; + Gap := (Gap DIV 2); + IF (Gap = 0) THEN + Gap := 1; + NumSorted := 0; + FOR RecNum := 1 TO (NumFiles - Gap) DO + BEGIN + RecNum1 := (RecNum + Gap); + Seek(DirFile1,(RecNum - 1)); + Read(DirFile1,F1); + Seek(DirFile1,(RecNum1 - 1)); + Read(DirFile1,F2); + IF (F1.FileName > F2.FileName) THEN + BEGIN + Seek(DirFile1,(RecNum - 1)); + Write(DirFile1,F2); + Seek(DirFile1,(RecNum1 - 1)); + Write(DirFile1,F1); + Inc(NumSorted); + END; + END; + UNTIL (NumSorted = 0) AND (Gap = 1); +END; + +PROCEDURE SortAllFileAreas(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: DirF; + FileArea: FileAreaRecordType; + F: ULFRec; + NumFiles, + Counter: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + NumFiles := FileSize(DirFile); + IF (NumFiles <> 0) THEN + SortFileArea(DirFile,NumFiles); + Close(DirFile); + END; + Close(FileAreaFile); +END; + +PROCEDURE InsertIndex(VAR UserIndexFile1: SF; Uname: AStr; UserNum: Integer; IsReal,IsDeleted: Boolean); +VAR + IndexR: UserIDXRec; + Current, + InsertAt: Integer; + Done: Boolean; + + PROCEDURE WriteIndex; + BEGIN + FillChar(IndexR,SizeOf(IndexR),0); + WITH IndexR DO + BEGIN + Name := Uname; + Number := UserNum; + RealName := IsReal; + Deleted := IsDeleted; + Left := -1; + Right := -1; + Write(UserIndexFile1,IndexR); + END + END; + +BEGIN + Done := FALSE; + Uname := Allcaps(Uname); + Current := 0; + Reset(UserIndexFile1); + IF (FileSize(UserIndexFile1) = 0) THEN + WriteIndex + ELSE + REPEAT + Seek(UserIndexFile1,Current); + InsertAt := Current; + Read(UserIndexFile1,IndexR); + IF (Uname < IndexR.Name) THEN + Current := IndexR.Left + ELSE IF (Uname > IndexR.Name) THEN + Current := IndexR.Right + ELSE IF (IndexR.Deleted <> IsDeleted) THEN + BEGIN + Done := TRUE; + IndexR.Deleted := IsDeleted; + IndexR.RealName := IsReal; + IndexR.Number := UserNum; + Seek(UserIndexFile1,Current); + Write(UserIndexFile1,IndexR); + END + ELSE + BEGIN + IF (UserNum <> IndexR.Number) THEN + WriteLn('Note: Duplicate user '+UName+' #'+IntToStr(IndexR.Number)+' and '+UName+' #'+IntToStr(UserNum)) + ELSE + BEGIN + IndexR.RealName := FALSE; + Seek(UserIndexFile1,Current); { Make it be his handle IF it's BOTH } + Write(UserIndexFile1,IndexR); + END; + Done := TRUE; + END; + UNTIL (Current = -1) OR (Done); + IF (Current = -1) THEN + BEGIN + IF (Uname < IndexR.Name) THEN + IndexR.Left := FileSize(UserIndexFile1) + ELSE + IndexR.Right := FileSize(UserIndexFile1); + Seek(UserIndexFile1,InsertAt); + Write(UserIndexFile1,IndexR); + Seek(UserIndexFile1,FileSize(UserIndexFile1)); + WriteIndex; + END; + Close(UserIndexFile1); +END; + +PROCEDURE PackUsers; +VAR + GeneralFile: FILE OF GeneralRecordType; + UserFile: FILE OF UserRecordType; + UserFile1: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + UserIndexFile: SF; + F: FILE; + General: GeneralRecordType; + User, + SysOpUser: UserRecordType; + DeleteDateStr: STRING; + TotalUsers, + Counter: Integer; + Year: Word; + PackedDeleteDate: LongInt; + UsersToDelete, + DeleteByDate, + InvalidDate: Boolean; +BEGIN + DeleteByDate := FALSE; + + IF (ParamCount > 0) THEN + FOR Counter := 1 TO ParamCount DO + IF (AllCaps(Copy(ParamStr(Counter),1,2)) = AllCaps('-D')) THEN + BEGIN + DeleteDateStr := Copy(ParamStr(Counter),3,Length(ParamStr(Counter))); + InvalidDate := FALSE; + IF (Length(DeleteDateStr) <> 10) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 0) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) > 12) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,4,2)) = 0) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [1,3,5,7,8,10,12]) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 31) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [4,6,9,11]) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 30) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) <> 0) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 28) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) = 0) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 29) THEN + InvalidDate := TRUE; + GetYear(Year); + IF (StrToInt(Copy(DeleteDateStr,7,4)) > Year) THEN + InvalidDate := TRUE; + + IF (InvalidDate) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'Invalid date or format, valid format is "00/00/0000'); + Exit; + END + ELSE + BEGIN + PackedDeleteDate := Date2PD(DeleteDateStr); + DeleteByDate := TRUE; + END; + END; + + ClrScr; + WriteLn('Renegade User Packer Version 1.0'); + Writeln('Copyright 2007 - The Renegade Developement Team'); + WriteLn; + Writeln('This utility will pack your Renegade BBS Version 09/30/06 '); + WriteLn('USERS.DAT file and update all required data files.'); + WriteLn; + WriteLn('User''s to be packed:'); + WriteLn(' - All user''s currently marked for deletion'); + IF (DeleteByDate) THEN + WriteLn(' - All user''s that have not logged on since '+DeleteDateStr); + WriteLn; + WriteLn('This process could take awhile depending on the total number'); + WriteLn('of files on your BBS that require update.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + IF (NOT Exist('RENEGADE.DAT')) THEN + WriteLn('This utility must be executed in the same directory as RENEGADE.DAT!') + ELSE + BEGIN + Write('Reading RENEGADE.DAT ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done!'); + + WriteLn; + Write('Checking USERS.DAT for user''s to pack ... '); + Assign(UserFile,General.DataPath+'USERS.DAT'); + Reset(UserFile); + UsersToDelete := FALSE; + Counter := 2; + WHILE (Counter <= (FileSize(UserFile) - 1)) AND (NOT UsersToDelete) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags)) + AND (User.LastOn < PackedDeleteDate) THEN + UsersToDelete := TRUE; + Inc(Counter); + END; + WriteLn('Done!'); + + IF (NOT UsersToDelete) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'No deleted user''s found to pack!'); + END + ELSE + BEGIN + + Write('Updating USERS.DAT "UserID" with record number for all user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile) - 1) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + User.UserID := Counter; + Seek(UserFile,Counter); + Write(UserFile,User); + END; + WriteLn('Done!'); + + Write('Locating deleted user''s and creating USERS.DEL and USERS.BAK ... '); + Assign(UserFile1,General.DataPath+'USERS.DEL'); + ReWrite(UserFile1); + Assign(UserFile2,General.DataPath+'USERS.BAK'); + ReWrite(UserFile2); + Seek(UserFile,0); + Read(UserFile,User); + User.UserID := 0; + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + Seek(UserFile,1); + Read(UserFile,User); + User.UserID := 1; + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + FOR Counter := 2 TO (FileSize(UserFile) - 1) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags)) + AND (User.LastOn < PackedDeleteDate) THEN + BEGIN + Seek(UserFile1,FileSize(UserFile1)); + Write(UserFile1,User); + END + ELSE + BEGIN + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + END; + END; + Close(UserFile); + Close(UserFile2); + WriteLn('Done!'); + + Write('Removing voting records for deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillUserVotes(General.DataPath,User); + Seek(UserFile1,Counter); + Write(UserFile1,User); + END; + WriteLn('Done!'); + + Write('Setting SHORTMSG.DAT "Destin" to -1 for deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillShortMsgs(General.DataPath,User); + END; + WriteLn('Done!'); + + Write('Updating SHORTMSG.DAT "Destin" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateSHortMsgs(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting BATCHDL.DAT "BDLUserNum" to -1 for all deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillBatchQueue(General.DataPath,User); + END; + WriteLn('Done!'); + + Write('Updating BATCHDL.DAT "BDLUserNum" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateBatchQueue(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting EMAIL.HDR "MDeleted" for email to/from deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillUserEMail(General.DataPath,General.MsgPath,User); + Seek(UserFile1,Counter); + Write(UserFile1,User); + END; + WriteLn('Done!'); + + Write('Updating EMAIL.HDR "MTO/FROM" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateUserEMail(General.MsgPath,User,Counter); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating *.DIR files with sysop name/number for all deleted user''s ... '); + Assign(UserFile2,General.DataPath+'USERS.BAK'); + Reset(UserFile2); + Seek(UserFile2,1); + Read(UserFile2,SysOpUser); + Close(UserFile2); + Reset(UserFile1); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + UpdateDIRFilesDeletedUsers(General.DataPath,User,SysOpUser); + END; + WriteLn('Done!'); + + Write('Updating *.DIR files with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateDIRFilesExistingUsers(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting *.HDR files "MTO/FROM" to 0 for all deleted user''s ... '); + Reset(UserFile1); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + UpdateMsgFilesDeletedUsers(General.DataPath,General.MsgPath,User); + END; + WriteLn('Done!'); + + Write('Updating *.HDR files with new user number for existing user''s ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateMsgFilesExistingUsers(General.DataPath,General.MsgPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating file area scan flags for existing user''s ... '); + UpdateFileSCNFilesExistingUsers(General.DataPath); + WriteLn('Done!'); + + Write('Updating message area scan flags for existing user''s ... '); + UpdateMsgSCNFilesExistingUsers(General.DataPath,General.MsgPath); + WriteLn('Done!'); + + Write('Re-Scaning email waiting for existing user''s ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + ReScanUserEMail(General.MsgPath,User,Counter); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Re-Scaning voting for existing user''s ... '); + ResetVotes(General.DataPath); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + ReScanUserVotes(General.DataPath,User); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Updating UserID with record number for existing user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + User.UserID := Counter; + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Purging SHORTMSG.DAT of deleted records ... '); + PurgingShortMsgs(General.DataPath); + WriteLn('Done!'); + + Write('Purging BATCHDL.DAT of deleted records ... '); + PurgingBatchQueue(General.DataPath); + WriteLn('Done!'); + + Write('Updating all File Area file size ... '); + UpdateDIRFileSize(General.DataPath); + WriteLn('Done!'); + + Write('Sorting all file areas ... '); + SortAllFileAreas(General.DataPath); + WriteLn('Done!'); + + Write('Packing all message areas ... '); + PackMessageAreas(General.DataPath,General.MsgPath); + WriteLn('Done!'); + + Write('Deleting USERS.DEL ... '); + Close(UserFile1); + Erase(UserFile1); + WriteLn('Done!'); + + Write('Deleting USERS.DAT ... '); + Erase(UserFile); + WriteLn('Done!'); + + Write('Re-Naming USERS.BAK to USERS.DAT ... '); + ReName(UserFile2,General.DataPath+'USERS.DAT'); + WriteLn('Done!'); + + Write('Deleting USERS.IDX ... '); + Assign(F,General.DataPath+'USERS.IDX'); + Erase(F); + WriteLn('Done!'); + + Write('Creating and re-indexing USERS.IDX ... '); + TotalUsers := 0; + Assign(UserIndexFile,General.DataPath+'USERS.IDX'); + ReWrite(UserIndexFile); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + IF NOT (Deleted IN User.SFLags) THEN + Inc(TotalUsers); + InsertIndex(UserIndexFile,User.Name,Counter,FALSE,(Deleted IN User.SFLags)); + InsertIndex(UserIndexFile,User.RealName,Counter,TRUE,(Deleted IN User.SFLags)); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating RENEGADE.DAT "NumUsers" ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + General.NumUsers := TotalUsers; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done!'); + + WriteLn; + WriteLn(^G^G^G'Your USERS.DAT file has been packed and associated files have been updated.'); + END; + END; + END; +END; + +BEGIN + PackUsers; +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGMAINT2.PAS b/SOURCE/UNUSED/RGMAINT2.PAS new file mode 100644 index 0000000..ebc4608 --- /dev/null +++ b/SOURCE/UNUSED/RGMAINT2.PAS @@ -0,0 +1,1584 @@ +{$M 35500,0,131072} +PROGRAM RGMAINT; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +TYPE + StorageType = + ( + Disk, + CD, + Copied + ); + + BatchDLRecordType = RECORD + BDLFileName: STRING[52]; + BDLStorage: StorageType; + BDLUserNum, + BDLSection, + BDLPoints, + BDLUploader: Integer; + BDLFSize, + BDLTime, + BDLOwnerCRC: LongInt; + BDLNoRatio: Boolean; + END; + + ULFRec = { *.DIR : File records } +{$IFDEF WIN32} packed {$ENDIF} RECORD + FileName: STRING[12]; { Filename } + LDescription: STRING[60]; { File description } + Credits: Integer; { File points } + Downloaded: Word; { Number DLs } + SizeMod: Word; { # chars over last 128 byte block } + Blocks: LongInt; { # 128 byte blks } + Owner: Word; { ULer of file } + StOwner: STRING[36]; { ULer's name } + Date: STRING[10]; { Date ULed } + DateN: Word; { Numeric Date ULed } + VPointer: LongInt; { Pointer to verbose descr, -1 if none } + FileStat: FiFlagSet; { File status } + Res: ARRAY [1..10] OF Byte; { RESERVED } + END; + + VotingR = { VOTING.DAT : Voting records } +{$IFDEF WIN32} packed {$ENDIF} RECORD + Description: STRING[65]; { voting question } + ACS: ACString; { ACS required to vote on this } + ChoiceNumber: Word; { number of choices } + NumVoted: Word; { number of votes on it } + MadeBy: STRING[35]; { who created it } + AddChoicesACS: ACString; { ACS required to add choices } + Choices: ARRAY [1..25] OF + {$IFDEF WIN32} packed {$ENDIF} RECORD + Description: STRING[65]; { answer description } + Description2: STRING[65]; { answer description #2 } + NumVoted: Integer; { # user's who picked this answer } + END; + END; + + DirF = FILE OF ULFRec; + SF = FILE OF UserIDXRec; + +CONST + DYNY: BOOLEAN = FALSE; + +FUNCTION AllCaps(S: STRING): STRING; +VAR + Counter: Byte; +BEGIN + FOR Counter := 1 TO Length(S) DO + IF (S[Counter] IN ['a'..'z']) THEN + S[Counter] := Chr(Ord(S[Counter]) - Ord('a')+Ord('A')); + AllCaps := S; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := s; +END; + +FUNCTION SQOutSp(S: STRING): STRING; +BEGIN + WHILE (Pos(' ',S) > 0) DO + Delete(S,Pos(' ',S),1); + SQOutSp := S; +END; + +FUNCTION Exist(fn: AStr): Boolean; +VAR + DirInfo: SearchRec; +BEGIN + FindFirst(SQOutSp(fn),AnyFile,DirInfo); + Exist := (DOSError = 0); +END; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +END; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +FUNCTION StrToInt(S: STRING): LongInt; +VAR + I: Integer; + L: LongInt; +BEGIN + Val(S,L,I); + IF (I > 0) THEN + BEGIN + S[0] := Chr(I - 1); + Val(S,L,I) + END; + IF (S = '') THEN + StrToInt := 0 + ELSE + StrToInt := L; +END; + +FUNCTION GetFileSize(FileName: AStr): LongInt; +VAR + F: FILE OF Byte; + FSize: LongInt; +BEGIN + FSize := 0; + IF (Exist(SQOutSp(FileName))) THEN + BEGIN + Assign(F,SQOutSp(FileName)); + Reset(F); + FSize := FileSize(F); + Close(F); + END; + GetFileSize := FSize; +END; + +PROCEDURE KillUserVotes(DataPath: STRING; VAR User: UserRecordType); +VAR + VotingFile: FILE OF VotingR; + Topic: VotingR; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter] > 0) THEN + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + IF (Topic.NumVoted > 0) THEN + Dec(Topic.NumVoted); + IF (Topic.Choices[User.Vote[Counter]].NumVoted > 0) THEN + Dec(Topic.Choices[User.Vote[Counter]].NumVoted); + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + User.Vote[Counter] := 0; + END; + Close(VotingFile); + END; +END; + +PROCEDURE ResetVotes(DataPath: STRING); +VAR + VotingFile: FILE OF VotingR; + Topic: VotingR; + Counter, + Counter1: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + Topic.NumVoted := 0;; + FOR Counter1 := 1 TO 25 DO + Topic.Choices[Counter1].NumVoted := 0; + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + END; + Close(VotingFile); + END; +END; + +PROCEDURE ReScanUserVotes(DataPath: STRING; VAR User: UserRecordType); +VAR + VotingFile: FILE OF VotingR; + Topic: VotingR; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'VOTING.DAT')) THEN + BEGIN + Assign(VotingFile,DataPath+'VOTING.DAT'); + Reset(VotingFile); + FOR Counter := 1 TO FileSize(VotingFile) DO + IF (User.Vote[Counter] > 0) THEN + BEGIN + Seek(VotingFile,(Counter - 1)); + Read(VotingFile,Topic); + Inc(Topic.NumVoted); + Inc(Topic.Choices[User.Vote[Counter]].NumVoted); + Seek(VotingFile,(Counter - 1)); + Write(VotingFile,Topic); + END; + Close(VotingFile); + END; +END; + +PROCEDURE KillShortMsgs(DataPath: STRING; VAR User: UserRecordType); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF (Exist(DataPath+'SHORTMSG.DAT')) THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin = User.UserID) THEN + ShortMsg.Destin := -1; + Seek(ShortMsgFile,(Counter - 1)); + Write(ShortMsgFile,ShortMsg); + END; + Close(ShortMsgFile); + END; +END; + +PROCEDURE UpdateShortMsgs(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'SHORTMSG.DAT') THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin = User.UserID) THEN + ShortMsg.Destin := NewUserNumber; + Seek(ShortMsgFile,(Counter - 1)); + Write(ShortMsgFile,ShortMsg); + END; + Close(ShortMsgFile); + END; +END; + +PROCEDURE PurgingShortMsgs(DataPath: STRING); +VAR + ShortMsgFile: FILE OF ShortMessageRecordType; + ShortMsgFile1: FILE OF ShortMessageRecordType; + ShortMsg: ShortMessageRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'SHORTMSG.DAT') THEN + BEGIN + Assign(ShortMsgFile,DataPath+'SHORTMSG.DAT'); + Reset(ShortMsgFile); + Assign(ShortMsgFile1,DataPath+'SHORTMSG.BAK'); + ReWrite(ShortMsgFile1); + FOR Counter := 1 TO FileSize(ShortMsgFile) DO + BEGIN + Seek(ShortMsgFile,(Counter - 1)); + Read(ShortMsgFile,ShortMsg); + IF (ShortMsg.Destin <> -1) THEN + BEGIN + Seek(ShortMsgFile1,FileSize(ShortMsgFile1)); + Write(ShortMsgFile1,ShortMsg); + END; + END; + Close(ShortMsgFile); + Erase(ShortMsgFile); + Close(ShortMsgFile1); + ReName(ShortMsgFile1,DataPath+'SHORTMSG.DAT'); + END; +END; + +PROCEDURE KillBatchQueue(DataPath: STRING; VAR User: UserRecordType); +VAR + BatchDLFile: FILE OF BatchDlRecordType; + BatchDL: BatchDlRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum = User.UserID) THEN + BatchDL.BDLUserNum := -1; + Seek(BatchDLFile,(Counter - 1)); + Write(BatchDLFile,BatchDL); + END; + Close(BatchDLFile); + END; +END; + +PROCEDURE UpdateBatchQueue(DataPath: STRING; VAR User: UserRecordType; NewUserNumber: Integer); +VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDL: BatchDlRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum = User.UserID) THEN + BatchDL.BDLUserNum := NewUserNumber; + Seek(BatchDLFile,(Counter - 1)); + Write(BatchDLFile,BatchDL); + END; + Close(BatchDLFile); + END; +END; + +PROCEDURE PurgingBatchQueue(DataPath: STRING); +VAR + BatchDLFile: FILE OF BatchDLRecordType; + BatchDLFile1: FILE OF BatchDLRecordType; + BatchDL: BatchDLRecordType; + Counter: Integer; +BEGIN + IF Exist(DataPath+'BATCHDL.DAT') THEN + BEGIN + Assign(BatchDLFile,DataPath+'BATCHDL.DAT'); + Reset(BatchDLFile); + Assign(BatchDLFile1,DataPath+'BATCHDL.BAK'); + ReWrite(BatchDLFile1); + FOR Counter := 1 TO FileSize(BatchDLFile) DO + BEGIN + Seek(BatchDLFile,(Counter - 1)); + Read(BatchDLFile,BatchDL); + IF (BatchDL.BDLUserNum <> -1) THEN + BEGIN + Seek(BatchDLFile1,FileSize(BatchDLFile1)); + Write(BatchDLFile1,BatchDL); + END; + END; + Close(BatchDLFile); + Erase(BatchDLFile); + Close(BatchDLFile1); + ReName(BatchDLFile1,DataPath+'BATCHDL.DAT'); + END; +END; + +PROCEDURE KillUserEMail(DataPath,MsgPath: STRING; VAR User: UserRecordType); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF ((MHeader.MTO.UserNum = User.UserID) OR (MHeader.From.UserNum = User.UserID)) THEN + Include(MHeader.Status,MDeleted); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := 0; + IF (MHeader.FROM.UserNum = User.UserID) THEN + MHeader.FROM.UserNum := 0; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + User.Waiting := 0; + END; +END; + +PROCEDURE UpdateUserEMail(MsgPath: STRING; VAR User: UserRecordType; NewUserNum: Integer); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := NewUserNum; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := NewUserNum; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + END; +END; + +PROCEDURE ReScanUserEMail(MsgPath: STRING; VAR User: UserRecordType; UserNum: Integer); +VAR + MsgHdrF: FILE OF MHeaderRec; + MHeader: MHeaderRec; + MsgNum: Word; +BEGIN + IF (Exist(MsgPath+'EMAIL.HDR')) THEN + BEGIN + User.Waiting := 0; + Assign(MsgHdrF,MsgPath+'EMAIL.HDR'); + Reset(MsgHdrF); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = UserNum) THEN + IF (NOT (MDeleted IN MHeader.Status)) THEN + Inc(User.Waiting); + END; + Close(MsgHdrF); + END; +END; + +PROCEDURE UpdateDIRFilesDeletedUsers(DataPath: STRING; User,SysOpUser: UserRecordType); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF ULFRec; + FileArea: FileAreaRecordType; + VerbF: FILE; + F: ULFRec; + Counter, + Counter1: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + IF (F.Owner = User.UserID) THEN + BEGIN + F.Owner := SysOpUser.UserID; + F.StOwner := AllCaps(SysOpUser.Name); + END; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateDIRFilesExistingUsers(DataPath: STRING; User: UserRecordType; NewUserNum: Integer); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF ULFRec; + VerbF: FILE; + FileArea: FileAreaRecordType; + F: ULFRec; + Counter, + Counter1: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + IF (F.Owner = User.UserID) THEN + F.Owner := NewUserNum; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateDIRFileSize(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: FILE OF ULFRec; + FileArea: FileAreaRecordType; + VerbF: FILE; + F: ULFRec; + Counter, + Counter1: Integer; + FSize: Longint; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(VerbF,FileArea.Dlpath+FileArea.FileName+'.EXT') + ELSE + Assign(VerbF,Datapath+FileArea.FileName+'.EXT'); + Reset(VerbF,1); + IF (IOResult = 2) THEN + ReWrite(VerbF,1); + FOR Counter1 := 0 TO (FileSize(DirFile) - 1) DO + BEGIN + Seek(DirFile,Counter1); + Read(DirFile,F); + FSize := GetFileSize(FileArea.DLPath+F.FileName); + IF (FSize = 0) THEN + BEGIN + F.SizeMod := 0; + F.Blocks := 0; + Include(F.FileStat,FIIsRequest); + END + ELSE + BEGIN + F.Blocks := FSize DIV 128; + F.SizeMod := FSize MOD 128; + END; + Seek(DirFile,Counter1); + Write(DirFile,F); + END; + Close(DirFile); + Close(VerbF); + END; + Close(FileAreaFile); +END; + +PROCEDURE UpdateFileSCNFilesExistingUsers(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + UserFile: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + ScnFile: FILE OF Boolean; + ScnFile1: FILE OF Boolean; + FileArea: FileAreaRecordType; + User: UserRecordType; + Path: STRING; + Counter, + Counter1, + NumUsers: Integer; + NewScanFBase: Boolean; +BEGIN + Assign(UserFile,DataPath+'USERS.DAT'); + Reset(UserFile); + Assign(UserFile2,DataPath+'USERS.BAK'); + Reset(UserFile2); + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Path := FileArea.Dlpath+FileArea.FileName + ELSE + Path := Datapath+FileArea.FileName; + Assign(ScnFile,Path+'.SCN'); + Reset(ScnFile); + IF (IOResult = 2) THEN + ReWrite(ScnFile); + Assign(ScnFile1,Path+'.SCB'); + ReWrite(ScnFile1); + NumUsers := (FileSize(UserFile) - 1); + IF (NumUsers > FileSize(ScnFile)) THEN + BEGIN + Seek(ScnFile,FileSize(ScnFile)); + NewScanFBase := TRUE; + FOR Counter1 := FileSize(ScnFile) TO (NumUsers - 1) DO + Write(ScnFile,NewScanFBase); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(ScnFile1,FileSize(ScnFile1)); + NewScanFBase := TRUE; + Write(ScnFile1,NewScanFBase); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter1); + Read(UserFile2,User); + Seek(ScnFile,(User.UserID - 1)); + Read(ScnFile,NewScanFBase); + Seek(ScnFile1,(Counter1 - 1)); + Write(ScnFile1,NewScanFBase); + END; + Close(ScnFile); + Erase(ScnFile); + Close(ScnFile1); + ReName(ScnFile1,Path+'.SCN'); + END; + Close(FileAreaFile); + Close(UserFile); + Close(UserFile2); +END; + +PROCEDURE UpdateMsgFilesDeletedUsers(DataPath,MsgPath: STRING; User: UserRecordType); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgHdrF: FILE OF MHeaderRec; + MsgTxtF: FILE; + MsgArea: MessageAreaRecordType; + MHeader: MHeaderRec; + Counter: Integer; + MsgNum: Word; +BEGIN + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,Counter); + Read(MsgAreaFile,MsgArea); + Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR'); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT'); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := 0; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := 0; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END; + Close(MsgAreaFile); +END; + +PROCEDURE UpdateMsgFilesExistingUsers(DataPath,MsgPath: STRING; User: UserRecordType; NewUserNum: Integer); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgHdrF: FILE OF MHeaderRec; + MsgTxtF: FILE; + MsgArea: MessageAreaRecordType; + MHeader: MHeaderRec; + Counter: Integer; + MsgNum: Word; +BEGIN + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR Counter := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,Counter); + Read(MsgAreaFile,MsgArea); + Assign(MsgHdrF,MsgPath+MsgArea.FileName+'.HDR'); + Reset(MsgHdrF); + IF (IOResult = 2) THEN + ReWrite(MsgHdrF); + Assign(MsgTxtF,MsgPath+MsgArea.FileName+'.DAT'); + Reset(MsgTxtF,1); + IF (IOResult = 2) THEN + ReWrite(MsgTxtF,1); + FOR MsgNum := 1 TO FileSize(MsgHdrF) DO + BEGIN + Seek(MsgHdrF,(MsgNum - 1)); + Read(MsgHdrF,MHeader); + IF (MHeader.MTO.UserNum = User.UserID) THEN + MHeader.MTO.UserNum := NewUserNum; + IF (MHeader.From.UserNum = User.UserID) THEN + MHeader.From.UserNum := NewUserNum; + Seek(MsgHdrF,(MsgNum - 1)); + Write(MsgHdrF,MHeader); + END; + Close(MsgHdrF); + Close(MsgTxtF); + END; + Close(MsgAreaFile); +END; + +PROCEDURE UpdateMsgSCNFilesExistingUsers(DataPath,MsgPath: STRING); +VAR + MessageFile: FILE OF MessageAreaRecordType; + UserFile: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + MsgScanFile: FILE OF ScanRec; + MsgScanFile1: FILE OF ScanRec; + MsgArea: MessageAreaRecordType; + User: UserRecordType; + LastReadRecord: ScanRec; + Path: STRING; + Counter, + Counter1, + NumUsers: Integer; +BEGIN + Assign(UserFile,DataPath+'USERS.DAT'); + Reset(UserFile); + Assign(UserFile2,DataPath+'USERS.BAK'); + Reset(UserFile2); + Assign(MessageFile,DataPath+'MBASES.DAT'); + Reset(MessageFile); + FOR Counter := 0 TO (FileSize(MessageFile) - 1) DO + BEGIN + Seek(MessageFile,Counter); + Read(MessageFile,MsgArea); + Path := MsgPath+MsgArea.FileName; + Assign(MsgScanFile,Path+'.SCN'); + Reset(MsgScanFile); + IF (IOResult = 2) THEN + ReWrite(MsgScanFile); + Assign(MsgScanFile1,Path+'.SCB'); + ReWrite(MsgScanFile1); + NumUsers := (FileSize(UserFile) - 1); + IF (NumUsers > FileSize(MsgScanFile)) THEN + BEGIN + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgScanFile,FileSize(MsgScanFile)); + FOR Counter1 := FileSize(MSGScanFile) TO (NumUsers - 1) DO + Write(MsgScanFile,LastReadRecord); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + WITH LastReadRecord DO + BEGIN + LastRead := 0; + NewScan := TRUE; + END; + Seek(MsgScanFile1,FileSize(MsgScanFile1)); + Write(MsgScanFile1,LastReadRecord); + END; + FOR Counter1 := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter1); + Read(UserFile2,User); + Seek(MsgScanFile,(User.UserID - 1)); + Read(MsgScanFile,LastReadRecord); + Seek(MsgScanFile1,(Counter1 - 1)); + Write(MsgScanFile1,LastReadRecord); + END; + Close(MsgScanFile); + Erase(MsgScanFile); + Close(MsgScanFile1); + ReName(MsgScanFile1,Path+'.SCN'); + END; + Close(MessageFile); + Close(UserFile); + Close(UserFile2); +END; + +PROCEDURE PackMessageArea(MsgPath,FN: STRING; MaxM: LongInt); +VAR + Buffer: ARRAY [1..4096] OF Char; + MsgHdrF1, + MsgHdrF2: FILE OF MheaderRec; + BrdF1, + BrdF2: FILE; + MHeader: MheaderRec; + Numm, + i, + IDX, + TotLoad, + Buffered: Word; + NeedPack: Boolean; + + PROCEDURE ErrMsg; + BEGIN + Writeln('Error renaming temp files while packing.'); + END; + + PROCEDURE Kill(CONST FN: AStr); + VAR + F: FILE; + BEGIN + IF Exist(FN) THEN + BEGIN + Assign(F,FN); + Erase(F); + END; + END; + +BEGIN + NeedPack := FALSE; + FN := AllCaps(FN); + FN := MsgPath + FN; + + Assign(BrdF1,FN+'.DAT'); + Reset(BrdF1,1); + IF (IOResult <> 0) THEN + Exit; + + Assign(MsgHdrF1,FN+'.HDR'); + Reset(MsgHdrF1); + + IF (IOResult <> 0) THEN + BEGIN + Close(BrdF1); + Exit + END; + + IF (MaxM <> 0) AND (FileSize(MsgHdrF1) > MaxM) THEN + BEGIN + Numm := 0; + IDX := FileSize(MsgHdrF1); + WHILE (IDX > 0) DO + BEGIN + Seek(MsgHdrF1,(IDX - 1)); + Read(MsgHdrF1,MHeader); + IF NOT (MDeleted IN MHeader.Status) THEN + Inc(Numm); + IF (Numm > MaxM) AND NOT (Permanent IN MHeader.Status) THEN + BEGIN + MHeader.Status := [MDeleted]; + Seek(MsgHdrF1,(IDX - 1)); + Write(MsgHdrF1,MHeader); + END; + Dec(IDX); + END; + END + ELSE + BEGIN + + WHILE (FilePos(MsgHdrF1) < FileSize(MsgHdrF1)) AND (NOT NeedPack) DO + BEGIN + Read(MsgHdrF1,MHeader); + IF (MDeleted IN MHeader.Status) THEN + NeedPack := TRUE; + END; + + IF (NOT NeedPack) THEN + BEGIN + Close(MsgHdrF1); + Close(BrdF1); + Exit; + END; + END; + + Assign(BrdF2,FN+'.DA1'); + ReWrite(BrdF2,1); + + Assign(MsgHdrF2,FN+'.HD2'); + ReWrite(MsgHdrF2); + + Kill(FN+'.HD3'); + Kill(FN+'.DA3'); + + IDX := 1; + i := 0; + + WHILE (i <= FileSize(MsgHdrF1) - 1) DO + BEGIN + Seek(MsgHdrF1,i); + Read(MsgHdrF1,MHeader); + + IF (MHeader.Pointer - 1 + MHeader.TextSize > FileSize(BrdF1)) OR + (MHeader.Pointer < 1) THEN + MHeader.Status := [MDeleted]; + + IF NOT (MDeleted IN MHeader.Status) THEN + BEGIN + Inc(IDX); + Seek(BrdF1,MHeader.Pointer - 1); + MHeader.Pointer := (FileSize(BrdF2) + 1); + Write(MsgHdrF2,MHeader); + + TotLoad := 0; + IF (MHeader.TextSize > 0) THEN + WHILE (MHeader.TextSize > 0) DO + BEGIN + Buffered := MHeader.TextSize; + IF (Buffered > 4096) THEN + Buffered := 4096; + Dec(MHeader.TextSize,Buffered); + BlockRead(BrdF1,Buffer[1],Buffered); + BlockWrite(BrdF2,Buffer[1],Buffered); + END; + END; + Inc(i); + END; + + Close(BrdF1); + Close(BrdF2); + Close(MsgHdrF1); + Close(MsgHdrF2); + + ReName(BrdF1,FN+'.DA3'); { ReName .DAT to .DA3 } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Exit; + END; + + ReName(BrdF2,FN+'.DAT'); { ReName .DA2 to .DAT } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + Exit; + END; + + ReName(MsgHdrF1,FN+'.HD3'); { ReName .HDR to .HD3 } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Erase(BrdF2); { Erase .DA2 } + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + Exit; + END; + + ReName(MsgHdrF2,FN+'.HDR'); { ReName .HD2 to .HDR } + + IF (IOResult <> 0) THEN { Didn't work, abort } + BEGIN + ErrMsg; + Erase(BrdF2); { Erase .DAT (new) } + Erase(MsgHdrF2); { Erase .HD2 (new) } + ReName(BrdF1,FN+'.DAT'); { ReName .DA3 to .DAT } + ReName(MsgHdrF1,FN+'.HDR'); { ReName .HD3 to .HDR } + Exit; + END; + + Erase(MsgHdrF1); + Erase(BrdF1); +END; + +PROCEDURE PackMessageAreas(DataPath,MsgPath: STRING); +VAR + MsgAreaFile: FILE OF MessageAreaRecordType; + MsgArea: MessageAreaRecordType; + MArea: Integer; +BEGIN + PackMessageArea(MsgPath,'EMAIL',0); + Assign(MsgAreaFile,DataPath+'MBASES.DAT'); + Reset(MsgAreaFile); + FOR MArea := 0 TO (FileSize(MsgAreaFile) - 1) DO + BEGIN + Seek(MsgAreaFile,MArea); + Read(MsgAreaFile,MsgArea); + PackMessageArea(MsgPath,MsgArea.FIleName,MsgArea.MaxMsgs); + END; + Close(MsgAreaFile); +END; + +PROCEDURE SortFileArea(VAR DirFile1: DirF; NumFiles: Integer); +VAR + F1, + F2: ULFRec; + NumSorted, + RecNum, + RecNum1, + Gap: Integer; +BEGIN + Gap := NumFiles; + REPEAT; + Gap := (Gap DIV 2); + IF (Gap = 0) THEN + Gap := 1; + NumSorted := 0; + FOR RecNum := 1 TO (NumFiles - Gap) DO + BEGIN + RecNum1 := (RecNum + Gap); + Seek(DirFile1,(RecNum - 1)); + Read(DirFile1,F1); + Seek(DirFile1,(RecNum1 - 1)); + Read(DirFile1,F2); + IF (F1.FileName > F2.FileName) THEN + BEGIN + Seek(DirFile1,(RecNum - 1)); + Write(DirFile1,F2); + Seek(DirFile1,(RecNum1 - 1)); + Write(DirFile1,F1); + Inc(NumSorted); + END; + END; + UNTIL (NumSorted = 0) AND (Gap = 1); +END; + +PROCEDURE SortAllFileAreas(DataPath: STRING); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + DirFile: DirF; + FileArea: FileAreaRecordType; + F: ULFRec; + NumFiles, + Counter: Integer; +BEGIN + Assign(FileAreaFile,DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + FOR Counter := 0 TO (FileSize(FileAreaFile) - 1) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + IF (FADirDLPath IN FileArea.FAFlags) THEN + Assign(Dirfile,FileArea.Dlpath+FileArea.FileName+'.DIR') + ELSE + Assign(Dirfile,Datapath+FileArea.FileName+'.DIR'); + Reset(Dirfile); + IF (IOResult = 2) THEN + ReWrite(Dirfile); + NumFiles := FileSize(DirFile); + IF (NumFiles <> 0) THEN + SortFileArea(DirFile,NumFiles); + Close(DirFile); + END; + Close(FileAreaFile); +END; + +PROCEDURE InsertIndex(VAR UserIndexFile1: SF; Uname: AStr; UserNum: Integer; IsReal,IsDeleted: Boolean); +VAR + IndexR: UserIDXRec; + Current, + InsertAt: Integer; + Done: Boolean; + + PROCEDURE WriteIndex; + BEGIN + FillChar(IndexR,SizeOf(IndexR),0); + WITH IndexR DO + BEGIN + Name := Uname; + Number := UserNum; + RealName := IsReal; + Deleted := IsDeleted; + Left := -1; + Right := -1; + Write(UserIndexFile1,IndexR); + END + END; + +BEGIN + Done := FALSE; + Uname := Allcaps(Uname); + Current := 0; + Reset(UserIndexFile1); + IF (FileSize(UserIndexFile1) = 0) THEN + WriteIndex + ELSE + REPEAT + Seek(UserIndexFile1,Current); + InsertAt := Current; + Read(UserIndexFile1,IndexR); + IF (Uname < IndexR.Name) THEN + Current := IndexR.Left + ELSE IF (Uname > IndexR.Name) THEN + Current := IndexR.Right + ELSE IF (IndexR.Deleted <> IsDeleted) THEN + BEGIN + Done := TRUE; + IndexR.Deleted := IsDeleted; + IndexR.RealName := IsReal; + IndexR.Number := UserNum; + Seek(UserIndexFile1,Current); + Write(UserIndexFile1,IndexR); + END + ELSE + BEGIN + IF (UserNum <> IndexR.Number) THEN + WriteLn('Note: Duplicate user '+UName+' #'+IntToStr(IndexR.Number)+' and '+UName+' #'+IntToStr(UserNum)) + ELSE + BEGIN + IndexR.RealName := FALSE; + Seek(UserIndexFile1,Current); { Make it be his handle IF it's BOTH } + Write(UserIndexFile1,IndexR); + END; + Done := TRUE; + END; + UNTIL (Current = -1) OR (Done); + IF (Current = -1) THEN + BEGIN + IF (Uname < IndexR.Name) THEN + IndexR.Left := FileSize(UserIndexFile1) + ELSE + IndexR.Right := FileSize(UserIndexFile1); + Seek(UserIndexFile1,InsertAt); + Write(UserIndexFile1,IndexR); + Seek(UserIndexFile1,FileSize(UserIndexFile1)); + WriteIndex; + END; + Close(UserIndexFile1); +END; + +PROCEDURE PackUsers; +VAR + GeneralFile: FILE OF GeneralRecordType; + UserFile: FILE OF UserRecordType; + UserFile1: FILE OF UserRecordType; + UserFile2: FILE OF UserRecordType; + UserIndexFile: SF; + F: FILE; + General: GeneralRecordType; + User, + SysOpUser: UserRecordType; + DeleteDateStr: STRING; + TotalUsers, + Counter: Integer; + Year: Word; + PackedDeleteDate: LongInt; + UsersToDelete, + DeleteByDate, + InvalidDate: Boolean; +BEGIN + DeleteByDate := FALSE; + + IF (ParamCount > 0) THEN + FOR Counter := 1 TO ParamCount DO + IF (AllCaps(Copy(ParamStr(Counter),1,2)) = AllCaps('-D')) THEN + BEGIN + DeleteDateStr := Copy(ParamStr(Counter),3,Length(ParamStr(Counter))); + InvalidDate := FALSE; + IF (Length(DeleteDateStr) <> 10) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 0) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) > 12) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,4,2)) = 0) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [1,3,5,7,8,10,12]) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 31) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) IN [4,6,9,11]) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 30) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) <> 0) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 28) THEN + InvalidDate := TRUE; + IF (StrToInt(Copy(DeleteDateStr,1,2)) = 2) AND ((StrToInt(Copy(DeleteDateStr,7,4)) MOD 4) = 0) THEN + IF (StrToInt(Copy(DeleteDateStr,4,2)) > 29) THEN + InvalidDate := TRUE; + GetYear(Year); + IF (StrToInt(Copy(DeleteDateStr,7,4)) > Year) THEN + InvalidDate := TRUE; + + IF (InvalidDate) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'Invalid date or format, valid format is "00/00/0000'); + Exit; + END + ELSE + BEGIN + PackedDeleteDate := Date2PD(DeleteDateStr); + DeleteByDate := TRUE; + END; + END; + + ClrScr; + WriteLn('Renegade User Packer Version 1.0'); + Writeln('Copyright 2007 - The Renegade Developement Team'); + WriteLn; + Writeln('This utility will pack your Renegade BBS Version 09/30/06 '); + WriteLn('USERS.DAT file and update all required data files.'); + WriteLn; + WriteLn('User''s to be packed:'); + WriteLn(' - All user''s currently marked for deletion'); + IF (DeleteByDate) THEN + WriteLn(' - All user''s that have not logged on since '+DeleteDateStr); + WriteLn; + WriteLn('This process could take awhile depending on the total number'); + WriteLn('of files on your BBS that require update.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + IF (NOT Exist('RENEGADE.DAT')) THEN + WriteLn('This utility must be executed in the same directory as RENEGADE.DAT!') + ELSE + BEGIN + Write('Reading RENEGADE.DAT ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done!'); + + WriteLn; + Write('Checking USERS.DAT for user''s to pack ... '); + Assign(UserFile,General.DataPath+'USERS.DAT'); + Reset(UserFile); + UsersToDelete := FALSE; + Counter := 2; + WHILE (Counter <= (FileSize(UserFile) - 1)) AND (NOT UsersToDelete) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags)) + AND (User.LastOn < PackedDeleteDate) THEN + UsersToDelete := TRUE; + Inc(Counter); + END; + WriteLn('Done!'); + + IF (NOT UsersToDelete) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'No deleted user''s found to pack!'); + END + ELSE + BEGIN + + Write('Updating USERS.DAT "UserID" with record number for all user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile) - 1) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + User.UserID := Counter; + Seek(UserFile,Counter); + Write(UserFile,User); + END; + WriteLn('Done!'); + + Write('Locating deleted user''s and creating USERS.DEL and USERS.BAK ... '); + Assign(UserFile1,General.DataPath+'USERS.DEL'); + ReWrite(UserFile1); + Assign(UserFile2,General.DataPath+'USERS.BAK'); + ReWrite(UserFile2); + Seek(UserFile,0); + Read(UserFile,User); + User.UserID := 0; + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + Seek(UserFile,1); + Read(UserFile,User); + User.UserID := 1; + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + FOR Counter := 2 TO (FileSize(UserFile) - 1) DO + BEGIN + Seek(UserFile,Counter); + Read(UserFile,User); + IF (Deleted IN User.SFlags) OR (DeleteByDate) AND (NOT (FNoDeletion IN User.Flags)) + AND (User.LastOn < PackedDeleteDate) THEN + BEGIN + Seek(UserFile1,FileSize(UserFile1)); + Write(UserFile1,User); + END + ELSE + BEGIN + Seek(UserFile2,FileSize(UserFile2)); + Write(UserFile2,User); + END; + END; + Close(UserFile); + Close(UserFile2); + WriteLn('Done!'); + + Write('Removing voting records for deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillUserVotes(General.DataPath,User); + Seek(UserFile1,Counter); + Write(UserFile1,User); + END; + WriteLn('Done!'); + + Write('Setting SHORTMSG.DAT "Destin" to -1 for deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillShortMsgs(General.DataPath,User); + END; + WriteLn('Done!'); + + Write('Updating SHORTMSG.DAT "Destin" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateSHortMsgs(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting BATCHDL.DAT "BDLUserNum" to -1 for all deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillBatchQueue(General.DataPath,User); + END; + WriteLn('Done!'); + + Write('Updating BATCHDL.DAT "BDLUserNum" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateBatchQueue(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting EMAIL.HDR "MDeleted" for email to/from deleted user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + KillUserEMail(General.DataPath,General.MsgPath,User); + Seek(UserFile1,Counter); + Write(UserFile1,User); + END; + WriteLn('Done!'); + + Write('Updating EMAIL.HDR "MTO/FROM" with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateUserEMail(General.MsgPath,User,Counter); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating *.DIR files with sysop name/number for all deleted user''s ... '); + Assign(UserFile2,General.DataPath+'USERS.BAK'); + Reset(UserFile2); + Seek(UserFile2,1); + Read(UserFile2,SysOpUser); + Close(UserFile2); + Reset(UserFile1); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + UpdateDIRFilesDeletedUsers(General.DataPath,User,SysOpUser); + END; + WriteLn('Done!'); + + Write('Updating *.DIR files with new user number ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateDIRFilesExistingUsers(General.DataPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Setting *.HDR files "MTO/FROM" to 0 for all deleted user''s ... '); + Reset(UserFile1); + FOR Counter := 0 TO (FileSize(UserFile1) - 1) DO + BEGIN + Seek(UserFile1,Counter); + Read(UserFile1,User); + UpdateMsgFilesDeletedUsers(General.DataPath,General.MsgPath,User); + END; + WriteLn('Done!'); + + Write('Updating *.HDR files with new user number for existing user''s ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + UpdateMsgFilesExistingUsers(General.DataPath,General.MsgPath,User,Counter); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating file area scan flags for existing user''s ... '); + UpdateFileSCNFilesExistingUsers(General.DataPath); + WriteLn('Done!'); + + Write('Updating message area scan flags for existing user''s ... '); + UpdateMsgSCNFilesExistingUsers(General.DataPath,General.MsgPath); + WriteLn('Done!'); + + Write('Re-Scaning email waiting for existing user''s ... '); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + ReScanUserEMail(General.MsgPath,User,Counter); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Re-Scaning voting for existing user''s ... '); + ResetVotes(General.DataPath); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + ReScanUserVotes(General.DataPath,User); + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Updating UserID with record number for existing user''s ... '); + FOR Counter := 0 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + User.UserID := Counter; + Seek(UserFile2,Counter); + Write(UserFile2,User); + END; + WriteLn('Done!'); + + Write('Purging SHORTMSG.DAT of deleted records ... '); + PurgingShortMsgs(General.DataPath); + WriteLn('Done!'); + + Write('Purging BATCHDL.DAT of deleted records ... '); + PurgingBatchQueue(General.DataPath); + WriteLn('Done!'); + + Write('Updating all File Area file size ... '); + UpdateDIRFileSize(General.DataPath); + WriteLn('Done!'); + + Write('Sorting all file areas ... '); + SortAllFileAreas(General.DataPath); + WriteLn('Done!'); + + Write('Packing all message areas ... '); + PackMessageAreas(General.DataPath,General.MsgPath); + WriteLn('Done!'); + + Write('Deleting USERS.DEL ... '); + Close(UserFile1); + Erase(UserFile1); + WriteLn('Done!'); + + Write('Deleting USERS.DAT ... '); + Erase(UserFile); + WriteLn('Done!'); + + Write('Re-Naming USERS.BAK to USERS.DAT ... '); + ReName(UserFile2,General.DataPath+'USERS.DAT'); + WriteLn('Done!'); + + Write('Deleting USERS.IDX ... '); + Assign(F,General.DataPath+'USERS.IDX'); + Erase(F); + WriteLn('Done!'); + + Write('Creating and re-indexing USERS.IDX ... '); + TotalUsers := 0; + Assign(UserIndexFile,General.DataPath+'USERS.IDX'); + ReWrite(UserIndexFile); + Reset(UserFile2); + FOR Counter := 1 TO (FileSize(UserFile2) - 1) DO + BEGIN + Seek(UserFile2,Counter); + Read(UserFile2,User); + IF NOT (Deleted IN User.SFLags) THEN + Inc(TotalUsers); + InsertIndex(UserIndexFile,User.Name,Counter,FALSE,(Deleted IN User.SFLags)); + InsertIndex(UserIndexFile,User.RealName,Counter,TRUE,(Deleted IN User.SFLags)); + END; + Close(UserFile2); + WriteLn('Done!'); + + Write('Updating RENEGADE.DAT "NumUsers" ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + General.NumUsers := TotalUsers; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done!'); + + WriteLn; + WriteLn(^G^G^G'Your USERS.DAT file has been packed and associated files have been updated.'); + END; + END; + END; +END; + +BEGIN + PackUsers; +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGMAINTX.DAT b/SOURCE/UNUSED/RGMAINTX.DAT new file mode 100644 index 0000000..a9ccd70 Binary files /dev/null and b/SOURCE/UNUSED/RGMAINTX.DAT differ diff --git a/SOURCE/UNUSED/RGNOTE.EXE b/SOURCE/UNUSED/RGNOTE.EXE new file mode 100644 index 0000000..218c2fb Binary files /dev/null and b/SOURCE/UNUSED/RGNOTE.EXE differ diff --git a/SOURCE/UNUSED/RGNOTE.PAS b/SOURCE/UNUSED/RGNOTE.PAS new file mode 100644 index 0000000..1a29748 --- /dev/null +++ b/SOURCE/UNUSED/RGNOTE.PAS @@ -0,0 +1,190 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +PROGRAM RGNOTE; + +USES + Crt; + +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; + +BEGIN + CLrScr; + WriteLn('Renegade System Notes String Compiler Version 1.0'); + Writeln('Copyright 2006 - The Renegade Developement Team'); + WriteLn; + Write('Compiling 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. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGNOTE.TXT b/SOURCE/UNUSED/RGNOTE.TXT new file mode 100644 index 0000000..0ff2952 --- /dev/null +++ b/SOURCE/UNUSED/RGNOTE.TXT @@ -0,0 +1,181 @@ +$Internal_Use_Only +%LF^7This is for internal use only. +%PA +$ + +$Only_Change_Locally +%LF^7This can only be changed locally. +%PA +$ + +$Invalid_Menu_Number +%LF^7Invalid menu number. +$ + +$Minimum_Baud_Logon_PW +%LFYou must be using at least %M7 baud to call this BBS. +$ + +$Minimum_Baud_Logon_High_Low_Time_PW +%LFHours for those using less than %M7 baud are from %H3 to %H4. +$ + +$Minimum_Baud_Logon_High_Low_Time_No_PW +%LFNOTE: Callers at less than %M7 baud are restricted to the + following hours ONLY: %H3 to %H4. +$ + +$Logon_Event_Restricted_1 +%LFRestricted: Only certain users allowed online at this time. +$ + +$Logon_Event_Restricted_2 +%LFThis time window allows certain other users to get online. +Please call back later, after it has ended. +$ + +$Name_Not_Found +%LFName not found in user list. +$ + +$Illegal_Logon +%LF|15Logon Incorrect. +$ + +$Logon_Node_ACS +%LFYou don't have the required ACS to logon to this node. +$ + +$Locked_Out +%LFYou have been locked out of the BBS by the SysOp. +$ + +$Logged_On_Another_Node +%LFYou are already logged in on another node. +$ + +$Incorrect_Birth_Date +%LFYou entered an incorrect birthdate. +$ + +$Insufficient_Logon_Credits +%LFYou have insufficient credits for online time. +$ + +$Logon_Once_Per_Day +%LFYou can only log on once per day. +$ + +$Logon_Calls_Allowed_Per_Day +%LFYou can only log on %CA times per day. +$ + +$Logon_Time_Allowed_Per_Day_Or_Call +%LFYou can only logon for %T1 minutes per %CD. +$ + +$Logon_Minutes_Left_In_Bank +%LF^5However, you have %TB minutes left in your Time Bank. +$ + +$Logon_Minutes_Left_In_Bank_Time_Left +%LF^5In your account: ^3%TB^5 Time left online: ^3%TL +$ + +$Logon_Bank_Hangup +%LFHanging up. +$ + +$Logon_Attempt_IEMSI_Negotiation + +Attempting IEMSI negotiation ... @ +$ + +$Logon_IEMSI_Negotiation_Success +success. + +$Logon_IEMSI_Negotiation_Failed +failure. + +$Logon_Attempt_Detect_Emulation + +Attempting to detect emulation ... @ +$ + +$Logon_RIP_Detected +RIP +$ + +$Logon_ANSI_Detect_Other +/Ansi +$ + +$Logon_ANSI_Detect +Ansi +$ + +$Logon_Avatar_Detect_Other +/Avatar +$ + +$Logon_Avatar_Detect +Avatar +$ + +$Logon_Emulation_Detected + detected. + +$ + +$Shuttle_Logon_Validation_Status +%LFYou have not been validated yet. +$ + +$Logon_Closed_BBS +%LFThis BBS is currently not accepting new users, hanging up ... @ +$ + +$Node_Activity_Waiting_One +|02Waiting For Logon +$ + +$Node_Activity_Waiting_Two + |08- +$ + +$Node_Activity_Logging_On +Logging on +$ + +$Node_Activity_New_User_Logging_On +New user logging on +$ + +$Node_Activity_Miscellaneous +Miscellaneous +$ + +$New_User_Password_Invalid +%LFInvalid password, keep trying. +$ + +$New_User_Password_Attempt_Exceeded +%LFYou have exceeded the maximum new user logon attempts, hanging up. +$ + +$New_User_Record_Saving +%LFSaving your information ... @ +$ + +$New_User_Record_Saved +^3Saved. +$ + +$New_User_Application_Letter +%LFYou must now send a new user application letter to the SysOp. +%PA +$ + +$New_User_In_Response_To_Subj +New User Application +$ \ No newline at end of file diff --git a/SOURCE/UNUSED/RGNOTEPR.DAT b/SOURCE/UNUSED/RGNOTEPR.DAT new file mode 100644 index 0000000..bc3258c Binary files /dev/null and b/SOURCE/UNUSED/RGNOTEPR.DAT differ diff --git a/SOURCE/UNUSED/RGNOTETX.DAT b/SOURCE/UNUSED/RGNOTETX.DAT new file mode 100644 index 0000000..45dceaf Binary files /dev/null and b/SOURCE/UNUSED/RGNOTETX.DAT differ diff --git a/SOURCE/UNUSED/RGQUOTE.EXE b/SOURCE/UNUSED/RGQUOTE.EXE new file mode 100644 index 0000000..e815c0d Binary files /dev/null and b/SOURCE/UNUSED/RGQUOTE.EXE differ diff --git a/SOURCE/UNUSED/RGSCFG.EXE b/SOURCE/UNUSED/RGSCFG.EXE new file mode 100644 index 0000000..a4455f5 Binary files /dev/null and b/SOURCE/UNUSED/RGSCFG.EXE differ diff --git a/SOURCE/UNUSED/RGSCFG.PAS b/SOURCE/UNUSED/RGSCFG.PAS new file mode 100644 index 0000000..f0c47cc --- /dev/null +++ b/SOURCE/UNUSED/RGSCFG.PAS @@ -0,0 +1,169 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +PROGRAM RGMAIN; + +USES + Crt; + +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; + +BEGIN + CLrScr; + WriteLn('Renegade System Configuration String Compiler Version 1.0'); + Writeln('Copyright 2006 - The Renegade Developement Team'); + WriteLn; + Write('Compiling 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_MULTNODE_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. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGSCFG.TXT b/SOURCE/UNUSED/RGSCFG.TXT new file mode 100644 index 0000000..0413143 --- /dev/null +++ b/SOURCE/UNUSED/RGSCFG.TXT @@ -0,0 +1,187 @@ +$System_Configuration_Menu +%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]: @ +$ + +$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. String directory : ^5%P3 + +Enter selection [^5A^4-^5N^4,^50^4-^59^4,^5Q^4=^5Quit^4]: @ +$ + +$Main_BBS_Configuration_BBS_Name +%LFNew BBS name: @ +$ + +$Main_BBS_Configuration_BBS_Phone +%LFNew BBS phone number: @ +$ + +$Main_BBS_Configuration_Telnet_URL +%LF^1New Telnet Url:%LF^4: @ +$ + +$Main_BBS_Configuration_SysOp_Name +%LFNew SysOp name: @ +$ + +$Main_BBS_Configuration_SysOp_Chat_Hours +%LFDo you want to declare sysop chat hours? @ +$ + +$Main_BBS_Configuration_Minimum_Baud_Hours +%LFDo you want to declare hours people at the minimum baud can logon? @ +$ + +$Main_BBS_Configuration_Download_Hours +%LFDo you want to declare download hours? @ +$ + +$Main_BBS_Configuration_Minimum_Baud_Download_Hours +%LFDo you want to declare hours people at minimum baud can download? @ +$ + +$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,^5^4=^5Quit^4]: @ +$ + +$Main_BBS_Configuration_SysOp_Password +%LFNew SysOp password: @ +$ + +$Main_BBS_Configuration_New_User_Password +%LFNew new-user password: @ +$ + +$Main_BBS_Configuration_Baud_Override_Password +%LFNew minimum baud rate override password: @ +$ + +$Main_BBS_Configuration_Pre_Event_Time +%LFNew pre-event warning time@ +$ + +$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,^5^4=^5Quit^4]: @ +$ + +$Main_BBS_Configuration_System_Menus_Global +%LFMenu for global commands (^50^4=^5None^4)@ +$ + +$Main_BBS_Configuration_System_Menus_Start +%LFMenu to start all users at@ +$ + +$Main_BBS_Configuration_System_Menus_Shuttle +%LFMenu for shuttle logon (^50^4=^5None^4)@ +$ + +$Main_BBS_Configuration_System_Menus_New_User +%LFMenu for new user information@ +$ + +$Main_BBS_Configuration_System_Menus_Message_Read +%LFMenu for message read@ +$ + +$Main_BBS_Configuration_System_Menus_File_Listing +%LFMenu for file listing@ +$ + +$Main_BBS_Configuration_Bulletin_Prefix +%LFDefault bulletin prefix: @ +$ + +$Main_BBS_Configuration_Local_Security +%LFDo you want local security to remain on? @ +$ + +$Main_BBS_Configuration_Data_Path +%LF^1New data files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Misc_Path +%LF^1New miscellaneous files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Msg_Path +%LF^1New message files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_NodeList_Path +%LF^1New nodelist files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Log_Path +%LF^1New sysop log files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Temp_Path +%LF^1New temporary files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Protocol_Path +%LF^1New protocol files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Archive_Path +%LF^1New archive files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_Attach_Path +%LF^1New file attach files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ + +$Main_BBS_Configuration_String_Path +%LF^1New string files path (^5End with a ^1"^5\^1"):%LF^4: @ +$ diff --git a/SOURCE/UNUSED/RGSCFGPR.DAT b/SOURCE/UNUSED/RGSCFGPR.DAT new file mode 100644 index 0000000..7a3f774 Binary files /dev/null and b/SOURCE/UNUSED/RGSCFGPR.DAT differ diff --git a/SOURCE/UNUSED/RGSCFGTX.DAT b/SOURCE/UNUSED/RGSCFGTX.DAT new file mode 100644 index 0000000..d26d3ff Binary files /dev/null and b/SOURCE/UNUSED/RGSCFGTX.DAT differ diff --git a/SOURCE/UNUSED/RGSTAT.PAS b/SOURCE/UNUSED/RGSTAT.PAS new file mode 100644 index 0000000..65fcd58 --- /dev/null +++ b/SOURCE/UNUSED/RGSTAT.PAS @@ -0,0 +1,1419 @@ +UNIT RGSTAT; + +{$M 65520,0,30000} + +{Written By..........: The Renegade Developement Team} +{Date Started........: 01 Sep 2006} +{Last Update.........: ?? ??? ????} + +INTERFACE + +IMPLEMENTATION + +USES + Crt, + Dos, + Common; + +TYPE + (* + Str3 = STRING[3]; + Str8 = STRING[8]; + Str12 = STRING[12]; + Str30 = STRING[30]; + Str36 = STRING[36]; + *) + Str43 = STRING[43]; + (* + Str78 = STRING[78]; + *) + genrec = RECORD + name : str43; + info : real; + END; + + b_array = ARRAY[1..20] OF boolean; + d_array = ARRAY[1..20] OF str8; + e_array = ARRAY[1..10] OF word; + g_array = ARRAY[1..20] OF longint; + gsysactivity = ARRAY[1..20] OF real; + h_array = ARRAY[1..19] OF word; + m_array = ARRAY[1..3] OF word; + t_array = ARRAY[1..10] OF genrec; + + configinfo = RECORD + exuser: e_array; + graph_fg, + graph_bg, + logdays, + dldsl: byte; + use_real: boolean; + END; + +VAR + config: configinfo; + uage: m_array; + usex: m_array; + gdate: d_array; + ubaud: h_array; + tttimeon: t_array; + tfreqc: t_array; + tulk: t_array; + tdlk: t_array; + tprivp: t_array; + tpubp: t_array; + tfeedback: t_array; + tnumc: t_array; + tnumul: t_array; + tnumdl: t_array; + tfilep: t_array; + tupd: t_array; + tpostc: t_array; + gsysact: gsysactivity; + gmina: g_array; + gnumc: g_array; + gnewu: g_array; + gtimeu: g_array; + gmsgpub: g_array; + gmsgpvt: g_array; + gmsgfb: g_array; + gnume: g_array; + gful: g_array; + gulkb: g_array; + gfdl: g_array; + gdlkb: g_array; + +function graph_month(s: str8): str3; +BEGIN + CASE Value(copy(s,1,2)) OF + 1 : graph_month := 'Jan'; + 2 : graph_month := 'Feb'; + 3 : graph_month := 'Mar'; + 4 : graph_month := 'Apr'; + 5 : graph_month := 'May'; + 6 : graph_month := 'Jun'; + 7 : graph_month := 'Jul'; + 8 : graph_month := 'Aug'; + 9 : graph_month := 'Sep'; + 10 : graph_month := 'Oct'; + 11 : graph_month := 'Nov'; + 12 : graph_month := 'Dec'; + END; +END; + +FUNCTION RmvLeadSpace(S: AStr): AStr; +BEGIN + WHILE (S[1] = ' ') DO + Delete(S,1,1); + RmvLeadSpace := S; +END; + +FUNCTION RmvTrailSpace(S: AStr): AStr; +BEGIN + WHILE (S[Length(S)] = ' ') DO + Delete(S,Length(S),1); + RmvTrailSpace := S; +END; + +function reverse_str(s: str160): str160; +VAR + s1: str160; + counter: byte; +BEGIN + s1 := ''; + FOR counter := 20 downto 1 DO + s1 := s1 + s[counter]; + reverse_str := rmvleadspace(rmvtrailspace(s1)); +END; + +function center(s: str160; i: integer; tf: boolean): str160; +VAR + counter,strlength: integer; + which_way: boolean; +BEGIN + which_way := tf; + strlength := length(s); + FOR counter := (strlength + 1) TO i 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; + +function return_time(w,w1: word): str160; +BEGIN + IF (w > 0) and (w1 > 0) THEN + return_time := inttostr(trunc(w div w1)) + ELSE + return_time := '0'; +END; + +function age(s: str160): str160; +BEGIN + age := inttostr(Value(copy(datestr,7,2)) - Value(copy(s,7,2))); +END; + +function return_age(userbday: str160): str160; +VAR + today,user_years: str160; +BEGIN + today := datestr; + user_years := age(userbday); + IF (Value(copy(userbday,1,2)) > Value(copy(today,1,2))) THEN + user_years := inttostr(Value(user_years)-1) + ELSE + IF (Value(copy(userbday,1,2)) = Value(copy(today,1,2))) THEN + IF (Value(copy(userbday,4,2)) > Value(copy(today,4,2))) THEN + user_years := inttostr(Value(user_years)-1); + return_age := user_years; +END; + +PROCEDURE read_config_file(VAR config: configinfo); +VAR + f: text; + line,line1: str160; + counter,counter1: byte; +BEGIN + assign(f,'TAGSTAT.CFG'); + {$I-} reset(f); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to access TAGSTAT.CFG!'); + halt; + END; + textcolor(lightgray); + textbackground(black); + with config DO + BEGIN + FOR counter1 := 1 TO 10 DO + exuser[counter1] := 0; + graph_fg := 9; + graph_bg := 7; + logdays := 0; + dldsl := 255; + use_real := false; + END; + counter := 1; + counter1 := 0; + WHILE not eof(f) DO + BEGIN + {$I-} readln(f,line); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to read TAGSTAT.CFG!'); + {$I-} close(f); {$I+} + IF (ioresult <> 0) THEN + writeln(^G^G^G'Unable to close TAGSTAT.CFG!'); + halt; + END; + line := rmvleadspace(rmvtrailspace(line)); + line1 := allcaps(line); + IF (line1 <> '') and (line1[1] <> '%') THEN + BEGIN + IF (pos('USER_EXCLUDE',line1) = 1) and (counter1 < 10) THEN + BEGIN + Delete(line,1,12); + inc(counter1); + config.exuser[counter1] := Value(rmvleadspace(line)); + END + ELSE IF (pos('DOWNLOAD_DSL',line1) = 1) THEN + BEGIN + Delete(line,1,12); + config.dldsl := Value(rmvleadspace(line)); + IF (config.dldsl < 0) OR (config.dldsl > 255) THEN + config.dldsl := 255; + END + ELSE IF (pos('REAL_NAME',line1) = 1) THEN + config.use_real := TRUE + ELSE IF (pos('GRAPH_BACKGROUND',line1) = 1) THEN + BEGIN + Delete(line,1,16); + config.graph_bg := Value(rmvleadspace(line)); + IF (config.graph_bg < 0) OR (config.graph_bg > 15) THEN + config.graph_bg := 7; + END + ELSE IF (pos('GRAPH_BARS',line1) = 1) THEN + BEGIN + Delete(line,1,10); + config.graph_fg := Value(rmvleadspace(line)); + IF (config.graph_fg < 0) OR (config.graph_fg > 15) THEN + config.graph_fg := 9; + END; + END; + END; + {$I-} close(f); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to close TAGSTAT.CFG!'); + halt; + END; +END; + +PROCEDURE init_d_array(VAR gdate: d_array); +VAR + counter: byte; +BEGIN + FOR counter := 1 TO 20 DO + gdate[counter] := ''; +END; + +PROCEDURE init_g_array(VAR ar: g_array; info_val: longint); +VAR + counter: byte; +BEGIN + FOR counter := 1 TO 20 DO + ar[counter] := info_val; +END; + +PROCEDURE init_gsysactivity(VAR gsysact: gsysactivity); +VAR + counter: byte; +BEGIN + FOR counter := 1 TO 20 DO + gsysact[counter] := 0.0; +END; + +PROCEDURE init_h_array(VAR ar: h_array; info_val: word); +VAR + counter: byte; +BEGIN + FOR counter := 1 TO 19 DO + ar[counter] := info_val; +END; + +PROCEDURE init_m_array(VAR ar: m_array; info_val: word); +VAR + counter: byte; +BEGIN + FOR counter := 1 TO 3 DO + ar[counter] := info_val; +END; + +PROCEDURE init_t_array(VAR ar: t_array; info_val: real); +VAR + counter: byte; +BEGIN + FOR counter := 1 TO 10 DO + BEGIN + ar[counter].name := ''; + ar[counter].info := info_val; + END; +END; + +PROCEDURE sort_ascending(s: str43; r: real; VAR tfreqc: t_array); +VAR + counter,counter1: byte; +BEGIN + IF (r > 0.0) THEN + FOR counter := 1 TO 10 DO + IF (r <= tfreqc[counter].info) THEN + BEGIN + FOR counter1 := 10 downto counter DO + IF ((counter1 - 1) > 0) THEN + tfreqc[counter1] := tfreqc[counter1-1]; + tfreqc[counter].name := s; + tfreqc[counter].info := r; + counter := 10; + END; +END; + +PROCEDURE sort_descending(s: str43; r: real; VAR ar: t_array); +VAR + counter,counter1: byte; +BEGIN + IF (r > 0.0) THEN + FOR counter := 1 TO 10 DO + IF (r >= ar[counter].info) THEN + BEGIN + FOR counter1 := 10 downto counter DO + IF ((counter1 - 1) > 0) THEN + ar[counter1] := ar[counter1 - 1]; + ar[counter].name := s; + ar[counter].info := r; + counter := 10; + END; +END; + +PROCEDURE scrn_one; +BEGIN + CLS; + Print(#3'5'+center('Renegade BBS Statistics',78,TRUE)); + NL; + Print(#3'5'+center('Copyright (c) 2006 The Renegade Developement Team',78,TRUE)); + NL; + Print(#3'5'+center('Version 1.0',78,TRUE)); + NL; + NL; + Prompt(#3'2[> '#3'4One Moment Please ... '); +END; + +PROCEDURE scrn_two(s: str160); +BEGIN + window(1,1,80,25); + CLS; + Print(#3'1[> Returning to '+s+'... '); + NL; + delay(2000); + clrscr; +END; + +function in_array(w: word; exuser: e_array): boolean; +VAR + counter: byte; + tf: boolean; +BEGIN + tf := false; + FOR counter := 1 TO 10 DO + IF (w = exuser[counter]) THEN + tf := TRUE; + in_array := tf; +END; + +PROCEDURE read_user_file(General: GeneralRecordType; VAR config: configinfo; VAR uage, + usex: m_array; VAR ubaud: h_array; VAR tfreqc,tttimeon, + tulk,tdlk,tprivp,tpubp,tfeedback,tnumc,tnumul,tnumdl, + tfilep,tupd,tpostc: t_array); +const + maxuserblock = 30000 div sizeof(UserRecordType); {* Allocate 30K *} +type + userblocktype = ARRAY[1..maxuserblock] OF UserRecordType; +VAR + uf: FILE; + userblock: ^userblocktype; + recnum,numusers,unum: word; + totuage: longint; + counter,userage: byte; + calltot,realuserblockcount: integer; + name: str43; +BEGIN + assign(uf,General.DataPath+'USER.LST'); + new(userblock); + init_m_array(uage,0); + init_m_array(usex,0); + init_h_array(ubaud,0); + init_t_array(tfreqc,255.000); + init_t_array(tttimeon,0.000); + init_t_array(tulk,0.000); + init_t_array(tdlk,0.000); + init_t_array(tprivp,0.000); + init_t_array(tpubp,0.000); + init_t_array(tfeedback,0.000); + init_t_array(tnumc,0.000); + init_t_array(tnumul,0.000); + init_t_array(tnumdl,0.000);; + init_t_array(tfilep,0.000); + init_t_array(tupd,0.000); + init_t_array(tpostc,0.000); + recnum := 0; + numusers := 0; + totuage := 0; + uage[2] := 255; + seek(uf,1); + REPEAT + blockread(uf,userblock^,maxuserblock,realuserblockcount); + FOR unum := 1 TO realuserblockcount DO + with userblock^[unum] DO + BEGIN + inc(recnum); + calltot := 0; + IF (recnum = usernum) and not in_array(usernum,config.exuser) THEN + BEGIN + userage := AgeUser(BirthDate); + Inc(totuage,userage); + (* + uage[2] := min(uage[2],userage); + uage[3] := max(userage,uage[3]); + *) + IF (Sex = 'M') THEN + inc(usex[1]) + ELSE IF (Sex = 'F') THEN + inc(usex[2]) + ELSE + inc(usex[3]); + (* + IF (hbaud = 300) THEN + inc(ubaud[1]) + ELSE IF (hbaud = 600) THEN + inc(ubaud[2]) + ELSE IF (hbaud = 1200) THEN + inc(ubaud[3]) + ELSE IF (hbaud = 2400) THEN + inc(ubaud[4]) + ELSE IF (hbaud = 4800) THEN + inc(ubaud[5]) + ELSE IF (hbaud = 7200) THEN + inc(ubaud[6]) + ELSE IF (hbaud = 9600) THEN + inc(ubaud[7]) + ELSE IF (hbaud = 12000) THEN + inc(ubaud[8]) + ELSE IF (hbaud = 14400) THEN + inc(ubaud[9]) + ELSE IF (hbaud = 16800) THEN + inc(ubaud[10]) + ELSE IF (hbaud = 19200) THEN + inc(ubaud[11]) + ELSE IF (hbaud = 21600) THEN + inc(ubaud[12]) + ELSE IF (hbaud = 24000) THEN + inc(ubaud[13]) + ELSE IF (hbaud = 26400) THEN + inc(ubaud[14]) + ELSE IF (hbaud = 28800) THEN + inc(ubaud[15]) + ELSE IF (hbaud = 31200) THEN + inc(ubaud[16]) + ELSE IF (hbaud = 33600) THEN + inc(ubaud[17]) + ELSE IF (hbaud = 38400) THEN + inc(ubaud[18]) + ELSE IF (hbaud = 57600) THEN + inc(ubaud[19]) + ELSE IF (hbaud = 115200) THEN + inc(ubaud[20]); + *) + IF config.use_real THEN + name := allcaps(realname)+' #'+inttostr(usernum) + ELSE + name := name+' #'+inttostr(usernum); + sort_ascending(name,calltot/15,tfreqc); + sort_descending(name,ttimeon,tttimeon); + sort_descending(name,ulk,tulk); + sort_descending(name,dlk,tdlk); + sort_descending(name,privpost,tprivp); + sort_descending(name,pubpost,tpubp); + sort_descending(name,feedback,tfeedback); + sort_descending(name,numcalls,tnumc); + sort_descending(name,numul,tnumul); + sort_descending(name,numdl,tnumdl); + sort_descending(name,points,tfilep); + sort_descending(name,ulk/maxr(1.0,dlk),tupd); + sort_descending(name,pubpost/maxr(1.0,numcalls),tpostc); + inc(numusers); + END; + END; + UNTIL (realuserblockcount < maxuserblock); + dispose(userblock); + uage[1] := totuage div numusers; + {$I-} close(uf); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to close USER.LST!'); + halt; + END; +END; + +PROCEDURE read_usage_file(General: GeneralRecordType; VAR config: configinfo; VAR + gdate: d_array; VAR gsysact: gsysactivity; VAR + gmina,gnumc,gnewu,gtimeu,gmsgpub,gmsgpvt,gmsgfb, + gnume,gful,gulkb,gfdl,gdlkb: g_array); +VAR + ul: text; + line: str160; + counter: byte; + + function ajust_int_size(l,size: longint): longint; + BEGIN + IF (l < 0) THEN + ajust_int_size := 0 + ELSE IF (l > size) THEN + ajust_int_size := size + ELSE + ajust_int_size := l; + END; + + function ajust_real_size(r,size: real): real; + BEGIN + IF (r < 0.0) THEN + ajust_real_size := 0.0 + ELSE IF (r > size) THEN + ajust_real_size := size + ELSE + ajust_real_size := r; + END; + +BEGIN + IF General.multiuser THEN + BEGIN + IF fileexist(General.DataPath+'USAGE.LOG') THEN + assigntxtfile(ul,General.DataPath+'USAGE.LOG') + ELSE + assigntxtfile(ul,General.multiuserpath+'USAGE.LOG'); + END + ELSE + assigntxtfile(ul,General.DataPath+'USAGE.LOG'); + {$I-} reset(ul); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to access USAGE.LOG!'); + halt; + END; + init_d_array(gdate); + init_g_array(gmina,0); + init_g_array(gnumc,0); + init_g_array(gnewu,0); + init_gsysactivity(gsysact); + init_g_array(gtimeu,0); + init_g_array(gmsgpub,0); + init_g_array(gmsgpvt,0); + init_g_array(gmsgfb,0); + init_g_array(gnume,0); + init_g_array(gful,0); + init_g_array(gulkb,0); + init_g_array(gfdl,0); + init_g_array(gdlkb,0); + FOR counter := 1 TO 5 DO + BEGIN + {$I-} readln(ul); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to read USAGE.LOG!'); + {$I-} close(ul); {$I+} + IF (ioresult <> 0) THEN + writeln(^G^G^G'Unable to close USAGE.LOG!'); + halt; + END; + END; + FOR counter := 1 TO 20 DO + IF not eof(ul) THEN + BEGIN + {$I-} readln(ul,line); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to read USAGE.LOG!'); + {$I-} close(ul); {$I+} + IF (ioresult <> 0) THEN + writeln(^G^G^G'Unable to close USAGE.LOG!'); + halt; + END; + gdate[counter] := copy(line,1,8); + Delete(line,1,8); + gmina[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,6))),99999); + Delete(line,1,6); + gnumc[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gnewu[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gsysact[counter] := ajust_real_size(valuer(rmvleadspace(copy(line,1,6))),100.0); + Delete(line,1,6); + gtimeu[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gmsgpub[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gmsgpvt[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gmsgfb[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gnume[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gful[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gulkb[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,7))),999999); + Delete(line,1,7); + gfdl[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,5))),9999); + Delete(line,1,5); + gdlkb[counter] := ajust_int_size(Value(rmvleadspace(copy(line,1,7))),999999); + inc(config.logdays); + END; + {$I-} close(ul); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to close USAGE.LOG!'); + halt; + END; +END; + +PROCEDURE read_dir_file(dirpath: pathstr; dirname: str8; name: str160; + dlpath: str30; group: integer; area: word; + sn: byte; flags: ulrecflagset; VAR frec: f_array); +const + maxfileblock = 30000 div sizeof(ulfrec); {* Allocate 30K *} +type + fileblocktype = ARRAY[1..maxfileblock] OF ulfrec; +VAR + udir: FILE; + fileblock: ^fileblocktype; + counter,counter1: byte; + fnum,realfileblockcount,recnum: word; +BEGIN + assign(udir,dirpath+dirname+'.DIR'); + setfilemode(readdenynone); + {$I-} reset(udir,sizeof(ulfrec)); {$I+} + IF (ioresult = 0) THEN + BEGIN + setfilemode(normalmode); + IF (filesize(udir) > 1) THEN + BEGIN + recnum := 0; + new(fileblock); + seek(udir,1); + REPEAT + blockread(udir,fileblock^,maxfileblock,realfileblockcount); + FOR fnum := 1 TO realfileblockcount DO + BEGIN + inc(recnum); + FOR counter := 1 TO 20 DO + IF (fileblock^[fnum].nacc > frec[counter].nacc) THEN + BEGIN + IF (counter <= (20 - 1)) THEN + FOR counter1 := (20 - 1) downto counter DO + frec[counter1 + 1] := frec[counter1]; + frec[counter].recnum := recnum; + frec[counter].filename := fileblock^[fnum].filename; + frec[counter].description := fileblock^[fnum].description; + frec[counter].nacc := fileblock^[fnum].nacc; + frec[counter].unused := fileblock^[fnum].unused; + frec[counter].blocks := fileblock^[fnum].blocks; + frec[counter].owner := fileblock^[fnum].owner; + frec[counter].date := fileblock^[fnum].date; + frec[counter].daten := fileblock^[fnum].daten; + frec[counter].flag := fileblock^[fnum].flag; + frec[counter].points := fileblock^[fnum].points; + frec[counter].dirpath := dirpath; + frec[counter].dirname := dirname; + frec[counter].dlpathname := dlpath; + frec[counter].flags := flags; + frec[counter].areaname := name; + frec[counter].seenames := sn; + frec[counter].group := group; + frec[counter].area := area; + counter := 20; + END; + END; + UNTIL (realfileblockcount < maxfileblock); + dispose(fileblock); + END; + {$I-} close(udir); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to close '+dirname+'.DIR!'); + halt; + END; + END; +END; + +PROCEDURE read_fboard_file(General: GeneralRecordType; VAR frec: f_array); +VAR + ulf: FILE OF ulrec; + uboards: ulrec; + dirpathname: str160; + counter: byte; + grp: ARRAY[0..127] OF integer; + tempgrp: integer; +BEGIN + IF General.multiuser THEN + BEGIN + IF fileexist(General.DataPath+'FBOARDS.DAT') THEN + assign(ulf,General.DataPath+'FBOARDS.DAT') + ELSE + assign(ulf,General.multiuserpath+'FBOARDS.DAT'); + END + ELSE + assign(ulf,General.DataPath+'FBOARDS.DAT'); + setfilemode(readdenynone); + {$I-} reset(ulf); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to access FBOARDS.DAT!'); + halt; + END; + setfilemode(normalmode); + FOR counter := 0 TO 127 DO + grp[counter] := -1; + tempgrp := -1; + init_f_array(frec); + WHILE not eof(ulf) DO + BEGIN + {$I-} read(ulf,uboards); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to read FBOARDS.DAT!'); + {$I-} close(ulf); {$I+} + IF (ioresult <> 0) THEN + writeln(^G^G^G'Unable to close FBOARDS.DAT!'); + halt; + END; + IF General.dynamicfile THEN + BEGIN + inc(grp[uboards.noratiogroupnum shr 1]); + tempgrp := grp[uboards.noratiogroupnum shr 1]; + END + ELSE + inc(tempgrp); + dirpathname := uboards.dlpathname; + IF (uboards.dsl <= thisuser.dsl) and (uboards.arlvl in thisuser.ar) OR + (uboards.dsl <= thisuser.dsl) and (uboards.arlvl = '@') THEN + BEGIN + IF (uboards.filename[1] = '@') THEN + BEGIN + dirpathname := General.DataPath; + uboards.filename := copy(uboards.filename,2,length(uboards.filename)); + END + ELSE IF (uboards.filename[1] = '`') THEN + BEGIN + dirpathname := General.multiuserpath; + uboards.filename := copy(uboards.filename,2,length(uboards.filename)); + END + ELSE IF (uboards.filename[1] = '+') THEN + BEGIN + dirpathname := General.altpath; + uboards.filename := copy(uboards.filename,2,length(uboards.filename)); + END; + read_dir_file(dirpathname,uboards.filename,uboards.name,uboards.dlpathname, + uboards.noratiogroupnum shr 1,tempgrp,uboards.seenames, + uboards.flags,frec); + END; + END; + {$I-} close(ulf); {$I+} + IF (ioresult <> 0) THEN + BEGIN + writeln(^G^G^G'Unable to close FBOARDS.DAT!'); + halt; + END; +END; + +PROCEDURE menu_line(c,c1: char; s,s1: str160); +BEGIN + IF (c <> ' ') THEN + BEGIN + IF (length(s) > 32) THEN + s := copy(s,1,32); + ds_write(#3'1['#3'3'+c+#3'1] : '+addspace(s,33,false)); + END + ELSE + ds_write(addspace(s,39,TRUE)); + IF (c1 <> ' ') THEN + BEGIN + IF (length(s1) > 32) THEN + s1 := copy(s1,1,32); + ds_write(#3'1['#3'3'+c1+#3'1] : '+addspace(s1,33,false)); + END; + NL; +END; + +PROCEDURE menu1_line(c: char; s: str160); +BEGIN + IF (length(s) > 73) THEN + s := copy(s,1,73); + Print(#3'1['#3'3'+c+#3'1] : '+s); +END; + +PROCEDURE sys_menu_line(s,s1: str160); +BEGIN + ds_write(#3'1'+s+#3'0'+s1); +END; + +PROCEDURE sys_menu_line1(s,s1: str160); +BEGIN + Print(#3'1'+s+#3'0'+s1); +END; + +PROCEDURE hdr(s: str160); +BEGIN + CLS; + Print(#3'5'+center('-=[ '+s+' ]=-',78,TRUE)); + NL; +END; + +PROCEDURE ftr(s: str160); +BEGIN + NL; + menu1_line('Q','Return to '+s); + NL; + ds_write(#3'4['#3'1'+realtostr1(nsl / 60,0,0)+' Mins Left'#3'4] Enter Command > '#3'1'); +END; + +PROCEDURE display_t_array(decimal,width: byte; t_ar: t_array; title, + header: str160); +VAR + counter,counter1: byte; +BEGIN + hdr('Top 10 '+title); + Print(#3'2## User Name '+center(header,55,TRUE)); + NL; + FOR counter := 1 TO 10 DO + BEGIN + ds_write(#3'4'+addspace(inttostr(counter),2,TRUE)); + IF (config.use_real) and (t_ar[counter].name = allcaps(thisuser.rname)+' #'+inttostr(thisuser.usernum)) + OR (t_ar[counter].name = thisuser.uname+' #'+inttostr(thisuser.usernum)) THEN + ds_write(' '#3'8'+t_ar[counter].name+' '#3'9') + ELSE + ds_write(' '#3'1'+t_ar[counter].name+' '#3'9'); + FOR counter1 := (length(t_ar[counter].name) + 1) TO 42 DO + ds_write('.'); + IF (t_ar[counter].info > 0) THEN + Print(#3'4'+addspace(realtostr1(t_ar[counter].info,0,decimal),width,TRUE)) + ELSE + NL; + END; + ds_pause_cr; +END; + +PROCEDURE display_t_freqcall(decimal,width: byte; t_ar: t_array; title, + header: str160); +VAR + counter,counter1: byte; +BEGIN + hdr('Top 10 '+title); + Print(#3'2## User Name '+center(header,55,TRUE)); + NL; + FOR counter := 1 TO 10 DO + BEGIN + ds_write(#3'4'+addspace(inttostr(counter),2,TRUE)); + IF config.use_real and (t_ar[counter].name = allcaps(thisuser.rname)+' #'+inttostr(thisuser.usernum)) + OR (t_ar[counter].name = thisuser.uname+' #'+inttostr(thisuser.usernum)) THEN + ds_write(' '#3'8'+t_ar[counter].name+' '#3'9') + ELSE + ds_write(' '#3'1'+t_ar[counter].name+' '#3'9'); + FOR counter1 := (length(t_ar[counter].name) + 1) TO 42 DO + ds_write('.'); + IF (t_ar[counter].info < 255) THEN + Print(#3'4'+addspace(realtostr1(t_ar[counter].info,0,decimal),width,TRUE)) + ELSE + NL; + END; + ds_pause_cr; +END; + +PROCEDURE graph_yes(tf: boolean; VAR first: b_array; i,g_fg,g_bg: byte); +BEGIN + IF (ANSI in thisuser.Flags) THEN + BEGIN + ds_textcolor(g_fg); + ds_write('栢'); + IF first[i] THEN + BEGIN + ds_textcolor(g_bg); + ds_write('�'); + first[i] := false; + END + ELSE + BEGIN + ds_textcolor(black); + ds_write('�'); + IF not tf THEN + ds_textcolor(g_bg); + END; + END + ELSE + ds_write('###'); +END; + +PROCEDURE graph_no; +BEGIN + IF (ANSI in thisuser.Flags) THEN + ds_write('栢�') + ELSE + ds_write('...'); +END; + +PROCEDURE display_g_sysactivity(config: configinfo; gdate: d_array; gsysact: + gsysactivity; s: str160); +VAR + first: b_array; + counter,counter1: byte; + average: real; + tf: boolean; +BEGIN + FOR counter := 1 TO 20 DO + first[counter] := TRUE; + average := 0.0; + CLS; + Print(#3'5 '+center('-=[ Graph Of System Activity By Percentage ]=-',60,TRUE)); + FOR counter := 20 downto 1 DO + BEGIN + average := average + gsysact[counter]; + IF (copy(s,counter,1) <> ' ') THEN + ds_write(#3'5'+copy(s,counter,1)) + ELSE + ds_write(' '); + ds_write(#3'2'+addspace(inttostr(counter * 5),7,TRUE)+'% '); + FOR counter1 := 20 downto 1 DO + IF (gsysact[counter1] >= (counter * 5)) THEN + BEGIN + tf := TRUE; + IF (counter1 > 1) THEN + BEGIN + tf := false; + IF (gsysact[counter1 - 1] >= counter * 5) THEN + tf := TRUE; + END; + graph_yes(tf,first,counter1,config.graph_fg,config.graph_bg) + END + ELSE + BEGIN + IF (counter1 = 20) THEN + ds_textcolor(config.graph_bg); + graph_no; + END; + NL; + END; + ds_ansi_color(2); + tf := false; + FOR counter := 20 downto 1 DO + IF (gdate[counter] <> '') and not tf THEN + BEGIN + ds_write(addspace(graph_month(gdate[counter])+' ',11,TRUE)); + tf := TRUE; + END; + IF not tf THEN + ds_write(' '); + FOR counter := 20 downto 1 DO + IF (gdate[counter] <> '') THEN + ds_write(copy(gdate[counter],4,2)+' ') + ELSE + ds_write(' '); + IF (gdate[1] <> '') THEN + Print(graph_month(gdate[1])) + ELSE + NL; + average := average / config.logdays; + Print(#3'5 '+center('(Average '+reverse_str(s)+': '+realtostr1(average,0,0)+'%)',60,TRUE)); + ds_pause_cr; +END; + +PROCEDURE display_g_array(config: configinfo; gdate: d_array; g_ar: g_array; + title,side: str160; increment: longint); +VAR + first: b_array; + counter,counter1: byte; + average: longint; + tf: boolean; +BEGIN + FOR counter := 1 TO 20 DO + first[counter] := TRUE; + average := 0; + CLS; + Print(#3'5 '+center('-=[ Graph Of '+title+' ]=-',60,TRUE)); + FOR counter := 20 downto 1 DO + BEGIN + Inc(average,g_ar[counter]); + IF (copy(side,counter,1) <> ' ') THEN + ds_write(#3'5'+copy(side,counter,1)) + ELSE + ds_write(' '); + ds_write(#3'2'+addspace(inttostr(counter * increment),7,TRUE)+' '); + FOR counter1 := 20 downto 1 DO + IF (g_ar[counter1] >= (counter * increment)) THEN + BEGIN + tf := TRUE; + IF (counter1 > 1) THEN + BEGIN + tf := false; + IF (g_ar[counter1 - 1] >= (counter * increment)) THEN + tf := TRUE; + END; + graph_yes(tf,first,counter1,config.graph_fg,config.graph_bg) + END + ELSE + BEGIN + IF (counter1 = 20) THEN + ds_textcolor(config.graph_bg); + graph_no; + END; + NL; + END; + ds_ansi_color(2); + tf := false; + FOR counter := 20 downto 1 DO + IF (gdate[counter] <> '') and not tf THEN + BEGIN + ds_write(addspace(graph_month(gdate[counter])+' ',11,TRUE)); + tf := TRUE; + END; + IF not tf THEN + ds_write(' '); + FOR counter := 20 downto 1 DO + IF (gdate[counter] <> '') THEN + ds_write(copy(gdate[counter],4,2)+' ') + ELSE + ds_write(' '); + IF (gdate[1] <> '') THEN + Print(graph_month(gdate[1])) + ELSE + NL; + average := average div config.logdays; + Print(#3'5 '+center('(Average '+reverse_str(side)+': '+inttostr(average)+')',60,TRUE)); + ds_pause_cr; +END; + +function div_g(g: g_array): longint; +VAR + i: byte; + counter: longint; + big: longint; + num: real; + + function div_size(num: real): longint; + BEGIN + IF (num <= 1) THEN + div_size := 1 + ELSE IF (num < 2) THEN + div_size := 2 + ELSE IF (num < 3) THEN + div_size := 3 + ELSE IF (num < 4) THEN + div_size := 4 + ELSE IF (num < 5) THEN + div_size := 5 + ELSE + BEGIN + counter := 5; + REPEAT + Inc(counter); + UNTIL (num > 999999) OR (counter > num); + div_size := counter; + END; + END; + +BEGIN + big := 0; + FOR i := 1 TO 20 DO + big := max(big,g[i]); + num := big / 20; + div_g := div_size(num); +END; + +PROCEDURE display_m_array(m_ar: m_array; title,desc1,desc2,desc3: str160; value: byte); +VAR + len: byte; + + PROCEDURE m_line(s: str160; w: word); + VAR + counter: byte; + BEGIN + ds_write(#3'1'+s+' '#3'9'); + FOR counter := 1 TO (len - length(s)) DO + ds_write('.'); + Print(#3'4'+addspace(inttostr(w),value+1,TRUE)); + END; + +BEGIN + len := 0; + len := max(len,length(desc1)); + len := max(len,length(desc2)); + len := max(len,length(desc3)); + Inc(len,3); + hdr(title); + m_line(desc1,m_ar[1]); + m_line(desc2,m_ar[2]); + IF (desc3 = 'Total Not Specified') and (m_ar[3] > 0) OR (desc3 = 'The Oldest User Is') THEN + m_line(desc3,m_ar[3]); + ds_pause_cr; +END; + +PROCEDURE display_h_array(ubaud: h_array); + + PROCEDURE baud_line(s: str160; w: word); + VAR + counter: byte; + BEGIN + ds_write(#3'1Total '+s+' Baud Callers '#3'9'); + FOR counter := 1 TO (27 - length('Total '+s+' Baud Callers')) DO + ds_write('.'); + Print(#3'4'+addspace(inttostr(w),6,TRUE)); + END; + +BEGIN + hdr('User Baud Rate Statistics'); + IF (ubaud[1] > 0) THEN + baud_line('300',ubaud[1]); + IF (ubaud[2] > 0) THEN + baud_line('1200',ubaud[2]); + IF (ubaud[3] > 0) THEN + baud_line('1275',ubaud[3]); + IF (ubaud[4] > 0) THEN + baud_line('2400',ubaud[4]); + IF (ubaud[5] > 0) THEN + baud_line('4800',ubaud[5]); + IF (ubaud[6] > 0) THEN + baud_line('7200',ubaud[6]); + IF (ubaud[7] > 0) THEN + baud_line('9600',ubaud[7]); + IF (ubaud[8] > 0) THEN + baud_line('12000',ubaud[8]); + IF (ubaud[9] > 0) THEN + baud_line('14400',ubaud[9]); + IF (ubaud[10] > 0) THEN + baud_line('16800',ubaud[10]); + IF (ubaud[11] > 0) THEN + baud_line('19200',ubaud[11]); + IF (ubaud[12] > 0) THEN + baud_line('21600',ubaud[12]); + IF (ubaud[13] > 0) THEN + baud_line('24000',ubaud[13]); + IF (ubaud[14] > 0) THEN + baud_line('26400',ubaud[14]); + IF (ubaud[15] > 0) THEN + baud_line('28800',ubaud[15]); + IF (ubaud[16] > 0) THEN + baud_line('38400',ubaud[16]); + IF (ubaud[17] > 0) THEN + baud_line('57600',ubaud[17]); + IF (ubaud[18] > 0) THEN + baud_line('64000',ubaud[18]); + IF (ubaud[19] > 0) THEN + baud_line('115200',ubaud[19]); + ds_pause_cr; +END; + +PROCEDURE todayusage(General: GeneralRecordType); +BEGIN + CLS; + with General DO + BEGIN + Print(#3'5'+center('-=[ Todays Usage ]=-',78,TRUE)); + sys_menu_line(' Date:',datestr); + sys_menu_line1(' Time:',timestr); + NL; + sys_menu_line1('Board Name :',boardname); + sys_menu_line1('Node Number :',inttostr(nodenumber)); + sys_menu_line1('Board Address :',boardcitystate); + sys_menu_line1('SysOp Name :',sysopname); + sys_menu_line1('Phone Number :',boardphone); + sys_menu_line('Mail Address :',inttostr(address.zone)+':'+inttostr(address.net)+'/'+inttostr(address.node)); + IF (address.point > 0) THEN + Print('.'+inttostr(address.point)) + ELSE + NL; + sys_menu_line1('BBS Software :','T.A.G. Version '+lasttagversion); + NL; + sys_menu_line1('Total Calls :',realtostr1(callernum,0,0)); + sys_menu_line1('Number Of Users :',realtostr1(users,0,0)); + sys_menu_line1('Last Caller :',lastcaller); + NL; + Print(#3'5'+center('-=[ Summary Of Activity ]=-',78,TRUE)); + sys_menu_line('Minutes Active :',addspace(inttostr(activetoday),9,false)); + sys_menu_line('Calls Today :',addspace(inttostr(callstoday),9,false)); + sys_menu_line1('New Users Today :',addspace(inttostr(nuserstoday),9,false)); + sys_menu_line('Percent Active :',addspace(return_percent(activetoday),9,false)); + sys_menu_line('Time/User :',addspace(return_time(activetoday,callstoday),9,false)); + sys_menu_line1('Public Posts :',addspace(inttostr(msgposttoday),9,false)); + sys_menu_line('Private Posts :',addspace(inttostr(emailtoday),9,false)); + sys_menu_line('Feedback Sent :',addspace(inttostr(fbacktoday),9,false)); + sys_menu_line1('Errors Today :',addspace(inttostr(errorstoday),9,false)); + sys_menu_line('Number Uploads :',addspace(inttostr(ultoday),9,false)); + sys_menu_line('UL K-Bytes :',addspace(realtostr1(ulktoday,0,0)+'K',9,false)); + sys_menu_line1('Number Downloads:',addspace(inttostr(dltoday),9,false)); + sys_menu_line1('DL K-Bytes :',addspace(realtostr1(dlktoday,0,0)+'K',9,false)); + END; + ds_pause_cr; +END; + +PROCEDURE chlen(s: str78; i,i1: integer); +VAR + line1,line2,temp: str160; + counter: integer; +BEGIN + s := rmvleadspace(rmvtrailspace(s)); + WHILE (pos(' ',s) > 0) DO + Delete(s,pos(' ',s),1); + IF (length(s) > i) THEN + BEGIN + line1 := copy(s,1,i); + WHILE (line1[length(line1)] <> ' ') DO + BEGIN + Delete(line1,length(line1),1); + Dec(i); + END; + line1 := rmvtrailspace(line1); + line2 := copy(s,i + 1,length(s)); + line2 := rmvleadspace(line2); + temp := ''; + FOR counter := 1 TO i1 DO + temp := ' ' + temp; + Print(#3'0'+line1); + ds_write(temp); + ds_write(#3'1:'); + Print(#3'0'+line2); + END + ELSE + Print(#3'0'+s); +END; + +PROCEDURE mainmenuscr(bbsname: str160); +BEGIN + hdr('Renegade Statistics Main Menu'); + menu1_line('A','User Statistics'); + menu1_line('B','Usage Statistics'); + ftr(bbsname); +END; + +PROCEDURE usermenuscr; +BEGIN + hdr('Renegade Statistics User Menu'); + menu1_line('A','Top 10 User Menu'); + menu1_line('B','User Age'); + menu1_line('C','User Gender'); + menu1_line('D','User Baud Rate'); + ftr('Renegade Statistics Main Menu'); +END; + +PROCEDURE usagemenuscr; +BEGIN + hdr('Renegade Statistics Usage Menu'); + menu1_line('A','Usage Graph Menu'); + menu1_line('B','Todays Usage'); + ftr('Renegade Statistics Main Menu'); +END; + +PROCEDURE top10menuscr; +BEGIN + hdr('Renegade Statistics Top 10 User Menu'); + menu_line('A','B','Most Frequent Callers','High Time Users'); + menu_line('C','D','File Kbyte Uploaders','File Kbyte Downloaders'); + menu_line('E','F','Private Message Senders','Public Message Posters'); + menu_line('G','H','SysOp Feedback Senders','All Time Callers'); + menu_line('I','J','File Uploaders','File Downloaders'); + menu_line('K','L','File Points','Upload/Download Ratios'); + menu_line('M',' ','Post/Call Ratios',''); + ftr('Renegade Statistics User Menu'); +END; + +PROCEDURE graph20menuscr; +BEGIN + hdr('Renegade Statistics Usage Graph Menu'); + menu_line('A','B','Minutes Active','Number Of Calls'); + menu_line('C','D','New User Logons','System Activity'); + menu_line('E','F','Average Time/User','Public Message Posting'); + menu_line('G','H','Private Message Posting','SysOp Feedback Sent'); + menu_line('I','J','Number Of Errors','File Uploads'); + menu_line('K','L','File Kbytes Uploaded','File Downloads'); + menu_line('M',' ','File Kbytes Downloaded',''); + ftr('Renegade Statistics Usage Menu'); +END; + +PROCEDURE mainmenu(General: GeneralRecordType; config: configinfo; tfreqc,tttimeon, + tulk,tdlk,tprivp,tpubp,tfeedback,tnumc, + tnumul,tnumdl,tfilep,tupd,tpostc: t_array; gdate: d_array; + gsysact: gsysactivity; gmina,gnumc,gnewu,gtimeu,gmsgpub, + gmsgpvt,gmsgfb,gnume,gful,gulkb,gfdl,gdlkb: g_array; + uage,usex: m_array; ubaud: h_array; frec: f_array); +VAR + c: char; +BEGIN + REPEAT + mainmenuscr(General.boardname); + OneK(c,'QABC'); + CASE c OF + 'A' : BEGIN + REPEAT + usermenuscr; + OneK(c,'QABCD'); + CASE c OF + 'A' : BEGIN + REPEAT + top10menuscr; + OneK(c,'QABCDEFGHIJKLM'); + CASE c OF + 'A' : display_t_freqcall(3,12,tfreqc,'Most Frequent Callers', + 'Average Number Of Days Between Calls'); + 'B' : display_t_array(0,8,tttimeon,'High Time Users', + 'Total Number Of Minutes Online'); + 'C' : display_t_array(0,8,tulk,'File Kbyte Uploaders', + 'Number Of Kbytes Uploaded'); + 'D' : display_t_array(0,8,tdlk,'File Kbyte Downloaders', + 'Number Of Kbytes Downloaded'); + 'E' : display_t_array(0,6,tprivp,'Private Message Senders', + 'Number Of Private Messages Sent'); + 'F' : display_t_array(0,6,tpubp,'Public Message Posters', + 'Number Of Public Messages Posted'); + 'G' : display_t_array(0,6,tfeedback,'SysOp Feedback Senders', + 'Number Of SysOp Feedback Sent'); + 'H' : display_t_array(0,6,tnumc,'All Time Callers', + 'Number Of Calls To The System'); + 'I' : display_t_array(0,6,tnumul,'File Uploaders', + 'Number Of Files Uploaded'); + 'J' : display_t_array(0,6,tnumdl,'File Downloaders', + 'Number Of Files Downloaded'); + 'K' : display_t_array(0,6,tfilep,'File Points', + 'Amount Of File Points On Hand'); + 'L' : display_t_array(3,12,tupd,'Upload/Download Ratios', + 'Number Of KB Uploaded For Each KB Downloaded'); + 'M' : display_t_array(3,12,tpostc,'Post/Call Ratios', + 'Number Of Public Messages Posted Each Call'); + END; + UNTIL (c = 'Q') OR HangUp; + c := #0; + END; + 'B' : display_m_array(uage,'User Age Statistics','The Average User Age Is', + 'The Youngest User Is','The Oldest User Is',3); + 'C' : display_m_array(usex,'User Gender Statistics','Total Male Users', + 'Total Female Users','Total Not Specified',5); + 'D' : display_h_array(ubaud); + END; + UNTIL (c = 'Q') OR HangUp; + c := #0; + END; + 'B' : BEGIN + REPEAT + usagemenuscr; + OneK(c,'QAB'); + CASE c OF + 'A' : BEGIN + REPEAT + graph20menuscr; + OneK(c,'QABCDEFGHIJKLM'); + CASE c OF + 'A' : display_g_array(config,gdate,gmina,'Total Minutes Active', + ' setuniM ',div_g(gmina)); + 'B' : display_g_array(config,gdate,gnumc,'Total Calls', + ' sllaC ',div_g(gnumc)); + 'C' : display_g_array(config,gdate,gnewu,'New User Logons to System', + ' sresU weN ',div_g(gnewu)); + 'D' : display_g_sysactivity(config,gdate,gsysact,' tnecreP '); + 'E' : display_g_array(config,gdate,gtimeu,'Average Time/User', + ' setuniM ',div_g(gtimeu)); + 'F' : display_g_array(config,gdate,gmsgpub,'Public Messages Posted', + ' segasseM ',div_g(gmsgpub)); + 'G' : display_g_array(config,gdate,gmsgpvt,'Private Messages Sent', + ' segasseM ',div_g(gmsgpvt)); + 'H' : display_g_array(config,gdate,gmsgfb,'SysOp Feedback Sent', + ' segasseM ',div_g(gmsgfb)); + 'I' : display_g_array(config,gdate,gnume,'Logon Errors', + ' srorrE ',div_g(gnume)); + 'J' : display_g_array(config,gdate,gful,'File Uploads', + ' seliF ',div_g(gful)); + 'K' : display_g_array(config,gdate,gulkb,'Total Upload Kbytes', + ' setybK ',div_g(gulkb)); + 'L' : display_g_array(config,gdate,gfdl,'File Downloads', + ' seliF ',div_g(gfdl)); + 'M' : display_g_array(config,gdate,gdlkb,'Total Download Kbytes', + ' setybK ',div_g(gdlkb)); + END; + UNTIL (c = 'Q') OR HangUp; + c := #0; + END; + 'B' : todayusage(General); + END; + UNTIL (c = 'Q') OR HangUp; + c := #0; + END; + END; + UNTIL (c = 'Q') OR HangUp; +END; + +BEGIN + read_config_file(config,chatconfig); + TempPause := FALSE; + read_usage_file(General,config,gdate,gsysact,gmina,gnumc,gnewu,gtimeu, + gmsgpub,gmsgpvt,gmsgfb,gnume,gful,gulkb,gfdl,gdlkb); + scrn_one; + read_user_file(General,config,uage,usex,ubaud,tfreqc,tttimeon,tulk,tdlk, + tprivp,tpubp,tfeedback,tnumc,tnumul,tnumdl,tfilep,tupd, + tpostc); + mainmenu(General,config,tfreqc,tttimeon,tulk,tdlk,tprivp,tpubp, + tfeedback,tnumc,tnumul,tnumdl,tfilep,tupd,tpostc,gdate,gsysact, + gmina,gnumc,gnewu,gtimeu,gmsgpub,gmsgpvt,gmsgfb,gnume,gful,gulkb, + gfdl,gdlkb,uage,usex,ubaud,frec); + scrn_two(General.boardname); +END. diff --git a/SOURCE/UNUSED/RGUPDATE.EXE b/SOURCE/UNUSED/RGUPDATE.EXE new file mode 100644 index 0000000..8b9ea64 Binary files /dev/null and b/SOURCE/UNUSED/RGUPDATE.EXE differ diff --git a/SOURCE/UNUSED/RGUPDATE.PAS b/SOURCE/UNUSED/RGUPDATE.PAS new file mode 100644 index 0000000..d7fc245 --- /dev/null +++ b/SOURCE/UNUSED/RGUPDATE.PAS @@ -0,0 +1,843 @@ +{$M 49152,0,65536} +PROGRAM RGUPDATE; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +TYPE + + OldGeneralRecordType = +{$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: ACString; { ACS to change their vote } + + 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: Byte; { Swap where? } + + 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 } + MinSpaceForPost, { minimum drive space left to post } + MinSpaceForUpload, { minimum drive space left to upload } + 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: Integer; { check user's birthdate every xx logons } + + MaxQWKTotal, { max msgs in a packet, period } + MaxQWKBase, { max msgs in a area } + DaysOnline: Word; { days online } + + 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: LongInt; { max K allowed in TEMP } + + 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, + 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: Boolean; { perform integrity tests on uploads? } + + 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: Word; + 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; + + OldStatusFlagType = + (OldLockedOut, { if locked out } + OldDeleted, { if deleted } + OldTrapActivity, { if trapping users activity } + OldTrapSeparate, { if trap to seperate TRAP file } + OldChatAuto, { if auto chat trapping } + OldChatSeparate, { if separate chat file to trap to } + OldSLogSeparate, { if separate SysOp log } + OldCLSMsg, { if clear-screens } + OldRIP, { if RIP graphics can be used } + OldFSEditor, { if Full Screen Editor } + OldAutoDetect { Use auto-detected emulation } + ); + + OldStatusFlagSet = SET OF OldStatusFlagType; + + OldUserRecordType = { 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: Char; { last conference in } + + 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: Byte; { menu to start at } + + BirthDate, { Birth date } + FirstOn, { First On Date } + LastOn, { Last On Date } + TTimeOn, { total time on } + LastQWK, { last qwk packet } + Expiration: UnixTime; { Expiration date } + + UserID, { Permanent userid } + TLToday, { # min left today } + ForUsr, { forward mail to } + LastMsgArea, { # last msg area } + LastFileArea: Integer; { # last file area } + + PasswordChanged: Word; { Numeric date pw changed - was UnixTime } + + Credit, { 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 } + TimeBankWith: LongInt; { Time withdrawn } + + TeleConfEcho, { Teleconf echo? } + TeleConfInt, { Teleconf interrupt } + GetOwnQWK, { Get own messages } + ScanFilesQWK, { new files in qwk } + PrivateQWK: Boolean; { private mail qwk } + + AR: ARFlagSet; { AR flags } + Flags: FlagSet; { flags } + OldSFlags: OldStatusFlagSet; { status flags } + END; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +function exist(fn: astr): boolean; +var + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +PROCEDURE ChangeLength(S: STRING; VAR S1,S2: STRING); +VAR + TempStr: STRING; + Counter: Byte; +BEGIN + IF (Length(S) <= 60) THEN + BEGIN + S1 := S; + S2 := ''; + END + ELSE + BEGIN + TempStr := Copy(S,1,65); + IF (TempStr[65] <> ' ') THEN + BEGIN + Counter := 65; + WHILE (TempStr[Counter] <> ' ') DO + BEGIN + Dec(TempStr[0]); + Dec(Counter); + END; + Dec(TempStr[0]); + S1 := TempStr; + S2 := Copy(S,(Counter + 1),Length(S)); + END + ELSE + BEGIN + S1 := Copy(S,1,64); + S2 := Copy(S,66,Length(S)); + END; + END; +END; + +PROCEDURE Kill(CONST FileName: AStr); +VAR + F: FILE; +BEGIN + Assign(F,FileName); + Erase(F); +END; + +PROCEDURE ConvertGeneralRec; +VAR + OldGeneralFile: FILE OF OldGeneralRecordType; + GeneralFile: FILE OF GeneralRecordType; + OldGeneral: OldGeneralRecordType; + General: GeneralRecordType; + Counter: Integer; +BEGIN + Write('Converting "RENEGADE.DAT" file ... '); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Reset(OldGeneralFile); + Assign(GeneralFile,'RENEGADE.NEW'); + ReWrite(GeneralFile); + Seek(OldGeneralFile,0); + Read(OldGeneralFile,OldGeneral); + WITH General DO + BEGIN + ForgotPWQuestion := OldGeneral.ForgotPWQuestion; + + QWKWelcome := OldGeneral.QWKWelcome; + QWKNews := OldGeneral.QWKNews; + QWKGoodbye := OldGeneral.QWKGoodBye; + Origin := OldGeneral.Origin; + + DataPath := OldGeneral.DataPath; + MiscPath := OldGeneral.MiscPath; + LogsPath := OldGeneral.LogsPath; + MsgPath := OldGeneral.MsgPath; + NodePath := OldGeneral.NodePath; + TempPath := OldGeneral.TempPath; + ProtPath := OldGeneral.ProtPath; + ArcsPath := OldGeneral.ArcsPath; + lMultPath := OldGeneral.LMultPath; + FileAttachPath := OldGeneral.FileAttachPath; + QWKLocalPath := OldGeneral.QWKLocalPath; + DefEchoPath := OldGeneral.DefEchoPath; + NetmailPath := OldGeneral.NetMailPath; + BBSName := OldGeneral.BBSName; + + SysOpName := OldGeneral.SysOpName; + + Version := '1.XX'; (* <-- Update this with version *) + + BBSPhone := OldGeneral.BBSPhone; + + LastDate := OldGeneral.LastDate; + + PacketName := OldGeneral.PacketName; + BulletPrefix := OldGeneral.BulletPrefix; + + SysOpPW := OldGeneral.SysOpPW; + NewUserPW := OldGeneral.NewUserPW; + MinBaudOverride := OldGeneral.MinBaudOverride; + QWKNetworkACS := OldGeneral.QWKNetworkACS; + LastOnDatACS := OldGeneral.LastOnDatACS; + SOP := OldGeneral.SOP; + CSOP := OldGeneral.CSOP; + MSOP := OldGeneral.MSOP; + FSOP := OldGeneral.FSOP; + SPW := OldGeneral.SPW; + AddChoice := OldGeneral.AddChoice; + NormPubPost := OldGeneral.NormPubPost; + NormPrivPost := OldGeneral.NormPrivPost; + AnonPubRead := OldGeneral.AnonPubRead; + AnonPrivRead := OldGeneral.AnonPrivRead; + AnonPubPost := OldGeneral.AnonPubPost; + AnonPrivPost := OldGeneral.AnonPrivPost; + SeeUnval := OldGeneral.SeeUnval; + DLUnval := OldGeneral.DLUnval; + NoDLRatio := OldGeneral.NoDLRatio; + NoPostRatio := OldGeneral.NoPostRatio; + NoFileCredits := OldGeneral.NoFileCredits; + ULValReq := OldGeneral.ULValReq; + TeleConfMCI := OldGeneral.TeleConfMCI; + OverrideChat := OldGeneral.OverrideChat; + NetMailACS := OldGeneral.NetMailACS; + Invisible := OldGeneral.Invisible; + FileAttachACS := OldGeneral.FileAttachACS; + ChangeVote := OldGeneral.ChangeVote; + UnUsedACS1 := ''; + UnUsedACS2 := ''; + + MaxPrivPost := OldGeneral.MaxPrivPost; + MaxFBack := OldGeneral.MaxFBack; + MaxPubPost := OldGeneral.MaxPubPost; + MaxChat := OldGeneral.MaxChat; + MaxWaiting := OldGeneral.MaxWaiting; + CSMaxWaiting := OldGeneral.CSMaxWaiting; + MaxMassMailList := OldGeneral.MaxMassMailList; + MaxLogonTries := OldGeneral.MaxLogonTries; + SysOpColor := OldGeneral.SysOpColor; + UserColor := OldGeneral.UserColor; + SliceTimer := OldGeneral.SliceTimer; + MaxBatchDLFiles := OldGeneral.MaxBatchDLFiles; + MaxBatchULFiles := OldGeneral.MaxBatchULFiles; + Text_Color := OldGeneral.Text_Color; + Quote_Color := OldGeneral.Quote_Color; + Tear_Color := OldGeneral.Tear_Color; + Origin_Color := OldGeneral.Origin_Color; + BackSysOpLogs := OldGeneral.BackSysOpLogs; + EventWarningTime := OldGeneral.EventWarningTime; + WFCBlankTime := OldGeneral.WFCBlankTime; + AlertBeep := OldGeneral.AlertBeep; + FileCreditComp := OldGeneral.FileCreditComp; + FileCreditCompBaseSize := OldGeneral.FileCreditCompBaseSize; + ULRefund := OldGeneral.ULRefund; + GlobalMenu := OldGeneral.GlobalMenu; + AllStartMenu := OldGeneral.AllStartMenu; + ShuttleLogonMenu := OldGeneral.ShuttleLogonMenu; + NewUserInformationMenu := OldGeneral.NewUserInformationMenu; + FileListingMenu := OldGeneral.FileListingMenu; + MessageReadMenu := OldGeneral.MessageReadMenu; + CurWindow := OldGeneral.CurWindow; + SwapTo := OldGeneral.SwapTo; + UnUsedByte1 := 0; + UnUsedByte2 := 0; + + lLowTime := OldGeneral.lLowTime; + HiTime := OldGeneral.HiTime; + DLLowTime := OldGeneral.DLLowTime; + DLHiTime := OldGeneral.DLHiTime; + MinBaudLowTime := OldGeneral.MinBaudLowTime; + MinBaudHiTime := OldGeneral.MinBaudHiTime; + MinBaudDLLowTime := OldGeneral.MinBaudDLLowTime; + MinBaudDLHiTime := OldGeneral.MinBaudDLHiTime; + NewApp := OldGeneral.NewApp; + TimeOutBell := OldGeneral.TimeOutBell; + TimeOut := OldGeneral.TimeOut; + ToSysOpDir := OldGeneral.ToSysOpDir; + CreditMinute := OldGeneral.CreditMinute; + CreditPost := OldGeneral.CreditPost; + CreditEmail := OldGeneral.CreditEmail; + CreditFreeTime := OldGeneral.CreditFreeTime; + NumUsers := OldGeneral.NumUsers; + PasswordChange := OldGeneral.PasswordChange; + RewardRatio := OldGeneral.RewardRatio; + CreditInternetMail := OldGeneral.CreditInternetMail; + BirthDateCheck := OldGeneral.BirthDateCheck; + UnUsedInteger1 := 0; + UnUsedInteger2 := 0; + + MaxQWKTotal := OldGeneral.MaxQWKTotal; + MaxQWKBase := OldGeneral.MaxQWKBase; + DaysOnline := OldGeneral.DaysOnline; + UnUsedWord1 := 0; + UnUsedWord2 := 0; + + MinimumBaud := OldGeneral.MinimumBaud; + MinimumDLBaud := OldGeneral.MinimumDLBaud; + MaxDepositEver := OldGeneral.MaxDepositEver; + MaxDepositPerDay := OldGeneral.MaxDepositPerDay; + MaxWithdrawalPerDay := OldGeneral.MaxWithdrawalPerDay; + CallerNum := OldGeneral.CallerNum; + RegNumber := OldGeneral.RegNumber; + TotalCalls := OldGeneral.TotalCalls; + TotalUsage := OldGeneral.TotalUsage; + TotalPosts := OldGeneral.TotalPosts; + TotalDloads := OldGeneral.TotalDloads; + TotalUloads := OldGeneral.TotalUloads; + MinResume := OldGeneral.MinResume; + MaxInTemp := OldGeneral.MaxInTemp; + MinSpaceForPost := OldGeneral.MinSpaceForPost; + MinSpaceForUpload := OldGeneral.MinSpaceForUpload; + UnUsedLongInt1 := 0; + UnUsedLongInt2 := 0; + + AllowAlias := OldGeneral.AllowAlias; + PhonePW := OldGeneral.PhonePW; + LocalSec := OldGeneral.LocalSec; + GlobalTrap := OldGeneral.GlobalTrap; + AutoChatOpen := OldGeneral.AutoChatOpen; + AutoMInLogon := OldGeneral.AutoMInLogon; + BullInLogon := OldGeneral.BullInLogon; + YourInfoInLogon := OldGeneral.YourInfoInLogon; + OffHookLocalLogon := OldGeneral.OffHookLocalLogon; + ForceVoting := OldGeneral.ForceVoting; + CompressBases := OldGeneral.CompressBases; + SearchDup := OldGeneral.SearchDup; + ForceBatchDL := OldGeneral.ForceBatchDL; + ForceBatchUL := FALSE; + LogonQuote := OldGeneral.LogonQuote; + UserAddQuote := OldGeneral.UserAddQuote; + StripCLog := OldGeneral.StripCLog; + SKludge := OldGeneral.SKludge; + SSeenby := OldGeneral.SSeenby; + SOrigin := OldGeneral.SOrigin; + AddTear := OldGeneral.AddTear; + ShuttleLog := OldGeneral.ShuttleLog; + ClosedSystem := OldGeneral.ClosedSystem; + SwapShell := OldGeneral.SwapShell; + UseEMS := OldGeneral.UseEMS; + UseBios := OldGeneral.UseBios; + UseIEMSI := OldGeneral.UseIEMSI; + ULDLRatio := OldGeneral.ULDLRatio; + FileCreditRatio := OldGeneral.FileCreditRatio; + ValidateAllFiles := OldGeneral.ValidateAllFiles; + FileDiz := OldGeneral.FileDiz; + SysOpPword := OldGeneral.SysOpPword; + TrapTeleConf := OldGeneral.TrapTeleConf; + IsTopWindow := OldGeneral.IsTopWindow; + ReCompress := OldGeneral.ReCompress; + RewardSystem := OldGeneral.RewardSystem; + TrapGroup := OldGeneral.TrapGroup; + QWKTimeIgnore := OldGeneral.QWKTimeIgnore; + NetworkMode := OldGeneral.NetworkMode; + WindowOn := OldGeneral.WindowOn; + ChatCall := OldGeneral.ChatCall; + DailyLimits := OldGeneral.DailyLimits; + MultiNode := OldGeneral.MultiNode; + PerCall := OldGeneral.PerCall; + TestUploads := OldGeneral.TestUploads; + UseFileAreaLightBar := TRUE; + UseMsgAreaLightBar := TRUE; + UnUsedBoolean1 := FALSE; + UnUsedBoolean2 := FALSE; + + FOR Counter := 1 TO MaxArcs DO + FileArcInfo[Counter] := OldGeneral.FileArcInfo[Counter]; + + FOR Counter := 1 TO 3 DO + FileArcComment[Counter] := OldGeneral.FileArcComment[Counter]; + + FOR Counter := 0 TO 20 DO + WITH AKA[Counter] DO + BEGIN + Zone := OldGeneral.AKA[Counter].Zone; + Net := OldGeneral.AKA[Counter].Net; + Node := OldGeneral.AKA[Counter].Node; + Point := OldGeneral.AKA[Counter].Point; + END; + + FOR Counter := 1 TO 20 DO + NewUserToggles[Counter] := OldGeneral.NewUserToggles[Counter]; + + FOR Counter := 0 TO 9 DO + Macro[Counter] := OldGeneral.Macro[Counter]; + + Netattribute := OldGeneral.NetAttribute; + + TimeAllow := OldGeneral.TimeAllow; + CallAllow := OldGeneral.CallAllow; + DLRatio := OldGeneral.DLRatio; + DLKRatio := OldGeneral.DLKRatio; + PostRatio := OldGeneral.PostRatio; + DLOneday := OldGeneral.DLOneDay; + DLKOneDay := OldGeneral.DLKOneDay; + END; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(OldGeneralFile); + Close(GeneralFile); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Erase(OldGeneralFile); + Assign(GeneralFile,'RENEGADE.NEW'); + ReName(GeneralFile,'RENEGADE.DAT'); + WriteLn('Done'); +END; + +PROCEDURE ConvertUserRec(OldGeneral: OldGeneralRecordType); +VAR + OldUserFile: FILE OF OldUserRecordType; + UserFile: FILE OF UserRecordType; + OldUser: OldUserRecordType; + User: UserRecordType; + Counter, + Counter1: Integer; +BEGIN + Write('Converting "USERS.DAT" file ... '); + Assign(OldUserFile,OldGeneral.DataPath+'USERS.DAT'); + Reset(OldUserFile); + Assign(UserFile,OldGeneral.DataPath+'USERS.NEW'); + ReWrite(UserFile); + Counter := 0; + WHILE (Counter <= (FileSize(OldUserFile) - 1)) DO + BEGIN + Seek(OldUserFile,Counter); + Read(OldUserFile,OldUser); + WITH User DO + BEGIN + Name := OldUser.Name; + RealName := OldUser.RealName; + Street := OldUser.Street; + CityState := OldUser.CityState; + CallerID := OldUser.CallerID; + ZipCode := OldUser.ZipCode; + PH := OldUser.PH; + ForgotPWAnswer := OldUser.ForgotPWAnswer; + FOR Counter1 := 1 TO 3 DO + UsrDefStr[Counter1] := OldUser.UsrDefStr[Counter1]; + Note := OldUser.Note; + LockedFile := OldUser.LockedFile; + FOR Counter1 := 1 TO 25 DO + Vote[Counter1] := OldUser.Vote[Counter1]; + Sex := OldUser.Sex; + Subscription := OldUser.SubScription; + ExpireTo := OldUser.ExpireTo; + LastConf := OldUser.LastConf; + UnUsedChar1 := ' '; + UnUsedChar2 := ' '; + + SL := OldUser.SL; + DSL := OldUser.DSL; + Waiting := OldUser.Waiting; + LineLen := OldUser.LineLen; + PageLen := OldUser.PageLen; + OnToday := OldUser.OnToday; + Illegal := OldUser.Illegal; + DefArcType := OldUser.DefArcType; + ColorScheme := OldUser.ColorScheme; + UserStartMenu := OldUser.UserStartMenu; + UnUsedByte1 := 0; + UnUsedByte2 := 0; + + BirthDate := OldUser.BirthDate; + FirstOn := OldUser.FirstOn; + LastOn := OldUser.LastOn; + TTimeOn := OldUser.TTimeOn; + LastQWK := OldUser.LastQWK; + Expiration := OldUser.Expiration; + UnUsedUnixTime1 := 0; + UnUsedUnixTime2 := 0; + + UserID := OldUser.UserID; + TLToday := OldUser.TLToday; + ForUsr := OldUser.ForUsr; + LastMsgArea := OldUser.LastMsgArea; + LastFileArea := OldUser.LastFileArea; + UnUsedInteger1 := 0; + UnUsedInteger2 := 0; + + PasswordChanged := OldUser.PasswordChanged; + UnUsedWord1 := 0; + UnUsedWord2 := 0; + + LCredit := OldUser.Credit; + Debit := OldUser.Debit; + PW := OldUser.PW; + Uploads := OldUser.Uploads; + Downloads := OldUser.Downloads; + UK := OldUser.UK; + DK := OldUser.DK; + LoggedOn := OldUser.LoggedOn; + MsgPost := OldUser.MsgPost; + EmailSent := OldUser.EmailSent; + FeedBack := OldUser.FeedBack; + TimeBank := OldUser.TimeBank; + TimeBankAdd := OldUser.TimeBankAdd; + DLKToday := OldUser.DLKToday; + DLToday := OldUser.DLToday; + FilePoints := 0; + TimeBankWith := OldUser.TimeBankWith; + UnUsedLongInt1 := 0; + UnUsedLongInt2 := 0; + + TeleConfEcho := OldUser.TeleConfEcho; + TeleConfInt := OldUser.TeleConfInt; + GetOwnQWK := OldUser.GetOwnQWK; + ScanFilesQWK := OldUser.ScanFilesQWK; + PrivateQWK := OldUser.PrivateQWK; + UnUsedBoolean1 := FALSE; + UnUsedBoolean2 := FALSE; + + AR := OldUser.AR; + + Flags := OldUser.Flags; + + SFlags := []; + IF (OldLockedOut IN OldUser.OldSFlags) THEN + Include(SFlags,LockedOut); + IF (OldDeleted IN OldUser.OldSFlags) THEN + Include(SFlags,Deleted); + IF (OldTrapActivity IN OldUser.OldSFlags) THEN + Include(SFlags,TrapActivity); + IF (OldTrapSeparate IN OldUser.OldSFlags) THEN + Include(SFlags,TrapSeparate); + IF (OldChatAuto IN OldUser.OldSFlags) THEN + Include(SFlags,ChatAuto); + IF (OldChatSeparate IN OldUser.OldSFlags) THEN + Include(SFlags,ChatSeparate); + IF (OldSLogSeparate IN OldUser.OldSFlags) THEN + Include(SFlags,SLogSeparate); + IF (OldCLSMsg IN OldUser.OldSFlags) THEN + Include(SFlags,CLSMsg); + IF (OldRIP IN OldUser.OldSFlags) THEN + Include(SFlags,RIP); + IF (OldFSEditor IN OldUser.OldSFlags) THEN + Include(SFlags,FSEditor); + IF (OldAutoDetect IN OldUser.OldSFlags) THEN + Include(SFlags,AutoDetect); + Include(SFlags,FileAreaLightBar); + Include(SFlags,MsgAreaLightBar); + END; + Write(UserFile,User); + Inc(Counter); + END; + Close(OldUserFile); + Close(UserFile); + Assign(OldUserFile,OldGeneral.DataPath+'USERS.DAT'); + Erase(OldUserFile); + Assign(UserFile,OldGeneral.DataPath+'USERS.NEW'); + ReName(UserFile,OldGeneral.DataPath+'USERS.DAT'); + WriteLn('Done'); +END; + +VAR + OldGeneralFile: FILE OF OldGeneralRecordType; + OldGeneral: OldGeneralRecordType; + +BEGIN + ClrScr; + WriteLn('Renegade Upgrade Utility (v1.XX to v1.XX)'); (* <-- Update this with version *) + WriteLn; + Writeln('This utility will upgrade your Renegade BBS from'); + WriteLn('Version 1.XX to Version 1.XX'); (* <-- Update this with version *) + WriteLn; + IF PYNQ('Do you want to continue? ') THEN + BEGIN + WriteLn; + Write('Reading "RENEGADE.DAT" file ... '); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Reset(OldGeneralFile); + Seek(OldGeneralFile,0); + Read(OldGeneralFile,OldGeneral); + Close(OldGeneralFile); + WriteLn('Done'); + WriteLn; + IF (Exist(OldGeneral.DataPath+'BATCHDL.DAT')) THEN + BEGIN + Write('Deleting "BATCHDL.DAT" file ... '); + Kill(OldGeneral.DataPath+'BATCHDL.DAT'); + WriteLn('Done'); + END; + ConvertUserRec(OldGeneral); + ConvertGeneralRec; + END; +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGUPDT1.EXE b/SOURCE/UNUSED/RGUPDT1.EXE new file mode 100644 index 0000000..f4c2025 Binary files /dev/null and b/SOURCE/UNUSED/RGUPDT1.EXE differ diff --git a/SOURCE/UNUSED/RGUPDT1.PAS b/SOURCE/UNUSED/RGUPDT1.PAS new file mode 100644 index 0000000..8d948ce --- /dev/null +++ b/SOURCE/UNUSED/RGUPDT1.PAS @@ -0,0 +1,776 @@ +{$M 49152,0,65536} +PROGRAM RGUPDT1; + +USES + Crt, + Dos; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +TYPE + OldValidationRecordType = +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Description: STRING[25]; { description } + NewSL, { new SL } + NewDSL, { new DSL } + NewMenu: Byte; { User start out menu } + Expiration: Word; { days until expiration } + NewFP, { nothing } + NewCredit: LongInt; { new credit } + ExpireTo: Char; { validation level to expire to } + SoftAR, { TRUE=AR added to current, else replaces } + SoftAC: Boolean; { TRUE=AC " " " " " } + NewAR: ARFlagSet; { new AR } + NewAC: FlagSet; { new AC } + END; + + OldGeneralRecordType = +{$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 } + MultPath, { 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: ACString; { ACS to change their vote } + + 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: Byte; { Swap where? } + + LowTime, { 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 } + MinSpaceForPost, { minimum drive space left to post } + MinSpaceForUpload, { minimum drive space left to upload } + + 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: Integer; { check user's birthdate every xx logons } + + MaxQWKTotal, { max msgs in a packet, period } + MaxQWKBase, { max msgs in a area } + DaysOnline: Word; { days online } + + 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: LongInt; { max K allowed in TEMP } + + 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, + 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: Boolean; { perform integrity tests on uploads? } + + 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: Word; + END; + + NewUserToggles: ARRAY [1..20] OF Byte; + + OldValidation: ARRAY ['A'..'Z'] OF + OldValidationRecordType; { Validation records A - Z } + + 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; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +function exist(fn: astr): boolean; +var + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +FUNCTION Caps(s: STRING): STRING; +VAR + Counter: Integer; { must be Integer } +BEGIN + IF (s[1] IN ['a'..'z']) THEN + Dec(s[1],32); + FOR Counter := 2 TO Length(s) DO + IF (s[Counter - 1] IN ['a'..'z','A'..'Z']) THEN + IF (s[Counter] IN ['A'..'Z']) THEN + Inc(s[Counter],32) + ELSE + ELSE + IF (s[Counter] IN ['a'..'z']) THEN + Dec(s[Counter],32); + Caps := s; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := S; +END; + +FUNCTION ReadUsers(OldGeneral: OldGeneralRecordType): Boolean; +VAR + TFile: Text; + UserFile: FILE OF UserRecordType; + User: UserRecordType; + RecNum, + RecNum1, + RecNum2: Integer; +BEGIN + Assign(UserFile,OldGeneral.DataPath+'USERS.DAT'); + Reset(UserFile); + + Write('Number of users with invalid expiration setup ... '); + + Assign(TFile,'EXPIRE.TXT'); + ReWrite(TFile); + WriteLn(TFile,'Users with invalid expiration setup:'); + Writeln(TFile,''); + + RecNum1 := 0; + RecNum := 0; + WHILE (RecNum <= (FileSize(UserFile) - 1)) DO + BEGIN + Seek(UserFile,RecNum); + Read(UserFile,User); + IF (User.Expiration = 0) AND (User.ExpireTo <> ' ') OR + (User.Expiration <> 0) AND (User.ExpireTo = ' ') THEN + BEGIN + WriteLn(TFile,Caps(User.Name)+' #'+IntToStr(RecNum)); + Inc(RecNum1); + END; + Inc(RecNum); + END; + WriteLn(TFile); + Close(TFile); + IF (RecNum1 = 0) THEN + Erase(TFile); + WriteLn(IntToStr(RecNum1)); + + Write('Number of users with invalid expire to key ... '); + + Assign(TFile,'KEY.TXT'); + ReWrite(TFile); + WriteLn(TFile,'Users with invalid expire to keys:'); + WriteLn(TFile,''); + + Reset(UserFile); + RecNum2 := 0; + RecNum := 0; + WHILE (RecNum <= (FileSize(UserFile) - 1)) DO + BEGIN + Seek(UserFile,RecNum); + Read(UserFile,User); + IF (User.ExpireTo <> ' ') THEN + IF (OldGeneral.OldValidation[User.ExpireTo].Description = '') THEN + BEGIN + WriteLn(TFile,Caps(User.Name)+' #'+IntToStr(RecNum)); + Inc(RecNum2); + END; + Inc(RecNum); + END; + Close(TFile); + IF (RecNum2 = 0) THEN + Erase(TFile); + WriteLn(IntToStr(RecNum2)); + + Close(UserFile); + ReadUsers := (RecNum1 = 0) AND (RecNum2 = 0); +END; + +PROCEDURE CreateValidationRec(OldGeneral: OldGeneralRecordType); +VAR + ValidationFile: FILE OF ValidationRecordType; + Validation: ValidationRecordType; + UserFile: FILE OF UserRecordType; + User: UserRecordType; + C: Char; +BEGIN + Write('Creating "VALIDATE.DAT" file ... '); + + Assign(UserFile,OldGeneral.DataPath+'USERS.DAT'); + Reset(UserFile); + Seek(UserFile,0); + Read(UserFile,User); + Close(UserFile); + + Assign(ValidationFile,OldGeneral.DataPath+'VALIDATE.DAT'); + ReWrite(ValidationFile); + FOR C := 'A' TO 'Z' DO + IF (OldGeneral.OldValidation[C].Description <> '') THEN + BEGIN + WITH Validation DO + BEGIN + IF (C = 'A') THEN + Key := '!' + ELSE + Key := C; + IF (OldGeneral.OldValidation[C].Expiration = 0) THEN + ExpireTo := ' ' + ELSE + ExpireTo := OldGeneral.OldValidation[C].ExpireTo; + IF (C = 'A') THEN + Description := 'New User Validation' + ELSE + Description := OldGeneral.OldValidation[C].Description; + UserMsg := 'You have been validated, enjoy the system!'; + IF (OldGeneral.OldValidation[C].NewSL < User.SL) THEN + NewSL := User.SL + ELSE + NewSL := OldGeneral.OldValidation[C].NewSL; + IF (OldGeneral.OldValidation[C].NewDSL < User.DSL) THEN + NewDSL := User.DSL + ELSE + NewDSL := OldGeneral.OldValidation[C].NewDSL; + NewMenu := OldGeneral.OldValidation[C].NewMenu; + IF (OldGeneral.OldValidation[C].ExpireTo = ' ') THEN + Expiration := 0 + ELSE + Expiration := OldGeneral.OldValidation[C].Expiration; + NewFP := OldGeneral.OldValidation[C].NewFP; + NewCredit := OldGeneral.OldValidation[C].NewCredit; + SoftAR := OldGeneral.OldValidation[C].SoftAR; + SoftAC := OldGeneral.OldValidation[C].SoftAR; + NewAR := OldGeneral.OldValidation[C].NewAR; + NewAC := OldGeneral.OldValidation[C].NewAC; + END; + Write(ValidationFile,Validation); + END; + Close(ValidationFile); + Writeln('Done'); +END; + +PROCEDURE ConvertGeneralRec(OldGeneral: OldGeneralRecordType); +VAR + OldGeneralFile: FILE OF OldGeneralRecordType; + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + C: Char; + Counter: Byte; +BEGIN + Write('Converting "RENEGADE.DAT" file ... '); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Reset(OldGeneralFile); + Assign(GeneralFile,'RENEGADE.NEW'); + ReWrite(GeneralFile); + Seek(OldGeneralFile,0); + Read(OldGeneralFile,OldGeneral); + FillChar(General,SizeOf(General),0); + WITH General DO + BEGIN + ForgotPWQuestion := OldGeneral.ForgotPWQuestion; + + QWKWelcome := OldGeneral.QWKWelcome; + QWKNews := OldGeneral.QWKNews; + QWKGoodbye := OldGeneral.QWKGoodbye; + Origin := OldGeneral.Origin; + + DataPath := OldGeneral.DataPath; + MiscPath := OldGeneral.MiscPath; + LogsPath := OldGeneral.LogsPath; + MsgPath := OldGeneral.MsgPath; + NodePath := OldGeneral.NodePath; + TempPath := OldGeneral.TempPath; + ProtPath := OldGeneral.ProtPath; + ArcsPath := OldGeneral.ArcsPath; + MultPath := OldGeneral.MultPath; + FileAttachPath := OldGeneral.FileAttachPath; + QWKLocalPath := OldGeneral.QWKLocalPath; + DefEchoPath := OldGeneral.DefEchoPath; + NetmailPath := OldGeneral.NetMailPath; + BBSName := OldGeneral.BBSName; + + SysOpName := OldGeneral.SysOpName; + + Version := Ver; + + BBSPhone := OldGeneral.BBSPhone; + + LastDate := OldGeneral.LastDate; + + PacketName := OldGeneral.PacketName; + BulletPrefix := OldGeneral.BulletPrefix; + + SysOpPW := OldGeneral.SysOpPw; + NewUserPW := OldGeneral.NewUserPW; + MinBaudOverride := OldGeneral.MinBaudOverride; + QWKNetworkACS := OldGeneral.QWKNetworkACS; + LastOnDatACS := OldGeneral.LastOnDatACS; + SOP := OldGeneral.SOP; + CSOP := OldGeneral.CSOP; + MSOP := OldGeneral.MSOP; + FSOP := OldGeneral.FSOP; + SPW := OldGeneral.SPW; + AddChoice := OldGeneral.AddChoice; + NormPubPost := OldGeneral.NormPubPost; + NormPrivPost := OldGeneral.NormPrivPost; + AnonPubRead := OldGeneral.AnonPubPost; + AnonPrivRead := OldGeneral.AnonPrivRead; + AnonPubPost := OldGeneral.AnonPubPost; + AnonPrivPost := OldGeneral.AnonPrivPost; + SeeUnval := OldGeneral.SeeUnVal; + DLUnval := OldGeneral.DLUnval; + NoDLRatio := OldGeneral.NODLRatio; + NoPostRatio := OldGeneral.NoPostRatio; + NoFileCredits := OldGeneral.NoFileCredits; + ULValReq := OldGeneral.ULValReq; + TeleConfMCI := OldGeneral.TeleConfMCI; + OverrideChat := OldGeneral.OverrideChat; + NetMailACS := OldGeneral.NetMailACS; + Invisible := OldGeneral.Invisible; + FileAttachACS := OldGeneral.FileAttachACS; + ChangeVote := OldGeneral.ChangeVote; + + MaxPrivPost := OldGeneral.MaxPrivPost; + MaxFBack := OldGeneral.MaxFBack; + MaxPubPost := OldGeneral.MaxPubPost; + MaxChat := OldGeneral.MaxChat; + MaxWaiting := OldGeneral.MaxWaiting; + CSMaxWaiting := OldGeneral.CSMaxWaiting; + MaxMassMailList := OldGeneral.MaxMassMailList; + MaxLogonTries := OldGeneral.MaxLogonTries; + SysOpColor := OldGeneral.SysOpColor; + UserColor := OldGeneral.UserColor; + SliceTimer := OldGeneral.SliceTimer; + MaxBatchDLFiles := OldGeneral.MaxBatchDLFiles; + MaxBatchULFiles := OldGeneral.MaxBatchULFiles; + Text_Color := OldGeneral.Text_Color; + Quote_Color := OldGeneral.Quote_Color; + Tear_Color := OldGeneral.Tear_Color; + Origin_Color := OldGeneral.Origin_Color; + BackSysOpLogs := OldGeneral.BackSysOpLogs; + EventWarningTime := OldGeneral.EventWarningTime; + WFCBlankTime := OldGeneral.WFCBlankTime; + AlertBeep := OldGeneral.AlertBeep; + FileCreditComp := OldGeneral.FileCreditComp; + FileCreditCompBaseSize := OldGeneral.FileCreditCompBaseSize; + ULRefund := OldGeneral.ULRefund; + GlobalMenu := OldGeneral.GlobalMenu; + AllStartMenu := OldGeneral.AllStartMenu; + ShuttleLogonMenu := OldGeneral.ShuttleLogonMenu; + NewUserInformationMenu := OldGeneral.NewUserInformationMenu; + FileListingMenu := OldGeneral.FileListingMenu; + MessageReadMenu := OldGeneral.MessageReadMenu; + CurWindow := OldGeneral.CurWindow; + SwapTo := OldGeneral.SwapTo; + + LowTime := OldGeneral.LowTime; + HiTime := OldGeneral.HiTime; + DLLowTime := OldGeneral.DLLowTime; + DLHiTime := OldGeneral.DLHiTime; + MinBaudLowTime := OldGeneral.MinBaudLowTime; + MinBaudHiTime := OldGeneral.MinBaudHiTime; + MinBaudDLLowTime := OldGeneral.MinBaudDLLowTime; + MinBaudDLHiTime := OldGeneral.MinBaudDLHiTime; + MinSpaceForPost := OldGeneral.MinSpaceForPost; + MinSpaceForUpload := OldGeneral.MinSpaceForUpload; + NewApp := OldGeneral.NewApp; + TimeOutBell := OldGeneral.TimeOutBell; + TimeOut := OldGeneral.TimeOut; + ToSysOpDir := OldGeneral.ToSysOpDir; + CreditMinute := OldGeneral.CreditMinute; + CreditPost := OldGeneral.CreditPost; + CreditEmail := OldGeneral.CreditEmail; + CreditFreeTime := OldGeneral.CreditFreeTime; + NumUsers := OldGeneral.NumUsers; + PasswordChange := OldGeneral.PasswordChange; + RewardRatio := OldGeneral.RewardRatio; + CreditInternetMail := OldGeneral.CreditInternetMail; + BirthDateCheck := OldGeneral.BirthDateCheck; + + MaxQWKTotal := OldGeneral.MaxQWKTotal; + MaxQWKBase := OldGeneral.MaxQWKBase; + DaysOnline := OldGeneral.DaysOnline; + + MinimumBaud := OldGeneral.MinimumBaud; + MinimumDLBaud := OldGeneral.MinimumDLBaud; + MaxDepositEver := 300; + MaxDepositPerDay := 30; + MaxWithdrawalPerDay := 30; + CallerNum := OldGeneral.CallerNum; + RegNumber := OldGeneral.RegNumber; + TotalCalls := OldGeneral.TotalCalls; + TotalUsage := OldGeneral.TotalUsage; + TotalPosts := OldGeneral.TotalPosts; + TotalDloads := OldGeneral.TotalDloads; + TotalUloads := OldGeneral.TotalUloads; + MinResume := OldGeneral.MinResume; + MaxInTemp := OldGeneral.MaxInTemp; + + AllowAlias := OldGeneral.AllowAlias; + PhonePW := OldGeneral.PhonePW; + LocalSec := OldGeneral.LocalSec; + GlobalTrap := OldGeneral.GlobalTrap; + AutoChatOpen := OldGeneral.AutoChatOpen; + AutoMInLogon := OldGeneral.AutoMInLogon; + BullInLogon := OldGeneral.BullInLogon; + YourInfoInLogon := OldGeneral.YourInfoInLogon; + OffHookLocalLogon := OldGeneral.OffHookLocalLogon; + ForceVoting := OldGeneral.ForceVoting; + CompressBases := OldGeneral.CompressBases; + SearchDup := OldGeneral.SearchDup; + ForceBatchDL := OldGeneral.ForceBatchDL; + LogonQuote := OldGeneral.LogonQuote; + UserAddQuote := OldGeneral.UserAddQuote; + StripCLog := OldGeneral.StripCLog; + SKludge := OldGeneral.SKludge; + SSeenby := OldGeneral.SSeenby; + SOrigin := OldGeneral.SOrigin; + AddTear := OldGeneral.AddTear; + ShuttleLog := OldGeneral.ShuttleLog; + ClosedSystem := OldGeneral.ClosedSystem; + SwapShell := OldGeneral.SwapShell; + UseEMS := OldGeneral.UseEMS; + UseBios := OldGeneral.UseBios; + UseIEMSI := OldGeneral.UseIEMSI; + ULDLRatio := OldGeneral.ULDLRatio; + FileCreditRatio := OldGeneral.FileCreditRatio; + ValidateAllFiles := OldGeneral.ValidateAllFiles; + FileDiz := OldGeneral.FileDiz; + SysOpPword := OldGeneral.SysOpPword; + TrapTeleConf := OldGeneral.TrapTeleConf; + IsTopWindow := OldGeneral.IsTopWindow; + ReCompress := OldGeneral.ReCompress; + RewardSystem := OldGeneral.RewardSystem; + TrapGroup := OldGeneral.TrapGroup; + QWKTimeIgnore := OldGeneral.QWKTimeIgnore; + NetworkMode := OldGeneral.NetworkMode; + WindowOn := OldGeneral.WindowOn; + ChatCall := OldGeneral.ChatCall; + DailyLimits := OldGeneral.DailyLimits; + MultiNode := OldGeneral.MultiNode; + PerCall := OldGeneral.PerCall; + TestUploads := OldGeneral.TestUploads; + + FOR Counter := 1 TO MaxArcs DO + WITH FileArcInfo[Counter] DO + BEGIN + Active := OldGeneral.FileArcInfo[Counter].Active; + Ext := OldGeneral.FileArcInfo[Counter].Ext; + ListLine := OldGeneral.FileArcInfo[Counter].ListLine; + ArcLine := OldGeneral.FileArcInfo[Counter].ArcLine; + UnArcLine := OldGeneral.FileArcInfo[Counter].UnArcLine; + TestLine := OldGeneral.FileArcInfo[Counter].TestLine; + CmtLine := OldGeneral.FileArcInfo[Counter].CmtLine; + SuccLevel := OldGeneral.FileArcInfo[Counter].SuccLevel; + END; + + FOR Counter := 1 TO 3 DO + FileArcComment[Counter] := OldGeneral.FileArcComment[Counter]; + + FOR Counter := 0 TO 20 DO + WITH AKA[Counter] DO + BEGIN + Zone := OldGeneral.AKA[Counter].Zone; + Net := OldGeneral.AKA[Counter].Net; + Node := OldGeneral.AKA[Counter].Node; + Point := OldGeneral.AKA[Counter].Point; + END; + + FOR Counter := 1 TO 20 DO + NewUserToggles[Counter] := OldGeneral.NewUserToggles[Counter];; + + FOR Counter := 0 TO 9 DO + Macro[Counter] := OldGeneral.Macro[Counter]; + + Netattribute := OldGeneral.Netattribute; + + FOR Counter := 0 TO 255 DO + TimeAllow[Counter] := OldGeneral.TimeAllow[Counter]; + + FOR Counter := 0 TO 255 DO + CallAllow[Counter] := OldGeneral.CallAllow[Counter]; + + FOR Counter := 0 TO 255 DO + DLRatio[Counter] := OldGeneral.DLRatio[Counter]; + + FOR Counter := 0 TO 255 DO + DLKRatio[Counter] := OldGeneral.DLKRatio[Counter]; + + FOR Counter := 0 TO 255 DO + PostRatio[Counter] := OldGeneral.PostRatio[Counter]; + + FOR Counter := 0 TO 255 DO + DLOneday[Counter] := OldGeneral.DLOneday[Counter]; + + FOR Counter := 0 TO 255 DO + DLKOneDay[Counter] := OldGeneral.DLKOneDay[Counter]; + + END; + Write(GeneralFile,General); + Close(OldGeneralFile); + Close(GeneralFile); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Erase(OldGeneralFile); + Assign(GeneralFile,'RENEGADE.NEW'); + ReName(GeneralFile,'RENEGADE.DAT'); + WriteLn('Done'); +END; + +VAR + OldGeneralFile: FILE OF OldGeneralRecordType; + OldGeneral: OldGeneralRecordType; + +BEGIN + ClrScr; + WriteLn('Renegade Update Utility (12.07/8 to 01.28/8)'); + WriteLn; + Writeln('This utility will upgrade your Renegade BBS from'); + WriteLn('Version 12.07/8 to Version 01.28/8.'); + WriteLn; + Writeln('This update will scan your USERS.DAT file to ensure'); + WriteLn('that your expiration information for each guest is'); + WriteLn('configured properly. Errors will be logged to the'); + WriteLn('files (EXPIRE.TXT or KEY.TXT). Errors will result in'); + Writeln('the termination of this update utility until corrected.'); + Writeln('The following rules apply:'); + Writeln; + Writeln(' - Both the expiration date and expire to key must'); + Writeln(' be null or contain valid data. You can not have'); + WriteLn(' one configured without the other.'); + WriteLn; + WriteLn(' - The expire to key must be a valid key configured'); + Writeln(' in the validation editor.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + Write('Reading "RENEGADE.DAT" file ... '); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Reset(OldGeneralFile); + Read(OldGeneralFile,OldGeneral); + Close(OldGeneralFile); + WriteLn('Done'); + WriteLn; + (* + IF (NOT ReadUsers(OldGeneral)) THEN + BEGIN + WriteLn; + WriteLn(^G^G^G'Please see the file EXPIRE.TXT/KEY.TXT for errors.'); + END + ELSE + BEGIN + *) + WriteLn; + CreateValidationRec(OldGeneral); + ConvertGeneralRec(OldGeneral); + WriteLn; + WriteLn(^G^G^G'Conversion complete!'); + WriteLn; + WriteLn('Please replace your old RENEGADE.EXE/RENEGADE.OVR files'); + WriteLn('with the new files provided with this update.'); + (* + END; + *) + END; +END. diff --git a/SOURCE/UNUSED/RGUPDT2.EXE b/SOURCE/UNUSED/RGUPDT2.EXE new file mode 100644 index 0000000..32ae95d Binary files /dev/null and b/SOURCE/UNUSED/RGUPDT2.EXE differ diff --git a/SOURCE/UNUSED/RGUPDT2.PAS b/SOURCE/UNUSED/RGUPDT2.PAS new file mode 100644 index 0000000..ade23b2 --- /dev/null +++ b/SOURCE/UNUSED/RGUPDT2.PAS @@ -0,0 +1,161 @@ +{$M 49152,0,65536} +PROGRAM RGUPDT1; + +USES + Crt, + Dos; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +TYPE + ConfRec = { CONFRENC.DAT : Conference data } +{$IFDEF WIN32} PACKED {$ENDIF} RECORD + Conference: ARRAY ['@'..'Z'] OF + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + ACS: ACString; { access requirement } + Name: STRING[40]; { name of conference } + END; + END; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +function exist(fn: astr): boolean; +var + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +FUNCTION Caps(s: STRING): STRING; +VAR + Counter: Integer; { must be Integer } +BEGIN + IF (s[1] IN ['a'..'z']) THEN + Dec(s[1],32); + FOR Counter := 2 TO Length(s) DO + IF (s[Counter - 1] IN ['a'..'z','A'..'Z']) THEN + IF (s[Counter] IN ['A'..'Z']) THEN + Inc(s[Counter],32) + ELSE + ELSE + IF (s[Counter] IN ['a'..'z']) THEN + Dec(s[Counter],32); + Caps := s; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := S; +END; + +PROCEDURE ConvertConferenceFile(General: GeneralRecordType); +VAR + ConferenceFile: FILE OF ConferenceRecordType; + Conference: ConferenceRecordType; + OldConferenceFile: FILE OF ConfRec; + OldConference: ConfRec; + C: Char; +BEGIN + Write('Converting "CONFRENC.DAT" file ... '); + Assign(OldConferenceFile,General.DataPath+'CONFRENC.DAT'); + Reset(OldConferenceFile); + Assign(ConferenceFile,General.DataPath+'CONFRENC.NEW'); + ReWrite(ConferenceFile); + Seek(OldConferenceFile,0); + Read(OldConferenceFile,OldConference); + FOR C := '@' TO 'Z' DO + BEGIN + WITH Conference DO + BEGIN + Key := C; + IF (C = '@') THEN + Name := 'General' + ELSE + Name := OldConference.Conference[C].Name; + ACS := OldConference.Conference[C].ACS; + END; + IF (OldConference.Conference[C].Name <> '') THEN + Write(ConferenceFile,Conference); + END; + Close(OldConferenceFile); + Close(ConferenceFile); + Assign(OldConferenceFile,General.DataPath+'CONFRENC.DAT'); + Erase(OldConferenceFile); + Assign(ConferenceFile,General.DataPath+'CONFRENC.NEW'); + ReName(ConferenceFile,General.DataPath+'CONFRENC.DAT'); + WriteLn('Done'); +END; + +VAR + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + +BEGIN + ClrScr; + WriteLn('Renegade Update Utility (08.04/8 to 08.12/8)'); + WriteLn; + Writeln('This utility will upgrade your Renegade BBS from'); + WriteLn('Version 08.04/8 to Version 08.12/8.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + Write('Reading "RENEGADE.DAT" file ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done'); + WriteLn; + ConvertConferenceFile(General); + WriteLn; + WriteLn(^G^G^G'Conversion complete!'); + WriteLn; + WriteLn('Please replace your old RENEGADE.EXE/RENEGADE.OVR files'); + WriteLn('with the new files provided with this update.'); + END; +END. diff --git a/SOURCE/UNUSED/RGUPDT3.EXE b/SOURCE/UNUSED/RGUPDT3.EXE new file mode 100644 index 0000000..3e19099 Binary files /dev/null and b/SOURCE/UNUSED/RGUPDT3.EXE differ diff --git a/SOURCE/UNUSED/RGUPDT3.PAS b/SOURCE/UNUSED/RGUPDT3.PAS new file mode 100644 index 0000000..598609a --- /dev/null +++ b/SOURCE/UNUSED/RGUPDT3.PAS @@ -0,0 +1,222 @@ +{$M 49152,0,65536} +PROGRAM RGUPDT3; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +TYPE + OldFileInfoFlagType = + (OldFINotVal, { If file is not validated } + OldFIIsRequest, { If file is REQUEST } + OldFIResumeLater, { If file is RESUME-LATER } + OldFIHatched); { Has file been hatched? } + + OldFIFlagSet = SET OF OldFileInfoFlagType; + + OldFileInfoRecordType = { *.DIR : File records } + {$IFDEF WIN32} PACKED {$ENDIF} RECORD + FileName: STRING[12]; { Filename } + Description: STRING[50]; { File description } + FilePoints: Integer; { File points } + Downloaded: LongInt; { Number DLs } + SizeMod: Byte; { # chars over last 128 Byte block } + Blocks: LongInt; { # 128 Byte blks } + OwnerNum: Integer; { ULer OF file } + OwnerName: STRING[36]; { ULer's name } + Date: UnixTime; { Date ULed } + DateN: Word; { Numeric date ULed - 01/01/85 - 07/26/3061 = 0-65535 } + VPointer: LongInt; { Pointer to verbose descr, -1 if none } + VTextSize: Integer; { Verbose descr textsize - 50 Bytes x 99 Lines = 4950 max } + OldFIFlags: OldFIFlagSet; { File status } + END; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +function exist(fn: astr): boolean; +var + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +FUNCTION Caps(s: STRING): STRING; +VAR + Counter: Integer; { must be Integer } +BEGIN + IF (s[1] IN ['a'..'z']) THEN + Dec(s[1],32); + FOR Counter := 2 TO Length(s) DO + IF (s[Counter - 1] IN ['a'..'z','A'..'Z']) THEN + IF (s[Counter] IN ['A'..'Z']) THEN + Inc(s[Counter],32) + ELSE + ELSE + IF (s[Counter] IN ['a'..'z']) THEN + Dec(s[Counter],32); + Caps := s; +END; + +FUNCTION IntToStr(L: LongInt): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L,S); + IntToStr := S; +END; + +PROCEDURE ReadDirFile(DirPath,FName: AStr); +VAR + OldDirFile: FILE OF OldFileInfoRecordType; + DirFile: FILE OF FileInfoRecordType; + OldDir: OldFileInfoRecordType; + Dir: FileInfoRecordType; + RecNum: Integer; +BEGIN + IF (Exist(DirPath+FName+'.DIR')) THEN + BEGIN + Assign(OldDirFile,DirPath+FName+'.DIR'); + Reset(OldDirFile); + Assign(DirFile,DirPath+FName+'.NEW'); + ReWrite(DirFile); + RecNum := 0; + WHILE (RecNum <= (FileSize(OldDirFile) - 1)) DO + BEGIN + Seek(OldDirFile,RecNum); + Read(OldDirFile,OldDir); + WITH DIR DO + BEGIN + FileName := OldDir.FileName; + Description := OldDir.Description; + FilePoints := OldDir.FilePoints; + Downloaded := OldDir.Downloaded; + FileSize := ((OldDir.Blocks * 128) + OldDir.SizeMod); + OwnerNum := OldDir.OwnerNum; + OwnerName := OldDir.OwnerName; + FileDate := OldDir.Date; + VPointer := OldDir.VPointer; + VTextSize := OldDir.VTextSize; + FIFlags := []; + IF (OldFINotVal IN OldDir.OldFIFlags) THEN + Include(FIFlags,FINotVal); + IF (OldFIIsRequest IN OldDir.OldFIFlags) THEN + Include(FIFlags,FIIsRequest); + IF (OldFIResumeLater IN OldDir.OldFIFlags) THEN + Include(FIFlags,FIResumeLater); + IF (OldFIHatched IN OldDir.OldFIFlags) THEN + Include(FIFlags,FIHatched); + END; + Write(DirFile,Dir); + Inc(RecNum); + END; + Close(OldDirFile); + Close(DirFile); + Assign(OlDDirFile,DirPath+FName+'.DIR'); + Erase(OlDDirFile); + Assign(DirFile,DirPath+FName+'.NEW'); + ReName(DirFile,DirPath+FName+'.DIR'); + END; +END; + +PROCEDURE ConvertFileInfoRec(General: GeneralRecordType); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + FileArea: FileAreaRecordType; + DirPath: STRING; + Counter: Integer; +BEGIN + Write('Converting "*.DIR" files ... '); + Assign(FileAreaFile,General.DataPath+'FBASES.DAT'); + Reset(FileAreaFile); + Counter := 0; + WHILE (Counter <= (FileSize(FileAreaFile) - 1)) DO + BEGIN + Seek(FileAreaFile,Counter); + Read(FileAreaFile,FileArea); + WITH FileArea DO + BEGIN + IF (FADirDLPath IN FileArea.FAFlags) THEN + DIRPath := FileArea.DLPath + ELSE + DIRPath := General.DataPath; + ReadDirFile(DirPath,FileArea.FileName); + END; + Inc(Counter); + END; + Close(FileAreaFile); + WriteLn('Done'); +END; + +VAR + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + +BEGIN + ClrScr; + WriteLn('Renegade Update Utility (??.??/? to 10.01/8)'); + WriteLn; + Writeln('This utility will upgrade your Renegade BBS from'); + WriteLn('Version ??.??/? to Version 10.01/8.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + Write('Reading "RENEGADE.DAT" file ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done'); + WriteLn; + ConvertFileInfoRec(General); + WriteLn; + WriteLn('Conversion complete!'); + WriteLn; + WriteLn('Please replace your old RENEGADE.EXE/RENEGADE.OVR files'); + WriteLn('with the new files provided with this update.'); + END; +END. diff --git a/SOURCE/UNUSED/RGUPDT4.PAS b/SOURCE/UNUSED/RGUPDT4.PAS new file mode 100644 index 0000000..3f7f077 --- /dev/null +++ b/SOURCE/UNUSED/RGUPDT4.PAS @@ -0,0 +1,126 @@ +{$M 49152,0,65536} +PROGRAM RGUPDATE; + +USES + Crt, + Dos, + TimeFunc; + +{$I records.pas} + +TYPE + oldnoderec= { MULTNODE.DAT } + {$IFDEF WIN32} packed {$ENDIF} record + User:word; { 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 } + activity:byte; { What are they doing? } + Description:string[50]; { Optional string } + Status:NodeFlagSet; + Room:byte; { What room are they in? } + Channel:word; { What channel are they in? } + Invited:array[0..31] of set of 0..7; { Have they been invited ? } + Booted:array[0..31] of set of 0..7; { Have they been kicked off ? } + Forget:array[0..31] of set of 0..7; { Who are they forgetting? } + end; + +function IntToStr(i: longint): string; +var + s: string; +begin + s := ''; + str(I,S); + IntToStr := s; +end; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +function exist(fn: astr): boolean; +var + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +PROCEDURE CvtNodeFile(General: GeneralRecordType); +VAR + OldNodeFile: FILE OF OldNodeRec; + NodeFile: FILE OF NodeRecordType; + OldNode: OldNodeRec; + Node: NodeRecordType; + Counter: Byte; +BEGIN + FOR Counter := 1 To 255 Do + IF Exist(General.DataPath+'NODE'+Inttostr(Counter)+'.DAT') THEN + BEGIN + Write('Converting "NODE'+inttostr(Counter)+'.DAT" file ... '); + Assign(Oldnodefile,General.DataPath+'NODE'+inttostr(Counter)+'.DAT'); + Reset(Oldnodefile); + Read(Oldnodefile,Oldnode); + Assign(nodefile,General.DataPath+'NODE'+inttostr(Counter)+'.NEW'); + ReWrite(nodefile); + WITH Node DO + BEGIN + User := Oldnode.User; + UserName := Oldnode.UserName; + CityState := Oldnode.CityState; + Sex := Oldnode.Sex; + Age := Oldnode.Age; + LogonTime := Oldnode.LogonTime; + + (* Start - Delete *) + {activity := Oldnode.Activity} + (* End - Delete *) + + (* Start - Add *) + IF (OldNode.Activity = 2) THEN + GroupChat := TRUE + ELSE + GroupChat := FALSE; + (* End - Add *) + + (* Start - Change *) + ActivityDesc := Oldnode.Description; + (* End - Change *) + + Status := Oldnode.Status; + Room := Oldnode.Room; + Channel := Oldnode.Channel; + FillChar(Node.Invited,SizeOf(Node.Invited),0); + FillChar(Node.Booted,SizeOf(Node.Booted),0); + FillChar(Node.Forget,SizeOf(Node.Forget),0); + END; + Write(NodeFile,Node); + Close(OldNodeFile); + Close(NodeFile); + Assign(OldNodeFile,General.DataPath+'NODE'+inttostr(Counter)+'.DAT'); + Erase(OldNodeFile); + Assign(NodeFile,General.DataPath+'NODE'+inttostr(Counter)+'.NEW'); + ReName(Nodefile,General.DataPath+'NODE'+inttostr(Counter)+'.DAT'); + WriteLn('Done'); + END; +END; + +VAR + GR: FILE OF GeneralRecordType; + General: GeneralRecordType; + +BEGIN + Write('Reading "RENEGADE.DAT" file ... '); + Assign(GR,'RENEGADE.DAT'); + Reset(GR); + Read(GR,General); + Close(GR); + WriteLn('Done'); + + CvtNodeFile(General); + +END. \ No newline at end of file diff --git a/SOURCE/UNUSED/RGV118.EXE b/SOURCE/UNUSED/RGV118.EXE new file mode 100644 index 0000000..1790b46 Binary files /dev/null and b/SOURCE/UNUSED/RGV118.EXE differ diff --git a/SOURCE/UNUSED/RGV118.PAS b/SOURCE/UNUSED/RGV118.PAS new file mode 100644 index 0000000..3945730 --- /dev/null +++ b/SOURCE/UNUSED/RGV118.PAS @@ -0,0 +1,843 @@ +{$M 49152,0,65536} +PROGRAM RGUPDATE; + +USES + Crt, + Dos, + TimeFunc; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +TYPE + + OldGeneralRecordType = +{$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: ACString; { ACS to change their vote } + + 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: Byte; { Swap where? } + + 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 } + MinSpaceForPost, { minimum drive space left to post } + MinSpaceForUpload, { minimum drive space left to upload } + 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: Integer; { check user's birthdate every xx logons } + + MaxQWKTotal, { max msgs in a packet, period } + MaxQWKBase, { max msgs in a area } + DaysOnline: Word; { days online } + + 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: LongInt; { max K allowed in TEMP } + + 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, + 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: Boolean; { perform integrity tests on uploads? } + + 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: Word; + 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; + + OldStatusFlagType = + (OldLockedOut, { if locked out } + OldDeleted, { if deleted } + OldTrapActivity, { if trapping users activity } + OldTrapSeparate, { if trap to seperate TRAP file } + OldChatAuto, { if auto chat trapping } + OldChatSeparate, { if separate chat file to trap to } + OldSLogSeparate, { if separate SysOp log } + OldCLSMsg, { if clear-screens } + OldRIP, { if RIP graphics can be used } + OldFSEditor, { if Full Screen Editor } + OldAutoDetect { Use auto-detected emulation } + ); + + OldStatusFlagSet = SET OF OldStatusFlagType; + + OldUserRecordType = { 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: Char; { last conference in } + + 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: Byte; { menu to start at } + + BirthDate, { Birth date } + FirstOn, { First On Date } + LastOn, { Last On Date } + TTimeOn, { total time on } + LastQWK, { last qwk packet } + Expiration: UnixTime; { Expiration date } + + UserID, { Permanent userid } + TLToday, { # min left today } + ForUsr, { forward mail to } + LastMsgArea, { # last msg area } + LastFileArea: Integer; { # last file area } + + PasswordChanged: Word; { Numeric date pw changed - was UnixTime } + + Credit, { 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 } + TimeBankWith: LongInt; { Time withdrawn } + + TeleConfEcho, { Teleconf echo? } + TeleConfInt, { Teleconf interrupt } + GetOwnQWK, { Get own messages } + ScanFilesQWK, { new files in qwk } + PrivateQWK: Boolean; { private mail qwk } + + AR: ARFlagSet; { AR flags } + Flags: FlagSet; { flags } + OldSFlags: OldStatusFlagSet; { status flags } + END; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +function exist(fn: astr): boolean; +var + srec: searchrec; +begin + findfirst(sqoutsp(fn),anyfile,srec); + exist := (doserror = 0); +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +PROCEDURE ChangeLength(S: STRING; VAR S1,S2: STRING); +VAR + TempStr: STRING; + Counter: Byte; +BEGIN + IF (Length(S) <= 60) THEN + BEGIN + S1 := S; + S2 := ''; + END + ELSE + BEGIN + TempStr := Copy(S,1,65); + IF (TempStr[65] <> ' ') THEN + BEGIN + Counter := 65; + WHILE (TempStr[Counter] <> ' ') DO + BEGIN + Dec(TempStr[0]); + Dec(Counter); + END; + Dec(TempStr[0]); + S1 := TempStr; + S2 := Copy(S,(Counter + 1),Length(S)); + END + ELSE + BEGIN + S1 := Copy(S,1,64); + S2 := Copy(S,66,Length(S)); + END; + END; +END; + +PROCEDURE Kill(CONST FileName: AStr); +VAR + F: FILE; +BEGIN + Assign(F,FileName); + Erase(F); +END; + +PROCEDURE ConvertGeneralRec; +VAR + OldGeneralFile: FILE OF OldGeneralRecordType; + GeneralFile: FILE OF GeneralRecordType; + OldGeneral: OldGeneralRecordType; + General: GeneralRecordType; + Counter: Integer; +BEGIN + Write('Converting "RENEGADE.DAT" file ... '); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Reset(OldGeneralFile); + Assign(GeneralFile,'RENEGADE.NEW'); + ReWrite(GeneralFile); + Seek(OldGeneralFile,0); + Read(OldGeneralFile,OldGeneral); + WITH General DO + BEGIN + ForgotPWQuestion := OldGeneral.ForgotPWQuestion; + + QWKWelcome := OldGeneral.QWKWelcome; + QWKNews := OldGeneral.QWKNews; + QWKGoodbye := OldGeneral.QWKGoodBye; + Origin := OldGeneral.Origin; + + DataPath := OldGeneral.DataPath; + MiscPath := OldGeneral.MiscPath; + LogsPath := OldGeneral.LogsPath; + MsgPath := OldGeneral.MsgPath; + NodePath := OldGeneral.NodePath; + TempPath := OldGeneral.TempPath; + ProtPath := OldGeneral.ProtPath; + ArcsPath := OldGeneral.ArcsPath; + lMultPath := OldGeneral.LMultPath; + FileAttachPath := OldGeneral.FileAttachPath; + QWKLocalPath := OldGeneral.QWKLocalPath; + DefEchoPath := OldGeneral.DefEchoPath; + NetmailPath := OldGeneral.NetMailPath; + BBSName := OldGeneral.BBSName; + + SysOpName := OldGeneral.SysOpName; + + Version := '1.18a'; (* <-- Update this with version *) + + BBSPhone := OldGeneral.BBSPhone; + + LastDate := OldGeneral.LastDate; + + PacketName := OldGeneral.PacketName; + BulletPrefix := OldGeneral.BulletPrefix; + + SysOpPW := OldGeneral.SysOpPW; + NewUserPW := OldGeneral.NewUserPW; + MinBaudOverride := OldGeneral.MinBaudOverride; + QWKNetworkACS := OldGeneral.QWKNetworkACS; + LastOnDatACS := OldGeneral.LastOnDatACS; + SOP := OldGeneral.SOP; + CSOP := OldGeneral.CSOP; + MSOP := OldGeneral.MSOP; + FSOP := OldGeneral.FSOP; + SPW := OldGeneral.SPW; + AddChoice := OldGeneral.AddChoice; + NormPubPost := OldGeneral.NormPubPost; + NormPrivPost := OldGeneral.NormPrivPost; + AnonPubRead := OldGeneral.AnonPubRead; + AnonPrivRead := OldGeneral.AnonPrivRead; + AnonPubPost := OldGeneral.AnonPubPost; + AnonPrivPost := OldGeneral.AnonPrivPost; + SeeUnval := OldGeneral.SeeUnval; + DLUnval := OldGeneral.DLUnval; + NoDLRatio := OldGeneral.NoDLRatio; + NoPostRatio := OldGeneral.NoPostRatio; + NoFileCredits := OldGeneral.NoFileCredits; + ULValReq := OldGeneral.ULValReq; + TeleConfMCI := OldGeneral.TeleConfMCI; + OverrideChat := OldGeneral.OverrideChat; + NetMailACS := OldGeneral.NetMailACS; + Invisible := OldGeneral.Invisible; + FileAttachACS := OldGeneral.FileAttachACS; + ChangeVote := OldGeneral.ChangeVote; + UnUsedACS1 := ''; + UnUsedACS2 := ''; + + MaxPrivPost := OldGeneral.MaxPrivPost; + MaxFBack := OldGeneral.MaxFBack; + MaxPubPost := OldGeneral.MaxPubPost; + MaxChat := OldGeneral.MaxChat; + MaxWaiting := OldGeneral.MaxWaiting; + CSMaxWaiting := OldGeneral.CSMaxWaiting; + MaxMassMailList := OldGeneral.MaxMassMailList; + MaxLogonTries := OldGeneral.MaxLogonTries; + SysOpColor := OldGeneral.SysOpColor; + UserColor := OldGeneral.UserColor; + SliceTimer := OldGeneral.SliceTimer; + MaxBatchDLFiles := OldGeneral.MaxBatchDLFiles; + MaxBatchULFiles := OldGeneral.MaxBatchULFiles; + Text_Color := OldGeneral.Text_Color; + Quote_Color := OldGeneral.Quote_Color; + Tear_Color := OldGeneral.Tear_Color; + Origin_Color := OldGeneral.Origin_Color; + BackSysOpLogs := OldGeneral.BackSysOpLogs; + EventWarningTime := OldGeneral.EventWarningTime; + WFCBlankTime := OldGeneral.WFCBlankTime; + AlertBeep := OldGeneral.AlertBeep; + FileCreditComp := OldGeneral.FileCreditComp; + FileCreditCompBaseSize := OldGeneral.FileCreditCompBaseSize; + ULRefund := OldGeneral.ULRefund; + GlobalMenu := OldGeneral.GlobalMenu; + AllStartMenu := OldGeneral.AllStartMenu; + ShuttleLogonMenu := OldGeneral.ShuttleLogonMenu; + NewUserInformationMenu := OldGeneral.NewUserInformationMenu; + FileListingMenu := OldGeneral.FileListingMenu; + MessageReadMenu := OldGeneral.MessageReadMenu; + CurWindow := OldGeneral.CurWindow; + SwapTo := OldGeneral.SwapTo; + UnUsedByte1 := 0; + UnUsedByte2 := 0; + + lLowTime := OldGeneral.lLowTime; + HiTime := OldGeneral.HiTime; + DLLowTime := OldGeneral.DLLowTime; + DLHiTime := OldGeneral.DLHiTime; + MinBaudLowTime := OldGeneral.MinBaudLowTime; + MinBaudHiTime := OldGeneral.MinBaudHiTime; + MinBaudDLLowTime := OldGeneral.MinBaudDLLowTime; + MinBaudDLHiTime := OldGeneral.MinBaudDLHiTime; + NewApp := OldGeneral.NewApp; + TimeOutBell := OldGeneral.TimeOutBell; + TimeOut := OldGeneral.TimeOut; + ToSysOpDir := OldGeneral.ToSysOpDir; + CreditMinute := OldGeneral.CreditMinute; + CreditPost := OldGeneral.CreditPost; + CreditEmail := OldGeneral.CreditEmail; + CreditFreeTime := OldGeneral.CreditFreeTime; + NumUsers := OldGeneral.NumUsers; + PasswordChange := OldGeneral.PasswordChange; + RewardRatio := OldGeneral.RewardRatio; + CreditInternetMail := OldGeneral.CreditInternetMail; + BirthDateCheck := OldGeneral.BirthDateCheck; + UnUsedInteger1 := 0; + UnUsedInteger2 := 0; + + MaxQWKTotal := OldGeneral.MaxQWKTotal; + MaxQWKBase := OldGeneral.MaxQWKBase; + DaysOnline := OldGeneral.DaysOnline; + UnUsedWord1 := 0; + UnUsedWord2 := 0; + + MinimumBaud := OldGeneral.MinimumBaud; + MinimumDLBaud := OldGeneral.MinimumDLBaud; + MaxDepositEver := OldGeneral.MaxDepositEver; + MaxDepositPerDay := OldGeneral.MaxDepositPerDay; + MaxWithdrawalPerDay := OldGeneral.MaxWithdrawalPerDay; + CallerNum := OldGeneral.CallerNum; + RegNumber := OldGeneral.RegNumber; + TotalCalls := OldGeneral.TotalCalls; + TotalUsage := OldGeneral.TotalUsage; + TotalPosts := OldGeneral.TotalPosts; + TotalDloads := OldGeneral.TotalDloads; + TotalUloads := OldGeneral.TotalUloads; + MinResume := OldGeneral.MinResume; + MaxInTemp := OldGeneral.MaxInTemp; + MinSpaceForPost := OldGeneral.MinSpaceForPost; + MinSpaceForUpload := OldGeneral.MinSpaceForUpload; + UnUsedLongInt1 := 0; + UnUsedLongInt2 := 0; + + AllowAlias := OldGeneral.AllowAlias; + PhonePW := OldGeneral.PhonePW; + LocalSec := OldGeneral.LocalSec; + GlobalTrap := OldGeneral.GlobalTrap; + AutoChatOpen := OldGeneral.AutoChatOpen; + AutoMInLogon := OldGeneral.AutoMInLogon; + BullInLogon := OldGeneral.BullInLogon; + YourInfoInLogon := OldGeneral.YourInfoInLogon; + OffHookLocalLogon := OldGeneral.OffHookLocalLogon; + ForceVoting := OldGeneral.ForceVoting; + CompressBases := OldGeneral.CompressBases; + SearchDup := OldGeneral.SearchDup; + ForceBatchDL := OldGeneral.ForceBatchDL; + ForceBatchUL := FALSE; + LogonQuote := OldGeneral.LogonQuote; + UserAddQuote := OldGeneral.UserAddQuote; + StripCLog := OldGeneral.StripCLog; + SKludge := OldGeneral.SKludge; + SSeenby := OldGeneral.SSeenby; + SOrigin := OldGeneral.SOrigin; + AddTear := OldGeneral.AddTear; + ShuttleLog := OldGeneral.ShuttleLog; + ClosedSystem := OldGeneral.ClosedSystem; + SwapShell := OldGeneral.SwapShell; + UseEMS := OldGeneral.UseEMS; + UseBios := OldGeneral.UseBios; + UseIEMSI := OldGeneral.UseIEMSI; + ULDLRatio := OldGeneral.ULDLRatio; + FileCreditRatio := OldGeneral.FileCreditRatio; + ValidateAllFiles := OldGeneral.ValidateAllFiles; + FileDiz := OldGeneral.FileDiz; + SysOpPword := OldGeneral.SysOpPword; + TrapTeleConf := OldGeneral.TrapTeleConf; + IsTopWindow := OldGeneral.IsTopWindow; + ReCompress := OldGeneral.ReCompress; + RewardSystem := OldGeneral.RewardSystem; + TrapGroup := OldGeneral.TrapGroup; + QWKTimeIgnore := OldGeneral.QWKTimeIgnore; + NetworkMode := OldGeneral.NetworkMode; + WindowOn := OldGeneral.WindowOn; + ChatCall := OldGeneral.ChatCall; + DailyLimits := OldGeneral.DailyLimits; + MultiNode := OldGeneral.MultiNode; + PerCall := OldGeneral.PerCall; + TestUploads := OldGeneral.TestUploads; + UseFileAreaLightBar := TRUE; + UseMsgAreaLightBar := TRUE; + UnUsedBoolean1 := FALSE; + UnUsedBoolean2 := FALSE; + + FOR Counter := 1 TO MaxArcs DO + FileArcInfo[Counter] := OldGeneral.FileArcInfo[Counter]; + + FOR Counter := 1 TO 3 DO + FileArcComment[Counter] := OldGeneral.FileArcComment[Counter]; + + FOR Counter := 0 TO 20 DO + WITH AKA[Counter] DO + BEGIN + Zone := OldGeneral.AKA[Counter].Zone; + Net := OldGeneral.AKA[Counter].Net; + Node := OldGeneral.AKA[Counter].Node; + Point := OldGeneral.AKA[Counter].Point; + END; + + FOR Counter := 1 TO 20 DO + NewUserToggles[Counter] := OldGeneral.NewUserToggles[Counter]; + + FOR Counter := 0 TO 9 DO + Macro[Counter] := OldGeneral.Macro[Counter]; + + Netattribute := OldGeneral.NetAttribute; + + TimeAllow := OldGeneral.TimeAllow; + CallAllow := OldGeneral.CallAllow; + DLRatio := OldGeneral.DLRatio; + DLKRatio := OldGeneral.DLKRatio; + PostRatio := OldGeneral.PostRatio; + DLOneday := OldGeneral.DLOneDay; + DLKOneDay := OldGeneral.DLKOneDay; + END; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(OldGeneralFile); + Close(GeneralFile); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Erase(OldGeneralFile); + Assign(GeneralFile,'RENEGADE.NEW'); + ReName(GeneralFile,'RENEGADE.DAT'); + WriteLn('Done'); +END; + +PROCEDURE ConvertUserRec(OldGeneral: OldGeneralRecordType); +VAR + OldUserFile: FILE OF OldUserRecordType; + UserFile: FILE OF UserRecordType; + OldUser: OldUserRecordType; + User: UserRecordType; + Counter, + Counter1: Integer; +BEGIN + Write('Converting "USERS.DAT" file ... '); + Assign(OldUserFile,OldGeneral.DataPath+'USERS.DAT'); + Reset(OldUserFile); + Assign(UserFile,OldGeneral.DataPath+'USERS.NEW'); + ReWrite(UserFile); + Counter := 0; + WHILE (Counter <= (FileSize(OldUserFile) - 1)) DO + BEGIN + Seek(OldUserFile,Counter); + Read(OldUserFile,OldUser); + WITH User DO + BEGIN + Name := OldUser.Name; + RealName := OldUser.RealName; + Street := OldUser.Street; + CityState := OldUser.CityState; + CallerID := OldUser.CallerID; + ZipCode := OldUser.ZipCode; + PH := OldUser.PH; + ForgotPWAnswer := OldUser.ForgotPWAnswer; + FOR Counter1 := 1 TO 3 DO + UsrDefStr[Counter1] := OldUser.UsrDefStr[Counter1]; + Note := OldUser.Note; + LockedFile := OldUser.LockedFile; + FOR Counter1 := 1 TO 25 DO + Vote[Counter1] := OldUser.Vote[Counter1]; + Sex := OldUser.Sex; + Subscription := OldUser.SubScription; + ExpireTo := OldUser.ExpireTo; + LastConf := OldUser.LastConf; + UnUsedChar1 := ' '; + UnUsedChar2 := ' '; + + SL := OldUser.SL; + DSL := OldUser.DSL; + Waiting := OldUser.Waiting; + LineLen := OldUser.LineLen; + PageLen := OldUser.PageLen; + OnToday := OldUser.OnToday; + Illegal := OldUser.Illegal; + DefArcType := OldUser.DefArcType; + ColorScheme := OldUser.ColorScheme; + UserStartMenu := OldUser.UserStartMenu; + UnUsedByte1 := 0; + UnUsedByte2 := 0; + + BirthDate := OldUser.BirthDate; + FirstOn := OldUser.FirstOn; + LastOn := OldUser.LastOn; + TTimeOn := OldUser.TTimeOn; + LastQWK := OldUser.LastQWK; + Expiration := OldUser.Expiration; + UnUsedUnixTime1 := 0; + UnUsedUnixTime2 := 0; + + UserID := OldUser.UserID; + TLToday := OldUser.TLToday; + ForUsr := OldUser.ForUsr; + LastMsgArea := OldUser.LastMsgArea; + LastFileArea := OldUser.LastFileArea; + UnUsedInteger1 := 0; + UnUsedInteger2 := 0; + + PasswordChanged := OldUser.PasswordChanged; + UnUsedWord1 := 0; + UnUsedWord2 := 0; + + LCredit := OldUser.Credit; + Debit := OldUser.Debit; + PW := OldUser.PW; + Uploads := OldUser.Uploads; + Downloads := OldUser.Downloads; + UK := OldUser.UK; + DK := OldUser.DK; + LoggedOn := OldUser.LoggedOn; + MsgPost := OldUser.MsgPost; + EmailSent := OldUser.EmailSent; + FeedBack := OldUser.FeedBack; + TimeBank := OldUser.TimeBank; + TimeBankAdd := OldUser.TimeBankAdd; + DLKToday := OldUser.DLKToday; + DLToday := OldUser.DLToday; + FilePoints := 0; + TimeBankWith := OldUser.TimeBankWith; + UnUsedLongInt1 := 0; + UnUsedLongInt2 := 0; + + TeleConfEcho := OldUser.TeleConfEcho; + TeleConfInt := OldUser.TeleConfInt; + GetOwnQWK := OldUser.GetOwnQWK; + ScanFilesQWK := OldUser.ScanFilesQWK; + PrivateQWK := OldUser.PrivateQWK; + UnUsedBoolean1 := FALSE; + UnUsedBoolean2 := FALSE; + + AR := OldUser.AR; + + Flags := OldUser.Flags; + + SFlags := []; + IF (OldLockedOut IN OldUser.OldSFlags) THEN + Include(SFlags,LockedOut); + IF (OldDeleted IN OldUser.OldSFlags) THEN + Include(SFlags,Deleted); + IF (OldTrapActivity IN OldUser.OldSFlags) THEN + Include(SFlags,TrapActivity); + IF (OldTrapSeparate IN OldUser.OldSFlags) THEN + Include(SFlags,TrapSeparate); + IF (OldChatAuto IN OldUser.OldSFlags) THEN + Include(SFlags,ChatAuto); + IF (OldChatSeparate IN OldUser.OldSFlags) THEN + Include(SFlags,ChatSeparate); + IF (OldSLogSeparate IN OldUser.OldSFlags) THEN + Include(SFlags,SLogSeparate); + IF (OldCLSMsg IN OldUser.OldSFlags) THEN + Include(SFlags,CLSMsg); + IF (OldRIP IN OldUser.OldSFlags) THEN + Include(SFlags,RIP); + IF (OldFSEditor IN OldUser.OldSFlags) THEN + Include(SFlags,FSEditor); + IF (OldAutoDetect IN OldUser.OldSFlags) THEN + Include(SFlags,AutoDetect); + Include(SFlags,FileAreaLightBar); + Include(SFlags,MsgAreaLightBar); + END; + Write(UserFile,User); + Inc(Counter); + END; + Close(OldUserFile); + Close(UserFile); + Assign(OldUserFile,OldGeneral.DataPath+'USERS.DAT'); + Erase(OldUserFile); + Assign(UserFile,OldGeneral.DataPath+'USERS.NEW'); + ReName(UserFile,OldGeneral.DataPath+'USERS.DAT'); + WriteLn('Done'); +END; + +VAR + OldGeneralFile: FILE OF OldGeneralRecordType; + OldGeneral: OldGeneralRecordType; + +BEGIN + ClrScr; + WriteLn('Renegade Upgrade Utility (v1.10 to v1.18a)'); (* <-- Update this with version *) + WriteLn; + Writeln('This utility will upgrade your Renegade BBS from'); + WriteLn('Version 1.10 to Version 1.18a'); (* <-- Update this with version *) + WriteLn; + IF PYNQ('Do you want to continue? ') THEN + BEGIN + WriteLn; + Write('Reading "RENEGADE.DAT" file ... '); + Assign(OldGeneralFile,'RENEGADE.DAT'); + Reset(OldGeneralFile); + Seek(OldGeneralFile,0); + Read(OldGeneralFile,OldGeneral); + Close(OldGeneralFile); + WriteLn('Done'); + WriteLn; + IF (Exist(OldGeneral.DataPath+'BATCHDL.DAT')) THEN + BEGIN + Write('Deleting "BATCHDL.DAT" file ... '); + Kill(OldGeneral.DataPath+'BATCHDL.DAT'); + WriteLn('Done'); + END; + ConvertUserRec(OldGeneral); + ConvertGeneralRec; + END; +END. diff --git a/SOURCE/UNUSED/RGVER.EXE b/SOURCE/UNUSED/RGVER.EXE new file mode 100644 index 0000000..f424578 Binary files /dev/null and b/SOURCE/UNUSED/RGVER.EXE differ diff --git a/SOURCE/UNUSED/RGVER.PAS b/SOURCE/UNUSED/RGVER.PAS new file mode 100644 index 0000000..d29c2eb --- /dev/null +++ b/SOURCE/UNUSED/RGVER.PAS @@ -0,0 +1,95 @@ +PROGRAM RGVERUDT; + +USES + CRT, + Common1; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +VAR + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + VerStr: STRING; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +BEGIN + ClrScr; + WriteLn('Renegade Version Update Utility Version 1.0a'); + WriteLn; + Writeln('This utility will upgrade the Renegade Data Files.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + { WriteLn; + WriteLn('Example: 07-12.8/Alpha'); + WriteLn; + Write('Please enter the new version: '); + Local_Input1(VerStr,20,TRUE);} + VerStr := '1.19/Alpha'; + {IF (VerStr = '') THEN + WriteLn(^G^G^G'Aborted!') + ELSE + BEGIN + WriteLn; + WriteLn('You entered '+VerStr); + WriteLn; + IF PYNQ('Is this what you want? ') THEN} + BEGIN + WriteLn; + Write('Updating "RENEGADE.DAT" file ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Seek(GeneralFile,0); + Read(GeneralFile,General); + General.Version := VerStr; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done'); + WriteLn; + WriteLn(^G^G^G'Update complete!'); + END; + END; + +END. diff --git a/SOURCE/UNUSED/RGVERUDT.EXE b/SOURCE/UNUSED/RGVERUDT.EXE new file mode 100644 index 0000000..ef6adaf Binary files /dev/null and b/SOURCE/UNUSED/RGVERUDT.EXE differ diff --git a/SOURCE/UNUSED/RGVERUDT.PAS b/SOURCE/UNUSED/RGVERUDT.PAS new file mode 100644 index 0000000..7347293 --- /dev/null +++ b/SOURCE/UNUSED/RGVERUDT.PAS @@ -0,0 +1,94 @@ +PROGRAM RGVERUDT; + +USES + CRT, + Common1; + +{$I RECORDS.PAS} + +CONST + DYNY: BOOLEAN = FALSE; + +VAR + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + VerStr: STRING; + +function sqoutsp(s:string):string; +begin + while (pos(' ',s)>0) do delete(s,pos(' ',s),1); + sqoutsp:=s; +end; + +FUNCTION SYN(B: BOOLEAN): STRING; +BEGIN + IF (B) THEN + SYN := 'Yes' + ELSE + SYN := 'No '; +END; + +FUNCTION YN: BOOLEAN; +VAR + C: CHAR; +BEGIN + Write(SQOutSp(SYN(DYNY))); + REPEAT + C := UpCase(Char(ReadKey)); + UNTIL (C IN ['Y','N',^M]); + IF (DYNY) AND (C <> 'N') THEN + C := 'Y'; + IF (DYNY) AND (C = 'N') THEN + Write(#8#8#8'No ') + ELSE IF (NOT DYNY) AND (C = 'Y') THEN + Write(#8#8'Yes'); + WriteLn; + YN := (C = 'Y'); + DYNY := FALSE; +end; + +FUNCTION PYNQ(CONST S: AStr): BOOLEAN; +BEGIN + Write(S); + PYNQ := YN; +END; + +BEGIN + ClrScr; + WriteLn('Renegade Version Update Utility Version 1.0'); + WriteLn; + Writeln('This utility will upgrade the Renegade Version Number.'); + WriteLn; + IF PYNQ('Do you wish to continue? ') THEN + BEGIN + WriteLn; + WriteLn('Example: 07-12.8/Alpha'); + WriteLn; + Write('Please enter the new version: '); + Local_Input1(VerStr,20,TRUE); + IF (VerStr = '') THEN + WriteLn(^G^G^G'Aborted!') + ELSE + BEGIN + WriteLn; + WriteLn('You entered '+VerStr); + WriteLn; + IF PYNQ('Is this what you want? ') THEN + BEGIN + WriteLn; + Write('Updating "RENEGADE.DAT" file ... '); + Assign(GeneralFile,'RENEGADE.DAT'); + Reset(GeneralFile); + Seek(GeneralFile,0); + Read(GeneralFile,General); + General.Version := VerStr; + Seek(GeneralFile,0); + Write(GeneralFile,General); + Close(GeneralFile); + WriteLn('Done'); + WriteLn; + WriteLn('Update complete!'); + END; + END; + END; +END. diff --git a/SOURCE/UNUSED/RMAILWKS.PAS b/SOURCE/UNUSED/RMAILWKS.PAS new file mode 100644 index 0000000..b144159 --- /dev/null +++ b/SOURCE/UNUSED/RMAILWKS.PAS @@ -0,0 +1,953 @@ +PROGRAM Renemail; {eatus echomailius} + +{$A+,I-,E-,F+} + +(* {A+,B-,D-,E-,F+,G+,N-,R-,S-,V-,I-} *) + +uses crt, dos, timefunc; + +{$I RECORDS.PAS} + +type + fidorecord = 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; + +VAR + LastError :integer; + header : fidorecord; + dt : datetime; + MsgTFile : file; + hiwaterf : file of integer; + statusf : file of generalrecordtype; + statusr : generalrecordtype; + boardf : file of MessageAreaRecordType; + BoardR : MessageAreaRecordType; + MsgHdrF : file of mheaderrec; + MsgHdr : mheaderrec; + MsgTxtF : file; + uf : file of userrecordtype; + user : userrecordtype; + sf : file of useridxrec; + toi, fromi, subjecti, datetime : string; + i, j, lines, MsgNumber, highest, lowest, Board, TextSize, + msglength, msgpointer : integer; + c : char; + attribute : word; + ispm : boolean; + dirinfo : searchrec; + s, StartDir, nos, datapath, MsgPath, netmailpath : string [81]; + MsgTxt : string [255]; + buffer : array [1..32767] of char; + fcb : array [1..37] of char; +{$IFDEF MSDOS} + Regs : registers; +{$ENDIF} + x : byte; + +const + netmailonly : boolean = FALSE; + IsNetMail : boolean = FALSE; + fastpurge : boolean = TRUE; + process_netmail : boolean = TRUE; + purge_netmail : boolean = TRUE; + absolute_scan : boolean = FALSE; + ignore_1msg : boolean = TRUE; + +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 {Hex} ; + +FUNCTION Usename(b:byte; s:astr):string; +BEGIN + case b of + 1, + 2:s:='Anonymous'; + 3:s:='Abby'; + 4:s:='Problemed Person'; + END; + Usename:=s; +END; + +FUNCTION ExistDir(fn:string):boolean; +VAR dirinfo:searchrec; +BEGIN + WHILE (fn[Length(fn)] = '\') DO + Dec(fn[0]); + findfirst(fn,anyfile,dirinfo); + ExistDir:=(doserror=0) AND (dirinfo.attr AND $10=$10); +END; + +FUNCTION StrPas(Str: String): String; assembler; +asm + PUSH DS + CLD + LES DI,Str + MOV CX,0FFFFH + XOR AL,AL + REPNE SCASB + NOT CX + Dec CX + LDS SI,Str + LES DI,@Result + MOV AL,CL + STOSB + REP MOVSB + POP DS +END; + + +FUNCTION StripName(s:astr):astr; +VAR + n:integer; +BEGIN + n := Length(s); + WHILE (n > 0) AND (POS(s[n],':\/') = 0) DO + Dec(n); + Delete(s,1,n); + StripName := s; +END; + +FUNCTION AllCaps (const s : string) : string; +VAR + q : integer; +BEGIN + AllCaps [0] := s [0]; + FOR q := 1 TO Length (s) DO + AllCaps [q] := upcase (s [q]); +END; + +FUNCTION Caps (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]) + 32); + + FOR i := 1 TO Length (s) DO + IF (NOT (s [i] in ['A'..'Z', 'a'..'z', chr (39) ]) ) THEN + IF (s [i + 1] in ['a'..'z']) THEN + s [i + 1] := upcase (s [i + 1]); + s [1] := upcase (s [1]); + Caps := s; +END; + +FUNCTION searchuser(Uname:string): word; +VAR + Current:integer; + Done:boolean; + IndexR:useridxrec; +BEGIN + + Reset(sf); + IF (IOResult > 0) THEN Exit; + + Uname := AllCaps(UName); + + Current := 0; + Done := FALSE; + + IF (FileSize(sf) > 0) THEN BEGIN + REPEAT + Seek(sf, Current); + Read(sf, IndexR); + IF (Uname < IndexR.Name) THEN BEGIN Current := IndexR.Left END + ELSE BEGIN + IF (Uname > IndexR.Name) THEN Current := IndexR.Right + ELSE Done := TRUE; + END; + UNTIL (Current = -1) or (Done); + END; + + Close(sf); + + IF (Done) AND NOT (IndexR.Deleted) THEN SearchUser := IndexR.Number + ELSE SearchUser := 0; + + LastError := IOResult; +END; + +FUNCTION StripColor (o : string) : string; +VAR i,j : byte; + s : string; +BEGIN + i := 0; + s := ''; + WHILE (i < Length (o) ) DO BEGIN + Inc (i); + case o [i] of + #128..#255:IF (mafilter in BoardR.maflags) THEN + s := s + chr(ord(o[i]) AND 128) + ELSE + s := s + o[i]; + '^' : IF o [i + 1] in [#0..#9, '0'..'9'] THEN + Inc (i) ELSE s := s + '^'; + '|' : IF (mafilter in BoardR.maflags) AND (o[i + 1] in ['0'..'9']) THEN + BEGIN + j:=0; + WHILE (o [i + 1] in ['0'..'9']) AND (i <= Length (o) ) + AND (j<=2) DO BEGIN + Inc (i); + Inc (j) + END + END + ELSE + s := s + '|' + ELSE s := s + o [i]; + END; + END; + StripColor := s; +END; + +procedure aborterror(const s:string); +BEGIN + WriteLn(s); + halt(255); +END; + + FUNCTION Value (s : string) : longint; + VAR i : longint; + j : integer; + BEGIN + val (s, i, j); + IF (j <> 0) THEN BEGIN + s[0]:=chr(j-1); + val (s, i, j) + END; + Value := i; + IF (s = '') THEN Value := 0; + END; + + FUNCTION CStr (i : longint) : string; + VAR c : string [16]; + BEGIN + str (i, c); + CStr := c; + END; + + procedure getmsglst (const dir : string); + VAR hiwater : integer; + BEGIN + hiwater := 1; + IF NOT IsNetMail THEN BEGIN + Assign (hiwaterf, dir + 'HI_WATER.MRK'); + Reset (hiwaterf); + IF IOResult <> 0 THEN BEGIN + ReWrite (hiwaterf); + Write (hiwaterf, hiwater); + IF IOResult <> 0 THEN aborterror('error creating ' + dir + '\HI_WATER.MRK'); + END + ELSE BEGIN + Read (hiwaterf, hiwater); + i := IOResult; + findfirst (dir + CStr (hiwater) + '.MSG', 0, dirinfo); + IF doserror <> 0 THEN hiwater := 1; + END; + Close (hiwaterf); + END; + findfirst (dir + '*.MSG', 0, dirinfo); + highest := 1; + lowest := 32767; + WHILE doserror = 0 DO BEGIN + i := Value (dirinfo.name); + IF i < lowest THEN lowest := i; + IF i > highest THEN highest := i; + findnext (dirinfo); + END; + + IF hiwater <= highest THEN BEGIN + IF hiwater > 1 THEN lowest := hiwater + 1; + END; + + IF (ignore_1msg) THEN BEGIN + IF (lowest = 1) AND (highest > 1) THEN lowest := 2; + END; + LastError := IOResult; + END; + + procedure getpaths; + + procedure badpath(const s:string); + BEGIN + WriteLn('The ',s,' path is bad. Please correct it.'); + halt; + END; + + BEGIN + s := fsearch ('RENEGADE.DAT', getenv ('PATH') ); + Assign (statusf, s); + Reset (statusf); + IF (IOResult <> 0) or (s = '') THEN BEGIN + WriteLn ('RENEGADE.DAT must be in the current directory or the path.'); + halt (1); + END; + Read (statusf, statusr); + datapath := statusr.datapath; + IF NOT (ExistDir(datapath)) THEN badpath('DATA'); + netmailpath := statusr.netmailpath; + IF NOT (ExistDir(netmailpath)) THEN badpath('NETMAIL'); + MsgPath := statusr.MsgPath; + IF NOT (ExistDir(MsgPath)) THEN badpath('MSGS'); + Close (statusf); + IF IOResult <> 0 THEN + aborterror('error reading From RENEGADE.DAT'); + END; + + procedure updatehiwater (const dir:string; x:integer); + BEGIN + Assign (hiwaterf, dir + 'HI_WATER.MRK'); + ReWrite (hiwaterf); + Write (hiwaterf, x); + Close (hiwaterf); + i := IOResult; + END; + + procedure PurgeDir (const dir : string); + VAR purged : boolean; + BEGIN +{$IFDEF MSDOS} + IF fastpurge THEN BEGIN + ChDir (Copy (dir, 1, Length (dir) - 1) ); + IF (IOResult <> 0) THEN Exit; + IF (dir[2] = ':') THEN fcb [1] := chr(ord(dir[1]) - 64) + ELSE fcb [1] := chr(ord(StartDir[1]) - 64); + Regs.ds := seg (fcb); + Regs.dx := ofs (fcb); + Regs.ax := $1300; + msdos (Regs); + purged := (lo (Regs.ax) = 0); + END; +{$ENDIF} + IF NOT fastpurge THEN BEGIN + purged := TRUE; + findfirst (dir + '*.MSG', 0, dirinfo); + IF doserror <> 0 THEN BEGIN purged := FALSE END + ELSE BEGIN + WHILE doserror = 0 DO BEGIN + Assign (hiwaterf, dir + dirinfo.name); + erase (hiwaterf); + i := IOResult; + findnext (dirinfo); + END; + END; + END; + + IF NOT purged THEN Write ('No messages') + ELSE Write ('Purged'); + updatehiwater (dir, 1); + END; + + FUNCTION readmsg (x:integer ; const dir:string) : boolean; + VAR + q : boolean; + BEGIN + Assign (MsgTFile, dir + CStr (x) + '.MSG'); + Reset (MsgTFile, 1); + q := FALSE; + IF IOResult = 0 THEN BEGIN + + IF FileSize (MsgTFile) >= sizeof(header) THEN BEGIN + + BlockRead (MsgTFile, header, sizeof(header)); + s := StrPas(Header.FromUserName); + + IF ((header.attribute AND 16) = 16) THEN MsgHdr.fileattached := 1; + + MsgHdr.From.a1s := s; + MsgHdr.From.real := s; + MsgHdr.From.name := s; + + s := StrPas(Header.ToUserName); + + MsgHdr.MTO.a1s := s; + MsgHdr.MTO.real := s; + MsgHdr.MTO.name := s; + + MsgHdr.Subject := StrPas(Header.Subject); + + MsgHdr.OriginDate := StrPas(Header.DateTime); + + q := TRUE; + + IF (Header.Attribute AND 1 = 1) THEN MsgHdr.status := [Sent, Prvt] + ELSE MsgHdr.status := [Sent]; + + IF IsNetMail THEN BEGIN + q:=FALSE; + MsgHdr.From.node := Header.OrigNode; + MsgHdr.From.net := Header.OrigNet; + MsgHdr.MTO.node := Header.DestNode; + MsgHdr.MTO.net := Header.DestNet; + MsgHdr.From.Point := 0; + MsgHdr.MTO.Point := 0; + MsgHdr.From.Zone := 0; + MsgHdr.MTO.Zone := 0; + IF (Header.Attribute AND 256 = 0) AND + (Header.Attribute AND 4 = 0) THEN BEGIN + {look here FOR the netmail bug} + FOR i := 0 TO 19 DO BEGIN {21 is the uucp} + IF (MsgHdr.MTO.node = statusr.aka[i].node) AND + (MsgHdr.MTO.net = statusr.aka[i].net) THEN BEGIN + MsgHdr.MTO.Zone := statusr.aka[i].Zone; + MsgHdr.From.Zone := statusr.aka[i].Zone; + q := TRUE; + END; + END; + END; + END; + + IF q THEN BEGIN + IF (FileSize(MsgTFile) - 190) <= sizeof(buffer) THEN x := FileSize(MsgTFile) - 190 + ELSE x := sizeof(buffer); + BlockRead (MsgTFile, buffer, x, msglength); + END; + END; + + IF IsNetMail THEN + IF q AND purge_netmail THEN + BEGIN + Close (MsgTFile); + erase (MsgTFile) + END + ELSE IF q THEN + BEGIN + Header.Attribute := 260; + Seek (MsgTFile, 0); + BlockWrite (MsgTFile, header, sizeof(Header)); + END; + IF NOT (IsNetMail AND q AND purge_netmail) THEN Close(MsgTFile); + END; + readmsg := q; + i := IOResult; + END; + + procedure nextboard(Scanning:boolean); + VAR + GoodBoard:boolean; + BEGIN + IF Board = 0 THEN + BEGIN + i := IOResult; + Assign (boardf, datapath + 'MBASES.DAT'); + Reset (boardf); + i := IOResult; + IF i <> 0 THEN + BEGIN + WriteLn (i,':Problem accessing ' + datapath + 'MBASES.DAT. Please fix.'); + halt (1); + END; + END; + + IF Board = FileSize (boardf) THEN + BEGIN + Board := 32767; + Exit; + END; + + BoardR.matype := 0; BoardR.maflags := []; GoodBoard := FALSE; + WHILE NOT GoodBoard AND (Board < FileSize(boardf)) DO + BEGIN + Read (boardf, BoardR); + GoodBoard := (BoardR.matype = 1) AND + (NOT scanning or (absolute_scan or (mascanout in BoardR.maflags))); + Inc(Board); + END; + + IF (NOT GoodBoard) THEN + Board := 32767 + ELSE + IF scanning AND (mascanout in BoardR.maflags) THEN + BEGIN + Seek(boardf, Board - 1); + BoardR.maflags := BoardR.maflags - [mascanout]; + Write(boardf, BoardR); + END; + END; + + + procedure toss; + VAR i,j:word; + z:string [20]; + left, right, gap, oldgap : integer; + BEGIN + MsgHdr.From.anon := 0; + MsgHdr.From.usernum := 0; + MsgHdr.MTO.anon := 0; + MsgHdr.MTO.usernum := 0; + MsgHdr.replyto := 0; + MsgHdr.replies := 0; + MsgHdr.fileattached := 0; + + getdayofweek (MsgHdr.dayofweek); + MsgHdr.date := getpackdatetime; + getmsglst (BoardR.MsgPath); + IF IsNetMail AND (highest > 1) THEN lowest := 1; + + IF (lowest <= highest) AND ((highest > 1) or IsNetMail) THEN BEGIN + + Assign (MsgHdrF, MsgPath + BoardR.FileName + '.HDR'); + Reset (MsgHdrF); + IF (IOResult = 2) THEN ReWrite (MsgHdrF); + + Assign (MsgTxtF, MsgPath + BoardR.FileName + '.DAT'); + Reset (MsgTxtF, 1); + IF (IOResult = 2) THEN ReWrite (MsgTxtF, 1); + + Seek (MsgHdrF, FileSize (MsgHdrF) ); + Seek (MsgTxtF, FileSize (MsgTxtF) ); + + IF IOResult <> 0 THEN + aborterror('error accessing ' + MsgPath + BoardR.FileName + '.*'); + + FOR MsgNumber := lowest TO highest DO BEGIN + Write (MsgNumber : 4); + IF readmsg (MsgNumber, BoardR.MsgPath) THEN + with MsgHdr DO BEGIN + Inc (date); + pointer := FileSize (MsgTxtF) + 1; + TextSize := 0; + msgpointer := 0; + nos := ''; + WHILE (msgpointer < msglength) DO BEGIN + MsgTxt := nos; + REPEAT + Inc (msgpointer); + c := buffer [msgpointer]; + IF NOT (c in [#0, #10, #13, #141]) THEN + IF (Length(MsgTxt) < 255) THEN {MsgTxt := MsgTxt + c;} + BEGIN + Inc(MsgTxt[0]); + MsgTxt[Length(MsgTxt)] := c; + END; + UNTIL ( + (nos = #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; + + i := POS('INTL ', MsgTxt); + IF (i > 0) THEN + BEGIN + Inc(i, 6); + FOR j := 1 TO 8 DO + BEGIN + z := ''; + WHILE (MsgTxt[i] in ['0'..'9']) AND (i <= Length(MsgTxt)) DO + BEGIN + z := z + MsgTxt[i]; + Inc(i); + END; + case j of + 1:MsgHdr.MTO.Zone := Value(z); + 2:MsgHdr.MTO.net := Value(z); + 3:MsgHdr.MTO.node := Value(z); + 4:MsgHdr.MTO.Point := Value(z); + 5:MsgHdr.From.Zone := Value(z); + 6:MsgHdr.From.net := Value(z); + 7:MsgHdr.From.node := Value(z); + 8:MsgHdr.From.Point := Value(z); + END; + IF (j = 3) AND (MsgTxt[i] <> '.') THEN + Inc(j); + IF (j = 7) AND (MsgTxt[i] <> '.') THEN + break; + Inc(i); + END; + END; + + IF (Length (MsgTxt) > 79) THEN + BEGIN + i := Length (MsgTxt); + WHILE (MsgTxt [i] = ' ') AND (i > 1) DO + Dec (i); + WHILE (i > 65) AND (MsgTxt [i] <> ' ') DO + Dec (i); + + nos[0] := chr(Length(MsgTxt) - i); + Move(MsgTxt[i + 1], nos[1], Length(MsgTxt) - i); + MsgTxt[0] := chr(i - 1); + + END + ELSE + nos := ''; + + IF ( (MsgTxt [1] = #1) AND (maskludge in BoardR.maflags) ) or + ( (POS ('SEEN-BY', MsgTxt) > 0) AND (masseenby in BoardR.maflags) ) or + ( (POS ('* Origin:', MsgTxt) > 0) AND (masorigin in BoardR.maflags) ) THEN + MsgTxt := '' + ELSE BEGIN + Inc (MsgHdr.TextSize, Length (MsgTxt) + 1); + BlockWrite (MsgTxtF, MsgTxt, Length (MsgTxt) + 1); + END; + END; + IF IsNetMail THEN BEGIN + MsgHdr.status := MsgHdr.status + [netmail]; + MsgHdr.MTO.usernum := SearchUser(MsgHdr.MTO.a1s); + IF MsgHdr.MTO.usernum = 0 THEN + MsgHdr.MTO.usernum := 1; + Seek (uf, MsgHdr.MTO.usernum); + Read (uf, user); + Inc (user.waiting); + Seek (uf, MsgHdr.MTO.usernum); + Write (uf, user); + END; + Write (MsgHdrF, MsgHdr); + END; + IF MsgNumber < highest THEN Write (#8#8#8#8); + i := IOResult; + END; + Close (MsgHdrF); + Close (MsgTxtF); + IF NOT IsNetMail THEN updatehiwater (BoardR.MsgPath, highest); + END ELSE Write ('No messages'); + LastError := IOResult; + END; + + procedure scan; + VAR rgmsgnumber : integer; + highestwritten : integer; + AnsiOn, + scanned : boolean; + BEGIN + AnsiOn := FALSE; + scanned := FALSE; + getmsglst (BoardR.MsgPath); + MsgNumber := highest; + IF (NOT ExistDir(BoardR.MsgPath)) THEN + BEGIN + WriteLn('WARNING: Cannot access ', BoardR.MsgPath); + Exit; + END; + + Assign (MsgHdrF, MsgPath + BoardR.FileName + '.HDR'); + Reset (MsgHdrF); + IF IOResult <> 0 THEN Exit; + + Assign (MsgTxtF, MsgPath + BoardR.FileName + '.DAT'); + Reset (MsgTxtF, 1); + IF IOResult <> 0 THEN BEGIN Close (MsgHdrF); Exit; END; + + FOR rgmsgnumber := 1 TO FileSize (MsgHdrF) DO BEGIN + Seek (MsgHdrF, rgmsgnumber - 1); + Read (MsgHdrF, MsgHdr); + IF NOT (Sent in MsgHdr.status) AND (IOResult = 0) AND + NOT (MDeleted in MsgHdr.status) AND + NOT (IsNetMail AND NOT (netmail in MsgHdr.status)) AND + NOT (unvalidated in MsgHdr.status) THEN BEGIN + scanned := TRUE; + Inc (MsgNumber); + Assign (MsgTFile, BoardR.MsgPath + CStr (MsgNumber) + '.MSG'); + ReWrite (MsgTFile, 1); + Write (rgmsgnumber : 5); + + MsgHdr.status := MsgHdr.status + [Sent]; + + IF IsNetMail THEN + MsgHdr.status := MsgHdr.status + [MDeleted]; + + Seek (MsgHdrF, rgmsgnumber - 1); + Write (MsgHdrF, MsgHdr); + + IF (marealname in BoardR.maflags) THEN + s := Caps (MsgHdr.From.real) + ELSE + s := Caps (MsgHdr.From.a1s); + + s := usename(MsgHdr.From.anon, s); + + FillChar(Header,sizeof(Header),#0); + + Move(s[1],Header.FromUserName[0],Length(s)); + + IF (marealname in BoardR.maflags) THEN + s := Caps (MsgHdr.MTO.real) + ELSE + s := Caps (MsgHdr.MTO.a1s); + + s := usename(MsgHdr.MTO.anon, s); + + Move(s[1],Header.ToUserName[0],Length(s)); + + MsgHdr.Subject := StripColor(MsgHdr.Subject); + + IF (NOT IsNetMail) AND (MsgHdr.fileattached > 0) THEN + MsgHdr.Subject := StripName(MsgHdr.Subject); + + Move(MsgHdr.Subject[1],Header.Subject[0],Length(MsgHdr.Subject)); + + packtodate (dt, MsgHdr.date); + with dt DO BEGIN + s := CStr (day); + IF Length (s) < 2 THEN s := '0' + s; + s := s + ' ' + Copy ('JanFebMarAprMayJunJulAugSepOctNovDec', (month - 1) * 3 + 1, 3) + ' '; + s := s + Copy (CStr (year), 3, 2) + ' '; + nos := CStr (hour); + IF Length (nos) < 2 THEN nos := '0' + nos; + s := s + nos + ':'; + nos := CStr (min); + IF Length (nos) < 2 THEN nos := '0' + nos; + s := s + nos + ':'; + nos := CStr (sec); + END; + IF Length (nos) < 2 THEN nos := '0' + nos; + s := s + nos; + + Move(s[1],Header.DateTime[0],Length(s)); + + IF IsNetMail THEN BEGIN + Header.OrigNet := MsgHdr.From.net; + Header.OrigNode := MsgHdr.From.node; + Header.DestNet := MsgHdr.MTO.net; + Header.DestNode := MsgHdr.MTO.node; + END ELSE BEGIN + Header.OrigNet := statusr.aka [BoardR.aka].net; + Header.OrigNode := statusr.aka [BoardR.aka].node; + Header.DestNet := 0; + Header.DestNode := 0; + END; + + IF IsNetMail THEN + Header.Attribute := word(MsgHdr.netattribute) + {word(statusr.netattribute)} + ELSE + IF (prvt in MsgHdr.status) THEN + Header.Attribute := 257 + ELSE + Header.Attribute := 256; + + IF (MsgHdr.fileattached > 0) THEN + Header.Attribute := Header.Attribute + 16; + + BlockWrite (MsgTFile, header, sizeof(Header)); + Seek (MsgTxtF, MsgHdr.pointer - 1); + + IF IsNetMail THEN BEGIN + s := 'INTL ' + CStr (MsgHdr.MTO.Zone) + ':' + CStr (MsgHdr.MTO.net) + '/' + CStr (MsgHdr.MTO.node); + s := s + ' ' + CStr (MsgHdr.From.Zone) + ':' + CStr (MsgHdr.From.net) + '/' + CStr (MsgHdr.From.node); + s := s + #13; + BlockWrite (MsgTFile, s [1], Length (s) ); + IF MsgHdr.MTO.Point > 0 THEN + BEGIN + s := #1'TOPT ' + CStr(MsgHdr.MTO.Point); + BlockWrite (MsgTFile, s [1], Length (s) ); + END; + IF MsgHdr.From.Point > 0 THEN + BEGIN + s := #1'FMPT ' + CStr(MsgHdr.From.Point); + BlockWrite (MsgTFile, s [1], Length (s) ); + END; + + s := ^A'MSGID: ' + CStr (MsgHdr.From.Zone) + ':' + CStr (MsgHdr.From.net) + + '/' + CStr (MsgHdr.From.node) + ' ' + Hex(Random($FFFF), 4) + Hex(Random($FFFF),4); + + IF MsgHdr.From.Point > 0 THEN s := s + '.' + CStr (MsgHdr.From.Point); + s := s + {' '} #13; { *** } + BlockWrite (MsgTFile, s [1], Length (s) ); +{$IFDEF MSDOS} + s := #1'PID: Renemail ' + ver + #13; +{$ELSE} + s := #1'PID: Renemail/2 ' + ver + #13; +{$ENDIF} + BlockWrite (MsgTFile, s [1], Length (s) ); + END; + + j := 0; + IF MsgHdr.TextSize > 0 THEN + REPEAT + BlockRead (MsgTxtF, s [0], 1); + BlockRead (MsgTxtF, s [1], ord (s [0]) ); + Inc (j, Length (s) + 1); + WHILE POS(#0,s) > 0 DO + Delete(s,POS(#0,s),1); + IF s [Length (s) ] = #29 THEN + Dec(s[0]) + ELSE + IF POS (#27, s) = 0 THEN + s := StripColor(s) + ELSE + AnsiOn := TRUE; + s := s + #13; + BlockWrite (MsgTFile, s [1], Length (s) ); + UNTIL (j >= MsgHdr.TextSize); + Close (MsgTFile); + Write (#8#8#8#8#8); + END; + highestwritten := MsgNumber; + END; + i := IOResult; + IF NOT IsNetMail THEN updatehiwater (BoardR.MsgPath, highestwritten); + Close (MsgHdrF); + Close (MsgTxtF); + IF NOT scanned THEN Write ('No messages'); + LastError := IOResult; + END; + +BEGIN + Randomize; + GetDir (0, StartDir); + FOR x := 1 TO 37 DO + fcb [x] := ' '; + fcb [1] := chr (ord (StartDir [1]) - 64); + fcb [2] := '*'; + fcb [10] := 'M'; + fcb [11] := 'S'; + fcb [12] := 'G'; + FileMode := 66; + MsgHdr.From.Zone := 0; + MsgHdr.From.Point := 0; + ClrScr; + TextColor (3); +{$IFDEF MSDOS} + WriteLn ('Renegade Echomail Interface DOS v' + ver); +{$ELSE} + WriteLn ('Renegade Echomail Interface OS/2 v' + ver); +{$ENDIF} + WriteLn ('Copyright 2004-2006'); + WriteLn; + TextColor (10); + + IF ParamStr (1) = '' THEN + BEGIN + WriteLn (' Commands: -T Toss incoming messages'); + WriteLn (' -S Scan outbound messages'); + WriteLn (' -P Purge echomail dirs'); + WriteLn (' Options: -A Absolute scan'); +{$IFDEF MSDOS} + WriteLn (' -F No fast purge'); +{$ENDIF} + WriteLn (' -N No Netmail'); + WriteLn (' -D Do not delete Netmail'); +{$IFDEF MSDOS} + WriteLn (' -B Bios video output'); +{$ENDIF} + WriteLn (' -O Only Netmail'); + WriteLn (' -I Import 1.MSG'); + WriteLn; + halt; + END; + FOR i := 1 TO paramcount DO + IF POS ('-N', AllCaps (ParamStr (i) ) ) > 0 THEN + process_netmail := FALSE + ELSE + IF POS ('-F', AllCaps (ParamStr (i) ) ) > 0 THEN + fastpurge := FALSE + ELSE + IF POS ('-D', AllCaps (ParamStr (i) ) ) > 0 THEN + purge_netmail := FALSE + ELSE +{$IFDEF MSDOS} + IF POS ('-B', AllCaps (ParamStr (i) ) ) > 0 THEN + directvideo := FALSE + ELSE +{$ENDIF} + IF POS ('-O', AllCaps (ParamStr (i) ) ) > 0 THEN + netmailonly := TRUE + ELSE + IF POS ('-A', AllCaps (ParamStr (i) ) ) > 0 THEN + absolute_scan := TRUE + ELSE + IF POS ('-I', AllCaps (ParamStr (i) ) ) > 0 THEN + ignore_1msg := FALSE; + (* 09-16-96 Changed to allow processing of 1.msg + *) + Board := 0; + getpaths; + + IF process_netmail THEN + BEGIN + BoardR.MsgPath := netmailpath; + BoardR.FileName := 'EMAIL'; + BoardR.maflags := [maskludge]; + Assign (uf, datapath + 'users.dat'); + Reset (uf); + IF IOResult <> 0 THEN + aborterror('Cannot find users.dat in your DATA directory'); + Assign (sf, datapath + 'users.idx'); + Reset (sf); + IF IOResult <> 0 THEN + aborterror('Cannot find users.idx in your DATA directory'); + + IsNetMail := TRUE; + TextColor (3); + Write ('Processing: '); + TextColor (14); + Write (' NETMAIL - '); + TextColor (11); + IF POS ('-T', AllCaps (ParamStr (1) ) ) > 0 THEN + toss; + IF POS ('-S', AllCaps (ParamStr (1) ) ) > 0 THEN + scan; + Close (uf); + Close (sf); + LastError := IOResult; + WriteLn; + IsNetMail := FALSE; + END; + + IF netmailonly THEN halt; + + WHILE Board <> 32767 DO BEGIN + nextboard(POS('-S', AllCaps(ParamStr(1))) > 0); + IF Board <> 32767 THEN BEGIN + TextColor (3); + Write ('Processing: '); + TextColor (14); + Write (BoardR.FileName : 8, ' - '); + TextColor (11); + IF POS ('-P', AllCaps (ParamStr (1) ) ) > 0 THEN PurgeDir (BoardR.MsgPath) + ELSE IF POS ('-T', AllCaps (ParamStr (1) ) ) > 0 THEN toss + ELSE IF POS ('-S', AllCaps (ParamStr (1) ) ) > 0 THEN scan; + WriteLn; + END ELSE Close (boardf) + END; + ChDir (StartDir); +END. diff --git a/SOURCE/UNUSED/RMCHANGE.DOC b/SOURCE/UNUSED/RMCHANGE.DOC new file mode 100644 index 0000000..b30c62b --- /dev/null +++ b/SOURCE/UNUSED/RMCHANGE.DOC @@ -0,0 +1,3 @@ +1. Added Caps to tossed From/MTO Names. +2. Bumped the maximum messages that can be handled per based from + 32767 to 65535. \ No newline at end of file diff --git a/SOURCE/UNUSED/RMUPDATE.DOC b/SOURCE/UNUSED/RMUPDATE.DOC new file mode 100644 index 0000000..8a8f4b0 --- /dev/null +++ b/SOURCE/UNUSED/RMUPDATE.DOC @@ -0,0 +1,13 @@ +Renemail Echomail Interface update log for Renegade v1.10 + +10/04/09 + +1. Changed the Style of the code for easier updating. + +2. Removed numerous unused variables thru-out the code. + +3. Replaced all instances of "i := IOResult" with "LastError := IOResult". + +4. Added/Replaced "Include/Excludes" where appropriate tru-out the code. + +5. Replaced the Scan - Fido Message Date/Time calculation routine. \ No newline at end of file diff --git a/SOURCE/UNUSED/SCRIPT.TPU b/SOURCE/UNUSED/SCRIPT.TPU new file mode 100644 index 0000000..d4bfb67 Binary files /dev/null and b/SOURCE/UNUSED/SCRIPT.TPU differ diff --git a/SOURCE/UNUSED/SHORTMSG.TPU b/SOURCE/UNUSED/SHORTMSG.TPU new file mode 100644 index 0000000..26f4888 Binary files /dev/null and b/SOURCE/UNUSED/SHORTMSG.TPU differ diff --git a/SOURCE/UNUSED/SORTING.PAS b/SOURCE/UNUSED/SORTING.PAS new file mode 100644 index 0000000..e7c3313 --- /dev/null +++ b/SOURCE/UNUSED/SORTING.PAS @@ -0,0 +1,157 @@ +unit Sorting; +{=============================================} +{ James L. Allison } +{ 1703 Neptune Lane } +{ Houston, Texas 77062 } +{ Dec 22, 1988 } +{=============================================} + +{ Please feel free to use any part of this in any of your programs.} + +interface + uses TypeSpec; +type + Item=TypeSpec.Character; {This defines the objects being sorted.} + List=array [0..0] of Item; {This is an array of objects to be sorted.} + + L_Less_Than_R = function(L,R:Item):boolean; +{ This is a user defined function that determines the + order of the sort. It may be as simple or complex as + necessary to give the desired order. In particular it + can use any field in a record as the sort key, or use + more than one key. } + + { Make sure that range check is off before you use any of these. } + +procedure QuickSort (var X:List; Less_Than:L_Less_Than_R; N:integer); +{ A very fast sort, uses recursion. + May have stack problems on a large sort. } + +procedure ShellSort (var X:List; Less_Than:L_Less_Than_R; N:integer); +{ Almost as fast as QuickSort, but without recursion. + The work horse of fast sorting methods. } + +procedure LoopSort (var X:List; Less_Than:L_Less_Than_R; N:integer); +{ No reason to use this. Included only for comparison. } + +procedure BubbleSort (var X:List; Less_Than:L_Less_Than_R; N:integer); +{ The only time to use this is when the array is almost in order, with + only a couple of items out of place. It may be useful to modify this + to make the sweep from the other end of the array. BubbleSort is + a special purpose method. Stick to QuickSort or ShellSort.} + +(*---------------------------------------------------------------------*) +implementation +(*---------------------------------------------------------------------*) +procedure Swap(var X:List;I,J:integer); +var + Temp:Item; + begin + Temp:=X[I]; + X[I]:=X[J]; + X[J]:=Temp; + end; +(*---------------------------------------------------------------------*) +procedure Qsort(var X:List;Less_Than:L_Less_Than_R;Left,Right:integer); +label + Again; +var + Pivot:Item; + P,Q:integer; + + begin + P:=Left; + Q:=Right; + Pivot:=X [(Left+Right) div 2]; + + while P<=Q do + begin + while Less_Than(X[P],Pivot) do inc(P); + while Less_Than(Pivot,X[Q]) do dec(Q); + if P>Q then goto Again; + Swap(X,P,Q); + inc(P);dec(Q); + end; + + Again: + if Left0 do + begin + I:=Gap; + + while I=0) and (Less_Than(X[J+Gap],X[J])) do + begin + Swap(X,J,J+Gap); + dec(J,Gap); + end; + + inc(I); + end; + + Gap:=Gap div 2; + end; + + end; + +(*---------------------------------------------------------------------*) +procedure LoopSort(var X:List;Less_Than:L_Less_Than_R;N:integer); +var + I,J:integer; + begin + for I:=0 to N-1 do + begin + for J:=I+1 to N-1 do + begin + if Less_Than(X[J],X[I]) + then + begin + Swap(X,I,J); + end; + end; + end; + end; + +(*---------------------------------------------------------------------*) +procedure BubbleSort(var X:List;Less_Than:L_Less_Than_R;N:integer); +var + J:integer; + Finished:boolean; + begin + repeat + Finished:=true; + for J:=0 to N-2 do + if Less_Than(X[J+1],X[J]) then + begin + Finished:=false; + Swap(X,J,J+1); + end; + dec(N); + until Finished; + end; + + begin + end. + + + \ No newline at end of file diff --git a/SOURCE/UNUSED/SPAWNO.TPU b/SOURCE/UNUSED/SPAWNO.TPU new file mode 100644 index 0000000..693adbf Binary files /dev/null and b/SOURCE/UNUSED/SPAWNO.TPU differ diff --git a/SOURCE/UNUSED/SPLITCHA.TPU b/SOURCE/UNUSED/SPLITCHA.TPU new file mode 100644 index 0000000..9919716 Binary files /dev/null and b/SOURCE/UNUSED/SPLITCHA.TPU differ diff --git a/SOURCE/UNUSED/STATS.TPU b/SOURCE/UNUSED/STATS.TPU new file mode 100644 index 0000000..466c1ad Binary files /dev/null and b/SOURCE/UNUSED/STATS.TPU differ diff --git a/SOURCE/UNUSED/SYSCHAT.PAS b/SOURCE/UNUSED/SYSCHAT.PAS new file mode 100644 index 0000000..6f1b93d --- /dev/null +++ b/SOURCE/UNUSED/SYSCHAT.PAS @@ -0,0 +1,664 @@ +{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} + +UNIT SysChat; + +INTERFACE + +USES + Common; + +PROCEDURE RequestSysOpChat(CONST MenuOption: STr50); +PROCEDURE ChatFileLog(b: Boolean); +PROCEDURE Chat; + +IMPLEMENTATION + +USES + Crt, + Dos, + Email, + Event, + TimeFunc; + +VAR + UserChatArray: ARRAY [1..10] OF AStr; + SysOpChatArray: ARRAY [1..10] OF AStr; + 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 + 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; + END; + NoSound; + IF (KeyPressed) THEN + BEGIN + Cmd := ReadKey; + CASE Cmd OF + #0 : BEGIN + Cmd := ReadKey; + SKey1(Cmd); + END; + #32 : BEGIN + Chatted := TRUE; + ChatAttempts := 0; + Chat; + 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 SysOpChatWindow; +BEGIN + CLS; + + ANSIG(1,1); + + Prompt('郞袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴拷'); + + ANSIG(1,12); + + Prompt('突袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴槁'); + + ANSIG(1,13); + + Prompt('郞袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴拷'); + + ANSIG(1,24); + + Prompt('突袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴槁'); + + ANSIG(37,25); + + Prompt('Help'); + +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 Chat; +VAR + S, + SysOpStr, + UserStr, + SysOpLastLineStr, + UserLastLineStr: AStr; (* Was S *) + + C: Char; + Counter, + Counter1, + SysOpCPos, + UserCPos: Byte; + + 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; + + SysOpLastLineStr := ''; + UserLastLineStr := ''; + SysOpXPos := 2; + SysOpYPos := 2; + UserXPos := 2; + UserYPos := 14; + + SysOpStr := ''; + UserStr := ''; + SysOpCPos := 1; + UserCPos := 1; + + SysOpChatWindow; + + ANSIG(SysOpXPos,SysOpYPos); + + REPEAT + + C := Char(GetKey); + + CheckHangUp; + + CASE Ord(C) OF + 32..255 : IF (WColor) THEN + BEGIN + IF (SysOpCPos < 79) THEN + BEGIN + SysOpStr[SysOpCPos] := C; + Inc(SysOpCPos); + ANSIG(SysOpXPos,SysOpYPos); + OutKey(C); + Inc(SysOpXPos); + IF (Trapping) THEN + Write(TrapFile,C); + END + ELSE + BEGIN + SysOpStr[0] := Chr(SysOpCPos - 1); + + Counter := (SysOpCPos - 1); + WHILE (Counter > 0) AND (SysOpStr[Counter] <> ' ') AND (SysOpStr[Counter] <> ^H) DO + Dec(Counter); + IF (Counter > (SysOpCPos DIV 2)) AND (Counter <> (SysOpCPos - 1)) THEN + BEGIN + SysOpLastLineStr := Copy(SysOpStr,(Counter + 1),(SysOpCPos - Counter)); + FOR Counter1 := (SysOpCPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(SysOpXPos,SysOpYPos); + Prompt(^H); + Dec(SysOpXPos); + END; + FOR Counter1 := (SysOpCPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(SysOpXPos,SysOpYPos); + Prompt(' '); + Inc(SysOpXPos); + END; + SysOpStr[0] := Chr(Counter - 1); + END; + NL; + + Inc(SysOpYPos); + SysOpXPos := 2; + ANSIG(SysOpXPos,SysOpYPos); + + SysOpCPos := 1; + SysOpStr := ''; + IF (SysOpLastLineStr <> '') THEN + BEGIN + SysOpXPos := Length(SysOpLastLineStr) + 2; + Prompt(SysOpLastLineStr); + ANSIG(SysOpXPos,SysOpYPos); + SysOpStr := SysOpLastLineStr; + SysOpLastLineStr := ''; + SysOpCPos := (Length(SysOpStr) + 1); + END; + + END; + + END + ELSE + BEGIN + IF (UserCPos < 79) THEN + BEGIN + UserStr[UserCPos] := C; + Inc(UserCPos); + ANSIG(UserCPos,UserYPos); + OutKey(C); + Inc(UserXPos); + IF (Trapping) THEN + Write(TrapFile,C); + END + ELSE + BEGIN + UserStr[0] := Chr(UserCPos - 1); + + Counter := (UserCPos - 1); + WHILE (Counter > 0) AND (UserStr[Counter] <> ' ') AND (UserStr[Counter] <> ^H) DO + Dec(Counter); + IF (Counter > (UserCPos DIV 2)) AND (Counter <> (UserCPos - 1)) THEN + BEGIN + UserLastLineStr := Copy(UserStr,(Counter + 1),(UserCPos - Counter)); + FOR Counter1 := (UserCPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(UserXPos,UserYPos); + Prompt(^H); + Dec(UserXPos); + END; + FOR Counter1 := (UserCPos - 2) DOWNTO Counter DO + BEGIN + ANSIG(UserXPos,UserYPos); + Prompt(' '); + Inc(UserXPos); + END; + UserStr[0] := Chr(Counter - 1); + END; + NL; + + Inc(UserYPos); + UserXPos := 2; + ANSIG(UserXPos,UserYPos); + + UserCPos := 1; + UserStr := ''; + IF (UserLastLineStr <> '') THEN + BEGIN + UserXPos := Length(UserLastLineStr) + 2; + Prompt(UserLastLineStr); + ANSIG(UserXPos,UserYPos); + UserStr := UserLastLineStr; + UserLastLineStr := ''; + UserCPos := (Length(UserStr) + 1); + END; + + END; + + END; + 8 : IF (WColor) THEN + BEGIN + IF (SysOpCPos > 1) THEN + BEGIN + ANSIG(SysOpXPos,SysOpYPos); + Dec(SysOpCPos); + Dec(SysOpXPos); + BackSpace; + END; + END + ELSE + BEGIN + IF (UserCPos > 1) THEN + BEGIN + ANSIG(UserXPos,UserYPos); + Dec(UserCPos); + Dec(UserXPos); + BackSpace; + END; + END; + 13 : IF (WColor) THEN + BEGIN + SysOpStr[0] := Chr(SysOpCPos - 1); + + END + ELSE + BEGIN + UserStr[0] := Chr(UserCPos - 1); + + END; + + END; + + + + + (* + 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 + 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)); + + 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/UNUSED/SYSCHAT.TPU b/SOURCE/UNUSED/SYSCHAT.TPU new file mode 100644 index 0000000..719695c Binary files /dev/null and b/SOURCE/UNUSED/SYSCHAT.TPU differ diff --git a/SOURCE/UNUSED/SYSOP1.TPU b/SOURCE/UNUSED/SYSOP1.TPU new file mode 100644 index 0000000..7ee17a5 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP1.TPU differ diff --git a/SOURCE/UNUSED/SYSOP10.TPU b/SOURCE/UNUSED/SYSOP10.TPU new file mode 100644 index 0000000..8c9274b Binary files /dev/null and b/SOURCE/UNUSED/SYSOP10.TPU differ diff --git a/SOURCE/UNUSED/SYSOP11.TPU b/SOURCE/UNUSED/SYSOP11.TPU new file mode 100644 index 0000000..5632a61 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP11.TPU differ diff --git a/SOURCE/UNUSED/SYSOP12.TPU b/SOURCE/UNUSED/SYSOP12.TPU new file mode 100644 index 0000000..6f173bb Binary files /dev/null and b/SOURCE/UNUSED/SYSOP12.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2.TPU b/SOURCE/UNUSED/SYSOP2.TPU new file mode 100644 index 0000000..b224099 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2A.TPU b/SOURCE/UNUSED/SYSOP2A.TPU new file mode 100644 index 0000000..27cfcce Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2A.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2B.TPU b/SOURCE/UNUSED/SYSOP2B.TPU new file mode 100644 index 0000000..5a49dc8 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2B.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2C.TPU b/SOURCE/UNUSED/SYSOP2C.TPU new file mode 100644 index 0000000..7487c82 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2C.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2D.TPU b/SOURCE/UNUSED/SYSOP2D.TPU new file mode 100644 index 0000000..e8c7ca1 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2D.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2E.TPU b/SOURCE/UNUSED/SYSOP2E.TPU new file mode 100644 index 0000000..f59fdcd Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2E.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2F.TPU b/SOURCE/UNUSED/SYSOP2F.TPU new file mode 100644 index 0000000..9ff5109 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2F.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2G.TPU b/SOURCE/UNUSED/SYSOP2G.TPU new file mode 100644 index 0000000..8c8d117 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2G.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2H.TPU b/SOURCE/UNUSED/SYSOP2H.TPU new file mode 100644 index 0000000..ad40f26 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2H.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2I.TPU b/SOURCE/UNUSED/SYSOP2I.TPU new file mode 100644 index 0000000..f7ff1b1 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2I.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2J.TPU b/SOURCE/UNUSED/SYSOP2J.TPU new file mode 100644 index 0000000..5fa101c Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2J.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2K.TPU b/SOURCE/UNUSED/SYSOP2K.TPU new file mode 100644 index 0000000..755a88d Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2K.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2L.TPU b/SOURCE/UNUSED/SYSOP2L.TPU new file mode 100644 index 0000000..2faf70e Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2L.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2M.TPU b/SOURCE/UNUSED/SYSOP2M.TPU new file mode 100644 index 0000000..32af1e3 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2M.TPU differ diff --git a/SOURCE/UNUSED/SYSOP2O.TPU b/SOURCE/UNUSED/SYSOP2O.TPU new file mode 100644 index 0000000..e3e50b6 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP2O.TPU differ diff --git a/SOURCE/UNUSED/SYSOP3.TPU b/SOURCE/UNUSED/SYSOP3.TPU new file mode 100644 index 0000000..9f09e3e Binary files /dev/null and b/SOURCE/UNUSED/SYSOP3.TPU differ diff --git a/SOURCE/UNUSED/SYSOP4.TPU b/SOURCE/UNUSED/SYSOP4.TPU new file mode 100644 index 0000000..1b80ef1 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP4.TPU differ diff --git a/SOURCE/UNUSED/SYSOP5.TPU b/SOURCE/UNUSED/SYSOP5.TPU new file mode 100644 index 0000000..1051567 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP5.TPU differ diff --git a/SOURCE/UNUSED/SYSOP6.TPU b/SOURCE/UNUSED/SYSOP6.TPU new file mode 100644 index 0000000..8d046b5 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP6.TPU differ diff --git a/SOURCE/UNUSED/SYSOP6~1.PAS b/SOURCE/UNUSED/SYSOP6~1.PAS new file mode 100644 index 0000000..f33fc0c --- /dev/null +++ b/SOURCE/UNUSED/SYSOP6~1.PAS @@ -0,0 +1,738 @@ +{$A+,B+,D+,E+,F+,I+,L+,N-,O+,R-,S+,V-} +UNIT SYSOP6; + +INTERFACE + +PROCEDURE EventEditor; + +IMPLEMENTATION + +USES + Common; + +PROCEDURE EventEditor; +VAR + EventTypeStr, + UserCmds, + OneKCmds: Str160; + Cmd: CHAR; + Counter, + Counter1, + Counter2, + RecNum: INTEGER; + Abort, + Next: BOOLEAN; + + FUNCTION DActive(ed: eventdaystype): Str160; + CONST + days: Str7 = 'MTWTFSS'; + VAR + s1: Str160; + i: INTEGER; + BEGIN + s1 := ''; + FOR i := 0 TO 6 DO + IF (i IN ed) THEN + s1 := s1+days[i + 1] + ELSE + s1 := s1+'-'; + DActive := s1; + END; + + (* + FUNCTION LastDay(dt: Str8): Str8; + VAR + D,M,Y: INTEGER; + BEGIN + M := StrToInt(Copy(dt,1,2)); + D := StrToInt(Copy(dt,4,2)); + Y := StrToInt(Copy(dt,7,2)); + IF (D = 1) AND (M = 1) THEN + BEGIN + IF (Y > 0) then + dec(Y) + ELSE + Y := 99; + M := 12; + D := DaysInMonth(M,Y); + END + ELSE IF (D > 1) THEN + Dec(D) + ELSE IF (M > 1) THEN + BEGIN + Dec(M); + D := DaysInMonth(M,Y); + END; + LastDay := ZeroPad(M)+'/'+ZeroPad(D)+'/'+ZeroPad(Y); + END; + *) + (* + FUNCTION NextDay(dt: Str8): Str8; + VAR + D,M,Y: integer; + BEGIN + M := StrToInt(Copy(dt,1,2)); + D := StrToInt(Copy(dt,4,2)); + Y := StrToInt(Copy(dt,7,2)); + IF (D = 31) AND (M = 12) THEN + BEGIN + IF (Y < 99) THEN + Inc(y) + ELSE + Y := 0; + M := 1; + D := 1; + END + ELSE + BEGIN + IF (D < DaysInMonth(M,Y)) THEN + Inc(D) + ELSE IF (M < 12) THEN + BEGIN + Inc(M); + D := 1; + END; + END; + NextDay := ZeroPad(m)+'/'+ZeroPad(d)+'/'+ZeroPad(y); + END; + *) + + (* + FUNCTION ShowTime(W: WORD): Str5; + BEGIN + ShowTime := ZeroPad(W DIV 60)+':'+ZeroPad(W MOD 60); + END; + *) + + PROCEDURE ToggleEventFlag(EventFlagT: EventFlagType; VAR EventFlagS: EFlagSet); + BEGIN + IF (EventFlagT IN EventFlagS) THEN + Exclude(EventFlagS,EventFlagT) + ELSE + Include(EventFlagS,EventFlagT); + END; + + PROCEDURE ToggleEventFlags(Flag: BYTE; VAR EventFlagS: EFlagSet); + BEGIN + CASE Flag OF + 2 : ToggleEventFlag(EventIsExternal,EventFlagS); + 3 : ToggleEventFlag(EventIsActive,EventFlagS); + 4 : ToggleEventFlag(EventIsShell,EventFlagS); + 5 : ToggleEventFlag(EventIsMonthly,EventFlagS); + 6 : ToggleEventFlag(EventIsPermission,EventFlagS); + 7 : ToggleEventFlag(EventIsChat,EventFlagS); + 8 : ToggleEventFlag(EventIsSoft,EventFlagS); + 9 : ToggleEventFlag(BaudIsActive,EventFlagS); + 10 : ToggleEventFlag(SLisActive,EventFlagS); + 11 : ToggleEventFlag(DSLisActive,EventFlagS); + 12 : ToggleEventFlag(ARisActive,EventFlagS); + 13 : ToggleEventFlag(InRatioIsActive,EventFlagS); + 14 : ToggleEventFlag(TimeIsActive,EventFlagS); + 15 : ToggleEventFlag(SetARisActive,EventFlagS); + 16 : ToggleEventFlag(ClearARisActive,EventFlagS); + END; + END; + + PROCEDURE EventRecordDelete(RecNum1: INTEGER); + VAR + Counter: INTEGER; + BEGIN + IF ((RecNum1 >= 1) AND (RecNum1 <= NumEvents)) THEN + BEGIN + IF (RecNum1 <= (FileSize(EventFile) - 2)) THEN + FOR Counter := RecNum1 TO (FileSize(EventFile) - 2) DO + BEGIN + Seek(EventFile,(Counter + 1)); + Read(EventFile,Events); + Seek(EventFile,Counter); + Write(EventFile,Events); + END; + Seek(EventFile,(FileSize(EventFile) - 1)); + Truncate(EventFile); + Dec(NumEvents); + END; + END; + + PROCEDURE EventRecordInsert(RecNum1: INTEGER); + VAR + Counter: Integer; + BEGIN + IF ((RecNum1 >= 1) AND (RecNum1 <= FileSize(EventFile)) AND (NumEvents < MaxEvents)) THEN + BEGIN + FOR Counter := (FileSize(EventFile) - 1) DOWNTO RecNum1 DO + BEGIN + Seek(EventFile,Counter); + Read(EventFile,Events); + Write(EventFile,Events); + END; + WITH Events DO + BEGIN + EFlags := []; + EventDayOfMonth := 1; + EventDays := [0..6]; + EventStartTime := 0; + EventFinishTime := 0; + EventDescription := '<<< New Event >>>'; + EventQualMsg := ''; + EventNotQualMsg := ''; + EventPreTime := 5; + EventOffHookTime := 0 {FALSE}; + EventLastDate := DateStr; + EventErrorLevel := 0; + EventShellPath := ''; + LoBaud := 300; + HiBaud := 19200; + LoSL := 'S0'; + HiSL := 'S255'; + LoDSL := 'D0'; + HiDSL := 'D255'; + ARflagRequired := #0; + MaxTimeAllowed := 60; + SetARflag := #0; + ClearARflag := #0; + END; + Seek(EventFile,RecNum1); + Write(EventFile,Events); + Inc(NumEvents); + END; + END; + + PROCEDURE EventRecordModify(VAR RecNum1: INTEGER); + VAR + TempS: Str160; + Cmd1: CHAR; + TempB: BYTE; + SaveRecNum1: INTEGER; + TempW, + TempW1: WORD; + Changed: BOOLEAN; + BEGIN + RecNum1 := -1; + InputIntegerWoc('Record number to start editing',RecNum1,1,NumEvents); + IF (RecNum1 <> -1) THEN + BEGIN + SaveRecNum1 := -1; + Cmd1 := #0; + WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO + BEGIN + IF (SaveRecNum1 <> RecNum1) THEN + BEGIN + Seek(EventFile,RecNum1); + Read(EventFile,Events); + SaveRecNum1 := RecNum1; + Changed := FALSE; + END; + WITH Events DO + REPEAT + IF (Cmd1 <> '?') THEN + BEGIN + CLS; + Print(#3'31.'#3'1 Event type : '#3'5'+AOnOff(EventIsExternal IN EFlags,'External','Internal')); + Print(#3'32.'#3'1 Description : '#3'5'+EventDescription); + Print(#3'33.'#3'1 Active : '#3'5'+AOnOff(EventIsActive IN EFlags,'Active','Inactive')); + IF (EventIsExternal IN EFlags) THEN + BEGIN + Print(#3'34.'#3'1 Execution hard/soft : '#3'5'+AOnOff(EventIsSoft IN EFlags,'Soft','Hard')); + Print(#3'35.'#3'1 Error level/shell file: '#3'5'+AOnOff(EventIsShell IN EFlags, + 'Shell file = "'+eventshellpath+'"', + 'Error level = '+IntToStr(EventErrorLevel))); + Print(#3'36.'#3'1 Scheduled day(s) : '#3'5'+AOnOff(EventIsMonthly IN EFlags, + 'Monthly - Day = '+IntToStr(EventDayOfMonth), + 'Weekly - Days = '+DActive(EventDays))); + (* + Print(#3'37.'#3'1 Start time : '#3'5'+ShowTime(EventStartTime)); + *) + Print(#3'38.'#3'1 Phone status : '#3'5'+AOnOff(EventOffHookTime <> 0, + 'Off-hook ('+IntToStr(eventpretime)+' minutes before the Event)', + 'Remain on-hook')); + Print(#3'39.'#3'1 Executed today : '#3'5'+ShowYesNo(EventLastDate = DateStr)+' ' + +AOnOff(EventIsActive IN EFlags, + '(Next scheduled date:'+EventLastDate+' - in ??? minutes)', + '(Not scheduled for execution)')); + END + ELSE + BEGIN + Print(#3'34.'#3'1 Scheduled day(s) : '#3'5'+AOnOff(EventIsMonthly IN EFlags, + 'Monthly - Day = '+IntToStr(EventDayOfMonth), + 'Weekly - Days = '+DActive(EventDays))); + (* + Print(#3'35.'#3'1 Time active : '#3'5'+ShowTime(EventStartTime)+' to '+ + ShowTime(EventFinishTime)); + *) + Print(#3'36.'#3'1 Permission/restriction: '#3'5'+AOnOff(EventIsPermission IN EFlags, + 'Permission','Restriction')); + Print(#3'37.'#3'1 Logon/chat : '#3'5'+AOnOff(EventIsChat IN EFlags,'Chat','Logon')); + Print(#3'38.'#3'1 Affected message : "'#3'5'+eventqualmsg+#3'1"'); + Print(#3'39.'#3'1 Unaffected message : "'#3'5'+eventnotqualmsg+#3'1"'); + NL; + Print(' '#3'4<<<'#3'5 Qualifiers '#3'4>>>'); + NL; + Print(#3'3A.'#3'1 Baud rate range : '#3'5'+AOnOff(BaudIsActive IN EFlags, + IntToStr(LoBaud)+' to '+IntToStr(HiBaud), + '<>')); + (* + Print(#3'3B.'#3'1 SL range : '#3'5'+AOnOff(SlIsActive IN EFlags, + IntToStr(LoSl)+' to '+IntToStr(HiSl), + '<>')); + Print(#3'3C.'#3'1 DSL range : '#3'5'+AOnOff(DslIsActive IN EFlags, + IntToStr(LoDsl)+' to '+IntToStr(HiDsl), + '<>')); + *) + IF (EventIsPermission IN EFlags) THEN + Print(#3'3D.'#3'1 Maximum time : '#3'5'+AOnOff(TimeIsActive IN EFlags, + IntToStr(MaxTimeAllowed), + '<>')); + Print(#3'3E.'#3'1 AR flag required : '#3'5'+AOnOff(ArIsActive IN EFlags, + ArFlagRequired, + '<>')); + IF (EventIsPermission IN EFlags) THEN + BEGIN + Print(#3'3F.'#3'1 Set AR flag : '#3'5'+AOnOff(SetArIsActive IN EFlags, + SetArFlag, + '<>')); + Print(#3'3G.'#3'1 Clear AR flag : '#3'5'+AOnOff(ClearArIsActive IN EFlags, + ClearArFlag, + '<>')); + END; + Print(#3'3H.'#3'1 UL/DL ratio check: '#3'5'+AOnOff(InRatioIsActive IN EFlags, + 'Active', + '<>')); + END; + END; + IF (EventIsExternal IN EFlags) THEN + BEGIN + EventTypeStr := 'EXTERNAL'; + UserCmds := ''; + OneKCmds := 'Q123456789'; + END + ELSE + BEGIN + EventTypeStr := 'INTERNAL'; + IF (EventIsPermission IN EFlags) THEN + BEGIN + UserCmds := ',A-H'; + OneKCmds := 'ABCDEFGH'; + END + ELSE + BEGIN + UserCmds := ',A-C,E,H'; + OneKCmds := 'ABCEH'; + END; + END; + NL; + Prt('Modify '+EventTypeStr+' event: (1-9'+UserCmds+',Q=Quit): '); + OneK(Cmd1,'Q123456789'+OneKCmds); + IF (Cmd1 IN ['2','4'..'9','E'..'G']) THEN + NL; + CASE Cmd1 OF + '1' : BEGIN + ToggleEventFlag(EventIsExternal,EFlags); + Changed := TRUE; + END; + '2' : BEGIN + Prt('New description: '); + Mpl(32); + InputWn1(EventDescription,32,[],Changed); + END; + '3' : BEGIN + ToggleEventFlag(EventIsActive,EFlags); + Changed := TRUE; + END; + '4' : IF (EventIsExternal IN EFlags) THEN + BEGIN + ToggleEventFlag(EventIsSoft,EFlags); + Changed := TRUE; + END + ELSE + BEGIN + Prt('Schedule: (D:aily,M:onthly,Q:uit): '); + OneK(Cmd1,'QDM'); + CASE Cmd1 OF + 'D' : BEGIN + IF (EventIsMonthly IN EFlags) THEN + Exclude(EFlags,EventIsMonthly); + REPEAT + NL; + Print('Active Days: '#3'5'+DActive(EventDays)); + NL; + Prt('Toggle day: (1:Mon,2:Tue,3:Wed,4:Thu,5:Fri,6:Sat,7:Sun,Q:uit): '); + OneK(Cmd1,'Q1234567'); + IF (Cmd1 <> 'Q') THEN + IF (StrToInt(Cmd1) - 1 IN EventDays) THEN + Exclude(EventDays,StrToInt(Cmd1) - 1) + ELSE + Include(EventDays,StrToInt(Cmd1) - 1); + UNTIL (Cmd1 = 'Q') OR (HangUp); + Cmd1 := #0; + END; + 'M' : BEGIN + IF NOT (EventIsMonthly IN EFlags) THEN + Include(EFlags,EventIsMonthly); + InputByteWC('Day of the month',EventDayOfMonth,[],1,31,Changed); + END; + END; + Cmd1 := #0; + END; + '5' : IF (EventIsExternal IN EFlags) THEN + BEGIN + Prt('Excution method: (S:hell,E:rrorlevel,Q:uit): '); + OneK(Cmd1,'QSE'); + CASE Cmd1 OF + 'S' : BEGIN + IF NOT (EventIsShell IN EFlags) THEN + Include(EFlags,EventIsShell); + NL; + Prt('Shell file: '); + Mpl(8); + InputWn1(eventshellpath,8,[upperonly],Changed); + END; + 'E' : BEGIN + IF (EventIsShell IN EFlags) THEN + Exclude(EFlags,EventIsShell); + TempB := 255; + InputByteWc('Error Level',TempB,[],0,255,Changed); + EventErrorLevel := TempB; + END; + END; + Cmd1 := #0; + END + ELSE + BEGIN + Prt('Event Start Time (HH:MM): '); + Mpl(5); + Input(TempS,5); + IF (TempS <> '') AND (Length(TempS) = 5) AND (Pos(':',TempS) = 3) THEN + BEGIN + TempW := StrToInt(Copy(TempS,1,2)); + TempW1 := StrToInt(Copy(TempS,4,2)); + IF (((TempW * 60) + TempW1) >= 0) AND (((TempW * 60) + TempW1) <= 1440) THEN + BEGIN + EventStartTime := (TempW * 60) + TempW1; + Changed := TRUE; + END + ELSE + BEGIN + NL; + Print(#3'5Invalid time - Format is HH:MM (24 hour military)'); + END; + END; + NL; + Prt('Event Finish Time (HH:MM): '); + Mpl(5); + Input(TempS,5); + IF (TempS <> '') AND (Length(TempS) = 5) AND (Pos(':',TempS) = 3) THEN + BEGIN + TempW := StrToInt(Copy(TempS,1,2)); + TempW1 := StrToInt(Copy(TempS,4,2)); + IF (((TempW * 60) + TempW1) >= 0) AND (((TempW * 60) + TempW1) <= 1440) THEN + BEGIN + EventFinishTime := (TempW * 60) + TempW1; + Changed := TRUE; + END + ELSE + BEGIN + NL; + Print(#3'5Invalid time - Format is HH:MM (24 hour military)'); + END; + END; + END; + '6' : IF (EventIsExternal IN EFlags) THEN + BEGIN + Prt('Schedule: (D:aily,M:onthly,Q:uit): '); + OneK(Cmd1,'QDM'); + CASE Cmd1 OF + 'D' : BEGIN + IF (EventIsMonthly IN EFlags) THEN + Exclude(EFlags,EventIsMonthly); + REPEAT + NL; + Print('Active Days: '#3'5'+DActive(EventDays)); + NL; + Prt('Toggle day: (1:Mon,2:Tue,3:Wed,4:Thu,5:Fri,6:Sat,7:Sun,Q:uit): '); + OneK(Cmd1,'Q1234567'); + IF (Cmd1 <> 'Q') THEN + IF (StrToInt(Cmd1) - 1 IN EventDays) THEN + Exclude(EventDays,StrToInt(Cmd1) - 1) + ELSE + Include(EventDays,StrToInt(Cmd1) - 1); + UNTIL (Cmd1 = 'Q') OR (HangUp); + Cmd1 := #0; + END; + 'M' : BEGIN + IF NOT (EventIsMonthly IN EFlags) THEN + Include(EFlags,EventIsMonthly); + InputByteWc('Day of the month',EventDayOfMonth,[],1,31,Changed); + END; + END; + Cmd1 := #0; + END + ELSE + BEGIN + ToggleEventFlag(EventIsPermission,EFlags); + Changed := TRUE; + END; + '7' : IF (EventIsExternal IN EFlags) THEN + BEGIN + Prt('Event Start Time (HH:MM): '); + Mpl(5); + Input(TempS,5); + IF (TempS <> '') AND (Length(TempS) = 5) AND (Pos(':',TempS) = 3) THEN + BEGIN + TempW := StrToInt(Copy(TempS,1,2)); + TempW1 := StrToInt(Copy(TempS,4,2)); + IF (((TempW * 60) + TempW1) >= 0) AND (((TempW * 60) + TempW1) <= 1440) THEN + BEGIN + EventStartTime := (TempW * 60) + TempW1; + Changed := TRUE; + END + ELSE + BEGIN + NL; + Print(#3'5Invalid time - Format is HH:MM (24 hour military)'); + END; + END; + END + ELSE + BEGIN + ToggleEventFlag(EventIsChat,EFlags); + Changed := TRUE; + END; + '8' : IF (EventIsExternal IN EFlags) THEN + BEGIN + (* + IF (EventOffHookTime) THEN + EventOffHookTime := FALSE + ELSE + BEGIN + InputByteWc('Minutes before Event to take phone OffHook',eventpretime,[],0,255,3,Changed,TRUE); + EventOffHookTime := TRUE; + END; + *) + END + ELSE + BEGIN + Print('Message/@File if the user is effected by the event'); + Prt(': '); + InputWn1(EventQualMsg,64,[],Changed); + END; + '9' : IF (EventIsExternal IN EFlags) THEN + BEGIN + (* + IF (EventLastDate = DateStr) THEN + EventLastDate := NextDay(EventLastDate) + ELSE + EventLastDate := DateStr; + *) + END + ELSE + BEGIN + Print('Message/@File if the user IS NOT effected by the event'); + Prt(': '); + InputWn1(EventNotQualMsg,64,[],Changed); + END; + 'A' : IF NOT (EventIsExternal IN EFlags) THEN + BEGIN + IF (BaudIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,BaudIsActive); + LoBaud := 300; + HiBaud := 19200; + END + ELSE + BEGIN + Include(EFlags,BaudIsActive); + InputLongIntWoc('Baud lower limit',LoBaud,0,65535); + InputLongIntWoc('Baud upper limit',HiBaud,0,65535); + END; + Changed := TRUE; + END; + 'B' : IF NOT (EventIsExternal IN EFlags) THEN + BEGIN + IF (SlIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,SlIsActive); + LoSl := 'S0'; + HiSl := 'S255'; + END + ELSE + BEGIN + Include(EFlags,SlIsActive); + (* + InputByteWoc('SL lower limit',LoSl,0,255); + InputByteWoc('SL upper limit',HiSl,0,255); + *) + END; + Changed := TRUE; + END; + 'C' : IF NOT (EventIsExternal IN EFlags) THEN + BEGIN + IF (DslIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,DslIsActive); + LoDsl := 'd0'; + HiDsl := 'd255'; + END + ELSE + BEGIN + Include(EFlags,DslIsActive); + (* + InputByteWoc('DSL lower limit',LoDsl,0,255); + InputByteWoc('DSL upper limit',HiDsl,0,255); + *) + END; + Changed := TRUE; + END; + 'D' : IF NOT (EventIsExternal IN EFlags) THEN + IF (EventIsPermission IN EFlags) THEN + BEGIN + IF (TimeIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,TimeIsActive); + MaxTimeAllowed := 60; + END + ELSE + BEGIN + Include(EFlags,TimeIsActive); + InputWordWoc('Maximum time allowed on-line (minutes)',MaxTimeAllowed,0,65535); + END; + Changed := TRUE; + END; + 'E' : IF NOT (EventIsExternal IN EFlags) THEN + BEGIN + IF (ArIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,ArIsActive); + ArFlagRequired := #0; + END + ELSE + BEGIN + Include(EFlags,ArIsActive); + Prt('AR flag required (A-Z): '); + Mpl(1); + OneK(Cmd1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); + ArFlagRequired := Cmd1; + Cmd1 := #0; + END; + Changed := TRUE; + END; + 'F' : IF NOT (EventIsExternal IN EFlags) THEN + IF (EventIsPermission IN EFlags) THEN + BEGIN + IF (SetArIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,SetArIsActive); + SetArFlag := #0; + END + ELSE + BEGIN + Include(EFlags,SetArIsActive); + Prt('AR flag to set (A-Z): '); + Mpl(1); + OneK(Cmd1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); + SetArFlag := Cmd1; + Cmd1 := #0; + END; + Changed := TRUE; + END; + 'G' : IF NOT (EventIsExternal IN EFlags) THEN + IF (EventIsPermission IN EFlags) THEN + BEGIN + IF (ClearArIsActive IN EFlags) THEN + BEGIN + Exclude(EFlags,ClearArIsActive); + ClearArFlag := #0; + END + ELSE + BEGIN + Include(EFlags,ClearArIsActive); + Prt('AR flag to clear (A-Z): '); + Mpl(1); + OneK(Cmd1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); + ClearArFlag := Cmd1; + Cmd1 := #0; + END; + Changed := TRUE; + END; + 'H' : IF NOT (EventIsExternal IN EFlags) THEN + BEGIN + IF (InRatioIsActive IN EFlags) THEN + Exclude(EFlags,InRatioIsActive) + ELSE + Include(EFlags,InRatioIsActive); + Changed := TRUE; + END; + END; + UNTIL (Cmd1 = 'Q') OR (HangUp); + IF (Changed) THEN + BEGIN + Seek(EventFile,SaveRecNum1); + Write(EventFile,Events); + Changed := FALSE; + END; + END; + END; + END; + +BEGIN + Reset(EventFile); + REPEAT + CLS; + (* + TStr(419); + *) + Abort := FALSE; + RecNum := 1; + WHILE (RecNum <= NumEvents) AND NOT (Abort) AND NOT (HangUp) DO + BEGIN + Seek(EventFile,RecNum); + Read(EventFile,Events); + WITH Events DO + PrintaCr(PadRightInt(RecNum,3)+ + ' '#3'2'+PadRightStr(AOnOff(EventIsActive IN EFlags,'YES','NO'),6)+ + ' '#3'5'+PadRightStr(EventDescription,32)+ + ' '#3'3'+AOnOff(EventIsExternal IN EFlags,'External','Internal')+ + (* + ' '#3'0'+ShowTime(EventStartTime)+ + *) + (* + ' '#3'0'+AOnOff(EventIsExternal in EFlags,'-----',ShowTime(EventFinishTime))+ + *) + ' '#3'4'+AOnOff(EventIsMonthly IN EFlags,'Day = '+IntToStr(EventDayOfMonth),DActive(EventDays))); + Inc(RecNum); + END; + IF (NumEvents = 0) THEN + Print('No Events Defined.'); + NL; + Prt('Event Editor: (D:elete,I:nsert,M:odify,Q:uit): '); + OneK(Cmd,'QDIM'); + CASE Cmd OF + 'D' : BEGIN + RecNum := -1; + InputIntegerWoc('Event number to delete',RecNum,1,NumEvents); + IF (RecNum <> -1) THEN + BEGIN + Seek(EventFile,RecNum); + Read(EventFile,Events); + NL; + Print('Event: '+Events.EventDescription); + NL; + IF PYNQ('Are you sure you want to delete it',0) THEN + EventRecordDelete(RecNum); + END; + END; + 'I' : IF (NumEvents = MaxEvents) THEN + BEGIN + NL; + Print('No more then '+IntToStr(MaxEvents)+' events can exist.'); + PauseScr(FALSE); + END + ELSE + EventRecordInsert(FileSize(EventFile)); + 'M' : EventRecordModify(RecNum); + END; + UNTIL (Cmd = 'Q') OR (HangUp); + Close(EventFile); +END; + +END. + diff --git a/SOURCE/UNUSED/SYSOP7.TPU b/SOURCE/UNUSED/SYSOP7.TPU new file mode 100644 index 0000000..a8d9a1a Binary files /dev/null and b/SOURCE/UNUSED/SYSOP7.TPU differ diff --git a/SOURCE/UNUSED/SYSOP7M.TPU b/SOURCE/UNUSED/SYSOP7M.TPU new file mode 100644 index 0000000..3f8a4de Binary files /dev/null and b/SOURCE/UNUSED/SYSOP7M.TPU differ diff --git a/SOURCE/UNUSED/SYSOP8.TPU b/SOURCE/UNUSED/SYSOP8.TPU new file mode 100644 index 0000000..1fa1695 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP8.TPU differ diff --git a/SOURCE/UNUSED/SYSOP9.TPU b/SOURCE/UNUSED/SYSOP9.TPU new file mode 100644 index 0000000..060f020 Binary files /dev/null and b/SOURCE/UNUSED/SYSOP9.TPU differ diff --git a/SOURCE/UNUSED/TAGLINE.DAT b/SOURCE/UNUSED/TAGLINE.DAT new file mode 100644 index 0000000..b5afb08 --- /dev/null +++ b/SOURCE/UNUSED/TAGLINE.DAT @@ -0,0 +1 @@ +J12345678901234567890123456789012345678901234567890123456789012345678901234 \ No newline at end of file diff --git a/SOURCE/UNUSED/TAGLINE.EXE b/SOURCE/UNUSED/TAGLINE.EXE new file mode 100644 index 0000000..33d04d9 Binary files /dev/null and b/SOURCE/UNUSED/TAGLINE.EXE differ diff --git a/SOURCE/UNUSED/TAGLINE.PTR b/SOURCE/UNUSED/TAGLINE.PTR new file mode 100644 index 0000000..db3ae0e Binary files /dev/null and b/SOURCE/UNUSED/TAGLINE.PTR differ diff --git a/SOURCE/UNUSED/TAGLINE.TXT b/SOURCE/UNUSED/TAGLINE.TXT new file mode 100644 index 0000000..3b3358d --- /dev/null +++ b/SOURCE/UNUSED/TAGLINE.TXT @@ -0,0 +1,2184 @@ +All's well that ends well - E. A. Poe +All's well that ends well. -Poe. Bother. -Pooh. +Always avoid the inevitable +Always be sincere, even if you don't mean it. +Always be smarter than the people who hire you. +Always remember where you came from so you can return. +Always store beer in a dark place - Heinlein +Always tell her she is beautiful. +Am I The Only One With A Salami In His Trenchcoat? +America, worst nation in the world save for all the rest. +American by birth - Southern by the grace of God. +An atheist has no invisible means of support. +An attacker must vanquish, a defender need only survive. +An empty stomach is not a good political advisor. +An evil man is snared by his own sin. +An expert is someone from out of town. +An eye for an eye leaves the whole world blind - Ghandi +An honest politician is one who STAYS bought! +An idea is not responsible for fools who believe in it. +An interstellar war can ruin your whole day. +Anarchy is against the law. +ANARCHY.COM -> (A)bort, (R)etry, (O)verthrow System +Anatomically Correct beats Politically Correct any day. +Ancient Chinese curse:"May you live in interesting times" +Ancient Evil In Training +And now for something completely different. +And now we return you to your (ir)regular conference... +And on the 8th Day God said, "Murphy, you're in charge." +And Satan said to God,"But where will you get a lawyer?" +And she disappeared in a puff of logic. +and that is how we know the Earth is banana-shaped +and then the fun began - N. Bonaparte +And then you typed 'G=C800:5', right? +And they said unto Jesus, "How the Hell did you do that?! +And who decides what is just? Who decides what is right? +and you were expecting something profound & witty? +And, pray tell, whose imagination are you a figment of? +Angels and ministers of grace offend us! -- Snakespeare +Annoy a liberal: Ask them to be truthful. +Another casualty of the seduction of art. - Hobbes +Another good mind not yet ruined by higher education! +Antelope Freeway, 1/64 mile. +Antifloccinaucinihilipihilificationism rules ok! +Any priest or shaman may be presumed guilty until proved innocent. - RAH +Any sufficiently advanced magic looks like technology! +Any system that relies on human reliability is unreliable +Anybody seen the internet around here? +Anyone ever found a use for those tractor feed cutouts? +Anyone who says he can see through women is missing a lot +Anything free is worth what you pay for it. +Anything not a constant, is not a commandment from God. +Anything that kills you makes you... well, dead. +Anything you say will be misquoted and used against you. +Apathy Error: Don't Bother Striking Any Key +Applicants wanted! - Darth Vader School of Management +Archaeologist: one whose career lies in ruins +Are the noises in my head bothering you? +Are you implying that coconuts are migratory? +Are you suggesting that coconuts are migratory? +Are you telling me a 686DX/200 is ALL you got ? +Are you using Windows, or is that just an XT? +Argue if you must, just remember I'm right +Arguments with furniture are rarely productive. +Artificial Intelligence is no match for Natural Stupidity +As confused as a termite in a yo-yo +As of next week, passwords will be entered in Morse code. +Ask me anything: if I don't know, I'll make up something. +Ask me no questions, I'll tell you no lies... +Asphault = Proctologist's malpractice insurance +Assist: v. To increase the factor of incompetency by 1. +Assumption is the mother of all screwups. +At last, the Eludium Q36 explosive space modulator +Atheism is a non-prophet organization. +Attend Miskatonic U. - Why study >lesser< evils? +Auntie Em: Hate you, Hate Kansas. Taking the dog. +Auntie Em: Hate you. Hate Kansas. Took the Dog. Dorothy. +Avoid hangovers - stay drunk +Avoid morning breath... Sleep till noon! +Avoidence - Surrender, Confrontation - Attack +Ay, every inch a king. - King Lear +B: not found, formatting other drives instead.... +Back from the shadows again ... +Back off man, We're scientists!!! +Backup aborted: Please remove disk #92 and start over... +Backup Initiated: Insert disk 1 of 1362. +Backup not found: (A)bort (R)etry (P)anic +Bad Command or Filename. Or maybe you screwed up. +Bagpipes are just Hell's way of giving hints. +Ban the bomb. Save the world for conventional warfare. +Barney:What happens when you feed a smurf after midnight. +Basic programmers never die, they gosub and don't return. +Basic Vampire: If it screams, it's not food... yet. +Bathing beauty: A girl worth wading for +BBS: a method to triple your phone bill. +Be creative - invent a perversion! +Be moderate in all things, including moderation... +Be spontaneous.......combust. +Beam me up, Scotty; this ISN'T the ladies' room! +Beam's Choice Green Label -- It's SMOOTH!!!! +Beauty is in the eye of the beer holder..... +Been there, done that, got the mouse mat. +Been there. Done that. Jumped bail. +Been through Hell?? and what did you bring me?? +Beer is Better: Beer is always in season. +Beer. It's not just for breakfast anymore! +BEERWARE: If it works, buy yourself a beer. +Before making a backup copy, first destroy the original +Before you see the light, you must die. +Beheading: The ultimate loss of face. +Behind every successful man--a surprised mother-in-law. +Being common isn't one of my strengths. +Being human does have certain advantages. +Being ignorant isn't your fault, staying ignorant is. +Being in beta means never having to say you're sorry. +Being paranoid doesn't mean they aren't out to get you. +Believe the road goes on forever and the party never ends. +Ben Dover & C. Howit Feels -- Attorney's at law +Best cure for a case of nerves is a case of beer. +Best file compression around! "DEL *.*" - 100% comp. +Best thing about the future: it comes one day at a time. +Better taglines through confiscation. +Better than a poke in the eye with a stick. +Between two evils, always pick one you never tried before +Beware False Messengers, and Trust Only Your Enemies. +Beware of a tiger in its lair or a moderator in his echo +Beware of programmers who carry screwdrivers. +Beware! This is a dangerous product, manuals required. +Big or small We tax them all. +Big toe: Feature on man to accommodate coroner's tag. +Bigomy: one wife too many. Monogamy: same idea. +Bigot: Anyone who's winning an argument with a liberal +Bill your doctor for the time spent in the waiting room +Billy Bob's Road Kill Cafe - You kill'em, we grill'em. +Bio-Genetix Eng. Labs: "Playing God so you don't have to" +Birds of a feather fluck together. +Black holes are big attractions. +Black Holes are what happens when God divides by Zero +Black holes suck. +Blended coffee...todays & yesterdays. +Blessed are the censors: For They Shall Inhibit the Earth +Blessed are the censors; they shall inhibit the earth. +Blessed are the meek, for they make great scapegoats. +Blessed are the pessimists, for they hath made backups +Blood is thicker than water, and much tastier. +Blow, winds, and crack your cheeks! Rage! Blow! +Bluff means never having to sway your story. +Bo knows your girlfriend..... +Boring women have immaculate homes +Bork was a dork... that's not too political, is it? +Borrow money from pessimists. They don't expect it back. +Bought some powdered water.....What do I add?? +Boy, this Soylent Green tastes great! What's the recipe? -SLR +Brain damage? No thanks, I already have some. +Brain Disengaged; Call Back Tomorrow. +Brain the size of a planet and I have to talk to humans. +Brains...BRAINS! Fresh brai... oh, wrong conference. +Breaking Windows isn't just for kids anymore... +Bring on the dancing girls! +Bring order to your life, use random numbers. +Brought to you by your local SPAM Appreciation Society. +BS (bee ess): n. An uninformed statement. +Budweiser: Breakfast of Champions +Bug removal Tagline. Bang forehead here to debug---->@@ +Bureau of Natural Disasters - Planning Division +Burn the flag. Burn the bra. Burn the bridges behind you. +Burned out but still glowing! +Burning houses simply helps keep me from going Sane, Doc. +But honey, we can afford it, I sold your car +But Honey, you NEED VGA for Dbase management! +But I thought YOU did the backups! +Butcher the Intelligensia in the name of Sanity! +Buy a Pentium so you can reboot Windows faster! +Buy OS/2: Keep Bill Gates on his toes. +By all means, let's not confuse ourselves with the facts. +By Pendragon's sword the Dark shall fall. +C A U T I O N - I drive the same way you do. +C program run. C program crash. C programmer quit. +C-4 works much better than a hammer when things get stuck +C:\CATHOLIC\VATICAN.EXE: Okay program, but no updates, _ever_. +C:\DAMSEL.EXE x-linked with DISTRESS.COM. RESCUE? (y/n?) +Caffeine is my only *real* friend... +CALCULUS..... the agony and dx/dt. +Call me Ishmael. I won't ANSWER, but.. +Calm down. It's only ones and zeros. +Can I trade in this life for a full refund? +Can you believe that thing is STILL moving? +Can you hold this grenade a second, I dropped the pin... +Can you repeat the part after "Listen very carefully" +Canadian Dos prompt= "Like,Insert Disk #1,eh" +Cannibals send out for pizza boys. +Carefull, we might be landing on your street +Carpenter's Rule: Cut to fit; beat into place. +Catch the Blue Wave! +Cats--the ultimate agents of Entropy. +Caution: I drive using The Force +CCITT- Can't Conceive Intelligent Thoughts Today +Cease & Desist citizen, or I'll reduce your head to a fine mist. +Celebrate your freedom: Read a banned book. +Celtic Magic? Didn't he play basketball??? +Cement shoes, dirt cheap; ask for Guido. +Chance makes our parents, but choice makes our friends. +Change is inevitable...except from a vending machine. +Chaotic Evil means never having to say your sorry. +CHASTITY: The most unnatural of sexual perversions. +Chat mode is DISABLED during Quantum Leap +Cheap fuses are protected by expensive chips +Cheer Up! Things are getting worse at a slower rate. +Chef: (shef) A cook who swears in French. +Chicago: Vaporware of the desperate and scared +Children: the most common sexually transmitted disease. +Chile today. Hot tamale. +Chili, the national food ... Fart, the national odor. +Chivalry is not dead - it's on life support. +Choking on another Xanth novel? Try the Heinlein Maneuver +Christmas is coming, the geese are getting *very* worried +Chthulhu calls his shots. +CIA Motto: In God we trust, all others we polygraph +City Morgue: You stab 'em, we slab 'em. +Clean this stuff up or we'll all wind up in jail! +Climate is what we expect. Weather is what we get. - Heinlein +Clowns to the left of me, Jokers to the right, here I am. +CMOS: Commonly Misunderstood Option Switches +Cold as Night, Dark as Death +College is just high school with ashtrays... +College's don't make fools; they only develop them +Columbus HAD a fourth ship--it sailed over the edge. +Combat gear doesn't make a man..... +Come on Mr. Krinkle tell me why... +Come on! There's plenty of room out here on this limb! +Command Not Understood. . . Now erasing Hard Drive +Commercial Software - The Devils payback! +Committee: a lifeform with 12 legs and no brain. +Communism is like one big phone company. +Compile, run, curse. Recompile, rerun, recurse. +Computer Excuse #3: Systems analyst needs psychoanalyst +Computer Hacker Wanted. Must have own axe. +Confuse your local coroner ... die happy. +Congress Virus: Overdraws disk space, won't release files +Congress's road to h*ll is now a 4 lane highway +Congress:"They have what it takes to take what you got" +Conspiracy can never replace simple stupidity. +Consult with a real expert - Call your mother. +Consult with an Expert - Call your Mother. +CONSULTANT: Person who makes good on salesman's promises +Contains less than 2% U.S. RDA for this echo +Contraceptives: to be used on all conceivable occasions. +Cover me. I'm going to change lanes. +Crackpot can't play, he's working on his thesis. +Cream rises to the top... but then, so does scum... +Create opportunities week. Blackmail a senior executive. +Creativity is great, plagiarism's faster. +Crime wouldn't pay if the government ran it. +Crime, Sex, Alcohol, Drugs... God, I love Congress! +Criminal lawyer?...Isn't that redundant? +Crossbows don't kill people; quarrels kill people. +Cry "ribbit" and let slip the frogs of war! +Cthulhu calls.........COLLECT! +Cthulhu in '96: why settle for the LESSER evil? +Cthulhu loves you...on a Ritz cracker. +Cthulhu loves you...on a sesame bun. +Cthulhu loves you...with a tossed salad and white wine. +Cthulhu loves you...with an apple in your mouth. +Cthulhu Saves! ... in case he's hungry later. +Cthulhu saves... passes to Hastur... the crowd goes mad!! +Cthulu for President: Why settle for the Lesser Evil?? +Cthulu fthagn! Cthulu fthagn! Cthulu fthagn! Oh, wow, that really ... +Cure for postal strikes: mail them their strike pay. +Curiosity didn't kill the cat, my 12 gauge did.. +Curiosity didn't kill the cat. I got `em with the mower! +Curiosity killed the cat, but for a while I was a suspect +Cursor: What you become when your system crashes. +Custer was fitted for an Arrow shirt. +Cut my pizza into six pieces please. I can't eat eight. +cyberpunk (si'-ber-punk) n. - a computer with an attitude +Damn it Jim, I'm an Alzheimer's patient, not a...uh...uh. +Damn the documentation, full speed ahead! +Darth Vader: Robert Dole's long-lost half brother. +Dawn: The time when people of reason go to bed. +Dead reckoning: The method of navigation by a driver. +Death before dishonor and either before soap operas. +Death before dishonor, neither before breakfast. +Death Comes as the end... +Death is not the end; there remains the litigation. +Death, Life, and Infinite are the only constants. +Decadent Capitalist and proud of it! +Deep down...I'm really a pretty superficial kind of guy. +Def. of a beetle : A fly on steroids. +Def. of Upgrade: Take old bugs out, put new ones in. +Defeat may test you. It need not stop you. +Define the universe. Give three examples. +Deicide - The Extinction of All That's Holy........ +Democracy-A catchword used by Democrats and Republicans +Demons are a Ghouls best Friend. +Deny everything - remove all evidence - & make counter-accusations! +Department of Redundancy Department +Desperate times call for cheap shots. +Despite the high cost of living, it remains popular. +Detour: The roughest distance between two points. +Diagonally parked in a parallel universe. +Did you hear that? They've shut down the main reactor! +Didn't I meet you in some other hallucination?? +Die: To stop sinning suddenly. +Difference between a virus & windows? Viruses never fail. +Difference between Genius & Stupidity? Genius has limits. +Digital circuits are made from analog parts. +Dime: a dollar with all the taxes taken out. +Ding, Dong the Lich is dead +Dip it in chocolate, it'll be fine. +Diplomacy is saying "nice doggy" until you find a rock. +Diplomacy: The art of letting someone else get your way. +Diplomacy: The patriotic lying for one's country. +Dirty Old Men: Men who haven't quite given up women yet.. +Disclose classified information only when a NEED TO KNOW +Discoveries are made by not following instructions, +Divers do it deeper and stay down longer. +Divorce is not an effective deterrent to marriage. +Do cross-eyed dyslexics read normally? +Do Files get embarassed when they are unzipped? +Do I even WANT ancestors? Some of those I found I wish I could lose. +Do I ice her? Do I marry her? Which wunna deez? +Do it tommorrow. You've made enough mistakes for one day +DO NOT ADJUST YOUR MIND - the fault is with reality. +Do Not Attempt to Traverse a Chasm in Two Leaps +Do not look in laser with remaining eye. +Do unto others BEFORE they do unto you! +Do Winchesters sneeze when they catch a virus? +Do you multitask or just run Windoze? +Do you prefer gin and platonic or scotch and sofa? +Docs? We don need no stinkeeng docs! +Docs? Who wants to look at the Docs. Nurses are better... +Docs? Why would I want to look at the Docs. Nurses are better :) +Doctors bury mistakes. Architects plant ivy. +Documentation - The worst part of programming. +Documentation is for people who can't read. +Documentation is for wimps who cant read listings or the object code. +Does "PIRATE" software come with a treasure map? +Does a Kzin fear to follow where a Puppeteer leads? +Does history record any case in which the majority was right? - Heinlein +Does killing time harm eternity? +Does Microsoft mean "small and limp"? +Does the term 'Rational Anarchist' ring a bell? +Doing strange things in the name of art. +Don't 'yield' to temptation. Go and hunt it down... +Don't be sexist. Broads hate that. +Don't be silly... of course we'll survive... +Don't be stupid; of *course* we intend to resist you! +Don't bother pressing that key. There is no Esc. +Don't bother pushing that key. There is no Esc +Don't call me a sexist, you bimbo! +Don't call me ignorant, you supercilious twit. +Don't confuse me with facts. +Don't crush that dwarf, hand me the pliers! +Don't drink and park...Accidents cause people. +Don't give me that "kinkier than thou" attitude ...! +Don't just stand there...KNEEL!! +Don't let me get too deep. It's already too deep in here. +Don't let school interfere with your education. +Don't look at me in that tone of voice! +Don't look conspicuous-it draws fire. +Don't look for flaws as you go through life. +Don't meddle in the affairs of Wizards... +Don't mess with the Zombie, @TO@ +Don't push it, you fool! That's the History Eraser button! +DON'T read the manual! Just WING that sucker! +Don't run away, it's only me... +Don't steal...the government hates competition. +Don't take criticism from just anybody. +Don't take life seriously...it isn't permanent. +Don't take life seriously; You won't get out alive anyway +Don't take life so seriously. It's not forever. +Don't tell me how hard you work. Tell me how much you get +Don't try to have the last word. You might get it. - Heinlein +Don't use a big word where a diminutive one will suffice. +Don't vote - it only encourages them. +Don't worry . . . everything is out of control +Don't worry, I'm fluent in weirdo +Don't worry, Inspector. Just a swamp cult, no big deal... +Don't worry... It's under warranty. +Dorothy- hate OZ, took shoes, find your own way home Toto +DOS Perot: you boot, it decides whether it wants to run. +Dracula was a vein man... +Drag me, drop me. Treat me like an object. +Dragon? What dragon? You said we were looking for a worm. +Dragons: Friendly Toasters. +Drilling for oil is boring. +Drink till she's cute. Stop before you get married. +Drink your coffee! There are people in India sleeping. +Drive A: format failed. Restarting with drive C:. +Drive defensively. Buy a tank. +Drugs: n - Substance Programmers use while programming. +Duct tape, not The Force, holds the universe together. +Dude did you see her? I think I'm pitching a tent! +Due to inflation, all clouds will now be lined with zinc. +Dumb luck beats sound planning every time. Trust me. +Dusk lures like a lyre beckoning the quietude +Dyslexics of the world untie! +Early to bed, early to rise; makes people suspicious. +Earn cash in your spare time -- blackmail your friends. +Earth is 98% full...please delete anyone you can. +Earth: mostly harmless. +Eat Healthy, Exercise, and Die Anyway... +Eat more lamb. 10,000,000 coyotes can't all be wrong. +Eat the rich - the poor are tough and stringy. +Eat yogurt and get cultured. +Egad, I believe I've blown another synapse. -SLR +ELECTROCUTION : High Tech Burning at the Stake! +Employees are instructed to restrict their orgasms to the lunch hour. +End rush-hour traffic now! Legalize vehicular weaponry! +Enter any 12-digit prime number to continue. +Equal Opportunity: The prospect of pillage for the meek +EROTIC: using a feather. KINKY: using the whole duck! +Eternity? Straight ahead, turn left at infinity. +Ettore's law: the other line always moves faster +Eval Day 1,094,583,217 * I Support Shareware! +Eval Day 15 * Assimilate culture? (Y/n) +Even after fusion, confusion remains. +Even Ockham occasionally cut himself shaving. +Even the boldest zebra fears the hungry lion. +Ever meet a Sysop who would admit the problem was his? +Ever notice how much Cheeze Whiz resembles silicone caulking? +Every absurdity has @TO@ to defend it. +Every absurdity has a champion to defend it. +Every child should be given the desire to learn. +Every girl's crazy 'bout a sharp dressed man. +Every morning is the dawn of a new error... +Every saint has a past and every sinner a future - Wilde +Every Silver lining has a clone around it. +Every solution breeds new problems. +Every sun has a golden lining +Every time a Country singer dies, ten more pop up. +Every time I use a MicroSoft product I feel "dirty." +Everybody lies about sex. - Robert A. heinlein +Everybody loves a moose; they just don't know it. +Everybody must believe - I believe I'll have another beer +Everyone has a photographic memory, some just don't have any film. +Everyone hates me because I'm paranoid. +Everyone is entitled to my opinion. +EVERYONE is weird...some of us are proud of it. +Everything @TO@ does is needlessly violent. +Everything flows and nothing stays. -- Heraclitus +Everything I do is needlessly violent. +Everything I like is illegal, immoral or expensive! +Evolution is God's way of issuing updates. +Excuse me while I change into something more formidable. +Excuse me while I crouch down behind my asbestos shield. +Excuse me, did you say something? +Exercise before kinky sex . . . be fit to be tied. +Experience is directly proportional to ruined equipment +Experience=a name everyone gives to his mistakes. +Experiencing synaptical difficulties; Please stand by. +Explain counter-clockwise to someone with a digital watch +Extinct species will never be Born Again. +Extra Credit: Define the universe. Give 3 examples. +Extreme Conditions Demand Extreme Responses. +Exxon - greasing the coastline for smoother boating! +Eye of newt, toe of frog, and a side order of fries +Face reality; yet, indulge yourself in fantasy and fairy tales. +Fact. Stranger than any science fiction. +Facts, though interesting, are irrelevant. +Fahr-ferg-nug-en: German for "Can't afford the Mercedes." +Failure reading left hemisphere bort etry rolic? +Failure: The path of least persistence. +Falling ego zone. Keep ID covered at all times. +Famous Last Words - "The backups can wait." +Famous Last Words: Look, I'm driving with my eyes closed! +Famous words, "Trust me, I'm a consultant" +Fanatics do everything with unmatched dedication. +Fasten your seat belt--I wanna try something. +Faster horses, Younger women, Older whiskey, More Money! +Fatal Error: Size Of Thought Exceeds Available Memory. +Fatal Error: User Executed +Fear not, for I have given you authority +Fear the Stark Fist of Removal. +Features should be discovered, not documented +Feel lucky???? Update your software! +Few hours in life are more agreeable than afternoon tea +Fight crime....shoot back +Fight Crime: Shoot a politician +File not found. Delete *.* and change directory? (Y/N)_ +Fingers not found - Pound head on keyboard to continue. +Finish the project. We'll buy you a new family. +First listen to sermon, THEN eat missionary. +First rule of adaption: only when evolving. +First rule of marriage: If YOU'RE Right, APOLOGIZE FAST! +First, push the button. Then find out what it does. +First, we'll kill all the programmers +Flying is not dangerous.... CRASHING is dangerous. +Food, glorious food. Hot sausage with mustard.... +Fools fight one another, but wise men agree together. +For a good time, don't call me. +For all my dreams are haunted by a fire on the moon. +For God's sake get the hell off... she's dead, Jim! +For Reply, send a self-abused stomped Antelope to... +FOR SALE: Used Dyson sphere, needs work. Priced to sell. +For sincere personal advice, page your sysop at 3 A.M. +For those who like peace & quiet: a phoneless cord. +For yerz ago i cudent evin spel injuneer. Now i are one +Forego novocaine: Transcend dental medication. +Forget patience! I'm gonna kill something... +Forget the manual, phone the author at home! +Forgive your enemies but never forget their faces +FREE PRIZE! NO PURCHASE NEEDED! (Details inside box) +Friends come and go, but enemies accumulate. +Friends don't let friends use Prodigy +Friends: People who dislike the same people we do. +From IRS Agents that go bump in the night, deliver us. +From the pastor of the 1st Church of Electron Flux +Fun with Greek #4: Fee, �, fo, fum! +Funny how life imitates LSD... +Funny, only sensible people agree with me. +Furry Weddings are were "groom" is a verb, not a noun +Gargling twice daily is a good way to see if your neck leaks. +Gee, Mr. Wizard! Aren't nuclear reactors dangerous? +Geee, is that what static electricity does to cpu chips? +Genetic engineering: heir styling. +Genius is ten percent inspiration and 50% capital gains. +Gentleman: One who can play bagpipes but chooses not to. +Get a taste of religion. Bite a preacher. +Get the facts first - you can distort them later ! +Getting caught is the mother of invention. +Ghosts are merely unsubstantiated roomers. +Gimme $50 Or I'll Call Your Religion A Cult. +Gimme a match, I think my gas tank is empty. +Give 'em a fair trial, then hang 'em! +Give me a gun and I'll kill all the liberals. +Give my lawfirm a call sometime: Dewey, Cheetum & Howe. +Give sadists a fair crack at the whip. +Give up, you'll only live till you die. +Go ahead, jump. 100,000 lemmings can't be wrong. +Go ahead, speak your mind! I'll enjoy the silence. +Go climb a gravity well. +God created all men. But Sam Colt made them equal. +God created anchovies. Satan put them on pizza. +God fights on the side with the heaviest artilliary.--RAH +God isn't dead, he just couldn't find a parking place. +Good aim means never having to say you're sorry. +Gosh I miss George. Heck, I even miss Jimmy! +Gotta run. My neighbors just sighted Elvis making crop circles. +Government - the only vessel known to leak from the top +Government Tagline. Takes up space, no known function. +Government: we can't do that, it makes too much sense. +Graduate of the Mad Max School of Defensive Driving +Great minds always meet at infinity. +Great minds twist alike. +Great! She's naked and I forgot the rope!! +Great; Custer had a plan, too. +Gross Ignorance: 144 times worse than ordinary ignorance. +Growing old is mandatory... Growing up is optional. +Guilt trips: the nuclear weapon of relationships. +Gun control is not about guns; it's about control. +Gun Control means .174" @ 100yds. +Gun Control means using 2 hands +Gunpowder and alcohol DO mix - but it tastes awful! +Guns don't kill people. I kill people. +Guns don't kill people. Moderators do. +Guns don't kill people. Moderators kill people. +Guns don't kill. Fast-moving projectiles do. +Guru Meditation Error -- Insufficent User +H*LL (n): Backing up a 600 meg drive with 360K floppies +H*ll hath no fury like a woman scorned. +H*ll, if I was sane why would I be here? +Hand me that dolphin burger. Yeah, the one in styrofoam. +Hand me that planet, will you? +Hard Work never killed anyone, so why chance it? +Has that file been saved? No, but we're praying for it. +Have a nice day - unless you've made other plans +Have an affair. It will help break up the monogamy. +Have I ever claimed to be sane? +Have no fear - I never attack lesser beings. +Have you clubbed an ignorant human today? +Have you clubbed an ignorant kitten today? +Have you crashed your Windows today? +Have you hugged an electric fence today? +Haven't you got any pleasant facts I can face? +HD Crash: (A)bort,(R)etry,(S)tart Self-Destruct Sequence +He did say cleared for final ......didnt he ??? +He died to take away your sins, not your mind. +He does the work of 3 Men...Moe, Larry & Curly +He has a train of thought. You have a tricycle... +He has all the charm of a dirty Christmas card. +He isnt dead; He's electroencephalographically challenged +He knows little who will tell his wife all he knows +He ran for the curb but I bagged him before he made it. +He said "KUNG FU!" I said "M-16." He said "Peace Brother" +He stalks to the beat of a violent state of time .. +He was ever greater than his opportunities. +He who dies with the highest upgrade wins. +He who has never hoped can never despair. -- G.B. Shaw +He who hesitates is trampled by the mob. +He who laughs last probably backed up his hard disk... +He who lives by the sword gets shot with a AK47 +He who steps on others to reach the top has good balance. +He'll feel a lot better once we robbed a couple banks. +He's a SOB -- but at least he's *our* SOB. +He's dead Dave, everyone's dead, everyone is dead Dave! +He's dead Jim, kick him yourself and see. +He's dead, Jim; kick him yourself if you don't believe me. +He's not a lousy pilot, he's gravitationaly challenged. +He's not a politician; he's just ethically challenged. +He's not dead, Jim. He's just considering moving to Seattle. +He's not drunk; He's neurologically challenged. +Headline: War dims hope for peace. +Health tip: Red meat IS good. Blue fuzzy meat is BAD. +Heaven doesn't want me & Hell's afraid I'll take over. +Heavy rain: What you get 2 hours after washing your car. +Hee, hee, eees beeg trouble for moose and squirrel... +Heisenberg really wasn't certain about this. +Heisenburg slept here... or did he? +Helicopters don't fly; they beat the Air into Submission. +Hell hath no fury like the lawyer of a woman scorned +Hell hath no fury like vested interest masquerading as moral principle. +Hell hath no misery like a backup ignored. +Hell is empty... but our Congress is full. Hmmm........ +Help fight against a cure for nymphomania. +Help Prevent Birth Defects; Castrate a RedNeck! +Here is my fist, please run towards it very fast. +Here, doggie. Chase the nice stick of dynamite. +Here, you go first, you're immune to bullets. +Hermits have no sense of peer pressure. +Hero for Hire - Dragons Slain. +Hey, buddy ya need a Comp Sci degree? How about a watch? +Hey, Santa, how much for your list of naughty girls? +Hi Ho, Hi Ho, it's Hand Grenades I throw! +Hi! I'm heavily armed, easily bored, & off medication. +Hi, I'm from the government. I'm here to help you. +Hi, Mr. Rex! I'm Barney!...I love you...you love m.....*CHOMP!!!!* +High message: 943432. Message you last read: 59 +Highballing the skyways between the stars +Higher Versions mean more bugs found... +History books which contain no lies are extremely dull. +History Repeats Itself Because Nobody Listens +Hit and run means never having to say you're sorry. +Hmmmmm.... never tried an atomic bomb before. +Ho! Ha! Guard! Turn! Parry! Dodge! Spin! Ha! Thrust! +Ho! Haha! Guard! Turn! Parry! Dodge! Spin! Ha! Thrust! WHACK! +Homeless man's sign: Will be President for Food. +Honest, Officer! The dwarf was on fire when I got here! +Honest, Officer! The smurf was on fire when I got here! +Honey, your IQ test came back. It's negative. +Honk if you like obscene gestures! +Honk if you're illiterate +Honk if you've never seen an Uzi fired from a car window. +Horn broke...watch for finger. +Hostages? What do you mean, I thought they were targets.. +Hot Tip #5: The light at the end of a tunnel is a train +House physician - a misnomer for a carpenter/repairman. +How about a 7-day wait period on buying Congressmen? +How can I miss you if you don't go away? +How come pizza gets to your house faster than the police? +How come this jacket they gave me doesn't have sleeves? +How do we know you really have those magic powers? +How do we know you're the *real* Angel of Death? +How do you call a *very* large cat wearing a rising-sun headband? +How do you pronounce my name? With reverence. +How many cat skeletons does it take to fill a tree? +How the hell does this thing work? +How will banning *MY* firearms reduce crime? +How's "Nuke 'em All!" for strategy? +However subtle the wizard; a knife in the back will cramp his style. +Human Being: An ingenious assembly of portable plumbing. +Humankind cannot bear very much reality. +Hunting is no fun when the rabbit has the gun. +Hush boy, you'll annoy the Overlords. +Hydrogen bombs are great party gags. +I *could* be arguing in my spare time. +I *told* the Muse I'm not a masochist, so why is the whip out again? +I abstain from wine, women and song; mostly song. +I Almost Saw Elvis - Then My Shovel Broke... +I always poach my Rats...lowers the cholesterol... +I always use the goodest English. +I am =NOT= illiterate. I know who my parents are. +I am a man more sinned against than sinning. - King Lear +I am a mental tourist, my mind wanders. +I am committed--or should be. +I am firm. You're stubborn. He's pigheaded. +I am free of all prejudices. I hate every one equally. +I am Ingnio Montoya. You stole my tagline. Prepare to die. +I am not a human! I am an animal! er...wait.. +I am not an animal! I am ... well, not an animal. +I am NOT anthropomorphic! Now get off my tail... +I am not antisocial, I'm just not real friendly... +I am not arguing with you, I'm telling you. +I am not conceited! I just hate mortals. +I am not young enough to know everything... +I am the neurosis that requires a $500-an-hour shrink! +I am the terror that posts in the night. +I am their leader, which way did they go? +I am tolerant of your (fruitcake) beliefs +I am tolerant of your (pagan) beliefs. +I am torn by conflicting apathies. +I became a power user, I bought 30 unformatted floppies. +I believe in the infliction of pain for the sake of art. +I beta test co unication softwFEL87=\d+A$ NO CARRIER +I came, I saw, I had no idea what was going on, so I left +I can count even higher if I take my shoes off. +I can walk on water, but I stagger on alcohol. +I can walk on water...........I stagger on alcohol. +I can't be stupid, I completed third grade! +I CAN'T go to h*ll, they don't want me. +I carry a gun 4 days a week. You guess which 4. +I couldn't repair the brakes, so I made your horn louder. +I cut it three times and it's still too short! +I debug with a magnet. +I didn't create reality...I'm just trapped in it! +I didn't know it was impossible when I did it. +I didn't wake up grouchy... I let her sleep. +I dislike killing my guests - Steven Brust +I do a weekly format In case I accidently backup c drive. +I do everything better when I'm naked. +I do whatever my Rice Crispies tell me to do. +I don't do jogging, it makes my beer all foamy +I don't do Windows. But OS/2 does. Very well. +I don't get mad...I just delete your COMMAND.COM +I don't have a problem with GOD, it's his FAN CLUB I hate +I don't have a solution, but I do admire the problem. +I don't have any solution, but I admire the problem. +I don't know what I like, but I know what art is. +I don't like violence but I'm very good at it +I don't recall running for this office. +I don't suffer from mental illness...I enjoy it!!! +I don't think Mr. Ranger is gonna like this, Yogi. +I Don't Wanna Overthrow the Govt, I Wanna Fire'em.!! +I don't want more, I want it all! +I Don't Want The World, I Just Want Your Half. +I Don't Want The World, I want the universe. +I don't want to be literate, I just want to program. +I donated my cat to the local Chinese restaurant. +I escaped from a political correction facility... +I even tried to reformat it, but still can't read my file +I fart in your general direction! -John Cleese +I feel a random act of violence coming on... +I FELT something was wrong. Multitasking causes schizophrenia. +I found my x-girlfriend in a find-a-fiend add. +I gave her the ring, she gave me the finger. +I get the news I need on the weather report. +I got a life once. Traded it in for a bigger hard disk. +I had a cat once. Tasted like chicken. +I had a vile comment once, but it escaped -Saint +I had one just like it.... only different. +I harbor no grudges, only angry memories. +I hate the way he says "Interesting Problem." +I have a 486, but a .357 is much faster. +I have a black belt in haiku. +I have a firm grip on reality. Now I can strangle it. +I have a rock garden. Last week three of them died. +I have an interesting way of my words structuring. +I have an OS/2 suit - It's multithreaded. +I have my priorities straight-it's the demands that are screwed up. +I have no idea what I'm doing, but I'm doing it well. +I have seen the evidence. I want DIFFERENT evidence... +I have the heart of a young boy - in a jar on my desk. +I have the simplest of tastes. The best is satisfactory. +I haven't killed anyone yet. Help me keep it that way. +I hear that it's Tourist Season in Florida. +I hunt flies with a sledge hammer....and get em!!! +I intend to live long enough to see my enemies die. +I just forgot my whole philosophy of life!!! +I just need enough to tide me over until I need more. +I just tested out my pitbull. Ever heard a mime scream? +I know so little, but I know it fluently. +I like os2 as much as the next fanatic! +I like to leave messages *before* the beep. +I like to skate on the other side of the ice. +I like to throw boomerangs to dogs. +I live in a quiet neighborhood, they use silencers +I live on good soup, not on fine words. - Moliere +I live to serve the public. How'd you like to be cooked? +I Love Animals......They're Delicious! +I love cats. On a good night, I can eat 5 or 6 of 'em... +I love standards! Such a variety to choose from! +I love the smell of napalm in the morning! +I love the sound of silence. Say what's on your mind. +I love you, you love me, Barney ate my fa-mi-ly... +I M a tru beleever in hour edukashun sistum. +I may be wrong, but I'm not uncertain. +I may have my faults but being wrong isn't one of them. +I may not always be NICE, but I'm always GOOD. }}}:) +I may not be smart, but I can lift heavy things. +I may work slow, but I do poor work +I need someone really bad. Are you really bad? +I never liked crayons much. They just don't have any flavor at all. +I never make stupid mistakes. Only very, very clever ones. +I never said I was perfect, but I never denied it! +I nows is graadiated froum Hi Skule. +I offer you your enemies. +I only drink to make other people seem interesting +I only drink when I'm alone or with someone. +I Only See In Infrared. +I passed my ethics course. I cheated, of course... +I played poker w/ tarot cards-got a flush & 5 people died +I procrastinate, therefore I will be. +I program like a MAN. I use COPY CON PROGRAM.EXE. +I put hard wood floors over carpeting. +I put on women's clothing, And hang around in bars +I quit drinking/smoking/&sex once.Very boring 15mins. +I refuse a battle of wits with an unarmed person. +I refuse to answer on the grounds..in the air maybe... +I refuse to go to a doctor who believes in reincarnation. +I run stop signs; I don't believe what I read. +I said Vulcan MIND meld, not MIME meld. Sorry, Marcel.... +I saw a tree fall in the woods, and I didn't hear it. +I saw Elvis. He sat between me and Bigfoot on the UFO. +I saw this in a cartoon once, but I think I can do it... +I saw what you did, and would like your phone #. +I see that your second lobotomy finally took hold. +I see your .44 and raise you a GAU-8A. +I should have known, you'd bid me farewell +I shpeak seeks different langwages, Eenlish da bast. +I stepped on a Tetanus needle today..... now what? +I still miss my exwife, but my aim is getting better... +I still Miss my wife. But with this new laser Sight... +I stink, therefore I'm Spam. +I SWEAR I thought she was 18! +I think ... therefore I am overqualified. +I think he's from the shallow end of the gene pool. +I think I'll wait for the 80986. +I think. Therefore I am DANGEROUS. +I think.... therefore I am conservative. +I thought you would've ducked.... honest. +I toast...therefore I am. +I tried being reasonable once, I didn't like it. +I tried switching to gum but couldn't keep it lit. +I tried to contain myself, but I escaped. +I turned in Schroedinger for Animal Cruelty... +I used to be a coyote, but I'm alright nooow! +I used to be sane once, didn't care for it much... +I used to jog, but the ice kept falling out of my glass +I used to play with my food, but I kept losing... +I want to live forever, and so far so good. +I was a dirty young man - I haven't changed. +I was gonna be a barber but neurosurgery pays better. +I was there. I saw it happen. You can trust me. +I was walking on water, or was that *under* water? +I went mad once. Did me a world of good. +I went to court for a parking ticket. I pleaded insanity +I will not squeak chalk. (with appropriate squeaks) +I wish I had a lower IQ so I could enjoy your company! +I wish my brain had expansion slots. +I wish scripts would do what I think I tell them +I wish you wouldn't sharpen your teeth when you say that. +I would have got away with it if it wasn't for those meddling kids!! +I would say more,but I'm�limited to only 57 characters here. +I would strongly oppose apathy, if I cared... +I'd give my right arm to be ambidextrous. +I'd give you a piece of my mind, but I'm on the last one. +I'd love to, but I'm taking punk totem pole carving. +I'd love to, but my bathroom tiles need grouting. +I'd offer everyone a Twinkie, but I'm not the host. +I'd rather have a bottle in front of me than a frontal lobotomy. +I'll be mellow when I'm dead. +I'll bring the Chtorr: you bring the barbeque sauce. +I'll have one brain on drugs with bacon and toast. +I'll have what the guy on the floor is having. +I'll never forget you -- you're too weird. +I'll never get off this planet. +I'll play fair if I get to make up the rules +I'm a belligerent omnivore -- I eat vegetarians. +I'm a modemer & I'm OK, I post all night & I sleep all day. +I'm a paranoid hypochondriac enamored with reality. +I'm a peaceful man. I vote to kill all weapon makers. +I'm a perfectionist with other people's work. +I'm a very modest man, and damned proud of it. +I'm an alien, an illegal alien! +I'm an anti-solipsist: everyone/thing exists except me. +I'm an antisolipsist: Everybody exists except me +I'm an Englishman in New York! +I'm an OS/2 developer...I don't NEED a life! +I'm another roadkill on the Information Superhighway. +I'm BETA testing my girlfriend. Bug report follows +I'm dangerous when I know what I'm doing. +I'm easy to please as long as I get my way. +I'm evil... I *LIKE* being evil... +I'm from the government. I'm here to help you. +I'm going to live forever!...or die trying. +I'm growing older, but not up..... +I'm happiest when I'm doing the cooking. +I'm having an out of money experience. +I'm having this tremendous difficulty with my lifestyle +I'm heavily armed, easily bored & off my medication... +I'm heavily armed, easily upset, and off the medication. +I'm immortal. I'm bored. Let's party. +I'm just here for moral support. . . ignore the gun. +I'm not a complete idiot - several parts are missing. +I'm not a mercenary; killing is more of a hobby with me. +I'm not a shyster, I'm a QUACK. +I'm NOT a vampire - I just eat like one... +I'm not arrogant, I'm just better than you. +I'm not Canadian although I tend to like their bacon. +I'm not crazy..I just have a unique sense of reality. +I'm not hostile! I'll kill the #%! that said that! +I'm not insane; Just pschologically challenged. +I'm not lost, I'm locationally challenged. +I'm not nearly as think as you confused I am. +I'm not paranoid! Which of my enemies told you this? +I'm not perfect. (but my inner self is) +I'm not perfect. (but my subconcious is) +I'm not prejudiced; I hate everybody +I'm not stupid, I'm just "politically correct." +I'm not stupid, I'm not expendable, and I'm not going! +I'm on top of the world. To bad there's no air here. +I'm out of bed and dressed. What more do you want? +I'm part Scotch -- my other part's water. +I'm perfect, other people just screw up my plans. +I'm practicing assertiveness. Do you think that's okay? +I'm pretty cool, Beavis, but I can't change the future... +I'm really imprinted with the quality of this conference. +I'm scared of the dark.. the government's in it. +I'm Seymour Cash of the law firm Dowie, Screwem, & Howe +I'm sorry, but my opinion is ROM burned. +I'm sorry, you are not cleared for that information. +I'm spending a year dead for tax purposes. +I'm The Best at what I do, and what I do isn't very nice. +I'm the creature that goes bump in the night. +I'm the person your mother warned you about +I'm weird, but around here it's barely noticeable. +I've already told you more than I know. +I've been pursuing a path of alternate reality +I've committed adultery in my heart many times +I've lost my sense of direction; which way to the bar? +I, myself, AM strange and unusual... +Idiocy is an inbred genetic trait of all politicians. +Idiot (id-ee-it) n.-> One who disagrees with me. +If a bear is chasing you please don't run this way. +If a program is useful, it will have to be changed. +If a program is useless, it will have to be documented. +If a thing is worth doing at all, it's worth doing badly. +If anything -can't- go wrong, it will. +If At First You Don't Succeed Ignore The Docs +If at first you don't succeed, destroy the evidence. +If at first you don't succeed, lower your standards. +If at first you don't succeed, put it out for beta test +If at first you don't succeed, redefine success. +If at first you don't succeed, skydiving isn't for you... +If at first you don't succeed, tell her another lie. +If at first you don't succeed, that means you're average. � +If at first you don't succeed, work for Microsoft. +If at first you don't succeed, you must be a programmer. +If at first you don't suceed, you fail. +If everything's coming your way, you're in the wrong lane +If God wanted us to go METRIC Jesus would've had 10 disciples not 12. +If guns are outlawed, can we use swords? +If I knew how to spell, I could use a dictionary. +If I melt dry ice, I can go swimming without getting wet. +If I offend thee... ...tough! +If I want your opinion I'll give it to you. +If I want your opinion, I'll read your entrails. +If I wanted flames, I'd sell my soul to the Devil. +If idiots could fly, this would be an airport. +If ignorance is bliss, 'tis folly to be wise. +If it ain't broke yet, let me have a shot at it. +If it ain't broke, hit it harder. +If it ain't broken, play with it till it is. +If it doesn't work, change the documentation. +If it doesn't work, it doesn't matter how fast it doesn't work. +If it don't mean a thing, it ain't information. +If it isn't broken, I can fix it. +If it jams, force it...If it breaks, it needed replacing. +If it moves shoot it, when its dead paint it green. +If it screams, it's not food.........yet. +If it walks out of your refrigerator, LET IT GO! +If it works, something went wrong. +If it's glowing, don't eat it... +If it's not on fire, it's a software problem. +If its Tourist Season, why can't we shoot 'em ??? +If love is blind, why is lingerie so popular? +If people can't communicate, they could at least shut up. +If she won't live forever, then why give her a diamond? +If someone shoots me, I get to keep the bullet. +If stupidity was a survival value, he would live forever! +If stupidity was painful, then people would get help. +If the enemy is in range, SO ARE YOU. +If the enemy is within range, so are you. +If the facts are against you, argue the law. +If the law is against you, argue the facts. +If the mail wants me so badly, _it_ can walk to _me_. +If they catch us we're dead." "I've been dead before." +If they put your brain in a bird, it would fly backward. +If they're waving, where's the rest of their fingers? +If thine enemy offend thee, give his child a drum. +If this isn't war, why is CNN massing on the border? +If this was a real emergency, you'd've been trampled +If two wrongs don't make a right, try three. +If users can't read the manual, give them the source code +If Version 1.0 works someone goofed... +If we left the bones out it wouldn't be crunchy! +If wishes were horses, beggars would be shoveling manure. +If ya can't say anything nice, sit by me. +If you ain't making waves, you ain't kicking hard enough. +If you believe in telekinesis, raise my hand. +If you call me insane again, I'll eat your other eye too. +If you can count your money, then you don't have enough +If you can't fix it call it a feature. +If you can't laugh at yourself, I'll laugh at you...... +If you can't make fun of your friends ... what good are they? +If you can't make fun of yourself, give me a call! +If you cannot convince them, confuse them. +If you don't bet, you can't win. - Heinlein +If you don't care where you are, then you can't get lost. +If you don't like how I drive, get off the sidewalk! +If you don't like my facts, make up your own. +If you don't like my opinion of you - improve yourself! +If you don't like the Graffiti here, don't order Italian! +If You Don't Think Women Are Explosive... Drop One. +If you drink, don't drive. Don't even putt. +If you find this message offensive then you get my drift +If you hit every time, the target's too near. +If you leave the room, you're elected. +If you want it done right, forget Microsoft. +If you were an Armadillo, you'd worship trees, too! +If you're happy and you know it clank your chains +If you're on the cutting edge, expect to bleed. +If you're trying to drive me crazy, you're too late. +Ifyoucanreadthis,youspendtoomuchtimefiguringouttaglines. +Ignorance won't kill you, but it makes you sweat a lot. +ILLITERATE? Write for a free brochure... +Immortality is no excuse for not flossing. +Improve your IQ...eat gifted children! +In a nuclear war, all men will be cremated equal +In a sense, we have always lived in Ahnk-Morpork. +In a solemn ceremony, they giggle viciously. +In a vegetable garden, flowers are weeds. +In Arkansas, if you get a divorce, technically you're STILL cousins. +In CyberSpace everybody can hear you scream. +In Cyberspace, no one wears a watch. +In DOS we trust, all others please crash. +In extreme circumstances, cautionary measures are always justified. +In handling a stinging insect, movevery slowly. - Heinlein +In life.....pain is mandatory....misery is optional +In space...no one can hear you "Cha! Cha! Cha!" +In the beginning there was the Precambrian epoch. +In the country of the blind, the one-eyed men are kings. +In the end, everything is the same as it ever was. +Incorrigible punster - do not incorrige. +Inductive logic is much more difficult--but can produce new truths.- RAH +Infuriate the media: think for yourself. +Ingratitude, thou marble-hearted fool... - King Lear +Injustice anywhere threatens justice everywhere. +Inquiring minds wanna know. Intelligent minds don't care. +Insanity is fun if you do it right. +Insects really bug me. +Insert disk 5 of 4 and press any key to continue +Insert New Disk for Drive C: Press ENTER when ready. +Insert prong A into hole B and twist HARD! +Insert your favorite rude obnoxious offensive phrase here +Insomnia isn't anything to lose sleep over. +Install failed: Attempting to transfer virus to c: +Installation recommended (not included) +Instead here we are in a silence more eloquent... +Intelligence is the right arm of modern warfare. +Is it Progress when the cannibals use a fork? +Is nothing sacred? Great! When are worship services? +Is there supposed to be a lot of water down here? +Isn't that our pilot over there, kissing the ground? +It appears to make a driver mad if he misses you. +It doesn't work, but it looks pretty. +It is better to copualte than never. - Heinlein +It is better to light a flamethrower than curse the dark. +It is dangerous to be sincere unless you are also well armed. +It is morally wrong to allow suckers to keep their money. +It is when I struggled to be brief that I became obscure +It isn't really mine 'til I've modified it +It made a sound like someone was field-cleaning a badger. +It takes a long time to grow an old friend. +It takes a Real Man to sit indoors all day doing this. +It was supposed to be so easy. +It works better if you plug it in. +It works fine except when it's activated. +It's a chain saw. I always carry one for emergencies. +It's a dead man's party...Who could ask for more? +It's a great day for putting slinkies on an escalator. +It's a great place, and the drinks are cold! +It's a Satanic drug thing - You WOULDN'T understand... +It's all fun and games until the hard drive dies. +It's all psychobabble rap to me. +It's amazing how much "mature wisdom" resembles being too tired. - RAH +It's cold outside...there's no kind of atmosphere... +It's easy to make Windows faster. Just throw it harder. +It's great to do nothing and rest afterwards. +It's hard to RTFM when you can't find the FM.. +It's hard to work in groups when you're omnipotent. +It's not 0 to 60 that counts... it's 85 to 55 that matters! +It's not a bug, it's an undocumented feature. +It's NOT kill the women and rape the men, it's... +It's not so much the bat, but the Cyborg swinging it.... +It's not that life is so short, it's that you're dead for so +It's not the money I want, it's the stuff. +It's not the principle, it's the money. +It's not your imagination... we ARE against you. +It's nothing a warm-boot can't fix, I think +It's on that one, the 6th unlabeled floppy. +It's only my opinion, but it's better than yours. +It's so hard to find good vacuum tubes for my PC anymore. +It's working now; I don't want to break it by fixing it +JaLaPe Brand Ration's - Raw Meat that's great to eat! +Japan says your illiterate. +Jesus Saves --at First National Bank +Jimmy Hoffa, call your office. +Joe's crematorium u kill'em we grill'em! +John Wayne's World: Party time, Pilgrim. -SLR +Join army: travel, meet interesting people & kill them! +Just 'cause it won't work; You think it's buggy. +Just a lowly conference participant; not a moderator. +Just another prisoner of gravity!! +Just climb in, and hang on. Open your eyes, if you dare... +Just don't tell the asylum you saw me here. +Just say NO to negativism. +Just sliding down the razor blade of life . . . +Just when you thought it was safe to go back in the bitstream. +Kant's Categorical Imperative is too long for a tagline. +Keep honking...I'm reloading +Keep thy Tail Bushy and thine Eyes Bright, +Keep you're opinion to yourself. Spread mine around. +Keep your city clean...eat a pigeon. +Keyboard: A device for entering misteaks in a computer� +Kill or starve. +Kill the extremists. +KILL the s.o.b. - THEN count to 10. +Kill What You Can't Understand. +Killing time takes practice. +Klingon DOS 6.0- DEL.COM; ERASE.COM; WIPE.COM; TRASH.EXE; BURN.BAT; +Knights errant spend their nights erring. +Knowledge itself is power. -- Francis Bacon +Knowledge rests not on truth alone, but upon error also. +Knowledge without common sense is folly. +LABEL NOT FOUND: go anywhere you like. +Lack of planning does not constitute an emergency. +Land of the Free, Home of the Unemployed. +Last one out of the coffin is a rotten corpse. +Lawyer: one who calls a 137-page document a brief. +Lawyer: the larval form of politician. +Lawyers should advertise on Emergency room ceilings. +Lawyers: the larval form of politicians. +Lay down all thought, surrender to the void... +Lead me not into temptation - unless there's money involved. -SLR +Lead us not into temptation; we can find it ourselves. +Lead, Follow, or get the H*ll out of the way... +Left blank to annoy the moderator. +Lern two spel. Kull mee att wurc four fre hellp. +Let him who understands reckon the number of the Beast. +Let the meek inherit the earth, I want stars. +Let's get some beer and dynamite and go fishing. +Let's take a chance on living; before we die! +Let's you and him fight. +Liberal (n): Anyone who disagrees with you. +Liberal censorship is hogwash. I see no evide ... NO CA +Liberals! Looks like we'll have to blast our way out! +Life and Liberty are safe...when congress is in recess. +Life being what it is, I dream of revenge +Life is a game, and money is how you keep score... +Life is an interruption in entropy. +Life is complex: It consists of real and imaginary parts +Life is like toilet paper; we panic as the end approaches. +Life sucks and then you marry one who won't. +Life's a b*tch...then you are reincarnated. +Life. It's not just a bowl of cereal anymore. +Life: what happens while you're making other plans. +Limit Congressmen to 2 terms - 1 in Congress, 1 in Jail! +Line Noise Brought to You By an I.R.S. Phone Tap +Listen to sermon, THEN eat missionary! +Listen you malfunctioning mess of microchips...... +Little did he know, but I was a master of the pugil... +Live by the sword, die by the longbow. +Living: The best demonstration of victory over mortality. +Logic is a way of going wrong with confidence. +Logic is logic. That's all I say." Holmes +Logic: 1+1= 11, 2+2= 22, 3+3=6 +Loitering with intent to hesitate. +Long live conference hosts ... so they can suffer longer. +Longer life through superior firepower. +Longer than lumber and broader than a bench. +Look unimportant - The enemy may be low on ammo +Looks like I picked a bad year to stop sniffing glue. +Lots of cute, furry animals killed to make this tagline. +LOTUS - Let Only The Users Suffer +Love is deaf as well as blind... and walks with a limp. -SLR +Love is grand... Divorce is twenty grand... +Love me or hate me, but spare me your indifference. +Love your country, but fear the government. +Love your neighbour, but don't get caught. +LSD melts in your mind not in your hands. +LSD melts your mind, not in your hand. +LSD: Virtual Reality without the expensive hardware! +Lucas refrigerators: Why the British drink warm beer. +Lunatic asylum: where optimism most flourishes. +Mac screen message: "Like, dude, something went wrong." +Macintosh - Computer /w training wheels you can't remove. +MACs = Snobby-Expensive-User-Friendly computers +Mad at your neighbor? Buy his kid a drum! +Madness takes it's toll; please have exact change. +Mafia DOS: "Thisa you lasta chance [Y/N]?" +Magicians are a vanishing species. +Mail not found: (A)bort (R)etry (P)anic (B)lame sysop. +Make a bold fashion statement: Get Naked. +Make friends with SysOps: Page them at 3am. +Make it as simple as possible, but no simpler. +Make my day, kill a GUI today. +Make my sushi medium rare +Malice:merely stupidity raised to a higher power. +Man is a god in ruins. -Ralph Waldo Emerson +Man looks into the abyss, and sees himself. +Man made Booze. God made Grass. Who do you trust? +Man of Steel hates industrial electromagnets. +Man often abolishes God; fortunately God is more tolerant +Man with forked tongue has no need for chopsticks. +Man,the missing link between apes and human beings +Mandatory tagline affixed in accordance with rule 3, sec A, par 2. +Manuals come out, after all possible keystrokes fail. +Marriage enders: You propose, we dispose. +Marriage is a rocky road when the attendents get stoned. +Marriage is not a word but a sentence. +Marriage is ok, but I wouldn't recommend it for singles +Marriage? No thanks, I don't breed well in captivity. +Married alive -- a fate worse than death. +Mars Needs Bovines +Mary had a little lamb, some white wine, and a salad. +Mason-Dixon: Line that separates y'all from youse- +Math illiteracy affects eight out of every five people. +Math Problems? Call 1-800-10x(24+13)-(64-16)/2 36x2. +MAXIMUM UNPLEASANT STIMULI!!! +Me opinionated? . . . Not on your life pig! +Me use the manual? Do I look like a sissy to you? +Me, indecisive? I don't think I am, do you? +Me...a skeptic? I trust you have proof. +Medical definition: Dilate. To live too long +MEDICAL STAFF: A doctor's cane. +Meet the new boss, same as the old boss... +Member: International Brotherhood of Tagline Kenders. +Member: International Brotherhood of Tagline Thieves! +Memory parity interrupt at 367A:64DF Self-Destruct 5 sec. +Men who believe absurdities will commit atrocities -Voltaire +Mental compatability not covered by warranty. +Mental Floss prevents Moral Decay. +Mere life is not victory, mere death is not defeat. +Message sent. Destroy immediately upon receipt. +Messiah Complex? Me? Well, let me just sayeth unto you...... +Mickey Mouse wears an Al Gore wristwatch. +Microbiology Lab: STAPH ONLY! +Microsoft Slogan..."McDoublespace..... Over 30 Billion crashed..." +Microsoft Windows - proof that P.T. Barnum was correct. +Microsoft: Making it easier... to switch to OS/2! +Microsoft: Making it all. Make sense? +MilliHelen: Amount of Beauty Needed to Launch One Ship +Millions of sperm and _that_ one got through. Sigh. +Milton's 1st Law: Anything can be used as a hammer. +Mind if I clean my fly swatter over your soup? +Mmm mmm good; Cream of Spotted Owl Soup, yum +Mmmmmm! A problem with grammar have I, yes! -- Yoda +MODEM - M_onumentally O_verpriced D_ata E_ating M_achine +Modem: A great deterrent to phone solicitors +Moderator (n): see also god, dictator, egotist, oppressor +Modesty Becomes You. Try It More Often. +Monday is an awful way to spend one seventh of your life. +Mondays are a rotten way to spend 1/7th of your life. +Money can't buy happiness, but it does quiet the nerves. +Money is truthful. If a man speaks of his honor, make him pay cash.- RAH +Monogamous and monotonous are synonymous. +Monolith Moscow Cemetery: "My God, it's full of czars!" +Monotheism: a gift from the gods +Morale improved, but now I ENJOY floggings! +Morbid: Burying the body, and then visiting weekly. +More fun than @TO@ should be allowed. +More than just a book--it's a major piece of torture. +Morgue, you stab'em, we slab'em! +Mosquito: Designed by God to make flies seem better. +Most "scientists" are bottle washers and button sorters. - Heinlein +Most allies must be watched just like the enemy. +Most have good aims in life, but few pull the trigger. +Most people make sense, I'm not one of them. +Most political jokes get elected +Multitasking - Twice the mistakes in half the time. +Multitasking = screwing up several things at once. +Murphy didn't come close to real trouble. +Murphy's rule of combat: Incoming fire has right of way. +Murphy's: All constants are variables! +MUST...DESTROY...MANKIND.......oops! Time for lunch! +My best feature? I would say my overwhelming humility... +My boss says I'm going to be famous, he says I'm history. +My computer NEVER loc +My demand curves are *always* upward sloping.... +My dog loves cats! He'll eat as many as he can catch! +My ego's bigger than your ego...... +My girlfriend said I never listen to her, or something. +My guru told me there'd be lifetimes like this. +My horse is the one that just broke its leg and fell on the jockey. +My infinity is bigger than yours. +My last original thought died of loneliness. +My life is in your hands... What do you mean, "oops"? +My mind is a scary place, I try not to go there alone. +My mind isn't always in the gutter - sometimes it comes out to feed. +My Mind's like a steel trap: Rusty and Unhinged. +My mistakes are purely erroneous. +My one regret in life is that I'm not someone else +My opinions are my own; mistakes are the computer's fault +My opinions are not those of my employer +My other computer is a TRS-80 Model 4. +My other sentient killing machine is a BOLO +My other tagline's a Rolex... +My psychiatrist told me "Maybe life isn't for everyone" +My reality check just bounced. +My ship came in but unfortunatly it was the flying dutchmen. +My system will resolve an infinite loop in 3 millisec. +My V32bs fx/mdm wrks jst fne wthot a 1550 bffrd URT +My Wife wishes I drank or chased women like other men! +My wife's other car is a broomstick. +Name: John Doe Phone:222-2222 Sex:Not lately +Natural laws have no pity. - Heinlein +Natural Selection works ... if you let it. +Nature always sides with the hidden flaw. +Necrophilia means never having to say... well, anything... +Neurotoxin Lite! Tastes great. Less drooling. +Never accept a drink from a urologist. +Never argue with a skunk, mule, woman, or SysOp... +Never assume conspiracy when stupidity will explain it. +Never assume. It makes an "ass" out of "u" and "me". +Never attribute to malice that which may be explained by stupidity. +Never board a plane whose flight number is 5050! +Never buy wine from a guy with purple feet. +Never draw fire, it irritates everyone around you. +Never eat a hedgehog without peeling it first. +Never enough time, unless you're serving it. +Never fight ugly people, 'cause they have nothing to lose +Never frighten a little man, he'll kill you. - Heinlein +Never give a gun to ducks. +Never go to a cyberpunk play when the review says "Riotous." +Never go to a doctor whose office plants have died. +Never go to bed mad. Stay up and fight instead. +Never hit a man when he's down - always kick him. +Never hit a man with glasses. Use your fist. +Never judge a man by his taglines. +Never laugh at live dragons. +Never lean forward to push an invisible object. +Never let a fool kiss you, or a kiss fool you. +Never let a machine know you're in a hurry. +Never let an inanimate object defeat you. +Never let your dragon overeat! +Never lick a gift horse in the mouth. +Never mind the oxygen. This man's a donor. +Never mind the star - get those camels off the lawn! +Never mistake endurance for hospitality. +Never pet a burning dog. +Never play Global War with someone named after a state. +Never put off till tomorrow what you can ignore entirely. +Never send a monster to do the work of an evil scientist. +Never show up at a gun fight with a knife +Never sleep with anyone crazier than yourself. +Never take a beer to a job interview. +Never tell them what you wouldn't want to do. +Never test for an error you don't know how to handle. +Never trust a computer that smiles at you... +Never underestimate a barbarian knucklewalker. +Never underestimate the power of human stupidity. - Heinlein +Never, ever, ever attempt to learn thermodynamics. +Never, ever, pinch a sorceress on the butt. +New Lurker Conference! Join in and disappear... +new oxymoron: final beta +Next time I send a damn fool, I'll go myself...Geez! +Nice guys finish last, but we get to sleep in. +No amount of careful planning will ever replace dumb luck +No bathroom? Just go boldly where no one has gone before. +No battle plan survives contact with the enemy +No Brain, No Pain. +NO CARRIER...but I've got 2 destroyers and a frigate +No cute, furry animals killed to make this tagline. +No good deed ever goes unpunished. +No good deed goes unpunished - Mark Twain. +No man is free who is not master of himself. +No matter where you go, there you are.... +NO MESSAGES FOUND. [H]it modem. [S]cream at fido gods. [Y]ell profanity +No One Is Ugly After 2:00 AM +No real reason for it; it just happens to be my policy. +No reason for it; it's just my policy. +No sense being pessimistic. It wouldn't work anyway. +No trouble parking, I drive a forklift... +No uninteresting subjects, just uninterested people. +No wanna work. Wanna bang on keyboard.� +No, bartender, I said I vanted a BLOOD lite! +No, I never read the documentation. +No, I'm not an elitist. Why do you ask, peasant? +No, no, not "born again." I said, I was into PORN again. +No, really. Where did you get the zombie slime? +Noble deeds that are concealed are most esteemed. +Nobody ever bet too much on a winning horse. +None are so blind as those who will not see. +North East Breakfast: A cuppa coffee and a cigarette. +Not a computer nerd; merely a techno-weenie. +not after devouring so many maidens of the valley. +Not all men are fools, some are bachelors. +Not broke, merely under-funded. +Not now ... I have to go mow the laundry. +Not-so-famous Fraternities: I Phelta Thi, Tappa Kegga Bru +Nothing can go wrong(clik)go wrong(clik)go wro.. +Nothing is 100% certain, bug-free, or IBM compatible +Nothing is final. Except me, of course. +Nothing is so smiple that it can't get screwed up. +Nothing like a bribe to get things rolling. +Nothing wrong w/ this program a strong magnet can't cure. +Nothing's foolproof. Idiots are too ingenious. +Nothing's impossible for those who don't have to do it. +Nothing: Often a good thing to do & a clever thing to say +Now abusing OS/2 2.1 +Now and then an innocent man becomes a senator. +Now and then an innocent man is sent to the Legislature +Now in new great-tasting Grape and Watermelon flavor. +Now where did I put that fire extinguisher? +NT - "The carrot in front of the donkey" - J Dvorak +Nuke 'em til they glow... shoot 'em in the dark! +Number of phone rings = number of steps from commode -1 +O Lord, protect me from those to whom You speak directly!... +Objection, your Honour! My client is an idiot! +Of all the people I have met, you are certainly one. +Of all the things I've lost...I miss my mind the most. +Of course I can cook, but I never do it on the 1st date! +Of course I turned, I hit you didn't I? +Of course I'll pay for that one. Check okay? +Of course it's safe. Go on in, I'll be right behind you. +Of course it's safe. Go in, I'll be right behind you. +Of course, coffee *is* one of the major vitamins +Often it's fatal to live too long +Oh freddled gruntbuggly, thy micturations are to me ... +Oh what a Grand Universe we live in.... +Oh, excuse me, were those your panties? +Oh, I'm sorry, were the voices in my head bothering you? +Oh, it's on page 732 of the docs, paragraph 3, section D1 +Oh, pardon me, was that *your* culture? So sorry. +Ok Space Cadets! Prepare to hurtle through the cosmos! +OK, I pulled the pin. Now what? Hey, where're you going? +OK, I'm weird! But I'm saving up to be eccentric. +OK, I've pulled the pin. Now what ? Where are you going ? +OK-give me ONE good reason why I can't have it both ways. +Old enough to know better, young enough not to care! +Old is when your back goes out more often than you do. +Old soldiers never die...young ones do. +On a clear disk you can seek forever +On Fidonet, nobody knows you're naked. +On one condition -- that it leads to extreme violence! +On the day of the dead, when the year too dies... +Once again, truth and American technology defeat Bill. +Once again, truth and American technology defeat Satan. +Once in a while, I screw up and do something right. +Once you pull the pin, Mr. Grenade is no longer a friend. +One atom bomb can ruin your whole day +One golden glance of what should be +One good turn is usually enough to get a person lost. +One man's Windows are another man's walls. +One more day like today and I'll kill you too. +One murder makes a villian, millions a hero -B Porteus +One nation under God; with liberty, fries & a Coke to go. +One ring to rule them all... +One sword at least thy rights shall guard, +One thing about pain: it proves you're alive. +Online? Good, hit Alt-H for FREE Unlimited Access ! +Only 19,999 lines of C++ to my next ski trip... +Only a lawyer calls a 10,000 word document a "brief". +Only a liberal could coin a word such as "undertaxed." +Only lemmings jump to unknown conclusions. +Only the educated are free: Some Greek guy. +Oops, gotta go feed the dragon. +Open mouth, insert foot, echo internationally +Operating at a higher level - OS/2 v2.1 +Operator error (E)xecute (T)rain (S)end Home +Operator! Trace this call and tell me where I am. +OPINIONS? I have lots. Which one would you like? +Optimism is profoundly depressing. +Or time will grind you down to dust again... +Originality is the art of concealing your sources +OS/2 - because 32 bits are terrible things to waste. +OS/2 - The only true 100% FAT free operating system. +OS/2 fixes broken windows +OS/2! Anything else is just DOS. +OS/2: Windows with bullet-proof glass. +OS/2: Your brain. Windows: Your brain on drugs. +Other than that, Mrs. Lincoln, how did you like the play? +Our swords shall play the orators for us. +Our world is like a cactus except the pricks are inside. +Page your sysop at 3am for Free Prizes! +Pain -- Finally something we can depend on. +Paint it Octarine: the color of magic. +Paranoia is just a heightened sense of awareness. +Pardon me if not every "i" is crossed and "t" dotted... +Pardon my driving; I'm trying to reload. +Pardon my existence and I might pardon yours. +Path = 'down there a ways and to the left' +Patience and time do more than strength or passion. +Patience is a virtue possessed by few men and no women� +Patience-A Virtue That Carries A Lot Of Wait +PATROL CAR BUMPERSTICKER: Attitudes adjusted, while you wait. +Paul Harvey fans always have a good day +Paused: enter any 12-digit prime number to continue +PCBackup: 1 of 1362 disks. +PCs rule 1001111 1001011 +Pedestrian: Someone who found a place to park. +Pedestrian: The most approachable chap in the world. +People say I'm apathetic, but I don't care. +People say I'm indecisive. Am I? I don't know. +Perhaps I should take up golf instead? +Personal beliefs become trivial when reality intrudes... +Personals:"Mormon seeks wife, must get along with others" +Philosophy is for people who can't form their own opinions. -SLR +Phoneco.sys corrupted-recommend competitive market. +Pick two: 1)Fast 2)Right 3)Cheap 4)Windows (counts as 2) +Pioneers are the ones with the arrows in their backs. +PKunZIP V56.7 FAST! Exploding Universe->>CRC-@ error +Place your clothes and weapons where you can find them in the dark.- RAH +Plasma is another matter +Played poker w/tarot cards. Got a flush & 5 people died! +Please excuse me. I'm one of the fatigue impaired. +Please stand by, depressurization begins in 15 seconds. +Plunk your magic twanger Froggy... +Polite Virus: Sorry to interrupt, but I need to format... +Political Correctness: marketing term for mind contral. +Politicians aren't born, they are excreted. (Cicero) +Politics: Passing the buck or passing the doe. +Politics:Root(s):[a]Poly-Many [b]Tics-Bloodsuckers +Pornography: n. Things we enjoy but don't want anyone to know about. +Posted by a twisted mind behind a machine. +Power corrupts, but OS/2 is kinda neat. +Power corrupts. Absolute power is kinda neat, though. +Power doesn't corrupt people, people corrupt power. +Power is an illusion; only stupidity is real. +Practice mirth control - used a conumdrum. +Practice mirth control..... always use a conundrum +Practice safe snuggle. Make her wear socks to bed! +Pray for Bill Clinton (see Psalm 109:8) +Precinct toilet stolen... Police have nothing to go on. +Predestination was doomed from the start. +Preserve wildlife...pickle a squirrel today. +President Clinton --- The Eddie Haskel of politics. +Press -- to continue ... +Press -- to store all new data: +Press alt-H to continue, then Y if applicable. +Press any key to continue or any other key to quit +Press SPACEBAR once to quit or twice to save changes +Press to test. Release to detonate... +Press [ESC] to detonate or any other key to explode +Prevent Messes-Cover Hamster before Microwaving +Problems? No, I LIKE my foot there. +Profanity, the language computerists know. +Professor: a textbook wired for sound. +Programmer (n): One who makes salesman's lies come true. +Programming Dept.: Mistakes made while you wait. +Prosecutors will be violated. +Provider of fine voodoo productions..... � +Prune Juice . . . The drink of warriors! +Pscyhos R Us +Psychiatry: The study of the ID by the ODD. +Psychic Convention cancelled due to unforeseen problems +Psychoceramics: The study of crackpots. +Psychoses are red, Melancholia's blue, I'm Schizo...you? +Pull once to eject... twice to abort ejection. +Pull trigger repeatedly until problem dissapears +Puns are bad, but poetry is verse. +Put Lawyers on the ETHICS COMMITTEE, for BALANCE +Put the straightjacket over his mouth. Trust me. +QEMM Exception #13: [L]ockup, [L]ockup, or [L]ockup? +QUICK! Hand me the cat; the cherry bomb's lit! +Quick, easy, enlightenment; Just axe for it. +Quoth the Raven, "Eat My Shorts." +Radical: Anyone whose opinion differs from ours. +Radioactive Halibut will make fission chips +RADIOACTIVE: if you can read this you're sterile +Rainy days and automatic weapons get me down. +Read Books And Repeat Quotations. +Real programmers innovate, others LITIGATE ! +REAL programmers use "COPY CON PROGRAM.EXE" +Real Trekkers work out at the He's Dead Gym +Real women don't deflate when you bite them. +Reality is a constant intrusion on my dreams. +Reality Is An Illusion Caused By Lack Of Acid +Reality is an illusion: men are only the dreams of gods. +Reality is an obstacle to hallucination. +Reality is for those people who have no grasp of fantasy. +Reality is for those who can't face fantasy. +Reality is the leading cause of stress amongst those in touch with it. +Reality: a fantasy gone wrong, dreadfully wrong!!! +Reality: an illusion produced by an alcohol deficiency. +Reality:a crutch for those who can't handle drugs. +Really honey, I NEED 10 megawatts for it. +Real_men_don't_need_spacebars. +Red meat is good for you; fuzzy green-blue meat is bad. +Redneck marriage proposal:.........YER WHUT!!?????? +Relativity all depends on how you look at it. +Religion keeps the poor from murdering the rich. +Religious error: (A)tone, (R)epent, (I)mmolate? +REMEMBER that the only proper way to exit a door is ALT-H +Remember: Scan all files for viru(+(+(&*^)6075$%^&$ +Remember: USER is a four letter word. +Reports of my being alive and well are grossly exagerated +Reputation: what others are not thinking about you. +Research has found that research causes cancer in mice. +Retreat h*ll! We're just fighting in another direction! +Revenge is a dish best served....with tangy Miracle Whip! +Reward for a job well done: more work +Right theory, wrong universe +Right, mate, I'll just throw another Ken on the Barbie! +Road Kill Cafe - Today's Special: Swirl of Squirrel +Road Kill Cafe: new meaning for "fresh off the grill." +Robert A. Heinlein memorial taglein. +Rosanne Barr: proof that mankind is troubled +RTFM? - Nah, call the author at home! +Rumour: NT means Not Tested +Run for shelter in these golden years +Sacred cows make better hamburgers. -Graffiti +Sacred Cows make good hamburgers. +Safety needle: pointless, isn't it? +Salvador Dali for Coca Cola: It's surreal thing. +SAPFU -- Surpassing All Previous Foul Ups. +Saudi Arabia, A country where the word "DUCK" is a Verb. +Save a flag - Burn a protester +Save a tree, eat a beaver! +Save Georgia's economy...Eat more canned Possum! +Save time - live several lives at once. +Save toilet paper. Use the other side. +Say something nice to everyone today...drive them crazy. +Scandal is juicy gossip made tedious by morality. +Schizophrenia beats being alone. +Science Fiction: So fun it ought to be illegal or fattening or sumfin'` +Science is truth -- don't be misled by facts. +Screw the company, those first 20 minutes belong to you. +Scripts, the thinking man's route to insanity. +Second star to the right and straight on 'til morning +Secrecy is the beginning of tyranny. - Heinlein +Secret revealed: Press CONTROL-ALT-DEL for SysOp Access! +Sects! Sects! Sects! Is that all Monks think about? +See ya in the chronostream, Time Jockey! +sEe! I cna ytpe 300 wrods pre mniuet!!! +Send $20.00 in small unmarked electrons. +send moneySUBLIMINALsend moneyTAGLINEsend money +Send Monopoly money to your favorite TV Evangelist. +Send more tourists..... the last ones were delicious! +Seriousness is the very next step to being dull. +Set. Spike. Dig. I do it in the sand. +Sex ain't dirty.. it's slippery! +Shall I scream? Let's scream together. -SLR +Share and Enjoy. (or - Go stick your head in a pig) +Sharks don't eat lawyers. Professional Courtesy. +She said "Have a nice day", but I had other plans. +She turned me into a newt! ....well, I got better.... +She won't last forever, so why buy her a diamond? +She's dead, Jim. But hell, she was like that in the sack +She's the bargain hunter. I just carry the ammunition. +Shin - Device for finding furniture in the dark. +Shoot Dr. @FIRST@ on sight and dissolve his body in acid. +Shoot first, and whatever you hit, call it the target. +Shoot first; answers aren't that important. +Shopping tip: Shoes are $.85 at bowling alleys. +Shouldn't you be doing something productive? +Show me a sane man. I'll cure him for you. +Shut up, or I'll nail your other foot to the floor +Sign on the mortuary door: Remains to be Seen. +Sign outside brothel: "On Vacation. Beat it." +Silence cannot be misquoted. +Silence? Oh no, it's the Attack Of The Mimes! +Simon says Stand! Simon says sit! Format your drive! HA! Gotcha! +Since I've used up my sick leave, I'm calling in dead. +Sinner: A stupid person who gets found out. +Sit dux sapienta- Let wisdom be your guide. +Sky diving, its good to the last drop. +Slaying foul maidens, rescuing fair dragons. +SLEDGE-O-MATIC: For life's most difficult problems. +Sleep: (noun), Short time between BBSing and work. +Sleep? I'm a Consultant!! +Slow the aging process: put it through Congress. +Slugs saut�... a hors of a different d'oeuvre. +SMILE ! (makes people wonder what you're up to) +Smith & Wesson: The original point-and-click interface. +Smith & Wesson: The ultimate point & click user interface... +Snap, Crackle, Pop ....Darn I hope that was a fuse... +So he says to the Shapeshifter waitress, "Keep the change." +So I said to my one-legged wife, "Peg..." +So many books, so little time. +So many jerks, so few bullets... +So much time, so little to do (or something like that). +Society prepares the crime; the criminal commits it. +Software Troubleshooter - @TO@, w/44 Magnum +Software: What you boot. Hardware: What you kick. +Solve the problems of the world: Vote anarchist. +Some days I look my best in a thick fog. +Some days you're the windshield, some days the bug. +Some nonsense now and then is relished by the wisest men. +Some people are only alive because it is illegal to kill them. +Some settling may have occurred in shipping. +Some thoughts are best guillotined before actions result. +Somehow tuna doesn't taste the same without the dolphin. +Sometimes a cigar is just a cigar. +Sometimes even fools make good suggestions. +Sometimes I wake up grouchy. Most times, I let her sleep. +Sometimes the depths of your ignorance amazes even me. +Sometimes you just have to say 'What the heck' +Sometimes you're a bug, sometimes a windshield +Sometimes you're a Kenworth, sometimes you're a possum. +Sometimes, I wish I could ARJ my wife... +Sometimes, the Dragon wins... +Sooner or later, I'll be free to leave the past behind. +Sorry Congressman... cash only. +Sorry, tomorrow is cancelled due to the lack of interest! +Southern DOS: Y'all reckon? [yep/nope] +Sow dragons teeth, reap trouble. +Spaced Aliens: Columbian drug lords in US. +SPAM - Squirrels, Possum, And Mice. +Speak softly and carry a meat cleaver. +Speed doesn't kill. Stopping very fast kills. +Speed is fine ... accuracy is final. -- Wyatt Earp +Speed kills! Switch to Windows ... +Speed kills; slow just infuriates... +Spindle & Mutilate - See if I care.. +Spiritual Truth thru Superior Weapons +Squeeze Me Hard! I Work Better Under Pressure.... +Squirrels: Rats with good P.R. +Stand aside: I'm fluent in lunatic. +Stand under it, but don't let it lick you. +Start a download. Get a beer. Multitasking. +Stationary mice have bigger balls. +Statistics are no substitute for judgment. +Steven King, eat your heart out. +Strange fits of passion have I known; +Studies show that 51% of Americans are in the majority. +Success is just a matter of luck. Ask any failure. +Success lies in achieving the top of the food chain +Sumo wrestling in the canoe of life. +Support medical examiners--die strangely. +Support NAFTA, export Clinton and Bore +Support nuclear families! The mutants are fun to watch! +Support OS/2: Show NT to your friends! +Support your constitutional right to arm bears. +Support your SysOp... Send your paycheck. +Sure you can trust the government... ask any Indian. +Sure, I stole them. All of them, and I'm *PROUD* of it! HAHAHAHAHA! +Sure, it's embarrassing, but it's over quickly. +Sure, money talks. All mine ever says is goodbye. +SURF NAKED: sharks hate to peel their food +Surrender now - before I have to offer you better terms. +Surrounded? No, we're just in a target rich environment. +Survival Tip #2: Never moon a werewolf. +Survival Tip #3: Never invite Cthulhu over for dinner. +Sushi: Known to the rest of the world as 'Bait'. +Swamp gas usually doesn't create sonic booms. +Swim nude. Sharks hate to peel their food. +Synonym: A word used when you can't spell the first one. +SysOp ('sih sop) n. - The person laughing at your typing. +System error. Strike any user to continue... +SYSTEM ERROR: place sacrifice on keyboard to continue. +SYSTEM FAILURE: PRESS F13 TO CONTINUE! +Tabloid: A newspaper with a permanent crime wave. +Taco Bell is *not* a mexican phone company +Tact is knowing how far to go in going too far. +Tact is knowing how far you can go too far. +Tact: Recalling a lady's birthday but forgetting her age. +Taglines: More interesting than the garbage above. +Take me not for what I seem, but for what I am. +Taking up collection to give Barney a one way ticket to hell. +Talk is cheap... till you hire a lawyer. +TANSTAAFL - There Ain't No Such Thing As A Free Lunch. +Target Shooting - Official Pastime of Nicaraugua +Taxes are not levied for the benefit of the taxed. - RAH +Teamwork is vital. It gives you someone to blame. +Tech Support is Just A Busy Signal Away +Tech Support: Where is it when you need it? +TECHNICALITY: Someone *ELSES* Constitutional rights.. +Tell me, have you ever woken up and realized you were doomed? +Temporal distortion located around workplace clock. +Temporary suspension of disbelief is a wonderful thing. +Terror is also a form of communication. +Thank you for not discussing the outside world. +Thank you for not mooning your checkout girl. +That IS a gun in my pocket, and I AM glad to see you. +That parrot wouldn't VROOM if you put 5000 volts to it! +That rap tune is really the Polyvtsian Dance #2 by Borodin. +That which can be imagined can also actually be realized. +That which does not kill me had better run away damn fast! +That which does not kill us makes us stronger. +That which does not kill us took its ball and went home. +That Which Doesn't Kill Me Better Run Away Damn Fast! +That which makes life good, makes death good also... +That's stronger than a garlic milkshake. +The above opinions are those of my computer! +The absence of alternatives clears the mind marvelously. +The arrogance of age must submit to be taught by youth. +The best blood at times gets into fools and mosquitoes. +The Big Bang is only the universe rebooting. +The bigger they are, the harder they punch. +The Bill of Rights: Void Where Prohibited by Law +The Church has appropriated God for its own ends! - Machiavelli +The dead don't come back to life? Be here at quitting time. +The Department of Agriculture is full of Dirtbags. +The Devil is most devilish when respectable. +THE DEVIL MADE ME DO IT ? NOW OPEN THE CELL DOOR. +The earth is like a tiny grain of sand, only heavier +The Few, The Proud, The Most Frequently Shot At... +The fient a tail she had to shake! +The first ten million years were the worst. +The floggings will continue until morale improves. +The four food groups.. coffee, ice cream, beer and pizza! +The gene pool has no lifeguard +The gene pool needs a lifeguard. +The Gods of one culture become the devils of the next... +The greatest production force is human selfishness. - Heinlein +The height of cleverness is to be able to conceal it. +The hippopotamus rests on his belly in the mud. And you? +The ideal wife is the woman who has an ideal husband. +The illuminati aren't out to get you. What was your name again? +The last sound that it made was "Zap." +The light at the end of the tunnel is a buglight +The living world is a continuum in each and every aspect. +The Magical Mythstery Tour +The moat is off-limits to swimming, except to IRS agents +The more I get to thinking, the less I tend to laugh. +The more I hear about Microsoft, the less I like them. +The most interesting results happen only once. +The Novel: Your imagination intensified. +The only GOOD user is a DEAD user +The only paradise is paradise lost. -Marcel Proust +The only winner of the War of 1812 was Tchaikovsky. +The ox is slow, but the Earth is patient. +The pen is mightier than the sword, but swords are more fun! +The Peregrine Plot Thickens...Alas, we are undone... +The polls show 8 out of 5 schizophrenics agree! +The prince hides his face from the dreams in the mist. +The problem drinker is the one who never buys. +The refrigerator light DOES go out. Now let me out of here. +The Results of your IQ test came back. They're negative. +The Ringworld is Unstable! +The road to hell is paved with legislation. +The road to success is always under construction. +The Roman Empire never died it became the Catholic Church +The Second Amendment -- my concealed-weapons "permit" +The secrecy of my job prevents me from knowing what I do. +The secret of DoubleSpace: Randomly loses half your data +The Strange are strange but to men, but familiar to God. +The sun comes up too early for my liking! +The surest way to be late is to have plenty of time +The tenants are then chopped up by the rotating knifes... +The thrill of the chase is worth the pain. +The toughest thing in business is minding your own. +The trouble with political jokes is they get elected. +The truth is rarely pure, and never simple. (Wilde) +The truth is the safest lie. +The truth, however, is not pertinent to the issue. +The universe by time's fell hand defaced. +The universe is laughing behind your back. +The universe is very BIG. Believe me. +The way to a man's heart is with a broadsword. +The way to a man's heart: between the ribs, and slightly up. +The way to a woman's heart is through her ribs. +The weather's here, wish you were beautiful... +The weed of crime bears bitter fruit but I like the taste +The wise learn more from fools than fools from the wise. +The word today is "legs".....Help spread the word! +The words are there, my dear, but the music is wanting. +The world ended yesterday; sorry, you missed it. +The world ends at 8 P. M.... Film at 11. +The world is a stage, but the play is badly cast. +The worst thing about censorship is ##########. +The X Insurance Co.---How may we shaft you? +There are only 3 lawyer jokes; the rest are true +There Are Three Sides To Every Story. +There are two secrets in life: Never tell everything at once. +There is always one more imbecile than you counted on. +There is infinite hope...... But not for us.... +There is no fool like an old fool. J.Heywood (1497-1580) +There is no intelligence on Earth, I'm just visiting. +There is no Pattern but that we impose on chaos. +There is no problem that cannot be solved by high explosives. +There is no substitute for a genuine lack of preparation. +There is no such thing as bravery; only degrees of fear. +There is no wealth but life. -- John Ruskin +There may be millions of votes, but I'm Gulliver. +There's a light, over at the Frankenstein place. +There's always one more bug. +There's not enough Sax and Violin's on TV +There's nothing a concentrated phaser blast can't solve. +They called him tall in the saddle till his blister broke +They got the library at Alexandria. They're not getting mine. +They say act your age, and when you do they get mad. +They say God made All Men. I say Samuel Colt made all men Equal. +Things are never so bad that they can't get worse. +Things in this room do not react well to bullets. +Things that appear simple, usually aren't. +Things you never hear people say: Please saw my leg off. +Think of it as evolution in action. +This blade here is my best friend.... +This is another fine myth you've gotten me into. +This is beginning to get on my nerves, now that I have some. +This is Discussion; Arguments & Abuse is down the hall. +This message is SHAREWARE! To Register, send $25. +This message will disappear in five seconds +This message will self-destruct in 5 seconds... +This message written with recycled electrons. +This MSG created by pouring warm tea on a Ouiji board. +This offer void except where prohibited by law. +This Space still for rent. Unreasonable rates +This tag is invisible to anyone with a higher IQ than me. +This tagline is a virus. Kis C:\*.* goodbye. +This tagline is NAGWARE! To remove it send $15.00. +This talgine meats all U.S. Guvermnint standerds. +This time he really is dead Jim, he he he. +Thomas Jefferson was a friend of mine... * @TO@ +Those that have the firepower make the rules. +Those truly alive wrestle truly with their own souls. +Those who live by the sword get shot by those who don't. +Those who live by the sword KILL those who don't. +Thou shalt not covet thy neighbor's tagline. +Thou shalt not post messages while drunk. +Three can keep a secret, if two are dead. +Tighten 'til it cracks, then back off 1/2 turn. +Time and distance are out of place here. +Time for the penguin on your telly to explode ..... +Time keeps everything from happening all at once. +Time machine, my foot. Why, it couldn't tell you the time, much less.. +To be, or not to be. What does it really matter... +To boldly go where no man has any business. +To discover one knows nothing is the beginning of wisdom. +To eat or not to eat, the question is whom to eat! +To err is human, to forgive is against company policy. +To err is human, to forgive........$5.00 +To every rule there is an exception, and vice versa. +To get back on your feet, miss 2 car payments. +To live now, first come to terms with your past. +To quote the Librarian at Unseen University, "Oook!" +To really live, you must almost die. +To remove virus, type Format C: at the prompt and... +To scan, or not to scan. There may be a vir^@#@&_*^|> +To strive, to seek, to find, and not to yield. +To take the Genesis online IQ test: press Alt/H +To tolerate everything is to teach nothing. +Today is the first day of the mess of your life. +Too bad about your Rectocranial Inversion. Get well soon +Took an hour to bury the cat. The silly thing kept movin' +Torture: The Ultimate Art Form. +Total is $1000. $10 for the upgrade, and $990 s/h. +Tradition: The art of making the same mistake over and over. +Transplated musical instrument explodes. Organ rejection suspected. +Tree falls in forest. Hits Milli Vanilli. Someone else screams. +Trespassers will be SHOT, survivors will be SHOT again. +Trilogy (n). Series of three books, sometimes more. +Truck Pulls: for people who don't understand WWF. +Trust everyone, but always cut the cards. +Trust me, Ignore the rash. +Truth is shorter than fiction. -Irving Cohen +Try filling a light bulb with gasoline and putting it in a socket. +TV Truth #5: Drinking beer attracts beautiful females. +Twisted mind? No, just bent in several strategic places +Twisted? No, just bent in several strategic places. +Two can live as cheaply as one, for half as long. +Two Great Tennesseans: Charlie and Jack Daniels +Two peanuts were walking down a street, one was assaulted +Type in the Gettysburg Address to continue..._ +Unbounded is thy rage; with varied style +Unfair competition: Selling cheaper than we do. +Unknown Error on Unknown Device for Unexplainable Reason. +Use DEVICE = EXXON to screw up your environment. +Users: Keep them dry and don't feed them after midnight. +Vacation in the billion worlds of a used book store . . . +Vampire making daquiri: blend me a tenor. +Vampire robs sperm bank in state of confusion, news at 11 +Veni Vidi Fetuccini: I came, I saw, I had lunch. +Veni, vidi, clinti: I came, I saw, I lied. +Very good, Einstein, but next time show your work. +Veteran of the Bermuda Triangle Expeditionary Force 1990-1951 +Viking Foreplay: "HEY! YOU! C'MERE!" +Violence in reality is quite different from theory. +Virus located. Delete c:\window\*.*? y/n +Visit your money this year: Vacation in Washington DC +void main (void) { if (windows=="useful") hell=frozen } � +Vote NO with the weapon of your choice. +Wagner's music is better than it sounds. - Twain +Wanderers and nomads have gone to see their chieftains. +Wanna do something big? Pick up a boulder. +Wanna read a good horror novel? Get a history book +Want more grey hair? Teach your child to drive! +Want my guns? Come in range and get them. +Want to own a small business? Buy a big one and wait... +Wanted dead or alive -- Schrodinger's cat! +Wanted: Guillotine operator. Good chance to get ahead. +Wanted: Programmers. Some assembly required. +War is just Nature's way of keeping humanity in check. +War never decides who is right, only who is left. +Warm the Northeast...use aerosol spray! +Warning: bonds skin. +Warnings are for people without imagination. +Warped, and proud of it. +Warped, twisted, sick, and proud of it. +Watch it - You're trying my infinite patience +Ways to skin a cat: #27 --- Use a belt sander. +We are NOT surrounded. We are in a target-rich environment. +We come in peace, shoot to kill. +We come not to discuss reality, but to use the BBS. +We don't care, we don't have to: We're Exxon. +We don't care. We don't have to. We're The Phone Company. +We have enough scientists; we need more hunchbacks, Igor. +We have met the enemy and they is us. +We have nothing to fear but sanity itself. +We must flee before they set loose the marmosets upon us! +We now return to our regularly scheduled flame-throwing. +We said you'd get your money back, we didn't say when. +We should back the Metric system every inch of the way +We used to be Schizophrenic. +We want a war the whole family can watch! +We want peaceful relations, or we'll blow up your planet. +We would gladly feast on those who would subdue us. +We'll get standards even if we have to bribe someone! +We're entering the Bond-Age, in more ways than one. +We've broken the space-time continuum and passed the savings on to you! +We've missed you; we'll aim better next time! +Welcome to hell -- here's your copy of Windows. +Well, at least I'm improving my cold tolerance. +Well, I might be high, but...but I'm REAL fast! +Well, I'd like to see you resist. +Well, it seemed like the thing to do at the time. +Well, it was only plan A; plan B is much more interesting. Really. +Well, it worked the last time I tried this.... +Well, it's got *SOME* rat in it ..... +Whaddya mean you don't STAPLE diskette labels on? +What colour wine is served with BOILED TONGUE? +What does it mean when your fortune cookie is empty? +What does the Infantry call Airborne? Skeet Shoot! +What does this red button do? +What garlic is to salad, insanity is to art. +What has 4 legs and an arm? A pit bull. +What if there were no hypothetical situations? +What is Redneck foreplay? (Nudge) Are you awake? +What is the purpose of hanging up if I'm calling again tomorrow? +What is this tiny hole in the bathroom wall for? +What type of support were you looking for? Tech or Jock? +What we need is a Pizza Door and a Beer Door +What?!? DOSSHELL *isn't* supposed to be a joke? +When all else fails, do something else. +When all else fails, refer to the destructions. +When childhood dies, its corpses are called adults. +When donating your brain to science, make sure science wants it. +When governments fall, people like me are lined up & shot +When I played in the sandbox, the cat kept covering me up. +When I was a kid we had to carve our CPU's out of wood... +When in doubt - comment it out. +When in doubt, attack the old bearded guy in the back. +When in doubt, run in circles and scream and shout. +When life gets weird, the weird get a life. +When need arises, any tool close to you becomes a hammer +When people agree with me, I always feel that I must be wrong. +When subtlety fails us we must resort to cream pies. +When symmetries are broken, things begin. +When the going gets tough, most people leave +When the mind is ready, a teacher appears. - Zen +When you get there, there's no there there. +When you seek it, you cannot find it. -Zen +When's the trial? - Right after the hanging... +Where are we going...and why am I in this handbasket?? +where do they hide those swords????!!! +Where do you find 100 talking invertebrates? The US Senate! +Where might is master, justice is servant. +Where they burn books, people are next. +Which one of you alien sombitch artists made these gawddammed circles? +Which version of the truth would you prefer today? +Which way did they go!? I'm they're leader!! +While the lunatic dreams, the Earth changes +Whip me, beat me and cover me in chocolate. Please. +Whip me; beat me; make me register bad software. +Whips & chains? Sorry, thats a hardware problem. +White dwarf seeks red giant for binary relationship. +Who beta tested Preparations A through G? +Who is General Failure and why's he reading my hard disk? +Who popped the cork on my lunch!? +Who wants to live forever? +Who watches the watchmen? +Who you callin' "argumentative", Bucko? +Whoever said that work was fun, didn't work! +Whom gods would destroy, they first teach MS-DOS. +Whom the mad would destroy, they first make gods. +Why are there so many gnarly limbs on my family tree? +Why be normal? +Why buy Cologne when you can wipe a magazine on yourself. +Why do they put locks on the doors of 24 hour stores? +Why get even, when you can get odd? +Why me? +Why not invite her over for a Scotch and sofa? +Why? +Wife: A slave who demands to be set on a throne� +William K. Smith:"Wait, my uncle Ted can drive you home." +WindowError:001 Windows loaded. System in danger. +WindowError:005 Multitasking attempted. System confused. +WindowError:00F Unexplained Error, Please tell us how it happened. +WindowError:01E Timing error. Please wait eight years... +Windows - the solution to a problem that didn't exist +Windows 3.1 -- The best $89 solitaire game on the market. +Windows Backup Started: Insert disk 1 of 38,544 +Windows Error 005: Multitasking attempted. System confused. +Windows Error: 002 - No error yet ... +Windows Error: 004 - Operator fell asleep while waiting. +Windows is to OS/2 what Etch-a-Sketch is to art. +Windows isn't crippleware: it's "Fuctionally Challenged" +Windows NT: An imaginary OS for your imaginary 686 PC. +Windows NT: Needs Terabytes +Windows NT: The only 80 meg solitaire game. +Windows NT? Is that the new NinTendo GUI? +Windows: big, expensive, pretty virus. +Windows: Proof that MS has a room of monkeys with PC's +Windows: the $89 solution to your excess speed problem. +Windows:(n.)1. Something that comes with the mouse you bought. +Windows:(n.)2. The Gates of hell. +Windows:(n.)4. Proof that God has a sense of humor. +Windoze for Workgroups: Why crash 1 when you can crash 6? +Windws is ine for bckgroun comunicaions - Bll Gats, 192 +Winning or losing doesn't matter until you lose... +Winter is Natures way of saying, "Up Yours!" +Wise Man cross river *THEN* insult alligator. +Wise men make proverbs, but fools repeat them... +With caller ID, Cthulhu hasn't dialed out in ages!... +With consequences, the unexpected always predominate. +Wizard's Guild Parking: Violators will be toad. +Women and cats do as they like. Men and dogs better get used to it. +Women are to be served and obeyed! +Women speak two languages, one of which is verbal� +WOMEN-Wierd Obnoxious Male Enticing Nymphs +Women... you can't live with 'em... pass the beer nuts. +Women: Can't live with 'em, and sheep can't cook. +Won spell Czecker, works grate! $5 oar best offer. +Work fascinates me. I can sit and watch it for hours. +Would all ghouls in the audience please raise their talons? +Would you prefer cache or chkdsk for payment? +WOW! I Didn't know a 386 could smoke like that!!! +Write all complaints legibly in this space -> [] +Written at @TIME@, on @MONTH@ @DATE@ in Knoxville, Tn. +Written on a Cray Laptop (I'm from Texas and I'm BIG) +Yeah, but what's the speed of darkness... +Yes, I do believe that is my axe in your chest... +Yes, son, long ago, mail was written with pen and paper. +You and me against the world? Great! When do we attack?!? +You are only young once, but you can always be immature +You are the Amoeba. You have the power to Flow. +You are the Senate. You have the power to filibuster. +You can lead a man to knowledge, but you cannot make him think. +You can tie me up, but you can't tie me down. +You can trust me. I'm not a doctor. +You CAN trust the government...ask any Indian. +You could have knocked me over with a fender. +You disgust me! Do it some more.... +You don't still use a human and a keyboard do you? +You expect mere PROOF to change my opinion? +You gawddammed aliens keep your ship out of my wheat field!!! +You got any more taglines I can plagerize? +You haven't lived a full life until you're dead. +You hold 'em off, I'll go for help. (heh-heh-heh) +You Klingon son, you killed my bastard... err, wait... +You know what they say about paradigms: shift happens +You know, my sister was bitten by a moose once... +You laughable bowl of mutilated cow cud. +You live and learn. Or you don't live long. - Robert Heinlein +You make it we take it. +You may be recognized soon. Perhaps you should hide? +You may be Southern -- but you're no Comfort. +You now have 10 minutes to reach a safe distance. +You remind me of myself, confused and hungover... +You seem a decent fellow. I hate to kill you. +You shall know the truth, and it shall make you odd. +You should presently be able to deal from a full deck. +You'll never be the man your mother was! +You're a Redneck if: You're entertained by a 6-pack +You're all insane and trying to steal my magic bag +You're floatin' for a slit-throatin'... +You're in a maze of twisty echo conferences, all alike. +You're never too old to learn something stupid. +You're really strange @TO@, really strange... +You're right - now shut up, someone might hear you.... +You're sick and you're twisted...Are we related??? +You're staring at me like I'm driving the nails. +You're twisted and sick, I like that in a person. +You're twisted, perverted and sick. I like that. +You're worse than a fungus... +You've got nicer legs than Hitler... +Your eyes are a striking shade of (insert color) +Your father is waiting for you in the toolshed... +Your friendly neighbourhood Thought Police . . . +Your Lucky Number Has Been Disconnected. +Your mileage may vary. Your car may not run. +Your new credit limit is $1. Have a nice day. +Your proctologist called. He found your head. +Yours for the asking. Torture never works. +Yur'assic Park: Where you butt is on the line daily +Zealots have fanatical tendencies. +Zen Crafters - enlightenment in about an hour. +Zen Druids practice Transcendental Vegetation. +Zo! Lie here and tell me about your mother, Herr Heinlein! +Zymurgy is the best hobby around, homemade hangovers... +[Maxim XII] Plan and Replan Your Sequence -Brown +_You_ see a coffin. _I_ see a cheap living module. diff --git a/SOURCE/UNUSED/TAGSTAT.PAS b/SOURCE/UNUSED/TAGSTAT.PAS new file mode 100644 index 0000000..7548ea0 --- /dev/null +++ b/SOURCE/UNUSED/TAGSTAT.PAS @@ -0,0 +1,1722 @@ +{$M 35500,0,131072} +program tagstat; + +uses + crt, + dos, + Common; + +type + Str39 = STRING[39]; + Str43 = STRING[43]; + Str78 = STRING[78]; + + genrec = record + name : str43; + info : real; + END; + + (* + fileinfo = record + recnum: word; + filename: str12; + description: str78; + Downloaded: word; + unused: byte; + blocks: word; + owner: str36; + date: LongInt; + daten: word; + FIFlags: FIFlagSet; + points: byte; + dirpath: pathstr; + dirname: str8; + DLPath: str30; + FAflags: FAFlagSet; + areaname: str39; + area: word; + END; + + b_array = ARRAY[1..20] OF boolean; + d_array = ARRAY[1..20] OF str8; + e_array = ARRAY[1..10] OF word; + f_array = ARRAY[1..20] OF fileinfo; + g_array = ARRAY[1..20] OF longint; + gsysactivity = ARRAY[1..20] OF real; + h_array = ARRAY[1..19] OF word; + m_array = ARRAY[1..3] OF word; + *) + t_array = ARRAY[1..10] OF genrec; + + (* + configinfo = record + exuser: e_array; + graph_fg, + graph_bg, + logdays, + dldsl: byte; + use_real: boolean; + END; + *) + +VAR + (* + config: configinfo; + uage: m_array; + usex: m_array; + gdate: d_array; + ubaud: h_array; + tttimeon: t_array; + tfreqc: t_array; + tulk: t_array; + tdlk: t_array; + tprivp: t_array; + *) + tpubp: t_array; + (* + tfeedback: t_array; + tnumc: t_array; + tnumul: t_array; + tnumdl: t_array; + tfilep: t_array; + tupd: t_array; + tpostc: t_array; + gsysact: gsysactivity; + gmina: g_array; + gnumc: g_array; + gnewu: g_array; + gtimeu: g_array; + gmsgpub: g_array; + gmsgpvt: g_array; + gmsgfb: g_array; + gnume: g_array; + gful: g_array; + gulkb: g_array; + gfdl: g_array; + gdlkb: g_array; + frec: f_array; + *) + +FUNCTION RealToStr(L: Real; W,D: Integer): STRING; +VAR + S: STRING[11]; +BEGIN + Str(L:W:D,S); + RealToStr := s; +END; + +FUNCTION RmvLeadSpace(S: STRING): STRING; +BEGIN +END; + +FUNCTION RmvTrailSpace(S: STRING): STRING; +BEGIN +END; + +FUNCTION Min(X,Y: Integer): Integer; +BEGIN +END; + +FUNCTION Max(X,Y: Integer): Integer; +BEGIN +END; + +function graph_month(s: str8): str3; +BEGIN + CASE StrToInt(copy(s,1,2)) OF + 1 : graph_month := 'Jan'; + 2 : graph_month := 'Feb'; + 3 : graph_month := 'Mar'; + 4 : graph_month := 'Apr'; + 5 : graph_month := 'May'; + 6 : graph_month := 'Jun'; + 7 : graph_month := 'Jul'; + 8 : graph_month := 'Aug'; + 9 : graph_month := 'Sep'; + 10 : graph_month := 'Oct'; + 11 : graph_month := 'Nov'; + 12 : graph_month := 'Dec'; + END; +END; + +function reverse_str(s: str160): str160; +VAR + s1: str160; + Counter: byte; +BEGIN + s1 := ''; + FOR Counter := 20 downto 1 DO + s1 := s1 + s[Counter]; + reverse_str := rmvleadspace(rmvtrailspace(s1)); +END; + +function center(s: str160; i: integer; tf: boolean): str160; +VAR + Counter,strlength: integer; + which_way: boolean; +BEGIN + which_way := tf; + strlength := length(s); + FOR Counter := (strlength + 1) to i 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; + +function return_time(w,w1: word): str160; +BEGIN + IF (w > 0) AND (w1 > 0) THEN + return_time := IntToStr(trunc(w div w1)) + ELSE + return_time := '0'; +END; + +function age(s: str160): str160; +BEGIN + age := IntToStr(StrToInt(copy(datestr,7,2)) - StrToInt(copy(s,7,2))); +END; + +function return_age(userbday: str160): str160; +VAR + today,user_years: str160; +BEGIN + today := datestr; + user_years := age(userbday); + IF (StrToInt(copy(userbday,1,2)) > StrToInt(copy(today,1,2))) THEN + user_years := IntToStr(StrToInt(user_years)-1) + ELSE + IF (StrToInt(copy(userbday,1,2)) = StrToInt(copy(today,1,2))) THEN + IF (StrToInt(copy(userbday,4,2)) > StrToInt(copy(today,4,2))) THEN + user_years := IntToStr(StrToInt(user_years)-1); + return_age := user_years; +END; + +(* +PROCEDURE read_config_file(VAR config: configinfo); +VAR + f: text; + line,line1: str160; + Counter,counter1: byte; +BEGIN + Assign(f,'TAGSTAT.CFG'); + {$I-} Reset(f); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access TAGSTAT.CFG!'); + Halt; + END; + textcolor(lightgray); + textbackground(black); + WITH config DO + BEGIN + FOR counter1 := 1 to 10 DO + exuser[counter1] := 0; + graph_fg := 9; + graph_bg := 7; + logdays := 0; + dldsl := 255; + use_real := false; + END; + Counter := 1; + counter1 := 0; + while not eof(f) DO + BEGIN + {$I-} readln(f,line); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to read TAGSTAT.CFG!'); + {$I-} Close(f); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close TAGSTAT.CFG!'); + Halt; + END; + line := rmvleadspace(rmvtrailspace(line)); + line1 := allcaps(line); + IF (line1 <> '') AND (line1[1] <> '%') THEN + BEGIN + IF (pos('USER_EXCLUDE',line1) = 1) AND (counter1 < 10) THEN + BEGIN + delete(line,1,12); + inc(counter1); + config.exuser[counter1] := StrToInt(rmvleadspace(line)); + END + ELSE IF (pos('DOWNLOAD_DSL',line1) = 1) THEN + BEGIN + delete(line,1,12); + config.dldsl := StrToInt(rmvleadspace(line)); + IF (config.dldsl < 0) OR (config.dldsl > 255) THEN + config.dldsl := 255; + END + ELSE IF (pos('REAL_NAME',line1) = 1) THEN + config.use_real := true + ELSE IF (pos('GRAPH_BACKGROUND',line1) = 1) THEN + BEGIN + delete(line,1,16); + config.graph_bg := StrToInt(rmvleadspace(line)); + IF (config.graph_bg < 0) OR (config.graph_bg > 15) THEN + config.graph_bg := 7; + END + ELSE IF (pos('GRAPH_BARS',line1) = 1) THEN + BEGIN + delete(line,1,10); + config.graph_fg := StrToInt(rmvleadspace(line)); + IF (config.graph_fg < 0) OR (config.graph_fg > 15) THEN + config.graph_fg := 9; + END; + END; + END; + {$I-} Close(f); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close TAGSTAT.CFG!'); + Halt; + END; +END; +*) + +(* +PROCEDURE init_d_array(VAR gdate: d_array); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 20 DO + gdate[Counter] := ''; +END; + +PROCEDURE init_f_array(VAR ar: f_array); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 20 DO + WITH ar[Counter] DO + BEGIN + recnum := 0; + filename := ''; + description := ''; + Downloaded := 0; + unused := 0; + blocks := 0; + owner := ''; + date := 0; + daten := 0; + FIflags := []; + points := 0; + dirpath := ''; + dirname := ''; + DLPath := ''; + FAflags := []; + areaname := ''; + area := 0; + END; +END; + +PROCEDURE init_g_array(VAR ar: g_array; info_val: longint); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 20 DO + ar[Counter] := info_val; +END; + +PROCEDURE init_gsysactivity(VAR gsysact: gsysactivity); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 20 DO + gsysact[Counter] := 0.0; +END; + +PROCEDURE init_h_array(VAR ar: h_array; info_val: word); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 19 DO + ar[Counter] := info_val; +END; + +PROCEDURE init_m_array(VAR ar: m_array; info_val: word); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 3 DO + ar[Counter] := info_val; +END; + +*) +PROCEDURE init_t_array(VAR ar: t_array; info_val: real); +VAR + Counter: byte; +BEGIN + FOR Counter := 1 to 10 DO + BEGIN + ar[Counter].name := ''; + ar[Counter].info := info_val; + END; +END; + +PROCEDURE sort_ascending(s: str43; r: real; VAR tfreqc: t_array); +VAR + Counter,counter1: byte; +BEGIN + IF (r > 0.0) THEN + FOR Counter := 1 to 10 DO + IF (r <= tfreqc[Counter].info) THEN + BEGIN + FOR counter1 := 10 downto (Counter + 1) DO + tfreqc[counter1] := tfreqc[counter1-1]; + tfreqc[Counter].name := s; + tfreqc[Counter].info := r; + Counter := 10; + END; +END; + +PROCEDURE sort_descending(s: str43; r: real; VAR ar: t_array); +VAR + Counter,counter1: byte; +BEGIN + IF (r > 0.0) THEN + FOR Counter := 1 to 10 DO + IF (r >= ar[Counter].info) THEN + BEGIN + FOR counter1 := 10 downto (Counter + 1) DO + ar[counter1] := ar[counter1 - 1]; + ar[Counter].name := s; + ar[Counter].info := r; + Counter := 10; + END; +END; + +(* +function in_array(w: word; exuser: e_array): boolean; +VAR + Counter: byte; + tf: boolean; +BEGIN + tf := false; + FOR Counter := 1 to 10 DO + IF (w = exuser[Counter]) THEN + tf := true; + in_array := tf; +END; +*) + +PROCEDURE read_user_file(General: GeneralRecordType; VAR config: configinfo; VAR uage, + usex: m_array; VAR ubaud: h_array; VAR tfreqc,tttimeon, + tulk,tdlk,tprivp,tpubp,tfeedback,tnumc,tnumul,tnumdl, + tfilep,tupd,tpostc: t_array); +const + maxuserblock = 30000 div sizeof(UserRecordType); {* Allocate 30K *} +type + userblocktype = ARRAY[1..maxuserblock] OF UserRecordType; +VAR + uf: FILE; + userblock: ^userblocktype; + recnum,numusers,unum: word; + totuage: longint; + Counter,userage: byte; + calltot,realuserblockcount: integer; + name: str43; +BEGIN + Assign(uf,General.DataPath+'USER.LST'); + {$I-} Reset(uf,sizeof(UserRecordType)); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access USER.LST!'); + Halt; + END; + new(userblock); + init_m_array(uage,0); + init_m_array(usex,0); + init_h_array(ubaud,0); + init_t_array(tfreqc,255.000); + init_t_array(tttimeon,0.000); + init_t_array(tulk,0.000); + init_t_array(tdlk,0.000); + init_t_array(tprivp,0.000); + init_t_array(tpubp,0.000); + init_t_array(tfeedback,0.000); + init_t_array(tnumc,0.000); + init_t_array(tnumul,0.000); + init_t_array(tnumdl,0.000);; + init_t_array(tfilep,0.000); + init_t_array(tupd,0.000); + init_t_array(tpostc,0.000); + recnum := 0; + numusers := 0; + totuage := 0; + uage[2] := 255; + seek(uf,1); + REPEAT + blockread(uf,userblock^,maxuserblock,realuserblockcount); + FOR unum := 1 to realuserblockcount DO + WITH userblock^[unum] DO + BEGIN + inc(recnum); + calltot := 0; + IF (recnum = usernum) AND not in_array(usernum,config.exuser) THEN + BEGIN + userage := AgeUser(BirthDate); + Inc(totuage,userage); + uage[2] := min(uage[2],userage); + uage[3] := max(userage,uage[3]); + IF (Sex = 'M') THEN + inc(usex[1]) + ELSE IF (Sex = 'F') THEN + inc(usex[2]) + ELSE + inc(usex[3]); + (* + IF (hbaud = 300) THEN + inc(ubaud[1]) + ELSE IF (hbaud = 1200) THEN + inc(ubaud[2]) + ELSE IF (hbaud = 1275) THEN + inc(ubaud[3]) + ELSE IF (hbaud = 2400) THEN + inc(ubaud[4]) + ELSE IF (hbaud = 4800) THEN + inc(ubaud[5]) + ELSE IF (hbaud = 7200) THEN + inc(ubaud[6]) + ELSE IF (hbaud = 9600) THEN + inc(ubaud[7]) + ELSE IF (hbaud = 12000) THEN + inc(ubaud[8]) + ELSE IF (hbaud = 14400) THEN + inc(ubaud[9]) + ELSE IF (hbaud = 16800) THEN + inc(ubaud[10]) + ELSE IF (hbaud = 19200) THEN + inc(ubaud[11]) + ELSE IF (hbaud = 21600) THEN + inc(ubaud[12]) + ELSE IF (hbaud = 24000) THEN + inc(ubaud[13]) + ELSE IF (hbaud = 26400) THEN + inc(ubaud[14]) + ELSE IF (hbaud = 28800) THEN + inc(ubaud[15]) + ELSE IF (hbaud = 38400) THEN + inc(ubaud[16]) + ELSE IF (hbaud = 57600) THEN + inc(ubaud[17]) + ELSE IF (hbaud = 64000) THEN + inc(ubaud[18]) + ELSE IF (hbaud = 115200) THEN + inc(ubaud[19]); + *) + IF config.use_real THEN + name := allcaps(RealName)+' #'+IntToStr(usernum) + ELSE + name := Name+' #'+IntToStr(usernum); + sort_ascending(name,calltot/15,tfreqc); + sort_descending(name,ttimeon,tttimeon); + sort_descending(name,uk,tulk); + sort_descending(name,dk,tdlk); + sort_descending(name,emailsent,tprivp); + sort_descending(name,msgpost,tpubp); + sort_descending(name,feedback,tfeedback); + sort_descending(name,loggedon,tnumc); + sort_descending(name,uploads,tnumul); + sort_descending(name,downloads,tnumdl); + sort_descending(name,credit,tfilep); + (* + sort_descending(name,uk/maxr(1.0,dlk),tupd); + sort_descending(name,msgpost/maxr(1.0,numcalls),tpostc); + inc(numusers); + *) + END; + END; + UNTIL (realuserblockcount < maxuserblock); + dispose(userblock); + uage[1] := totuage div numusers; + {$I-} Close(uf); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close USER.LST!'); + Halt; + END; +END; + +PROCEDURE read_usage_file(General: GeneralRecordType; VAR config: configinfo; VAR + gdate: d_array; VAR gsysact: gsysactivity; VAR + gmina,gnumc,gnewu,gtimeu,gmsgpub,gmsgpvt,gmsgfb, + gnume,gful,gulkb,gfdl,gdlkb: g_array); +VAR + ul: text; + line: str160; + Counter: byte; + + function ajust_int_size(l,size: longint): longint; + BEGIN + IF (l < 0) THEN + ajust_int_size := 0 + ELSE IF (l > size) THEN + ajust_int_size := size + ELSE + ajust_int_size := l; + END; + + function ajust_real_size(r,size: real): real; + BEGIN + IF (r < 0.0) THEN + ajust_real_size := 0.0 + ELSE IF (r > size) THEN + ajust_real_size := size + ELSE + ajust_real_size := r; + END; + +BEGIN + Assign(ul,General.DataPath+'USAGE.LOG'); + {$I-} Reset(ul); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access USAGE.LOG!'); + Halt; + END; + init_d_array(gdate); + init_g_array(gmina,0); + init_g_array(gnumc,0); + init_g_array(gnewu,0); + init_gsysactivity(gsysact); + init_g_array(gtimeu,0); + init_g_array(gmsgpub,0); + init_g_array(gmsgpvt,0); + init_g_array(gmsgfb,0); + init_g_array(gnume,0); + init_g_array(gful,0); + init_g_array(gulkb,0); + init_g_array(gfdl,0); + init_g_array(gdlkb,0); + FOR Counter := 1 to 5 DO + BEGIN + {$I-} readln(ul); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to read USAGE.LOG!'); + {$I-} Close(ul); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close USAGE.LOG!'); + Halt; + END; + END; + FOR Counter := 1 to 20 DO + IF not eof(ul) THEN + BEGIN + {$I-} readln(ul,line); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to read USAGE.LOG!'); + {$I-} Close(ul); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close USAGE.LOG!'); + Halt; + END; + gdate[Counter] := copy(line,1,8); + delete(line,1,8); + gmina[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,6))),99999); + delete(line,1,6); + gnumc[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gnewu[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gsysact[Counter] := ajust_real_size(valuer(rmvleadspace(copy(line,1,6))),100.0); + delete(line,1,6); + gtimeu[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gmsgpub[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gmsgpvt[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gmsgfb[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gnume[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gful[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gulkb[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,7))),999999); + delete(line,1,7); + gfdl[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,5))),9999); + delete(line,1,5); + gdlkb[Counter] := ajust_int_size(StrToInt(rmvleadspace(copy(line,1,7))),999999); + inc(config.logdays); + END; + {$I-} Close(ul); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close USAGE.LOG!'); + Halt; + END; +END; + +(* +read_dir_file(dirpathname,uboards.filename,uboards.name,uboards.dlpathname, + uboards.noratiogroupnum shr 1,tempgrp,uboards.seenames, + uboards.flags,frec); +*) + +PROCEDURE read_dir_file(dirpath: pathstr; dirname: str8; name: str160; + dlpath: str30; area: word; + FAflags: FAFlagSet; VAR frec: f_array); +const + maxfileblock = 30000 div sizeof(FileInfoRecordType); {* Allocate 30K *} +type + fileblocktype = ARRAY[1..maxfileblock] OF FileInfoRecordType; +VAR + udir: FILE; + fileblock: ^fileblocktype; + Counter,counter1: byte; + fnum,realfileblockcount,recnum: word; +BEGIN + Assign(udir,dirpath+dirname+'.DIR'); + {$I-} Reset(udir,sizeof(FileInfoRecordType)); {$I+} + IF (IOResult = 0) THEN + BEGIN + IF (filesize(udir) > 1) THEN + BEGIN + recnum := 0; + new(fileblock); + seek(udir,1); + REPEAT + blockread(udir,fileblock^,maxfileblock,realfileblockcount); + FOR fnum := 1 to realfileblockcount DO + BEGIN + inc(recnum); + FOR Counter := 1 to 20 DO + IF (fileblock^[fnum].Downloaded > frec[Counter].Downloaded) THEN + BEGIN + IF (Counter <= (20 - 1)) THEN + FOR counter1 := (20 - 1) downto Counter DO + frec[counter1 + 1] := frec[counter1]; + frec[Counter].recnum := recnum; + frec[Counter].filename := fileblock^[fnum].filename; + frec[Counter].description := fileblock^[fnum].description; + frec[Counter].Downloaded := fileblock^[fnum].Downloaded; + frec[Counter].blocks := fileblock^[fnum].blocks; + frec[Counter].owner := fileblock^[fnum].ownername; + frec[Counter].date := fileblock^[fnum].date; + frec[Counter].daten := fileblock^[fnum].daten; + frec[Counter].FIflags := fileblock^[fnum].fIFlags; + frec[Counter].points := fileblock^[fnum].credits; + frec[Counter].dirpath := dirpath; + frec[Counter].dirname := dirname; + frec[Counter].DLPath := dlpath; + frec[Counter].FAflags := FAflags; + frec[Counter].areaname := name; + frec[Counter].area := area; + Counter := 20; + END; + END; + UNTIL (realfileblockcount < maxfileblock); + dispose(fileblock); + END; + {$I-} Close(udir); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close '+dirname+'.DIR!'); + Halt; + END; + END; +END; + +PROCEDURE read_fboard_file(General: GeneralRecordType; VAR frec: f_array); +VAR + FileAreaFile: FILE OF FileAreaRecordType; + Filearea: FileAreaRecordType; + dirpathname: str160; + Counter: byte; + grp: ARRAY[0..127] OF integer; + tempgrp: integer; +BEGIN + Assign(FileAreaFile,General.DataPath+'FBOARDS.DAT'); + {$I-} Reset(FileAreaFile); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access FBOARDS.DAT!'); + Halt; + END; + FOR Counter := 0 to 127 DO + grp[Counter] := -1; + tempgrp := -1; + init_f_array(frec); + while not eof(FileAreaFile) DO + BEGIN + {$I-} read(FileAreaFile,Filearea); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to read FBOARDS.DAT!'); + {$I-} Close(FileAreaFile); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close FBOARDS.DAT!'); + Halt; + END; + (* + IF General.dynamicfile THEN + BEGIN + inc(grp[Filearea.noratiogroupnum shr 1]); + tempgrp := grp[Filearea.noratiogroupnum shr 1]; + END + ELSE + inc(tempgrp); + *) + dirpathname := Filearea.DLPath; + (* + IF (Filearea.dsl <= thisuser.dsl) AND (Filearea.arlvl IN thisuser.ar) OR + (Filearea.dsl <= thisuser.dsl) AND (Filearea.arlvl = '@') THEN + BEGIN + *) + + read_dir_file(dirpathname,Filearea.filename,Filearea.name,Filearea.DLPath,Counter, + Filearea.FAflags,frec); + (* + END; + *) + END; + {$I-} Close(FileAreaFile); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close FBOARDS.DAT!'); + Halt; + END; +END; + +(* +PROCEDURE menu_line(c,c1: Char; s,s1: str160); +BEGIN + IF (c <> ' ') THEN + BEGIN + IF (length(s) > 32) THEN + s := copy(s,1,32); + Prompt(#3'1['#3'3'+c+#3'1] : '+addspace(s,33,false)); + END + ELSE + Prompt(addspace(s,39,true)); + IF (c1 <> ' ') THEN + BEGIN + IF (length(s1) > 32) THEN + s1 := copy(s1,1,32); + Prompt(#3'1['#3'3'+c1+#3'1] : '+addspace(s1,33,false)); + END; + NL; +END; + +PROCEDURE menu1_line(c: Char; s: str160); +BEGIN + IF (length(s) > 73) THEN + s := copy(s,1,73); + PrintACR(#3'1['#3'3'+c+#3'1] : '+s); +END; +*) + +PROCEDURE sys_menu_line(s,s1: str160); +BEGIN + Prompt(#3'1'+s+#3'0'+s1); +END; + +PROCEDURE sys_menu_line1(s,s1: str160); +BEGIN + PrintACR(#3'1'+s+#3'0'+s1); +END; + +PROCEDURE hdr(s: str160); +BEGIN + CLS; + PrintACR(#3'5'+center('-=[ '+s+' ]=-',78,true)); + NL; +END; + +(* +PROCEDURE ftr(s: str160); +BEGIN + NL; + menu1_line('Q','Return To '+s); + NL; + Prompt(#3'4['#3'1'+realtostr1(nsl / 60,0,0)+' Mins Left'#3'4] Enter Command > '#3'1'); +END; +*) + +PROCEDURE display_t_array(decimal,width: byte; t_ar: t_array; title, + header: str160); +VAR + Counter,counter1: byte; +BEGIN + hdr('Top 10 '+title); + PrintACR(#3'2## User Name '+center(header,55,true)); + NL; + FOR Counter := 1 to 10 DO + BEGIN + Prompt(#3'4'+PadRightStr(IntToStr(Counter),2)); + IF (config.use_real) AND (t_ar[Counter].name = allcaps(thisuser.RealName)+' #'+IntToStr(usernum)) + OR (t_ar[Counter].name = thisuser.Name+' #'+IntToStr(usernum)) THEN + Prompt(' '#3'8'+t_ar[Counter].name+' '#3'9') + ELSE + Prompt(' '#3'1'+t_ar[Counter].name+' '#3'9'); + FOR counter1 := (length(t_ar[Counter].name) + 1) to 42 DO + Prompt('.'); + IF (t_ar[Counter].info > 0) THEN + PrintACR(#3'4'+PadRightStr(realtostr(t_ar[counter].info,0,decimal),width)) + ELSE + NL; + END; + PauseScr(FALSE); +END; + +(* +PROCEDURE display_t_freqcall(decimal,width: byte; t_ar: t_array; title, + header: str160); +VAR + Counter,counter1: byte; +BEGIN + hdr('Top 10 '+title); + PrintACR(#3'2## User Name '+center(header,55,true)); + NL; + FOR Counter := 1 to 10 DO + BEGIN + Prompt(#3'4'+addspace(IntToStr(Counter),2,true)); + IF config.use_real AND (t_ar[Counter].name = allcaps(thisuser.RealName)+' #'+IntToStr(thisuser.usernum)) + OR (t_ar[Counter].name = thisuser.Name+' #'+IntToStr(thisuser.usernum)) THEN + Prompt(' '#3'8'+t_ar[Counter].name+' '#3'9') + ELSE + Prompt(' '#3'1'+t_ar[Counter].name+' '#3'9'); + FOR counter1 := (length(t_ar[Counter].name) + 1) to 42 DO + Prompt('.'); + IF (t_ar[Counter].info < 255) THEN + PrintACR(#3'4'+addspace(realtostr1(t_ar[Counter].info,0,decimal),width,true)) + ELSE + NL; + END; + PauseScr(FALSE); +END; +*) + +(* +PROCEDURE graph_yes(tf: boolean; VAR first: b_array; i,g_fg,g_bg: byte); +BEGIN + IF (ANSI IN thisuser.Flags) THEN + BEGIN + ds_textcolor(g_fg); + Prompt('栢'); + IF first[i] THEN + BEGIN + ds_textcolor(g_bg); + Prompt('�'); + first[i] := false; + END + ELSE + BEGIN + ds_textcolor(black); + Prompt('�'); + IF not tf THEN + ds_textcolor(g_bg); + END; + END + ELSE + Prompt('###'); +END; + +PROCEDURE graph_no; +BEGIN + IF (ANSI IN thisuser.Flags) THEN + Prompt('栢�') + ELSE + Prompt('...'); +END; + +PROCEDURE display_g_sysactivity(config: configinfo; gdate: d_array; gsysact: + gsysactivity; s: str160); +VAR + first: b_array; + Counter,counter1: byte; + average: real; + tf: boolean; +BEGIN + FOR Counter := 1 to 20 DO + first[Counter] := true; + average := 0.0; + CLS; + PrintACR(#3'5 '+center('-=[ Graph Of System Activity By Percentage ]=-',60,true)); + FOR Counter := 20 downto 1 DO + BEGIN + average := average + gsysact[Counter]; + IF (copy(s,Counter,1) <> ' ') THEN + Prompt(#3'5'+copy(s,Counter,1)) + ELSE + Prompt(' '); + Prompt(#3'2'+addspace(IntToStr(Counter * 5),7,true)+'% '); + FOR counter1 := 20 downto 1 DO + IF (gsysact[counter1] >= (Counter * 5)) THEN + BEGIN + tf := true; + IF (counter1 > 1) THEN + BEGIN + tf := false; + IF (gsysact[counter1 - 1] >= Counter * 5) THEN + tf := true; + END; + graph_yes(tf,first,counter1,config.graph_fg,config.graph_bg) + END + ELSE + BEGIN + IF (counter1 = 20) THEN + ds_textcolor(config.graph_bg); + graph_no; + END; + NL; + END; + ds_ansi_color(2); + tf := false; + FOR Counter := 20 downto 1 DO + IF (gdate[Counter] <> '') AND not tf THEN + BEGIN + Prompt(addspace(graph_month(gdate[Counter])+' ',11,true)); + tf := true; + END; + IF not tf THEN + Prompt(' '); + FOR Counter := 20 downto 1 DO + IF (gdate[Counter] <> '') THEN + Prompt(copy(gdate[Counter],4,2)+' ') + ELSE + Prompt(' '); + IF (gdate[1] <> '') THEN + PrintACR(graph_month(gdate[1])) + ELSE + NL; + average := average / config.logdays; + PrintACR(#3'5 '+center('(Average '+reverse_str(s)+': '+realtostr1(average,0,0)+'%)',60,true)); + PauseScr(FALSE); +END; + +PROCEDURE display_g_array(config: configinfo; gdate: d_array; g_ar: g_array; + title,side: str160; increment: longint); +VAR + first: b_array; + Counter,counter1: byte; + average: longint; + tf: boolean; +BEGIN + FOR Counter := 1 to 20 DO + first[Counter] := true; + average := 0; + CLS; + PrintACR(#3'5 '+center('-=[ Graph Of '+title+' ]=-',60,true)); + FOR Counter := 20 downto 1 DO + BEGIN + Inc(average,g_ar[Counter]); + IF (copy(side,Counter,1) <> ' ') THEN + Prompt(#3'5'+copy(side,Counter,1)) + ELSE + Prompt(' '); + Prompt(#3'2'+addspace(IntToStr(Counter * increment),7,true)+' '); + FOR counter1 := 20 downto 1 DO + IF (g_ar[counter1] >= (Counter * increment)) THEN + BEGIN + tf := true; + IF (counter1 > 1) THEN + BEGIN + tf := false; + IF (g_ar[counter1 - 1] >= (Counter * increment)) THEN + tf := true; + END; + graph_yes(tf,first,counter1,config.graph_fg,config.graph_bg) + END + ELSE + BEGIN + IF (counter1 = 20) THEN + ds_textcolor(config.graph_bg); + graph_no; + END; + NL; + END; + ds_ansi_color(2); + tf := false; + FOR Counter := 20 downto 1 DO + IF (gdate[Counter] <> '') AND not tf THEN + BEGIN + Prompt(addspace(graph_month(gdate[Counter])+' ',11,true)); + tf := true; + END; + IF not tf THEN + Prompt(' '); + FOR Counter := 20 downto 1 DO + IF (gdate[Counter] <> '') THEN + Prompt(copy(gdate[Counter],4,2)+' ') + ELSE + Prompt(' '); + IF (gdate[1] <> '') THEN + PrintACR(graph_month(gdate[1])) + ELSE + NL; + average := average div config.logdays; + PrintACR(#3'5 '+center('(Average '+reverse_str(side)+': '+IntToStr(average)+')',60,true)); + PauseScr(FALSE); +END; + +function div_g(g: g_array): longint; +VAR + i: byte; + Counter: longint; + big: longint; + num: real; + + function div_size(num: real): longint; + BEGIN + IF (num <= 1) THEN + div_size := 1 + ELSE IF (num < 2) THEN + div_size := 2 + ELSE IF (num < 3) THEN + div_size := 3 + ELSE IF (num < 4) THEN + div_size := 4 + ELSE IF (num < 5) THEN + div_size := 5 + ELSE + BEGIN + Counter := 5; + REPEAT + Inc(Counter); + UNTIL (num > 999999) OR (Counter > num); + div_size := Counter; + END; + END; + +BEGIN + big := 0; + FOR i := 1 to 20 DO + big := max(big,g[i]); + num := big / 20; + div_g := div_size(num); +END; + +PROCEDURE display_m_array(m_ar: m_array; title,desc1,desc2,desc3: str160; StrToInt: byte); +VAR + len: byte; + + PROCEDURE m_line(s: str160; w: word); + VAR + Counter: byte; + BEGIN + Prompt(#3'1'+s+' '#3'9'); + FOR Counter := 1 to (len - length(s)) DO + Prompt('.'); + PrintACR(#3'4'+addspace(IntToStr(w),StrToInt+1,true)); + END; + +BEGIN + len := 0; + len := max(len,length(desc1)); + len := max(len,length(desc2)); + len := max(len,length(desc3)); + Inc(len,3); + hdr(title); + m_line(desc1,m_ar[1]); + m_line(desc2,m_ar[2]); + IF (desc3 = 'Total Not Specified') AND (m_ar[3] > 0) OR (desc3 = 'The Oldest User Is') THEN + m_line(desc3,m_ar[3]); + PauseScr(FALSE); +END; + +PROCEDURE display_h_array(ubaud: h_array); + + PROCEDURE baud_line(s: str160; w: word); + VAR + Counter: byte; + BEGIN + Prompt(#3'1Total '+s+' Baud Callers '#3'9'); + FOR Counter := 1 to (27 - length('Total '+s+' Baud Callers')) DO + Prompt('.'); + PrintACR(#3'4'+addspace(IntToStr(w),6,true)); + END; + +BEGIN + hdr('User Baud Rate Statistics'); + IF (ubaud[1] > 0) THEN + baud_line('300',ubaud[1]); + IF (ubaud[2] > 0) THEN + baud_line('1200',ubaud[2]); + IF (ubaud[3] > 0) THEN + baud_line('1275',ubaud[3]); + IF (ubaud[4] > 0) THEN + baud_line('2400',ubaud[4]); + IF (ubaud[5] > 0) THEN + baud_line('4800',ubaud[5]); + IF (ubaud[6] > 0) THEN + baud_line('7200',ubaud[6]); + IF (ubaud[7] > 0) THEN + baud_line('9600',ubaud[7]); + IF (ubaud[8] > 0) THEN + baud_line('12000',ubaud[8]); + IF (ubaud[9] > 0) THEN + baud_line('14400',ubaud[9]); + IF (ubaud[10] > 0) THEN + baud_line('16800',ubaud[10]); + IF (ubaud[11] > 0) THEN + baud_line('19200',ubaud[11]); + IF (ubaud[12] > 0) THEN + baud_line('21600',ubaud[12]); + IF (ubaud[13] > 0) THEN + baud_line('24000',ubaud[13]); + IF (ubaud[14] > 0) THEN + baud_line('26400',ubaud[14]); + IF (ubaud[15] > 0) THEN + baud_line('28800',ubaud[15]); + IF (ubaud[16] > 0) THEN + baud_line('38400',ubaud[16]); + IF (ubaud[17] > 0) THEN + baud_line('57600',ubaud[17]); + IF (ubaud[18] > 0) THEN + baud_line('64000',ubaud[18]); + IF (ubaud[19] > 0) THEN + baud_line('115200',ubaud[19]); + PauseScr(FALSE); +END; + +PROCEDURE todayusage(General: GeneralRecordType); +BEGIN + CLS; + WITH General DO + BEGIN + PrintACR(#3'5'+center('-=[ Todays Usage ]=-',78,true)); + sys_menu_line(' Date:',datestr); + sys_menu_line1(' Time:',timestr); + NL; + sys_menu_line1('Board Name :',boardname); + sys_menu_line1('Node Number :',IntToStr(nodenumber)); + sys_menu_line1('Board Address :',boardcitystate); + sys_menu_line1('SysOp Name :',sysopname); + sys_menu_line1('Phone Number :',boardphone); + sys_menu_line('Mail Address :',IntToStr(address.zone)+':'+IntToStr(address.net)+'/'+IntToStr(address.node)); + IF (address.point > 0) THEN + PrintACR('.'+IntToStr(address.point)) + ELSE + NL; + sys_menu_line1('BBS Software :','T.A.G. Version '+lasttagversion); + NL; + sys_menu_line1('Total Calls :',realtostr1(callernum,0,0)); + sys_menu_line1('Number Of Users :',realtostr1(users,0,0)); + sys_menu_line1('Last Caller :',lastcaller); + NL; + PrintACR(#3'5'+center('-=[ Summary Of Activity ]=-',78,true)); + sys_menu_line('Minutes Active :',addspace(IntToStr(activetoday),9,false)); + sys_menu_line('Calls Today :',addspace(IntToStr(callstoday),9,false)); + sys_menu_line1('New Users Today :',addspace(IntToStr(nuserstoday),9,false)); + sys_menu_line('Percent Active :',addspace(return_percent(activetoday),9,false)); + sys_menu_line('Time/User :',addspace(return_time(activetoday,callstoday),9,false)); + sys_menu_line1('Public Posts :',addspace(IntToStr(msgposttoday),9,false)); + sys_menu_line('Private Posts :',addspace(IntToStr(emailtoday),9,false)); + sys_menu_line('Feedback Sent :',addspace(IntToStr(fbacktoday),9,false)); + sys_menu_line1('Errors Today :',addspace(IntToStr(errorstoday),9,false)); + sys_menu_line('Number Uploads :',addspace(IntToStr(ultoday),9,false)); + sys_menu_line('UL K-Bytes :',addspace(realtostr1(ulktoday,0,0)+'K',9,false)); + sys_menu_line1('Number Downloads:',addspace(IntToStr(dltoday),9,false)); + sys_menu_line1('DL K-Bytes :',addspace(realtostr1(dlktoday,0,0)+'K',9,false)); + END; + PauseScr(FALSE); +END; + +PROCEDURE chlen(s: str78; i,i1: integer); +VAR + line1,line2,temp: str160; + Counter: integer; +BEGIN + s := rmvleadspace(rmvtrailspace(s)); + while (pos(' ',s) > 0) DO + delete(s,pos(' ',s),1); + IF (length(s) > i) THEN + BEGIN + line1 := copy(s,1,i); + while (line1[length(line1)] <> ' ') DO + BEGIN + delete(line1,length(line1),1); + dec(i); + END; + line1 := rmvtrailspace(line1); + line2 := copy(s,i + 1,length(s)); + line2 := rmvleadspace(line2); + temp := ''; + FOR Counter := 1 to i1 DO + temp := ' ' + temp; + PrintACR(#3'0'+line1); + Prompt(temp); + Prompt(#3'1:'); + PrintACR(#3'0'+line2); + END + ELSE + PrintACR(#3'0'+s); +END; + +PROCEDURE write_status_file(General: GeneralRecordType); +VAR + systatf: FILE OF GeneralRecordType; +BEGIN + Assign(systatf,paramstr(1)+'\RENEGADE.DAT'); + {$I-} Reset(systatf); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access STATUS.DAT!'); + Halt; + END; + {$I-} Write(systatf,General); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close STATUS.DAT!'); + {$I-} Close(systatf); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close STATUS.DAT!'); + Halt; + END; + {$I-} Close(systatf); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close STATUS.DAT!'); + Halt; + END; +END; + +PROCEDURE write_user_file(user: UserRecordType); +VAR + uf: FILE OF UserRecordType; + fvar: dos.filerec; +BEGIN + Assign(uf,General.DataPath+'USER.LST'); + {$I-} Reset(uf); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access USER.LST!'); + Halt; + END; + seek(uf,user.usernum); + WITH fvar DO + lockfile(handle,lock,user.usernum*recsize,recsize); + {$I-} Write(uf,user); {$I+} + WITH fvar DO + lockfile(handle,unlock,user.usernum*recsize,recsize); + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close USER.LST!'); + {$I-} Close(uf); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close USER.LST!'); + Halt; + END; + {$I-} Close(uf); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close USER.LST!'); + Halt; + END; +END; + +PROCEDURE write_dir_file(b: byte; frec: f_array); +VAR + udir: FILE OF FileInfoRecordType; + udirfile: FileInfoRecordType; + fvar: dos.filerec; +BEGIN + Assign(udir,frec[b].dirpath+frec[b].dirname+'.DIR'); + {$I-} Reset(udir); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to access '+frec[b].dirname+'.DIR!'); + Halt; + END; + WITH udirfile DO + BEGIN + filename := frec[b].filename; + description := frec[b].description; + Downloaded := frec[b].Downloaded + 1; + unused := frec[b].unused; + blocks := frec[b].blocks; + owner := frec[b].owner; + date := frec[b].date; + daten := frec[b].daten; + flag := frec[b].flag; + points := frec[b].points; + END; + seek(udir,frec[b].recnum); + WITH fvar DO + lockfile(handle,lock,frec[b].recnum*recsize,recsize); + {$I-} Write(udir,udirfile); {$I+} + WITH fvar DO + lockfile(handle,unlock,frec[b].recnum*recsize,recsize); + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close '+frec[b].dirname+'.DIR!'); + {$I-} Close(udir); {$I+} + IF (IOResult <> 0) THEN + WriteLn(^G^G^G'Unable to close '+frec[b].dirname+'.DIR!'); + Halt; + END; + {$I-} Close(udir); {$I+} + IF (IOResult <> 0) THEN + BEGIN + WriteLn(^G^G^G'Unable to close '+frec[b].dirname+'.DIR!'); + Halt; + END; +END; + +PROCEDURE top20file(frec: f_array); +VAR + c: Char; + s,s1: str160; + Counter,counter1: byte; + tempsize: longint; + tf: boolean; +BEGIN + REPEAT + REPEAT + counter1 := 0; + c := #0; + s := ''; + hdr('Top 20 Files Downloaded'); + PrintACR(#3'2## Filename.Ext Number Downloads ## Filename.Ext Number Downloads'); + NL; + FOR Counter := 1 to 10 DO + BEGIN + Prompt(#3'4'+addspace(IntToStr(Counter),2,true)); + Prompt(#3'1'+addspace(frec[Counter].filename,15,true)); + IF (frec[Counter].Downloaded > 0) THEN + BEGIN + Prompt(#3'4'+addspace(IntToStr(frec[Counter].Downloaded),12,true)); + inc(counter1); + END + ELSE + Prompt(' '); + Prompt(' '); + Prompt(#3'4'+addspace(IntToStr(Counter+10),2,true)); + Prompt(#3'1'+addspace(frec[Counter+10].filename,15,true)); + IF (frec[Counter+10].Downloaded > 0) THEN + BEGIN + PrintACR(#3'4'+addspace(IntToStr(frec[Counter+10].Downloaded),12,true)); + inc(counter1); + END + ELSE + PrintACR(' '); + END; + NL; + menu1_line('#','Number for Extended File Information'); + menu1_line('Q','Return To T.A.G. Statistics File Menu'); + NL; + Prompt(#3'4['#3'1'+realtostr1(nsl / 60,0,0)+' Mins Left'#3'4] Enter Command > '#3'1'); + IF (length(IntToStr(counter1)) = 1) THEN + BEGIN + FOR Counter := 1 to counter1 DO + s := s + IntToStr(Counter); + OneK(c,'Q'+s); + s := c; + END + ELSE + BEGIN + ds_input(s,2,false,false,true,false); + s := rmvleadspace(s); + END; + UNTIL (s <> #1) OR ds_hangup; + IF (StrToInt(s) >= 1) AND (StrToInt(s) <= counter1) THEN + BEGIN + hdr('Extended File Information'); + WITH frec[StrToInt(s)] DO + BEGIN + PrintACR(#3'1Group # :'#3'5'+IntToStr(group)); + PrintACR(#3'1Area # :'#3'5'+IntToStr(area)); + PrintACR(#3'1Area Name :'#3'5'+striptagcodes(areaname)); + Prompt(#3'1File Name :'#3'0'+rmvspace(filename)); + IF (notvalidated IN flag) THEN + Prompt(#3'8 '); + NL; + Prompt(#3'1Description :'); + chlen(description,65,13); + PrintACR(#3'1File Points :'#3'5'+IntToStr(points)); + Prompt(#3'1File Size :'); + tempsize := blocks; + Prompt(#3'5'+IntToStr(tempsize * 128)+' Bytes / '); + Prompt(IntToStr(tempsize)+' XModem Blks / '); + PrintACR(realtostr1(((tempsize * 128) + 1023) / 1024,0,0)+' YModem Blks'); + PrintACR(#3'1Date U/L''ed :'#3'5'+date); + PrintACR(#3'1Times D/L''ed :'#3'3'+IntToStr(Downloaded)); + IF (thisuser.dsl >= seenames) THEN + PrintACR(#3'1Uploaded By :'#3'3'+owner); + NL; + IF (thisuser.dsl >= config.dldsl) THEN + BEGIN + Prompt(#3'7Download file (y/[N]? '); + IF ds_yesnoresp THEN + BEGIN + NL; + tf := true; + IF (ISCDROM IN flags) THEN + BEGIN + Prompt('Copying file ... '); + swapvectors; + exec(getenv('COMSPEC'),'/C copy '+DLPath+rmvspace(filename)+ + ' '+copy(General.tempdlpath,1,length(General.tempdlpath)-1)); + swapvectors; + IF (doserror = 0) THEN + BEGIN + PrintACR('Successful'); + DLPath := General.tempdlpath; + tf := true; + END + ELSE + BEGIN + PrintACR('Failed'); + tf := false; + END; + NL; + END; + IF tf THEN + BEGIN + Prompt('['#3'3X'#3'1]Modem, ['#3'3Y'#3'1]Modem, ['#3'3Z'#3'1]Modem, ['#3'3Q'#3'1]uit: '); + OneK(c,'QXYZ'); + CASE c OF + 'X' : s1 := 'protocol dsz port '+IntToStr(General.comport)+' sx -s '+DLPath+rmvspace(filename); + 'Y' : s1 := 'protocol dsz port '+IntToStr(General.comport)+' sb -s '+DLPath+rmvspace(filename); + 'Z' : s1 := 'protocol dsz port '+IntToStr(General.comport)+' sz -m -s '+DLPath+rmvspace(filename); + END; + IF (c <> 'Q') THEN + BEGIN + NL; + Prompt('Ready to send file, ^X to abort...'); + swapvectors; + exec(getenv('COMSPEC'),'/C '+s1); + swapvectors; + delay(2000); + General.dlktoday := General.dlktoday + (((tempsize * 128) + 1023) / 1024); + Inc(General.dltoday); + write_status_file(General); + thisuser.dlk := thisuser.dlk + (((tempsize * 128) + 1023) / 1024); + Inc(thisuser.numdl); + write_user_file(thisuser); + write_dir_file(StrToInt(s),frec); + ds_sysop_window; + END; + END; + END; + END + ELSE + PauseScr(FALSE); + END; + END; + UNTIL (s[1] = 'Q') OR DS_hangup; +END; + + +PROCEDURE mainmenuscr(bbsname: str160); +BEGIN + hdr('T.A.G. Statistics Main Menu'); + menu1_line('A','User Statistics'); + menu1_line('B','Usage Statistics'); + menu1_line('C','File Statistics'); + ftr(bbsname); +END; + +PROCEDURE usermenuscr; +BEGIN + hdr('T.A.G. Statistics User Menu'); + menu1_line('A','Top 10 User Menu'); + menu1_line('B','User Age'); + menu1_line('C','User Gender'); + menu1_line('D','User Baud Rate'); + ftr('T.A.G. Statistics Main Menu'); +END; + +PROCEDURE usagemenuscr; +BEGIN + hdr('T.A.G. Statistics Usage Menu'); + menu1_line('A','Usage Graph Menu'); + menu1_line('B','Todays Usage'); + ftr('T.A.G. Statistics Main Menu'); +END; + +PROCEDURE fboardmenuscr; +BEGIN + hdr('T.A.G. Statistics File Menu'); + menu1_line('A','Top 20 Files Downloaded'); + ftr('T.A.G. Statistics Main Menu'); +END; + +PROCEDURE top10menuscr; +BEGIN + hdr('T.A.G. Statistics Top 10 User Menu'); + menu_line('A','B','Most Frequent Callers','High Time Users'); + menu_line('C','D','File Kbyte Uploaders','File Kbyte Downloaders'); + menu_line('E','F','Private Message Senders','Public Message Posters'); + menu_line('G','H','SysOp Feedback Senders','All Time Callers'); + menu_line('I','J','File Uploaders','File Downloaders'); + menu_line('K','L','File Points','Upload/Download Ratios'); + menu_line('M',' ','Post/Call Ratios',''); + ftr('T.A.G. Statistics User Menu'); +END; + +PROCEDURE graph20menuscr; +BEGIN + hdr('T.A.G. Statistics Usage Graph Menu'); + menu_line('A','B','Minutes Active','Number Of Calls'); + menu_line('C','D','New User Logons','System Activity'); + menu_line('E','F','Average Time/User','Public Message Posting'); + menu_line('G','H','Private Message Posting','SysOp Feedback Sent'); + menu_line('I','J','Number Of Errors','File Uploads'); + menu_line('K','L','File Kbytes Uploaded','File Downloads'); + menu_line('M',' ','File Kbytes Downloaded',''); + ftr('T.A.G. Statistics Usage Menu'); +END; + +PROCEDURE mainmenu(General: GeneralRecordType; config: configinfo; tfreqc,tttimeon, + tulk,tdlk,tprivp,tpubp,tfeedback,tnumc, + tnumul,tnumdl,tfilep,tupd,tpostc: t_array; gdate: d_array; + gsysact: gsysactivity; gmina,gnumc,gnewu,gtimeu,gmsgpub, + gmsgpvt,gmsgfb,gnume,gful,gulkb,gfdl,gdlkb: g_array; + uage,usex: m_array; ubaud: h_array; frec: f_array); +VAR + c: Char; +BEGIN + REPEAT + mainmenuscr(General.boardname); + OneK(c,'QABC'); + CASE c OF + 'A' : BEGIN + REPEAT + usermenuscr; + OneK(c,'QABCD'); + CASE c OF + 'A' : BEGIN + REPEAT + top10menuscr; + OneK(c,'QABCDEFGHIJKLM'); + CASE c OF + 'A' : display_t_freqcall(3,12,tfreqc,'Most Frequent Callers', + 'Average Number Of Days Between Calls'); + 'B' : display_t_array(0,8,tttimeon,'High Time Users', + 'Total Number Of Minutes Online'); + 'C' : display_t_array(0,8,tulk,'File Kbyte Uploaders', + 'Number Of Kbytes Uploaded'); + 'D' : display_t_array(0,8,tdlk,'File Kbyte Downloaders', + 'Number Of Kbytes Downloaded'); + 'E' : display_t_array(0,6,tprivp,'Private Message Senders', + 'Number Of Private Messages Sent'); + 'F' : display_t_array(0,6,tpubp,'Public Message Posters', + 'Number Of Public Messages Posted'); + 'G' : display_t_array(0,6,tfeedback,'SysOp Feedback Senders', + 'Number Of SysOp Feedback Sent'); + 'H' : display_t_array(0,6,tnumc,'All Time Callers', + 'Number Of Calls To The System'); + 'I' : display_t_array(0,6,tnumul,'File Uploaders', + 'Number Of Files Uploaded'); + 'J' : display_t_array(0,6,tnumdl,'File Downloaders', + 'Number Of Files Downloaded'); + 'K' : display_t_array(0,6,tfilep,'File Points', + 'Amount Of File Points On Hand'); + 'L' : display_t_array(3,12,tupd,'Upload/Download Ratios', + 'Number Of KB Uploaded for Each KB Downloaded'); + 'M' : display_t_array(3,12,tpostc,'Post/Call Ratios', + 'Number Of Public Messages Posted Each Call'); + END; + UNTIL (c = 'Q') OR ds_hangup; + c := #0; + END; + 'B' : display_m_array(uage,'User Age Statistics','The Average User Age Is', + 'The Youngest User Is','The Oldest User Is',3); + 'C' : display_m_array(usex,'User Gender Statistics','Total Male Users', + 'Total Female Users','Total Not Specified',5); + 'D' : display_h_array(ubaud); + END; + UNTIL (c = 'Q') OR ds_hangup; + c := #0; + END; + 'B' : BEGIN + REPEAT + usagemenuscr; + OneK(c,'QAB'); + CASE c OF + 'A' : BEGIN + REPEAT + graph20menuscr; + OneK(c,'QABCDEFGHIJKLM'); + CASE c OF + 'A' : display_g_array(config,gdate,gmina,'Total Minutes Active', + ' setuniM ',div_g(gmina)); + 'B' : display_g_array(config,gdate,gnumc,'Total Calls', + ' sllaC ',div_g(gnumc)); + 'C' : display_g_array(config,gdate,gnewu,'New User Logons To System', + ' sresU weN ',div_g(gnewu)); + 'D' : display_g_sysactivity(config,gdate,gsysact,' tnecreP '); + 'E' : display_g_array(config,gdate,gtimeu,'Average Time/User', + ' setuniM ',div_g(gtimeu)); + 'F' : display_g_array(config,gdate,gmsgpub,'Public Messages Posted', + ' segasseM ',div_g(gmsgpub)); + 'G' : display_g_array(config,gdate,gmsgpvt,'Private Messages Sent', + ' segasseM ',div_g(gmsgpvt)); + 'H' : display_g_array(config,gdate,gmsgfb,'SysOp Feedback Sent', + ' segasseM ',div_g(gmsgfb)); + 'I' : display_g_array(config,gdate,gnume,'Logon Errors', + ' srorrE ',div_g(gnume)); + 'J' : display_g_array(config,gdate,gful,'File Uploads', + ' seliF ',div_g(gful)); + 'K' : display_g_array(config,gdate,gulkb,'Total Upload Kbytes', + ' setybK ',div_g(gulkb)); + 'L' : display_g_array(config,gdate,gfdl,'File Downloads', + ' seliF ',div_g(gfdl)); + 'M' : display_g_array(config,gdate,gdlkb,'Total Download Kbytes', + ' setybK ',div_g(gdlkb)); + END; + UNTIL (c = 'Q') OR ds_hangup; + c := #0; + END; + 'B' : todayusage(General); + END; + UNTIL (c = 'Q') OR ds_hangup; + c := #0; + END; + 'C' : BEGIN + REPEAT + fboardmenuscr; + OneK(c,'QA'); + CASE c OF + 'A' : top20file(frec); + END; + UNTIL (c = 'Q') OR DS_hangup; + c := #0; + END; + END; + UNTIL (c = 'Q') OR DS_hangup; +END; +*) + +VAR + GeneralFile: FILE OF GeneralRecordType; + General: GeneralRecordType; + +BEGIN + (* + read_config_file(config,chatconfig); + read_usage_file(General,config,gdate,gsysact,gmina,gnumc,gnewu,gtimeu, + gmsgpub,gmsgpvt,gmsgfb,gnume,gful,gulkb,gfdl,gdlkb); + *) + Assign(GeneralFile,'C:\RG\RENEGADE.DAT'); + Reset(GeneralFile); + Read(GeneralFile,General); + Close(GeneralFile); + + read_user_file(General,config,uage,usex,ubaud,tfreqc,tttimeon,tulk,tdlk, + tprivp,tpubp,tfeedback,tnumc,tnumul,tnumdl,tfilep,tupd, + tpostc); + display_t_array(0,6,tpubp,'Public Message Posters','Number Of Public Messages Posted'); + (* + read_fboard_file(General,frec); + mainmenu(General,config,tfreqc,tttimeon,tulk,tdlk,tprivp,tpubp, + tfeedback,tnumc,tnumul,tnumdl,tfilep,tupd,tpostc,gdate,gsysact, + gmina,gnumc,gnewu,gtimeu,gmsgpub,gmsgpvt,gmsgfb,gnume,gful,gulkb, + gfdl,gdlkb,uage,usex,ubaud,frec); + *) +END. diff --git a/SOURCE/UNUSED/TEMP6.BAT b/SOURCE/UNUSED/TEMP6.BAT new file mode 100644 index 0000000..36a118a --- /dev/null +++ b/SOURCE/UNUSED/TEMP6.BAT @@ -0,0 +1,8 @@ +@ECHO OFF +F: +CD F:\RG\TEMP6\ARC +F:\RG\ARCS\PKUNZIP -o F:\RG\FILES\NEWUP\TDRAW463.ZIP FILE_ID.DIZ DESC.SDI +:DONE +F: +CD F:\RG110 +Exit diff --git a/SOURCE/UNUSED/TIMEBANK.TPU b/SOURCE/UNUSED/TIMEBANK.TPU new file mode 100644 index 0000000..0dd343f Binary files /dev/null and b/SOURCE/UNUSED/TIMEBANK.TPU differ diff --git a/SOURCE/UNUSED/TIMEFUNC.TPU b/SOURCE/UNUSED/TIMEFUNC.TPU new file mode 100644 index 0000000..605e052 Binary files /dev/null and b/SOURCE/UNUSED/TIMEFUNC.TPU differ diff --git a/SOURCE/UNUSED/TPX.DSK b/SOURCE/UNUSED/TPX.DSK new file mode 100644 index 0000000..00c2e2b Binary files /dev/null and b/SOURCE/UNUSED/TPX.DSK differ diff --git a/SOURCE/UNUSED/TPX.TP b/SOURCE/UNUSED/TPX.TP new file mode 100644 index 0000000..c7475f9 Binary files /dev/null and b/SOURCE/UNUSED/TPX.TP differ diff --git a/SOURCE/UNUSED/TURBO.DSK b/SOURCE/UNUSED/TURBO.DSK new file mode 100644 index 0000000..53c6de9 Binary files /dev/null and b/SOURCE/UNUSED/TURBO.DSK differ diff --git a/SOURCE/UNUSED/USER.PAS b/SOURCE/UNUSED/USER.PAS new file mode 100644 index 0000000..32d5ea2 --- /dev/null +++ b/SOURCE/UNUSED/USER.PAS @@ -0,0 +1,328 @@ +{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} + +{ User related functions } + +unit User; + +interface + +uses + common; + +procedure changeconf(var v:str8); +procedure finduserws(var x:integer); +procedure changearflags(const cms:astr); +procedure changeacflags(const cms:astr); +procedure finduser(var usernum:integer); +procedure InsertIndex(uname:astr;usernum:integer;IsReal,IsDeleted:boolean); + +implementation + +uses + dos; + +procedure changeconf(var v:str8); +var + c:char; + done:boolean; + + procedure listconfs; + var i,onlin:byte; + s:string[100]; + + begin + printf('conflist'); + if not nofile then exit; + cls; + abort:=FALSE; next:=FALSE; + s:='^0N'+seperator+'Title'; + if (thisuser.linelen>=80) then s:=mln(s,38)+seperator+s; + print(s); + s:='^4=:===================================='; + if (thisuser.linelen>=80) then s:=s+':'+s; + print(s); + i:=1; + onlin:=0; + while (i<=27) and (not abort) and (not hangup) do begin + c:=chr(i+63); + if (aacs(confr.conference[c].acs)) and (confr.conference[c].name<>'') then begin + s:='^0'+c+' ^3'+confr.conference[c].name; + inc(onlin); + s:=mln(s,39); + if (onlin=1) then prompt(s) + else begin + if (thisuser.linelen<80) then nl; + print(s); + onlin:=0; + end; + end; + wkey; + inc(i); + end; + if (onlin=1) and (thisuser.linelen>=80) then nl; + end; + +begin + nl; + done:=false; + if v<>'' then c:=v[1] else c:=#0; + if (c>='@') and (c<='Z') and aacs(confr.conference[c].acs) then begin + currentconf:=c; + thisuser.lastconf:=c; + printf('conf'+c); + end else if c='?' then listconfs + else begin + print(^M^J'^4Current conference: ^5%CT - %CN'); + repeat + prompt(^M^J'^4Join which conference (^3?^4=^3List^4): '); + c:=upcase(char(getkey)); + print(c + ^M^J); + if (c>='@') and (c<='Z') then begin + if (aacs(confr.conference[c].acs)) and (confr.conference[c].name<>'') then begin + printf('conf'+c); + if nofile then print('Conference joined.'); + currentconf:=c; + thisuser.lastconf:=c; + done:=true; + nl + end else print('No such conference.'); + end else if c='?' then listconfs; + until (c=#13) or (done) or (hangup); + end; + newcomptables; +end; + +procedure finduserws(var x:integer); +var user:UserRecordType; + IndexR:useridxrec; + nn:astr; + gg,j:integer; + c:char; + done,asked:boolean; +begin + linput(nn,36); + if (nn='SYSOP') then nn:='1'; + x:=value(nn); + if (x>0) then begin + if (x > (maxusers - 1)) then + begin + print(^M^J'Unknown User.'); + x:=0; + end else loadurec(user,x); + end else + if (nn<>'') then begin + done:=FALSE; asked:=FALSE; + x := searchuser(nn, CoSysOp); + if (x > 0) then + exit; + reset(sf); + gg:=0; j:=filesize(sf); + while (gg 0) and + ((not IndexR.RealName) or (CoSysOp)) then + if ((IndexR.Name = nn) or (CoSysOp and (IndexR.Name = nn))) and + (Indexr.number <= (maxusers - 1)) then + x := Indexr.Number + else begin + if (not asked) then begin nl; asked:=TRUE; end; + prompt('^1Did you mean ^3' + caps(IndexR.Name) + '^1? '); + onek(c,'QYN'^M); + done:=TRUE; + case c of + 'Q':x:=-1; + 'Y':x:= IndexR.Number; + else + done:=FALSE; + end; + end; + end; + close(sf); + if (x=0) then print(^M^J'User not found.'); + if x=-1 then x:=0; + end; + Lasterror := IOResult; +end; + +procedure changearflags(const cms:astr); +var + c,cc:char; + i:byte; + +begin + for i:=1 to (length(cms)-1) do + begin + c := upcase(cms[i]); + cc := upcase(cms[i+1]); + case c of + '+':Include(thisuser.ar,cc); + '-':Exclude(thisuser.ar,cc); + '!':if (upcase(cms[i + 1]) in thisuser.ar) then + Exclude(thisuser.ar,cc) + else + Include(thisuser.ar,cc); + end; + end; + + newcomptables; + update_screen; +end; + +procedure changeacflags(const cms:astr); +var + c,cc:char; + i:byte; +begin + for i:=1 to length(cms)-1 do + begin + c:=upcase(cms[i]); + cc := upcase(cms[i+1]); + case c of + '+':Include(thisuser.flags,tacch(cc)); + '-':Exclude(thisuser.flags,tacch(cc)); + '!':acch(upcase(cms[i+1]),thisuser); + end; + end; + newcomptables; + update_screen; +end; + +procedure finduser(var usernum:integer); +var user:UserRecordType; + nn:astr; + ii:integer; +begin + usernum:=0; + linput(nn,36); + + if (nn='NEW') then + begin + usernum := -1; + exit; + end; + + if (nn='?') then exit; + + while (pos(' ',nn)<>0) do + delete(nn,pos(' ',nn),1); + + while (nn[1] = ' ') and (length(nn) > 0) do + delete(nn,1,1); + + if ((hangup) or (nn='')) then exit; + usernum:=value(nn); + if (usernum<>0) then begin + if (usernum<0) then + usernum:=0 + else begin + if (usernum > (maxusers - 1)) then + usernum := 0 + else + begin + loadurec(user,usernum); + if (deleted in user.sflags) then + usernum:=0; + end; + end; + end else begin + if (nn <> '') then begin + ii := searchuser(nn, TRUE); + if (ii <> 0) then + begin + loadurec(user,ii); + if not (deleted in user.sflags) then + usernum:=ii + else + usernum:=0; + end; + end; + end; +end; + +procedure InsertIndex(Uname:astr; usernum:integer; IsReal, IsDeleted:boolean); +var + IndexR:useridxrec; + Current:integer; + InsertAt:integer; + SFO,Done:boolean; + + procedure WriteIndex; + begin + with IndexR do + begin + fillchar(IndexR, sizeof(IndexR), 0); + Name := Uname; + Number := UserNum; + RealName:= IsReal; + Deleted := IsDeleted; + Left := -1; + Right := -1; + write(sf, IndexR); + end + end; + +begin + Done := FALSE; + Uname := Allcaps(Uname); + Current := 0; + + SFO := (filerec(sf).mode<>fmclosed); + + if (not SFO) then + reset(sf); + + if (filesize(sf) = 0) then + WriteIndex + else + repeat + seek(sf, Current); + InsertAt := Current; + read(sf, IndexR); + if (Uname < IndexR.Name) then + Current := IndexR.Left + else + if (Uname > IndexR.Name) then + Current := IndexR.Right + else + if (IndexR.Deleted <> IsDeleted) then + begin + Done := TRUE; + IndexR.Deleted := IsDeleted; + IndexR.RealName := IsReal; + IndexR.Number := Usernum; + seek(sf, Current); + write(sf,IndexR); + end + else + begin + if (Usernum <> IndexR.Number) then + sysoplog('Note: Duplicate user ' + UName + ' #' + cstr(IndexR.Number) + + ' and ' + UName + ' #' + cstr(Usernum)) + else + begin + IndexR.RealName := FALSE; + seek(sf, Current); { Make it be his handle if it's BOTH } + write(sf, IndexR); + end; + Done := TRUE; + end; + until (Current = -1) or (Done); + + if (Current = -1) then + begin + if (Uname < IndexR.Name) then + IndexR.Left := filesize(sf) + else + IndexR.Right := filesize(sf); + seek(sf, InsertAt); + write(sf, IndexR); + seek(sf, filesize(sf)); + WriteIndex; + end; + if (not SFO) then + close(sf); + Lasterror := IOResult; +end; + +end. diff --git a/SOURCE/UNUSED/VOTE.TPU b/SOURCE/UNUSED/VOTE.TPU new file mode 100644 index 0000000..1f9e448 Binary files /dev/null and b/SOURCE/UNUSED/VOTE.TPU differ diff --git a/SOURCE/UNUSED/WD110107.TXT b/SOURCE/UNUSED/WD110107.TXT new file mode 100644 index 0000000..24a9b7c --- /dev/null +++ b/SOURCE/UNUSED/WD110107.TXT @@ -0,0 +1,50 @@ +Renegade Updates + +FC Cmd (Files.BBS Importer) + +1. Optimized by removing a duplicate procedure. +2. Reports duplicate files in the Sysop.log. +3. Reports missing files in the Sysop.log. +4. The "Hatched" flag is now set for all imported files. +5. The user can now enter file points per file uploaded when not + in the waiting for caller screen (Parameter switch -F). +6. All User/System upload statistics are checked for variable overrun. + +*1 Cmd (Edit Files) + +1. File name change will no longer allow renaming a file if the new file + names exists in the upload or download path. +2. The Filesize limit as been increased to allow for a maximum of 1.9 Gigs. + You now also have the choice of updating with the actual file size or + entering whatever you like up to the 1.9 Gig limit. +3. You may now interactively edit the file description. +4. Changing the user name or number now reports an error if the user + does not exist. +5. Changing the upload date of the file will not allow entry of a date + beyond the current date. +6. The number of downloads has been increased to allow up to 2147483647. +7. The modify extended description option has been revamped. If one exists, + you will first be asked if you would like to delete it, if one doesn't, you + will be asked if you would like to create one. If you decide to keep the + exisiting one or created one, you will be taken to the standard full screen + message editor, the old line by line edit mode has been removed. Existing + extended descriptions will be copied into the message editor for editing. + All message editing option are available for line edit or full screen edit + mode. +8. The file move cmd has been revamped provides clearer error message. +9. The User Editor option will now display messages if the user doesn't meet + the access requirement and also default to User #1 if the current owner + of the file has been deleted. +10. All User/System upload statistics are checked for variable overrun. + +Please add this note to the one about ext desc now being 99 lines + +NOTE: + + The way extended description were handled has been revamped. Prior to this + release, every extended description required 950 bytes of hard drive space rather + the description required it or not and was limited to 19 lines. This version now + allows up to 99 lines of 50 chars each and will only require space for the + actual characters utilized plus one byte for every line in the description. + For example: "This is a great file" would only require 20 + 1 byte or 21 bytes + of harddrive space verses the old minimum of 950 bytes. \ No newline at end of file diff --git a/SOURCE/UNUSED/WD110207.TXT b/SOURCE/UNUSED/WD110207.TXT new file mode 100644 index 0000000..0c585a0 --- /dev/null +++ b/SOURCE/UNUSED/WD110207.TXT @@ -0,0 +1,6 @@ +Renegade Updates + +FC Cmd (Files.BBS Importer) + +1. File_ID.DIZ will only be checked if allowed by System Config + setting. \ No newline at end of file diff --git a/SOURCE/UNUSED/WD110307.TXT b/SOURCE/UNUSED/WD110307.TXT new file mode 100644 index 0000000..ede38c0 --- /dev/null +++ b/SOURCE/UNUSED/WD110307.TXT @@ -0,0 +1,48 @@ +Renegade Updates + + +FC Cmd (Files.BBS Importer) + +1. File_ID.DIZ will only be checked if allowed by System Config + setting. + + +*1 Cmd (Edit Files) + +1. While editing the file owner name, the owner name will be checked + against the user name stored in the user editor. If the names do + not match, the file owner name will be converted to the Sysop name + (User #1). The editor will assume that the orignal uploader account + has been deleted. + +2. While updating the file size, if the file does not exist, you will be + asked if you would like to set the file to offline or request status. + +3. Use File_ID.DIZ must now be turn on in System Config to be able to + update or upload the Extended Description (if it exists). + +5. The internal archive viewer will now only attempt to display files with + the following extentions (ZIP,ARC,PAK,ZOO,LZH,ARK,ARJ). IF the extention + is valid and the file doesn't exist, you will be prompted to set the + file to offline or to request status. + +OB Cmd (User Statistics) + +1. Renegade now has built in User Top 10 Statistics. I recommend that + a new menu be created for these cmds. Menu options are listed below + along with the title of the action performed. + + Option Top 10 Result + + A High Time Users + B File Kbyte Uploaders + C File Kbyte Downloaders + D Private Message Senders + E Public Message Posters + F SysOp Feedback Senders + G All Time Callers + H File Uploaders + I File Downloaders + J File Points + K Upload/Download Ratios + L Post/Call Ratios diff --git a/SOURCE/UNUSED/WFCMENU.TPU b/SOURCE/UNUSED/WFCMENU.TPU new file mode 100644 index 0000000..7fbba4c Binary files /dev/null and b/SOURCE/UNUSED/WFCMENU.TPU differ diff --git a/SOURCE/UNUSED/WFCNEW1.ANS b/SOURCE/UNUSED/WFCNEW1.ANS new file mode 100644 index 0000000..81f2b31 --- /dev/null +++ b/SOURCE/UNUSED/WFCNEW1.ANS @@ -0,0 +1,25 @@ +[?7h The Renegade Bulletin Board System  + 旼컴컴컴컴컴컴컴컴� 旼컴컴컴컴컴컴컴컴� 旼컴컴컴컴컴컴컴컴� 旼컴컴컴컴컴컴컴�� + � Today's Stats � � System Averages � � System Totals � � Critical Info � + � Newusers � � Calls � � Calls � � Errors � + � Calls � � Posts � � Posts � � GB Free � + � Posts � � #/GB UL � � #/GB UL � � Feedback � + � #/GB UL � � #/GB DL � � #/GB DL � � � + � #/GB DL � � Activity � � Days � � � + �컴컴컴컴컴컴컴컴켸 �컴컴컴컴컴컴컴컴켸 �컴컴컴컴컴컴컴컴켸 �컴컴컴컴컴컴컴컴� + 旼컴컴컴컴컴컴컴컴� 旼컴컴컴컴컴컴컴컴컴컴컴� Modem 컴컴컴컴컴컴컴컴컴컴컴컴�� + � Node Summary � �� + � Node � �� + � Node Type � �� + � Nodes Total � 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�� + � Nodes Busy � 旼0%컴컴컴컴컴컴컴�Today's Activity컴컴컴컴컴컴컴컴�100%�� + � [T]o Nodeview � �� + �컴컴컴컴컴컴컴컴켸 �컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�� + � [S]ystem Config [F]ile Base [C]allers [I]nit Modem [!]Validate � + � [U]ser Editor [B]Msg Base [P]ack Msgs [O]ffhook Modem [L]ogs � + � [#]Menu Editor [X]fer Prots [M]ail Read [A]nswer Modem [Z]History � + � [E]vent Editor [W]rite Mail [R]ead Mail [H]angup Modem [D]rop to DOS � + � [V]oting Editor [$]Conferences [ ] Log On [N]ode listing [Q]uit to Dos � + �컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + diff --git a/SOURCE/UNUSED/WFC_COM.ANS b/SOURCE/UNUSED/WFC_COM.ANS new file mode 100644 index 0000000..505db48 --- /dev/null +++ b/SOURCE/UNUSED/WFC_COM.ANS @@ -0,0 +1,25 @@ +[?7h + + + + + + + + + + + + + + + + + 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�� + � [S]ystem Config [F]ile Base [C]allers [I]nit Modem [!]Validate � + � [U]ser Editor [B]Msg Base [P]ack Msgs [O]ffhook Modem [L]ogs � + � [#]Menu Editor [X]fer Prots [M]ail Read [A]nswer Modem [Z]History � + � [E]vent Editor [W]rite Mail [R]ead Mail [H]angup Modem [D]rop to DOS � + � [V]oting Editor [$]Conferences [ ] Log On [N]ode listing [Q]uit to DOS � + �컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + diff --git a/SOURCE/UNUSED/WFC_NODE.ANS b/SOURCE/UNUSED/WFC_NODE.ANS new file mode 100644 index 0000000..34e02ff --- /dev/null +++ b/SOURCE/UNUSED/WFC_NODE.ANS @@ -0,0 +1,25 @@ +[?7h + + + + + + + + + + + + + + + + + 旼컴컴컴컴컴컴컴컴컴�� 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� + � � Node WFC � � ��������������������������������������������������� � + � � Node Down � � ��������������������������������������������������� � + � � Newuser on Node � � ��������������������������������������������������� � + � � Node Available � � ��������������������������������������������������� � + � � � ��������������������������������������������������� � + �컴컴컴컴컴컴컴컴컴컴� �컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 + diff --git a/SOURCE/UNUSED/bootoldback.pas b/SOURCE/UNUSED/bootoldback.pas new file mode 100644 index 0000000..8d2984e --- /dev/null +++ b/SOURCE/UNUSED/bootoldback.pas @@ -0,0 +1,1034 @@ +{$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 + ASM + Mov Ah,10h + Mov Al,0h + Int 2fh + Mov T_Al,Al + END; + SchareLoaded := (T_Al = $FF); +END; + +PROCEDURE FindTaskerType; +VAR + D5, + DOS_Major, + DOS_Minor, + Os2Vers: Word; + DVOk, + OS2Ok, + WinOk, + WinNTOk: Boolean; + + 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; + + 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; + + 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; + + 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; + +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/UNUSED/m.cmd b/SOURCE/UNUSED/m.cmd new file mode 100644 index 0000000..89287c4 --- /dev/null +++ b/SOURCE/UNUSED/m.cmd @@ -0,0 +1 @@ +move %1.pas .. \ No newline at end of file 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..c2dac62 --- /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..cbbdc15 --- /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..397b28e --- /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..eac3c90 --- /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 diff --git a/VPC.CFG b/VPC.CFG new file mode 100644 index 0000000..a759605 --- /dev/null +++ b/VPC.CFG @@ -0,0 +1,25 @@ +/OZ:\PROGRA~1\RG119SRC\EXE\VP +/I.\ELECOM;.\WIN32;Z:\VP21\SOURCE\RTL;Z:\VP21\SOURCE\TV +/U.\ELECOM;.\WIN32;Z:\VP21\UNITS.W32;Z:\VP21\SOURCE\RTL;Z:\VP21\SOURCE\W32;Z:\VP21\SOURCE\TV;Z:\VP21\EXAMPLES\W32\OPENGL\SHARED +/L.\ELECOM;.\WIN32;Z:\VP21\LIB.W32;Z:\VP21\UNITS.W32 +/R.\ELECOM;.\WIN32;Z:\VP21\RES.W32 +/$A+ +/$B- +/$D+ +/$E+ +/$F+ +/$G+ +/$I- +/$L+ +/$N- +/$O+ +/$P- +/$Q- +/$R- +/$S- +/$T- +/$V- +/$X+ +/$Y+ +/B +/GD