home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
189.img
/
TCS120S.ZIP
/
PULLDOWN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-04-02
|
10KB
|
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 (' ChDir MkDir 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.