I2010506%DBSTU1.BITNET@cunyvm.cuny.edu (07/29/89)
Date: 28 July 1989, 10:06:53 MEZ
From: Christian Boettger +49 (0)531 3915113 / I2010506 at DBSTU1
To: info-pascal at vim.brl
Some days ago, A. Verbraeck posted a TP program to view a DOS directory.
I picked up the idea and wrote a TP4 unit that shows the entire
information that you can get back by using FindFirst/FindNext.
Here it comes:
(*******************************************************************)
(*************** Turbo Pascal 4.0 unit to read a directory *********)
(*************** and display it *********)
(*******************************************************************)
unit dir;
interface
uses dos,crt;
procedure StandBy;
procedure GetDOSErrorMessage (code : integer; var message : string);
procedure ViewDir(MatchPtrn : string; FromLine : integer);
procedure ShowDir(MatchPtrn : string; var error : integer);
implementation
procedure StandBy;
var x,y : integer;
muell : char;
begin
x:=whereX; y:= WhereY;
GotoXY(20,25);
HighVideo;
write('Hit any key to continue ');
NormVideo;
repeat until keypressed;
muell := ReadKey;
GotoXY(20,25); write(' ');
GotoXY(x,y);
end;
procedure GetDOSErrorMessage (code : integer; var message : string);
begin
case code of
0 : message := 'OK';
2 : message := 'file not found';
3 : message := 'path not found';
5 : message := 'access denied';
6 : message := 'handle invalid';
8 : message := 'not enough memory';
10 : message := 'environment-parameter invalid';
11 : message := 'invalid command';
18 : message := 'no more entries/file not found';
else begin
Str(code,message);
message := 'DOS - Error Nr. ' + message;
end;
end;
end;
procedure ViewDir(MatchPtrn : string; FromLine : integer);
(********************************************************************
---------------------------------------------------------------------
Alexander Verbraeck e-mail:
Delft University of Technology winfavehdetud1.bitnet
Department of Information Systems winfavedutrun.uucp
PO Box 356, 2600 AJ The Netherlands
---------------------------------------------------------------------
********************************************************************)
var
DirInfo : SearchRec;
Line ,
Position : integer;
begin
LowVideo;
GotoXY(1,FromLine); ClrEol;
Line:=FromLine; Position:=1;
FindFirst(MatchPtrn,$37,DirInfo);
if DosError<>0 then
writeln('*** NO FILES FOUND ***')
else
while (DosError=0) and (Line<21) do
begin
GotoXY(Position,Line);
if DirInfo.Attr=$10 then HighVideo;
write(DirInfo.Name);
LowVideo;
Position:=Position+16;
if Position>65 then
begin
Line:=Line+1;
Position:=1;
end;
FindNext(DirInfo);
end;
NormVideo;
end;
procedure ShowDir(MatchPtrn : string; var error : integer);
(***********************************************************************
Christian Boettger phone: (+49) (0)531/391-5113
mail: Institut fuer Metallphysik und Nukleare Festkoerperphysik,
(room -167/-168), Technische Universitaet Braunschweig,
Mendelssohnstrasse 3, D-3300 Braunschweig, land
Bundesrepublik Deutschland (West Germany / FRG / RFA)
EARN: I2010506@DBSTU1.BITNET InterNet: boettger@julian.uwo.CA
UseNet: boettger@julian.UUCP
UUCP / UseNet:
(whereever)!uunet!watmath!julian!boettger
(whereever)!uunet!boettger@hydra.uwo.CA
(whereever)!uunet!mcvax!unido!i2010506@DBSTU1.BITNET
************************************************************************)
var DirInfo : SearchRec;
start,i,
line,ml : integer;
message : string;
procedure WriteEntry(DirInfo : SearchRec; line : integer);
var DT : DateTime;
attribut : string;
procedure GetAttribut (attr : byte; var attribut : string);
begin
case attr of
ReadOnly : attribut := 'ReadOnly';
Hidden : attribut := 'Hidden';
SysFile : attribut := 'SysFile';
VolumeID : attribut := 'VolumeID';
Directory : attribut := 'Directory';
Archive : attribut := 'Archive';
AnyFile : attribut := 'AnyFile';
else begin
Str(attr,attribut);
attribut := 'Attr = ' + attribut;
end;
end;
end;
begin (*of WriteEntry*)
with DirInfo do
begin
UnPackTime(Time,dt);
GetAttribut(attr,attribut);
GotoXY(1,line); ClrEol;
write(Name:12,' ',Size:8,' ');
with dt do
begin
write(day:2,'.',month:2,'.',year:4,' ');
write(hour:2,':',min:2,':',sec:2,' ');
end;
writeln(' ',attribut);
end;
end;(*of WriteEntry*)
begin (*of ShowDir*)
start := WhereY+1;
FindFirst(MatchPtrn,AnyFile,DirInfo);
case DOSError of
0 : begin
WriteEntry(DirInfo,start);
line := start;
while DOSError=0 do
begin
FindNext(DirInfo);
Inc(line);
if ml<=22 then ml := line;
if line>22 then begin
StandBy;
line := start;
for i:=start to ml do
begin
GotoXY(1,i);
ClrEol;
end;
end;
if DosError=0 then WriteEntry(DirInfo,line)
else begin
GotoXY(1,line); ClrEol;
writeln;ClrEol;
GetDOSErrorMessage(DOSError,message);
writeln (message,' ||');
writeln; ClrEol;
GotoXY(1,WhereY);
end;
end;
error :=0;
end;
2 : begin
GotoXY(1,start);
GetDOSErrorMessage(DOSError,message);
writeln(message,' ||');
writeln('Directory not found||');
error := DOSError;
end;
18 : begin
GotoXY(1,start);
GetDOSErrorMessage(DOSError,message);
writeln(message,' ||');
writeln('No Entries in directory that match pattern ||')
error := DOSERROR;
end;
else begin
GotoXY(1,start);
GetDOSErrorMessage(DOSError,message);
writeln(message,' ||');
error := DOSError;
end;
end;
end; (*of ShowDir*)
end.
________________________________________________________________________________
Christian Boettger phone: (+49) (0)531/391-5113
mail: Institut fuer Metallphysik und Nukleare Festkoerperphysik,
(room -167/-168), Technische Universitaet Braunschweig,
Mendelssohnstrasse 3, D-3300 Braunschweig, Bundesrepublik Deutschland
FRG / RFA
________________________________________________________________________________
EARN: I2010506@DBSTU1.BITNET InterNet: boettger@julian.uwo.CA
UseNet: boettger@julian.UUCP
UUCP / UseNet:
(whereever)!uunet!watmath!julian!boettger
(whereever)!uunet!boettger@hydra.uwo.CA
(whereever)!uunet!mcvax!unido!i2010506@DBSTU1.BITNET
********************************************************************************