Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FAQ-S.ZIP/PULLDOWN.PAS

Pascal/Delphi Source File | 1991-03-20 | 10.2 KB | 441 lines

program pulldown;

uses dos, crt;

var c:char;
    x,y,z,a:integer;
    dir:string[127];

{$M 8192,0,0}

procedure cursor (csize : byte);
var regs : registers;
begin
   case (csize) of
      1 : if mem[0:$449] = 7 then regs.cx := $0c0d  { underline  = 1 }
          else regs.cx := $0607;
      2 : if mem[0:$449] = 7 then regs.cx := $060d  { full Block = 2 }
          else regs.cx := $0007;
      3 : regs.cx := $2000;                         { no Cursor  = 3 }
   end;
   regs.ax := $0100;
   intr($10,regs);
end;

procedure ahigh (x:integer);
begin
    case x of
      1:begin
            gotoxy (2,3);
            textbackground (4);
            textcolor (15);
            write (' Root Directory ');
            textbackground (15);
            textcolor (4);
        end;
      2:begin
            gotoxy (2,4);
            textbackground (4);
            textcolor (15);
            write (' Other Dir      ');
            textbackground (15);
            textcolor (4);
        end;
    end;
end;

procedure bhigh (x:integer);
begin
     case x of
       1:begin
             gotoxy (27,3);
             textcolor (15);
             textbackground (4);
             write (' Copy   ');
         end;
       2:begin
             gotoxy (27,4);
             textcolor (15);
             textbackground (4);
             write (' Move   ');
         end;
       3:begin
             gotoxy (27,5);
             textcolor (15);
             textbackground (4);
             write (' Rename ');
         end;
       4:begin
             gotoxy (27,6);
             textcolor (15);
             textbackground (4);
             write (' Other  ');
         end;
     end;
end;

procedure high (x:integer);
begin
     case x of
      1:begin
            gotoxy (2,1);
            textbackground (4);
            textcolor (15);
            write (' ChDir ');
        end;
      2:begin
            gotoxy (10,1);
            textbackground (4);
            textcolor (15);
            write (' MkDir ');
        end;
      3:begin
            gotoxy (18,1);
            textbackground (4);
            textcolor (15);
            write (' RmDir ');
        end;
      4:begin
            gotoxy (26,1);
            textbackground (4);
            textcolor (15);
            write (' ExecCmd ');
        end;
      5:begin
            gotoxy (36,1);
            textbackground (4);
            textcolor (15);
            write (' Delete ');
        end;
      6:begin
            gotoxy (45,1);
            textbackground (4);
            textcolor (15);
            write (' Dir ');
        end;
      7:begin
            gotoxy (51,1);
            textbackground (4);
            textcolor (15);
            write (' Help ');
        end;
      8:begin
            gotoxy (58,1);
            textbackground (4);
            textcolor (15);
            write (' Quit ');
        end;
     end;
end;

