PROGRAM Oak_tree; (* XXX X X X XXXXX XXXX XXXXX XXXXX July 14, 1986 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 *) CONST page_size = 66; max_lines = 55; TYPE command_string = STRING[127]; output_type = (directories,files); REGPACK = RECORD AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS:INTEGER; END; dir_rec = ^DIRTREE; (* Dynamic storage for dir names *) DIRTREE = RECORD next : dir_rec; dir_name : STRING[15]; END; filerec = ^FILETREE; (* Dynamic storage for the *) FILETREE = RECORD (* filename sorting tree *) left : filerec; right : filerec; CASE BOOLEAN OF TRUE : (attribute : BYTE; file_time : ARRAY[1..2] OF BYTE; file_date : ARRAY[1..2] OF BYTE; file_size : ARRAY[1..4] OF BYTE; file_name : ARRAY[1..13] OF CHAR); FALSE : (file_rec : ARRAY[1..23] OF CHAR); END; VAR file_point : filerec; (* Pointer to a file record *) page_number : INTEGER; line_number : INTEGER; directory_count : INTEGER; recpack : REGPACK; dta : ARRAY[1..43] OF CHAR; (* Disk xfer address *) file_request : STRING[25]; root_mask : command_string; (* Used for vol-label search *) starting_path : command_string; cluster_size : INTEGER; sectors_per_cluster : INTEGER; free_clusters : INTEGER; bytes_per_sector : INTEGER; total_clusters : INTEGER; do_we_print : BOOLEAN; (* Print or not *) do_all_stats : BOOLEAN; (* List all disk stats? *) no_files_out : BOOLEAN; (* List no files *) which_list : output_type; real_size : REAL; r1,r2,r3 : REAL; total_cbytes : REAL; total_bytes : REAL; all_files : INTEGER; req_files : INTEGER; (* ***************************************************** 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_input : command_string ABSOLUTE CSEG:$80; parameters : command_string; index : BYTE; temp_store : CHAR; BEGIN do_we_print := FALSE; do_all_stats := FALSE; no_files_out := FALSE; (* First, preserve the input area to allow F3 to repeat *) FOR index := 0 TO length(parameters_input) DO parameters[index] := parameters_input[index]; FOR index := 1 TO length(parameters) DO BEGIN (* Find designated drive letter *) IF ((parameters[index] = ':') AND (index > 1)) THEN BEGIN root_mask[1] := parameters[index-1]; parameters[index-1] := ' '; parameters[index] := ' '; END; (* Find command line switches *) IF (parameters[index] = '/') AND (index < length(parameters)) THEN BEGIN temp_store := upcase(parameters[index + 1]); IF temp_store = 'P' THEN do_we_print := TRUE; IF temp_store = 'N' THEN no_files_out := TRUE; IF temp_store = 'S' THEN do_all_stats := TRUE; parameters[index] := ' '; parameters[index+1] := ' '; 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 + '\'; (* Finally, find the file name mask for searching *) REPEAT (* Remove leading blanks *) IF parameters[1] = ' ' THEN delete(parameters,1,1); UNTIL (parameters[1] <> ' ') OR (length(parameters) = 0); index := 0; (* Remove everything trailing the first entry *) REPEAT index := index + 1; UNTIL (parameters[index] = ' ') OR (index=length(parameters) + 1); delete(parameters,index,127); IF parameters = '' THEN file_request := '*.*' ELSE file_request := parameters; 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 month,day,hour,minute : STRING[2]; year : STRING[4]; error : INTEGER; attribute : BYTE; temp : BYTE; done : BOOLEAN; 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); recpack.AX := $4E00; (* Get the volume ID *) recpack.DS := seg(root_mask[1]); recpack.DX := ofs(root_mask[1]); recpack.CX := 8; intr($21,recpack); error := recpack.AX AND $FF; attribute := $1F AND mem[seg(dta):ofs(dta) + 21]; IF ((error > 0) OR (attribute <> 8)) THEN BEGIN IF do_we_print THEN WRITE(lst,' '); WRITE(' '); END ELSE BEGIN (* Write out Volume Label *) done := FALSE; FOR index := 30 TO 40 DO BEGIN temp := mem[seg(dta):ofs(dta) + index]; IF temp = 0 THEN done := TRUE; IF done = FALSE THEN BEGIN IF do_we_print THEN WRITE(lst,chr(temp)); WRITE(chr(temp)); END; END; END; WRITE(' '); IF do_we_print THEN WRITE(lst,' '); recpack.AX := $2A00; (* Get the present date *) msdos(recpack); str(recpack.CX:4,Year); str((recpack.DX MOD 256):2,day); str((recpack.DX SHR 8):2,month); IF day[1] = ' ' THEN day[1] := '0'; WRITE(month,'/',day,'/',year); IF do_we_print THEN WRITE(lst,month,'/',day,'/',year); recpack.AX := $2C00; (* Get the present time *) msdos(recpack); str((recpack.CX SHR 8):2,hour); str((recpack.CX MOD 256):2,minute); IF minute[1] = ' ' THEN minute[1] := '0'; WRITELN(' ',hour,':',minute); WRITELN; IF do_we_print THEN BEGIN 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 (* Print out disk statistics if asked for *) BEGIN WRITE(' bytes/sector =',bytes_per_sector:6); r1 := total_clusters; r2 := cluster_size; r1 := r1 *r2; WRITELN(' total disk space =',r1:12:0); WRITE(' bytes/cluster =',cluster_size:6); r3 := free_clusters; r2 := r3 * r2; WRITELN(' free disk space =',r2:12:0); WRITELN; IF do_we_print THEN BEGIN WRITE(lst,' bytes/sector =',bytes_per_sector:6); WRITELN(lst,' total disk space =',r1:12:0); WRITE(lst,' bytes/cluster =',cluster_size:6); WRITELN(lst,' free disk space =',r2:12:0); 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^.file_name[index] < root^.file_name[index] THEN BEGIN done := TRUE; IF root^.left = nil THEN root^.left := new ELSE position_a_new_filename(root^.left,new); END ELSE IF new^.file_name[index] > root^.file_name[index] 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; temp_string : STRING[25]; day : STRING[2]; BEGIN temp := root^.attribute; IF ((temp = $10) AND (which_list = directories)) OR ((temp <> $10) AND (which_list = files)) THEN BEGIN WRITE(' '); CASE temp OF $27 : WRITE(' '); $10 : WRITE(' '); $20 : WRITE(' ') ELSE WRITE('<',temp:3,'> '); END; (* of CASE *) IF do_we_print THEN BEGIN WRITE(lst,' '); CASE temp OF $27 : WRITE(lst,' '); $10 : WRITE(lst,' '); $20 : WRITE(lst,' ') ELSE WRITE(lst,'<',temp:3,'> '); END; (* of CASE *) END; temp_string := ' '; index := 1; REPEAT temp := ord(root^.file_name[index]); IF temp > 0 THEN temp_string[index] := root^.file_name[index]; index := index + 1; UNTIL (temp = 0) OR ( index = 14); temp_string[0] := chr(15); WRITE(temp_string); IF do_we_print THEN WRITE(lst,temp_string); (* Write out the file size *) r1 := root^.file_size[1]; r2 := root^.file_size[2]; r3 := root^.file_size[3]; real_size := r3*65536.0 + r2 * 256.0 + r1; WRITE(real_size:9:0); IF do_we_print THEN WRITE(lst,real_size:9:0); (* Write out the file date *) temp := ((root^.file_date[1] SHR 5) AND $7); WRITE(' ',(temp + ((root^.file_date[2] AND 1) SHL 3)):2,'/'); IF do_we_print THEN WRITE(lst,' ', (temp+((root^.file_date[2] AND 1) SHL 3)):2,'/'); str((root^.file_date[1] AND $1F):2,day); IF day[1] = ' ' THEN day[1] := '0'; WRITE(day,'/'); WRITE(80 + ((root^.file_date[2] SHR 1) AND $7F),' '); IF do_we_print THEN BEGIN WRITE(lst,day,'/'); WRITE(lst,80 + ((root^.file_date[2] SHR 1) AND $7F),' '); END; (* Write out the file time *) WRITE(' ',((root^.file_time[2] SHR 3) AND $1F):2,':'); IF do_we_print THEN WRITE(lst,' ',((root^.file_time[2] SHR 3) AND $1F):2,':'); temp := ((root^.file_time[2]) AND $7) SHL 3; str((temp + ((root^.file_time[1] SHR 5) AND $7)):2,day); IF day[1] = ' ' THEN day[1] := '0'; WRITELN(day); IF do_we_print THEN BEGIN WRITELN(lst,day); 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 *) (* 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); (* Write out the filename *) print_a_file(root,which_list); 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; error : BYTE; cluster_count : INTEGER; byte_count : REAL; tree_root : filerec; (* Root of file tree *) dir_root : dir_rec; dir_point : dir_rec; dir_last : dir_rec; (* 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; VAR temp_string : STRING[15]; temp : BYTE; index : BYTE; BEGIN temp := mem[seg(dta):ofs(dta) + 21]; (* Attribute *) IF temp = $10 THEN (* Pick out directories *) BEGIN index := 1; REPEAT temp := mem[seg(dta):ofs(dta) + 29 + index]; IF temp > 0 THEN temp_string[index] := chr(temp); index := index + 1; UNTIL (temp = 0) OR (index = 14); temp_string[0] := chr(index - 2); (* Directory name found, ignore if it is a '.' *) IF temp_string[1] <> '.' THEN BEGIN new(dir_point); dir_point^.dir_name := temp_string; 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 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 BEGIN (* Get first directory entry *) recpack.AX := $4E00; recpack.DS := seg(mask[1]); recpack.DX := ofs(mask[1]); recpack.CX := $17; (* Attribute for all files *) intr($21,recpack); END ELSE BEGIN (* Get additional directory entries *) recpack.AX := $4F00; intr($21,recpack); END; error := recpack.AX AND $FF; IF error = 0 THEN (* A good filename is found *) BEGIN count := count +1; (* Add one for a good entry *) (* Count up the number of clusters used *) r1 := mem[seg(dta):ofs(dta) + 26]; r2 := mem[seg(dta):ofs(dta) + 27]; r3 := mem[seg(dta):ofs(dta) + 28]; real_size := r3*65536.0 + r2 * 256.0 + r1; (*Nmbr of bytes*) r1 := cluster_size; r1 := real_size/r1; (* Number of clusters *) index := trunc(r1); r2 := index; IF (r1 - r2) > 0.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 error > 0; r1 := cluster_count; r2 := cluster_size; r1 := r1 * r2; 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 =',r1:9:0); 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 =',r1:9:0); count_print_lines(1); END; total_cbytes := total_cbytes + r1; 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 BEGIN (* Get first directory entry *) recpack.AX := $4E00; recpack.DS := seg(mask[1]); recpack.DX := ofs(mask[1]); recpack.CX := $17; (* Attribute for all files *) intr($21,recpack); END ELSE BEGIN (* Get additional directory entries *) recpack.AX := $4F00; intr($21,recpack); END; error := recpack.AX AND $FF; IF error = 0 THEN (* A good filename is found *) BEGIN count := count +1; (* Add one for a good entry *) file_point^.left := nil; file_point^.right := nil; FOR index := 1 TO 23 DO file_point^.file_rec[index] := char(mem[seg(dta):ofs(dta) + 20 + index]); IF tree_root = nil THEN BEGIN (* Point to first element in tree *) tree_root := file_point; END ELSE BEGIN (* Point to additional elements in tree *) position_a_new_filename(tree_root,file_point); END; (* Count up the number of bytes used *) r1 := file_point^.file_size[1]; r2 := file_point^.file_size[2]; r3 := file_point^.file_size[3]; real_size := r3*65536.0 + r2 * 256.0 + r1; (*Number of *) (* bytes used. *) byte_count := byte_count + real_size; END; UNTIL error > 0; END; which_list := directories; IF tree_root <> nil THEN print_a_directory(tree_root,which_list); IF tree_root <> nil THEN print_a_directory(tree_root,succ(which_list)); IF count > 0 THEN BEGIN WRITELN(' ',count:5,' Files ', byte_count:17:0,' Bytes'); WRITELN; IF do_we_print THEN BEGIN WRITELN(lst,' ',count:5,' Files ', byte_count:17:0,' 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:0,' Bytes in request'); WRITE(' ',all_files:5,' Files'); WRITELN(total_cbytes:15:0,' Cbytes in tree'); WRITE(' '); r1 := free_clusters; r2 := cluster_size; r1 := r1 * r2; WRITELN(r1:12:0,' Bytes free on disk'); IF do_we_print THEN BEGIN WRITELN(lst); WRITE(lst,' ',req_files:5,' Files'); WRITELN(lst,total_bytes:15:0,' Bytes in request'); WRITE(lst,' ',all_files:5,' Files'); WRITELN(lst,total_cbytes:15:0,' Cbytes in tree'); WRITE(lst,' '); WRITELN(lst,r1:12:0,' 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 *)