program Oak_Tree; (* This version is for TURBO Pascal 4.0 *)
(* XXX X X X XXXXX XXXX XXXXX XXXXX
Jan 15, 1988 X X X X X X X X X X X
X X X X X X X X X X X
X X X X XX X XXXX XXX XXX
X X XXXXX X X X X X X X
X X X X X X X X X X X
XXX X X X X X X X XXXXX XXXXX
*)
uses Dos, Printer;
const Page_Size = 66;
Max_Lines = 55;
type Command_String = string[127];
Output_Type = (Directories,Files);
Dir_Rec = ^Dirtree; (* Dynamic storage for dir names *)
Dirtree = record
Next : Dir_Rec;
Dir_Name : string[12];
end;
Filerec = ^Filetree; (* Dynamic storage for the *)
Filetree = record (* filename sorting tree *)
Left : Filerec;
Right : Filerec;
FileData : SearchRec; (* From Dos module *)
end;
(* Record definition from page 408 of the TURBO Pascal 4.0 manual *)
(* type SearchRec = record *)
(* Fill : array[1..21] of byte; *)
(* Attr : byte; *)
(* Time : longint; *)
(* Size : longint; *)
(* Name : string[12]; *)
(* end; *)
var File_Record : SearchRec; (* A working file record *)
File_Point : Filerec; (* Pointer to a file record *)
Page_Number : integer;
Line_Number : integer;
Directory_Count : integer;
Recpack : Registers; (* From Dos module *)
File_Request : string[25];
Root_Mask : Command_String;(* Used for vol-label search *)
Starting_Path : Command_String;
Total_Clusters : longint;
Disk_Total_Bytes : longint;
Cluster_Size : integer;
Sectors_Per_Cluster : integer;
Bytes_Per_Sector : integer;
Free_Clusters : longint;
Free_Bytes : longint;
Total_Cbytes : longint;
Total_Bytes : longint;
All_Files : integer; (* Number of files on disk *)
Req_Files : integer; (* Number of files in request *)
Do_We_Print : boolean; (* Print or not *)
Do_All_Stats : boolean; (* List all disk stats? *)
No_Files_Out : boolean; (* List no files *)
Date_Time_Rec : DateTime; (* From Dos module *)
(* **************************************************** Initialize *)
(* This procedure is used to initialize some variables and strings *)
(* prior to starting the disk search. *)
procedure Initialize;
begin
Page_Number := 1;
Line_Number := 1;
Directory_Count := 0;
Total_Cbytes := 0;
Total_Bytes := 0;
All_Files := 0;
Req_Files := 0;
Root_Mask := 'C:\*.*';
Root_Mask[Length(Root_Mask) + 1] := Chr(0);
(* Get the current default drive letter *)
Recpack.AX := $1900;
Intr($21,Recpack);
Root_Mask[1] := Chr(Recpack.AX and $F + Ord('A'));
end;
(* ****************************** Read And Parse Command Arguments *)
(* This procedure reads in the command line arguments, parses them,*)
(* and sets up the switches and defaults for the disk searches. *)
procedure Read_And_Parse_Command_Arguments;
var Parameters : Command_String;
Index : byte;
begin
Do_We_Print := FALSE;
Do_All_Stats := FALSE;
No_Files_Out := FALSE;
File_Request := '*.*';
for Index := 1 to ParamCount do begin
Parameters := ParamStr(Index);
Writeln(Parameters); (* ************ Temporary ***************)
(* Find command line switches *)
if Parameters[1] = '/' then begin
if Upcase(Parameters[2]) = 'P' then Do_We_Print := TRUE;
if Upcase(Parameters[2]) = 'N' then No_Files_Out := TRUE;
if Upcase(Parameters[2]) = 'S' then Do_All_Stats := TRUE;
end
else begin (* Find designated drive letter *)
if Parameters[2] = ':' then begin
Root_Mask[1] := Parameters[1];
Delete(Parameters,1,2);
end;
if Parameters = '' then (* No filename given *)
File_Request := '*.*'
else (* Filename listed *)
File_Request := Parameters;
end;
end;
(* get the current path on the selected drive *)
Getdir(Ord(Root_Mask[1])-Ord('A') + 1,Starting_Path);
if Length(Starting_Path) > 3 then
Starting_Path := Starting_Path + '\';
end;
(* ********************************************* count print lines *)
procedure Count_Print_Lines(Line_Count : byte);
var Count : byte;
begin
if Do_We_Print then begin
if Line_Count > 250 then (* This signals the end of the tree *)
begin (* Space up to a new page *)
for Count := Line_Number to (Page_Size - 3) do
Writeln(Lst);
Line_Number := 1;
Line_Count := 0;
end;
Line_Number := Line_Number + Line_Count;
if Line_Number > Max_Lines then begin
Page_Number := Page_Number +1;
for Count := Line_Number to (Page_Size - 2) do
Writeln(Lst);
Writeln(Lst,' Page',
Page_Number:4);
Writeln(Lst);
Line_Number := 1;
end;
end;
end;
(* ************************************************** Print Header *)
(* In this section of code, the volume label is found and displayed*)
(* and the present time and date are determined and displayed. *)
procedure Print_Header;
var Year,Month,Day,DayOfWeek : word;
Hour,Minute,Second,Sec100 : word;
Index : integer;
begin
if Do_We_Print then begin
Writeln(Lst);
Writeln(Lst);
Writeln(Lst);
Write(Lst,' Directory for ');
end;
Write(' Directory for ');
{ Recpack.AX := $1A00; (* Set up the DTA *)
Recpack.DS := Seg(Dta);
Recpack.DX := Ofs(Dta);
Msdos(Recpack); (* DTA setup complete *)
Error := Recpack.AX and $FF;
if Error > 0 then Writeln('DTA setup error ',Error);
}
FindFirst(Root_Mask,$08,File_Record); (* Get the volume ID *)
if ((DosError > 0) or (File_Record.Attr <> 8)) then begin
if Do_We_Print then
Write(Lst,' <no vol label> ');
Write(' <no vol label> ');
end
else begin (* Write out Volume Label *)
if Do_we_Print then
Write(Lst,File_Record.Name);
Write(File_Record.Name);
end;
GetDate(Year,Month,Day,DayOfWeek); (* Get the present date *)
GetTime(Hour,Minute,Second,Sec100); (* Get the present time *)
Write(' ');
Write(Month,'/',Day,'/',Year);
Writeln(' ',Hour,':',Minute);
Writeln;
if Do_We_Print then begin
Write(Lst,' ');
Write(Lst,Month,'/',Day,'/',Year);
Writeln(Lst,' ',Hour,':',Minute);
Writeln(Lst);
Count_Print_Lines(2);
end;
(* get all of the disk constants *)
Recpack.AX := $3600;
Recpack.DX := (Ord(Root_Mask[1]) - 64) and $F;
Msdos(Recpack);
Sectors_Per_Cluster := Recpack.AX;
Free_Clusters := Recpack.BX;
Bytes_Per_Sector := Recpack.CX;
Total_Clusters := Recpack.DX;
Cluster_Size := Bytes_Per_Sector * Sectors_Per_Cluster;
if Do_All_Stats then begin (* Print out disk stats if asked for *)
Write(' bytes/sector =',Bytes_Per_Sector:6);
Disk_Total_Bytes := Total_Clusters * Cluster_Size;
Writeln(' total disk space =',Disk_Total_Bytes:12);
Write(' bytes/cluster =',Cluster_Size:6);
Free_Bytes := Free_Clusters * Cluster_Size;
Writeln(' free disk space =',Free_Bytes:12);
Writeln;
if Do_We_Print then begin
Write(Lst,' bytes/sector =',Bytes_Per_Sector:6);
Writeln(Lst,' total disk space =',
Disk_Total_Bytes:12);
Write(Lst,' bytes/cluster =',Cluster_Size:6);
Writeln(Lst,' free disk space =',Free_Bytes:12);
Writeln(Lst);
Count_Print_Lines(3);
end;
end;
end;
(* *************************************** Position a new filename *)
(* When a new filename is found, this routine is used to locate it *)
(* in the B-TREE that will be used to sort the filenames alphabet- *)
(* ically. *)
procedure Position_A_New_Filename(Root, New : Filerec);
var Index : integer;
Done : boolean;
begin
Index := 1;
Done := FALSE;
repeat
if New^.FileData.Name < Root^.FileData.Name then begin
Done := TRUE;
if Root^.Left = nil then Root^.Left := New
else
Position_A_New_Filename(Root^.Left,New);
end
else if New^.FileData.Name > Root^.FileData.Name then
begin
Done := TRUE;
if Root^.Right = nil then
Root^.Right := New
else
Position_A_New_Filename(Root^.Right,New);
end;
Index := Index +1;
until (Index = 13) or Done;
end;
(* ************************************************** Print a file *)
(* This is used to print the data for one complete file. It is *)
(* called with a pointer to the root and an attribute that is to be*)
(* printed. Either the directories are printed (attribute = $10), *)
(* or the files are printed. *)
procedure Print_A_File(Root : Filerec;
Which_List : Output_Type);
var Index,Temp : byte;
begin
Temp := Root^.FileData.Attr;
if ((Temp = $10) and (Which_List = Directories)) or
((Temp <> $10) and (Which_List = Files)) then begin
Write(' ');
case Temp of
$27 : Write('<HID> ');
$10 : Write('<DIR> ');
$20 : Write(' ')
else Write('<',Temp:3,'> ');
end; (* of case *)
if Do_We_Print then begin
Write(Lst,' ');
case Temp of
$27 : Write(Lst,'<HID> ');
$10 : Write(Lst,'<DIR> ');
$20 : Write(Lst,' ')
else Write(Lst,'<',Temp:3,'> ');
end; (* of case *)
end;
(* Write out the filename *)
Write(Root^.FileData.Name);
for Index := 1 to (15 - Length(Root^.FileData.Name)) do
Write(' ');
if Do_We_Print then begin
Write(Lst,Root^.FileData.Name);
for Index := 1 to (15 - Length(Root^.FileData.Name)) do
Write(Lst,' ');
end;
(* Write out the file size *)
Write(Root^.FileData.Size:9);
if Do_We_Print then
Write(Lst,Root^.FileData.Size:9);
(* Write out the file date and time *)
UnpackTime(Root^.FileData.Time, Date_Time_Rec);
Write(' ',Date_Time_Rec.Month:2,'/');
Write(Date_Time_Rec.Day:2,'/');
Write(Date_Time_Rec.Year,' ');
Write(' ',Date_Time_Rec.Hour:2,':');
Writeln(Date_Time_Rec.Min:2);
if Do_We_Print then begin
Write(Lst,' ',Date_Time_Rec.Month:2,'/');
Write(Lst,Date_Time_Rec.Day:2,'/');
Write(Lst,Date_Time_Rec.Year,' ');
Write(Lst,' ',Date_Time_Rec.Hour:2,':');
Writeln(Lst,Date_Time_Rec.Min:2);
Count_Print_Lines(1);
end;
end;
end;
(* ********************************************* Print a directory *)
(* This is a recursive routine to print out the filenames in alpha-*)
(* betical order. It uses a B-TREE with "infix" notation. The *)
(* actual printing logic was removed to another procedure so that *)
(* the recursive part of the routine would not be too large and *)
(* fill up the heap too fast. *)
procedure Print_A_Directory(Root : Filerec;
Which_List : Output_Type);
begin
if Root^.Left <> nil then
Print_A_Directory(Root^.Left,Which_List);
Print_A_File(Root,Which_List); (* Write out the filename *)
if Root^.Right <> nil then
Print_A_Directory(Root^.Right,Which_List);
end;
(* **************************************************** Erase tree *)
(* After the directory is printed and counted, it must be erased or*)
(* the "heap" may overflow for a large disk with a lot of files. *)
procedure Erase_Tree(Root : Filerec);
begin
if Root^.Left <> nil then Erase_Tree(Root^.Left);
if Root^.Right <> nil then Erase_Tree(Root^.Right);
Dispose(Root);
end;
(* ************************************************ Do A Directory *)
(* This procedure reads all entries in any directory and sorts the *)
(* filenames alphabetically. Then it prints out the complete stat-*)
(* istics, and calls itself to do all of the same things for each *)
(* of its own subdirectories. Since each subdirectory also calls *)
(* each of its subdirectories, the recursion continues until there *)
(* are no more subdirectories. *)
procedure Do_A_Directory(Input_Mask : Command_String);
var Mask : Command_String;
Count,Index : integer;
Cluster_Count : longint;
Cluster_Bytes : longint;
Byte_Count : longint;
Tree_Root : Filerec; (* Root of file tree *)
Dir_Root : Dir_Rec;
Dir_Point : Dir_Rec;
Dir_Last : Dir_Rec;
File_Record : SearchRec;
(* This embedded procedure is called upon to store all of the *)
(* directory names in a linear linked list rather than a *)
(* B-TREE since it should be rather short and efficiency of *)
(* sorting is not an issue. A bubble sort will be used on it. *)
procedure Store_Dir_Name;
begin
if File_Record.Attr = $10 then begin (* Pick out directories*)
(* Directory name found, ignore if it is a '.' *)
if File_Record.Name[1] <> '.' then begin
New(Dir_Point);
Dir_Point^.Dir_Name := File_Record.Name;
Dir_Point^.Next := nil;
if Dir_Root = nil then
Dir_Root := Dir_Point
else
Dir_Last^.Next := Dir_Point;
Dir_Last := Dir_Point;
end;
end;
end;
(* This is the procedure that sorts the directory names after *)
(* they are all accumulated. It uses a bubble sort technique *)
(* which is probably the most inefficient sort available. It *)
(* is perfectly acceptable for what is expected to be a very *)
(* short list each time it is called. More than 30 or 40 *)
(* subdirectories in one directory would not be good practice *)
(* but this routine would sort any number given to it. *)
procedure Sort_Dir_Names;
var Change : byte;
Save_String : string[15];
Dir_Next : Dir_Rec;
begin
repeat
Change := 0;
Dir_Point := Dir_Root;
while Dir_Point^.Next <> nil do
begin
Dir_Next := Dir_Point^.Next;
Save_String := Dir_Next^.Dir_Name;
if Save_String < Dir_Point^.Dir_Name then begin
Dir_Next^.Dir_Name := Dir_Point^.Dir_Name;
Dir_Point^.Dir_Name := Save_String;
Change := 1;
end;
Dir_Point := Dir_Point^.Next;
end;
until Change = 0; (* No swaps in this pass, we are done *)
end;
begin (* Do_A_Directory procedure *)
Count := 0;
Cluster_Count := 0;
Dir_Root := nil;
Mask := Input_Mask + '*.*';
Mask[Length(Mask) + 1] := Chr(0); (* A trailing zero for DOS *)
(* Count all files and clusters *)
repeat
if Count = 0 then (* Get first directory entry *)
FindFirst(Mask,$17,File_Record)
else (* Get additional directory entries *)
FindNext(File_Record);
if DosError = 0 then begin (* A good filename is found *)
Count := Count +1; (* Add one for a good entry *)
(* Count up the number of clusters used *)
Index := File_Record.Size div Cluster_size;
if File_Record.Size mod Cluster_Size > 0 then
Index := Index + 1; (* If a fractional part *)
Cluster_Count := Cluster_Count + Index;
if Index = 0 then (* This is a directory, one cluster *)
Cluster_Count := Cluster_Count + 1;
Store_Dir_Name;
end;
until DosError > 0;
Cluster_Bytes := Cluster_Count * Cluster_Size;
Directory_Count := Directory_Count + 1;
Write(' ',Directory_Count:3,'. ');
Write(Input_Mask);
for Index := 1 to (32 - Length(Input_Mask)) do Write(' ');
Writeln(Count:4,' Files Cbytes =',Cluster_Bytes:9);
if Do_We_Print then begin
Write(Lst,' ',Directory_Count:3,'. ');
Write(Lst,Input_Mask);
for Index := 1 to (32 - Length(Input_Mask)) do Write(Lst,' ');
Writeln(Lst,Count:4,' Files Cbytes =',Cluster_Bytes:9);
Count_Print_Lines(1);
end;
Total_Cbytes := Total_Cbytes + Cluster_Bytes;
All_Files := All_Files + Count;
(* files counted and clusters counted *)
(* Now read in only the requested files *)
Count := 0;
Byte_Count := 0;
Tree_Root := nil;
if No_Files_Out <> TRUE then begin
Mask := Input_Mask + File_Request;
Mask[Length(Mask) + 1] := Chr(0); (* A trailing zero for DOS *)
repeat
New(File_Point);
if Count = 0 then (* Get first directory entry *)
FindFirst(Mask,$17,File_Record)
else (* Get additional directory entries *)
FindNext(File_Record);
if DosError = 0 then begin (* A good filename is found *)
Count := Count +1; (* Add one for a good entry *)
File_Point^.Left := nil;
File_Point^.Right := nil;
File_Point^.FileData := File_Record;
if Tree_Root = nil then begin (* Pt to 1st elem in tree*)
Tree_Root := File_Point;
end
else begin (* Point to additional elements in tree *)
Position_A_New_Filename(Tree_Root,File_Point);
end;
Byte_Count := Byte_Count + File_Record.Size;
end;
until DosError > 0;
end;
if Tree_Root <> nil then
Print_A_Directory(Tree_Root,Directories);
if Tree_Root <> nil then
Print_A_Directory(Tree_Root,Files);
if Count > 0 then begin
Writeln(' ',Count:5,' Files ',
Byte_Count:17,' Bytes');
Writeln;
if Do_We_Print then begin
Writeln(Lst,' ',Count:5,' Files ',
Byte_Count:17,' Bytes');
Writeln(Lst);
Count_Print_Lines(2);
end;
Total_Bytes := Total_Bytes + Byte_Count;
Req_Files := Req_Files + Count;
end;
(* Now go do all of the subdirectories *)
if Dir_Root <> nil then Sort_Dir_Names;
Dir_Point := Dir_Root;
while Dir_Point <> nil do begin
Mask := Input_Mask + Dir_Point^.Dir_Name + '\';
Do_A_Directory(Mask);
Dir_Point := Dir_Point^.Next;
end;
(* Finally, erase the tree and the list *)
if Tree_Root <> nil then
Erase_Tree(Tree_Root);
while Dir_Root <> nil do begin
Dir_Point := Dir_Root^.Next;
Dispose(Dir_Root);
Dir_Root := Dir_Point;
end;
end;
(* ******************************************* Output Summary Data *)
procedure Output_Summary_Data;
begin
Writeln;
Write(' ',Req_Files:5,' Files');
Writeln(Total_Bytes:15,' Bytes in request');
Write(' ',All_Files:5,' Files');
Writeln(Total_Cbytes:15,' Cbytes in tree');
Write(' ');
Free_Bytes := Free_Clusters * Cluster_Size;
Writeln(Free_Bytes:12,' Bytes free on disk');
if Do_We_Print then begin
Writeln(Lst);
Write(Lst,' ',Req_Files:5,' Files');
Writeln(Lst,Total_Bytes:15,' Bytes in request');
Write(Lst,' ',All_Files:5,' Files');
Writeln(Lst,Total_Cbytes:15,' Cbytes in tree');
Write(Lst,' ');
Writeln(Lst,Free_Bytes:12,' Bytes free on disk');
Count_Print_Lines(4); (* Signal the end, space paper up *)
end;
end;
begin (* Main program - Oak Tree ******************************** *)
Initialize;
Read_And_Parse_Command_Arguments;
Print_Header;
Do_A_Directory(Starting_Path);
Output_Summary_Data;
Count_Print_Lines(255);
end. (* Main Program *)
