home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / direct.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-05  |  2.8 KB  |  82 lines
  1. Program DirectoryControls;
  2. Var
  3.   Path: String[64];
  4.   Ch: Char;
  5.  
  6. Begin
  7.   TEXTBACKGROUND(1); TEXTCOLOR(14);
  8.   ch := '1';   { initialize loop variable }
  9.   Repeat
  10.     if Upcase(ch) IN ['1', 'M', '2', 'R', '3', 'C','4', 'D', '0', 'Q'] then
  11.       begin
  12.          ClrScr;
  13.          GetDir(0,Path); { Get the current directory of the current drive.
  14.                            Note that 0 for the first variable means the current
  15.                            drive, not A:.  1 means A: and so on.   This is contrary
  16.                            to the manual }
  17.          GOTOXY(23,09);
  18.          TEXTCOLOR(0);TEXTBACKGROUND(7);
  19.          WriteLn(' CURRENT DIRECTORY   IS     ',Path  );
  20.          GOTOXY(23,10); TEXTBACKGROUND(1); TEXTCOLOR(14);
  21.          Writeln('                                  ');
  22.          GOTOXY(32,11); textcolor(15);
  23.          WriteLn(' CHOOSE OPTION:                   ');
  24.          GOTOXY(23,13); textcolor(14);
  25.          WriteLn('  1: Make a directory             ');
  26.          GOTOXY(23,14);
  27.          WriteLn('  2: Remove a directory           ');
  28.          GOTOXY(23,15);
  29.          WriteLn('  3: Change the current directory ');
  30.          GOTOXY(23,16);
  31.          WriteLn('  0: Quit                         ');
  32.          GOTOXY(23,17);
  33.          Writeln('                                  ');
  34.          GOTOXY(32,18);textcolor(15);
  35.          Write(' OPTION: ');
  36.          textcolor(14);
  37.          Read(Kbd,Ch);
  38.  
  39.          {$I-}
  40.          Case Upcase(Ch) Of
  41.            '1','M': Begin
  42.                       GOTOXY(32,21);
  43.                       WriteLn('Make');
  44.                       GOTOXY(32,22);
  45.                       Write('Make what directory? ');
  46.                       Readln(path);
  47.                       MkDir(Path);
  48.                     End;
  49.            '2','R': Begin
  50.                       GOTOXY(32,21);
  51.                       WriteLn('Remove');
  52.                       GOTOXY(32,22);
  53.                       Write('Remove what directory? ');
  54.                       Readln(path);
  55.                       RmDir(Path);
  56.                     End;
  57.            '3','C': Begin
  58.                       GOTOXY(32,21);
  59.                       WriteLn('Change');
  60.                       Writeln;
  61.                       GOTOXY(32,22);
  62.                       Write('Change to what directory? ');
  63.                       Readln(path);
  64.                       ChDir(Path);
  65.                     End;
  66.            '0','Q': WriteLn('Quit');
  67.            Else
  68.           End; { case }
  69.  
  70.          {$I+}
  71.          If IOResult<>0 Then
  72.             begin
  73.               GOTOXY(32,24);
  74.               Write('*** Error *** Please Wait: ', path);
  75.               delay(3000);
  76.             end;
  77.        end { if }
  78.      else
  79.        read(kbd, ch)
  80.     Until Upcase(Ch) In ['0','Q', #27];
  81. End.
  82.