home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 2 BBS
/
02-BBS.zip
/
MFMP110A.ZIP
/
MFMP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-05-25
|
113KB
|
3,246 lines
(*#module(turbo_comp=>off)*)
Program Maximus_File_Manager(Input,Output);
IMPORT
OS2DEF(ULONG),
DOS(FILEFINDBUF,HDIR,HDIR_CREATE,EXIT_PROCESS),
PASDOS(paramcount,paramstr,getdate,gettime),
TURBOCRT(white,blink,yellow,magenta,cyan,green,red,black,lightred,assigncrt),
TURBODOS(dirstr,namestr,extstr,pathstr,diskfree,fsplit),
MaxAreas *,
{ Memory *, }
MfmCopy *,
Screen *,
Strings *,
TURBOSYS(_STR_INT,upcase)
;
Const
{ Pgmid = 'MFM 1.10 16nov91 MWBJR Enterprise 1:273/701.0 (215)641-0270';}
Pgmid = 'MFM 1.10.OS2.1 MWBJR Ent. 1:273/701, OS/2 - C. Renshaw 1:270/114';
Base153A = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ@!#$%&''()-^_`{}~';
Base153B = 'ÇÜÄÅÉÆÖ¢£¥₧ƒÑªº¿⌐¬½¼¡«»░▒▓│┤╡╢╖╕╣║╗╝╜╛┐└┴┬├─┼╞╟╚╔╩';
Base153C = '╦╠═╬╧╨╤╥╙╘╒╓╫╪┘┌█▄▌▐▀αßΓπΣµτΦΘΩδ∞φε∩≡±≥≤⌠⌡÷≈°∙·√ⁿ²■';
MaxSkip = 20;
Type
TypeOfRecordType = (Comment,FileRecord,Orphan,Offline);
ListPtr = ^ListRecord;
ListRecord = Record
NextEntry, PrevEntry : ListPtr;
TypeOfRecord : TypeOfRecordType;
FileName : String[12];
FileSize, FileDate : Integer;
Description : String[144];
Tagged : Boolean;
End;
AreaPtr = ^AreaRecord;
AreaRecord = Record
NextEntry, PrevEntry : AreaPtr;
AreaPath : String[40];
End;
S8 = String[8];
Var
tfname : string[12];
OK :boolean;
tempstr : maxstring;
ztempstr : array[1..255] of char;
hndlhdir : HDIR;
attr, reslng, count, retn : word;
rsrvd : ULONG;
Gcx : Char;
Gbx : Byte;
Counter, Row, AreaCounter, OffSet, Columns, ColumnPos : Byte;
Result : Word;
FileList, NewFileList : Text;
DirInfo : FILEFINDBUF;
Date : DateTime;
Month, Day : String[2];
Year : String[4];
AreaMask : String[20];
FileAreaPath : String[80];
WorkString : MAXSTRING;
NumberOfEntries, NumberOfAreaEntries, NumberOfFiles : Word;
D : DirStr;
N : NameStr;
E : ExtStr;
Altered, FilesBbs : Boolean;
FirstEntry, LastEntry, NewEntry, OldEntry, TopEntry, NextPrintEntry,
CurrentEntry, StackEntry, KillEntry, BeginSort, EndSort : ListPtr;
FirstAreaEntry, LastAreaEntry, NewAreaEntry,
OldAreaEntry, CurrentAreaEntry, ChooseAreaEntry : AreaPtr;
StringToFind : String[12];
FreeSpace, SizeOfFiles : Integer;
FreeSpaceString : String[6];
OkToAddToList, Changed : Boolean;
Base153 : String[153];
SkipList : Array[1..MaxSkip] Of String[12];
{========================================================================}
{========================================================================}
Function GetDateString(PackedTime : Integer) : S8;
Var
Month, Day : String[2];
Year : String[4];
OK : boolean;
Begin
UnpackTime(PackedTime,Date);
If Date.Year < 20 Then Date.Year := Date.Year + 1980;
IntToStr(Date.Month,Month,10,OK);
IntToStr(Date.Day,Day,10,OK);
IntToStr(Date.Year,Year,10,OK);
If Length(Month) = 1 Then Month := '0' + Month;
If Length(Day) = 1 Then Day := '0' + Day;
Year := Copy(Year,3,2);
GetDateString := Month + '/' + Day + '/' + Year;
End;
{========================================================================}
Function GetTimeString(PackedTime : Integer) : S8;
Var
Hour, Min, Sec : String[2];
Begin
UnpackTime(PackedTime,Date);
_STR_INT(Date.Hour, 0,Hour);
_STR_INT(Date.Min, 0,Min);
_STR_INT(Date.Sec, 0,Sec);
If Length(Hour) = 1 Then Hour := '0' + Hour;
If Length(Min) = 1 Then Min := '0' + Min;
If Length(Sec) = 1 Then Sec := '0' + Sec;
GetTimeString := Hour + ':' + Min + ':' + Sec;
End;
{========================================================================}
Function GetPackedTime(DateString, TimeString : S8) : Integer;
Var
Code : boolean;
PackedTime : Integer;
Begin
tempstr := Copy(DateString,1,2);
Date.Month := StrToInt(tempstr,10,Code);
tempstr := Copy(DateString,4,2);
Date.Day := StrToInt(tempstr,10,Code);
tempstr := Copy(DateString,7,2);
Date.Year := StrToInt(tempstr,10,Code);
If Date.Year < 20 Then Date.Year := Date.Year + 1980;
tempstr := Copy(TimeString,1,2);
Date.Hour := StrToInt(tempstr,10,Code);
tempstr := Copy(TimeString,4,2);
Date.Min := StrToInt(tempstr,10,Code);
tempstr := Copy(TimeString,7,2);
Date.Sec := StrToInt(tempstr,10,Code);
PackTime(Date,PackedTime);
GetPackedTime := PackedTime;
End;
{========================================================================}
Procedure BlankCurrentLocation;
Begin
AnsiGotoXY(Row,1);
If CurrentEntry^.Tagged Then
Begin
NewTextColor(White); Write('∙');
End
Else
Begin
NewTextColor(White); Write(' ');
End;
AnsiGotoXY(24,80);
End;
{========================================================================}
Procedure DisplayCurrentLocation;
Begin
AnsiGotoXY(Row,1);
If CurrentEntry^.Tagged Then
Begin
NewTextColor(White+Blink); Write('»'); NewTextColor(White);
End
Else
Begin
NewTextColor(White+Blink); Write('>'); NewTextColor(White);
End;
AnsiGotoXY(24,80);
End;
{========================================================================}
Procedure DisplayRecord(Row : Byte);
Begin
AnsiGotoXY(Row,1); AnsiClearToEOL;
NewTextColor(White);
If NextPrintEntry^.Tagged Then Write('∙');
AnsiGotoXY(Row,2);
Case NextPrintEntry^.TypeOfRecord Of
Comment :
Begin
NewTextColor(White);
Write(NextPrintEntry^.Description);
End;
FileRecord :
Begin
NewTextColor(Yellow);
Write(Copy(nextprintentry^.filename+' ',1,12));
NewTextColor(Magenta);
Write(NextPrintEntry^.FileSize:8);
NewTextColor(Green);
Write(' ' + GetDateString(NextPrintEntry^.FileDate) + ' ');
NewTextColor(Cyan);
Write(Copy(NextPrintEntry^.Description,1,48));
End;
Orphan :
Begin
NewTextColor(Yellow);
Write(Copy(NextPrintEntry^.FileName+' ',1,12));
NewTextColor(Magenta);
Write(NextPrintEntry^.FileSize:8);
NewTextColor(Green);
Write(' ' + GetDateString(NextPrintEntry^.FileDate) + ' ');
NewTextColor(Red);
Write('Orphan');
End;
Offline :
Begin
NewTextColor(Yellow);
Write(Copy(NextPrintEntry^.FileName+' ',1,12));
NewTextColor(Red);
Write(' offline ');
NewTextColor(Cyan);
Write(Copy(NextPrintEntry^.Description,1,48));
End;
Else End;
End;
{========================================================================}
Procedure DisplayScreen;
Var
Dsb : Byte;
Begin
NextPrintEntry := TopEntry;
Dsb := 1;
While (Dsb < 23) And (NextPrintEntry^.NextEntry <> NIL) Do
Begin
DisplayRecord(Dsb);
NextPrintEntry := NextPrintEntry^.NextEntry; Dsb:=Dsb+1;
End;
DisplayRecord(Dsb);
DisplayCurrentLocation;
If Dsb < 23 Then
Begin
Repeat
Dsb:=Dsb+1;
AnsiGotoXY(Dsb,1); AnsiClearToEOL;
Until Dsb = 23;
End;
AnsiGotoXY(24,80);
End;
{========================================================================}
Procedure LineUp;
Begin
If CurrentEntry^.PrevEntry <> NIL Then
Begin
If Row > 1 Then
Begin
BlankCurrentLocation;
Row:=Row-1; CurrentEntry := CurrentEntry^.PrevEntry;
DisplayCurrentLocation;
End
Else
Begin
CurrentEntry := CurrentEntry^.PrevEntry;
TopEntry := CurrentEntry;
DisplayScreen;
End;
End;
End;
{========================================================================}
Procedure LineDown;
Begin
If CurrentEntry^.NextEntry <> NIL Then
Begin
If Row <= 22 Then
Begin
BlankCurrentLocation;
Row:=Row+1; CurrentEntry := CurrentEntry^.NextEntry;
DisplayCurrentLocation;
End
Else
Begin
CurrentEntry := CurrentEntry^.NextEntry;
TopEntry := TopEntry^.NextEntry;
DisplayScreen;
End;
End;
End;
{========================================================================}
Procedure PageUp;
Begin
If NumberOfEntries <= 23 Then
Begin
CurrentEntry := FirstEntry; Row := 1;
DisplayScreen;
End
Else
Begin
Counter := 1;
While (Counter < 23) And (TopEntry^.PrevEntry <> NIL) Do
Begin
Counter:=Counter+1; TopEntry := TopEntry^.PrevEntry;
End;
While (Counter > 1) And (CurrentEntry^.PrevEntry <> NIL) Do
Begin
Counter:=Counter-1; CurrentEntry := CurrentEntry^.PrevEntry;
End;
Row := Row - (Counter - 1);
DisplayScreen;
End;
End;
{========================================================================}
Procedure PageDown;
Begin
If NumberOfEntries <= 23 Then
Begin
CurrentEntry := LastEntry; Row := NumberOfEntries;
DisplayScreen;
End
Else
Begin
Counter := 1;
While (Counter < 23) And (TopEntry^.NextEntry <> NIL) Do
Begin
Counter:=Counter+1; TopEntry := TopEntry^.NextEntry;
End;
While (Counter > 1) And (CurrentEntry^.NextEntry <> NIL) Do
Begin
Counter:=Counter-1; CurrentEntry := CurrentEntry^.NextEntry;
End;
Row := Row - (Counter - 1);
DisplayScreen;
End;
End;
{========================================================================}
Procedure TopOfList;
Begin
CurrentEntry := FirstEntry; TopEntry := FirstEntry; Row := 1;
DisplayScreen;
End;
{========================================================================}
Procedure BottomOfList;
Begin
If NumberOfEntries <= 23 Then
Begin
CurrentEntry := LastEntry;
Row := NumberOfEntries;
DisplayScreen;
End
Else
Begin
CurrentEntry := LastEntry; TopEntry := LastEntry;
Row := 23;
Repeat
TopEntry := TopEntry^.PrevEntry;
Row:=Row-1;
Until Row = 1;
Row := 23;
DisplayScreen;
End;
End;
{========================================================================}
{========================================================================}
Function OkToAdd(InString : MAXSTRING) : Boolean;
Var
Otab : Byte;
Begin
If (MaxAvail > Size(ListRecord)) Then
Begin
OkToAdd := True;
For Otab := 1 To 10 Do If Pos(SkipList[Otab],UpperString(InString)) = 1 Then OkToAdd := False;
End
Else
Begin
OkToAdd := False;
End;
End;
{========================================================================}
Function CommentEntry : Boolean;
Begin
CommentEntry := False;
If Length(WorkString) = 0 Then CommentEntry := True;
If Copy(WorkString,1,1) = ' ' Then CommentEntry := True;
If Copy(WorkString,1,1) = '-' Then CommentEntry := True;
If Pos(WorkString[1],Base153) = 0 Then CommentEntry := True;
End;
{========================================================================}
Procedure FindOrphans;
Var
FileFound : Boolean;
SearchEntry : ListPtr;
Begin
FileFound := False; SearchEntry := FirstEntry;
If FilesBbs Then
Begin
While (Not FileFound) And (SearchEntry^.NextEntry <> NIL) Do
Begin
tfname := array2string(ADR(dirinfo.name),dirinfo.cname);
If tfname = SearchEntry^.FileName Then FileFound := True;
SearchEntry := SearchEntry^.NextEntry;
End;
End;
If FilesBbs Then
Begin
tfname := array2string(ADR(dirinfo.name),dirinfo.cname);
If (Not FileFound) And (tfname <> SearchEntry^.FileName) Then
Begin
tfname := array2string(ADR(dirinfo.name),dirinfo.cname);
If OkToAdd(tfname) Then
Begin
New(NewEntry);
If NumberOfEntries = 0 Then
Begin
FirstEntry := NewEntry;
NewEntry^.PrevEntry := NIL;
OldEntry := FirstEntry;
End
Else
Begin
NewEntry^.PrevEntry := OldEntry;
OldEntry^.NextEntry := NewEntry;
OldEntry := NewEntry;
End;
NewEntry^.TypeOfRecord := Orphan;
tfname := array2string(ADR(dirinfo.name),dirinfo.cname);
NewEntry^.FileName := tfname;
NewEntry^.FileSize := DirInfo.fileSize;
If tfname <> 'FILES.BBS' Then
Begin
SizeOfFiles := SizeOfFiles + DirInfo.fileSize;
NumberOfFiles:=NumberOfFiles+1;
End;
NewEntry^.FileDate := DirInfo.fdatelastwrite;
NewEntry^.FileDate := NewEntry^.FileDate << 16;
NewEntry^.FileDate := NewEntry^.FileDate + DirInfo.ftimelastwrite;
NewEntry^.Description := '';
NewEntry^.Tagged := False;
NumberOfEntries:=NumberOfEntries+1;
End;
End;
End
Else
Begin
If Not FileFound Then
Begin
If MaxAvail > Size(ListRecord) Then
Begin
New(NewEntry);
NewEntry^.Tagged := False;
If NumberOfEntries = 0 Then
Begin
FirstEntry := NewEntry;
NewEntry^.PrevEntry := NIL;
OldEntry := FirstEntry;
End
Else
Begin
NewEntry^.PrevEntry := OldEntry;
OldEntry^.NextEntry := NewEntry;
OldEntry := NewEntry;
End;
NewEntry^.TypeOfRecord := Orphan;
tfname := array2string(ADR(dirinfo.name),dirinfo.cname);
NewEntry^.FileName := tfname;
NewEntry^.FileSize := DirInfo.fileSize;
If tfname <> 'FILES.BBS' Then
Begin
SizeOfFiles := SizeOfFiles + DirInfo.fileSize;
NumberOfFiles:=NumberOfFiles+1;
End;
NewEntry^.FileDate := DirInfo.fdatelastwrite;
NewEntry^.FileDate := NewEntry^.FileDate << 16;
NewEntry^.FileDate := NewEntry^.FileDate + DirInfo.ftimelastwrite;
NewEntry^.Description := '';
NumberOfEntries:=NumberOfEntries+1;
End;
End;
End;
End;
{========================================================================}
Procedure BuildList;
Begin
NumberOfEntries := 0;
FilesBbs := True;
Altered := False;
SizeOfFiles := 0;
NumberOfFiles := 0;
Assign(FileList,FileAreaPath+'FILES.BBS');
FileMode := 0H;
{$I-}
IOcheck := FALSE;
Reset(FileList);
{$I+}
IOcheck :=TRUE;
If IOresult = 0 Then
Begin
AnsiGotoXY(25,1);
NewTextColor(White);
NewTextBackground(Black);
AnsiClearToEOL; Write('Loading FILES.BBS ...');
While Not Eof(FileList) Do
Begin
ReadLn(FileList,WorkString);
If OkToAdd(WorkString) Then
Begin
NumberOfEntries:=NumberOfEntries+1;
If CommentEntry Then
Begin
New(NewEntry);
NewEntry^.TypeOfRecord := Comment;
NewEntry^.FileName := '';
NewEntry^.FileSize := 0;
NewEntry^.FileDate := 0;
NewEntry^.Description := WorkString;
NewEntry^.Tagged := False;
If NumberOfEntries = 1 Then
Begin
FirstEntry := NewEntry;
NewEntry^.PrevEntry := NIL;
OldEntry := FirstEntry;
End
Else
Begin
NewEntry^.PrevEntry := OldEntry;
OldEntry^.NextEntry := NewEntry;
OldEntry := NewEntry;
End;
End
Else
Begin
New(NewEntry);
NewEntry^.Tagged := False;
If NumberOfEntries = 1 Then
Begin
FirstEntry := NewEntry;
NewEntry^.PrevEntry := NIL;
OldEntry := FirstEntry;
End
Else
Begin
NewEntry^.PrevEntry := OldEntry;
OldEntry^.NextEntry := NewEntry;
OldEntry := NewEntry;
End;
If Pos(' ',WorkString) = 0 Then
Begin
NewEntry^.FileName := UpperString(WorkString);
End
Else
Begin
NewEntry^.FileName := UpperString(Copy(
Copy(WorkString,1,Pos(' ',WorkString)-1)
,1,12));
End;
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(FileAreaPath+NewEntry^.FileName,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
NewEntry^.TypeOfRecord := FileRecord;
NewEntry^.FileSize := DirInfo.fileSize;
SizeOfFiles := SizeOfFiles + DirInfo.fileSize;
NumberOfFiles:=NumberOfFiles+1;
NewEntry^.FileDate := DirInfo.fdatelastwrite;
NewEntry^.FileDate := NewEntry^.FileDate << 16;
NewEntry^.FileDate := NewEntry^.FileDate + DirInfo.ftimelastwrite;
If Pos(' ',WorkString) = 0 Then
Begin
NewEntry^.Description := '';
End
Else
Begin
NewEntry^.Description := LtrimRtrim(Copy(WorkString,Pos(' ',WorkString)+1,144));
End;
End
Else
Begin
NewEntry^.TypeOfRecord := Offline;
NewEntry^.FileSize := 0;
NewEntry^.FileDate := 0;
If Pos(' ',WorkString) = 0 Then
Begin
NewEntry^.Description := '';
End
Else
Begin
NewEntry^.Description := LtrimRtrim(Copy(WorkString,Pos(' ',WorkString)+1,144));
End;
End;
End;
End;
End;
Close(FileList);
NewEntry^.NextEntry := NIL;
If NumberOfEntries = 0 Then FilesBbs := False;
End
Else
Begin
FilesBbs := False;
End;
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(FileAreaPath+'*.*',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then FindOrphans;
While retn = 0 Do
Begin
NewEntry^.NextEntry := NIL;
retn := dos.FindNext(hndlhdir,DirInfo,reslng,count);
If retn = 0 Then FindOrphans;
End;
LastEntry := NewEntry;
LastEntry^.NextEntry := NIL;
StackEntry := NIL; KillEntry := NIL;
AnsiGotoXY(25,1); AnsiClearToEOL;
End;
{========================================================================}
Function Bytes(NumberOfBytes : Integer) : S8;
Var
TempString : S8;
Begin
If NumberOfBytes < 1024 Then
Begin
TempString := MyStr(NumberOfBytes,4)+'K';
End
Else
Begin
IntToStr(NumberOfBytes DIV 1024,TempString,10,OK);
{ _STR_REAL_FIX(NumberOfBytes/1024,3,1,TempString); }
TempString := TempString+'M';
End;
Bytes := TempString;
End;
{========================================================================}
Procedure SetupScreen;
Begin
NewTextColor(White); NewTextBackground(Black);
AnsiClearScreen; AnsiGotoXY(24,1);
NewTextColor(Black); NewTextBackground(Cyan);
Write(Pgmid+' ^Q=quit ?=help');
NewTextColor(White); NewTextBackground(Black);
End;
{========================================================================}
Procedure ReDrawScreen;
Begin
SetupScreen; DisplayScreen;
End;
{========================================================================}
{========================================================================}
Procedure Help;
Begin
AnsiClearScreen; NewTextColor(7);
AnsiGotoXY(1,1); Write(Pgmid); WriteLn;
WriteLn('╔═[Navagate through list]════════════════════════════════════════════════════╗');
Write('║');
NewTextColor(9);
Write(' 7 : TopOfList 8 : LineUp 9 : PageUp ');
NewTextColor(7);
WriteLn('║');
Write('║');
NewTextColor(9);
Write(' 1 : BottomOfList 2 : LineDown 3 : PageDown ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[Add, Edit and Rename]═════════════════════════════════════════════════════╣');
Write('║');
NewTextColor(10);
Write(' A : Adopt/Abandon E : Edit Description I : Insert Blank ');
NewTextColor(7);
WriteLn('║');
Write('║');
NewTextColor(10);
Write(' R : Rename File D : Change File Date ^A : Adopt ALL ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[Copy or Move between areas]═══════════════════════════════════════════════╣');
Write('║');
NewTextColor(11);
Write(' C : Copy to New Area M : Move to New Area ');
NewTextColor(7);
WriteLn('║');
Write('║');
NewTextColor(11);
Write(' $ : Mass Copy # : Mass Move <SP> : Toggle Tag ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[Move or Remove entries in list]═══════════════════════════════════════════╣');
Write('║');
NewTextColor(12);
Write(' < : Push Record > : Pop Record K : Kill Entry U : UnKill Entry ');
NewTextColor(7);
WriteLn('║');
Write('║');
NewTextColor(12);
Write(' [ : Stack Prev ] : Stack Next { : Prev Kill } : Next Kill ');
NewTextColor(7);
WriteLn('║');
Write('║');
NewTextColor(12);
Write(' ; : Show Stack : : Show Kill ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[Sort list]════════════════════════════════════════════════════════════════╣');
Write('║');
NewTextColor(13);
Write(' F : Mark First L : Mark Last S : Sort by Name T : Sort by Time ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[Search for string]════════════════════════════════════════════════════════╣');
Write('║');
NewTextColor(14);
Write(' ^F : In File Name ^D : In Description ^B : In Both ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[View]═[All Unavailable!!]═════════════════════════════════════════════════╣');
Write('║');
NewTextColor(9);
Write(' ALT-V : View File ALT-F : Force SHEZ View ALT-L : Force LIST View ');
NewTextColor(7);
WriteLn('║');
WriteLn('╠═[Misc]════════════════════════════════════════════[Not Available]══════════╣');
Write('║');
NewTextColor(10);
Write(' N : New Area W : Write List ! : ReDraw Screen ALT-S : Shell to DOS ');
NewTextColor(7);
WriteLn('║');
WriteLn('╚════════════════════════════════════════════════════════════════════════════╝');
AnsiGotoXY(25,27);
NewTextColor(Blink+Red);
Write('Press any key to continue!');
NewTextColor(White);
AnsiGotoXY(1,80);
Gbx := GetInput;
ReDrawScreen;
End;
{========================================================================}
Procedure AreaHelp;
Begin
AnsiClearScreen; NewTextColor(7);
AnsiGotoXY(1,1); Write(Pgmid);
AnsiGotoXY(3,15); Write('7 : Upper Left 8 : Move Up 9 : Upper Right');
AnsiGotoXY(4,15); Write('4 : Move Left 6 : Move Right');
AnsiGotoXY(5,15); Write('1 : Lower Left 2 : Move Down 3 : Lower Right');
AnsiGotoXY(7,15); Write('TAB : Add temporary path');
AnsiGotoXY(25,27);
NewTextColor(Blink+Red);
Write('Press any key to continue!');
NewTextColor(White);
AnsiGotoXY(1,80);
Gbx := GetInput;
SetupScreen;
End;
{========================================================================}
{========================================================================}
Function EditLine(LineToEdit : MAXSTRING; MaxLength, Row, Col : Byte) : MAXSTRING;
Var
Elc : Char;
Elb : Byte;
OverWrite : Boolean;
CharacterPosition, OffSet : Byte;
Begin
CharacterPosition := 1; OverWrite := True; AnsiGotoXY(Row,1+Col);
OffSet := 0;
Repeat
Repeat
Elb := GetInput;
If Elb = 0 Then
Begin
Elb := GetInput;
Case Elb Of
71 : Elc := chr(23);
75 : Elc := chr(19);
77 : Elc := chr(4);
79 : Elc := chr(18);
82 : Elc := chr(22);
83 : Elc := chr(7);
Else
Elc := chr(0);
End;
End
Else
Begin
Elc := (Elb::Char);
End;
Until Elc In [chr(1),chr(3),chr(4),chr(6),chr(7),chr(8),chr(12),chr(13),chr(17),chr(18),chr(19),chr(21),chr(22),chr(23),' '..'~'];
Case Elc Of
chr(1) : Begin(* Move left to previous word *)
If CharacterPosition > 2 Then
Begin
CharacterPosition:=CharacterPosition-1;
While (LineToEdit[CharacterPosition] = ' ') And (CharacterPosition > 1) Do CharacterPosition:=CharacterPosition-1;
End;
While (LineToEdit[CharacterPosition] <> ' ') And (CharacterPosition > 1) Do CharacterPosition:=CharacterPosition-1;
If LineToEdit[CharacterPosition] = ' ' Then CharacterPosition:=CharacterPosition+1;
While (CharacterPosition-OffSet) < 1 Do OffSet:=OffSet-1;
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet+1,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
chr(3) : Begin(* UpperCase first character *)
LineToEdit := CapFirst(LineToEdit);
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet+1,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
chr(4) : Begin(* Move right one character *)
If CharacterPosition <= Length(LineToEdit) Then
Begin
CharacterPosition:=CharacterPosition+1;
If (CharacterPosition-(OffSet+1)) > 79 Then
Begin
OffSet:=OffSet+1;
AnsiGotoXY(Row,1+Col);
Write(Copy(LineToEdit,OffSet+1,79));
End;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
chr(6) : Begin(* Move right to next word *)
While (LineToEdit[CharacterPosition] <> ' ') And (CharacterPosition <= Length(LineToEdit)) Do
Begin
CharacterPosition:=CharacterPosition+1;
End;
While (LineToEdit[CharacterPosition] = ' ') And (CharacterPosition <= Length(LineToEdit)) Do
Begin
CharacterPosition:=CharacterPosition+1;
End;
AnsiGotoXY(Row,CharacterPosition+Col);
While (CharacterPosition-OffSet) > 79 Do OffSet:=OffSet+1;
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet+1,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
chr(7) : Begin(* Delete character under cursor *)
If CharacterPosition <= Length(LineToEdit) Then
Begin
Delete(LineToEdit,CharacterPosition,1);
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet+1,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
chr(8) : Begin(* Delete character to left of cursor *)
If CharacterPosition > 1 Then
Begin
CharacterPosition:=CharacterPosition-1;
Delete(LineToEdit,CharacterPosition,1);
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet+1,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
chr(12) : Begin(* LowerCase entire line *)
LineToEdit := LowerString(LineToEdit);
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet+1,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
chr(18) : Begin(* Move to end of line *)
CharacterPosition := Length(LineToEdit)+1;
While Copy(LineToEdit,CharacterPosition,1) = ' ' Do Delete(LineToEdit,CharacterPosition,1);
If CharacterPosition > 79 Then
Begin
OffSet := CharacterPosition-79;
End
Else
Begin
OffSet := 0;
End;
If OffSet > 0 Then
Begin
AnsiGotoXY(Row,1);
Write(Copy(LineToEdit,OffSet+1,79)+' ');
End;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
chr(19) : Begin(* Move left one character *)
If CharacterPosition > 1 Then
Begin
CharacterPosition:=CharacterPosition-1;
If (CharacterPosition-OffSet) < 1 Then
Begin
OffSet:=OffSet-1;
AnsiGotoXY(Row,1);
Write(Copy(LineToEdit,OffSet+1,79));
End;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
chr(21) : Begin(* UpperCase entire line *)
LineToEdit := UpperString(LineToEdit);
AnsiGotoXY(Row,1+Col);
AnsiClearToEOL;
Write(Copy(LineToEdit,OffSet,79));
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
chr(22) : Begin(* Toggle insert and overwrite *)
If OverWrite Then
Begin
OverWrite := False;
AnsiGotoXY(24,1);
NewTextColor(Black);
NewTextBackground(Cyan);
Write('Insert ');
AnsiGotoXY(Row,1+Col);
NewTextColor(White);
NewTextBackground(Black);
If CurrentEntry^.TypeOfRecord = Comment Then NewTextColor(White) Else NewTextColor(Cyan);
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End
Else
Begin
OverWrite := True;
AnsiGotoXY(24,1);
NewTextColor(Black);
NewTextBackground(Cyan);
Write('OverWrite');
AnsiGotoXY(Row,1+Col);
NewTextColor(White);
NewTextBackground(Black);
If CurrentEntry^.TypeOfRecord = Comment Then NewTextColor(White) Else NewTextColor(Cyan);
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
chr(23) : Begin(* Move to begining of line *)
CharacterPosition := 1;
If OffSet > 0 Then
Begin
OffSet := 0;
AnsiGotoXY(Row,1);
Write(Copy(LineToEdit,1,79));
End;
AnsiGotoXY(Row,CharacterPosition+Col);
End;
Else
If Elc <> chr(13) Then
Begin
If Elc = chr(17) Then
Begin
AnsiGotoXY(24,1);
NewTextColor(Black);
NewTextBackground(Cyan);
Write('Quoting ');
AnsiGotoXY(Row,1+Col);
NewTextColor(White);
NewTextBackground(Black);
If CurrentEntry^.TypeOfRecord = Comment Then NewTextColor(White) Else NewTextColor(Cyan);
Elb := GetInput;
Elc := (Elb::Char);
AnsiGotoXY(24,1);
NewTextColor(Black);
NewTextBackground(Cyan);
If OverWrite Then Write('OverWrite') Else Write('Insert ');
AnsiGotoXY(Row,1+Col);
NewTextColor(White);
NewTextBackground(Black);
If CurrentEntry^.TypeOfRecord = Comment Then NewTextColor(White) Else NewTextColor(Cyan);
End;
If OverWrite Then
Begin
If CharacterPosition <= Length(LineToEdit) Then
Begin
LineToEdit[CharacterPosition] := Elc;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
If (CharacterPosition-(OffSet+1)) < 79 Then Write(Elc);
CharacterPosition:=CharacterPosition+1;
If (CharacterPosition-(OffSet+1)) > 79 Then
Begin
OffSet:=OffSet+1;
AnsiGotoXY(Row,1);
Write(Copy(LineToEdit,OffSet+1,79));
End;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End
Else
Begin
If Length(LineToEdit) < MaxLength Then
Begin
LineToEdit := LineToEdit + Elc;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
If (CharacterPosition-(OffSet+1)) < 79 Then Write(Elc);
CharacterPosition:=CharacterPosition+1;
If (CharacterPosition-(OffSet+1)) > 79 Then
Begin
OffSet:=OffSet+1;
AnsiGotoXY(Row,1);
Write(Copy(LineToEdit,OffSet+1,79));
End;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
End
Else
Begin
If Length(LineToEdit) < MaxLength Then
Begin
LineToEdit := Copy(LineToEdit,1,CharacterPosition-1)+Elc+Copy(LineToEdit,CharacterPosition,Length(LineToEdit));
AnsiGotoXY(Row,1+Col); Write(Copy(LineToEdit,OffSet+1,79)); CharacterPosition:=CharacterPosition+1;
AnsiGotoXY(Row,(CharacterPosition+Col)-OffSet);
End;
End;
End;
End;
Until Elc = chr(13);
EditLine := LineToEdit;
End;
{========================================================================}
Procedure EditDescriptionLine;
Var
MaxLength : Byte;
Begin
If CurrentEntry^.TypeOfRecord = Comment Then MaxLength := 79 Else MaxLength := 141;
CurrentEntry^.Description := EditLine(CurrentEntry^.Description,MaxLength,25,0);
End;
{========================================================================}
Procedure EditDescription;
Var
edc : Char;
Begin
If CurrentEntry^.TypeOfRecord <> Orphan Then
Begin
Altered := True;
AnsiGotoXY(24,1); NewTextColor(Black); NewTextBackground(Cyan);
Write('OverWrite ^w/^a/^s Left ^d/^f/^r Right ^h/^g Del ^v Toggle Insert ');
AnsiGotoXY(25,1); NewTextBackground(Black);
If CurrentEntry^.TypeOfRecord = Comment Then NewTextColor(White) Else NewTextColor(Cyan);
AnsiClearToEOL; Write(Copy(CurrentEntry^.Description,1,79));
EditDescriptionLine;
AnsiGotoXY(25,1); AnsiClearToEOL;
If CurrentEntry^.TypeOfRecord = Comment Then
Begin
NewTextColor(White);
AnsiGotoXY(Row,2); AnsiClearToEOL;
Write(CurrentEntry^.Description);
End
Else
Begin
NewTextColor(Cyan);
AnsiGotoXY(Row,33); AnsiClearToEOL;
Write(Copy(CurrentEntry^.Description,1,48));
End;
AnsiGotoXY(24,1);
NewTextColor(Black);
NewTextBackground(Cyan);
Write(Pgmid+' ^Q=quit ?=help');
NewTextColor(White);
NewTextBackground(Black);
AnsiGotoXY(24,80);
End;
End;
{========================================================================}
{========================================================================}
Procedure AdoptAbandon(Display : Byte);
Begin
Altered := True;
Case CurrentEntry^.TypeOfRecord Of
Orphan :
Begin
CurrentEntry^.TypeOfRecord := FileRecord;
NextPrintEntry := CurrentEntry;
If Display = 1 Then
Begin
DisplayRecord(Row); DisplayCurrentLocation;
End;
End;
FileRecord :
Begin
CurrentEntry^.TypeOfRecord := Orphan;
NextPrintEntry := CurrentEntry;
DisplayRecord(Row); DisplayCurrentLocation;
End;
Comment :
Begin
CurrentEntry^.TypeOfRecord := Offline;
CurrentEntry^.Description := LtrimRtrim(CurrentEntry^.Description);
CurrentEntry^.FileName :=
Copy(CurrentEntry^.Description,1,
Pos(' ',CurrentEntry^.Description)-1);
CurrentEntry^.Description := Copy(CurrentEntry^.Description,Pos(' ',CurrentEntry^.Description)+1,79);
NextPrintEntry := CurrentEntry;
DisplayRecord(Row); DisplayCurrentLocation;
End;
Offline :
Begin
CurrentEntry^.TypeOfRecord := Comment;
CurrentEntry^.Description :=
CurrentEntry^.FileName+' '+CurrentEntry^.Description;
CurrentEntry^.FileName := '';
NextPrintEntry := CurrentEntry;
DisplayRecord(Row); DisplayCurrentLocation;
End;
Else End;
End;
{========================================================================}
Procedure AdoptAllOrphans;
Begin
OldEntry := CurrentEntry;
CurrentEntry := FirstEntry;
Repeat
If (CurrentEntry^.FileName <> 'FILES.BBS') And
(CurrentEntry^.FileName <> 'FILES.BAK') And
(CurrentEntry^.TypeOfRecord = Orphan) Then AdoptAbandon(0);
CurrentEntry := CurrentEntry^.NextEntry;
Until CurrentEntry = NIL;
CurrentEntry := OldEntry;
DisplayScreen;
End;
{========================================================================}
Procedure InsertBlank;
Begin
If MaxAvail > Size(ListRecord) Then
Begin
Altered := True;
New(NewEntry);
NewEntry^.PrevEntry := CurrentEntry^.PrevEntry;
NewEntry^.NextEntry := CurrentEntry;
CurrentEntry^.PrevEntry^.NextEntry := NewEntry;
CurrentEntry^.PrevEntry := NewEntry;
If CurrentEntry = TopEntry Then TopEntry := NewEntry;
If CurrentEntry = FirstEntry Then FirstEntry := NewEntry;
CurrentEntry := NewEntry;
CurrentEntry^.TypeOfRecord := Comment;
CurrentEntry^.Description := ' ';
CurrentEntry^.Tagged := False;
NumberOfEntries:=NumberOfEntries+1;
DisplayScreen;
End;
End;
{========================================================================}
{========================================================================}
Procedure PushRecord(Var TempEntry : ListPtr);
Begin
If (CurrentEntry^.PrevEntry <> NIL) Or (CurrentEntry^.NextEntry <> NIL) Then
Begin
If CurrentEntry^.FileName <> 'FILES.BBS' Then
Begin
If CurrentEntry^.TypeOfRecord In [Orphan,FileRecord] Then NumberOfFiles:=NumberOfFiles-1;
SizeOfFiles := SizeOfFiles-CurrentEntry^.FileSize;
End;
Altered := True;
OldEntry := CurrentEntry;
If CurrentEntry^.PrevEntry = NIL Then
Begin
CurrentEntry^.NextEntry^.PrevEntry := NIL;
CurrentEntry := CurrentEntry^.NextEntry;
TopEntry := CurrentEntry;
FirstEntry := CurrentEntry;
End
Else
Begin
If CurrentEntry^.NextEntry = NIL Then
Begin
CurrentEntry^.PrevEntry^.NextEntry := NIL;
CurrentEntry := CurrentEntry^.PrevEntry;
LastEntry := CurrentEntry;
If TopEntry^.PrevEntry <> NIL Then
Begin
TopEntry := TopEntry^.PrevEntry;
End
Else
Begin
Row:=Row-1;
End;
End
Else
Begin
CurrentEntry^.PrevEntry^.NextEntry := CurrentEntry^.NextEntry;
CurrentEntry^.NextEntry^.PrevEntry := CurrentEntry^.PrevEntry;
CurrentEntry := CurrentEntry^.NextEntry;
If TopEntry = OldEntry Then TopEntry := CurrentEntry;
End;
End;
If TempEntry = NIL Then
Begin
TempEntry := OldEntry;
TempEntry^.PrevEntry := TempEntry;
TempEntry^.NextEntry := TempEntry;
End
Else
Begin
If TempEntry^.PrevEntry = TempEntry Then
Begin
OldEntry^.PrevEntry := TempEntry;
OldEntry^.NextEntry := TempEntry;
TempEntry^.PrevEntry := OldEntry;
TempEntry^.NextEntry := OldEntry;
TempEntry := OldEntry;
End
Else
Begin
OldEntry^.PrevEntry := TempEntry;
OldEntry^.NextEntry := TempEntry^.NextEntry;
TempEntry^.NextEntry^.PrevEntry := OldEntry;
TempEntry^.NextEntry := OldEntry;
TempEntry := OldEntry;
End;
End;
NumberOfEntries:=NumberOfEntries-1;
DisplayScreen;
End;
End;
{========================================================================}
Procedure PopRecord(Var TempEntry : ListPtr; BeforeOrAfter : Char);
Begin
If TempEntry <> NIL Then
Begin
If TempEntry^.FileName <> 'FILES.BBS' Then
Begin
If TempEntry^.TypeOfRecord In [Orphan,FileRecord] Then NumberOfFiles:=NumberOfFiles+1;
SizeOfFiles := SizeOfFiles+TempEntry^.FileSize;
End;
OldEntry := TempEntry;
If TempEntry^.PrevEntry = TempEntry Then
Begin
TempEntry := NIL;
End
Else
Begin
TempEntry^.PrevEntry^.NextEntry := TempEntry^.NextEntry;
TempEntry^.NextEntry^.PrevEntry := TempEntry^.PrevEntry;
TempEntry := TempEntry^.PrevEntry;
End;
If BeforeOrAfter = 'B' Then
Begin
If CurrentEntry^.PrevEntry = NIL Then
Begin
OldEntry^.PrevEntry := CurrentEntry^.PrevEntry;
OldEntry^.NextEntry := CurrentEntry;
CurrentEntry^.PrevEntry := OldEntry;
CurrentEntry := OldEntry;
TopEntry := CurrentEntry;
FirstEntry := CurrentEntry;
End
Else
Begin
OldEntry^.PrevEntry := CurrentEntry^.PrevEntry;
OldEntry^.NextEntry := CurrentEntry;
CurrentEntry^.PrevEntry^.NextEntry := OldEntry;
CurrentEntry^.PrevEntry := OldEntry;
CurrentEntry := OldEntry;
End;
End
Else
Begin
If CurrentEntry^.NextEntry = NIL Then
Begin
OldEntry^.NextEntry := CurrentEntry^.NextEntry;
OldEntry^.PrevEntry := CurrentEntry;
CurrentEntry^.NextEntry := OldEntry;
End
Else
Begin
OldEntry^.NextEntry := CurrentEntry^.NextEntry;
OldEntry^.PrevEntry := CurrentEntry;
CurrentEntry^.NextEntry^.PrevEntry := OldEntry;
CurrentEntry^.NextEntry := OldEntry;
End;
End;
NumberOfEntries:=NumberOfEntries+1;
DisplayScreen;
End;
End;
{========================================================================}
Procedure ShowStack(Var TempEntry : ListPtr);
Begin
If TempEntry <> NIL Then
Begin
NextPrintEntry := TempEntry;
DisplayRecord(25);
AnsiGotoXY(24,80);
End;
End;
{========================================================================}
Procedure StackPrev(Var TempEntry : ListPtr);
Begin
If TempEntry <> NIL Then
Begin
TempEntry := TempEntry^.PrevEntry;
ShowStack(TempEntry);
End;
End;
{========================================================================}
Procedure StackNext(Var TempEntry : ListPtr);
Begin
If TempEntry <> NIL Then
Begin
TempEntry := TempEntry^.NextEntry;
ShowStack(TempEntry);
End;
End;
{========================================================================}
{========================================================================}
Function SizeOfFilesBbs(FileArea : MAXSTRING) : Integer;
Var
FilesBbs : File Of Byte;
SizeOfFile : Integer;
Begin
Assign(FilesBbs,FileArea+'FILES.BBS');
{$I-}
IOcheck := FALSE;
Reset(FilesBbs);
{$I+}
IOcheck := TRUE;
If IOresult = 0 Then
Begin
SizeOfFilesBbs := FileSize(FilesBbs);
Close(FilesBbs);
End
Else
Begin
SizeOfFilesBbs := 0;
End;
End;
{========================================================================}
Function InMainList(TempEntry : ListPtr) : Boolean;
Begin
NextPrintEntry := FirstEntry; InMainList := False;
While NextPrintEntry^.NextEntry <> NIL Do
Begin
If NextPrintEntry^.FileName = TempEntry^.FileName Then InMainList := True;
NextPrintEntry := NextPrintEntry^.NextEntry;
End;
End;
{========================================================================}
Procedure EraseKillList;
Var
FileToErase : FILE OF char;
Begin
While KillEntry <> NIL Do
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(FileAreaPath+KillEntry^.FileName,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
If (Not InMainList(KillEntry)) Then
Begin
If UpperString(KillEntry^.FileName) <> 'FILES.BBS' Then
Begin
Assign(FileToErase,FileAreaPath+KillEntry^.FileName);
Erase(FileToErase);
End;
End;
End;
OldEntry := KillEntry;
If KillEntry^.PrevEntry = KillEntry Then
Begin
Dispose(KillEntry);
KillEntry := NIL;
End
Else
Begin
KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
KillEntry := KillEntry^.NextEntry;
End;
If KillEntry <> NIL Then Dispose(OldEntry);
End;
End;
{========================================================================}
Procedure Mfm2Bbs2Bak(InString : PathStr);
Var
TmpFilVar : Text;
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(InString+'FILES.BAK',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Assign(TmpFilVar,InString+'FILES.BAK');
Erase(TmpFilVar);
End;
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(InString+'FILES.BBS',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Assign(TmpFilVar,InString+'FILES.BBS');
Rename(TmpFilVar,InString+'FILES.BAK');
End;
Assign(TmpFilVar,InString+'FILES.MFM');
Rename(TmpFilVar,InString+'FILES.BBS');
End;
{========================================================================}
Procedure SaveList;
Var
Slc : Char;
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('This will DELETE killed files and update FILES.BBS, Are you sure? ');
Repeat
Gbx := GetInput;
Slc := UpCase(chr(Gbx));
Until Slc In ['N','Y'];
Write(Slc);
If Slc = 'Y' Then
Begin
Assign(FileList,FileAreaPath+'FILES.MFM');
{$I-}
IOcheck := FALSE;
ReWrite(FileList);
{$I+}
IOcheck := TRUE;
If IOresult = 0 Then
Begin
NextPrintEntry := FirstEntry;
While NextPrintEntry^.NextEntry <> NIL Do
Begin
If NextPrintEntry^.TypeOfRecord <> Orphan Then
Begin
If NextPrintEntry^.TypeOfRecord <> Comment Then
Begin
Write(FileList,NextPrintEntry^.FileName);
Write(FileList,
Copy(' ',1,13-Length(NextPrintEntry^.FileName))+' ');
End;
WriteLn(FileList,NextPrintEntry^.Description);
End;
NextPrintEntry := NextPrintEntry^.NextEntry;
End;
If NextPrintEntry^.TypeOfRecord <> Orphan Then
Begin
Write(FileList,NextPrintEntry^.FileName);
Write(FileList,' ');
WriteLn(FileList,NextPrintEntry^.Description);
End;
Close(FileList);
Mfm2Bbs2Bak(FileAreaPath);
EraseKillList;
AnsiGotoXY(25,1); AnsiClearToEOL;
End;
Altered := False;
End
Else Write('N');
AnsiGotoXY(24,80);
End;
{========================================================================}
{========================================================================}
Procedure Quit;
Var Qc : Char;
LABEL 1;
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Are you sure? ');
Repeat
Gbx := GetInput;
Qc := UpCase(chr(Gbx));
Until Qc In ['N','Y'];
Write(Qc);
If Qc = 'N' Then
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
GOTO 1;
End;
If Altered Then
Begin
SaveList;
End;
NewTextColor(White); NewTextBackground(Black);
AnsiClearScreen;
dos.exit(EXIT_PROCESS,0);
{ ABORT(0); }
1:
End;
{========================================================================}
Procedure ChangeFileDate;
Var
Cdc : Char;
Year, Month, Day, DayOfWeek, Hour, Minute, Second, Sec100 : Word;
FileToDate : FILE OF char;
DateTimeString : String[17];
Begin
If CurrentEntry^.TypeOfRecord = FileRecord Then
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Change date to current, special or abort? (C/S/A) ');
Repeat
Gbx := GetInput;
Cdc := Upcase(chr(Gbx));
Until Cdc In ['C','S','A'];
Write(Cdc);
If Cdc In ['C','S'] Then
Begin
Case Cdc Of
'C' : Begin
GetDate(Year, Month, Day, DayOfWeek);
GetTime(Hour, Minute, Second, Sec100);
Date.Year := Year; Date.Month := Month; Date.Day := Day;
Date.Hour := Hour; Date.Min := Minute; Date.Sec := Second;
PackTime(Date, CurrentEntry^.FileDate);
End;
'S' : Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
DateTimeString := GetDateString(CurrentEntry^.FileDate)+' '+GetTimeString(CurrentEntry^.FileDate);
Write(DateTimeString);
DateTimeString := EditLine(DateTimeString,17,25,0);
AnsiGotoXY(25,40); Write(DateTimeString);
CurrentEntry^.FileDate := GetPackedTime(Copy(DateTimeString,1,8),Copy(DateTimeString,10,8));
End;
Else End;
Assign(FileToDate,FileAreaPath+CurrentEntry^.FileName);
Reset(FileToDate);
SetFTime(FileToDate,CurrentEntry^.FileDate);
Close(FileToDate);
NextPrintEntry := CurrentEntry;
DisplayRecord(Row); DisplayCurrentLocation;
End;
AnsiGotoXY(24,80);
End;
End;
{========================================================================}
{========================================================================}
Procedure GetAreaTable;
Var
AreaRecordNumber : Word;
MaxAreaRecord : AreaRecordType;
Begin
NumberOfAreaEntries := 0; AreaRecordNumber := 1;
OpenMaximusArea;
While GetMaximusArea(AreaRecordNumber,StructLen,MaxAreaRecord) = 0 Do
Begin
OkToAddToList := False;
AreaRecordNumber:=AreaRecordNumber+1;
WorkString := Array2String(ADR(MaxAreaRecord.FilePath),Size(MaxAreaRecord.FilePath));
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(WorkString+'*.*',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
OkToAddToList := True;
End
Else
Begin
If retn <> 3 Then
Begin
Assign(FileList,WorkString+'FILES.BBS');
{$I-}
IOcheck := FALSE;
ReWrite(FileList);
{$I+}
IOcheck := TRUE;
If IOresult = 0 Then
Begin
Close(FileList);
OkToAddToList := True;
End;
End;
End;
If (Length(WorkString) = 0) or (retn = 3) Then OkToAddToList := False;
If OkToAddToList Then
Begin
NumberOfAreaEntries:=NumberOfAreaEntries+1;
If MaxAvail > Size(ListRecord) Then
Begin
New(NewAreaEntry);
If NumberOfAreaEntries = 1 Then
Begin
FirstAreaEntry := NewAreaEntry;
NewAreaEntry^.PrevEntry := NIL;
OldAreaEntry := FirstAreaEntry;
End
Else
Begin
NewAreaEntry^.PrevEntry := OldAreaEntry;
OldAreaEntry^.NextEntry := NewAreaEntry;
OldAreaEntry := NewAreaEntry;
End;
NewAreaEntry^.AreaPath := WorkString;
End;
End;
End;
CloseMaximusArea;
If NumberOfAreaEntries = 0 Then
Begin
WriteLn('No areas found!');
dos.exit(EXIT_PROCESS,1);
{ ABORT(1); }
End
Else
Begin
NewAreaEntry^.NextEntry := NIL;
AreaCounter := 1; ChooseAreaEntry := FirstAreaEntry;
End;
End;
{========================================================================}
Procedure DisplayArea(AreaNumber : Byte; TempAreaEntry : AreaPtr);
Var
Row, Col : Byte;
Begin
WorkString := TempAreaEntry^.AreaPath;
Delete(WorkString,Length(WorkString),1);
WorkString := RCopy(WorkString,1,RPos('\',WorkString)-1);
If AreaNumber = 1 Then Row := 1 Else Row := (((AreaNumber-1) Div Columns)+1);
If AreaNumber = 1 Then Col := 1 Else Col := (((AreaNumber-1) Mod Columns)*ColumnPos)+1;
If Col = 1 Then
Begin
AnsiGotoXY(Row,1); AnsiClearToEOL;
End;
AnsiGotoXY(Row,Col);
NewTextColor(LightRed);
Write(' '+WorkString);
NewTextColor(White);
End;
{========================================================================}
Procedure BlankAreaPointer(AreaNumber : Byte);
Var
Row, Col : Byte;
Begin
If AreaNumber = 1 Then Row := 1 Else Row := (((AreaNumber-1) Div Columns)+1);
If AreaNumber = 1 Then Col := 1 Else Col := (((AreaNumber-1) Mod Columns)*ColumnPos)+1;
AnsiGotoXY(Row,Col);
Write(' ');
AnsiGotoXY(24,80);
End;
{========================================================================}
Procedure ShowAreaPointer(AreaNumber : Byte);
Var
Row, Col : Byte;
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(ChooseAreaEntry^.AreaPath);
If AreaNumber = 1 Then Row := 1 Else Row := (((AreaNumber-1) Div Columns)+1);
If AreaNumber = 1 Then Col := 1 Else Col := (((AreaNumber-1) Mod Columns)*ColumnPos)+1;
AnsiGotoXY(Row,Col);
Write('>');
AnsiGotoXY(24,80);
End;
{========================================================================}
Procedure DisplayAreaList;
Var
AreaCounter : Byte;
Begin
OldAreaEntry := FirstAreaEntry; AreaCounter := 0;
While OldAreaEntry^.NextEntry <> NIL Do
Begin
AreaCounter:=AreaCounter+1;
DisplayArea(AreaCounter, OldAreaEntry);
OldAreaEntry := OldAreaEntry^.NextEntry;
End;
AreaCounter:=AreaCounter+1;
DisplayArea(AreaCounter, OldAreaEntry);
End;
{========================================================================}
Procedure AddTempArea;
Var
NewAreaName : MAXSTRING;
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Enter new temporary path: ');
NewAreaName := UpperString(EditLine('',40,25,26));
If Length(NewAreaName) > 0 Then
Begin
If Copy(NewAreaName,Length(NewAreaName),1) <> '\' Then NewAreaName := NewAreaName + '\';
OkToAddToList := False;
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(NewAreaName+'*.*',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
OkToAddToList := True;
End
Else
Begin
Assign(FileList,NewAreaName+'FILES.BBS');
{$I-}
IOcheck := FALSE;
ReWrite(FileList);
{$I+}
IOcheck := TRUE;
If IOresult = 0 Then
Begin
Close(FileList);
OkToAddToList := True;
End;
End;
If OkToAddToList Then
Begin
If MaxAvail > Size(ListRecord) Then
Begin
New(NewAreaEntry);
NewAreaEntry^.PrevEntry := OldAreaEntry;
OldAreaEntry^.NextEntry := NewAreaEntry;
OldAreaEntry := NewAreaEntry;
NewAreaEntry^.AreaPath := NewAreaName;
NewAreaEntry^.NextEntry := NIL;
NumberOfAreaEntries:=NumberOfAreaEntries+1;
DisplayAreaList;
ShowAreaPointer(AreaCounter);
End;
End
Else
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Directory '+NewAreaName+' not found!');
End;
End;
End;
{========================================================================}
Procedure MatchMask;
Var
AreaPointer : AreaPtr;
AreaPointerPosition : Byte;
Matched : Boolean;
Begin
Matched := False; AreaPointer := FirstAreaEntry; AreaPointerPosition := 1;
WorkString := AreaPointer^.AreaPath;
Delete(WorkString,Length(WorkString),1);
WorkString := RCopy(WorkString,1,RPos('\',WorkString)-1);
If Pos(AreaMask,UpperString(WorkString)) = 1 Then Matched := True;
While (AreaPointer^.NextEntry <> NIL) And (Not Matched) Do
Begin
AreaPointer := AreaPointer^.NextEntry; AreaPointerPosition:=AreaPointerPosition+1;
WorkString := AreaPointer^.AreaPath;
Delete(WorkString,Length(WorkString),1);
WorkString := RCopy(WorkString,1,RPos('\',WorkString)-1);
If Pos(AreaMask,UpperString(WorkString)) = 1 Then Matched := True;
End;
If Matched Then
Begin
BlankAreaPointer(AreaCounter);
ChooseAreaEntry := AreaPointer;
AreaCounter := AreaPointerPosition;
ShowAreaPointer(AreaCounter);
End
Else
Begin
Delete(AreaMask,Length(AreaMask),1);
End;
End;
{========================================================================}
Function ChooseArea : MAXSTRING;
Var
Cax : Char;
Cab : Byte;
Begin
DisplayAreaList;
ShowAreaPointer(AreaCounter);
AreaMask := '';
Repeat
Gbx := GetInput;
Cax := Upcase(chr(Gbx));
If Gbx = 0 Then
Begin
Gbx := GetInput;
Case Gbx Of
71 : Cax := '7';
72 : Cax := '8';
73 : Cax := '9';
75 : Cax := '4';
77 : Cax := '6';
79 : Cax := '1';
80 : Cax := '2';
81 : Cax := '3';
Else End;
End;
Case Cax Of
'1' : Begin
BlankAreaPointer(AreaCounter);
AreaCounter := (NumberOfAreaEntries - (NumberOfAreaEntries Mod Columns)) + 1;
If AreaCounter > NumberOfAreaEntries Then AreaCounter := NumberOfAreaEntries - (Columns-1);
ChooseAreaEntry := FirstAreaEntry;
For Cab := 1 To AreaCounter-1 Do ChooseAreaEntry := ChooseAreaEntry^.NextEntry;
ShowAreaPointer(AreaCounter);
End;
'2' : Begin
If AreaCounter+Columns <= NumberOfAreaEntries Then
Begin
BlankAreaPointer(AreaCounter);
AreaCounter := AreaCounter + Columns;
For Cab := 1 To Columns Do ChooseAreaEntry := ChooseAreaEntry^.NextEntry;
ShowAreaPointer(AreaCounter);
End;
End;
'3' : Begin
BlankAreaPointer(AreaCounter);
AreaCounter := NumberOfAreaEntries - (NumberOfAreaEntries Mod Columns);
ChooseAreaEntry := FirstAreaEntry;
For Cab := 1 To AreaCounter-1 Do ChooseAreaEntry := ChooseAreaEntry^.NextEntry;
ShowAreaPointer(AreaCounter);
End;
'4' : Begin
If AreaCounter > 1 Then
Begin
ChooseAreaEntry := ChooseAreaEntry^.PrevEntry;
BlankAreaPointer(AreaCounter);
AreaCounter:=AreaCounter-1;
ShowAreaPointer(AreaCounter);
End;
End;
'6' : Begin
If AreaCounter < NumberOfAreaEntries Then
Begin
ChooseAreaEntry := ChooseAreaEntry^.NextEntry;
BlankAreaPointer(AreaCounter);
AreaCounter:=AreaCounter+1;
ShowAreaPointer(AreaCounter);
End;
End;
'7' : Begin
ChooseAreaEntry := FirstAreaEntry;
BlankAreaPointer(AreaCounter);
AreaCounter := 1;
ShowAreaPointer(AreaCounter);
End;
'8' : Begin
If AreaCounter-Columns > 0 Then
Begin
BlankAreaPointer(AreaCounter);
AreaCounter := AreaCounter - Columns;
For Cab := 1 To Columns Do ChooseAreaEntry := ChooseAreaEntry^.PrevEntry;
ShowAreaPointer(AreaCounter);
End;
End;
'9' : Begin
BlankAreaPointer(AreaCounter);
AreaCounter := Columns;
ChooseAreaEntry := FirstAreaEntry;
For Cab := 1 To Columns-1 Do ChooseAreaEntry := ChooseAreaEntry^.NextEntry;
ShowAreaPointer(AreaCounter);
End;
chr(9) : AddTempArea;
'?' : Begin
AreaHelp;
DisplayAreaList;
ShowAreaPointer(AreaCounter);
End;
Else
If Cax = chr(8) Then
Begin
Delete(AreaMask,Length(AreaMask),1);
MatchMask
End;
If Cax In [':','A'..'Z','a'..'z'] Then
Begin
AreaMask := AreaMask + Cax;
MatchMask
End;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(AreaMask);
End;
Until Cax In [chr(13),chr(17),chr(27)];
If Cax In [chr(17),chr(27)] Then
Begin
If Cax = chr(17) Then
Begin
ChooseArea := 'QUITQUICK';
End
Else
Begin
ChooseArea := 'QUIT';
End;
End
Else
Begin
ChooseArea := ChooseAreaEntry^.AreaPath;
End;
End;
{========================================================================}
Procedure ChooseNewArea;
Var
TempArea : MAXSTRING;
Begin
If Altered Then
Begin
SaveList;
Altered := False;
End;
BeginSort := NIL; EndSort := NIL;
NextPrintEntry := FirstEntry;
If NumberOfEntries > 0 Then
Begin
While NextPrintEntry^.NextEntry <> NIL Do
Begin
NextPrintEntry := NextPrintEntry^.NextEntry;
Dispose(NextPrintEntry^.PrevEntry);
End;
Dispose(NextPrintEntry);
End;
SetupScreen;
Repeat
TempArea := ChooseArea;
If TempArea = 'QUITQUICK' Then
Begin
dos.exit(EXIT_PROCESS,1);
{ ABORT(1); }
End;
If TempArea <> 'QUIT' Then
Begin
FileAreaPath := TempArea;
End;
NumberOfEntries := 0; BuildList;
If NumberOfEntries = 0 Then
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('This area contains no files!');
End;
Until (NumberOfEntries > 0) Or (TempArea = 'QUIT');
If NumberOfEntries > 0 Then
Begin
If TempArea <> 'QUIT' Then
Begin
Row := 1;
CurrentEntry := FirstEntry;
TopEntry := FirstEntry;
End;
DisplayScreen;
End;
End;
{========================================================================}
{========================================================================}
Procedure CenterWrite(Row : Byte; CenteredString : MAXSTRING);
Begin
AnsiGotoXY(Row,1); AnsiClearToEOL;
AnsiGotoXY(Row,40-(Length(CenteredString) Div 2));
Write(CenteredString);
End;
{========================================================================}
Function FileCopy(FromFileName, ToFileName : MAXSTRING; CopyOrMove : Char) : Boolean;
Var
FromFile, ToFile : FILE OF char;
OverWrite : Boolean;
Fcc : Char;
TempEntry : ListPtr;
ToFilesBbs : Text;
Begin
FileCopy := False; OverWrite := True;
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(FromFileName,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(ToFileName,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
OverWrite := False;
AnsiClearScreen; AnsiGotoXY(21,1);
NewTextColor(Black); NewTextBackground(Cyan);
Write(Pgmid+' ^Q=quit ?=help');
NewTextColor(White); NewTextBackground(Black);
NextPrintEntry := CurrentEntry; DisplayRecord(22);
NewTextColor(White);
CenterWrite(23,'already exists as');
New(TempEntry);
TempEntry^.TypeOfRecord := FileRecord;
tfname := array2string(ADR(dirinfo.name),dirinfo.cname);
TempEntry^.FileName := tfname;
TempEntry^.FileDate := DirInfo.fdatelastwrite;
TempEntry^.FileDate := TempEntry^.FileDate << 16;
TempEntry^.FileDate := TempEntry^.FileDate + DirInfo.ftimelastwrite;
TempEntry^.FileSize := DirInfo.fileSize;
Fsplit(ToFileName,D,N,E);
Assign(ToFilesBbs,D+'FILES.BBS');
{$I-}
IOcheck := FALSE;
Reset(ToFilesBbs);
{$I+}
IOcheck := TRUE;
If IOresult = 0 Then
Begin
While (Not Eof(ToFilesBbs)) Do
Begin
ReadLn(ToFilesBbs,WorkString);
If Pos(N+E,WorkString) > 0 Then
Begin
TempEntry^.Description := Copy(WorkString,Pos(' ',WorkString)+1,Length(WorkString)-Pos(' ',WorkString));
End;
End;
Close(ToFilesBbs);
End
Else
Begin
TempEntry^.Description := '';
End;
TempEntry^.Tagged := False;
NextPrintEntry := TempEntry; DisplayRecord(24);
Dispose(TempEntry);
NewTextColor(White);
CenterWrite(25,'Overwrite? (Y/N) ');
Repeat
Gbx := GetInput;
Fcc := Upcase(chr(Gbx));
Until Fcc In ['N','Y'];
Write(Fcc);
If Fcc = 'Y' Then OverWrite := True;
End;
If OverWrite Then
Begin
If (CopyOrMove = 'M') And (Copy(FromFileName,1,1) = Copy(ToFileName,1,1)) Then
Begin
CenterWrite(22,'Moving');
CenterWrite(23,FromFileName);
CenterWrite(24,'to');
CenterWrite(25,ToFileName);
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(ToFileName,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Assign(ToFile,ToFileName);
Erase(ToFile);
End;
Assign(FromFile,FromFileName);
Rename(FromFile,ToFileName);
End
Else
Begin
If CopyOrMove = 'C' Then CenterWrite(22,'Copying ') Else CenterWrite(22,'Moving ');
CenterWrite(23,FromFileName);
CenterWrite(24,'to');
CenterWrite(25,ToFileName);
DoFileCopy(FromFileName,ToFileName);
Assign(FromFile,FromFileName);
If CopyOrMove = 'M' Then Erase(FromFile);
End;
FileCopy := True;
End;
End;
End;
{========================================================================}
Procedure ShowSizeSpace(Drive : Char; Row : Byte);
Begin
Drive := Upcase(Drive);
AnsiGotoXY(Row,1);
NewTextColor(Black);
NewTextBackground(Cyan);
AnsiClearToEOL;
Write(CurrentEntry^.FileName+' is ',CurrentEntry^.FileSize Div 1024,'K bytes in size! There are ');
Write(DiskFree(Ord(Drive)-64) Div 1024);
Write('K bytes free on drive '+Drive+'.');
NewTextColor(White); NewTextBackground(Black);
End;
{========================================================================}
Procedure CopyFile;
Var
ToAreaPath : String[80];
Cfc : Char;
Begin
If CurrentEntry^.TypeOfRecord = FileRecord Then
Begin
SetupScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(FileAreaPath+CurrentEntry^.FileName);
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If CurrentEntry^.FileSize < (DiskFree(Ord(Upcase(ToAreaPath[1]))-64)-(SizeOfFilesBbs(ToAreaPath)+2048)) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
CenterWrite(23,'to');
CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
CenterWrite(25,'Proceed with COPY? (Y/N) ');
Repeat
Gbx := GetInput;
Cfc := Upcase(chr(Gbx));
Until Cfc In ['N','Y'];
Write(Cfc);
If Cfc = 'Y' Then
Begin
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(ToAreaPath+'FILES.BBS',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.MFM');
ReWrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Mfm2Bbs2Bak(ToAreaPath);
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.MFM');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
Mfm2Bbs2Bak(ToAreaPath);
End;
End;
End;
ReDrawScreen;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
End;
End
Else ReDrawScreen;
End;
End;
{========================================================================}
Procedure MoveFile;
Var
ToAreaPath : String[80];
Mfc : Char;
FileToErase : FILE OF char;
Begin
If CurrentEntry^.TypeOfRecord = FileRecord Then
Begin
SetupScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(FileAreaPath+CurrentEntry^.FileName);
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If (CurrentEntry^.FileSize < (DiskFree(Ord(Upcase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
Or (FileAreaPath[1] = ToAreaPath[1]) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
CenterWrite(23,'to');
CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
CenterWrite(25,'Proceed with MOVE? (Y/N) ');
Repeat
Gbx := GetInput;
Mfc := Upcase(chr(Gbx));
Until Mfc In ['N','Y'];
Write(Mfc);
If Mfc = 'Y' Then
Begin
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(ToAreaPath+'FILES.BBS',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.MFM');
ReWrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Mfm2Bbs2Bak(ToAreaPath);
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.MFM');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
Mfm2Bbs2Bak(ToAreaPath);
End;
PushRecord(KillEntry);
OldEntry := KillEntry;
If KillEntry^.PrevEntry = KillEntry Then
Begin
Dispose(KillEntry);
KillEntry := NIL;
End
Else
Begin
KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
KillEntry := KillEntry^.NextEntry;
End;
If KillEntry <> NIL Then Dispose(OldEntry);
End;
End;
ReDrawScreen;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
End;
End
Else ReDrawScreen;
End;
End;
{========================================================================}
Procedure MassMove;
Var
ToAreaPath : String[80];
TempEntry : ListPtr;
Mmc : Char;
MoveOk : Boolean;
Begin
SetupScreen;
CenterWrite(25,'Select area to MASS MOVE to...');
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
CenterWrite(25,'Proceed with MASS MOVE? (Y/N) ');
Repeat
Gbx := GetInput;
Mmc := Upcase(chr(Gbx));
Until Mmc In ['N','Y'];
Write(Mmc);
If Mmc = 'Y' Then
Begin
TempEntry := CurrentEntry;
CurrentEntry := FirstEntry;
While CurrentEntry^.NextEntry <> NIL Do
Begin
MoveOk := False;
If CurrentEntry^.Tagged Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If (CurrentEntry^.FileSize < (DiskFree(Ord(Upcase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
Or (FileAreaPath[1] = ToAreaPath[1]) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(ToAreaPath+'FILES.BBS',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.MFM');
ReWrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Mfm2Bbs2Bak(ToAreaPath);
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.MFM');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
Mfm2Bbs2Bak(ToAreaPath);
End;
MoveOk := True;
PushRecord(KillEntry);
OldEntry := KillEntry;
If KillEntry^.PrevEntry = KillEntry Then
Begin
Dispose(KillEntry);
KillEntry := NIL;
End
Else
Begin
KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
KillEntry := KillEntry^.NextEntry;
End;
If KillEntry <> NIL Then Dispose(OldEntry);
End;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
End;
End;
If (Not MoveOk) Then CurrentEntry := CurrentEntry^.NextEntry;
End;
End;
End;
CurrentEntry := TopEntry; Row := 1;
SetupScreen; DisplayScreen;
End;
{========================================================================}
Procedure MassCopy;
Var
ToAreaPath : String[80];
TempEntry : ListPtr;
Mcc : Char;
CopyOk : Boolean;
Begin
SetupScreen;
CenterWrite(25,'Select area to MASS COPY to...');
ToAreaPath := ChooseArea;
If ToAreaPath <> 'QUIT' Then
Begin
CenterWrite(25,'Proceed with MASS COPY? (Y/N) ');
Repeat
Gbx := GetInput;
Mcc := Upcase(chr(Gbx));
Until Mcc In ['N','Y'];
Write(Mcc);
If Mcc = 'Y' Then
Begin
TempEntry := CurrentEntry;
CurrentEntry := FirstEntry;
While CurrentEntry^.NextEntry <> NIL Do
Begin
CopyOk := False;
If CurrentEntry^.Tagged Then
Begin
ShowSizeSpace(ToAreaPath[1],24);
If (CurrentEntry^.FileSize < (DiskFree(Ord(Upcase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
Or (FileAreaPath[1] = ToAreaPath[1]) Then
Begin
ShowSizeSpace(ToAreaPath[1],21);
If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(ToAreaPath+'FILES.BBS',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Changed := False;
Assign(FileList,ToAreaPath+'FILES.BBS');
Reset(FileList);
Assign(NewFileList,ToAreaPath+'FILES.MFM');
ReWrite(NewFileList);
While (Not Eof(FileList)) Do
Begin
ReadLn(FileList,WorkString);
If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
Begin
WriteLn(NewFileList,WorkString);
End
Else
Begin
WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Changed := True;
End;
End;
If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList); Close(NewFileList);
Mfm2Bbs2Bak(ToAreaPath);
End
Else
Begin
Assign(FileList,ToAreaPath+'FILES.MFM');
ReWrite(FileList);
WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
Close(FileList);
Mfm2Bbs2Bak(ToAreaPath);
End;
CopyOk := True;
End;
End
Else
Begin
ReDrawScreen;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
End;
End;
CurrentEntry^.Tagged := False;
If (Not CopyOk) Then CurrentEntry := CurrentEntry^.NextEntry;
End;
End;
End;
CurrentEntry := TopEntry; Row := 1;
SetupScreen; DisplayScreen;
End;
{========================================================================}
{========================================================================}
Procedure SortList;
Var
TempSort : ListPtr;
SortNext, SortPrev, Exchange : Boolean;
Begin
If (BeginSort <> NIL) And (EndSort <> NIL) And (BeginSort <> EndSort) Then
Begin
SortNext := False; SortPrev := False; Altered := True;
If MaxAvail > Size(ListRecord) Then
Begin
New(TempSort);
NextPrintEntry := BeginSort;
While (NextPrintEntry <> EndSort) And (NextPrintEntry <> NIL) Do
Begin
NextPrintEntry := NextPrintEntry^.NextEntry;
If NextPrintEntry = EndSort Then SortNext := True;
End;
NextPrintEntry := BeginSort;
While (NextPrintEntry <> EndSort) And (NextPrintEntry <> NIL) Do
Begin
NextPrintEntry := NextPrintEntry^.PrevEntry;
If NextPrintEntry = EndSort Then SortPrev := True;
End;
If SortNext Then
Begin
Repeat
Exchange := False;
NextPrintEntry := BeginSort;
While NextPrintEntry <> EndSort Do
Begin
If NextPrintEntry^.FileName > NextPrintEntry^.NextEntry^.FileName Then
Begin
TempSort^.TypeOfRecord := NextPrintEntry^.TypeOfRecord;
TempSort^.FileName := NextPrintEntry^.FileName;
TempSort^.FileSize := NextPrintEntry^.FileSize;
TempSort^.FileDate := NextPrintEntry^.FileDate;
TempSort^.Description := NextPrintEntry^.Description;
NextPrintEntry^.TypeOfRecord := NextPrintEntry^.NextEntry^.TypeOfRecord;
NextPrintEntry^.FileName := NextPrintEntry^.NextEntry^.FileName;
NextPrintEntry^.FileSize := NextPrintEntry^.NextEntry^.FileSize;
NextPrintEntry^.FileDate := NextPrintEntry^.NextEntry^.FileDate;
NextPrintEntry^.Description := NextPrintEntry^.NextEntry^.Description;
NextPrintEntry^.NextEntry^.TypeOfRecord := TempSort^.TypeOfRecord;
NextPrintEntry^.NextEntry^.FileName := TempSort^.FileName;
NextPrintEntry^.NextEntry^.FileSize := TempSort^.FileSize;
NextPrintEntry^.NextEntry^.FileDate := TempSort^.FileDate;
NextPrintEntry^.NextEntry^.Description := TempSort^.Description;
Exchange := True;
End;
NextPrintEntry := NextPrintEntry^.NextEntry;
End;
Until (Not Exchange);
DisplayScreen;
End;
If SortPrev Then
Begin
Repeat
Exchange := False;
NextPrintEntry := BeginSort;
While NextPrintEntry <> EndSort Do
Begin
If NextPrintEntry^.FileName > NextPrintEntry^.PrevEntry^.FileName Then
Begin
TempSort^.TypeOfRecord := NextPrintEntry^.TypeOfRecord;
TempSort^.FileName := NextPrintEntry^.FileName;
TempSort^.FileSize := NextPrintEntry^.FileSize;
TempSort^.FileDate := NextPrintEntry^.FileDate;
TempSort^.Description := NextPrintEntry^.Description;
NextPrintEntry^.TypeOfRecord := NextPrintEntry^.PrevEntry^.TypeOfRecord;
NextPrintEntry^.FileName := NextPrintEntry^.PrevEntry^.FileName;
NextPrintEntry^.FileSize := NextPrintEntry^.PrevEntry^.FileSize;
NextPrintEntry^.FileDate := NextPrintEntry^.PrevEntry^.FileDate;
NextPrintEntry^.Description := NextPrintEntry^.PrevEntry^.Description;
NextPrintEntry^.PrevEntry^.TypeOfRecord := TempSort^.TypeOfRecord;
NextPrintEntry^.PrevEntry^.FileName := TempSort^.FileName;
NextPrintEntry^.PrevEntry^.FileSize := TempSort^.FileSize;
NextPrintEntry^.PrevEntry^.FileDate := TempSort^.FileDate;
NextPrintEntry^.PrevEntry^.Description := TempSort^.Description;
Exchange := True;
End;
NextPrintEntry := NextPrintEntry^.PrevEntry;
End;
Until (Not Exchange);
DisplayScreen;
End;
Dispose(TempSort);
End;
End;
End;
{========================================================================}
Procedure SortListTime;
Var
TempSort : ListPtr;
SortNext, SortPrev, Exchange : Boolean;
Begin
If (BeginSort <> NIL) And (EndSort <> NIL) And (BeginSort <> EndSort) Then
Begin
SortNext := False; SortPrev := False; Altered := True;
If MaxAvail > Size(ListRecord) Then
Begin
New(TempSort);
NextPrintEntry := BeginSort;
While (NextPrintEntry <> EndSort) And (NextPrintEntry <> NIL) Do
Begin
NextPrintEntry := NextPrintEntry^.NextEntry;
If NextPrintEntry = EndSort Then SortNext := True;
End;
NextPrintEntry := BeginSort;
While (NextPrintEntry <> EndSort) And (NextPrintEntry <> NIL) Do
Begin
NextPrintEntry := NextPrintEntry^.PrevEntry;
If NextPrintEntry = EndSort Then SortPrev := True;
End;
If SortNext Then
Begin
Repeat
Exchange := False;
NextPrintEntry := BeginSort;
While NextPrintEntry <> EndSort Do
Begin
If NextPrintEntry^.FileDate > NextPrintEntry^.NextEntry^.FileDate Then
Begin
TempSort^.TypeOfRecord := NextPrintEntry^.TypeOfRecord;
TempSort^.FileName := NextPrintEntry^.FileName;
TempSort^.FileSize := NextPrintEntry^.FileSize;
TempSort^.FileDate := NextPrintEntry^.FileDate;
TempSort^.Description := NextPrintEntry^.Description;
NextPrintEntry^.TypeOfRecord := NextPrintEntry^.NextEntry^.TypeOfRecord;
NextPrintEntry^.FileName := NextPrintEntry^.NextEntry^.FileName;
NextPrintEntry^.FileSize := NextPrintEntry^.NextEntry^.FileSize;
NextPrintEntry^.FileDate := NextPrintEntry^.NextEntry^.FileDate;
NextPrintEntry^.Description := NextPrintEntry^.NextEntry^.Description;
NextPrintEntry^.NextEntry^.TypeOfRecord := TempSort^.TypeOfRecord;
NextPrintEntry^.NextEntry^.FileName := TempSort^.FileName;
NextPrintEntry^.NextEntry^.FileSize := TempSort^.FileSize;
NextPrintEntry^.NextEntry^.FileDate := TempSort^.FileDate;
NextPrintEntry^.NextEntry^.Description := TempSort^.Description;
Exchange := True;
End;
NextPrintEntry := NextPrintEntry^.NextEntry;
End;
Until (Not Exchange);
DisplayScreen;
End;
If SortPrev Then
Begin
Repeat
Exchange := False;
NextPrintEntry := BeginSort;
While NextPrintEntry <> EndSort Do
Begin
If NextPrintEntry^.FileDate > NextPrintEntry^.PrevEntry^.FileDate Then
Begin
TempSort^.TypeOfRecord := NextPrintEntry^.TypeOfRecord;
TempSort^.FileName := NextPrintEntry^.FileName;
TempSort^.FileSize := NextPrintEntry^.FileSize;
TempSort^.FileDate := NextPrintEntry^.FileDate;
TempSort^.Description := NextPrintEntry^.Description;
NextPrintEntry^.TypeOfRecord := NextPrintEntry^.PrevEntry^.TypeOfRecord;
NextPrintEntry^.FileName := NextPrintEntry^.PrevEntry^.FileName;
NextPrintEntry^.FileSize := NextPrintEntry^.PrevEntry^.FileSize;
NextPrintEntry^.FileDate := NextPrintEntry^.PrevEntry^.FileDate;
NextPrintEntry^.Description := NextPrintEntry^.PrevEntry^.Description;
NextPrintEntry^.PrevEntry^.TypeOfRecord := TempSort^.TypeOfRecord;
NextPrintEntry^.PrevEntry^.FileName := TempSort^.FileName;
NextPrintEntry^.PrevEntry^.FileSize := TempSort^.FileSize;
NextPrintEntry^.PrevEntry^.FileDate := TempSort^.FileDate;
NextPrintEntry^.PrevEntry^.Description := TempSort^.Description;
Exchange := True;
End;
NextPrintEntry := NextPrintEntry^.PrevEntry;
End;
Until (Not Exchange);
DisplayScreen;
End;
Dispose(TempSort);
End;
End;
End;
{========================================================================}
{========================================================================}
Function ValidFileName(FileName : MAXSTRING) : Boolean;
Begin
If (Pos('.',FileName) <= 9)
And (RPos('.',FileName) <= 4)
And (Length(FileName) > 0)
And (Copy(FileName,1,1) <> '.') Then
Begin
ValidFileName := True;
End
Else
Begin
ValidFileName := False;
End;
End;
{========================================================================}
Procedure RenameFile;
Var
NewFileName : String[12];
FileToRename : FILE OF char;
Rfc : Char;
Begin
If CurrentEntry^.TypeOfRecord = FileRecord Then
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Enter file name to rename '+CurrentEntry^.FileName+' to: ');
OffSet := 31 + Length(CurrentEntry^.FileName);
NewFileName := UpperString(EditLine('',12,25,OffSet));
If ValidFileName(NewFileName) Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(FileAreaPath+NewFileName,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn <> 0 Then
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Rename '+CurrentEntry^.FileName+' to '+NewFileName+' (Y/N)? ');
Repeat
Gbx := GetInput;
Rfc := Upcase(chr(Gbx));
Until Rfc In ['N','Y'];
Write(Rfc);
If Rfc = 'Y' Then
Begin
Altered := True;
Assign(FileToRename,FileAreaPath+CurrentEntry^.FileName);
Rename(FileToRename,FileAreaPath+NewFileName);
CurrentEntry^.FileName := NewFileName;
NextPrintEntry := CurrentEntry;
DisplayRecord(Row); DisplayCurrentLocation;
End;
End;
End;
AnsiGotoXY(24,80);
End;
End;
{========================================================================}
Procedure FindString(TypeOfSearch : Char);
Var
Found : Boolean;
Counter : Byte;
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write('Enter string to search for: '+StringToFind);
StringToFind := UpperString(EditLine(StringToFind,12,25,28));
NextPrintEntry := CurrentEntry; Found := False;
While (Not Found) And (NextPrintEntry^.NextEntry <> NIL) Do
Begin
NextPrintEntry := NextPrintEntry^.NextEntry;
If Pos(StringToFind,UpperString(NextPrintEntry^.FileName)) > 0 Then Found := True;
Case TypeOfSearch Of
'B' : Begin
If Pos(StringToFind,UpperString(NextPrintEntry^.FileName)) > 0 Then Found := True;
If Pos(StringToFind,UpperString(NextPrintEntry^.Description)) > 0 Then Found := True;
End;
'D' : Begin
If Pos(StringToFind,UpperString(NextPrintEntry^.Description)) > 0 Then Found := True;
End;
'F' : Begin
If Pos(StringToFind,UpperString(NextPrintEntry^.FileName)) > 0 Then Found := True;
End;
Else End;
End;
If Found Then
Begin
Counter := 10;
CurrentEntry := NextPrintEntry;
While (Counter > 1) And (NextPrintEntry^.PrevEntry <> NIL) Do
Begin
Counter:=Counter-1;
NextPrintEntry := NextPrintEntry^.PrevEntry;
End;
TopEntry := NextPrintEntry;
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(StringToFind+' found!');
Row := 11 - Counter;
DisplayScreen;
End
Else
Begin
AnsiGotoXY(25,1); AnsiClearToEOL;
Write(StringToFind+' NOT found!');
DisplayCurrentLocation;
End;
End;
{========================================================================}
{========================================================================}
Procedure ViewFile;
Var
Ext : String[3];
ReturnCode : Int16;
PathToUtility : PathStr;
Begin
If ReDirectTo = Console Then
Begin
If CurrentEntry^.TypeOfRecord In [FileRecord,Orphan] Then
Begin
If Pos('.',CurrentEntry^.FileName) > 0 Then
Begin
Ext := Copy(CurrentEntry^.FileName,Pos('.',CurrentEntry^.FileName)+1,
Length(CurrentEntry^.FileName)-Pos('.',CurrentEntry^.FileName));
AnsiClearScreen;
{ SetMemTop(HeapPtr); }
{ SwapVectors; }
If Pos(Ext,'ARCARJLZHPAKZIPZOO') In [1,4,7,10,13,16] Then
Begin
Write('Loading SHEZ...');
{ PathToUtility := FSearch('SHEZ.EXE',GetEnv('PATH')); }
{ Exec(FExpand(PathToUtility),FileAreaPath+CurrentEntry^.FileName); }
End
Else
Begin
Write('Loading LIST...');
{ PathToUtility := FSearch('LIST.COM',GetEnv('PATH')); }
If PathToUtility = '' Then
Begin
{ PathToUtility := FSearch('L.COM',GetEnv('PATH')); }
End;
{ Exec(FExpand(PathToUtility),FileAreaPath+CurrentEntry^.FileName); }
End;
{ SwapVectors; }
{ SetMemTop(HeapEnd); }
SetupScreen; DisplayScreen;
End;
End;
End;
End;
{========================================================================}
Procedure CallShez;
Var
ReturnCode : Int16;
PathToUtility : PathStr;
Begin
If ReDirectTo = Console Then
Begin
If CurrentEntry^.TypeOfRecord In [FileRecord,Orphan] Then
Begin
If Length(CurrentEntry^.FileName) > 0 Then
Begin
AnsiClearScreen;
{ SetMemTop(HeapPtr); }
Write('Loading SHEZ...');
{ SwapVectors; }
{ PathToUtility := FSearch('SHEZ.EXE',GetEnv('PATH')); }
If Pos('.',CurrentEntry^.FileName) = 0 Then
Begin
{ Exec(FExpand(PathToUtility),FileAreaPath+CurrentEntry^.FileName+'.*'); }
End
Else
Begin
{ Exec(FExpand(PathToUtility),FileAreaPath+CurrentEntry^.FileName); }
End;
{ SwapVectors; }
{ SetMemTop(HeapEnd); }
SetupScreen; DisplayScreen;
End;
End;
End;
End;
{========================================================================}
Procedure CallList;
Var
ReturnCode : Int16;
PathToUtility : PathStr;
Begin
If ReDirectTo = Console Then
Begin
If CurrentEntry^.TypeOfRecord In [FileRecord,Orphan] Then
Begin
If Length(CurrentEntry^.FileName) > 0 Then
Begin
AnsiClearScreen;
{ SetMemTop(HeapPtr); }
Write('Loading LIST...');
{ SwapVectors; }
{ PathToUtility := FSearch('LIST.COM',GetEnv('PATH')); }
If PathToUtility = '' Then
Begin
{ PathToUtility := FSearch('L.COM',GetEnv('PATH')); }
End;
{ Exec(FExpand(PathToUtility),FileAreaPath+CurrentEntry^.FileName); }
{ SwapVectors; }
{ SetMemTop(HeapEnd); }
SetupScreen; DisplayScreen;
End;
End;
End;
End;
{========================================================================}
Procedure CallVpic;
Var
ReturnCode : Int16;
PathToUtility : PathStr;
Begin
If ReDirectTo = Console Then
Begin
If CurrentEntry^.TypeOfRecord In [FileRecord,Orphan] Then
Begin
If Length(CurrentEntry^.FileName) > 0 Then
Begin
AnsiClearScreen;
{ SetMemTop(HeapPtr); }
Write('Loading VPIC...');
{ SwapVectors; }
{ PathToUtility := FSearch('VPIC.EXE',GetEnv('PATH')); }
{ Exec(FExpand(PathToUtility),FileAreaPath+CurrentEntry^.FileName); }
{ SwapVectors; }
{ SetMemTop(HeapEnd); }
SetupScreen; DisplayScreen;
End;
End;
End;
End;
{========================================================================}
Procedure ShellToDos;
Var
ReturnCode : Int16;
Begin
AnsiClearScreen;
{ SetMemTop(HeapPtr); }
WriteLn('Type EXIT to return...');
{ SwapVectors; }
{ Exec(GetEnv('COMSPEC'), ''); }
{ SwapVectors; }
{ SetMemTop(HeapEnd); }
SetupScreen; DisplayScreen;
End;
{========================================================================}
{========================================================================}
Procedure ParseCommandLine;
Var
x : Byte;
FileAreaPathOk, AreaPathOk, OutputSelected : Boolean;
Begin
ReDirectTo := StandardIO; FileAreaPath := ''; Columns := 5; ColumnPos := 16;
FileAreaPathOk := False; AreaPathOk := False; OutputSelected := False;
{ Assign(Input,''); }
{ Reset(Input); }
{ Assign(Output,''); }
{ ReWrite(Output); }
WriteLn(Pgmid); {WriteLn;}
WriteLn('Pre-Alpha version for testing ONLY, make backups please!');
WriteLn;
If ParamCount = 0 Then
Begin
ReDirectTo := Console;
OutputSelected := True;
{ AssignCrt(Input); }
{ Reset(Input); }
{ AssignCrt(Output); }
{ ReWrite(Output); }
Fsplit(ParamStr(0),D,N,E);
AreaPath := D + 'AREA.DAT';
GetAreaTable;
If NumberOfAreaEntries < Columns Then Columns := NumberOfAreaEntries;
SetupScreen;
FileAreaPath := ChooseArea;
If (FileAreaPath = 'QUIT') Or (FileAreaPath = 'QUITQUICK') Then
Begin
dos.exit(EXIT_PROCESS,250);
{ ABORT(250); }
End;
End
Else
Begin
For x := 1 To ParamCount Do
Begin
If Copy(UpperString(ParamStr(x)),1,2) = '-A' Then
Begin
AreaPathOk := True;
AreaPath := Copy(UpperString(ParamStr(x)),3,Length(ParamStr(x))-2);
If Length(AreaPath) > 0 Then
Begin
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(AreaPath,ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn <> 0 Then
Begin
If Copy(AreaPath,Length(AreaPath),1) <> '\' Then AreaPath := AreaPath + '\';
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(AreaPath+'AREA.DAT',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn <> 0 Then
Begin
WriteLn('AREA.DAT not found in '+AreaPath+' !');
dos.exit(EXIT_PROCESS,1);
{ ABORT(1); }
End
Else
Begin
AreaPath := AreaPath + 'AREA.DAT';
End;
End;
End;
End;
If Copy(UpperString(ParamStr(x)),1,2) = '-C' Then
Begin
OutputSelected := True;
If Copy(ParamStr(x),3,1) = '0' Then
Begin
ReDirectTo := Console;
{ AssignCrt(Input);}
{ Reset(Input);}
{ AssignCrt(Output);}
{ ReWrite(Output);}
End;
If Copy(ParamStr(x),3,1) = '1' Then
Begin
ReDirectTo := ComPort1;
Assign(Input,'Com1'); Reset(Input);
Assign(Output,'Com1'); ReWrite(Output);
End;
If Copy(ParamStr(x),3,1) = '2' Then
Begin
ReDirectTo := ComPort2;
Assign(Input,'Com2'); Reset(Input);
Assign(Output,'Com2'); ReWrite(Output);
End;
If Copy(ParamStr(x),3,1) = '9' Then
Begin
ReDirectTo := StandardIO;
{ Assign(Input,''); Reset(Input);}
{ Assign(Output,''); ReWrite(Output);}
End;
End;
If Copy(UpperString(ParamStr(x)),1,2) = '-P' Then
Begin
FileAreaPathOk := True;
FileAreaPath := Copy(UpperString(ParamStr(x)),3,Length(ParamStr(x))-2);
If Length(FileAreaPath) > 0 Then
Begin
If Copy(FileAreaPath,Length(FileAreaPath),1) <> '\' Then FileAreaPath := FileAreaPath + '\';
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(FileAreaPath+'*.*',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn <> 0 Then
Begin
WriteLn('Directory '+FileAreaPath+' not found!');
dos.exit(EXIT_PROCESS,1);
{ ABORT(1); }
End;
End;
End;
If Copy(UpperString(ParamStr(x)),1,2) = '-K' Then
Begin
tempstr := Copy(ParamStr(x),3,1);
Columns := StrToInt(tempstr,10,OK);
{ _VAL_INT(Copy(ParamStr(x),3,1),Columns,Result); }
If Columns < 3 Then Columns := 3;
If Columns > 8 Then Columns := 8;
End;
End;
If Columns = 3 Then ColumnPos := 25;
If Columns = 4 Then ColumnPos := 20;
If Columns = 5 Then ColumnPos := 16;
If Columns = 6 Then ColumnPos := 14;
If Columns = 7 Then ColumnPos := 12;
If Columns = 8 Then ColumnPos := 10;
If (Not AreaPathOk) Then
Begin
Fsplit(ParamStr(0),D,N,E);
AreaPath := D + 'AREA.DAT';
End;
GetAreaTable;
If NumberOfAreaEntries < Columns Then Columns := NumberOfAreaEntries;
If (Not OutputSelected) Then
Begin
ReDirectTo := Console;
OutputSelected := True;
{ AssignCrt(Input); }
{ Reset(Input); }
{ AssignCrt(Output); }
{ ReWrite(Output); }
End;
SetupScreen;
If (Not FileAreaPathOk) Then
Begin
FileAreaPath := ChooseArea;
If (FileAreaPath = 'QUIT') Or (FileAreaPath = 'QUITQUICK') Then
Begin
dos.exit(EXIT_PROCESS,250);
{ ABORT(250); }
End;
End;
End;
End;
{========================================================================}
Procedure BuildSkipList;
Var
Bslb : Byte;
InFile : Text;
Begin
For Bslb := 1 To MaxSkip Do SkipList[Bslb] := 'ACBDEFGHIJKL';
Fsplit(ParamStr(0),D,N,E);
attr := 0H;
hndlhdir := HDIR_CREATE;
count := 1;
reslng := size(FILEFINDBUF);
StrToZ(D+'MFM-SKIP.LST',ztempstr);
retn := dos.FindFirst(ztempstr,hndlhdir,attr,DirInfo,
reslng,count,rsrvd);
If retn = 0 Then
Begin
Assign(InFile,D+'MFM-SKIP.LST');
Reset(InFile);
Bslb := 1;
While (Not Eof(InFile)) And (Bslb < MaxSkip) Do
Begin
ReadLn(InFile,SkipList[Bslb]);
Bslb:=Bslb+1;
End;
Close(InFile);
End;
End;
{========================================================================}
Begin
Altered := False; BeginSort := NIL; EndSort := NIL;
Base153 := Base153A + Base153B + Base153C;
ParseCommandLine;
BuildSkipList;
NumberOfEntries := 0;
BuildList;
StringToFind := '';
If NumberOfEntries = 0 Then
Begin
AnsiGotoXY(25,1);
AnsiClearToEOL;
Write('This area contains no files!');
Repeat
FileAreaPath := ChooseArea;
NumberOfEntries := 0; BuildList;
If NumberOfEntries = 0 Then
Begin
AnsiGotoXY(25,1);
AnsiClearToEOL;
Write('This area contains no files!');
End;
Until NumberOfEntries > 0;
End;
If NumberOfEntries > 0 Then
Begin
Row := 1;
CurrentEntry := FirstEntry;
TopEntry := FirstEntry;
DisplayScreen;
Repeat
Gcx := Upcase(FileAreaPath[1]);
AnsiGotoXY(24,1);
NewTextColor(Black);
NewTextBackground(Cyan);
FreeSpace := DiskFree(Ord(Gcx)-64) Div 1024;
AnsiClearToEOL;
Write(' Number of files = '+MyStr(NumberOfFiles,3)
+' Size of files = '+Bytes(SizeOfFiles Div 1024)
+' Free space = '+Bytes(FreeSpace)
+' ? = Help');
NewTextColor(White);
NewTextBackground(Black);
AnsiGotoXY(25,1);
AnsiClearToEOL;
Write(FileAreaPath);
AnsiGotoXY(24,80);
Gbx := GetInput;
Gcx := Upcase(Chr(Gbx));
If Gbx = 0 Then
Begin
Gbx := GetInput;
Case Gbx Of
31 : Begin { ALT-S }
ShellToDos;
Gcx := chr(0);
End;
33 : Begin { ALT-F }
CallShez;
Gcx := chr(0);
End;
38 : Begin { ALT-L }
CallList;
Gcx := chr(0);
End;
44 : Begin { ALT-Z }
CallVpic;
Gcx := chr(0);
End;
47 : Begin { ALT-V }
ViewFile;
Gcx := chr(0);
End;
72 : Gcx := '8';
80 : Gcx := '2';
73 : Gcx := '9';
81 : Gcx := '3';
71 : Gcx := '7';
79 : Gcx := '1';
Else End;
End;
Case Gcx Of
chr(1) : AdoptAllOrphans;
chr(2) : FindString('B');
chr(4) : FindString('D');
chr(6) : FindString('F');
chr(17) : Begin
If Altered Then SaveList;
dos.exit(EXIT_PROCESS,0);
{ ABORT(0); }
End;
chr(24) : Begin
If CurrentEntry^.PrevEntry <> NIL Then
Begin
CurrentEntry^.Description := CurrentEntry^.PrevEntry^.Description;
NextPrintEntry := CurrentEntry;
DisplayRecord(Row);
DisplayCurrentLocation;
End;
End;
' ' : Begin
CurrentEntry^.Tagged := (Not CurrentEntry^.Tagged);
LineDown;
If CurrentEntry^.NextEntry = NIL Then DisplayCurrentLocation;
End;
'8' : LineUp;
'2' : LineDown;
'9' : PageUp;
'3' : PageDown;
'7' : TopOfList;
'1' : BottomOfList;
'#' : MassMove;
'$' : MassCopy;
'A' : AdoptAbandon(1);
'C' : CopyFile;
'D' : ChangeFileDate;
'E' : EditDescription;
'F' : BeginSort := CurrentEntry;
'I' : InsertBlank;
'K' : PushRecord(KillEntry);
'L' : EndSort := CurrentEntry;
'M' : MoveFile;
'N' : ChooseNewArea;
'Q' : Quit;
'R' : RenameFile;
'S' : SortList;
'T' : SortListTime;
'U' : PopRecord(KillEntry,'B');
'W' : SaveList;
'<' : PushRecord(StackEntry);
'>' : PopRecord(StackEntry,'A');
',' : PushRecord(StackEntry);
'.' : PopRecord(StackEntry,'B');
'[' : StackPrev(StackEntry);
']' : StackNext(StackEntry);
';' : ShowStack(StackEntry);
'{' : StackPrev(KillEntry);
'}' : StackNext(KillEntry);
':' : ShowStack(KillEntry);
'!' : ReDrawScreen;
'?' : Help;
Else End;
Until Gcx = chr(255);
End;
End.
{========================================================================}