Category : Pascal Source Code
Archive   : DRAWTREE.ZIP
Filename : DRAWTREE.PAS

{$G512,P512}

program DrawTree;

{ This program prints a tree listing of the subdirectories on the
drive or directory specified in the command line (if compiled
to a .COM file--e.g. drawtree c:) or in the Command Line
Parameters (specified in the Options menu of Turbo).

If you don't use extensions on your directory names, as most
people don't, change the "*.*" in line 71 to "*." This will
speed up searching by about 50 percent.

}

type DTARec = record
reserved: array [1..21] of char;
attr: byte;
other: array [1..4] of integer;
name: array [1..13] of char;
end;

RegRec = record
AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: integer;
end;

String64 = string [64];

var DTA: array [1..32] of DTARec;
Reg: RegRec;
NameStr: string [13];

procedure SetDTA (Level: integer);

begin
Reg.AX:= $1A00;
Reg.DX:= ofs (DTA[Level]);
Reg.DS:= seg (DTA[Level]);
intr ($21,Reg);
end;

function FindFirst (search: String64; Level: integer): integer;

begin
SetDTA (Level);
Reg.AX:= $4E00;
Reg.CX:= $0010;
Reg.DX:= ofs (search) + 1;
Reg.DS:= seg (search);
intr ($21, Reg);
if ((Reg.Flags and 1) = 0)
then FindFirst:= 0
else FindFirst:= Reg.AX;
end;

function FindNext (Level: integer): integer;

begin
SetDTA (Level);
Reg.AX:= $4F00;
intr ($21,Reg);
if ((Reg.Flags and 1) = 0)
then FindNext:= 0
else FindNext:= Reg.AX
end;

function ListDir (search: String64; Level: integer): integer;
var i,RetCode: integer;

begin
RetCode:= FindFirst (concat (search,'\*.*'#0), Level);
if RetCode = 18
then ListDir:= 0
else if RetCode <> 0
then ListDir:= 1
else begin
repeat
with DTA [Level]
do begin
if (attr = $10) and (name[1] <> '.')
then begin
NameStr [0]:= #13;
for i:= 1 to 13 do
NameStr [i]:= name[i];
NameStr[0]:= chr (pos (#0,NameStr) - 1);
NameStr:= concat ('\',NameStr);
for i:= 2 to Level do
write (' ');
writeln (NameStr);
RetCode:= ListDir (concat (search, NameStr), Level + 1);
end;
end;
until (FindNext (Level) = 18);
ListDir:= 0;
end;
end;

begin
if ListDir (paramstr(1), 1) = 1
then writeln ('Incorrect parameter');
end.