home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
turbopas
/
sfmsrc.arc
/
SFM.PAS
next >
Wrap
Pascal/Delphi Source File
|
1987-06-26
|
9KB
|
328 lines
{ Super File Manager
by David Steiner
2035 J Apt. 6
Lincoln, NE
SFM.PAS
}
{$C-} { Don't allow user breaks, speeds up screen. }
{$K-} { Don't watch for heap/stack collisions, saves code space. }
{ Besides, we already watch for this ourselves. }
{$I sfmVARS.inc }
{$I sfmOTHER.inc }
{$I sfmSCRN.inc }
{$I sfmDOS.inc }
{$I sfmFUNC.inc }
procedure InitVars;
var
Regs : reg_T;
i : integer;
begin
Mark( HeapStart );
Regs.AH := $30; { DOS function $30 - Get DOS Version Number }
MsDos( Regs );
if Regs.AX = 0 then
AbortProgram( 'InitVars :',
'',
' SFM does not support DOS versions prior to 2.0.',
''
);
ShowAll := false;
HelpScreen[1] := false;
HelpScreen[2] := true;
for i := 1 to 2 do
begin
Loaded[i] := false;
Mask[i] := '*.*';
ConvMask[i] := '???????????';
end;
SavedPath := '.';
Drive[1] := GetCurDrive;
if not (GetCurDir( Drive[1], Path[1] ) = 0) then
Path[1] := char(64 + Drive[1]) + ':\';
SavedPath := Path[1];
DiskFree[1] := FreeDisk( Drive[1] );
LoadDir( 1 );
if not loaded[1] then
AbortProgram( 'InitVars : ',
'',
' Couldn''t load current directory.',
''
);
end;
function GoMenu2( w : integer ) : integer;
begin
Wind( 3 );
clrscr;
writeln;
Disp( NATTR, ' Loading FAT for ' );
Disp( HATTR, copy( Path[w], 1, 2 ) );
writeln;
if ChangeCurDir( Path[w] ) <> 0 then
GoMenu2 := 1
else
begin
WriteScreen;
Menu2Window( w );
ShowAll := true;
fillchar( Marked[w], sizeof(MarkedArr_T), 0 );
LoadDir( w ); { Reload dir and FAT just to make }
LoadFAT( DiskTable[w], FATptr ); { sure it is current. }
FATsaved := true;
GoMenu2 := 2;
end;
end;
function GoMenu1( w : integer ) : integer;
var
menu : integer;
begin
Wind( 3 );
clrscr;
writeln;
menu := 2;
if (Saved[w] and FATsaved) or NoSave[w] then
menu := 1
else
begin
Disp( NATTR, ' Directory was changed, exit without saving' );
if YorN( false ) then menu := 1;
end;
if menu = 1 then
begin
WriteScreen;
ShowAll := false;
HelpScreen[3-w] := true;
HelpWindow( w, 3-w );
if Saved[w] and FATsaved then
HomeKey( w )
else
begin
DiskFree[w] := FreeDisk( Drive[w] );
LoadDir( w );
end;
end;
GoMenu1 := menu;
end;
const
command : integer = 0;
Ncom : array[1..2] of integer = ( 13, 9 );
ComStrt : array[1..2] of integer = ( 4, 7 );
ComLin : array[1..2] of integer = ( 7, 5 );
ComWid : array[1..2] of integer = ( 10, 14 );
ComName : array[1..2] of array[0..13] of string[10] =
((
' ClearAll ',' Copy ',' CopyInfo ',' Rename ',' Set Mask ',' Tog Attr ',' Menu 2 ',
' Mark All ',' Delete ',' Move ',' Reload ',' Make Dir ',' ClearDsk ',' Quit '
),
(
' Sort ',' Rename ',' Undelete ',' DiskInfo ',' Menu 1 ',
' VolLabel ',' Reload ',' Purge ',' Pick Up ',' Update ',
'','','',''
));
function GetCommand( var w : integer; menu : integer ) : integer;
var
ch : char;
lastcom, lastlin, Fcommand : integer;
procedure WriteCom( i, attr : integer ); { Local to GetCommand }
var
x, y : integer;
begin
x := ( i mod ComLin[menu]) * ComWid[menu];
y := i div ComLin[menu];
Display( X1+x+ComStrt[menu], Y1+y+1, attr, ComName[menu][i] );
end;
begin
Wind( 3 );
clrscr;
for lastcom := 0 to Ncom[menu] do
WriteCom( lastcom, NATTR );
lastcom := command;
lastlin := CurLin[w];
Fcommand := 0;
repeat
Wind( 3 );
if lastcom <> command then
WriteCom( lastcom, NATTR );
lastcom := command;
WriteCom( command, MATTR[menu] );
Wind( w );
if lastlin <> CurLin[w] then
Display( X1, Y1+lastlin-1, PATTR, ' ' );
lastlin := CurLin[w];
Display( X1, Y1+CurLin[w]-1, PATTR, ' '+PtrChar );
gotoxy( 1, CurLin[w] );
CursorON;
ch := Keyboard;
CursorOFF;
if funckey then
begin
case ch of
#59..#64 : begin { Pass these function keys }
Fcommand := ord( ch ) - 38; { as codes 21 - 26 }
ch := #13; { for F1 - F6 }
end;
#65 : if command = 0 then command := Ncom[menu] { F7 }
else command := command - 1;
#66 : if command = Ncom[menu] then command := 0 { F8 }
else command := command + 1;
#67 : if menu = 2 then { F9 }
begin
Fcommand := 29;
ch := #13;
end
else MarkEntry( w );
#83 : begin { Del }
Fcommand := 31;
ch := #13;
end;
#68 : UnMarkEntry( w ); { F10 }
#71 : HomeKey( w );
#72 : UpKey( w );
#73 : PgUp( w );
#75 : if Loaded[1] and not HelpScreen[1] then w := 1; { <-- }
#77 : if Loaded[2] and not HelpScreen[2] then w := 2; { --> }
#79 : EndKey( w );
#80 : DownKey( w );
#81 : PgDown( w );
end;
end
else
begin { Shifted cursor keys just return regular number characters }
case ch of
'7' : command := 0;
'1' : command := Ncom[menu];
'4' : if command = 0 then command := Ncom[menu]
else command := command - 1;
' ',
'+',
'6' : if command = Ncom[menu] then command := 0
else command := command + 1;
'8',
'2' : if command < ComLin[menu] then command := command + ComLin[menu]
else command := command - ComLin[menu];
end;
end;
until ch = #13;
if Fcommand = 0 then
GetCommand := command
else
GetCommand := Fcommand;
end;
procedure main;
var
w, com, menu : integer;
done : boolean;
begin
w := 1;
menu := 1;
done := false;
repeat
com := GetCommand( w, menu );
case menu of
1 : case com of
0 : ClearMarks( w ); { These first codes are for }
1 : CopyMarked( w ); { entries in the ComName }
2 : CopyInfo( w ); { array defined above. }
3 : RenameEntry( w );
4 : SetMask( w );
5 : ToggleAttr( w );
6 : begin
menu := GoMenu2( w );
command := ComLin[menu]-1; { Set command to the Menu entry }
end;
7 : MarkAll( w );
8 : DeleteMarked( w );
9 : RedirectMarked( w );
10 : ReloadDir( w, menu );
11 : MakeDir( w );
12 : ClearDisk( w );
13 : done := true;
21 : HelpWindow( w, 1 ); { Function keys are represented }
22 : HelpWindow( w, 2 ); { by numbers in the 20's }
23 : GoDir( w, 1 );
24 : GoDir( w, 2 );
25 : if ChangePath( 1 ) then w := 1;
26 : if ChangePath( 2 ) then w := 2;
31 : DeleteEntry( w ); { Special code for Del key }
end;
2 : case com of
0 : Sort( w ); { Code for ComName entry again }
1 : ChangeName( w );
2 : UndeleteEntry( w );
3 : TechInfo( w );
4 : begin
menu := GoMenu1( w );
command := ComLin[menu]-1;{ Set command to the Menu entry }
end;
5 : VolLabel( w );
6 : ReloadDir( w, menu );
7 : Purge( w );
8 : MoveEntry( w );
9 : WriteDir( w );
29 : MoveEntry( w ); { F9 - Only funtion key used by menu 2 }
end;
end;
until done;
end;
begin
ErrorPtr := ofs( AbortOnError ); { Trap Turbo errors so we can turn off }
Int24ON; { interrupt handlers before exiting. }
Int10ON;
CursorOFF;
SetCursorType; { Set default colors according to system }
Colors;
GetColor;
Colors;
WriteScreen;
InitVars;
WriteHelp1;
Main;
window( 1, 1, 80, 25 );
textcolor( LightGray );
textbackground( Black );
clrscr;
CursorON;
{$I-}
chdir( SavedPath );
{$I+}
Int10OFF;
Int24OFF;
end.