home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hráč 1997 February
/
Hrac_09_1997-02_cd.bin
/
UTILS
/
PROGRAM
/
1SVGA.ZIP
/
DIRS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-20
|
7KB
|
214 lines
{ Directory...with problem in SelectDrive }
uses Dos,Txt;
const { Box,Title,File,Select,Dir, Mask&DriveBox,Title,Text,Selcct, }
Color:array[1..13] of byte=( { ErrorBox,Title,Text, Messege }
$3F,$3E,$31,$5F,$34, $2F,$2E,$2E,$5F, $5F,$5E,$5E, $71);
var Max,DirNum,Page,PageMax,No,K:integer;
Files:array[0..1023] of string[12];
Mask:string[12];
{ ─────────────── TestDir ─────────────── }
function TestDir(Path:string;DirType:byte):integer;
var DirInfo:SearchRec; { DirType: 1=File, 2=Dir, 3=Vol }
begin { 0=Find not, 1=Yes }
FindFirst(Path,AnyFile,DirInfo); TestDir:=0;
while DosError=0 do begin
case DirType of
1:if DirInfo.Attr in [$00..$07,$20..$27] then begin TestDir:=1; Exit; end;
2:if DirInfo.Attr in [$10..$17] then begin TestDir:=1; Exit; end;
3:if DirInfo.Attr in [$08,$18,$28] then begin TestDir:=1; Exit; end;
end;
FindNext(DirInfo);
end;
end;
{ ─────────────── SortFiles ─────────────── }
procedure SortFiles(L,R:integer);
var I,J:integer;
M,T:string[12];
begin
I:=L; J:=R; M:=Files[(L+R) shr 1];
repeat
while Files[I]<M do Inc(I); { Move right }
while M<Files[J] do Dec(J); { Move left }
if I<=J then begin
T:=Files[I]; Files[I]:=Files[J]; Files[J]:=T;
Inc(I); Dec(J);
end;
until I>J;
if L<J then SortFiles(L,J);
if I<R then SortFiles(I,R);
end;
{ ─────────────── GetFiles ─────────────── }
procedure GetFiles(Path:string);
var DirInfo:SearchRec;
begin
Max:=0; DirNum:=0; Page:=0; No:=0;
FindFirst('*.*',AnyFile,DirInfo);
while DosError=0 do begin
if DirInfo.Attr in [$10..$17] then
begin Files[DirNum]:=DirInfo.Name; Inc(DirNum); end;
FindNext(DirInfo);
end;
Max:=DirNum;
FindFirst(Path,AnyFile,DirInfo);
while DosError=0 do begin
if DirInfo.Attr in [$00..$07,$20..$27] then
begin Files[Max]:=DirInfo.Name; Inc(Max); end;
FindNext(DirInfo);
end;
SortFiles(0,DirNum-1); SortFiles(DirNum,Max-1);
end;
{ ─────────────── FilesMask ─────────────── }
procedure FilesMask(X,Y:integer);
var St:string;
I,J:integer;
begin
TextWindow1(X,Y,40,3,Color[6],Color[7],1,' Enter Filenames Mask ');
TextBar(X+1,Y+1,38,1,Color[8],' ');
if (InputText(X+2,Y+1,12,St)=0) or (St='') then
begin SetCurShape($20,0); Exit; end;
SetCurShape($20,0); J:=0;
for I:=1 to Length(St) do if St[I] in [':','\'] then J:=1;
if (J=0) and (TestDir('*.*',2)=1) then begin
GetFiles(St); Mask:=St; { 2=Dir }
end else begin
TextWindow1(X,Y,40,3,Color[10],Color[11],1,' Error ');
PrintText(X+2,Y+1,Color[12],'No such files or incorrect mask.');
K:=Key; K:=0;
end;
end;
{ ─────────────── SelectDrive ─────────────── }
procedure SelectDrive(X,Y:integer);
var St:string;
I,N:integer;
D:array[0..25] of char;
begin
D[0]:='A'; D[1]:='B'; N:=1;
for I:=2 to 25 do
if (TestDir(Chr(I+65)+':\*.*',1)=1) or (TestDir(Chr(I+65)+':\*.*',2)=1)
then begin Inc(N); D[N]:=Chr(I+65); end;
TextWindow1(X,Y,40,3+N div 7,Color[6],Color[7],1,' Select a Drive ');
for I:=0 to N do PrintText(X+3+5*(I mod 7),Y+1+I div 7,Color[8],D[I]+':');
I:=0;
repeat
PrintText(X+2+5*(I mod 7),Y+1+I div 7,Color[9],' '+D[I]+': ');
K:=Key;
PrintText(X+2+5*(I mod 7),Y+1+I div 7,Color[8],' '+D[I]+': ');
case K of
$4B00:Dec(I); $4D00:Inc(I); { Left,Right }
$4800:Dec(I,7); $5000:Inc(I,7); { Up,Down }
end;
if I<0 then I:=N; if I>N then I:=0;
until (K=$1C0D) or (K=$011B); { Enter,Esc }
if K=$1C0D then begin
if (TestDir(D[I]+':'+Mask,1)=1) or (TestDir(D[I]+':*.*',2)=1)
then begin
GetDir(I+1,St); ChDir(St);
GetFiles(Mask);
end else begin
TextWindow1(X,Y,40,3,Color[10],Color[11],1,' Error ');
PrintText(X+2,Y+1,Color[12],'No such files or disk not ready.');
K:=Key;
end;
end;
K:=0;
end;
{ ─────────────── PrintFile ─────────────── }
procedure PrintFile(X,Y,Color,No:integer);
begin
TextBar(X,Y,14,1,Color,' ');
if No>=DirNum then PrintText(X+1,Y,Color,Files[No])
else PrintText(X+1,Y,Color,Files[No]+'\');
end;
{ ─────────────── ShowPage ─────────────── }
procedure ShowPage(X,Y,PageNo:integer); { 4x10,56x10 }
var I,C:integer;
begin
PageMax:=40;
if (Max<40) or (Page=(Max-1) div 40) then PageMax:=(Max-1) mod 40+1;
for I:=0 to PageMax-1 do begin
if PageNo*40+I>=DirNum then C:=Color[3] else C:=Color[5];
PrintFile(X+14*(I and 3),Y+I shr 2,C,40*PageNo+I);
end;
for I:=PageMax to 39 do
TextBar(X+14*(I and 3),Y+I shr 2,14,1,Color[1],' ');
end;
{ ─────────────── PrintMask ─────────────── }
procedure PrintMask(X,Y,Color:integer);
var St:string;
begin
GetDir(0,St);
if St[Length(St)]<>'\' then St:=St+'\';
TextBar(X,Y,55,1,Color,' ');
PrintText(X,Y,Color,St+Mask);
end;
{ ─────────────── SelectFile ─────────────── }
procedure SelectFile(X,Y:integer); { 58x13 }
var C,K2:integer;
St:string;
Buf:array[0..3999] of byte;
begin
if (TestDir('*.*',1)=0) and (TestDir('*.*',2)=0) then begin
Writeln('Can''t find any file or directory !'); Halt(1); end;
GetDir(0,St);
GetText(1,1,80,25,Buf);
SetCurShape($20,0);
TextBar(1,1,80,1,Color[13],' '); TextBar(1,25,80,1,Color[13],' ');
PrintText(3,1,Color[13],'Directory...Select a File');
PrintText(3,25,Color[13],'Arrows,PgUp,PgDn,Home,End,1~9,A~Z-Select'+
' /-Mask *-Drive Enter-Do Esc-Quit');
TextWindow1(X,Y,58,13,Color[1],Color[2],1,' Select a File ');
Mask:='*.*'; GetFiles(Mask);
PrintMask(X+2,Y+1,Color[2]);
ShowPage(X+1,Y+2,0);
repeat
PrintFile(X+1+14*(No and 3),Y+2+No shr 2,Color[4],40*Page+No);
K:=Key; K2:=K mod 256;
if 40*Page+No>=DirNum then C:=Color[3] else C:=Color[5];
PrintFile(X+1+14*(No and 3),Y+2+No shr 2,C,40*Page+No);
case K of
$4B00:Dec(No); $4D00:Inc(No); { Left,Right }
$4800:Dec(No,4); $5000:Inc(No,4); { Up,Down }
$4700:No:=0; $4F00:No:=PageMax-1; { Home,End }
$4900:if Page>0 then { PgUp}
begin Dec(Page); ShowPage(X+1,Y+2,Page); end;
$5100:if Page<(Max-1) div 40 then { PgDn }
begin Inc(Page); ShowPage(X+1,Y+2,Page); end;
$352F:begin { / }
FilesMask(X+8,Y+5);
PrintMask(X+2,Y+1,Color[2]);
ShowPage(X+1,Y+2,Page);
end;
$372A,$092A:begin { * }
SelectDrive(X+8,Y+5);
PrintMask(X+2,Y+1,Color[2]);
ShowPage(X+1,Y+2,Page);
end;
$1C0D:if 40*Page+No<DirNum then begin { Enter }
ChDir(Files[40*Page+No]);
GetFiles(Mask);
PrintMask(X+2,Y+1,Color[2]);
ShowPage(X+1,Y+2,Page);
end;
end;
if K2 in [48..57,65..90,97..122] then begin { 0..9, A..Z, a..Z }
if K2>=97 then Dec(K2,32);
for C:=DirNum to Max-1 do if Files[C,1]=Chr(K2) then begin
Page:=C div 40; ShowPage(X+1,Y+2,Page);
No:=C mod 40; C:=Max-1;
end;
end;
if No<0 then No:=PageMax-1;
if No>PageMax-1 then No:=0;
until K=$011B; { Esc }
PutText(1,1,80,25,Buf);
ChDir(St);
end;
begin
SelectFile(12,6);
VideoMode(3);
end.