02-04
This commit is contained in:
commit
6923bf0c27
22
.gitattributes
vendored
Normal file
22
.gitattributes
vendored
Normal 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
163
.gitignore
vendored
Normal 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
14
ACFLAGS.ASC
Normal 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
719
ARCHIVE1.PAS
Normal 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
BIN
ARCHIVE1.TPU
Normal file
Binary file not shown.
915
ARCHIVE2.PAS
Normal file
915
ARCHIVE2.PAS
Normal 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
BIN
ARCHIVE2.TPU
Normal file
Binary file not shown.
240
ARCHIVE3.PAS
Normal file
240
ARCHIVE3.PAS
Normal 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
BIN
ARCHIVE3.TPU
Normal file
Binary file not shown.
848
ARCVIEW.PAS
Normal file
848
ARCVIEW.PAS
Normal 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
BIN
ARCVIEW.TPU
Normal file
Binary file not shown.
159
AUTOMSG.PAS
Normal file
159
AUTOMSG.PAS
Normal 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
BIN
AUTOMSG.TPU
Normal file
Binary file not shown.
1
BATCH6.LST
Normal file
1
BATCH6.LST
Normal file
|
@ -0,0 +1 @@
|
|||
C:\RG\TEMP6.LOG
|
557
BBSLIST.PAS
Normal file
557
BBSLIST.PAS
Normal 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
BIN
BBSLIST.TPU
Normal file
Binary file not shown.
588
BULLETIN.PAS
Normal file
588
BULLETIN.PAS
Normal 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
BIN
BULLETIN.TPU
Normal file
Binary file not shown.
32
CHAIN.TXT
Normal file
32
CHAIN.TXT
Normal 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
33
CHAINT~1.TXT
Normal 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
212
CHANGE.TXT
Normal 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
27
CHANGE1.TXT
Normal 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
53
CHANGE10.TXT
Normal 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
28
CHANGE11.TXT
Normal 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
28
CHANGE12.TXT
Normal 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
5
CHANGE13.TXT
Normal 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
29
CHANGE14.TXT
Normal 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
8
CHANGE2.TXT
Normal 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
7
CHANGE3.TXT
Normal 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
70
CHANGE4.TXT
Normal 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
42
CHANGE5.TXT
Normal 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
70
CHANGE6.TXT
Normal 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
75
CHANGE7.TXT
Normal 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
25
CHANGE8.TXT
Normal 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
33
CHANGE9.TXT
Normal 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
38
CHANGES.TXT
Normal 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
44
CHANGES1.TXT
Normal 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
57
CHANGES2.TXT
Normal 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
18
CHANGES3.TXT
Normal 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
133
CHANGES4.TXT
Normal 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
42
CHANGES7.TXT
Normal 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
35
CHANGES8.TXT
Normal 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
29
CHANGES9.TXT
Normal 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
27
CHNAGE2.TXT
Normal 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
4870
COMMON.PAS
Normal file
File diff suppressed because it is too large
Load diff
BIN
COMMON.TPU
Normal file
BIN
COMMON.TPU
Normal file
Binary file not shown.
410
COMMON1.PAS
Normal file
410
COMMON1.PAS
Normal 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
BIN
COMMON1.TPU
Normal file
Binary file not shown.
1255
COMMON2.PAS
Normal file
1255
COMMON2.PAS
Normal file
File diff suppressed because it is too large
Load diff
BIN
COMMON2.TPU
Normal file
BIN
COMMON2.TPU
Normal file
Binary file not shown.
523
COMMON3.PAS
Normal file
523
COMMON3.PAS
Normal 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
BIN
COMMON3.TPU
Normal file
Binary file not shown.
870
COMMON4.PAS
Normal file
870
COMMON4.PAS
Normal 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
BIN
COMMON4.TPU
Normal file
Binary file not shown.
529
COMMON5.PAS
Normal file
529
COMMON5.PAS
Normal 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
BIN
COMMON5.TPU
Normal file
Binary file not shown.
193
CRC32.ASM
Normal file
193
CRC32.ASM
Normal 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
132
CRC32A.PAS
Normal 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.
|
52
DOOR.SYS
Normal file
52
DOOR.SYS
Normal 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
11
DOOR32.SYS
Normal 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
121
DOOR32~1.TXT
Normal 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
768
DOORS.PAS
Normal 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
DOORSY~1.DOC
Normal file
BIN
DOORSY~1.DOC
Normal file
Binary file not shown.
13
DORINFO1.DEF
Normal file
13
DORINFO1.DEF
Normal 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
29
DORINF~1.TXT
Normal 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
1333
DRAG_010.PAS
Normal file
File diff suppressed because it is too large
Load diff
55
EC.PAS
Normal file
55
EC.PAS
Normal 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
2
EC.TXT
Normal file
|
@ -0,0 +1,2 @@
|
|||
|03Copyright (C) 2003-2005 |03.
|
||||
›ËþA° ™tÛC·×ÿBk‹½íP}¯ßDdàCq
|
33
ERROR.LOG
Normal file
33
ERROR.LOG
Normal 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
248
EVENT.PAS
Normal 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.
|
242
EVENTS.PAS
Normal file
242
EVENTS.PAS
Normal 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
BIN
EVENTS.TPU
Normal file
Binary file not shown.
219
EXECBAT.PAS
Normal file
219
EXECBAT.PAS
Normal 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
BIN
EXECBAT.TPU
Normal file
Binary file not shown.
BIN
FAELNG.EXE
Normal file
BIN
FAELNG.EXE
Normal file
Binary file not shown.
267
FAELNG.PAS
Normal file
267
FAELNG.PAS
Normal 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
312
FAELNG.TXT
Normal 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
|
||||
$
|
1
FAETX.DAT
Normal file
1
FAETX.DAT
Normal 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
596
FILE0.PAS
Normal 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.
|
835
FILE10.LEE
Normal file
835
FILE10.LEE
Normal 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
906
FILE10.PAS
Normal 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
BIN
FILE10.TPU
Normal file
Binary file not shown.
1245
FILE11.PAS
Normal file
1245
FILE11.PAS
Normal file
File diff suppressed because it is too large
Load diff
BIN
FILE11.TPU
Normal file
BIN
FILE11.TPU
Normal file
Binary file not shown.
959
FILE12.PAS
Normal file
959
FILE12.PAS
Normal 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
BIN
FILE12.TPU
Normal file
Binary file not shown.
124
FILE13.PAS
Normal file
124
FILE13.PAS
Normal 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
Loading…
Reference in a new issue