procedure dohelp;
begin
     gotoxy (50,10);
     textbackground (3);
     textcolor (14);
     writeln ('╔══════════════════════╗');
     gotoxy (50,11);
     write ('║  ');
     textcolor (15);
     write (#27#26#25#24+' - Move Bar');
     textcolor (14);
     writeln ('     ║');
     gotoxy (50,12);
     write ('║ ');
     textcolor (15);
     write (' [Return] - Select');
     textcolor (14);
     writeln ('   ║');
     gotoxy (50,13);
     write ('║ ');
     textcolor (15);
     write (' ESC - Quits to Main ');
     textcolor (14);
     writeln ('║');
     gotoxy (50,14);
     writeln ('╚══════════════════════╝');
     repeat
     until keypressed;
end;


procedure changedir2;
begin
     gotoxy (6,10);
     textbackground (4);
     textcolor (15);
     writeln ('╔═══ Enter Directory ══════════════╗');
     gotoxy (6,11);
     writeln ('║                                  ║');
     gotoxy (6,12);
     writeln ('╚══════════════════════════════════╝');
     gotoxy (8,11);
     textcolor (14);
     cursor (2);
     readln (dir);
     if doserror <> 0 then begin
       gotoxy (1,14);
       textcolor (15);
       textbackground (0);
       cursor (3);
       writeln ('Invalid Directory!');
       exit;
     end;
     chdir (dir);
     cursor (3);
     textbackground (0);
     gotoxy (6,10);
     clreol;
     gotoxy (6,11);
     clreol;
     gotoxy (6,12);
     clreol;
end;

procedure changedir;
begin
     textbackground (15);
     textcolor (4);
     ahigh (y);
     gotoxy (1,2);
     writeln ('╔════════════════╗');
     writeln ('║ Root Directory ║');
     writeln ('║ Other Dir...   ║');
     writeln ('╚════════════════╝');
     textbackground (15);
     textcolor (4);
     gotoxy (2,1);
     ahigh (y);
     repeat
       c:=readkey;
       c:=upcase (c);
     until c in [#77,#75,#72,#80,#27,#13];
     if (c=#77) or (c=#80) then y:=y+1;
     if (c=#75) or (c=#72) then y:=y-1;
     if y=3 then y:=1;
     if y=0 then y:=2;
     if c=#27 then exit;
     if c=#13 then begin;
       case y of
        1:chdir('\');
        2:changedir2;
       end;
     end;
    changedir
end;

procedure makedir;
begin
     gotoxy (6,10);
     textbackground (4);
     textcolor (15);
     writeln ('╔═══ Enter Directory ══════════════╗');
     gotoxy (6,11);
     writeln ('║                                  ║');
     gotoxy (6,12);
     writeln ('╚══════════════════════════════════╝');
     gotoxy (8,11);
     textcolor (14);
     cursor (2);
     readln (dir);
     if doserror <> 0 then begin
      writeln ('Invalid Directory Name!');
      cursor (3);
      exit;
     end;
     mkdir (dir);
     cursor (3);
     textbackground (0);
     gotoxy (6,10);
     clreol;
     gotoxy (6,11);
     clreol;
     gotoxy (6,12);
     clreol;
end;

procedure copyproc;
var cf,ct:string;
begin
     gotoxy (1,8);
     textcolor (14);
     textbackground (1);
     writeln ('╔══ Copy ═══════════════════════════════════════════╗');
     writeln ('║                                                   ║');
     writeln ('╚═══════════════════════════════════════════════════╝');
     cursor (2);
     gotoxy (3,9);
     textcolor (15);
     readln (cf);
     if doserror <> 0 then begin
       writeln ('Invalid Filename or File doesn''t Exist!');
       exit;
     end;
     gotoxy (1,12);
     textcolor (14);
     writeln ('╔══ To ═════════════════════════════════════════════╗');
     writeln ('║                                                   ║');
     writeln ('╚═══════════════════════════════════════════════════╝');
     gotoxy (3,13);
     textcolor (15);
     readln (ct);
     if length(ct)=0 then begin
       writeln ('Invalid Directory or Filename!');
       exit;
     end;
     gotoxy (1,17);
     textcolor (11);
     textbackground (0);
     write ('Copying ');
     textcolor (15);
     write (cf);
     textcolor (11);
     write (' to ');
     textcolor (15);
     write (ct);
     textcolor (11);
     write ('.');
     exec(getenv('COMSPEC'),'/C copy '+cf+' '+ct);
     gotoxy (1,8);
     for a:=8 to 18 do begin
      gotoxy (1,a);
      clreol;
     end;
     cursor (3);
     delay (1000);
end;

procedure moveproc;
var mf,mt:string;
begin
     gotoxy (1,8);
     textcolor (14);
     textbackground (1);
     writeln ('╔══ Move ═══════════════════════════════════════════╗');
     writeln ('║                                                   ║');
     writeln ('╚═══════════════════════════════════════════════════╝');
     cursor (2);
     gotoxy (3,9);
     textcolor (15);
     readln (mf);
     if length(mf)=0 then begin
       writeln ('Invalid Filename!');
       exit;
     end;
     gotoxy (1,12);
     textcolor (14);
     writeln ('╔══ To ═════════════════════════════════════════════╗');
     writeln ('║                                                   ║');
     writeln ('╚═══════════════════════════════════════════════════╝');
     gotoxy (3,13);
     textcolor (15);
     readln (mt);
     if length(mt)=0 then begin
       writeln ('Invalid Directory or Filename!');
       exit;
     end;
     gotoxy (1,16);
     textcolor (11);
     write ('Moving ');
     textcolor (15);
     write (mf);
     textcolor (11);
     write ('to ');
     textcolor (15);
     write (mt);
     textcolor (11);
     write ('.   ');
     exec(getenv('COMSPEC'),'/C MOVE '+MF+' '+MT);
     if doserror <> 0 then writeln ('MOVE.COM not found!');
     textbackground (0);
     for a:=8 to 25 do begin
      gotoxy (1,a);
      clreol;
     end;
     cursor (3);
     delay (1000);
end;

procedure execcmds;
begin
     gotoxy (26,2);
     textbackground (15);
     textcolor (4);
     writeln ('╔════════╗');
     gotoxy (26,3);
     writeln ('║ Copy   ║');
     gotoxy (26,4);
     writeln ('║ Move   ║');
     gotoxy (26,5);
     writeln ('║ Rename ║');
     gotoxy (26,6);
     writeln ('║ Other..║');
     gotoxy (26,7);
     writeln ('╚════════╝');
     textbackground (15);
     textcolor (4);
     bhigh (z);
     repeat
       c:=readkey;
       c:=upcase(c);
     until c in [#77,#75,#72,#80,#27,#13,#3];
     if (c=#77) or (c=#80) then z:=z+1;
     if (c=#75) or (c=#72) then z:=z-1;
     if z=0 then z:=4;
     if z=5 then z:=1;
     if c=#27 then exit;
     if c=#3 then halt(0);
     if c=#13 then begin
      case z of
        1:copyproc;
        2:moveproc;
      {  3:renameproc;
        4:otherdosproc;   }
       end;
     end;
    execcmds
end;

procedure firstbar;
begin
     textbackground(0);
     clrscr;
     textbackground (15);
     textcolor (4);
     writeln ('Name    pasword   RmDir   ExecCmd   Delete   Dir   Help   Quit                  ');
     high (x);
     repeat
       c:=readkey;
       c:=upcase(c);
     until c in [#77,#75,#13,#3];
     if c=#77 then x:=x+1;
     if c=#75 then x:=x-1;
     if x=9 then x:=1;
     if x=0 then x:=8;
     if c=#3 then halt(0);
     if c=#13 then begin
      case x of
       1:changedir;
       2:makedir;
       3:;
       4:execcmds;
       5:;
       6:;
       7:dohelp;
       8:halt(0);
      end;
     end;
     firstbar

end;


begin
     clrscr;
     cursor (3);
     x:=1;
     y:=1;
     z:=1;
     firstbar;
end.