Power-Programmierung/CD1.mdf/pascal/library/dos/s_filema/source/sfm.pas

Pascal/Delphi Source File | 1987-06-26 | 8.9 KB | 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.