eric
/
Renegade-1.19
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

02-04

This commit is contained in:
mro lastname 2013-02-04 17:56:58 -06:00
commit 6923bf0c27
351 changed files with 97837 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
.gitattributes vendored Normal file
View File

@ -0,0 +1,22 @@
# Auto detect text files and perform LF normalization
* text=auto
# Custom for Visual Studio
*.cs diff=csharp
*.sln merge=union
*.csproj merge=union
*.vbproj merge=union
*.fsproj merge=union
*.dbproj merge=union
# Standard to msysgit
*.doc diff=astextplain
*.DOC diff=astextplain
*.docx diff=astextplain
*.DOCX diff=astextplain
*.dot diff=astextplain
*.DOT diff=astextplain
*.pdf diff=astextplain
*.PDF diff=astextplain
*.rtf diff=astextplain
*.RTF diff=astextplain

163
.gitignore vendored Normal file
View File

@ -0,0 +1,163 @@
#################
## Eclipse
#################
*.pydevproject
.project
.metadata
bin/
tmp/
*.tmp
*.bak
*.swp
*~.nib
local.properties
.classpath
.settings/
.loadpath
# External tool builders
.externalToolBuilders/
# Locally stored "Eclipse launch configurations"
*.launch
# CDT-specific
.cproject
# PDT-specific
.buildpath
#################
## Visual Studio
#################
## Ignore Visual Studio temporary files, build results, and
## files generated by popular Visual Studio add-ons.
# User-specific files
*.suo
*.user
*.sln.docstates
# Build results
[Dd]ebug/
[Rr]elease/
*_i.c
*_p.c
*.ilk
*.meta
*.obj
*.pch
*.pdb
*.pgc
*.pgd
*.rsp
*.sbr
*.tlb
*.tli
*.tlh
*.tmp
*.vspscc
.builds
*.dotCover
## TODO: If you have NuGet Package Restore enabled, uncomment this
#packages/
# Visual C++ cache files
ipch/
*.aps
*.ncb
*.opensdf
*.sdf
# Visual Studio profiler
*.psess
*.vsp
# ReSharper is a .NET coding add-in
_ReSharper*
# Installshield output folder
[Ee]xpress
# DocProject is a documentation generator add-in
DocProject/buildhelp/
DocProject/Help/*.HxT
DocProject/Help/*.HxC
DocProject/Help/*.hhc
DocProject/Help/*.hhk
DocProject/Help/*.hhp
DocProject/Help/Html2
DocProject/Help/html
# Click-Once directory
publish
# Others
[Bb]in
[Oo]bj
sql
TestResults
*.Cache
ClientBin
stylecop.*
~$*
*.dbmdl
Generated_Code #added for RIA/Silverlight projects
# Backup & report files from converting an old project file to a newer
# Visual Studio version. Backup files are not needed, because we have git ;-)
_UpgradeReport_Files/
Backup*/
UpgradeLog*.XML
############
## Windows
############
# Windows image file caches
Thumbs.db
# Folder config file
Desktop.ini
#############
## Python
#############
*.py[co]
# Packages
*.egg
*.egg-info
dist
build
eggs
parts
bin
var
sdist
develop-eggs
.installed.cfg
# Installer logs
pip-log.txt
# Unit test / coverage reports
.coverage
.tox
#Translations
*.mo
#Mr Developer
.mr.developer.cfg
# Mac crap
.DS_Store

14
ACFLAGS.ASC Normal file
View File

@ -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

719
ARCHIVE1.PAS Normal file
View File

