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

1589 lines
41 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{$IFDEF WIN32}
{$I DEFINES.INC}
{$ENDIF}
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
UNIT File1;
INTERFACE
USES
Common;
FUNCTION ChargeFilePoints(FArea: Integer): Boolean;
FUNCTION ChargeFileRatio(FArea: Integer): Boolean;
PROCEDURE CreditUploader(FileInfo: FileInfoRecordType);
FUNCTION SearchForDups(CONST CompleteFN: Str12): Boolean;
FUNCTION DizExists(CONST FN: AStr): Boolean;
PROCEDURE GetDiz(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte);
PROCEDURE DLX(FileInfo: FileInfoRecordType;
DirFileRecNum: Integer;
VAR TransferFlags: TransferFlagSet);
FUNCTION DLInTime: BOOLEAN;
FUNCTION BatchDLQueuedFiles(TransferFlags: TransferFlagSet): BOOLEAN;
PROCEDURE DL(CONST FileName: Str12; TransferFlags: TransferFlagSet);
PROCEDURE GetFileDescription(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray;
VAR NumExtDesc: Byte; VAR ToSysOp: Boolean);
PROCEDURE WriteFV(FileInfo: FileInfoRecordType;DirFileRecNum: Integer; ExtendedArray: ExtendedDescriptionArray);
PROCEDURE UpdateFileInfo(VAR FileInfo: FileInfoRecordType; CONST FN: Str12; VAR GotPts: Integer);
PROCEDURE ArcStuff(VAR Ok,Convt: Boolean; VAR FSize,ConvTime: LongInt;
ITest: Boolean; CONST FilePath: AStr; VAR FileName: Str12; VAR Descr: AStr);
PROCEDURE DownloadFile(FileName: Str12; TransferFlags: TransferFlagSet);
PROCEDURE UploadFile;
PROCEDURE LFileAreaList(VAR FArea,NumFAreas: Integer; AdjPageLen: Byte; ShowScan: Boolean);
PROCEDURE UnlistedDownload(FileName: AStr);
PROCEDURE Do_Unlisted_Download;
IMPLEMENTATION
USES
Dos,
Crt,
Archive1,
Email,
Events,
File0,
File2,
File6,
File8,
File11,
File12,
File14,
MultNode,
ShortMsg,
TimeFunc;
FUNCTION ChargeFilePoints(FArea: Integer): Boolean;
VAR
ChargePoints: Boolean;
BEGIN
ChargePoints := FALSE;
IF (FArea <> -1) AND
(NOT (FANoRatio IN MemFileArea.FAFlags)) AND
(NOT AACS(General.NoFileCredits)) AND
(NOT (FNoCredits IN ThisUser.Flags)) AND
(General.FileCreditRatio) THEN
ChargePoints := TRUE;
ChargeFilePoints := ChargePoints;
END;
FUNCTION ChargeFileRatio(FArea: Integer): Boolean;
VAR
ChargeRatio: Boolean;
BEGIN
ChargeRatio := FALSE;
IF (FArea <> -1) AND
(NOT (FANoRatio IN MemFileArea.FAFlags)) AND
(NOT AACS(General.NoDLRatio)) AND
(NOT (FNoDLRatio IN ThisUser.Flags)) AND
(General.ULDLRatio) THEN
ChargeRatio := TRUE;
ChargeFileRatio := ChargeRatio;
END;
PROCEDURE CreditUploader(FileInfo: FileInfoRecordType);
VAR
User: UserRecordType;
FilePointCredit: LongInt;
BEGIN
IF (General.RewardSystem) AND (FileInfo.OwnerNum >= 1) AND (FileInfo.OwnerNum <= (MaxUsers - 1)) AND
(FileInfo.OwnerNum <> UserNum) THEN
BEGIN
LoadURec(User,FileInfo.OwnerNum);
FilePointCredit := Trunc(FileInfo.FilePoints * (General.RewardRatio DIV 100));
IF (CRC32(FileInfo.OwnerName) = CRC32(User.Name)) AND (FilePointCredit > 0) THEN
BEGIN
IF ((User.FilePoints + FilePointCredit) < 2147483647) THEN
Inc(User.FilePoints,FilePointCredit)
ELSE
User.FilePoints := 2147483647;
SaveURec(User,FileInfo.OwnerNum);
SysOpLog('^3 - Credits: '+FormatNumber(FilePointCredit)+' fp to "^5'+Caps(User.Name)+'^3".');
SendShortMessage(FileInfo.OwnerNum,'You received '+FormatNumber(FilePointCredit)+
' '+Plural('file point',FilePointCredit)+' for the download of '
+SQOutSp(FileInfo.FileName));
END;
END;
END;
FUNCTION OKDL(CONST FileInfo: FileInfoRecordType): Boolean;
VAR
MHeader: MHeaderRec;
Counter: Byte;
BEGIN
OKDL := TRUE;
IF (FIIsRequest IN FileInfo.FIFlags) THEN
BEGIN
PrintF('REQFILE');
IF (NoFile) THEN
BEGIN
NL;
Print('^5You must request this from '+General.SysOpName+'!^1');
END;
NL;
IF (PYNQ('Request this file now? ',0,FALSE)) THEN
BEGIN
InResponseTo := #1'Request "'+SQOutSp(FileInfo.FileName)+'" from area #'+IntToStr(CompFileArea(FileArea,0));
MHeader.Status := [];
SEMail(1,MHeader);
END;
OKDL := FALSE;
END
ELSE IF (FIResumeLater IN FileInfo.FIFlags) AND (NOT FileSysOp) THEN
BEGIN
NL;
Print('^7You are not the uploader of this file!^1');
OKDL := FALSE;
END
ELSE IF (FINotVal IN FileInfo.FIFlags) AND (NOT AACS(General.DLUNVal)) THEN
BEGIN
NL;
Print('^7Your access level does not permit downloading unvalidated files!^1');
OKDL := FALSE;
END
ELSE IF (FileInfo.FilePoints > 0) AND (ThisUser.FilePoints < FileInfo.FilePoints) AND
ChargeFilePoints(FileArea) THEN
BEGIN
NL;
Print('^7'+lRGLngStr(26,TRUE)+'^1'{FString.NoFileCredits});
OKDL := FALSE;
END
ELSE IF ((FileInfo.FileSize DIV Rate) > NSL) THEN
BEGIN
NL;
Print('^7Insufficient time left online to download this file!^1');
Print(Ctim(NSL));
OKDL := FALSE;
END;
END;
PROCEDURE DLX(FileInfo: FileInfoRecordType;
DirFileRecNum: Integer;
VAR TransferFlags: TransferFlagSet);
VAR
DownloadPath: Str52;
CopyPath: Str40;
Cmd: Char;
Changed: Boolean;
BEGIN
Abort := FALSE;
Next := FALSE;
IF (IsFileAttach IN TransferFlags) THEN
BEGIN
NL;
Print('^4The following has been attached:^1');
END;
NL;
DisplayFileInfo(FileInfo,FALSE);
IF (IsFileAttach IN TransferFlags) THEN
IF (InCom) THEN
BEGIN
NL;
IF (NOT PYNQ('Download file now? ',0,FALSE)) THEN
Exit;
END
ELSE IF (NOT CoSysOp) THEN
Exit
ELSE
BEGIN
NL;
IF (NOT PYNQ('Move file now? ',0,FALSE)) THEN
Exit;
END;
IF (NOT OKDL(FileInfo)) THEN
Include(TransferFlags,IsPaused)
ELSE
BEGIN
DownloadPath := '';
IF (Exist(MemFileArea.DLPath+FileInfo.FileName)) THEN
BEGIN
DownloadPath := MemFileArea.DLPath;
IF (FACDRom IN MemFileArea.FAFlags) THEN
InClude(TransferFLags,IsCDRom);
END
ELSE IF (Exist(MemFileArea.ULPath+FileInfo.FileName)) THEN
DownloadPath := MemFileArea.ULPath;
IF (DownloadPath = '') THEN
BEGIN
NL;
Print('^7File does not actually exist.^1');
SysOpLog('File missing: '+SQOutSp(DownloadPath+FileInfo.FileName));
Exit;
END;
IF (InCom) THEN
Send(FileInfo,DirFileRecNum,DownloadPath,TransferFlags)
ELSE IF (NOT CoSysOp) THEN
Include(TransferFlags,IsPaused)
ELSE
BEGIN
CopyPath := '';
InputPath('%LF^4Enter the destination path (^5End with a ^4"^5\^4"):%LF^4:',CopyPath,FALSE,TRUE,Changed);
IF (CopyPath = '') THEN
Include(TransferFlags,IsPaused)
ELSE
BEGIN
NL;
IF (NOT CopyMoveFile(NOT (IsFileAttach IN TransferFlags),
+AOnOff(IsFileAttach IN TransferFlags,'^1Moving ... ','^1Copying ... '),
DownloadPath+SQOutSp(FileInfo.FileName),
CopyPath+SQOutSp(FileInfo.FileName),TRUE)) THEN
Include(TransferFlags,IsPaused);
END;
END;
END;
IF (IsPaused IN TransferFlags) AND (NOT (IsFileAttach IN TransferFlags)) THEN
BEGIN
NL;
Prompt('^1Press [^5Enter^1] to Continue or [^5Q^1]uit: ');
Onek(Cmd,'Q'^M,TRUE,TRUE);
IF (Cmd = 'Q') THEN
BEGIN
Include(TransferFlags,IsKeyboardAbort);
Abort := TRUE;
END;
END;
IF (IsPaused IN TransferFLags) THEN
Exclude(TransferFlags,IsPaused);
END;
PROCEDURE DL(CONST FileName: Str12; TransferFlags: TransferFlagSet);
VAR
SaveFileArea,
FArea: Integer;
GotAny,
Junk: Boolean;
FUNCTION ScanBase(FileName1: Str12; VAR GotAny1: Boolean): Boolean;
VAR
DirFileRecNum: Integer;
BEGIN
ScanBase := FALSE;
RecNo(FileInfo,FileName1,DirFileRecNum);
IF (BadDownloadPath) THEN
Exit;
WHILE (DirFileRecNum <> -1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
BackErase(13);
IF (NOT (FINotVal IN FileInfo.FIFlags)) OR (AACS(General.DLUnVal)) THEN
IF AACS(MemFileArea.DLACS) THEN
BEGIN
DLX(FileInfo,DirFileRecNum,TransferFlags);
ScanBase := TRUE;
IF (IsKeyboardAbort IN TransferFlags) THEN
Abort := TRUE;
IF (NOT (IsWildCard(FileName1))) THEN
Abort := TRUE;
END
ELSE
BEGIN
NL;
Print('Your access level does not permit downloading this file.');
END;
GotAny1 := TRUE;
WKey;
NRecNo(FileInfo,DirFileRecNum);
END;
Close(FileInfoFile);
Close(ExtInfoFile);
LastError := IOResult;
END;
BEGIN
GotAny := FALSE;
Abort := FALSE;
Next := FALSE;
Include(TransferFlags,IsCheckRatio);
NL;
Prompt('Searching ...');
IF (NOT ScanBase(FileName,GotAny)) THEN
BEGIN
SaveFileArea := FileArea;
FArea := 1;
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
IF (FArea <> SaveFileArea) THEN
BEGIN
LoadFileArea(FArea);
IF (MemFileArea.Password = '') THEN (* Doesn't scan areas with a Password ??? *)
ChangeFileArea(FArea);
IF (FileArea = FArea) THEN
Junk := ScanBase(FileName,GotAny);
END;
WKey;
Inc(FArea);
END;
FileArea := SaveFileArea;
LoadFileArea(FileArea);
END;
IF (NOT GotAny) THEN
BEGIN
BackErase(13);
NL;
Print('File not found.');
END;
END;
FUNCTION DLInTime: BOOLEAN;
VAR
DLAllowed: BOOLEAN;
BEGIN
DLAllowed := TRUE;
IF (NOT InTime(Timer,General.DLLowTime,General.DLHiTime)) THEN
DLAllowed := FALSE;
IF (ComPortSpeed < General.MinimumDLBaud) THEN
IF (NOT InTime(Timer,General.MinBaudDLLowTime,General.MinBaudDLHiTime)) THEN
DLAllowed := FALSE;
IF (NOT DLAllowed) THEN
BEGIN
NL;
PrintF('DLHOURS');
IF (NoFile) THEN
Print('File downloading is not allowed at this time.');
END;
DLInTime := DLAllowed;
END;
FUNCTION BatchDLQueuedFiles(TransferFlags: TransferFlagSet): BOOLEAN;
VAR
DLBatch: BOOLEAN;
BEGIN
DLBatch := FALSE;
IF (NOT (lIsAddDLBatch IN TransferFLags)) AND (NumBatchDLFiles > 0) THEN
BEGIN
NL;
IF (PYNQ('Batch download queued files? ',0,FALSE)) THEN
BEGIN
BatchDownload;
DLBatch := TRUE;
END;
END;
BatchDLQueuedFiles := DLBatch;
END;
PROCEDURE DownloadFile(FileName: Str12; TransferFlags: TransferFlagSet);
BEGIN
IF (DLInTime) THEN
IF (NOT BatchDLQueuedFiles(TransferFlags)) THEN
BEGIN
IF (FileName = '') THEN
BEGIN
PrintF('DLOAD');
IF (NOT (lIsAddDLBatch IN TransferFlags)) THEN
{
NL;
Print(FString.downloadline)
NL;
Prt('File name: ');
}
lRGLngStr(23,FALSE)
ELSE
{
NL;
Print(FString.AddDLBatch);
NL;
Prt('File name: ');
}
lRGLngStr(31,FALSE);
MPL(12);
Input(FileName,12);
IF (FileName = '') THEN
BEGIN
NL;
Print('Aborted.');
END;
END;
IF (FileName <> '') THEN
BEGIN
IF (Pos('.',FileName) = 0) THEN
FileName := FileName+'.*';
DL(FileName,TransferFlags);
END
END;
END;
PROCEDURE GetFileDescription(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray;
VAR NumExtDesc: Byte; VAR ToSysOp: Boolean);
VAR
MaxLen: Byte;
BEGIN
NL;
IF ((ToSysOp) AND (General.ToSysOpDir >= 1) AND (General.ToSysOpDir <= NumFileAreas)) THEN
Print('Begin description with (/) to make upload "Private".')
ELSE
ToSysOp := FALSE;
LoadFileArea(FileArea);
IF ((FAUseGIFSpecs IN MemFileArea.FAFlags) AND ISGifExt(FileInfo.FileName)) THEN
BEGIN
Print('Enter your text. Press <^5Enter^1> alone to end. (31 chars/line 1, 50 chars/line 2-'+IntToStr(MaxExtDesc + 1)+')');
MaxLen := 31;
END
ELSE
BEGIN
Print('Enter your text. Press <^5Enter^1> alone to end. (50 chars/line 1-'+IntToStr(MaxExtDesc + 1)+')');
MaxLen := 50;
END;
REPEAT
Prt(': ');
MPL(MaxLen);
InputWC(FileInfo.Description,MaxLen);
IF ((FileInfo.Description[1] = '/') OR (RValidate IN ThisUser.Flags)) AND (ToSysOp) THEN
BEGIN
IF (General.ToSysOpDir >= 1) AND (General.ToSysOpDir <= NumFileAreas) THEN
FileArea := General.ToSysOpDir;
InitFileArea(FileArea);
ToSysOp := TRUE;
END
ELSE
ToSysOp := FALSE;
IF (FileInfo.Description[1] = '/') THEN
Delete(FileInfo.Description,1,1);
UNTIL ((FileInfo.Description <> '') OR (FileSysOp) OR (HangUp));
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
NumExtDesc := 0;
REPEAT
Inc(NumExtDesc);
Prt(': ');
MPL(50);
InputL(ExtendedArray[NumExtDesc],50);
UNTIL (ExtendedArray[NumExtDesc] = '') OR (NumExtDesc = MaxExtDesc) OR (HangUp);
END;
FUNCTION DizExists(CONST FN: AStr): Boolean;
VAR
Ok: Boolean;
BEGIN
DizExists := FALSE;
IF (ArcType(FN) > 0) THEN
BEGIN
Star('Checking for description...'#29);
ArcDecomp(Ok,ArcType(FN),FN,'FILE_ID.DIZ DESC.SDI');
IF (Ok) AND (Exist(TempDir+'ARC\FILE_ID.DIZ') OR (Exist(TempDir+'ARC\DESC.SDI'))) THEN
DizExists := TRUE;
NL;
END;
END;
PROCEDURE GetDiz(VAR FileInfo: FileInfoRecordType; VAR ExtendedArray: ExtendedDescriptionArray; VAR NumExtDesc: Byte);
VAR
DizFile: Text;
TempStr: Str50;
Counter: Byte;
BEGIN
IF (Exist(TempDir+'ARC\FILE_ID.DIZ')) THEN
Assign(DizFile,TempDir+'ARC\FILE_ID.DIZ')
ELSE
Assign(DizFile,TempDir+'ARC\DESC.SDI');
Reset(DizFile);
IF (IOResult <> 0) THEN
Exit;
Star('Importing description.');
FillChar(ExtendedArray,SizeOf(ExtendedArray),0);
Counter := 1;
WHILE NOT EOF(DizFile) AND (Counter <= (MaxExtDesc + 1)) DO
BEGIN
ReadLn(DizFile,TempStr);
IF (TempStr = '') THEN
TempStr := ' ';
IF (Counter = 1) THEN
FileInfo.Description := TempStr
ELSE
ExtendedArray[Counter - 1] := TempStr;
Inc(Counter);
END;
NumExtDesc := MaxExtDesc;
WHILE (NumExtDesc >= 1) AND ((ExtendedArray[NumExtDesc] = ' ') OR (ExtendedArray[NumExtDesc] = '')) DO
BEGIN
ExtendedArray[NumExtDesc] := '';
Dec(NumExtDesc);
END;
Close(DizFile);
Erase(DizFile);
LastError := IOResult;
END;
PROCEDURE WriteFV(FileInfo: FileInfoRecordType; DirFileRecNum: Integer; ExtendedArray: ExtendedDescriptionArray);
VAR
LineNum: Byte;
VFO: Boolean;
BEGIN
FileInfo.VTextSize := 0;
IF (ExtendedArray[1] = '') THEN
FileInfo.VPointer := -1
ELSE
BEGIN
VFO := (FileRec(ExtInfoFile).Mode <> FMClosed);
IF (NOT VFO) THEN
Reset(ExtInfoFile,1);
IF (IOResult = 0) THEN
BEGIN
FileInfo.VPointer := (FileSize(ExtInfoFile) + 1);
Seek(ExtInfoFile,FileSize(ExtInfoFile));
FOR LineNum := 1 TO MaxExtDesc DO
IF (ExtendedArray[LineNum] <> '') THEN
BEGIN
Inc(FileInfo.VTextSize,(Length(ExtendedArray[LineNum]) + 1));
BlockWrite(ExtInfoFile,ExtendedArray[LineNum],(Length(ExtendedArray[LineNum]) + 1));
END;
IF (NOT VFO) THEN
Close(ExtInfoFile);
END;
END;
Seek(FileInfoFile,DirFileRecNum);
Write(FileInfoFile,FileInfo);
LastError := IOResult;
END;
PROCEDURE UpdateFileInfo(VAR FileInfo: FileInfoRecordType; CONST FN: Str12; VAR GotPts: Integer);
BEGIN
WITH FileInfo DO
BEGIN
FileName := Align(FN);
Downloaded := 0;
OwnerNum := UserNum;
OwnerName := AllCaps(ThisUser.Name);
FileDate := Date2PD(DateStr);
IF (NOT General.FileCreditRatio) THEN
BEGIN
FilePoints := 0;
GotPts := 0;
END
ELSE
BEGIN
FilePoints := 0;
IF (General.FileCreditCompBaseSize > 0) THEN
FilePoints := ((FileSize DIV 1024) DIV General.FileCreditCompBaseSize);
GotPts := (FilePoints * General.FileCreditComp);
IF (GotPts < 1) THEN
GotPts := 1;
END;
FIFlags := [];
IF (NOT AACS(General.ULValReq)) AND (NOT General.ValidateAllFiles) THEN
Include(FIFlags,FINotVal);
END;
END;
(*
OldArcType : current archive format, 0 IF none
NewArcType : desired archive format, 0 IF none
OldFileName : current FileName
NewFileName : desired archive format FileName
*)
PROCEDURE ArcStuff(VAR Ok,
Convt: Boolean; { IF Ok - IF converted }
VAR FSize, { file size }
ConvTime: LongInt; { convert time }
ITest: Boolean; { whether to test integrity }
CONST FilePath: AStr; { filepath }
VAR FileName: Str12; { FileName }
VAR Descr: AStr); { Description }
VAR
OldFileName,
NewFileName: AStr;
OldArcType,
NewArcType: Byte;
BEGIN
Ok := TRUE;
ConvTime := 0;
FSize := GetFileSize(FilePath+FileName);
IF (NOT General.TestUploads) THEN
Exit;
OldFileName := SQOutSp(FilePath+FileName);
OldArcType := ArcType(OldFileName);
NewArcType := MemFileArea.ArcType;
IF (NOT General.FileArcInfo[NewArcType].Active) OR
(General.FileArcInfo[NewArcType].Ext = '') THEN
BEGIN
NewArcType := 0;
NewArcType := OldArcType;
END;
IF ((OldArcType <> 0) AND (NewArcType <> 0)) THEN
BEGIN
NewFileName := FileName;
IF (Pos('.',NewFileName) <> 0) THEN
NewFileName := Copy(NewFileName,1,(Pos('.',NewFileName) - 1));
NewFileName := SQOutSp(FilePath+NewFileName+'.'+General.FileArcInfo[NewArcType].Ext);
IF ((ITest) AND (General.FileArcInfo[OldArcType].TestLine <> '')) THEN
BEGIN
NL;
Star('Testing file integrity ... '#29);
ArcIntegrityTest(Ok,OldArcType,OldFileName);
IF (NOT Ok) THEN
BEGIN
SysOpLog('^5 '+OldFileName+' on #'+IntToStr(FileArea)+': errors in integrity test');
Print('^3failed.');
END
ELSE
Print('^3passed.');
END;
IF (Ok) AND ((OldArcType <> NewArcType) OR General.Recompress) AND (NewArcType <> 0) THEN
BEGIN
Convt := InCom; {* don't convert IF local AND non-file-SysOp *}
IF (FileSysOp) THEN
BEGIN
IF (OldArcType = NewArcType) THEN
Convt := PYNQ('Recompress this file? ',0,TRUE)
ELSE
Convt := PYNQ('Convert archive to .'+General.FileArcInfo[NewArcType].Ext+' format? ',0,TRUE);
END;
IF (Convt) THEN
BEGIN
NL;
ConvTime := GetPackDateTime;
ConvA(Ok,OldArcType,NewArcType,OldFileName,NewFileName);
ConvTime := (GetPackDateTime - ConvTime);
IF (Ok) THEN
BEGIN
IF (OldArcType <> NewArcType) THEN
Kill(FilePath+FileName);
FSize := GetFileSize(NewFileName);
IF (FSize = -1) OR (FSize = 0) THEN
Ok := FALSE;
FileName := Align(StripName(NewFileName));
Star('No errors in conversion, file passed.');
END
ELSE
BEGIN
IF (OldArcType <> NewArcType) THEN
Kill(NewFileName);
SysOpLog('^5 '+OldFileName+' on #'+IntToStr(FileArea)+': Conversion unsuccessful');
Star('errors in conversion! Original format retained.');
NewArcType := OldArcType;
END;
Ok := TRUE;
END
ELSE
NewArcType := OldArcType;
END;
IF (Ok) AND (General.FileArcInfo[NewArcType].CmtLine <> '') THEN
BEGIN
ArcComment(Ok,NewArcType,MemFileArea.CmtType,SQOutSp(FilePath+FileName));
Ok := TRUE;
END;
END;
FileName := SQOutSp(FileName);
IF (FAUseGIFSpecs IN MemFileArea.FAFlags) AND (IsGifExt(FileName)) THEN
Descr := GetGIFSpecs(FilePath+FileName,Descr,2);
END;
FUNCTION SearchForDups(CONST CompleteFN: Str12): Boolean;
VAR
WildFN,
NearFN: Str12;
SaveFileArea,
FArea,
FArrayRecNum: Integer;
AnyFound,
HadACC,
Thisboard,
CompleteMatch,
NearMatch: Boolean;
PROCEDURE SearchB(FArea1: Integer; VAR FArrayRecNum: Integer; CONST FN: Str12; VAR HadACC: Boolean);
VAR
DirFileRecNum: Integer;
BEGIN
HadACC := FileAreaAC(FArea1);
IF (NOT HadACC) OR (FANoDupeCheck IN MemFileArea.FAFlags) AND (NOT (FileArea = FArea1)) THEN
Exit;
FileArea := FArea1;
RecNo(FileInfo,FN,DirFileRecNum);
IF (BadDownloadPath) THEN
Exit;
WHILE (DirFileRecNum <> -1) DO
BEGIN
IF (NOT AnyFound) THEN
BEGIN
NL;
NL;
AnyFound := TRUE;
END;
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
IF (CanSee(FileInfo)) THEN
BEGIN
WITH FArray[FArrayRecNum] DO
BEGIN
FArrayFileArea := FileArea;
FArrayDirFileRecNum := DirFileRecNum;
END;
LDisplay_File(FileInfo,FArrayRecNum,'',TRUE);
Inc(FArrayRecNum);
IF (FArrayRecNum = 100) THEN
FArrayRecNum := 0;
END;
IF (Align(FileInfo.FileName) = Align(CompleteFN)) THEN
BEGIN
CompleteMatch := TRUE;
ThisBoard := TRUE;
END
ELSE
BEGIN
NearFN := Align(FileInfo.FileName);
NearMatch := TRUE;
ThisBoard := TRUE;
END;
NRecNo(FileInfo,DirFileRecNum);
END;
Close(FileInfoFile);
Close(ExtInfoFile);
FileArea := SaveFileArea;
InitFileArea(FileArea);
LastError := IOResult;
END;
BEGIN
SaveFileArea := FileArea;
InitFArray(FArray);
FArrayRecNum := 0;
AnyFound := FALSE;
Prompt('^5Searching for possible duplicates ... ');
SearchForDups := TRUE;
IF (Pos('.',CompleteFN) > 0) THEN
WildFN := Copy(CompleteFN,1,Pos('.',CompleteFN) - 1)
ELSE
WildFN := CompleteFN;
WildFn := SQOutSp(WildFN);
WHILE (WildFN[Length(WildFN)] IN ['0'..'9']) AND (Length(WildFN) > 2) DO
Dec(WildFN[0]);
WHILE (Length(WildFN) < 8) DO
WildFN := WildFN + '?';
WildFN := WildFN + '.???';
CompleteMatch := FALSE;
NearMatch := FALSE;
FArea := 1;
WHILE (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT HangUp) DO
BEGIN
Thisboard := FALSE;
SearchB(FArea,FArrayRecNum,WildFN,HadACC);
LoadFileArea(FArea);
IF (CompleteMatch) THEN
BEGIN
SysOpLog('User tried to upload '+SQOutSp(CompleteFN)+' to #'+IntToStr(SaveFileArea)+
'; existed in #'+IntToStr(FArea)+AOnOff(NOT HadACC,' - no access',''));
NL;
NL;
IF (HadACC) THEN
Print('^5File "'+SQOutSp(CompleteFN)+'" already exists in "'+MemFileArea.AreaName+'^5 #'+IntToStr(FArea)+'".')
ELSE
Print('^5File "'+SQOutSp(CompleteFN)+ 'cannot be accepted by the system at this time.');
Print('^7Illegal File Name.');
Exit;
END
ELSE IF (NearMatch) AND (Thisboard) THEN
BEGIN
SysOpLog('User entered upload file name "'+SQOutSp(CompleteFN)+'" in #'+
IntToStr(FileArea)+'; was warned that "'+SQOutSp(NearFN)+
'" existed in #'+IntToStr(FArea)+AOnOff(NOT HadACC,' - no access to',''));
END;
Inc(FArea);
END;
FileArea := SaveFileArea;
InitFileArea(FileArea);
IF (NOT AnyFound) THEN
Print('No duplicates found.');
NL;
SearchForDups := FALSE;
END;
(*
AExists : if file already exists in dir
DirFileRecNum : rec-num of file if already exists in file listing
ResumeFile : IF user is going to RESUME THE UPLOAD
ULS : whether file is to be actually UPLOADED
OffLine : IF uploaded a file to be OffLine automatically..
*)
PROCEDURE UL(FileName: Str12; LocBatUp: Boolean; VAR AddULBatch: Boolean);
VAR
fi: FILE OF Byte;
Cmd: Char;
Counter,
LineNum,
NumExtDesc: Byte;
DirFileRecNum,
SaveFileArea,
GotPts: Integer;
TransferTime,
RefundTime,
ConversionTime: LongInt;
ULS,
UploadOk,
KeyboardAbort,
Convt,
AExists,
ResumeFile,
WentToSysOp,
OffLine: Boolean;
BEGIN
SaveFileArea := FileArea;
InitFileArea(FileArea);
IF (BadUploadPath) THEN
Exit;
UploadOk := TRUE;
IF (FileName[1] = ' ') OR (FileName[10] = ' ') THEN
UploadOk := FALSE;
FOR Counter := 1 TO Length(FileName) DO
IF (Pos(FileName[Counter],'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.-!#$%^&''~()_') = 0) THEN
BEGIN
UploadOk := FALSE;
Break;
END;
IF (NOT UploadOk) THEN
BEGIN
NL;
Print('^7Illegal file name specified!^1');
PauseScr(FALSE);
Exit;
END;
Abort := FALSE;
Next := FALSE;
ResumeFile := FALSE;
ULS := TRUE;
OffLine := FALSE;
AExists := Exist(MemFileArea.ULPath+FileName);
FileName := Align(FileName);
RecNo(FileInfo,FileName,DirFileRecNum);
IF (DirFileRecNum <> -1) THEN
BEGIN
Seek(FileInfoFile,DirFileRecNum);
Read(FileInfoFile,FileInfo);
ResumeFile := (FIResumeLater IN FileInfo.FIFlags);
IF (ResumeFile) THEN
BEGIN
NL;
Print('^5Note: ^1This is a resume-later file.^1');
ResumeFile := (CRC32(FileInfo.OwnerName) = CRC32(ThisUser.Name)) OR (FileSysOp);
IF (ResumeFile) THEN
BEGIN
IF (NOT InCom) THEN
BEGIN
NL;
Print('^7File upload can not be resumed locally!^1');
PauseScr(FALSE);
Exit;
END;
NL;
ResumeFile := PYNQ('Resume upload of "'+SQOutSp(FileName)+'"? ',0,TRUE);
IF (NOT ResumeFile) THEN
Exit;
END
ELSE
BEGIN
NL;
Print('^7You are not the uploader of this file!^1');
PauseScr(FALSE);
Exit;
END;
END;
END;
IF (NOT AExists) AND (FileSysOp) AND (NOT InCom) THEN
BEGIN
ULS := FALSE;
OffLine := TRUE;
NL;
Print('File does not exist in upload path: ^5'+MemFileArea.ULPath+SQOutSp(FileName)+'^1');
IF (DirFileRecNum <> -1) THEN
BEGIN
NL;
Print('^5Note: ^1File exists in listing.^1');
END;
NL;
IF NOT PYNQ('Do you want to create an offline entry? ',0,FALSE) THEN
Exit;
END;
IF (NOT ResumeFile) THEN
BEGIN
IF (((AExists) OR (DirFileRecNum <> -1)) AND (NOT FileSysOp)) THEN
BEGIN
NL;
Print('^7File already exists!^1');
Exit;
END;
IF (FileSize(FileInfoFile) >= MemFileArea.MaxFiles) THEN
BEGIN
NL;
Star('^7This file area is full!^1');
Exit;
END;
IF (NOT AExists) AND (NOT OffLine) THEN
IF (NOT CheckDriveSpace('Upload',MemFileArea.ULPath,General.MinSpaceForUpload)) THEN
Exit;
IF (AExists) THEN
BEGIN
ULS := FALSE;
NL;
Print('^1File exists in upload path: ^5'+MemFileArea.ULPath+SQOutSp(FileName));
IF (DirFileRecNum <> -1) THEN
BEGIN
NL;
Print('^5Note: ^1File exists in listing.^1');
END;
IF (LocBatUp) THEN
BEGIN
NL;
Prompt('^7[Q]uit or Upload this? (Y/N) ['+SQOutSp(ShowYesNo(DirFileRecNum = -1))+']: ');
OneK(Cmd,'QYN'^M,FALSE,FALSE);
IF (DirFileRecNum <> -1) THEN
UploadOk := (Cmd = 'Y')
ELSE
UploadOk := (Cmd IN ['Y',^M]);
Abort := (Cmd = 'Q');
IF (Abort) THEN
Print('^3Quit')
ELSE IF (NOT UploadOk) THEN
Print('^3No')
ELSE
Print('^3Yes');
UserColor(1);
END
ELSE
BEGIN
NL;
UploadOk := PYNQ('Upload this? (Y/N) ['+SQOutSp(ShowYesNo(DirFileRecNum = -1))+']: ',0,(DirFileRecNum = -1));
END;
DirFileRecNum := 0;
END;
IF (General.SearchDup) AND (UploadOk) AND (NOT Abort) AND (InCom) THEN
IF (NOT FileSysOp) OR (PYNQ('Search for duplicates? ',0,FALSE)) THEN
IF (SearchForDups(FileName)) THEN
Exit;
IF (ULS) THEN
BEGIN
NL;
UploadOk := PYNQ('Upload "^5'+SQOutSp(FileName)+'^7" to ^5'+MemFileArea.AreaName+'^7? ',0,TRUE);
END;
IF ((UploadOk) AND (ULS) AND (NOT ResumeFile)) THEN
BEGIN
Assign(fi,MemFileArea.ULPath+FileName);
ReWrite(fi);
IF (IOResult <> 0) THEN
UploadOk := FALSE
ELSE
BEGIN
Close(fi);
Erase(fi);
IF (IOResult <> 0) THEN
UploadOk := FALSE;
END;
IF (NOT UploadOk) THEN
BEGIN
NL;
Print('^7Unable to upload that file name!^1');
Exit;
END;
END;
END;
IF (NOT UploadOk) THEN
Exit;
WentToSysOp := TRUE;
IF (NOT ResumeFile) THEN
BEGIN
FileInfo.FileName := Align(FileName);
GetFileDescription(FileInfo,ExtendedArray,NumExtDesc,WentToSysOp);
END;
UploadOk := TRUE;
IF (ULS) THEN
BEGIN
Receive(FileName,MemFileArea.ULPath,ResumeFile,UploadOk,KeyboardAbort,AddULBatch,TransferTime);
IF (AddULBatch) THEN
BEGIN
IF CheckBatchUL(FileName) THEN
BEGIN
NL;
Print('^7This file is already in the batch upload queue!^1');
END
ELSE IF (NumBatchULFiles = General.MaxBatchULFiles) THEN
BEGIN
NL;
Print('^7The batch upload queue is full!^1');
END
ELSE
BEGIN
Assign(BatchULFile,General.DataPath+'BATCHUL.DAT');
IF (NOT Exist(General.DataPath+'BATCHUL.DAT')) THEN
ReWrite(BatchULFile)
ELSE
Reset(BatchULFile);
WITH BatchUL DO
BEGIN
BULFileName := SQOutSp(FileName);
BULUserNum := UserNum;
BULSection := FileArea; (* Should this be CompFileArea ??? *)
BULDescription := FileInfo.Description;
IF (ExtendedArray[1] = '') THEN
BEGIN
BULVPointer := -1;
BULVTextSize := 0;
END
ELSE
BEGIN
Assign(BatchULF,General.DataPath+'BATCHUL.EXT');
IF (NOT Exist(General.DataPath+'BATCHUL.EXT')) THEN
ReWrite(BatchULF,1)
ELSE
Reset(BatchULF,1);
BULVPointer := (FileSize(BatchULF) + 1);
BULVTextSize := 0;
Seek(BatchULF,FileSize(BatchULF));
FOR LineNum := 1 TO NumExtDesc DO
IF (ExtendedArray[LineNum] <> '') THEN
BEGIN
Inc(BULVTextSize,(Length(ExtendedArray[LineNum]) + 1));
BlockWrite(BatchULF,ExtendedArray[LineNum],(Length(ExtendedArray[LineNum]) + 1));
END;
Close(BatchULF);
LastError := IOResult;
END;
Seek(BatchULFile,FileSize(BatchULFile));
Write(BatchULFile,BatchUL);
Close(BatchULFile);
LastError := IOResult;
Inc(NumBatchULFiles);
NL;
Print('^5File added to the batch upload queue.^1');
NL;
Star('^1Batch upload queue: ^5'+IntToStr(NumBatchULFiles)+' '+Plural('file',NumBatchULFiles));
SysOpLog('Batch UL Add: "^5'+BatchUL.BULFileName+'^1" to ^5'+MemFileArea.AreaName);
END;
END;
NL;
Star('^1Press <^5Enter^1> to stop adding to the batch upload queue.^1');
NL;
FileArea := SaveFileArea;
Exit;
END;
IF (KeyboardAbort) THEN
BEGIN
FileArea := SaveFileArea;
Exit;
END;
RefundTime := (TransferTime * (General.ULRefund DIV 100));
Inc(FreeTime,RefundTime);
NL;
END;
NL;
Convt := FALSE;
IF (NOT OffLine) THEN
BEGIN
Assign(fi,MemFileArea.ULPath+FileName);
Reset(fi);
IF (IOResult <> 0) THEN
UploadOk := FALSE
ELSE
BEGIN
FileInfo.FileSize := FileSize(fi);
IF (FileSize(fi) = 0) THEN
UploadOk := FALSE;
Close(fi);
END;
END;
IF ((UploadOk) AND (NOT OffLine)) THEN
BEGIN
ArcStuff(UploadOk,Convt,FileInfo.FileSize,ConversionTime,ULS,MemFileArea.ULPath,FileName,FileInfo.Description);
UpdateFileInfo(FileInfo,FileName,GotPts);
IF (General.FileDiz) AND (DizExists(MemFileArea.ULPath+FileName)) THEN
GetDiz(FileInfo,ExtendedArray,NumExtDesc);
IF (UploadOk) THEN
BEGIN
IF (AACS(General.ULValReq)) OR (General.ValidateAllFiles) THEN
Include(FileInfo.FIFlags,FIOwnerCredited);
IF (NOT ResumeFile) OR (DirFileRecNum = -1) THEN
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray)
ELSE
WriteFV(FileInfo,DirFileRecNum,ExtendedArray);
IF (ULS) THEN
BEGIN
IF (UploadsToday < 2147483647) THEN
Inc(UploadsToday);
IF ((UploadKBytesToday + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN
Inc(UploadKBytesToday,(FileInfo.FileSize DIV 1024))
ELSE
UploadKBytesToday := 2147483647;
END;
SysOpLog('^3Uploaded: "^5'+SQOutSp(FileName)+'^3" on ^5'+MemFileArea.AreaName);
IF (ULS) THEN
SysOpLog('^3 ('+ConvertBytes(FileInfo.FileSize,FALSE)+', '+FormattedTime(TransferTime)+
', '+FormatNumber(GetCPS(FileInfo.FileSize,Transfertime))+' cps)');
IF ((InCom) AND (ULS)) THEN
BEGIN
Star('File size : ^5'+ConvertBytes(FileInfo.FileSize,FALSE));
Star('Upload time : ^5'+FormattedTime(TransferTime));
IF (Convt) THEN
Star('Convert time : ^5'+FormattedTime(ConversionTime));
Star('Transfer rate: ^5'+FormatNumber(GetCPS(FileInfo.FileSize,TransferTime))+' cps');
Star('Time refund : ^5'+FormattedTime(RefundTime));
IF (GotPts <> 0) THEN
Star('File Points : ^5'+FormatNumber(GotPts)+' pts');
IF (ChopTime > 0) THEN
BEGIN
Inc(ChopTime,RefundTime);
Dec(FreeTime,RefundTime);
NL;
Star('Sorry, no upload time refund may be given at this time.');
Star('You will get your refund after the event.');
NL;
END;
IF (NOT AACS(General.ULValReq)) AND (NOT General.ValidateAllFiles) THEN
BEGIN
IF (General.ULDLRatio) THEN
BEGIN
NL;
Print('^5You will receive file credit as soon as the SysOp validates the file!')
END
ELSE
BEGIN
NL;
Print('^5You will receive credit as soon as the SysOp validates the file!');
END;
END
ELSE
BEGIN
IF ((NOT General.ULDLRatio) AND (NOT General.FileCreditRatio) AND (GotPts = 0)) THEN
BEGIN
NL;
Print('^5You will receive credit as soon as the Sysop validates the file!')
END
ELSE
BEGIN
IF (ThisUser.Uploads < 2147483647) THEN
Inc(ThisUser.Uploads);
IF ((ThisUser.UK + (FileInfo.FileSize DIV 1024)) < 2147483647) THEN
Inc(ThisUser.UK,(FileInfo.FileSize DIV 1024))
ELSE
ThisUser.UK := 2147483647;
IF ((ThisUser.FilePoints + GotPts) < 2147483647) THEN
Inc(ThisUser.FilePoints,GotPts)
ELSE
ThisUser.FilePoints := 2147483647;
END;
END;
NL;
Print('^5Thanks for the file, '+Caps(ThisUser.Name)+'!');
PauseScr(FALSE);
END
ELSE
Star('Entry added.');
END;
END;
IF (NOT UploadOk) AND (NOT OffLine) THEN
BEGIN
IF (Exist(MemFileArea.ULPath+FileName)) THEN
BEGIN
Star('Upload not received.');
IF ((FileInfo.FileSize DIV 1024) >= General.MinResume) THEN
BEGIN
NL;
IF PYNQ('Save file for a later resume? ',0,TRUE) THEN
BEGIN
UpdateFileInfo(FileInfo,FileName,GotPts);
Include(FileInfo.FIFlags,FIResumeLater);
IF (NOT AExists) OR (DirFileRecNum = -1) THEN
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray)
ELSE
WriteFV(FileInfo,DirFileRecNum,ExtendedArray);
END;
END;
IF (NOT (FIResumeLater IN FileInfo.FIFlags)) AND (Exist(MemFileArea.ULPath+FileName)) THEN
Kill(MemFileArea.ULPath+FileName);
SysOpLog('^3Error uploading '+SQOutSp(FileName)+
' - '+AOnOff(FIResumeLater IN FileInfo.FIFlags,'file saved for later resume','file deleted'));
END;
Star('Removing time refund of '+FormattedTime(RefundTime));
Dec(FreeTime,RefundTime);
END;
IF (OffLine) THEN
BEGIN
FileInfo.FileSize := 0;
UpdateFileInfo(FileInfo,FileName,GotPts);
Include(FileInfo.FIFlags,FIIsRequest);
WriteFV(FileInfo,FileSize(FileInfoFile),ExtendedArray);
END;
Close(FileInfoFile);
Close(ExtInfoFile);
FileArea := SaveFileArea;
InitFileArea(FileArea);
SaveURec(ThisUser,UserNum);
END;
PROCEDURE UploadFile;
VAR
FileName: Str12;
AddULBatch: Boolean;
BEGIN
InitFileArea(FileArea);
IF (BadUploadPath) THEN
Exit;
IF (NOT AACS(MemFileArea.ULACS)) THEN
BEGIN
NL;
Star('Your access level does not permit uploading to this file area.');
Exit;
END;
PrintF('UPLOAD');
IF (NumBatchULFiles > 0) THEN
BEGIN
NL;
IF PYNQ('Upload queued files? ',0,FALSE) THEN
BEGIN
BatchUpload(FALSE,0);
Exit;
END;
END;
REPEAT
AddULBatch := FALSE;
{
NL;
Print(FString.UploadLine);
NL;
Prt('File name: ');
}
lRGLngStr(24,FALSE);
MPL(12);
Input(FileName,12);
FileName := SQOutSp(FileName);
IF (FileName = '') THEN
BEGIN
NL;
Print('Aborted.');
END
ELSE
BEGIN
IF (NOT FileSysOp) THEN
UL(FileName,FALSE,AddULBatch)
ELSE
BEGIN
IF (NOT IsWildCard(FileName)) THEN
UL(FileName,FALSE,AddULBatch)
ELSE
BEGIN
FindFirst(MemFileArea.ULPath+FileName,AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
IF (DOSError <> 0) THEN
BEGIN
NL;
Print('No files found.');
END
ELSE
REPEAT
UL(DirInfo.Name,TRUE,AddULBatch);
FindNext(DirInfo);
UNTIL (DOSError <> 0) OR (Abort) OR (HangUp);
END;
END;
END;
UNTIL (NOT AddUlBatch) OR (HangUp);
END;
PROCEDURE LFileAreaList(VAR FArea,NumFAreas: Integer; AdjPageLen: Byte; ShowScan: Boolean);
VAR
ScanChar: Str1;
TempStr: AStr;
NumOnline,
NumDone: Byte;
SaveFileArea: Integer;
BEGIN
SaveFileArea := FileArea;
Abort := FALSE;
Next := FALSE;
NumOnline := 0;
TempStr := '';
FillChar(LightBarArray,SizeOf(LightBarArray),0);
LightBarCounter := 0;
{
$New_Scan_Char_File
<20>
$
}
IF (ShowScan) THEN
ScanChar := lRGLngStr(55,TRUE);
{
%CL-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ
-<2D>. Num -<2D>/ Name -<2D>. Num -<2D>/ Name -<2D>
-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
}
lRGLngStr(59,FALSE);
Reset(FileAreaFile);
NumDone := 0;
WHILE (NumDone < (PageLength - AdjPageLen)) AND (FArea >= 1) AND (FArea <= NumFileAreas) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
LoadFileArea(FArea);
IF (ShowScan) THEN
LoadNewScanFile(NewScanFileArea);
IF AACS(MemFileArea.ACS) OR (FAUnHidden IN MemFileArea.FAFlags) THEN
BEGIN
IF (General.UseFileAreaLightBar) AND (FileAreaLightBar IN ThisUser.SFlags) THEN
BEGIN
Inc(LightBarCounter);
LightBarArray[LightBarCounter].CmdToExec := CompFileArea(FArea,0);
LightBarArray[LightBarCounter].CmdToShow := MemFileArea.AreaName;
IF (NumOnline = 0) THEN
BEGIN
LightBarArray[LightBarCounter].Xpos := 8;
LightBarArray[LightBarCounter].YPos := WhereY;
END
ELSE
BEGIN
LightBarArray[LightBarCounter].Xpos := 47;
LightBarArray[LightBarCounter].YPos := WhereY;
END;
END;
TempStr := TempStr + AOnOff(ShowScan AND NewScanFileArea,'0'+ScanChar[1],' ')+
PadLeftStr(PadRightStr('1'+IntToStr(CompFileArea(FArea,0)),5)+
+'2 '+MemFileArea.AreaName,37)+' ';
Inc(NumOnline);
IF (NumOnLine = 2) THEN
BEGIN
PrintACR(TempStr);
NumOnline := 0;
Inc(NumDone);
TempStr := '';
END;
Inc(NumFAreas);
END;
WKey;
Inc(FArea);
END;
Close(FileAreaFile);
LastError := IOResult;
IF (NumOnline = 1) AND (NOT Abort) AND (NOT HangUp) THEN
PrintACR(TempStr)
ELSE IF (NumFAreas = 0) AND (NOT Abort) AND (NOT HangUp) THEN
LRGLngStr(67,FALSE);
{
%LF^7No file areas!^1
}
FileArea := SaveFileArea;
LoadFileArea(FileArea);
END;
PROCEDURE UnlistedDownload(FileName: AStr);
VAR
User: UserRecordType;
TransferFlags: TransferFlagSet;
DS: DirStr;
NS: NameStr;
ES: ExtStr;
SaveFileArea: Integer;
BEGIN
IF (FileName <> '') THEN
IF (NOT Exist(FileName)) THEN
BEGIN
NL;
Print('File not found.');
END
ELSE
BEGIN
SaveFileArea := FileArea;
FileArea := -1;
Abort := FALSE;
Next := FALSE;
LoadURec(User,1);
FSplit(FileName,DS,NS,ES);
FindFirst(SQOutSp(FileName),AnyFile - Directory - VolumeID - Hidden - SysFile,DirInfo);
WHILE (DOSError = 0) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
WITH MemFileArea DO
BEGIN
AreaName := 'Unlisted Download';
DLPath := DS;
ULPath := DS;
FAFlags := [FANoRatio];
END;
WITH FileInfo DO
BEGIN
FileName := Align(DirInfo.Name);
Description := 'Unlisted Download';
FilePoints := 0;
Downloaded := 0;
FileSize := DirInfo.Size;
OwnerNum := 1;
OwnerName := Caps(User.Name);
FileDate := Date2PD(DateStr);
VPointer := -1;
VTextSize := 0;
FIFlags := [];
END;
TransferFlags := [IsUnlisted];
IF (InCom) THEN
BEGIN
NL;
IF (PYNQ('Is this file located on a CDRom? ',0,FALSE)) THEN
Include(MemFileArea.FAFlags,FACDROm);
END;
DLX(FileInfo,-1,TransferFlags);
IF (IsKeyboardAbort IN Transferflags) THEN
Abort := TRUE;
FindNext(DirInfo);
END;
FileArea := SaveFileArea;
LoadFileArea(FileArea);
END;
END;
PROCEDURE Do_Unlisted_Download;
VAR
PathFileName: Str52;
BEGIN
NL;
Print('Enter file name to download (d:path\filename.ext)');
Prt(': ');
MPL(52);
Input(PathFileName,52);
IF (PathFileName = '') THEN
BEGIN
NL;
Print('Aborted.');
END
ELSE IF (NOT IsUL(PathFileName)) THEN
BEGIN
NL;
Print('You must specify the complete path to the file.');
END
ELSE
UnlistedDownload(PathFileName)
END;
END.
Reference in New Issue View Git Blame Copy Permalink