@ -0,0 +1,719 @@
{$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: Integer;
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.

BIN
ARCHIVE1.TPU Normal file
View File

Binary file not shown.

915
ARCHIVE2.PAS Normal file
View File

@ -0,0 +1,915 @@
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
UNIT Archive2;
INTERFACE
PROCEDURE DOArcCommand(Cmd: Char);
IMPLEMENTATION
USES
Dos,
Archive1,
Archive3,
Arcview,
Common,
ExecBat,
File0,
File1,
File9,
File11,
TimeFunc;
CONST
MaxDOSChrLine = 127;
PROCEDURE DOArcCommand(Cmd: Char);
CONST
MaxFiles = 100;
VAR
FI: FILE OF Byte;
FileListArray: ARRAY [1..MaxFiles] OF AStr;
F: FileInfoRecordType;
(*
DirInfo: SearchRec;
*)
FileName,
S,
S1,
S2,
OS1: AStr;
DS: DirStr;
NS: NameStr;
ES: ExtStr;
AType,
BB,
NumExtDesc,
NumFiles,
RecNum,
Counter: Byte;
Junk,
RN,
FArea,
SaveFileArea,
C_Files: Integer;
C_OldSiz,
C_NewSiz,
OldSiz,
NewSiz: LongInt;
Ok,
Ok1,
FNX,
WentToSysOp,
DelBad: Boolean;
PROCEDURE AddFL(F1: FileInfoRecordType; FN1: AStr; VAR NumFiles1: Byte; b: Boolean);
VAR
DirInfo1: SearchRec;
DS1: DirStr;
NS1: NameStr;
ES1: ExtStr;
SaveNumFiles: Byte;
RN1: Integer;
BEGIN
SaveNumFiles := NumFiles1;
IF (NOT b) THEN
BEGIN
RecNo(F1,FN1,RN1);
IF (BadDownloadPath) THEN
Exit;
WHILE (RN1 <> -1) AND (NumFiles1 < MaxFiles) DO
BEGIN
Seek(FileInfoFile,RN1);
Read(FileInfoFile,F1);
Inc(NumFiles1);
FileListArray[NumFiles1] := F1.FileName;
NRecNo(F1,RN1);
END;
END
ELSE
BEGIN
FSplit(FN1,DS1,NS1,ES1);
ChDir(BSlash(DS1,FALSE));
IF (IOResult <> 0) THEN
Print('Path not found.')
ELSE
BEGIN
FindFirst(FN1,AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo1);
WHILE (DOSError = 0) AND (NumFiles1 < MaxFiles) DO
BEGIN
Inc(NumFiles1);
FileListArray[NumFiles1] := FExpand(DS1+DirInfo1.Name);
FindNext(DirInfo1);
END;
END;
ChDir(StartDir);
END;
IF (NumFiles1 = SaveNumFiles) THEN
Print('No matching files.')
ELSE IF (NumFiles1 >= MaxFiles) THEN
Print('File records filled.');
END;
PROCEDURE TestFiles(F1: FileInfoRecordType; FArea1: Integer; FN1: AStr; DelBad1: Boolean);
VAR
AType1: Byte;
RN1: Integer;
Ok2: Boolean;
BEGIN
IF (FileArea <> FArea1) THEN
ChangeFileArea(FArea1);
IF (FileArea = FArea1) THEN
BEGIN
RecNo(F1,FN1,RN1);
IF (BadDownloadPath) THEN
Exit;
WHILE (RN1 <> -1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(FileInfoFile,RN1);
Read(FileInfoFile,F1);
IF Exist(MemFileArea.DLPath+F1.FileName) THEN
FN1 := MemFileArea.DLPath+F1.FileName
ELSE
FN1 := MemFileArea.ULPath+F1.FileName;
AType1 := ArcType(FN1);
IF (AType1 <> 0) THEN
BEGIN
DisplayFileAreaHeader;
Star('Testing "'+SQOutSP(FN1)+'"');
IF (NOT Exist(FN1)) THEN
Star('File "'+SQOutSP(FN1)+'" does not exist.')
ELSE
BEGIN
Ok2 := TRUE;
ArcIntegrityTest(Ok2,AType1,SQOutSP(FN1));
IF (NOT Ok2) THEN
BEGIN
Star('File "'+SQOutSP(FN1)+'" did not pass integrity test.');
IF (DelBad1) THEN
BEGIN
DeleteFF(F1,RN1);
Kill(FN1);
END;
END;
END;
END;
WKey;
NRecNo(F1,RN1);
END;
Close(FileInfoFile);
Close(ExtInfoFile);
END;
LastError := IOResult;
END;
PROCEDURE CmtFiles(F1: FileInfoRecordType; FArea1: Integer; FN1: AStr);
VAR
AType1: Byte;
RN1: Integer;
Ok2: Boolean;
BEGIN
IF (FileArea <> FArea1) THEN
ChangeFileArea(FArea1);
IF (FileArea = FArea1) THEN
BEGIN
RecNo(F1,FN1,RN1);
IF (BadDownloadPath) THEN
Exit;
WHILE (RN1 <> -1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(FileInfoFile,RN1);
Read(FileInfoFile,F1);
IF Exist(MemFileArea.DLPath+F1.FileName) THEN
FN1 := MemFileArea.DLPath+F1.FileName
ELSE
FN1 := MemFileArea.ULPath+F1.FileName;
AType1 := ArcType(FN1);
IF (AType1 <> 0) THEN
BEGIN
DisplayFileAreaHeader;
NL;
Star('Commenting "'+SQOutSP(FN1)+'"');
IF (NOT Exist(FN1)) THEN
Star('File "'+SQOutSP(FN1)+'" does not exist.')
ELSE
BEGIN
Ok2 := TRUE;
ArcComment(Ok2,AType1,MemFileArea.CmtType,SQOutSP(FN1));
(* If NOT Ok *)
END;
END;
WKey;
NRecNo(F1,RN1);
END;
Close(FileInfoFile);
Close(ExtInfoFile);
END;
LastError := IOResult;
END;
PROCEDURE CvtFiles(F1: FileInfoRecordType;
FArea1: Integer;
FN1: AStr;
Toa: Integer;
VAR C_Files1: Integer;
VAR C_OldSiz1,
C_NewSiz1: LongInt);
VAR
FI: FILE OF Byte;
S3: AStr;
AType1: Byte;
RN1: Integer;
Ok2: Boolean;
BEGIN
IF (FileArea <> FArea1) THEN
ChangeFileArea(FArea1);
IF (FileArea = FArea1) THEN
BEGIN
RecNo(F1,FN1,RN1);
IF (BadDownloadPath) THEN
Exit;
WHILE (RN1 <> -1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(FileInfoFile,RN1);
Read(FileInfoFile,F1);
IF Exist(MemFileArea.DLPath+F1.FileName) THEN
FN1 := MemFileArea.DLPath+F1.FileName
ELSE
FN1 := MemFileArea.ULPath+F1.FileName;
AType1 := ArcType(FN1);
IF (AType1 <> 0) AND (AType1 <> Toa) THEN
BEGIN
DisplayFileAreaHeader;
NL;
Star('Converting "'+SQOutSP(FN1)+'"');
Ok2 := FALSE;
IF (NOT Exist(FN1)) THEN
BEGIN
Star('File "'+SQOutSP(FN1)+'" does not exist - changing extension.');
S3 := Copy(FN1,1,Pos('.',FN1))+General.FileArcInfo[Toa].Ext;
F1.FileName := Align(StripName(SQOutSP(S3)));
Seek(FileInfoFile,RN1);
Write(FileInfoFile,F1);
END
ELSE
BEGIN
Ok2 := TRUE;
S3 := Copy(FN1,1,Pos('.',FN1))+General.FileArcInfo[Toa].Ext;
ConvA(Ok2,AType1,BB,SQOutSP(FN1),SQOutSP(S3));
IF (Ok2) THEN
BEGIN
Assign(FI,SQOutSP(FN1));
Reset(FI);
Ok2 := (IOResult = 0);
IF (Ok2) THEN
BEGIN
OldSiz := FileSize(FI);
Close(FI);
END
ELSE
Star('Unable to access "'+SQOutSP(FN1)+'"');
IF (Ok2) THEN
IF (NOT Exist(SQOutSP(S3))) THEN
BEGIN
Star('Unable to access "'+SQOutSP(S3)+'"');
SysOpLog('Unable to access '+SQOutSP(S3));
Ok2 := FALSE;
END;
END;
IF (Ok2) THEN
BEGIN
F1.FileName := Align(StripName(SQOutSP(S3)));
Seek(FileInfoFile,RN1);
Write(FileInfoFile,F1);
Kill(SQOutSP(FN1));
Assign(FI,SQOutSP(S3));
Reset(FI);
Ok2 := (IOResult = 0);
IF (NOT Ok2) THEN
BEGIN
Star('Unable to access '+SQOutSP(S3));
SysOpLog('Unable to access '+SQOutSP(S3));
END
ELSE
BEGIN
NewSiz := FileSize(FI);
F1.FileSize := NewSiz;
Close(FI);
Seek(FileInfoFile,RN1);
Write(FileInfoFile,F1);
END;
IF (Ok2) THEN
BEGIN
Inc(C_OldSiz1,OldSiz);
Inc(C_NewSiz1,NewSiz);
Inc(C_Files1);
Star('Old total space took up : '+ConvertBytes(OldSiz,FALSE));
Star('New total space taken up : '+ConvertBytes(NewSiz,FALSE));
IF (OldSiz - NewSiz > 0) THEN
Star('Space saved : '+ConvertBytes(OldSiz-NewSiz,FALSE))
ELSE
Star('Space wasted : '+ConvertBytes(NewSiz-OldSiz,FALSE));
END;
END
ELSE
BEGIN
SysOpLog('Unable to convert '+SQOutSP(FN1));
Star('Unable to convert '+SQOutSP(FN1));
END;
END;
END;
WKey;
NRecNo(F,RN1);
END;
Close(FileInfoFile);
Close(ExtInfoFile);
END;
LastError := IOResult;
END;
BEGIN
TempPause := FALSE;
SaveFileArea := FileArea;
InitFileArea(FileArea);
IF (BadDownloadPath) THEN
Exit;
CASE Cmd OF
'A' : BEGIN
NL;
Print('Add file(s) to archive (up to '+IntToStr(MaxFiles)+') -');
NL;
Print('Archive file name: ');
Prt(':');
MPL(78);
Input(FileName,78);
IF IsUL(FileName) AND (NOT FileSysOp) THEN
FileName := '';
IF (FileName = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE
BEGIN
NumFiles := 0;
IF (Pos('.',FileName) = 0) AND (MemFileArea.ArcType <> 0) THEN
FileName := FileName+'.'+General.FileArcInfo[MemFileArea.ArcType].Ext;
FNX := ISUL(FileName);
IF (NOT FNX) THEN
BEGIN
IF Exist(MemFileArea.DLPath+FileName) THEN
FileName := MemFileArea.DLPath+FileName
ELSE
FileName := MemFileArea.ULPath+FileName
END;
FileName := FExpand(FileName);
AType := ArcType(FileName);
IF (AType = 0) THEN
InvArc
ELSE
BEGIN
Cmd := 'A';
REPEAT
IF (Cmd = 'A') THEN
REPEAT
NL;
Print('Add files to list - <CR> to end');
Prt(IntToStr(NumFiles + 1)+':');
MPL(70);
Input(S,70);
IF (S <> '') AND (NOT IsUL(S) OR FileSysOp) THEN
BEGIN
IF (Pos('.',S) = 0) THEN
S := S + '*.*';
AddFL(F,S,NumFiles,IsUL(S));
END;
UNTIL (S = '') OR (NumFiles >= MaxFiles) OR (HangUp);
NL;
Prt('Add files to list [^5?^4=^5Help^4]: ');
OneK(Cmd,'QADLR?',TRUE,TRUE);
NL;
CASE Cmd OF
'?' : BEGIN
LCmds(19,3,'Add more to list','Do it!');
LCmds(19,3,'List files in list','Remove files from list');
LCmds(19,3,'Quit','');
END;
'D' : BEGIN
RecNum := 0;
REPEAT
Inc(RecNum);
Counter := 1;
S2 := SQOutSP(FileListArray[RecNum]);
IF (NOT IsUL(S2)) THEN
S2 := MemFileArea.DLPath+S2;
S1 := FunctionalMCI(General.FileArcInfo[AType].ArcLine,FileName,S2);
OS1 := S1;
WHILE (Length(S1) <= MaxDOSChrLine) AND (RecNum < NumFiles) DO
BEGIN
Inc(RecNum);
Inc(Counter);
S2 := SQOutSP(FileListArray[RecNum]);
IF (NOT IsUL(S2)) THEN
S2 := MemFileArea.DLPath+S2;
OS1 := S1;
S1 := S1+' '+S2;
END;
IF (Length(S1) > MaxDOSChrLine) THEN
BEGIN
Dec(RecNum);
Dec(Counter);
S1 := OS1;
END;
Ok := TRUE;
Star('Adding '+IntToStr(Counter)+' files to archive...');
ExecBatch(Ok,
TempDir+'UP\',General.ArcsPath+S1,
General.FileArcInfo[AType].SuccLevel,Junk,FALSE);
IF (NOT Ok) THEN
BEGIN
Star('errors in adding files');
Ok := PYNQ('Continue anyway? ',0,FALSE);
IF (HangUp) THEN
Ok := FALSE;
END;
UNTIL (RecNum >= NumFiles) OR (NOT Ok);
ArcComment(Ok,AType,MemFileArea.CmtType,FileName);
NL;
IF (NOT FNX) THEN
BEGIN
S1 := StripName(FileName);
RecNo(F,S1,RN);
IF (BadDownloadPath) THEN
Exit;
IF (RN <> -1) THEN
Print('^5NOTE: File already exists in listing!');
IF PYNQ('Add archive to listing? ',0,FALSE) THEN
BEGIN
Assign(FI,FileName);
Reset(FI);
IF (IOResult = 0) THEN
BEGIN
F.fileSize := FileSize(FI);
Close(FI);
END;
F.FileName := Align(S1);
Ok1 := TRUE;
IF PYNQ('Replace a file in directory? ',0,FALSE) THEN
BEGIN
REPEAT
NL;
Prt('Enter file name: ');
MPL(12);
Input(S2,12);
IF (S2 = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE
BEGIN
RecNo(F,S2,RN);
IF (BadDownloadPath) THEN
Exit;
IF (RN = -1) THEN
Print('File not found!');
END;
UNTIL (RN <> -1) OR (S2 = '') OR (HangUp);
IF (S2 <> '') THEN
BEGIN
Seek(FileInfoFile,RN);
Read(FileInfoFile,F);
Kill(MemFileArea.ULPath+SQOutSP(F.FileName));
F.FileName := Align(S1);
Seek(FileInfoFile,RN);
Write(FileInfoFile,F);
END
ELSE
Ok1 := FALSE;
END
ELSE
Ok1 := FALSE;
IF (NOT Ok1) THEN
BEGIN
WentToSysOp := FALSE;
GetFileDescription(F,ExtendedArray,NumExtDesc,WentToSysOp);
F.FilePoints := 0;
F.Downloaded := 0;
F.OwnerNum := UserNum;
F.OwnerName := AllCaps(ThisUser.Name);
F.FileDate := Date2PD(DateStr);
F.VPointer := -1;
F.VTextSize := 0;
END;
F.FIFlags := [];
IF (NOT AACS(General.ULValReq)) AND (NOT General.ValidateAllFiles) THEN
Include(F.FIFlags,FINotVal);
IF (NOT General.FileCreditRatio) THEN
F.FilePoints := 0
ELSE
F.FilePoints := ((F.FileSize DIV 1024) DIV General.FileCreditCompBaseSize);
IF (RN = -1) THEN
WriteFV(F,FileSize(FileInfoFile),ExtendedArray)
ELSE
WriteFV(F,RN,ExtendedArray);
END;
END;
IF PYNQ('Delete original files? ',0,FALSE) THEN
FOR RecNum := 1 TO NumFiles DO
BEGIN
S2 := SQOutSP(FileListArray[RecNum]);
IF (NOT IsUL(FileListArray[RecNum])) THEN
BEGIN
RecNo(F,S2,RN);
IF (BadDownloadPath) THEN
Exit;
IF (RN <> -1) THEN
DeleteFF(F,RN);
S2 := MemFileArea.DLPath+S2;
END;
Kill(S2);
END;
IF (Ok) THEN
Cmd := 'Q';
END;
'L' : IF (NumFiles = 0) THEN
Print('No files in list!')
ELSE
BEGIN
Abort := FALSE;
Next := FALSE;
S := '';
Counter := 0;
RecNum := 0;
REPEAT
Inc(RecNum);
IF IsUL(FileListArray[RecNum]) THEN
S := S + '^3'
ELSE
S := S + '^1';
S := S + Align(StripName(FileListArray[RecNum]));
Inc(Counter);
IF (Counter < 5) THEN
S := S + ' '
ELSE
BEGIN
PrintACR(S);
S := '';
Counter := 0;
END;
UNTIL (RecNum = NumFiles) OR (Abort) OR (HangUp);
IF (Counter in [1..4]) AND (NOT Abort) THEN
PrintACR(S);
END;
'R' : IF (NumFiles = 0) THEN
Print('No files in list!')
ELSE
BEGIN
Prt('Remove file name: ');
MPL(12);
Input(S,12);
IF (S = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE
BEGIN
RecNum := 0;
REPEAT
Inc(RecNum);
IF Align(StripName(FileListArray[RecNum])) = Align(S) THEN
BEGIN
Prompt('^3'+SQOutSP(FileListArray[RecNum]));
IF PYNQ(' Remove it? ',0,FALSE) THEN
BEGIN
FOR Counter := RecNum TO (NumFiles - 1) DO
FileListArray[Counter] := FileListArray[Counter + 1];
Dec(NumFiles);
Dec(RecNum);
END;
END;
UNTIL (RecNum >= NumFiles);
END;
END;
END;
UNTIL (Cmd = 'Q') OR (HangUp);
Cmd := #0;
END;
END;
END;
'C' : BEGIN
NL;
Print('Convert archive formats -');
NL;
Print('Filespec:');
Prt(':');
MPL(78);
Input(FileName,78);
IF (FileName = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE
BEGIN
NL;
REPEAT
Prt('Archive type to use? (?=List): ');
MPL(3);
Input(S,3);
IF (S = '?') THEN
BEGIN
NL;
ListArcTypes;
NL;
END;
UNTIL (S <> '?');
IF (StrToInt(S) <> 0) THEN
BB := StrToInt(S)
ELSE
BB := ArcType('F.'+S);
IF (BB <> 0) THEN
BEGIN
C_Files := 0;
C_OldSiz := 0;
C_NewSiz := 0;
Abort := FALSE;
Next := FALSE;
SysOpLog('Conversion process initiated at '+DateStr+' '+TimeStr+'.');
IF (IsUL(FileName)) THEN
BEGIN
FSplit(FileName,DS,NS,ES);
FindFirst(FileName,AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo);
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
FileName := FExpand(SQOutSP(DS+DirInfo.Name));
AType := ArcType(FileName);
IF (AType <> 0) AND (AType <> BB) THEN
BEGIN
Star('Converting "'+FileName+'"');
Ok := TRUE;
S := Copy(FileName,1,Pos('.',FileName))+General.FileArcInfo[BB].Ext;
ConvA(Ok,AType,BB,FileName,S);
IF (Ok) THEN
BEGIN
Assign(FI,SQOutSP(FileName));
Reset(FI);
Ok := (IOResult = 0);
IF (Ok) THEN
BEGIN
OldSiz := FileSize(FI);
Close(FI);
END
ELSE
Star('Unable to access '+SQOutSP(FileName));
IF (Ok) THEN
IF (NOT Exist(SQOutSP(S))) THEN
BEGIN
Star('Unable to access '+SQOutSP(S));
SysOpLog('Unable to access '+SQOutSP(S));
Ok := FALSE;
END;
END;
IF (Ok) THEN
BEGIN
Kill(SQOutSP(FileName));
Assign(FI,SQOutSP(S));
Reset(FI);
Ok := (IOResult = 0);
IF (Ok) THEN
BEGIN
NewSiz := FileSize(FI);
Close(FI);
END
ELSE
Star('Unable to access "'+SQOutSP(S)+'"');
IF (Ok) THEN
BEGIN
Inc(C_OldSiz,OldSiz);
Inc(C_NewSiz,NewSiz);
Inc(C_Files);
Star('Old total space took up : '+ConvertBytes(OldSiz,FALSE));
Star('New total space taken up : '+ConvertBytes(NewSiz,FALSE));
IF (OldSiz - NewSiz > 0) THEN
Star('Space saved : '+ConvertBytes(OldSiz-NewSiz,FALSE))
ELSE
Star('Space wasted : '+ConvertBytes(NewSiz-OldSiz,FALSE));
END;
END
ELSE
BEGIN
SysOpLog('Unable to convert '+SQOutSP(FileName));
Star('Unable to convert '+SQOutSP(FileName));
END;
END;
WKey;
FindNext(DirInfo);
END;
END
ELSE
BEGIN
NL;
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
CvtFiles(F,FileArea,FileName,BB,C_Files,C_OldSiz,C_NewSiz)
ELSE
BEGIN
FArea := 1;
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
CvtFiles(F,FArea,FileName,BB,C_Files,C_OldSiz,C_NewSiz);
WKey;
Inc(FArea);
END;
END;
END;
SysOpLog('Conversion process completed at '+DateStr+' '+TimeStr+'.');
NL;
Star('Total archives converted : '+IntToStr(C_Files));
Star('Old total space took up : '+ConvertBytes(C_OldSiz,FALSE));
Star('New total space taken up : '+ConvertBytes(C_NewSiz,FALSE));
IF ((C_OldSiz - C_NewSiz) > 0) THEN
Star('Space saved : '+ConvertBytes((C_OldSiz - C_NewSiz),FALSE))
ELSE
Star('Space wasted : '+ConvertBytes((C_NewSiz - C_OldSiz),FALSE));
SysOpLog('Converted '+IntToStr(C_Files)+' archives; old size='+
ConvertBytes(C_OldSiz,FALSE)+' , new size='+ConvertBytes(C_NewSiz,FALSE));
END;
END;
END;
'M' : BEGIN
Ok := FALSE;
FOR Counter := 1 TO 3 DO
IF (General.FileArcComment[Counter] <> '') THEN
Ok := TRUE;
IF (NOT Ok) THEN
BEGIN
NL;
Print('No comment''s are available.');
PauseScr(FALSE);
Exit;
END;
NL;
Print('Comment field update -');
NL;
Print('Filespec:');
Prt(':');
MPL(78);
Input(FileName,78);
IF (FileName = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE
BEGIN
Abort := FALSE;
Next := FALSE;
IF (IsUL(FileName)) THEN
BEGIN
S := '';
NL;
FOR Counter := 1 TO 3 DO
IF (General.FileArcComment[Counter] <> '') THEN
BEGIN
S := S + IntToStr(Counter);
Print('^1'+IntToStr(Counter)+'. Archive comment file: ^5'+General.FileArcComment[Counter]);
END;
NL;
Prt('Comment to use [0=Quit]: ');
OneK(Cmd,'0'+S,TRUE,TRUE);
IF (Cmd IN ['1'..'3']) THEN
BEGIN
FSplit(FileName,DS,NS,ES);
FindFirst(FileName,AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo);
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
FileName := FExpand(SQOutSP(DS+DirInfo.Name));
AType := ArcType(FileName);
IF (AType <> 0) THEN
BEGIN
Star('Commenting "'+FileName+'"');
Ok := TRUE;
ArcComment(Ok,AType,(Ord(Cmd) - 48),FileName);
END;
WKey;
FindNext(DirInfo);
END;
END;
END
ELSE
BEGIN
NL;
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
CmtFiles(F,FileArea,FileName)
ELSE
BEGIN
FArea := 1;
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
CmtFiles(F,FArea,FileName);
WKey;
Inc(FArea);
END;
END;
END;
END;
Cmd := #0;
END;
'T' : BEGIN
NL;
Print('File integrity testing -');
NL;
Print('Filespec:');
Prt(':');
MPL(78);
Input(FileName,78);
IF (FileName = '') THEN
BEGIN
NL;
Print('Aborted!');
END
ELSE
BEGIN
NL;
DelBad := PYNQ('Delete files that don''t pass the test? ',0,FALSE);
NL;
Abort := FALSE;
Next := FALSE;
IF (IsUL(FileName)) THEN
BEGIN
FSplit(FileName,DS,NS,ES);
FindFirst(FileName,AnyFile - Directory - VolumeID - DOS.Hidden - SysFile,DirInfo);
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
FileName := FExpand(SQOutSP(DS+DirInfo.Name));
AType := ArcType(FileName);
IF (AType <> 0) THEN
BEGIN
Star('Testing "'+FileName+'"');
Ok := TRUE;
ArcIntegrityTest(Ok,AType,FileName);
IF (Ok) THEN
Star('Passed integrity test.')
ELSE
BEGIN
Star('File "'+FileName+'" didn''t pass integrity test.');
IF (DelBad) THEN
Kill(FileName);
END;
END;
WKey;
FindNext(DirInfo);
END;
END
ELSE
BEGIN
NL;
IF (NOT PYNQ('Search all file areas? ',0,FALSE)) THEN
TestFiles(F,FileArea,FileName,DelBad)
ELSE
BEGIN
FArea := 1;
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
TestFiles(F,FArea,FileName,DelBad);
WKey;
Inc(FArea);
END;
END;
END;
END;
END;
END;
FileArea := SaveFileArea;
LoadFileArea(FileArea);
LastError := IOResult;
END;
END.

BIN
ARCHIVE2.TPU Normal file
View File

Binary file not shown.

240
ARCHIVE3.PAS Normal file
View File

@ -0,0 +1,240 @@
{$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: Integer; 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: Integer;
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.

BIN
ARCHIVE3.TPU Normal file
View File

Binary file not shown.

848
ARCVIEW.PAS Normal file
View File

@ -0,0 +1,848 @@
{$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: Integer; {* last mod file Date *}
Mod_Time: Integer; {* last mod file Time *}
CRC: Integer; {* CRC *}
U_Size: LongInt; {* uncompressed size *}
END;
ZipRecordType = RECORD {* structure of ZIP archive file header *}
Version: Integer; {* Version needed to extract *}
Bit_Flag: Integer; {* General purpose bit flag *}
Method: Integer; {* compression Method *}
Mod_Time: Integer; {* last mod file Time *}
Mod_Date: Integer; {* last mod file Date *}
CRC: LongInt; {* CRC-32 *}
C_Size: LongInt; {* compressed size *}
U_Size: LongInt; {* uncompressed size *}
F_Length: Integer; {* FileName Length *}
E_Length: Integer; {* 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: Word; {* modification Date (DOS format) *}
Mod_Time: Word; {* modification Time (DOS format) *}
CRC: Word; {* 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: Word; {* Length of Comment (0 = none) *}
FName: ARRAY [0..12] OF Char; {* FileName *}
Var_DirLen: Integer; {* Length of variable part of dir entry *}
TZ: Char; {* timezone where file was archived *}
Dir_Crc: Word; {* 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: Integer;{* last mod file Time *}
Mod_Date: Integer;{* last mod file Date *}
Attrib: Integer; {* file attributes *}
F_Length: Byte; {* Length of FileName *}
CRC: Integer; {* CRC *}
END;
ARJRecordType = RECORD
FirstHdrSize: Byte;
ARJVersion: Byte;
ARJRequired: Byte;
HostOS: Byte;
Flags: Byte;
Method: Byte;
FileType: Byte;
GarbleMod: Byte;
Time,
Date: Integer;
CompSize: LongInt;
OrigSize: LongInt;
OrigCRC: ARRAY[1..4] OF Byte;
EntryName: Word;
AccessMode: Word;
HostData: Word;
END;
OutRec = RECORD {* output information structure *}
FileName: AStr; {* output file name *}
Date, {* output Date *}
Time, {* output Time *}
Method: Integer; {* 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: Word;
BasicHdrSiz: Word;
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.

BIN
ARCVIEW.TPU Normal file
View File

Binary file not shown.

159
AUTOMSG.PAS Normal file
View File

@ -0,0 +1,159 @@
{$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.

BIN
AUTOMSG.TPU Normal file
View File

Binary file not shown.

1
BATCH6.LST Normal file
View File

@ -0,0 +1 @@
C:\RG\TEMP6.LOG

557
BBSLIST.PAS Normal file
View File

@ -0,0 +1,557 @@
{$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;
BEGIN
BBSListPtr := Data1;
BBSListMCI := S;
CASE S[1] OF
'X' : CASE S[2] OF
'A' : BBSListMCI := BBSListPtr^.xA;
'B' : BBSListMCI := BBSListPtr^.xB;
'C' : BBSListMCI := BBSListPtr^.xC;
'D' : BBSListMCI := BBSListPtr^.xD;
'E' : BBSListMCI := BBSListPtr^.xE;
'F' : BBSListMCI := BBSListPtr^.xF;
END;
'B' : CASE S[2] OF
'N' : BBSListMCI := BBSListPtr^.BBSName;
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;
'P' : CASE S[2] OF
'N' : BBSListMCI := BBSListPtr^.PhoneNumber;
END;
'R' : CASE S[2] OF
'N' : BBSListMCI := IntToStr(BBSListPtr^.RecordNum);
END;
'S' : CASE S[2] OF
'N' : BBSListMCI := BBSListPtr^.SysOpName;
'P' : BBSListMCI := BBSListPtr^.Speed;
'W' : BBSListMCI := AllCaps(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: CHAR;
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 := UpCase(Question[2]);
Question := Copy(Question,(Pos(':',Question) + 1),Length(Question));
CASE WhichOne OF
'1' : BEGIN
NL;
PRT(Question+' ');
MPL(SizeOf(BBSList.BBSName) - 1);
InputMain(BBSList.BBSName,(SizeOf(BBSList.BBSName) - 1),[InterActiveEdit,ColorsAllowed]);
Abort := (BBSList.BBSName = '');
END;
'2' : BEGIN
PRT(Question+' ');
MPL(SizeOf(BBSList.SysOpName) - 1);
InputMain(BBSList.SysOpName,(SizeOf(BBSList.SysOpName) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.SysOpName = '');
END;
'3' : BEGIN
PrintACR(Question);
MPL(SizeOf(BBSList.TelnetUrl) - 1);
InputMain(BBSList.TelnetUrl,(SizeOf(BBSList.TelnetUrl) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.TelnetUrl = '');
END;
'4' : BEGIN
PrintACR(Question);
MPL(SizeOf(BBSList.WebSiteUrl) - 1);
InputMain(BBSList.WebSiteUrl,(SizeOf(BBSList.WebSiteUrl) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.WebSiteUrl = '');
END;
'5' : BEGIN
PRT(Question+' ');
MPL(SizeOf(BBSList.PhoneNumber) - 1);
InputMain(BBSList.PhoneNumber,(SizeOf(BBSList.PhoneNumber) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.PhoneNumber = '');
END;
'6' : BEGIN
PRT(Question+' ');
MPL(SizeOf(BBSList.Software) - 1);
InputMain(BBSList.Software,(SizeOf(BBSList.Software) - 1),[ColorsAllowed,InterActiveEdit,UpperOnly]);
Abort := (BBSList.Software = '');
END;
'7' : BEGIN
PRT(Question+' ');
MPL(SizeOf(BBSList.Speed) - 1);
InputMain(BBSList.Speed,(SizeOf(BBSList.Speed) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.Speed = '');
END;
'8' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.Description) - 1);
InputMain(BBSList.Description,(SizeOf(BBSList.Description) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.Description = '');
END;
'9' : BEGIN
IF (Question <> 'þ') THEN
Print(Question);
MPL(SizeOf(BBSList.Description2) - 1);
InputMain(BBSList.Description2,(SizeOf(BBSList.Description2) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.Description2 = '');
END;
'A' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.xA) - 1);
InputMain(BBSList.xA,(SizeOf(BBSList.xA) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.xA = '');
END;
'B' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.xB) - 1);
InputMain(BBSList.xB,(SizeOf(BBSList.xB) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.xB = '');
END;
'C' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.xC) - 1);
InputMain(BBSList.xC,(SizeOf(BBSList.xC) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.xC = '');
END;
'D' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.xD) - 1);
InputMain(BBSList.xD,(SizeOf(BBSList.xD) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.xD = '');
END;
'E' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.xE) - 1);
InputMain(BBSList.xE,(SizeOf(BBSList.xE) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.xE = '');
END;
'F' : BEGIN
Print(Question);
MPL(SizeOf(BBSList.xF) - 1);
InputMain(BBSList.xF,(SizeOf(BBSList.xF) - 1),[ColorsAllowed,InterActiveEdit]);
Abort := (BBSList.xF = '');
END;
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('Would you like to 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('Would you like to save this BBS Listing? ',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('BBSLET');
ReadBuffer('BBSLEM');
DisplayBuffer(BBSListMCI,@BBSList,Data2);
NL;
IF (PYNQ('Would you like to delete this BBS Listing? ',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;
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 (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('BBSLET');
ReadBuffer('BBSLEM');
DisplayBuffer(BBSListMCI,@BBSList,Data2);
NL;
IF (PYNQ('Would you like to edit this BBS Listing? ',0,FALSE)) 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,(OnRec - 1));
BBSList.DateEdited := GetPackDateTime;
Write(BBSListFile,BBSList);
SysOpLog('Edited BBS Listing: '+BBSList.BBSName+'.');
END;
END;
END;
Found := TRUE;
END;
Inc(OnRec);
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;
END;
PROCEDURE BBSList_View;
VAR
Data2: Pointer;
BBSList: BBSListRecordType;
OnRec: Longint;
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;
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);
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 *)
VAR
Data2: Pointer;
BBSList: BBSListRecordType;
OnRec: Longint;
BEGIN
IF (BBSList_Exists) THEN (* Add BBSME & BBSEH exist checking here *)
BEGIN
Assign(BBSListFile,General.DataPath+'BBSLIST.DAT');
Reset(BBSListFile);
IF (ReadBuffer('BBSME')) THEN
BEGIN
AllowContinue := TRUE;
Abort := FALSE;
PrintF('BBSEH');
OnRec := 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);
END;
IF (NOT Abort) THEN
PrintF('BBSET');
AllowContinue := FALSE;
PauseScr(FALSE);
SysOpLog('Viewed the BBS Listing.');
END;
Close(BBSListFile);
LastError := IOResult;
END;
END;
END.

BIN
BBSLIST.TPU Normal file
View File

Binary file not shown.

1034
BOOT.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
BOOT.TPU Normal file
View File

Binary file not shown.

588
BULLETIN.PAS Normal file
View File

@ -0,0 +1,588 @@
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
UNIT Bulletin;
INTERFACE
USES
Common;
FUNCTION FindOnlyOnce: Boolean;
FUNCTION NewBulletins: Boolean;
PROCEDURE Bulletins(MenuOption: Str50);
PROCEDURE UList(MenuOption: Str50);
PROCEDURE TodaysCallers(x: Byte; MenuOptions: Str50);
PROCEDURE RGQuote(MenuOption: Str50);
IMPLEMENTATION
USES
Dos,
Common5,
Mail1,
ShortMsg,
TimeFunc;
TYPE
LastCallerPtrType = ^LastCallerRec;
UserPtrType = ^UserRecordType;
PROCEDURE Bulletins(MenuOption: Str50);
VAR
Main,
Subs,
InputStr: ASTR;
BEGIN
NL;
IF (MenuOption = '') THEN
IF (General.BulletPrefix = '') THEN
MenuOption := 'BULLETIN;BULLET'
ELSE
MenuOption := 'BULLETIN;'+General.BulletPrefix;
IF (Pos(';',MenuOption) <> 0) THEN
BEGIN
Main := Copy(MenuOption,1,(Pos(';',MenuOption) - 1));
Subs := Copy(MenuOption,(Pos(';',MenuOption) + 1),(Length(MenuOption) - Pos(';',MenuOption)));
END
ELSE
BEGIN
Main := MenuOption;
Subs := MenuOption;
END;
PrintF(Main);
IF (NOT NoFile) THEN
REPEAT
NL;
{ Prt(FString.BulletinLine); }
lRGLngStr(16,FALSE);
ScanInput(InputStr,'ABCDEFGHIJKLMNOPQRSTUVWXYZ?');
IF (NOT HangUp) THEN
BEGIN
IF (InputStr = '?') THEN
PrintF(Main);
IF (InputStr <> '') AND NOT (InputStr[1] IN ['Q','?']) THEN
PrintF(Subs+InputStr);
END;
UNTIL (InputStr = 'Q') OR (HangUp);
END;
FUNCTION FindOnlyOnce: Boolean;
VAR
(*
DirInfo: SearchRec;
*)
DT: DateTime;
BEGIN
FindOnlyOnce := FALSE;
FindFirst(General.MiscPath+'ONLYONCE.*',AnyFile - Directory - VolumeID- DOS.Hidden,DirInfo);
IF (DosError = 0) THEN
BEGIN
UnPackTime(DirInfo.Time,DT);
IF (DateToPack(DT) > ThisUser.LastOn) THEN
FindOnlyOnce := TRUE;
END;
END;
FUNCTION NewBulletins: Boolean;
TYPE
BulletinType = ARRAY [0..255] OF Byte;
VAR
BulletinArray: ^BulletinType;
DT: DateTime;
(*
DirInfo: SearchRec;
*)
BullCount,
Biggest,
LenOfBullPrefix,
LenToCopy: Byte;
Found: Boolean;
PROCEDURE ShowBulls;
VAR
Counter,
Counter1,
Counter2: Byte;
BEGIN
FOR Counter := 0 TO BullCount DO
BEGIN
FOR Counter1 := 0 TO BullCount DO
IF (BulletinArray^[Counter] < BulletinArray^[Counter1]) THEN
BEGIN
Counter2 := BulletinArray^[Counter];
BulletinArray^[Counter] := BulletinArray^[Counter1];
BulletinArray^[Counter1] := Counter2;
END;
END;
Counter1 := 1;
Prt('|01[ |11');
FOR Counter2 := 0 TO (BullCount) DO
BEGIN
IF (Counter1 = 15) THEN
BEGIN
Prt(PadRightInt(BulletinArray^[Counter2],2));
IF (Counter2 < BullCount) THEN
Prt(' |01]'+^M^J+'|01[ |11')
ELSE
Prt(' |01]');
Counter1 := 0;
END
ELSE
BEGIN
Prt(PadRightInt(BulletinArray^[Counter2],2));
IF (Counter2 < BullCount) THEN
Prt('|07,|11 ')
ELSE
Prt(' |01]');
END;
Inc(Counter1);
END;
NL;
END;
BEGIN
New(BulletinArray);
FOR BullCount := 0 TO 255 DO
BulletinArray^[BullCount] := 0;
Found := FALSE;
Biggest := 0;
BullCount := 0;
LenOfBullPrefix := (Length(General.BulletPrefix) + 1);
FindFirst(General.MiscPath+General.BulletPrefix+'*.ASC',AnyFile - Directory - VolumeID - DOS.Hidden,DirInfo);
WHILE (DosError = 0) DO
BEGIN
IF (((Pos(General.BulletPrefix,General.MiscPath+General.BulletPrefix+'*.ASC') > 0) AND
(Pos('BULLETIN',AllCaps(DirInfo.Name)) = 0)) AND
(Pos('~',DirInfo.Name) = 0)) THEN
BEGIN
UnPackTime(DirInfo.Time,DT);
IF (DateToPack(DT) > ThisUser.LastOn) THEN
BEGIN
Found := TRUE;
LenToCopy := (Pos('.',DirInfo.Name) - 1) - Length(General.BulletPrefix);
BulletinArray^[BullCount] := StrToInt(Copy(DirInfo.Name,LenOfBullPrefix,LenToCopy));
IF (BulletinArray^[BullCount] > Biggest) THEN
Biggest := BulletinArray^[BullCount];
Inc(BullCount);
END;
END;
IF (BullCount > 254) THEN
Exit;
FindNext(DirInfo);
END;
IF (Found) THEN
BEGIN
Dec(BullCount);
ShowBulls;
END;
Dispose(BulletinArray);
NewBulletins := Found;
END;
FUNCTION UlistMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
VAR
UserPtr: UserPtrType;
BEGIN
UlistMCI := S;
UserPtr := Data1;
CASE S[1] OF
'A' : CASE S[2] OF
'G' : UListMCI := IntToStr(AgeUser(UserPtr^.BirthDate));
END;
'D' : CASE S[2] OF
'K' : UListMCI := IntToStr(UserPtr^.DK);
'L' : UListMCI := IntToStr(UserPtr^.Downloads);
END;
'L' : CASE S[2] OF
'C' : UListMCI := UserPtr^.CityState;
'O' : UListMCI := ToDate8(PD2Date(UserPtr^.LastOn));
END;
'M' : CASE S[2] OF
'P' : UListMCI := IntToStr(UserPtr^.MsgPost);
END;
'N' : CASE S[2] OF
'O' : UListMCI := Userptr^.Note;
END;
'R' : CASE S[2] OF
'N' : UListMCI := UserPtr^.RealName;
END;
'S' : CASE S[2] OF
'X' : UListMCI := UserPtr^.Sex;
END;
'U' : CASE S[2] OF
'K' : UListMCI := IntToStr(UserPtr^.UK);
'L' : UListMCI := IntToStr(UserPtr^.Uploads);
'N' : UListMCI := Caps(UserPtr^.Name);
'1' : UListMCI := UserPtr^.UsrDefStr[1];
'2' : UListMCI := UserPtr^.UsrDefStr[2];
'3' : UListMCI := UserPtr^.UsrDefStr[3];
END;
END;
END;
PROCEDURE UList(MenuOption: Str50);
VAR
Junk: Pointer;
User: UserRecordType;
Cmd: Char;
TempStr: ASTR;
Gender: Str1;
State,
UState: Str2;
Age: Str3;
DateLastOn: Str8;
City,
UCity: Str30;
RName,
UName: Str36;
FN: Str50;
RecNum: Integer;
PROCEDURE Option(c1: Char; s1,s2: Str160);
BEGIN
Prompt('^4<^5'+c1+'^4>'+s1+': ');
IF (s2 <> '') THEN
Print('^5"^4'+s2+'^5"^1')
ELSE
Print('^5<<INACTIVE>>^1');
END;
BEGIN
IF (RUserList IN ThisUser.Flags) THEN
BEGIN
Print('You are restricted from listing users.');
Exit;
END;
Age := '';
City := '';
DateLastOn := '';
Gender := '';
RName := '';
State := '';
UName := '';
REPEAT
NL;
Print('^5User lister search options:');
NL;
Option('A','ge match string ',Age);
Option('C','ity match string ',City);
Option('D','ate last online match string',DateLastOn);
Option('G','ender match string ',Gender);
Option('R','eal name match string ',RName);
Option('S','tate match string ',State);
Option('U','ser name match string ',UName);
NL;
Prompt('^4Enter choice (^5A^4,^5C^4,^5D^4,^5G^4,^5R^4,^5S^4,^5U^4) [^5L^4]ist [^5Q^4]uit: ');
OneK(Cmd,'QACDGLRSU'^M,TRUE,TRUE);
NL;
IF (Cmd IN ['A','C','D','G','R','S','U']) THEN
BEGIN
TempStr := 'Enter new match string for the ';
CASE Cmd OF
'A' : TempStr := TempStr + 'age';
'C' : TempStr := TempStr + 'city';
'D' : TempStr := TempStr + 'date last online';
'G' : TempStr := TempStr + 'gender';
'R' : TempStr := TempStr + 'real name';
'S' : TempStr := TempStr + 'state';
'U' : TempStr := TempStr + 'user name';
END;
TempStr := TempStr + ' (<CR>=Make INACTIVE)';
Print('^4'+TempStr);
Prompt('^4: ');
END;
CASE Cmd OF
'A' : BEGIN
Mpl(3);
Input(Age,3);
END;
'C' : BEGIN
Mpl(30);
Input(City,30);
END;
'D' : BEGIN
Mpl(8);
InputFormatted('',DateLastOn,'##/##/##',TRUE);
IF (DayNum(DateLastOn) <> 0) AND (DayNum(DateLastOn) <= DayNum(DateStr)) THEN
BEGIN
Delete(DateLastOn,3,1);
Insert('-',DateLastOn,3);
Delete(DateLastOn,6,1);
Insert('-',DateLastOn,6);
END;
END;
'G' : BEGIN
Mpl(1);
Input(Gender,1);
END;
'R' : BEGIN
Mpl(36);
Input(RName,36);
END;
'S' : BEGIN
Mpl(2);
Input(State,2);
END;
'U' : BEGIN
Mpl(36);
Input(UName,36);
END;
END;
UNTIL (Cmd IN ['L','Q',^M]) OR (HangUp);
IF (Cmd IN ['L',^M]) THEN
BEGIN
Abort := FALSE;
Next := FALSE;
AllowContinue := TRUE;
IF (Pos(';',MenuOption) > 0) THEN
BEGIN
FN := Copy(MenuOption,(Pos(';',MenuOption) + 1),255);
MenuOption := Copy(MenuOption,1,(Pos(';',MenuOption) - 1));
END
ELSE
FN := 'USER';
IF (NOT ReadBuffer(FN+'M')) THEN
Exit;
PrintF(FN+'H');
Reset(UserFile);
RecNum := 1;
WHILE (RecNum <= (FileSize(UserFile) - 1)) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
LoadURec(User,RecNum);
UCity := (Copy(User.CityState,1,(Pos(',',User.CityState) - 1)));
UState := SQOutSP((Copy(User.CityState,(Pos(',',User.CityState) + 2),(Length(User.CityState)))));
IF (AACS1(User,RecNum,MenuOption)) AND NOT (Deleted IN User.SFlags) THEN
IF (Age = '') OR (Pos(Age,IntToStr(AgeUser(User.BirthDate))) > 0) THEN
IF (City = '') OR (Pos(City,AllCaps(UCity)) > 0) THEN
IF (DateLastOn = '') OR (Pos(DateLastOn,ToDate8(PD2Date(User.LastOn))) > 0) THEN
IF (Gender = '') OR (Pos(Gender,User.Sex) > 0) THEN
IF (RName = '') OR (Pos(RName,AllCaps(User.RealName)) > 0) THEN
IF (State = '') OR (Pos(State,AllCaps(UState)) > 0) THEN
IF (UName = '') OR (Pos(UName,User.Name) > 0) THEN
DisplayBuffer(UlistMCI,@User,Junk);
Inc(RecNum);
END;
Close(UserFile);
IF (NOT Abort) AND (NOT HangUp) THEN
PrintF(FN+'T');
AllowContinue := FALSE;
END;
SysOpLog('Viewed User Listing.');
LastError := IOResult;
END;
FUNCTION TodaysCallerMCI(CONST S: ASTR; Data1,Data2: Pointer): STRING;
VAR
LastCallerPtr: LastCallerPtrType;
s1: STRING[100];
BEGIN
LastCallerPtr := Data1;
TodaysCallerMCI := S;
CASE S[1] OF
'C' : CASE S[2] OF
'A' : TodaysCallerMCI := FormatNumber(LastCallerPtr^.Caller);
END;
'D' : CASE S[2] OF
'K' : TodaysCallerMCI := IntToStr(LastCallerPtr^.DK);
'L' : TodaysCallerMCI := IntToStr(LastCallerPtr^.Downloads);
END;
'E' : CASE S[2] OF
'S' : TodaysCallerMCI := IntToStr(LastCallerPtr^.EmailSent);
END;
'F' : CASE S[2] OF
'S' : TodaysCallerMCI := IntToStr(LastCallerPtr^.FeedbackSent);
END;
'L' : CASE S[2] OF
'C' : TodaysCallerMCI := LastCallerPtr^.Location;
'O' : BEGIN
s1 := PDT2Dat(LastCallerPtr^.LogonTime,0);
s1[0] := Char(Pos('m',s1) - 2);
s1[Length(s1)] := s1[Length(s1) + 1];
TodaysCallerMCI := s1;
END;
'T' : BEGIN
IF (LastCallerPtr^.LogoffTime = 0) THEN
S1 := 'Online'
ELSE
BEGIN
s1 := PDT2Dat(LastCallerPtr^.LogoffTime,0);
s1[0] := Char(Pos('m',s1) - 2);
s1[Length(s1)] := s1[Length(s1) + 1];
END;
TodaysCallerMCI := s1;
END;
END;
'M' : CASE S[2] OF
'P' : TodaysCallerMCI := IntToStr(LastCallerPtr^.MsgPost);
'R' : TodaysCallerMCI := IntToStr(LastCallerPtr^.MsgRead);
END;
'N' : CASE S[2] OF
'D' : TodaysCallerMCI := IntToStr(LastCallerPtr^.Node);
'U' : IF (LastCallerPtr^.NewUser) THEN
TodaysCallerMCI := '*'
ELSE
TodaysCallerMCI := ' ';
END;
'S' : CASE S[2] OF
'P' : IF (LastCallerPtr^.Speed = 0) THEN
TodaysCallerMCI := 'Local'
ELSE IF (Telnet) THEN
TodaysCallerMCI := 'Telnet'
ELSE
TodaysCallerMCI := IntToStr(LastCallerPtr^.Speed);
END;
'T' : CASE S[2] OF
'O' : WITH LastCallerPtr^ DO
TodaysCallerMCI := IntToStr((LogoffTime - LogonTime) DIV 60);
END;
'U' : CASE S[2] OF
'K' : TodaysCallerMCI := IntToStr(LastCallerPtr^.UK);
'L' : TodaysCallerMCI := IntToStr(LastCallerPtr^.Uploads);
'N' : TodaysCallerMCI := LastCallerPtr^.UserName;
END;
END;
END;
PROCEDURE TodaysCallers(x: Byte; MenuOptions: Str50);
VAR
Junk: Pointer;
LastCallerFile: FILE OF LastCallerRec;
LastCaller: LastCallerRec;
RecNum: Integer;
BEGIN
Abort := FALSE;
Next := FALSE;
AllowContinue := TRUE;
IF (MenuOptions = '') THEN
MenuOptions := 'LAST';
IF (NOT ReadBuffer(MenuOptions+'M')) THEN
Exit;
Assign(LastCallerFile,General.DataPath+'LASTON.DAT');
Reset(LastCallerFile);
IF (IOResult <> 0) THEN
Exit;
RecNum := 0;
IF (x > 0) AND (x <= FileSize(LastCallerFile)) THEN
RecNum := (FileSize(LastCallerFile) - x);
PrintF(MenuOptions+'H');
Seek(LastCallerFile,RecNum);
WHILE (NOT EOF(LastCallerFile)) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Read(LastCallerFile,LastCaller);
IF (((LastCaller.LogonTime DIV 86400) <> (GetPackDateTime DIV 86400)) AND (x > 0)) OR
(((LastCaller.LogonTime DIV 86400) = (GetPackDateTime DIV 86400))) AND (NOT LastCaller.Invisible) THEN
DisplayBuffer(TodaysCallerMCI,@LastCaller,Junk);
END;
Close(LastCallerFile);
IF (NOT Abort) THEN
PrintF(MenuOptions+'T');
AllowContinue := FALSE;
SysOpLog('Viewed Todays Callers.');
LastError := IOResult;
END;
PROCEDURE RGQuote(MenuOption: Str50);
VAR
StrPointerFile: FILE OF StrPointerRec;
StrPointer: StrPointerRec;
RGStrFile: FILE;
F,
F1: Text;
MHeader: MHeaderRec;
S: STRING;
StrNum: Word;
TotLoad: LongInt;
BEGIN
IF (MenuOption = '') THEN
Exit;
Assign(StrPointerFile,General.LMultPath+MenuOption+'.PTR');
Reset(StrPointerFile);
TotLoad := FileSize(StrPointerFile);
IF (TotLoad < 1) THEN
Exit;
IF (TotLoad > 65535) THEN
Totload := 65535
ELSE
Dec(TotLoad);
Randomize;
StrNum := Random(Totload);
Seek(StrPointerFile,StrNum);
Read(StrPointerFile,StrPointer);
Close(StrPointerFile);
LastError := IOResult;
IF (Exist(General.MiscPath+'QUOTEHDR.*')) THEN
PrintF('QUOTEHDR')
ELSE
BEGIN
NL;
Print('|03[ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ |11And Now |03... |11A Quote For You! |03]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ]');
NL;
END;
TotLoad := 0;
Assign(RGStrFile,General.LMultPath+MenuOption+'.DAT');
Reset(RGStrFile,1);
Seek(RGStrFile,(StrPointer.Pointer - 1));
REPEAT
BlockRead(RGStrFile,S[0],1);
BlockRead(RGStrFile,S[1],Ord(S[0]));
Inc(TotLoad,(Length(S) + 1));
IF (S[Length(S)] = '@') THEN
BEGIN
Dec(S[0]);
Prt(Centre(S));
END
ELSE
PrintACR(Centre(S));
UNTIL (TotLoad >= StrPointer.TextSize) OR EOF(RGStrFile);
Close(RGStrFile);
LastError := IOResult;
IF (Exist(General.MiscPath+'QUOTEFTR.*')) THEN
PrintF('QUOTEFTR')
ELSE
BEGIN
NL;
Print('|03[ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ]');
NL;
END;
IF (NOT General.UserAddQuote) THEN
PauseScr(FALSE)
ELSE IF (PYNQ('Would you like to add a quote? ',0,FALSE)) THEN
BEGIN
PrintF('QUOTE');
InResponseTo := '';
MHeader.Status := [];
IF (InputMessage(TRUE,FALSE,'New Quote',MHeader,General.LMultPath+MenuOption+'.TMP',78,500)) then
IF Exist(General.LMultPath+MenuOption+'.TMP') THEN
BEGIN
Assign(F,General.LMultPath+MenuOption+'.NEW');
Reset(F);
IF (IOResult <> 0) THEN
ReWrite(F)
ELSE
Append(F);
Assign(F1,General.LMultPath+MenuOption+'.TMP');
Reset(F1);
IF (IOResult <> 0) THEN
Exit;
WriteLn(F,'New quote from: '+Caps(ThisUser.Name)+' #'+IntToStr(UserNum)+'.');
WriteLn(F,'');
WriteLn(F,'$');
WHILE (NOT EOF(F1)) DO
BEGIN
ReadLn(F1,S);
WriteLn(F,S);
END;
WriteLn(F,'$');
WriteLn(F,'');
WriteLn(F);
Close(F);
Close(F1);
Kill(General.LMultPath+MenuOption+'.TMP');
NL;
Print('^7Your new quote was saved.');
PauseScr(FALSE);
SendShortMessage(1,Caps(ThisUser.Name)+' added a new quote to "'+MenuOption+'.NEW".');
END;
END;
END;
END.

BIN
BULLETIN.TPU Normal file
View File

Binary file not shown.

32
CHAIN.TXT Normal file
View File

@ -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

33
CHAINT~1.TXT Normal file
View File

@ -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

212
CHANGE.TXT Normal file
View File

@ -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!!!

27
CHANGE1.TXT Normal file
View File

@ -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!

53
CHANGE10.TXT Normal file
View File

@ -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.

28
CHANGE11.TXT Normal file
View File

@ -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.

28
CHANGE12.TXT Normal file
View File

@ -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.

5
CHANGE13.TXT Normal file
View File

@ -0,0 +1,5 @@
Scan All new public messages
SAPM[Node#].DAT
FoundMap: ARRAY [0..4095] OF SET OF 0..7;

29
CHANGE14.TXT Normal file
View File

@ -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.

8
CHANGE2.TXT Normal file
View File

@ -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.

7
CHANGE3.TXT Normal file
View File

@ -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.

70
CHANGE4.TXT Normal file
View File

@ -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.

42
CHANGE5.TXT Normal file
View File

@ -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 <CR>
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
<CR> 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
<CR> 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.

70
CHANGE6.TXT Normal file
View File

@ -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.

75
CHANGE7.TXT Normal file
View File

@ -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.

25
CHANGE8.TXT Normal file
View File

@ -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.

33
CHANGE9.TXT Normal file
View File

@ -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.

38
CHANGES.TXT Normal file
View File

@ -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!!!

44
CHANGES1.TXT Normal file
View File

@ -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.

57
CHANGES2.TXT Normal file
View File

@ -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.

18
CHANGES3.TXT Normal file
View File

@ -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.

133
CHANGES4.TXT Normal file
View File

@ -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!!!

42
CHANGES7.TXT Normal file
View File

@ -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<Node>.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!!!

35
CHANGES8.TXT Normal file
View File

@ -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!!!

29
CHANGES9.TXT Normal file
View File

@ -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!!!

27
CHNAGE2.TXT Normal file
View File

@ -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 <Enter> 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.

4870
COMMON.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
COMMON.TPU Normal file
View File

Binary file not shown.

410
COMMON1.PAS Normal file
View File

@ -0,0 +1,410 @@
{$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.

BIN
COMMON1.TPU Normal file
View File

Binary file not shown.

1255
COMMON2.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
COMMON2.TPU Normal file
View File

Binary file not shown.

523
COMMON3.PAS Normal file
View File

@ -0,0 +1,523 @@
{$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: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean);
PROCEDURE InputWordWOC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word);
PROCEDURE InputIntegerWC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean);
PROCEDURE InputIntegerWOC(S: AStr; VAR I: Integer; 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;
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: Word; 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: Word; 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: Integer; 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: Integer; 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;
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;
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.

BIN
COMMON3.TPU Normal file
View File

Binary file not shown.

870
COMMON4.PAS Normal file
View File

@ -0,0 +1,870 @@
{$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;
(*
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
ASM
Cmp InWfcMenu,1
Je @TheEnd
Mov AH,0Ah
Mov DX,FossilPort
Int 14h
@TheEnd:
END;
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
ASM
Cmp LocalIOOnly,1
Je @TheEnd
Mov AH,09h
Mov DX,FossilPort
Int 14h
@TheEnd:
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 Com_Carrier: Boolean;
VAR
Dummy: Byte;
BEGIN
Dummy := 0; (* New *)
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;
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;
BEGIN
Com_Recv := #0;
T_RecvChar := FALSE;
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);
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 *)
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);
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;
BEGIN
Dummy := 0; (* New *)
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);
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
ASM
Cmp LocalIOOnly,1
Je @TheEnd
Mov AH,0Bh
Mov DX,FossilPort
Mov AL,C (* Should this be Byte(C) *)
Int 14h
@TheEnd:
END;
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);
ASM
Mov AH,00h
Mov AL,T_AL
Mov DX,FossilPort
Int 14h
END;
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
ASM
Mov AH,05h
Mov DX,FossilPort
Int 14h
END;
END;
END;
PROCEDURE Com_Install;
FUNCTION DriverInstalled: Word; ASSEMBLER;
ASM
Mov AH,5
Mov DX,FossilPort
PushF
Call Interrupt14
Mov AH,4
PushF
Call Interrupt14
END;
BEGIN
FossilPort := (Liner.Comport - 1);
IF (LocalIOOnly) THEN
Exit;
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;
Com_Set_Speed(Liner.InitBaud);
END;
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;
(*
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
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 = '');
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
ASM
Mov DX,FossilPort
Mov AH,03h
Int 14h
Mov T_AH,AH
END;
Empty := NOT (T_AH AND 1 = 1);
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);
ASM
Mov AH,06h
Mov DX,FossilPort
Mov AL,T_AL
Int 14h
END;
END;
END;
END.

BIN
COMMON4.TPU Normal file
View File

Binary file not shown.

529
COMMON5.PAS Normal file
View File

@ -0,0 +1,529 @@
{$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.

BIN
COMMON5.TPU Normal file
View File

Binary file not shown.

193
CRC32.ASM Normal file
View File

@ -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
;
; <End of Pascal version comments>
;
; 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


132
CRC32A.PAS Normal file
View File

@ -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.

1025
CUSER.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
CUSER.TPU Normal file
View File

Binary file not shown.

1192
DEZIP.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

52
DOOR.SYS Normal file
View File

@ -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

11
DOOR32.SYS Normal file
View File

@ -0,0 +1,11 @@
0
0
Renegade BBS 09-17-07/Alpha
2
John Smith
John Smith
255
5998
1
6

121
DOOR32~1.TXT Normal file
View File

@ -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

768
DOORS.PAS Normal file
View File

@ -0,0 +1,768 @@
{$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.

BIN
DOORS.TPU Normal file
View File

Binary file not shown.

BIN
DOORSY~1.DOC Normal file
View File

Binary file not shown.

13
DORINFO1.DEF Normal file
View File

@ -0,0 +1,13 @@
The Renegade BBS
Renegade
SysOp
COM0
0 BAUD,N,8,1
0
LEE
PALMER
Kellogg, ID
1
255
32762
0

29
DORINF~1.TXT Normal file
View File

@ -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.
--------------------------------------------------------------------------------

1333
DRAG_010.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

55
EC.PAS Normal file
View File

@ -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.

2
EC.TXT Normal file
View File

@ -0,0 +1,2 @@
|03Copyright (C) 2003-2005 |03.
›ËþA° ™ tÛC·×ÿBk‹½íP}¯ßDdàCq

1105
EMAIL.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
EMAIL.TPU Normal file
View File

Binary file not shown.

33
ERROR.LOG Normal file
View File

@ -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

248
EVENT.PAS Normal file
View File

@ -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.

BIN
EVENT.TPU Normal file
View File

Binary file not shown.

242
EVENTS.PAS Normal file
View File

@ -0,0 +1,242 @@
{$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;
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
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.

BIN
EVENTS.TPU Normal file
View File

Binary file not shown.

219
EXECBAT.PAS Normal file
View File

@ -0,0 +1,219 @@
{$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;
{$L EXECWIN}
PROCEDURE SetCsInts; EXTERNAL;
PROCEDURE NewInt21; EXTERNAL;
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;
{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);
{$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);
{Restore interrupt}
SetIntVec($21,CurInt21);
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.

BIN
EXECBAT.TPU Normal file
View File

Binary file not shown.

BIN
FAELNG.EXE Normal file
View File

Binary file not shown.

267
FAELNG.PAS Normal file
View File

@ -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.

312
FAELNG.TXT Normal file
View File

@ -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<CR>^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
$

BIN
FAEPR.DAT Normal file
View File

Binary file not shown.

1
FAETX.DAT Normal file
View File

@ -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<CR>^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

596
FILE0.PAS Normal file
View File

@ -0,0 +1,596 @@
{$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;
FUNCTION CompFileArea(FArea,ArrayNum: Integer): Integer;
VAR
FileCompArrayFile: FILE OF CompArrayType;
CompFileArray: CompArrayType;
BEGIN
Assign(FileCompArrayFile,TempDir+'FACT'+IntToStr(ThisNode)+'.DAT');
Reset(FileCompArrayFile);
Seek(FileCompArrayFile,(FArea - 1));
Read(FileCompArrayFile,CompFileArray);
Close(FileCompArrayFile);
CompFileArea := CompFileArray[ArrayNum];
END;
FUNCTION GetCPS(TotalBytes,TransferTime: LongInt): LongInt;
BEGIN
IF (TransferTime > 0) THEN
GetCPS := (TotalBytes DIV TransferTime)
ELSE
GetCPS := 0;
END;
(* Done - 01/01/07 Lee Palmer *)
FUNCTION Align(CONST FName: Str12): Str12;
VAR
F: Str8;
E: Str3;
Counter,
Counter1: Byte;
BEGIN
Counter := Pos('.',FName);
IF (Counter = 0) THEN
BEGIN
F := FName;
E := ' ';
END
ELSE
BEGIN
F := Copy(FName,1,(Counter - 1));
E := Copy(FName,(Counter + 1),3);
END;
F := PadLeftStr(F,8);
E := PadLeftStr(E,3);
Counter := Pos('*',F);
IF (Counter <> 0) THEN
FOR Counter1 := Counter TO 8 DO
F[Counter1] := '?';
Counter := Pos('*',E);
IF (Counter <> 0) THEN
FOR Counter1 := Counter TO 3 DO
E[Counter1] := '?';
Counter := Pos(' ',F);
IF (Counter <> 0) THEN
FOR Counter1 := Counter TO 8 DO
F[Counter1] := ' ';
Counter := Pos(' ',E);
IF (Counter <> 0) THEN
FOR Counter1 := Counter TO 3 DO
E[Counter1] := ' ';
Align := F+'.'+E;
END;
FUNCTION BadDownloadPath: Boolean;
BEGIN
IF (BadDLPath) THEN
BEGIN
NL;
Print('^7File area #'+IntToStr(FileArea)+': Unable to perform command.');
SysOpLog('^5Bad DL file path: "'+MemFileArea.DLPath+'".');
Print('^5Please inform the SysOp.');
SysOpLog('Invalid DL path (File Area #'+IntToStr(FileArea)+'): "'+MemFileArea.DLPath+'"');
END;
BadDownloadPath := BadDLPath;
END;
FUNCTION BadUploadPath: Boolean;
BEGIN
IF (BadULPath) THEN
BEGIN
NL;
Print('^7File area #'+IntToStr(FileArea)+': Unable to perform command.');
SysOpLog('^5Bad UL file path: "'+MemFileArea.Ulpath+'".');
Print('^5Please inform the SysOp.');
SysOpLog('Invalid UL path (File Area #'+IntToStr(FileArea)+'): "'+MemFileArea.Ulpath+'"');
END;
BadUploadPath := BadULPath;
END;
FUNCTION FileAreaAC(FArea: Integer): Boolean;
BEGIN
FileAreaAC := FALSE;
IF (FArea < 1) OR (FArea > NumFileAreas) THEN
Exit;
LoadFileArea(FArea);
FileAreaAC := AACS(MemFileArea.ACS);
END;
PROCEDURE ChangeFileArea(FArea: Integer);
VAR
PW: Str20;
BEGIN
IF (FArea < 1) OR (FArea > NumFileAreas) OR (NOT FileAreaAC(FArea)) THEN
Exit;
IF (MemFileArea.Password <> '') AND (NOT SortFilesOnly) THEN
BEGIN
NL;
Print('File area: ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FArea,0))+'^1');
NL;
Prt('Password: ');
GetPassword(PW,20);
IF (PW <> MemFileArea.Password) THEN
BEGIN
NL;
Print('^7Incorrect password!^1');
Exit;
END;
END;
FileArea := FArea;
ThisUser.LastFileArea := FileArea;
END;
PROCEDURE LoadFileArea(FArea: Integer);
VAR
FO: Boolean;
BEGIN
IF (ReadFileArea = FArea) THEN
Exit;
IF (FArea < 1) THEN
Exit;
IF (FArea > NumFileAreas) THEN
BEGIN
MemFileArea := TempMemFileArea;
ReadFileArea := FArea;
Exit;
END;
FO := (FileRec(FileAreaFile).Mode <> FMClosed);
IF (NOT FO) THEN
BEGIN
Reset(FileAreaFile);
LastError := IOResult;
IF (LastError > 0) THEN
BEGIN
SysOpLog('FBASES.DAT/Open Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
Exit;
END;
END;
Seek(FileAreaFile,(FArea - 1));
LastError := IOResult;
IF (LastError > 0) THEN
BEGIN
SysOpLog('FBASES.DAT/Seek Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
Exit;
END;
Read(FileAreaFile,MemFileArea);
LastError := IOResult;
IF (LastError > 0) THEN
BEGIN
SysOpLog('FBASES.DAT/Read Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
Exit;
END
ELSE
ReadFileArea := FArea;
IF (NOT FO) THEN
BEGIN
Close(FileAreaFile);
LastError := IOResult;
IF (LastError > 0) THEN
BEGIN
SysOpLog('FBASES.DAT/Close Error - '+IntToStr(LastError)+' (Procedure: LoadFileArea - '+IntToStr(FArea)+')');
Exit;
END;
END;
LastError := IOResult;
END;
FUNCTION GetDirPath(MemFileArea: FileAreaRecordType): AStr;
BEGIN
IF (FADirDLPath IN MemFileArea.FAFlags) THEN
GetDirPath := MemFileArea.DLPath+MemFileArea.FileName
ELSE
GetDirPath := General.DataPath+MemFileArea.FileName;
END;
PROCEDURE LoadNewScanFile(VAR NewScanFile: Boolean);
VAR
FileAreaScanFile: FILE OF Boolean;
Counter: Integer;
BEGIN
Assign(FileAreaScanFile,GetDirPath(MemFileArea)+'.SCN');
Reset(FileAreaScanFile);
IF (IOResult = 2) THEN
ReWrite(FileAreaScanFile);
IF (UserNum > FileSize(FileAreaScanFile)) THEN
BEGIN
NewScanFile := TRUE;
Seek(FileAreaScanFile,FileSize(FileAreaScanFile));
FOR Counter := FileSize(FileAreaScanFile) TO (UserNum - 1) DO
Write(FileAreaScanFile,NewScanFile);
END
ELSE
BEGIN
Seek(FileAreaScanFile,(UserNum - 1));
Read(FileAreaScanFile,NewScanFile);
END;
Close(FileAreaScanFile);
LastError := IOResult;
END;
PROCEDURE SaveNewScanFile(NewScanFile: Boolean);
VAR
FileAreaScanFile: FILE OF Boolean;
BEGIN
Assign(FileAreaScanFile,GetDirPath(MemFileArea)+'.SCN');
Reset(FileAreaScanFile);
Seek(FileAreaScanFile,(UserNum - 1));
Write(FileAreaScanFile,NewScanFile);
Close(FileAreaScanFile);
LastError := IOResult;
END;
PROCEDURE InitFileArea(FArea: Integer);
BEGIN
LoadFileArea(FArea);
IF ((Length(MemFileArea.DLPath) = 3) AND (MemFileArea.DLPath[2] = ':') AND (MemFileArea.DLPath[3] = '\')) THEN
BadDLPath := NOT ExistDrive(MemFileArea.DLPath[1])
ELSE IF NOT (FACDRom IN MemFileArea.FAFlags) THEN
BadDLPath := NOT ExistDir(MemFileArea.DLPath)
ELSE
BadDLPath := FALSE;
IF ((Length(MemFileArea.ULPath) = 3) AND (MemFileArea.ULPath[2] = ':') AND (MemFileArea.DLPath[3] = '\')) THEN
BadULPath := NOT ExistDrive(MemFileArea.ULPath[1])
ELSE IF NOT (FACDRom IN MemFileArea.FAFlags) THEN
BadULPath := NOT ExistDir(MemFileArea.ULPath)
ELSE
BadULPath := FALSE;
IF (NOT DirFileOpen1) THEN
IF (FileRec(FileInfoFile).Mode <> FMClosed) THEN
Close(FileInfoFile);
DirFileOpen1 := FALSE;
Assign(FileInfoFile,GetDirPath(MemFileArea)+'.DIR');
Reset(FileInfoFile);
IF (IOResult = 2) THEN
ReWrite(FileInfoFile);
IF (IOResult <> 0) THEN
BEGIN
SysOpLog('Error opening file: '+GetDirPath(MemFileArea)+'.DIR');
Exit;
END;
IF (NOT ExtFileOpen1) THEN
IF (FileRec(ExtInfoFile).Mode <> FMClosed) THEN
Close(ExtInfoFile);
ExtFileOpen1 := FALSE;
Assign(ExtInfoFile,GetDirPath(MemFileArea)+'.EXT');
Reset(ExtInfoFile,1);
IF (IOResult = 2) THEN
ReWrite(ExtInfoFile,1);
IF (IOResult <> 0) THEN
BEGIN
SysOpLog('Error opening file: '+GetDirPath(MemFileArea)+'.EXT');
Exit;
END;
LoadNewScanFile(NewScanFileArea);
FileAreaNameDisplayed := FALSE;
END;
PROCEDURE DisplayFileInfo(VAR F: FileInfoRecordType; Editing: Boolean);
VAR
TempStr: AStr;
Counter,
NumLine,
NumExtDesc: Byte;
FUNCTION DisplayFIStr(FIFlags: FIFlagSet): AStr;
VAR
TempStr1: AStr;
BEGIN
TempStr1 := '';
IF (FINotVal IN FIFlags) THEN
TempStr1 := TempStr1 + ' ^8'+'<NV>';
IF (FIIsRequest IN FIFlags) THEN
TempStr1 := TempStr1 + ' ^9'+'Ask (Request File)';
IF (FIResumeLater IN FIFlags) THEN
TempStr1 := TempStr1 + ' ^7'+'Resume later';
IF (FIHatched IN FIFlags) THEN
TempStr1 := TempStr1 + ' ^7'+'Hatched';
DisplayFIStr := TempStr1;
END;
BEGIN
Counter := 1;
WHILE (Counter <= 7) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
WITH F DO
BEGIN
IF (Editing) THEN
TempStr := IntToStr(Counter)+'. '
ELSE
TempStr := '';
CASE Counter OF
1 : TempStr := TempStr + 'Filename : ^0'+SQOutSp(FileName);
2 : IF (NOT General.FileCreditRatio) THEN
TempStr := TempStr + 'File size : ^2'+ConvertBytes(FileSize,FALSE)
ELSE
TempStr := TempStr + 'File size : ^2'+ConvertKB(FileSize DIV 1024,FALSE);
3 : BEGIN
TempStr := TempStr + 'Description : ^9'+Description;
PrintACR('^1'+TempStr);
IF (F.VPointer <> -1) THEN
BEGIN
LoadVerbArray(F,ExtendedArray,NumExtDesc);
NumLine := 1;
WHILE (NumLine <= NumExtDesc) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
PrintACR('^1'+AOnOff(Editing,PadLeftStr('',3),'')
+AOnOff(Editing AND (NumLine = 1),PadLeftStr('Extended',13),PadLeftStr('',13))
+AOnOff(Editing,PadRightInt(NumLine,3),PadRightStr('',3))
+' : ^9'+ExtendedArray[NumLine]);
Inc(NumLine);
END;
END;
IF (Editing) THEN
IF (F.VPointer = -1) THEN
PrintACR('^5 No extended description.');
END;
4 : TempStr := TempStr + 'Uploaded by : ^4'+Caps(OwnerName);
5 : TempStr := TempStr + 'Uploaded on : ^5'+PD2Date(FileDate);
6 : BEGIN
TempStr := TempStr + 'Times downloaded : ^5'+FormatNumber(Downloaded);
PrintACR('^1'+TempStr);
IF (NOT Editing) THEN
BEGIN
TempStr := 'Block size : 128-"^5'+IntToStr(FileSize DIV 128)+
'^1" / 1024-"^5'+IntToStr(FileSize DIV 1024)+'^1"';
PrintACR('^1'+TempStr);
TempStr := 'Time to download : ^5'+CTim(FileSize DIV Rate);
PrintACR('^1'+TempStr);
END;
END;
7 : TempStr := TempStr + 'File point cost : ^4'+AOnOff((FilePoints > 0),FormatNumber(FilePoints),'FREE')+
DisplayFIStr(FIFlags);
END;
IF (NOT (Counter IN [3,6])) THEN
PrintACR('^1'+TempStr+'^1');
END;
Inc(Counter);
END;
END;
FUNCTION Fit(CONST FileName1,FileName2: Str12): Boolean;
VAR
Counter: Byte;
Match: Boolean;
BEGIN
Match := TRUE;
FOR Counter := 1 TO 12 DO
IF (FileName1[Counter] <> FileName2[Counter]) AND (FileName1[Counter] <> '?') THEN
Match := FALSE;
IF (FileName2 = '') THEN
Match := FALSE;
Fit := Match;
END;
PROCEDURE GetFileName(VAR FileName: Str12);
BEGIN
MPL(12);
InputMain(FileName,12,[NoLineFeed,UpperOnly]);
IF (FileName <> '') THEN
NL
ELSE
BEGIN
MPL(12);
FileName := '*.*';
Print(FileName);
END;
FileName := Align(FileName);
END;
FUNCTION ISUL(CONST s: AStr): Boolean;
BEGIN
ISUL := ((Pos('/',s) <> 0) OR (Pos('\',s) <> 0) OR (Pos(':',s) <> 0) OR (Pos('|',s) <> 0));
END;
FUNCTION IsWildCard(CONST S: AStr): Boolean;
BEGIN
IsWildCard := ((Pos('*',S) <> 0) OR (Pos('?',S) <> 0));
END;
PROCEDURE LRecNo(FileInfo: FileInfoRecordType; VAR RN: Integer);
VAR
DirFileRecNum: Integer;
BEGIN
RN := 0;
IF (LastDIRRecNum <= FileSize(FileInfoFile)) AND (LastDIRRecNum >= 0) THEN
BEGIN
DirFileRecNum := (LastDIRRecNum - 1);
WHILE (DirFileRecNum >= 0) AND (RN = 0) DO
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
IF Fit(LastDIRFileName,FileInfo.FileName) THEN
RN := DirFileRecNum;
Dec(DirFileRecNum);
END;
LastDIRRecNum := RN;
END
ELSE
RN := -1;
LastError := IOResult;
END;
PROCEDURE NRecNo(FileInfo: FileInfoRecordType; VAR RN: Integer);
VAR
DirFileRecNum: Integer;
BEGIN
RN := 0;
IF (LastDIRRecNum < FileSize(FileInfoFile)) AND (LastDIRRecNum >= -1) THEN
BEGIN
DirFileRecNum := (LastDIRRecNum + 1);
WHILE (DirFileRecNum < FileSize(FileInfoFile)) AND (RN = 0) DO
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
IF Fit(LastDIRFileName,FileInfo.FileName) THEN
RN := (DirFileRecNum + 1);
Inc(DirFileRecNum);
END;
Dec(RN);
LastDIRRecNum := RN;
END
ELSE
RN := -1;
LastError := IOResult;
END;
PROCEDURE RecNo(FileInfo: FileInfoRecordType; FileName: Str12; VAR RN: Integer);
VAR
DirFileRecNum: Integer;
BEGIN
InitFileArea(FileArea);
FileName := Align(FileName);
RN := 0;
DirFileRecNum := 0;
WHILE (DirFileRecNum < FileSize(FileInfoFile)) AND (RN = 0) DO
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
IF Fit(FileName,FileInfo.FileName) THEN
RN := (DirFileRecNum + 1);
Inc(DirFileRecNum);
END;
Dec(RN);
LastDIRRecNum := RN;
LastDIRFileName := FileName;
LastError := IOResult;
END;
PROCEDURE LoadVerbArray(F: FileInfoRecordType; VAR ExtArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte);
VAR
VerbStr: AStr;
TotLoad: Integer;
VFO: Boolean;
BEGIN
FillChar(ExtArray,SizeOf(ExtArray),0);
NumExtDesc := 1;
VFO := (FileRec(ExtInfoFile).Mode <> FMClosed);
IF (NOT VFO) THEN
Reset(ExtInfoFile,1);
IF (IOResult = 0) THEN
BEGIN
TotLoad := 0;
Seek(ExtInfoFile,(F.VPointer - 1));
REPEAT
BlockRead(ExtInfoFile,VerbStr[0],1);
BlockRead(ExtInfoFile,VerbStr[1],Ord(VerbStr[0]));
Inc(TotLoad,(Length(VerbStr) + 1));
ExtArray[NumExtDesc] := VerbStr;
Inc(NumExtDesc);
UNTIL (TotLoad >= F.VTextSize);
IF (NOT VFO) THEN
Close(ExtInfoFile);
END;
Dec(NumExtDesc);
LastError := IOResult;
END;
PROCEDURE SaveVerbArray(VAR F: FileInfoRecordType; ExtArray: ExtendedDescriptionArray; NumExtDesc: Byte);
VAR
LineNum: Byte;
VFO: Boolean;
BEGIN
VFO := (FileRec(ExtInfoFile).Mode <> FMClosed);
IF (NOT VFO) THEN
Reset(ExtInfoFile,1);
IF (IOResult = 0) THEN
BEGIN
F.VPointer := (FileSize(ExtInfoFile) + 1);
F.VTextSize := 0;
Seek(ExtInfoFile,FileSize(ExtInfoFile));
FOR LineNum := 1 TO NumExtDesc DO
IF (ExtArray[LineNum] <> '') THEN
BEGIN
Inc(F.VTextSize,(Length(ExtArray[LineNum]) + 1));
BlockWrite(ExtInfoFile,ExtArray[LineNum],(Length(ExtArray[LineNum]) + 1));
END;
IF (NOT VFO) THEN
Close(ExtInfoFile);
END;
LastError := IOResult;
END;
PROCEDURE CountDown;
VAR
Cmd: Char;
Counter: Byte;
SaveTimer: LongInt;
BEGIN
NL;
Print('Press <^5CR^1> to logoff now.');
Print('Press <^5Esc^1> to abort logoff.');
NL;
Prompt('|12Hanging up in: ^99');
SaveTimer := Timer;
Cmd := #0;
Counter := 9;
WHILE (Counter > 0) AND NOT (Cmd IN [#13,#27]) AND (NOT HangUp) DO
BEGIN
IF (NOT Empty) THEN
Cmd := Char(InKey);
IF (Timer <> SaveTimer) THEN
BEGIN
Dec(Counter);
Prompt(^H+IntToStr(Counter));
SaveTimer := Timer;
END
ELSE
ASM
Int 28h
END;
END;
IF (Cmd <> #27) THEN
BEGIN
HangUp := TRUE;
OutCom := FALSE;
END;
UserColor(1);
END;
END.

BIN
FILE0.TPU Normal file
View File

Binary file not shown.

1584
FILE1.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
FILE1.TPU Normal file
View File

Binary file not shown.

835
FILE10.LEE Normal file
View File

@ -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.

906
FILE10.PAS Normal file
View File

@ -0,0 +1,906 @@
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
UNIT File10;
INTERFACE
USES
Common;
PROCEDURE CreditFileOwner(VAR User: UserRecordType; VAR FileInfo: FileInfoRecordType; Credit: Boolean; GotPts: Integer);
PROCEDURE EditFile(DirFileRecNum: Integer; VAR Cmd: Char; NoPrompt,IsPoints: Boolean);
PROCEDURE EditFiles;
PROCEDURE ValidateFiles;
IMPLEMENTATION
USES
Dos,
ArcView,
Common5,
File0,
File1,
File2,
File9,
Mail1,
SysOp3,
TimeFunc,
MiscUser;
PROCEDURE CreditFileOwner(VAR User: UserRecordType; VAR FileInfo: FileInfoRecordType; Credit: Boolean; GotPts: Integer);
VAR
FilePointsReceived: Integer;
BEGIN
IF (AllCaps(FileInfo.OwnerName) <> AllCaps(User.Name)) THEN
BEGIN
NL;
Print('^7File owner name does not match user name!^1');
Exit;
END;
IF (NOT General.FileCreditRatio) THEN
GotPts := 0
ELSE IF (GotPts = 0) THEN
BEGIN
FilePointsReceived := 0;
IF (General.FileCreditCompBaseSize <> 0) THEN
FilePointsReceived := ((FileInfo.FileSize DIV 1024) DIV General.FileCreditCompBaseSize);
GotPts := (FilePointsReceived * General.FileCreditComp);
IF (GotPts < 1) THEN
GotPts := 1;
END;
NL;
Print(AOnOff(Credit,'^1Awarding upload','^1Removing upload')+' credits:'+
' ^51 file'+
', '+ConvertKB(FileInfo.FileSize DIV 1024,FALSE)+
', '+IntToStr(GotPts)+' file points.^1');
SysOpLog(AOnOff(Credit,'^1Awarding upload','^1Removing upload')+' credits:'+
' ^51 file'+
', '+ConvertKB(FileInfo.FileSize DIV 1024,FALSE)+
', '+IntToStr(GotPts)+' file points.^1');
IF (Credit) THEN
BEGIN
IF (User.Uploads < 2147483647) THEN
Inc(User.Uploads);
IF ((User.UK + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN
Inc(User.UK,(FileInfo.FileSize DIV 1024))
ELSE
User.UK := 2147483647;
IF ((User.FilePoints + GotPts) < 2147483647) THEN
Inc(User.FilePoints,GotPts)
ELSE
User.FilePoints := 2147483647;
Include(FileInfo.FIFlags,FIOwnerCredited);
END
ELSE
BEGIN
IF (User.Uploads > 0) THEN
Dec(User.Uploads);
IF ((User.UK - (FileInfo.FileSize DIV 1024)) > 0) THEN
Dec(User.UK,(FileInfo.FileSize DIV 1024))
ELSE
User.UK := 0;
IF ((User.FilePoints - GotPts) > 0) THEN
Dec(User.FilePoints,GotPts)
ELSE
User.FilePoints := 0;
Exclude(FileInfo.FIFlags,FIOwnerCredited);
END;
SaveURec(User,FileInfo.OwnerNum);
END;
PROCEDURE EditFile(DirFileRecNum: Integer; VAR Cmd: Char; NoPrompt,IsPoints: Boolean);
VAR
FF: FILE;
ExtText: Text;
User: UserRecordType;
Mheader: MheaderRec;
InputStr,
MoveFromDir,
MoveToDir: AStr;
LineNum,
NumExtDesc: Byte;
UNum,
NewFileArea,
SaveFileArea,
FArea,
NumFAreas,
Totload,
SaveFArea: Integer;
FSize: Longint;
SaveConfSystem,
SaveTempPause,
DontShowList,
Ok: Boolean;
PROCEDURE ToggleFIFlag(FIFlagT: FileInfoFlagType; VAR FIFlagS: FIFlagSet);
BEGIN
IF (FIFlagT IN FIFlagS) THEN
Exclude(FIFlagS,FIFlagT)
ELSE
Include(FIFlagS,FIFlagT);
END;
PROCEDURE ToggleFIFlags(C: Char; VAR FIFlagS: FIFlagSet);
BEGIN
CASE C OF
'V' : ToggleFIFlag(FiNotVal,FIFlagS);
'T' : ToggleFIFlag(FiIsRequest,FIFlagS);
'R' : ToggleFIFlag(FIResumeLater,FIFlagS);
'H' : ToggleFIFlag(FIHatched,FIFlagS);
END;
END;
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
IF (IOResult <> 0) THEN
Exit;
IF (FileInfo.OwnerNum < 1) OR (FileInfo.OwnerNum > (MaxUsers - 1)) THEN
FileInfo.OwnerNum := 1;
LoadURec(User,FileInfo.OwnerNum);
IF (IsPoints) THEN
BEGIN
NL;
DisplayFileInfo(FileInfo,TRUE);
NL;
Prt('File points for file (^50^4-^5999^4,^5<CR>^4=^5Skip^4,^5Q^4=^5Quit^4): ');
MPL(3);
Input(InputStr,3);
IF (InputStr <> '') THEN
BEGIN
IF (InputStr = 'Q') THEN
BEGIN
NL;
Print('Aborted.');
Abort := TRUE
END
ELSE IF (StrToInt(InputStr) >= 0) AND (StrToInt(InputStr) <= 999) THEN
BEGIN
FileInfo.FilePoints := StrToInt(InputStr);
Exclude(FileInfo.FIFlags,FINotVal);
Seek(FileInfoFile,DirFileRecNum);
Write(FileInfoFile,FileInfo);
CreditFileOwner(User,FileInfo,TRUE,FileInfo.FilePoints);
IF (FileInfo.OwnerNum = UserNum) THEN
User.FilePoints := ThisUser.FilePoints;
NL;
Prt('File points for user (^5-'+IntToStr(User.FilePoints)+'^4 to ^5999^4): ');
MPL(4);
Input(InputStr,4);
IF (InputStr <> '') AND (StrToInt(InputStr) >= -User.FilePoints) AND (StrToInt(InputStr) <= 999) THEN
BEGIN
Inc(User.FilePoints,StrToInt(InputStr));
IF (FileInfo.OwnerNum = UserNum) THEN
ThisUser.FilePoints := User.FilePoints;
SaveURec(User,FileInfo.OwnerNum);
END;
END;
END;
Exit;
END;
IF (NoPrompt) THEN
BEGIN
Exclude(FileInfo.FIFlags,FINotVal);
Seek(FileInfoFile,DirFileRecNum);
Write(FileInfoFile,FileInfo);
CreditFileOwner(User,FileInfo,TRUE,0);
Exit;
END;
DontShowList := FALSE;
REPEAT
Abort := FALSE;
Next := FALSE;
IF (NOT DontShowList) THEN
BEGIN
NL;
DisplayFileInfo(FileInfo,TRUE);
Abort := FALSE;
END
ELSE
DontShowList := FALSE;
NL;
Abort := FALSE;
IF (Next) THEN
Cmd := 'N'
ELSE
BEGIN
Prt('Edit files (^5?^4=^5Help^4): ');
OneK(Cmd,'Q1234567DEGHIMNPRTUVW?'^M,TRUE,TRUE);
END;
CASE Cmd OF
'1' : BEGIN
NL;
Prt('New file name: ');
MPL((SizeOf(FileInfo.FileName) - 1));
Input(InputStr,(SizeOf(FileInfo.FileName) - 1));
IF (InputStr = '') THEN
BEGIN
NL;
Print('Aborted.');
END
ELSE IF (SQOutSp(InputStr) = SQOutSp(FileInfo.FileName)) THEN
BEGIN
NL;
Print('^7You must specify a different file name!^1');
END
ELSE IF (Exist(MemFileArea.DLPath+InputStr) OR Exist(MemFileArea.ULPath+InputStr)) THEN
BEGIN
NL;
Print('^7That file name exists in the download or upload path!^1');
END
ELSE
BEGIN
IF (NOT Exist(MemFileArea.DLPath+FileInfo.FileName)) OR
(NOT Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
BEGIN
NL;
Print('That file name does not exist in the download or upload path.');
Ok := FALSE;
IF (CoSysOp) THEN
BEGIN
IF (NOT (FIIsRequest IN FileInfo.FIFlagS)) THEN
BEGIN
NL;
IF (PYNQ('Do you want to set this file to offline? ',0,FALSE)) THEN
BEGIN
FileInfo.FileSize := 0;
Include(FileInfo.FIFlagS,FIIsRequest);
END;
END;
NL;
IF (PYNQ('Do you want to rename the file anyway? ', 0,FALSE)) THEN
Ok := TRUE;
END;
END;
IF (Ok) THEN
BEGIN
IF (Exist(MemFileArea.DLPath+FileInfo.FileName)) THEN
BEGIN
Assign(FF,MemFileArea.DLPath+FileInfo.FileName);
ReName(FF,MemFileArea.DLPath+InputStr);
END
ELSE IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
BEGIN
Assign(FF,MemFileArea.ULPath+FileInfo.FileName);
ReName(FF,MemFileArea.ULPath+InputStr);
END;
LastError := IOResult;
FileInfo.FileName := Align(InputStr);
END;
END;
END;
'2' : BEGIN
NL;
Print('Limit on file size restricted to 1.9 Gig.');
OK := TRUE;
IF (NOT Exist(MemFileArea.DLPath+FileInfo.FileName)) OR (NOT Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
BEGIN
NL;
IF (PYNQ('File does not exist, set to offline? ',0,FALSE)) THEN
BEGIN
FSize := 0;
Include(FileInfo.FIFlags,FiIsRequest);
OK := FALSE;
END;
END;
IF (Ok) THEN
BEGIN
NL;
IF PYNQ('Update with actual file size? ', 0,FALSE) THEN
BEGIN
FSize := 0;
IF (Exist(MemFileArea.DLPath+FileInfo.FileName)) THEN
FSize := GetFileSize(MemFileArea.DLPath+SQOutSp(FileInfo.FileName))
ELSE IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
FSize := GetFileSize(MemFileArea.ULPath+SqOutSp(FileInfo.FileName));
END
ELSE
BEGIN
FSize := FileInfo.FileSize;
InputLongIntWOC('%LFNew file size in bytes',FSize,[DisplayValue,NumbersOnly],0,2147483647);
END;
END;
IF (FSize >= 0) AND (FSize <= 2147483647) THEN
FileInfo.FileSize := FSize;
END;
'3' : BEGIN
NL;
Print('New description: ');
Prt(': ');
MPL((SizeOf(FileInfo.Description) - 1));
InputMain(FileInfo.Description,(SizeOf(FileInfo.Description) - 1),[InteractiveEdit]);
END;
'4' : BEGIN
LoadURec(User,FileInfo.OwnerNum);
IF (AllCaps(FileInfo.OwnerName) <> AllCaps(User.Name)) THEN
BEGIN
NL;
Print('Previous owner was '+Caps(FileInfo.OwnerName)+' #'+IntToStr(FileInfo.OwnerNum));
NL;
LoadURec(User,1);
FileInfo.OwnerNum := 1;
FileInfo.OwnerName := AllCaps(User.Name);
END;
NL;
Print('New owner user number or name ('+Caps(FileInfo.OwnerName)+' #'+IntToStr(FileInfo.OwnerNum)+'): ');
Prt(': ');
MPL((SizeOf(FileInfo.OwnerName) - 1));
FindUser(UNum);
IF (UNum <= 0) THEN
BEGIN
NL;
Print('User not found.');
END
ELSE
BEGIN
LoadURec(User,UNum);
FileInfo.OwnerNum := UNum;
FileInfo.OwnerName := AllCaps(User.Name);
END;
END;
'5' : BEGIN
NL;
Prt('New upload file date ('+PD2Date(FileInfo.FileDate)+'): ');
InputFormatted('',InputStr,'##-##-####',TRUE);
IF (InputStr = '') THEN
BEGIN
NL;
Print('Aborted.');
END
ELSE
BEGIN
IF (DayNum(InputStr) = 0) OR (DayNum(InputStr) > DayNum(DateStr)) THEN
BEGIN
NL;
Print('^7Invalid date entered!^1');
END
ELSE
FileInfo.FileDate := Date2PD(InputStr);
END;
END;
'6' : InputLongIntWOC('%LFNew number of downloads',FileInfo.DownLoaded,[DisplayValue,NumbersOnly],0,2147483647);
'7' : InputIntegerWOC('%LFNew amount of file points',FileInfo.FilePoints,[NumbersOnly],0,999);
'D' : IF PYNQ('%LFAre you sure? ',0,FALSE) THEN
BEGIN
Deleteff(FileInfo,DirFileRecNum);
InitFileArea(FileArea);
Dec(LastDIRRecNum);
InputStr := 'Removed "'+SQOutSp(FileInfo.FileName)+'" from '+MemFileArea.AreaName;
IF (Exist(MemFileArea.DLPath+FileInfo.FileName) OR Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
BEGIN
NL;
IF PYNQ('Erase file also? ',0,FALSE) THEN
BEGIN
Kill(MemFileArea.DLPath+FileInfo.FileName);
Kill(MemFileArea.ULPath+FileInfo.FileName);
InputStr := InputStr+' [FILE DELETED]'
END;
END;
IF (NOT (FIOwnerCredited IN FileInfo.FIFlags)) THEN
Print('%LF^7Owner did not receive upload credit for this file!^1')
ELSE IF PYNQ('%LFRemove from ^5'+Caps(User.Name)+' #'+IntToStr(FileInfo.OwnerNum)+'^7''s ratio? ',0,FALSE) THEN
CreditFileOwner(User,FileInfo,FALSE,FileInfo.FilePoints);
SysOpLog(InputStr);
Cmd := 'N';
END;
'E' : BEGIN
OK := TRUE;
IF (FileInfo.VPointer <> -1) THEN
BEGIN
IF (NOT PYNQ('%LFDelete the extended description for this file? ',0,FALSE)) THEN
LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc)
ELSE
BEGIN
FileInfo.VPointer := -1;
FileInfo.VTextSize := 0;
OK := FALSE;
END;
END
ELSE
BEGIN
IF (NOT PYNQ('%LFCreate an extended description for this file? ',0,FALSE)) THEN
BEGIN
FileInfo.VPointer := -1;
FileInfo.VTextSize := 0;
OK := FALSE
END
ELSE
BEGIN
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
NumExtDesc := 1;
END;
END;
IF (Ok) THEN
BEGIN
Assign(ExtText,TempDir+MemFileArea.FileName+'.TMP');
ReWrite(ExtText);
LineNum := 0;
REPEAT
Inc(LineNum);
IF (ExtendedArray[LineNum] <> '') THEN
WriteLn(ExtText,ExtendedArray[LineNum]);
UNTIL (LineNum = NumExtDesc);
Close(ExtText);
MHeader.Status := [];
InResponseTo := '';
IF (InputMessage(TRUE,FALSE,'Extended Description',
MHeader,TempDir+MemFileArea.FileName+'.TMP',50,99)) then
IF Exist(TempDir+MemFileArea.FileName+'.TMP') THEN
BEGIN
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
Assign(ExtText,TempDir+MemFileArea.FileName+'.TMP');
Reset(ExtText);
NumExtDesc := 0;
REPEAT
ReadLn(ExtText,InputStr);
IF (InputStr <> '') THEN
BEGIN
Inc(NumExtDesc);
ExtendedArray[NumExtDesc] := InputStr;
END;
UNTIL (NumExtDesc = MaxExtDesc) OR EOF(ExtText);
Close(ExtText);
IF (ExtendedArray[1] <> '') THEN
SaveVerbArray(FileInfo,ExtendedArray,NumExtDesc);
END;
Kill(TempDir+MemFileArea.FileName+'.TMP');
END;
Cmd := #0;
END;
'G' : IF (NOT General.FileDiz) THEN
Print('%LF^7This option is not active in the System Configuration!^1')
ELSE
BEGIN
IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
InputStr := MemFileArea.ULPath+SQOutSp(FileInfo.FileName)
ELSE
InputStr := MemFileArea.DLPath+SQOutSp(FileInfo.FileName);
IF (NOT DizExists(InputStr)) THEN
Print('%LFFile has no internal description.')
ELSE
BEGIN
GetDiz(FileInfo,ExtendedArray,NumExtDesc);
IF (ExtendedArray[1] <> '') THEN
SaveVerbArray(FileInfo,ExtendedArray,NumExtDesc)
ELSE
BEGIN
FileInfo.VPointer := -1;
FileInfo.VTextSize := 0;
END;
END;
END;
'H' : ToggleFIFlags('H',FileInfo.FIFlagS);
'I' : IF (NOT ValidIntArcType(FileInfo.FileName)) THEN
BEGIN
NL;
Print('^7Not a valid archive type or not supported!^1')
END
ELSE
BEGIN
OK := FALSE;
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
BEGIN
ViewInternalArchive(MemFileArea.DLPath+SQOutSp(FileInfo.FileName));
OK := TRUE;
END
ELSE IF Exist(MemFileArea.ULPath+FileInfo.FileName) THEN
BEGIN
ViewInternalArchive(MemFileArea.ULPath+SQOutSp(FileInfo.FileName));
OK := TRUE;
END;
IF (NOT Ok) THEN
BEGIN
NL;
IF (PYNQ('File does not exist, set to offline? ',0,FALSE)) THEN
BEGIN
FileInfo.FileSize := 0;
ToggleFIFlags('T',FileInfo.FIFlagS);
END;
END;
Abort := FALSE;
END;
'M' : BEGIN
SaveFileArea := FileArea;
SaveConfSystem := ConfSystem;
IF (SaveConfSystem) THEN
NewCompTables;
SaveTempPause := TempPause;
TempPause := FALSE;
FArea := 1;
NumFAreas := 0;
LightBarCmd := 1;
LightBarFirstCmd := TRUE;
InputStr := '?';
REPEAT
SaveFArea := FArea;
IF (InputStr = '?') THEN
LFileAreaList(FArea,NumFAreas,5,FALSE);
{
%LFMove to which file area? (^5'+IntToStr(LowFileArea)+'^4-^5'+IntToStr(HighFileArea)+'^4)
[^5#^4,^5?^4=^5Help^4,^5Q^4=^5Quit^4]: @
}
FileAreaScanInput(LRGLngStr(76,TRUE),Length(IntToStr(HighFileArea)),InputStr,'Q[]?',LowFileArea,HighFileArea);
IF (InputStr <> 'Q') THEN
BEGIN
IF (InputStr = '[') THEN
BEGIN
Farea := (SaveFArea - ((PageLength - 5) * 2));
IF (FArea < 1) THEN
FArea := 1;
InputStr := '?';
END
ELSE IF (InputStr = ']') THEN
BEGIN
IF (FArea > NumFileAreas) THEN
FArea := SaveFArea;
InputStr := '?';
END
ELSE IF (InputStr = '?') THEN
BEGIN
{
$File_Message_Area_List_Help
%LF^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry
^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page
^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry
^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down
^1(^3[^1)Previous page ^1(^3]^1)Next page
%PA
}
LRGLngStr(71,FALSE);
FArea := SaveFArea;
END
ELSE IF (StrToInt(InputStr) < LowFileArea) OR (StrToInt(InputStr) > HighFileArea) THEN
BEGIN
NL;
Print('^7The range must be from '+IntToStr(LowFileArea)+' to '+IntToStr(HighFileArea)+'!^1');
PauseScr(FALSE);
InputStr := '?';
FArea := SaveFArea;
END
ELSE IF (StrToInt(InputStr) = FileArea) THEN
BEGIN
NL;
Print('^7You can not move a file to the same file area.^1');
PauseScr(FALSE);
InputStr := '?';
FArea := SaveFArea;
END
ELSE
BEGIN
NewFileArea := CompFileArea(StrToInt(InputStr),1);
IF (FileArea <> NewFileArea) THEN
ChangeFileArea(NewFileArea);
IF (FileArea <> NewFileArea) THEN
BEGIN
NL;
Print('^7You do not have access to this file area!^1');
PauseScr(FALSE);
InputStr := '?';
FArea := SaveFArea;
END
ELSE
BEGIN
FileArea := SaveFileArea;
LoadFileArea(FileArea);
IF Exist(MemFileArea.DLPath+FileInfo.FileName) THEN
MoveFromDir := MemFileArea.DLPath
ELSE
MoveFromDir := MemFileArea.ULPath;
LoadFileArea(NewFileArea);
MoveToDir := MemFileArea.ULPath;
NL;
IF (NOT PYNQ('Move file to '+MemFileArea.AreaName+'? ',0,FALSE)) THEN
BEGIN
InputStr := '?';
FArea := SaveFArea;
END
ELSE
BEGIN
OK := TRUE;
IF Exist(MoveToDir+SQoutSp(FileInfo.FileName)) THEN
BEGIN
NL;
Print('^7The file exists in the upload path!^1');
OK := FALSE;
END
ELSE IF (NOT Exist(MoveFromDir+SQOutSp(FileInfo.FileName))) THEN
BEGIN
NL;
Print('^7The file does not exist in the download path!^1');
OK := FALSE;
END;
IF (Ok) THEN
BEGIN
NL;
CopyMoveFile(FALSE,'^5Moving file: ',
MoveFromDir+SQOutSp(FileInfo.FileName),
MoveToDir+SQOutSp(FileInfo.FileName),
TRUE);
END;
NL;
Prompt('^5Moving records: ');
FileArea := SaveFileArea;
InitFileArea(FileArea);
IF (BadDownloadPath) THEN
Exit;
IF (FileInfo.VPointer <> -1) THEN
LoadVerbArray(FileInfo,ExtendedArray,NumExtDesc);
Deleteff(FileInfo,DirFileRecNum);
FileArea := NewFileArea;
InitFileArea(FileArea);
IF (BadDownloadPath) THEN
Exit;
IF (FileInfo.VPointer <> - 1) THEN
SaveVerbArray(FileInfo,ExtendedArray,NumExtDesc);
Seek(FileInfoFile,FileSize(FileInfoFile));
Write(FileInfoFile,FileInfo);
FileArea := SaveFileArea;
InitFileArea(FileArea);
Dec(LastDIRRecNum);
Print('Done!^1');
Cmd := 'N';
END;
END;
FileArea := SaveFileArea;
LoadFileArea(FileArea);
END;
END;
IF (InputStr = 'Q') THEN
Cmd := 'N';
UNTIL (Cmd = 'N') OR (HangUp);
ConfSystem := SaveConfSystem;
IF (SaveConfSystem) THEN
NewCompTables;
TempPause := SaveTempPause;
FileArea := SaveFileArea;
LoadFileArea(FileArea);
END;
'P' : ;
'Q' : Abort := TRUE;
'R' : ToggleFIFlags('R',FileInfo.FIFlagS);
'T' : ToggleFIFlags('T',FileInfo.FIFlagS);
'U' : IF (NOT CoSysOp) THEN
BEGIN
NL;
Print('^7You do not have the required access level for this option!^1')
END
ELSE
BEGIN
IF (FileInfo.OwnerNum < 1) OR (FileInfo.OwnerNum > (MaxUsers - 1)) THEN
BEGIN
LoadURec(User,1);
FileInfo.OwnerNum := 1;
FileInfo.OwnerName := AllCaps(User.Name);
END;
UserEditor(FileInfo.OwnerNum);
END;
'V' : BEGIN
ToggleFIFlags('V',FileInfo.FIFlagS);
IF (FINotVal IN FileInfo.FIFlags) THEN
BEGIN
IF (NOT (FIOwnerCredited IN FileInfo.FIFlags)) THEN
Print('%LF^7Owner did not receive upload credit for this file!^1')
ELSE
CreditFileOwner(User,FileInfo,FALSE,FileInfo.FilePoints);
END
ELSE
CreditFileOwner(User,FileInfo,TRUE,0);
END;
'W' : IF (NOT (FIOwnerCredited IN FileInfo.FIFlags)) THEN
Print('%LF^7Owner did not receive upload credit for this file!^1')
ELSE IF PYNQ('%LFWithdraw credit? ',0,FALSE) THEN
CreditFileOwner(User,FileInfo,FALSE,FileInfo.FilePoints);
'?' : BEGIN
NL;
Print('^31-7^1:Modify item');
LCmds(18,3,'Move file','Delete file');
LCmds(18,3,'Extended edit','Hatched toggle');
LCmds(18,3,'Previous file','Next file');
LCmds(18,3,'Resume toggle','Toggle availability');
LCmds(18,3,'Validation toggle','Withdraw credit');
LCmds(18,3,'Internal listing','Get Description');
LCmds(18,3,'Uploader','Quit');
DontShowList := TRUE;
END;
^M : Cmd := 'N';
ELSE
Next := TRUE;
END;
IF (NOT (Cmd IN ['P','N','Q'])) THEN
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Write(FileInfoFile,FileInfo);
END;
UNTIL (Cmd IN ['P','N','Q']) OR (Abort) OR (Next) OR (HangUp);
END;
PROCEDURE EditFiles;
VAR
FileName,
SaveLastDirFileName: Str12;
Cmd: Char;
DirFileRecNum,
SaveLastDirFileRecNum: Integer;
FO: Boolean;
BEGIN
NL;
Print('File editor:');
{ Print(FString.lGFNLine1); }
lRGLngStr(28,FALSE);
{ Prt(FString.GFNLine2); }
lRGLngStr(29,FALSE);
GetFileName(FileName);
IF (FileName = '') OR (Pos('.',FileName) = 0) THEN
BEGIN
NL;
Print('Aborted.');
END
ELSE
BEGIN
SaveLastDirFileRecNum := LastDIRRecNum;
SaveLastDirFileName := LastDIRFileName;
FO := (FileRec(FileInfoFile).Mode <> FMClosed);
IF (FO) THEN
BEGIN
Close(FileInfoFile);
Close(ExtInfoFile);
END;
RecNo(FileInfo,FileName,DirFileRecNum);
IF (BadDownloadPath) THEN
Exit;
IF (DirFileRecNum = -1) THEN
BEGIN
NL;
Print('No matching files.');
END
ELSE
BEGIN
Abort := FALSE;
Next := FALSE;
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
EditFile(DirFileRecNum,Cmd,FALSE,FALSE);
IF (Cmd = 'Q') THEN
Abort := TRUE
ELSE
BEGIN
IF (Cmd = 'P') THEN
LRecNo(FileInfo,DirFileRecNum)
ELSE
NRecNo(FileInfo,DirFileRecNum);
END;
WKey;
END;
END;
Close(FileInfoFile);
Close(ExtInfoFile);
IF (FO) THEN
InitFileArea(FileArea);
LastDIRRecNum := SaveLastDirFileRecNum;
LastDIRFileName := SaveLastDirFileName;
LastCommandOvr := TRUE;
END;
LastError := IOResult;
END;
PROCEDURE ValidateFiles;
VAR
Cmd: Char;
FArea,
SaveFileArea: Integer;
SaveConfSystem: Boolean;
PROCEDURE ValFiles(FArea: Integer; Cmd1: Char; NoPrompt,IsPoints: Boolean);
VAR
DirFileRecNum: Integer;
Found,
FirstOne: Boolean;
BEGIN
IF (FileArea <> FArea) THEN
ChangeFileArea(FArea);
IF (FileArea = FArea) THEN
BEGIN
RecNo(FileInfo,'*.*',DirFileRecNum);
IF (BadDownloadPath) THEN
Exit;
LIL := 0;
CLS;
Cmd1 := #0;
Found := FALSE;
FirstOne := TRUE;
Prompt('^1Scanning ^5'+MemFileArea.AreaName+' #'+IntToStr(CompFileArea(FileArea,0))+'^1 ...');
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
IF (FINotVal IN FileInfo.FIFlagS) AND (NOT (FIResumeLater IN FileInfo.FIFlagS)) THEN
BEGIN
IF (FirstOne) THEN
BEGIN
NL;
FirstOne := FALSE;
END;
EditFile(DirFileRecNum,Cmd1,NoPrompt,IsPoints);
Found := TRUE;
END;
IF (Cmd1 = 'P') THEN
BEGIN
REPEAT
LRecNo(FileInfo,DirFileRecNum);
UNTIL (DirFileRecNum = -1) OR ((FINotVal IN FileInfo.FIFlags) AND NOT (FIResumeLater IN FileInfo.FIFlags));
END
ELSE
NRecNo(FileInfo,DirFileRecNum);
WKey;
END;
IF (NOT Found) THEN
BEGIN
LIL := 0;
BackErase(15 + LennMCI(MemFileArea.AreaName) + Length(IntToStr(CompFileArea(FileArea,0))));
END;
Close(FileInfoFile);
Close(ExtInfoFile);
END;
LastError := IOResult;
END;
BEGIN
NL;
Print('^4[^5M^4]anual, [^5A^4]utomatic, [^5P^4]oint entry, [^5Q^4]uit');
NL;
Prt('File validation: ');
OneK(Cmd,'QMAP',TRUE,TRUE);
IF (Cmd <> 'Q') THEN
BEGIN
SaveFileArea := FileArea;
SaveConfSystem := ConfSystem;
ConfSystem := FALSE;
IF (SaveConfSystem) THEN
NewCompTables;
TempPause := (Cmd <> 'A');
Abort := FALSE;
Next := FALSE;
NL;
IF (NOT InWFCMenu) AND (NOT PYNQ('Search all file areas? ',0,TRUE)) THEN
ValFiles(FileArea,Cmd,(Cmd = 'A'),(Cmd = 'P'))
ELSE
BEGIN
FArea := 1;
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Next) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
ValFiles(FArea,Cmd,(Cmd = 'A'),(Cmd = 'P'));
WKey;
IF (Next) THEN
BEGIN
Abort := FALSE;
Next := FALSE;
END;
Inc(FArea);
END;
END;
ConfSystem := SaveConfSystem;
IF (SaveConfSystem) THEN
NewCompTables;
FileArea := SaveFileArea;
LoadFileArea(FileArea);
END;
LastError := IOResult;
END;
END.

BIN
FILE10.TPU Normal file
View File

Binary file not shown.

1245
FILE11.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
FILE11.TPU Normal file
View File

Binary file not shown.

959
FILE12.PAS Normal file
View File

@ -0,0 +1,959 @@
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
UNIT File12;
INTERFACE
USES
Common;
FUNCTION CheckBatchUL(FileName: Str12): Boolean;
PROCEDURE EditBatchULQueue;
PROCEDURE ListBatchULFiles;
PROCEDURE RemoveBatchULFiles;
PROCEDURE ClearBatchULQueue;
PROCEDURE BatchUpload(BiCleanUp: Boolean; TransferTime: LongInt);
PROCEDURE BatchDLULInfo;
IMPLEMENTATION
USES
Dos,
Common5,
ExecBat,
File0,
File1,
File2,
File4,
TimeFunc;
FUNCTION CheckBatchUL(FileName: Str12): Boolean;
VAR
RecNum: LongInt;
FileFound: Boolean;
BEGIN
FileFound := FALSE;
IF (NumBatchULFiles > 0) THEN
BEGIN
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
Reset(BatchULFile);
RecNum := 1;
WHILE (RecNum <= FileSize(BatchULFile)) AND (NOT FileFound) DO
BEGIN
Seek(BatchULFile,(RecNum - 1));
Read(BatchULFile,BatchUL);
IF (BatchUL.BULUserNum = UserNum) AND (BatchUL.BULFileName = SQOutSp(FileName)) THEN
FileFound := TRUE;
Inc(RecNum);
END;
Close(BatchULFile);
LastError := IOResult;
END;
CheckBatchUL := FileFound;
END;
PROCEDURE EditBatchULQueue;
VAR
Cmd: Char;
BEGIN
IF (NumBatchULFiles = 0) THEN
BEGIN
NL;
Print('The batch upload queue is empty.');
Exit;
END;
REPEAT
NL;
Prt('Batch upoad queue [^5C^4]lear, [^5L^4]ist batch, [^5R^4]emove a file, [^5Q^4]uit: ');
OneK(Cmd,'QCLR',TRUE,TRUE);
CASE Cmd OF
'C' : ClearBatchULQueue;
'L' : ListBatchULFiles;
'R' : RemoveBatchULFiles;
END;
UNTIL (Cmd = 'Q') OR (HangUp);
END;
PROCEDURE ListBatchULFiles;
VAR
TempStr: STRING;
FileNumToList: Byte;
TempBULVTextSize: Integer;
RecNum: LongInt;
BEGIN
IF (NumBatchULFiles = 0) THEN
BEGIN
NL;
Print('The batch upload queue is empty.');
Exit;
END;
Abort := FALSE;
Next := FALSE;
NL;
PrintACR('^4###:Filename.Ext Area Description^1');
PrintACR('^4===:============:=====:==================================================^1');
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
Reset(BatchULFile);
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
Reset(BatchULF,1);
FileNumToList := 1;
RecNum := 1;
WHILE (RecNum <= FileSize(BatchULFile)) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(BatchULFile,(RecNum - 1));
Read(BatchULFile,BatchUL);
IF (BatchUL.BULUserNum = UserNum) THEN
BEGIN
PrintACR('^3'+PadRightInt(FileNumToList,3)+
'^4:^5'+Align(BatchUL.BULFileName)+
' '+AOnOff((BatchUL.BULSection = General.ToSysOpDir),'^7SysOp',PadRightInt(BatchUL.BULSection,5))+
' ^3'+BatchUL.BULDescription);
IF (BatchUL.BULVPointer <> -1) THEN
BEGIN
TempBULVTextSize := 0;
Seek(BatchULF,(BatchUL.BULVPointer - 1));
REPEAT
BlockRead(BatchULF,TempStr[0],1);
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
Inc(TempBULVTextSize,(Length(TempStr) + 1));
PrintACR('^3'+PadRightStr(TempStr,24)+'^1');
UNTIL (TempBULVTextSize >= BatchUL.BULVTextSize);
END;
Inc(FileNumToList);
END;
WKey;
Inc(RecNum);
END;
Close(BatchULFile);
Close(BatchULF);
LastError := IOResult;
PrintACR('^4===:============:=====:==================================================^1');
SysOpLog('Viewed the batch upload queue.');
END;
PROCEDURE RemoveBatchULFiles;
VAR
BatchULF1: FILE;
BatchUL1: BatchULRecordType;
TempStr: STRING;
InputStr: Str3;
Counter,
FileNumToRemove: Byte;
TotLoad: Integer;
TempVPointer,
RecNum,
RecNum1: LongInt;
BEGIN
IF (NumBatchULFiles = 0) THEN
BEGIN
NL;
Print('The batch upload queue is empty.');
Exit;
END;
InputStr := '?';
REPEAT
IF (InputStr = '?') THEN
ListBatchULFiles;
NL;
Prt('File to remove? (^51^4-^5'+IntToStr(NumBatchULFiles)+'^4) [^5?^4=^5List^4,^5<CR>^4=^5Quit^4]: ');
MPL(Length(IntToStr(NumBatchULFiles)));
ScanInput(InputStr,^M'?');
FileNumToRemove := StrToInt(InputStr);
IF (NOT (InputStr[1] IN ['?','-',^M])) THEN
IF (FileNumToRemove < 1) OR (FileNumToRemove > NumBatchULFiles) THEN
BEGIN
NL;
Print('^7The range must be from 1 to '+IntToStr(NumBatchULFiles)+'!^1');
InputStr := '?';
END
ELSE
BEGIN
Counter := 0;
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
Reset(BatchULFile);
RecNum := 1;
WHILE (RecNum <= FileSize(BatchULFile)) DO
BEGIN
Seek(BatchULFile,(RecNum - 1));
Read(BatchULFile,BatchUL);
IF (BatchUL.BULUserNum = UserNum) THEN
BEGIN
Inc(Counter);
IF (Counter = FileNumToRemove) THEN
BEGIN
BatchUL.BULVPointer := -1;
BatchUL.BULVTextSize := 0;
Seek(BatchULFile,(RecNum - 1));
Write(BatchULFile,BatchUL);
Dec(NumBatchULFiles);
NL;
Print('Removed from batch upload queue: "^5'+BatchUL.BULFileName+'^1".');
SysOpLog('Batch UL Remove: "^5'+BatchUL.BULFileName+'^1".');
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
Reset(BatchULF,1);
Assign(BatchULF1,General.DataPath+'BATCHUL.EX1');
ReWrite(BatchULF1,1);
FOR RecNum1 := 0 TO (FileSize(BatchULFile) - 1) DO
BEGIN
Seek(BatchULFile,RecNum1);
Read(BatchULFile,BatchUL1);
IF (BatchUL1.BULVPointer <> -1) THEN
BEGIN
TempVPointer := (FileSize(BatchULF1) + 1);
Seek(BatchULF1,FileSize(BatchULF1));
TotLoad := 0;
Seek(BatchULF,(BatchUL1.BULVPointer - 1));
REPEAT
BlockRead(BatchULF,TempStr[0],1);
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
Inc(TotLoad,(Length(TempStr) + 1));
BlockWrite(BatchULF1,TempStr,(Length(TempStr) + 1));
UNTIL (TotLoad >= BatchUL1.BULVTextSize);
BatchUL1.BULVPointer := TempVPointer;
Seek(BatchULFile,RecNum1);
Write(BatchULFile,BatchUL1);
END;
END;
Close(BatchULF);
Erase(BatchULF);
Close(BatchULF1);
ReName(BatchULF1,General.DataPath+'BATCHUL.EXT');
Dec(RecNum);
FOR RecNum1 := RecNum TO (FileSize(BatchULFile) - 2) DO
BEGIN
Seek(BatchULFile,(RecNum1 + 1));
Read(BatchULFile,BatchUL);
Seek(BatchULFile,RecNum1);
Write(BatchULFile,BatchUL);
END;
Seek(BatchULFile,(FileSize(BatchULFile) - 1));
Truncate(BatchULFile);
END;
END;
Inc(RecNum);
END;
Close(BatchULFile);
LastError := IOResult;
IF (NumBatchULFiles <> 0) THEN
BEGIN
NL;
Print('^1Batch upload queue: ^5'+IntToStr(NumBatchULFiles)+' '+Plural('file',NumBatchULFiles));
END
ELSE
BEGIN
NL;
Print('The batch upload queue is now empty.');
SysOpLog('Cleared the batch upload queue.');
END;
END;
UNTIL (InputStr <> '?') OR (HangUp);
END;
PROCEDURE ClearBatchULQueue;
VAR
BatchULF1: FILE;
BatchUL1: BatchULRecordType;
TempStr: STRING;
TotLoad: Integer;
TempVPointer,
RecNum,
RecNum1: LongInt;
BEGIN
IF (NumBatchULFiles = 0) THEN
BEGIN
NL;
Print('The batch upload queue is empty.');
Exit;
END;
NL;
IF PYNQ('Clear batch upload queue? ',0,FALSE) THEN
BEGIN
NL;
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
Reset(BatchULFile);
RecNum := 1;
WHILE (RecNum <= FileSize(BatchULFile)) DO
BEGIN
Seek(BatchULFile,(RecNum - 1));
Read(BatchULFile,BatchUL);
IF (BatchUL.BULUserNum = UserNum) THEN
BEGIN
BatchUL.BULVPointer := -1;
BatchUL.BULVTextSize := 0;
Seek(BatchULFile,(RecNum - 1));
Write(BatchULFile,BatchUL);
Dec(NumBatchULFiles);
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
Reset(BatchULF,1);
Assign(BatchULF1,General.DataPath+'BATCHUL.EX1');
ReWrite(BatchULF1,1);
FOR RecNum1 := 0 TO (FileSize(BatchULFile) - 1) DO
BEGIN
Seek(BatchULFile,RecNum1);
Read(BatchULFile,BatchUL1);
IF (BatchUL1.BULVPointer <> -1) THEN
BEGIN
TempVPointer := (FileSize(BatchULF1) + 1);
Seek(BatchULF1,FileSize(BatchULF1));
TotLoad := 0;
Seek(BatchULF,(BatchUL1.BULVPointer - 1));
REPEAT
BlockRead(BatchULF,TempStr[0],1);
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
Inc(TotLoad,(Length(TempStr) + 1));
BlockWrite(BatchULF1,TempStr,(Length(TempStr) + 1));
UNTIL (TotLoad >= BatchUL1.BULVTextSize);
BatchUL1.BULVPointer := TempVPointer;
Seek(BatchULFile,RecNum1);
Write(BatchULFile,BatchUL1);
END;
END;
Close(BatchULF);
Erase(BatchULF);
Close(BatchULF1);
ReName(BatchULF1,General.DataPath+'BATCHUL.EXT');
Print('Removed from batch upload queue: "^5'+BatchUL.BULFileName+'^1".');
SysOpLog('Batch UL Remove: "^5'+BatchUL.BULFileName+'^1".');
Dec(RecNum);
FOR RecNum1 := RecNum TO (FileSize(BatchULFile) - 2) DO
BEGIN
Seek(BatchULFile,(RecNum1 + 1));
Read(BatchULFile,BatchUL);
Seek(BatchULFile,RecNum1);
Write(BatchULFile,BatchUL);
END;
Seek(BatchULFile,(FileSize(BatchULFile) - 1));
Truncate(BatchULFile);
END;
Inc(RecNum);
END;
Close(BatchULFile);
LastError := IOResult;
NL;
Print('The batch upload queue is now empty.');
SysOpLog('Cleared the batch upload queue.');
END;
END;
PROCEDURE BatchUpload(BiCleanUp: Boolean; TransferTime: LongInt);
TYPE
TotalsRecordType = RECORD
FilesUL,
FilesULCredit: Byte;
BytesUL,
BytesULCredit,
PointsULCredit: LongInt;
END;
VAR
Totals: TotalsRecordType;
BatchUL1: BatchULRecordType;
BatchULF1: FILE;
(*
DirInfo: SearchRec;
*)
TempStr: STRING;
InputStr: AStr;
LineNum,
FileNumToList,
NumExtDesc: Byte;
TotLoad,
ReturnCode,
ProtocolNumber,
SaveFArea,
SaveFileArea,
NumFAreas,
FArea,
TempBULVTextSize: Integer;
TempVPointer,
RecNum,
RecNum1,
RefundTime,
TakeAwayRefundTime,
TotConversionTime: LongInt;
AutoLogOff,
AHangUp,
WentToSysOp,
SaveTempPause,
SaveConfSystem: Boolean;
PROCEDURE UpFile;
VAR
GotPts: Integer;
ConversionTime: LongInt;
ArcOk,
Convt: Boolean;
BEGIN
InitFileArea(FileArea);
ArcStuff(ArcOk,Convt,FileInfo.FileSize,ConversionTime,TRUE,TempDir+'UP\',FileInfo.FileName,FileInfo.Description);
Inc(TotConversionTime,ConversionTime);
UpdateFileInfo(FileInfo,FileInfo.FileName,GotPts);
IF (ArcOk) THEN
BEGIN
NL;
Star('Moving file to ^5'+MemFileArea.AreaName);
NL;
IF CopyMoveFile(FALSE,'',SQOutSp(TempDir+'UP\'+FileInfo.FileName),
SQOutSp(MemFileArea.ULPath+FileInfo.FileName),FALSE) THEN
BEGIN
IF (Totals.FilesULCredit < 255) THEN
Inc(Totals.FilesULCredit);
IF ((Totals.BytesULCredit + FileInfo.FileSize) < 2147483647) THEN
Inc(Totals.BytesULCredit,FileInfo.FileSize)
ELSE
Totals.BytesULCredit := 2147483647;
IF ((Totals.PointsULCredit + GotPts) < 2147483647) THEN
Inc(Totals.PointsULCredit,GotPts)
ELSE
Totals.PointsULCredit := 2147483647;
IF (AACS(General.ULValReq)) OR (General.ValidateAllFiles) THEN
Include(FileInfo.FIFlags,FIOwnerCredited);
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
Star(SQOutSp(FileInfo.FileName)+' successfully uploaded.');
SysOpLog('^3Batch uploaded: "^5'+SQOutSp(FileInfo.FileName)+'^3" to ^5'+MemFileArea.AreaName+'.');
END;
END
ELSE
BEGIN
Star('Upload not received.');
IF ((FileInfo.FileSize DIV 1024) >= General.MinResume) THEN
BEGIN
NL;
IF PYNQ('Save file for a later resume? ',0,TRUE) THEN
BEGIN
NL;
IF CopyMoveFile(FALSE,'^5Progress: ',TempDir+'UP\'+FileInfo.FileName,MemFileArea.ULPath+FileInfo.FileName,TRUE) THEN
BEGIN
Include(FileInfo.FIFlags,FIResumeLater);
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
END;
END;
END;
IF (NOT (FIResumeLater IN FileInfo.FIFlags)) THEN
Kill(TempDir+'UP\'+FileInfo.FileName);
SysOpLog('^3Errors batch uploading '+SQOutSp(FileInfo.FileName)+' - '+
AOnOff(FIResumeLater IN FileInfo.FIFlags,'file saved for resume','file deleted'));
END;
IF (NOT ArcOk) AND (NOT BiCleanUp) THEN
BEGIN
Inc(TakeAwayRefundTime,(FileInfo.FileSize DIV Rate));
Star('Time refund of '+FormattedTime(FileInfo.FileSize DIV Rate)+' will be taken away.');
END;
END;
BEGIN
IF (NOT CheckDriveSpace('Batch upload',MemFileArea.ULPath,General.MinSpaceForUpload)) THEN
Exit;
SaveFileArea := FileArea;
AutoLogOff := FALSE;
IF (BiCleanUp) THEN
RefundTime := 0
ELSE
BEGIN
NL;
Print('^5Batch upload (Statistics):^1');
NL;
Star('^1Total file(s) : ^5'+FormatNumber(NumBatchULFiles)+'^1');
IF (NumBatchULFiles = 0) THEN
BEGIN
PrintF('BATCHUL0');
IF (NoFile) THEN
BEGIN
NL;
Print('Warning! No upload batch files specified yet.');
Print('If you continue, and batch upload files, you will have to');
Print('enter file descriptions for each file after the batch upload');
Print('is complete.');
END;
END
ELSE
BEGIN
PrintF('BATCHUL');
IF (NoFile) THEN
BEGIN
NL;
Print('^1If you batch upload files IN ADDITION to the files already');
Print('specified in your upload batch queue, you must enter file');
Print('descriptions for them after the batch upload is complete.');
END;
END;
ProtocolNumber := DoProtocol(Protocol,TRUE,FALSE,TRUE,FALSE);
CASE ProtocolNumber OF
-1 : ;
-2 : Exit;
-3 : ;
-4 : ;
-5 : EditBatchULQueue;
ELSE
IF (InCom) THEN
BEGIN
PurgeDir(TempDir+'UP\',FALSE);
NL;
AutoLogOff := PYNQ('Auto-logoff after file transfer? ',0,FALSE);
NL;
Star('Ready to receive batch upload transfer.');
TimeLock := TRUE;
ExecProtocol('',
TempDir+'UP\',
FunctionalMCI(Protocol.EnvCmd,'','')
+#13#10+
General.ProtPath+FunctionalMCI(Protocol.ULCmd,'',''),
-1,
ReturnCode,
TransferTime);
TimeLock := FALSE;
NL;
Star('Batch upload transfer complete.');
RefundTime := (TransferTime * (General.ULRefund DIV 100));
Inc(FreeTime,RefundTime);
END;
END;
END;
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
Reset(BatchULFile);
FillChar(Totals,SizeOf(Totals),0);
FindFirst(TempDir+'UP\*.*',AnyFile - Directory - VolumeID - Dos.Hidden - SysFile ,DirInfo);
WHILE (DosError = 0) DO
BEGIN
Inc(Totals.FilesUL);
Inc(Totals.BytesUL,DirInfo.Size);
FindNext(DirInfo);
END;
IF (Totals.FilesUL = 0) THEN
BEGIN
NL;
Print('No uploads detected!^1');
Exit;
END;
AHangUp := FALSE;
IF (HangUp) THEN
BEGIN
IF (ComPortSpeed > 0) THEN
BEGIN
lStatus_Screen(100,'Hanging up and taking phone off hook...',FALSE,InputStr);
DoPhoneHangUp(FALSE);
DoPhoneOffHook(FALSE);
ComPortSpeed := 0;
END;
HangUp := FALSE;
AHangUp := TRUE;
END;
IF (NOT AHangUp) THEN
BEGIN
NL;
Print('^5Batch upload (Totals):^1');
NL;
Star('^1Total file(s) : ^5'+FormatNumber(Totals.FilesUL)+'^1');
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesUL,FALSE)+'^1');
Star('^1Upload time : ^5'+FormattedTime(TransferTime)+'^1');
Star('^1Transfer rate : ^5'+FormatNumber(GetCPS(Totals.BytesUL,TransferTime))+' cps^1');
Star('^1Time refund : ^5'+FormattedTime(RefundTime)+'^1');
IF (AutoLogOff) THEN
CountDown;
END;
TotConversionTime := 0;
TakeAwayRefundTime := 0;
RecNum := 1;
WHILE (RecNum <= FileSize(BatchULFile)) DO
BEGIN
Seek(BatchULFile,(RecNum - 1));
Read(BatchULFile,BatchUL);
IF (BatchUL.BULUserNum = UserNum) AND Exist(TempDir+'UP\'+BatchUL.BULFileName) THEN
BEGIN
FileInfo.FileName := BatchUL.BULFileName;
FileArea := BatchUL.BULSection;
NL;
Star('Found: "^5'+FileInfo.FileName+'^1"');
IF (General.FileDiz) AND (DizExists(TempDir+'UP\'+FileInfo.FileName)) THEN
GetDiz(FileInfo,ExtendedArray,NumExtDesc)
ELSE
BEGIN
FileInfo.Description := BatchUL.BULDescription;
FillChar(ExtendedArray,SizeOf(ExtendedArray),#0);
IF (BatchUL.BULVPointer <> 0) THEN
BEGIN
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
Reset(BatchULF,1);
LineNum := 1;
TempBULVTextSize := 0;
Seek(BatchULF,(BatchUL.BULVPointer - 1));
REPEAT
BlockRead(BatchULF,TempStr[0],1);
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
Inc(TempBULVTextSize,(Length(TempStr) + 1));
ExtendedArray[LineNum] := TempStr;
Inc(LineNum);
UNTIL (TempBULVTextSize >= BatchUL.BULVTextSize);
BatchUL.BULVPointer := -1;
BatchUL.BULVTextSize := 0;
Seek(BatchULFile,(RecNum - 1));
Write(BatchULFile,BatchUL);
END;
END;
UpFile;
Reset(BatchULF,1);
Assign(BatchULF1,General.DataPath+'BATCHUL.EX1');
ReWrite(BatchULF1,1);
FOR RecNum1 := 0 TO (FileSize(BatchULFile) - 1) DO
BEGIN
Seek(BatchULFile,RecNum1);
Read(BatchULFile,BatchUL1);
IF (BatchUL1.BULVPointer <> -1) THEN
BEGIN
TempVPointer := (FileSize(BatchULF1) + 1);
Seek(BatchULF1,FileSize(BatchULF1));
TotLoad := 0;
Seek(BatchULF,(BatchUL1.BULVPointer - 1));
REPEAT
BlockRead(BatchULF,TempStr[0],1);
BlockRead(BatchULF,TempStr[1],Ord(TempStr[0]));
Inc(TotLoad,(Length(TempStr) + 1));
BlockWrite(BatchULF1,TempStr,(Length(TempStr) + 1));
UNTIL (TotLoad >= BatchUL1.BULVTextSize);
BatchUL1.BULVPointer := TempVPointer;
Seek(BatchULFile,RecNum1);
Write(BatchULFile,BatchUL1);
END;
END;
Close(BatchULF);
Erase(BatchULF);
Close(BatchULF1);
ReName(BatchULF1,General.DataPath+'BATCHUL.EXT');
Dec(RecNum);
IF (RecNum >= 0) AND (RecNum <= (FileSize(BatchULFile) - 2)) THEN
FOR RecNum1 := RecNum TO (FileSize(BatchULFile) - 2) DO
BEGIN
Seek(BatchULFile,(RecNum1 + 1));
Read(BatchULFile,BatchUL);
Seek(BatchULFile,RecNum1);
Write(BatchULFile,BatchUL);
END;
Seek(BatchULFile,(FileSize(BatchULFile) - 1));
Truncate(BatchULFile);
Dec(NumBatchULFiles);
END;
Inc(RecNum);
END;
FindFirst(TempDir+'UP\*.*',AnyFile - Directory - VolumeID - Dos.Hidden - SysFile,DirInfo);
WHILE (DosError = 0) DO
BEGIN
FileInfo.FileName := DirInfo.Name;
NL;
Star('Found: "^5'+FileInfo.FileName+'^1"');
IF (General.SearchDup) THEN
IF (NOT FileSysOp) OR (PYNQ('Search for duplicates? ',0,FALSE)) THEN
IF (SearchForDups(FileInfo.FileName)) THEN
Exit;
IF (General.SearchDup) AND (SearchForDups(FileInfo.FileName)) THEN
BEGIN
Star('Deleting duplicate file: "^5'+FileInfo.FileName+'^1"');
Kill(TempDir+'UP\'+FileInfo.FileName);
END
ELSE
BEGIN
WentToSysOp := FALSE;
IF (General.FileDiz) AND (DizExists(TempDir+'UP\'+FileInfo.FileName)) THEN
GetDiz(FileInfo,ExtendedArray,NumExtDesc)
ELSE
BEGIN
GetFileDescription(FileInfo,ExtendedArray,NumExtDesc,WentToSysOp);
IF (AHangUp) THEN
BEGIN
FileInfo.Description := 'Not in upload batch queue - hungup after transfer';
FillChar(ExtendedArray,SizeOf(ExtendedArray),#0);
END;
END;
IF (WentToSysOp) THEN
FileArea := General.ToSysOpDir
ELSE
BEGIN
IF (AHangUp) THEN
FArea := SaveFileArea
ELSE
BEGIN
SaveConfSystem := ConfSystem;
ConfSystem := FALSE;
IF (SaveConfSystem) THEN
NewCompTables;
SaveTempPause := TempPause;
TempPause := FALSE;
FArea := 1;
NumFAreas := 0;
LightBarCmd := 1;
LightBarFirstCmd := TRUE;
InputStr := '?';
REPEAT
SaveFArea := FArea;
IF (InputStr = '?') THEN
LFileAreaList(FArea,NumFAreas,5,FALSE);
FileAreaScanInput('%LFMove to which file area? (^5'+IntToStr(LowFileArea)+'^4-^5'+IntToStr(HighFileArea)+'^4)'+
' [^5?^4=^5First^4,^5<CR>^4=^5Next^4]: ',Length(IntToStr(HighFileArea)),InputStr,'[]?',
LowFileArea,HighFileArea);
IF (InputStr = '[') THEN
BEGIN
FArea := (SaveFArea - ((PageLength - 5) * 2));
IF (FArea < 1) THEN
FArea := 1;
InputStr := '?';
END
ELSE IF (InputStr = ']') THEN
BEGIN
IF (FArea > NumFileAreas) THEN
FArea := SaveFArea;
InputStr := '?';
END
ELSE IF (InputStr = '?') THEN
BEGIN
NL;
Print('^1(^3###^1)Manual entry selection ^1(^3<CR>^1)Select current entry');
Print('^1(^3<Home>^1)First entry on page ^1(^3<End>^1)Last entry on page');
Print('^1(^3Left Arrow^1)Previous entry ^1(^3Right Arrow^1)Next entry');
Print('^1(^3Up Arrow^1)Move up ^1(^3Down Arrow^1)Move down');
Print('^1(^3[^1)Previous page ^1(^3]^1)Next page');
PauseScr(FALSE);
FArea := SaveFArea;
END
ELSE IF (StrToInt(InputStr) < LowFileArea) OR (StrToInt(InputStr) > HighFileArea) THEN
BEGIN
NL;
Print('^7The range must be from '+IntToStr(LowFileArea)+' to '+IntToStr(HighFileArea)+'!^1');
InputStr := '?';
FArea := 1
END
ELSE
BEGIN
FArea := CompFileArea(StrToInt(InPutStr),1);
IF (FArea <> FileArea) THEN
ChangeFileArea(FArea);
IF (FArea <> FileArea) THEN
BEGIN
NL;
Print('^7You do not have access to this file area.^1');
InputStr := '?';
FArea := 1
END
ELSE
BEGIN
InitFileArea(FArea);
IF (NOT AACS(MemFileArea.ULACS)) THEN
BEGIN
NL;
Print('^7You do not have the required upload access for this file area.^1');
InputStr := '?';
FArea := 1
END
ELSE IF ((NOT FileSysOp) AND (Exist(MemFileArea.ULPath+FileInfo.FileName)) OR
(Exist(MemFileArea.DLPath+FileInfo.FileName))) THEN
BEGIN
NL;
Print('^7The file already exists in the upload or download path.^1');
InputStr := '?';
FArea := 1
END
ELSE IF (FileSize(FileInfoFile) >= MemFileArea.MaxFiles) THEN
BEGIN
NL;
Print('^7This file area is full.^1');
InputStr := '?';
FArea := 1
END;
Close(FileInfoFile);
Close(ExtInfoFile);
END;
END;
UNTIL (NOT (InputStr[1] IN [^M,'?'])) OR (HangUp);
TempPause := SaveTempPause;
ConfSystem := SaveConfSystem;
IF (SaveConfSystem) THEN
NewCompTables;
END;
FileArea := FArea;
END;
UpFile;
END;
FindNext(DirInfo);
END;
lil := 0;
Dec(RefundTime,TakeAwayRefundTime);
Dec(FreeTime,TakeAwayRefundTime);
SysOpLog('^3 - Totals:'+
' '+FormatNumber(Totals.FilesUL)+' '+Plural('file',Totals.FilesUL)+
', '+ConvertBytes(Totals.BytesUL,FALSE)+
', '+FormattedTime(TransferTime)+' tt'+
', '+FormatNumber(GetCPS(Totals.BytesUL,Transfertime))+' cps'+
', '+FormattedTime(RefundTime)+' rt');
IF ((UploadsToday + Totals.FilesULCredit) < 2147483647) THEN
Inc(UploadsToday,Totals.FilesULCredit)
ELSE
UploadsToday := 2147483647;
IF ((UploadKBytesToday + (Totals.BytesULCredit DIV 1024)) < 2147483647) THEN
Inc(UploadKBytesToday,(Totals.BytesULCredit DIV 1024))
ELSE
UploadKBytesToday := 2147483647;
LIL := 0;
NL;
Print('^5Batch upload (Credits):^1');
NL;
Star('^1Total file(s) : ^5'+FormatNumber(Totals.FilesULCredit));
Star('^1Total size : ^5'+ConvertBytes(Totals.BytesULCredit,FALSE));
Star('^1Total file points : ^5'+FormatNumber(Totals.PointsULCredit));
Star('^1Time refund : ^5'+FormattedTime(RefundTime)+'^1');
IF (AACS(General.ULValReq)) OR (General.ValidateAllFiles) THEN
BEGIN
IF ((ThisUser.Uploads + Totals.FilesULCredit) < 2147483647) THEN
Inc(ThisUser.Uploads,Totals.FilesULCredit)
ELSE
ThisUser.Uploads := 2147483647;
IF (ThisUser.UK + (Totals.BytesULCredit DIV 1024) < 2147483647) THEN
Inc(ThisUser.UK,(Totals.BytesULCredit DIV 1024))
ELSE
ThisUser.UK := 2147483647;
IF ((ThisUser.FilePoints + Totals.PointsULCredit) < 2147483647) THEN
Inc(ThisUser.FilePoints,Totals.PointsULCredit)
ELSE
ThisUser.FilePoints := 2147483647;
END
ELSE
BEGIN
NL;
Print('^5You will receive upload credit after the SysOp validates the '+Plural('file',Totals.FilesULCredit)+'!');
Totals.FilesULCredit := 0;
Totals.BytesULCredit := 0;
Totals.PointsULCredit := 0;
END;
IF (ChopTime <> 0) THEN
BEGIN
ChopTime := ((ChopTime + RefundTime) - TakeAwayRefundTime);
FreeTime := ((FreeTime - RefundTime) + TakeAwayRefundTime);
NL;
Star('You will receive your time refund after the event.');
RefundTime := 0;
END;
SysOpLog('^3 - Credits:'+
' '+FormatNumber(Totals.FilesULCredit)+' '+Plural('file',Totals.FilesULCredit)+
', '+ConvertBytes(Totals.BytesULCredit,FALSE)+
', '+FormatNumber(Totals.PointsULCredit)+' fp'+
', '+FormattedTime(RefundTime)+' rt');
IF (NumBatchULFiles > 0) THEN
BEGIN
LIL := 0;
NL;
Print('^5Batch upload (Not Transferred):^1');
NL;
Star('^1Total file(s) : ^5'+FormatNumber(NumBatchULFiles));
SysOpLog('^3 - Not uploaded:'+
' '+FormatNumber(NumBatchULFiles)+' '+Plural('file',NumBatchULFiles));
END;
LIL := 0;
NL;
Star('Thanks for the '+Plural('file',Totals.FilesULCredit)+', '+Caps(ThisUser.Name)+'!');
PauseScr(False);
SaveURec(ThisUser,UserNum);
Close(BatchULFile);
IF (AHangUp) THEN
BEGIN
lStatus_Screen(100,'Hanging up phone again...',FALSE,InputStr);
DoPhoneHangUp(FALSE);
HangUp := TRUE;
END;
FileArea := SaveFileArea;
InitFileArea(FileArea);
END;
PROCEDURE BatchDLULInfo;
BEGIN
IF (NumBatchDLFiles <> 0) THEN
BEGIN
NL;
Print('^9>> ^3You have ^5'+FormatNumber(NumBatchDLFiles)+'^3 '+Plural('file',NumBatchDLFiles)+
' left in your batch download queue.^1');
END;
IF (NumBatchULFiles <> 0) THEN
BEGIN
NL;
Print('^9>> ^3You have ^5'+FormatNumber(NumBatchULFiles)+'^3 '+Plural('file',NumBatchULFiles)+
' left in your batch upload queue.^1');
END;
END;
END.

BIN
FILE12.TPU Normal file
View File

Binary file not shown.

124
FILE13.PAS Normal file
View File

@ -0,0 +1,124 @@
{$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.

Some files were not shown because too many files have changed in this diff Show More