home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
MISCPAS.ZIP
/
PRINTDIR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-23
|
19KB
|
757 lines
PROGRAM PDIR;
{$R+ $V+ $K+ }
TYPE
byte4 = ARRAY [1..4] OF BYTE;
txt = STRING[255];
ENTRY = RECORD
filename : ARRAY[1..8] OF BYTE;
ext : ARRAY[1..3] OF BYTE;
attr : BYTE;
reserve : ARRAY[1..10] OF BYTE;
cr_time : INTEGER;
cr_date : INTEGER;
fat_start : INTEGER;
file_size : byte4;
END;
dir_type = ARRAY [1..16] OF entry;
TYPE standardarray = ARRAY[1..512] OF STRING[8];
TYPE pointarray = ARRAY[1..512] OF INTEGER;
VAR
fat_fill : ARRAY[0..4095] OF BYTE;
dir : dir_type;
pointer : pointarray;
cluster : ARRAY [1..50] OF INTEGER;
father,son : ARRAY [0..50] OF BYTE;
i,j,k : INTEGER;
hour,min,sec,
month,day,date : BYTE;
year : INTEGER;
side,track,sector : BYTE;
no_dir : INTEGER;
no_words : INTEGER;
no_entry : INTEGER;
no_lines,no_max : INTEGER;
dir_name : ARRAY[1..50] OF STRING[50];
dir_root : STRING[20];
dir_num,dir_point : INTEGER;
parent : INTEGER;
size : REAL;
drive,cl_size,
no_sect,
first_clust,
no_side : BYTE;
first_dir : BYTE;
no_root : REAL;
file_name : standardarray;
ext_name : ARRAY [1..512] OF STRING[3];
fn_time : ARRAY [1..512] OF INTEGER;
fn_date : ARRAY [1..512] OF INTEGER;
fn_size : ARRAY [1..512] OF byte4;
vol_id : STRING[11];
one_on,want_border : BOOLEAN;
want_hidden : BOOLEAN;
want_dir : BOOLEAN;
want_deleted : BOOLEAN;
compressed : BOOLEAN;
response : INTEGER;
alpha : STRING[1];
drive_no : INTEGER;
border : STRING[80];
top_border : STRING[80];
left_border : STRING[5];
right_border : STRING[5];
side_border : STRING[1];
outfil_name : STRING[20];
outfil : TEXT;
ff,comp,EXP,
LL8,cancel : STRING[2];
short : STRING[3];
free_clusters : INTEGER;
total_clusters : INTEGER;
free_space : REAL;
total_size : REAL;
{$i biosread.inc}
{$i getfree.inc}
{$i getdate.inc}
PROCEDURE getfntime(VAR hour,min,sec :BYTE ; cr_time:INTEGER);
VAR
scratch : INTEGER;
BEGIN
scratch := cr_time SHR 5;
min := scratch MOD 64;
hour := scratch DIV 64;
sec := abs(cr_time) MOD 32;
sec := sec * 2;
END;
PROCEDURE getfndate(VAR year: INTEGER;
VAR month,day :BYTE;
cr_date:INTEGER);
BEGIN
year := 80 + (cr_date DIV 512);
month:= (cr_date MOD 512) DIV 32;
day := cr_date MOD 32;
END;
PROCEDURE getfnsize(VAR size:REAL; file_size:byte4);
BEGIN
size := file_size[1];
size := size + 256.*file_size[2];
size := size + 65536.*file_size[3];
size := size + 256.*65536.*file_size[4];
END;
FUNCTION fill_string(char_fill: txt ; no_char:BYTE): txt;
VAR
i : INTEGER;
newstring : txt;
BEGIN
newstring := '';
FOR i := 1 TO no_char DO
newstring := CONCAT(newstring,char_fill);
fill_string := newstring;
END;
FUNCTION concatc(VAR chars; no_char:BYTE): txt;
TYPE
ch_array = ARRAY[1..255] OF BYTE;
VAR
i : INTEGER;
newchars : ch_array ABSOLUTE chars;
newstring : txt;
BEGIN
newstring := '';
FOR i := 1 TO no_char DO
newstring := CONCAT(newstring,CHR(newchars[i]));
concatc := newstring;
END;
PROCEDURE read_dir (VAR dir:dir_type;
clust1 :INTEGER ; no_cluster:REAL);
VAR
lend : BOOLEAN;
clust : INTEGER;
fat_cluster,fat_offset : INTEGER;
BEGIN
no_words:= 0;
clust := clust1;
lend := FALSE;
i := 0;
WHILE NOT lend DO
BEGIN
i := i + 1;
sector := clust MOD no_sect + 1;
side := (clust DIV no_sect) MOD no_side;
track := clust DIV (no_side*no_sect);
biosread(dir[1],drive,side,track,sector,1);
FOR j := 1 TO 16 DO
BEGIN
WITH dir[j] DO
BEGIN
IF filename[1] = $00 THEN
lend := TRUE;
IF (filename[1] <> $00) AND
( (filename[1] <> $e5) OR want_deleted ) THEN
BEGIN
IF ( ( (attr AND 2) <> 2) OR want_hidden ) AND
( ( (attr AND 16) <> 16) OR want_dir) AND
( ( (attr AND 8) <> 8) OR want_dir)
THEN
BEGIN
no_words := no_words+1;
file_name[no_words] :=concatc(filename,8);
ext_name[no_words] :=concatc(ext,3);
fn_time[no_words] := cr_time;
fn_date[no_words] := cr_date;
fn_size[no_words] := file_size;
END;
IF ( (attr AND 8) = 08) THEN
BEGIN
vol_id := CONCAT( concatc(filename,8) ,
concatc(ext,3) );
WRITE(outfil,left_border,EXP,
' VOLUME NAME IS: ',VOL_ID);
IF LENGTH(cancel) <> 0 THEN
WRITELN(outfil,cancel,right_border:18)
ELSE
WRITELN(outfil,right_border:43);
no_lines := no_lines + 1;
END;
IF ( (attr AND 16) = 16) AND (CHR(filename[1]) <> '.')
AND ( filename[1] <> $e5 ) THEN
BEGIN
dir_num := dir_num + 1;
dir_name[dir_num] := dir_name[parent] +
concatc(filename,8) + '\' ;
father[dir_num] := parent;
IF son[parent] = 0 THEN
son[parent] := dir_num;
cluster[dir_num] := fat_start*cl_size + first_clust;
END;
END; { good entries}
END; {all entries}
END; {directory loop}
clust := clust + 1;
IF ( i >= (no_cluster*cl_size) ) AND (no_cluster = 1.0) THEN
BEGIN
clust1 := (clust1 - first_clust) DIV cl_size;
fat_offset := (clust1*3) DIV 2;
IF clust1 MOD 2 = 0 THEN
fat_cluster := fat_fill[fat_offset] +
( (fat_fill[fat_offset+1] MOD 16 ) * 256)
ELSE
fat_cluster := (fat_fill[fat_offset] SHR 4 ) +
(fat_fill[fat_offset+1] * 16);
IF fat_cluster > $ff0 THEN
lend := TRUE
ELSE
BEGIN
clust1 := fat_cluster*cl_size + first_clust;
clust := clust1;
i := 0;
END;
END;
END; {lend}
END; {read_dir}
PROCEDURE SWAP( VAR a,b: INTEGER );
VAR t: INTEGER;
BEGIN
t := a;
a := b;
b := t
END;
PROCEDURE bsort( start, top: INTEGER;
VAR arry: standardarray;
VAR pointer: pointarray );
{bubble sort procedure. sorts array from start to top inclusive}
VAR index: INTEGER;
switched: BOOLEAN;
BEGIN {bsort}
REPEAT
switched := FALSE;
FOR index := start TO top-1 DO
BEGIN
IF arry[pointer[index]] > arry[pointer[index+1]] THEN
BEGIN
SWAP( pointer[index] , pointer[index+1] );
switched := TRUE;
END
END;
UNTIL switched = FALSE;
END; {bsort}
PROCEDURE findmedian( start, top: INTEGER;
VAR arry: standardarray;
VAR pointer : pointarray );
{procedure to find a good median value in array and place it}
VAR middle: INTEGER;
sorted: ARRAY [1..3] OF STRING[8];
BEGIN {findmedian}
middle := (start + top) DIV 2;
sorted[1] := arry[pointer[start]];
sorted[2] := arry[pointer[top]];
sorted[3] := arry[pointer[middle]];
IF (sorted[2] > sorted[1]) AND (sorted[2] < sorted[3]) THEN
SWAP( pointer[start], pointer[middle] )
ELSE IF (sorted[3] > sorted[1]) AND (sorted[3] < sorted[2]) THEN
SWAP( pointer[start], pointer[top] );
END; {findmedian}
PROCEDURE sortsection( start, top: INTEGER;
VAR arry: standardarray;
VAR pointer : pointarray);
{procedure to sort a section of the main array, and }
{then divide it into two partitions to be sorted }
VAR swapup: BOOLEAN;
s,e,m: INTEGER;
BEGIN {sortsection}
IF top - start < 6 THEN {sort small sections with bsort}
bsort( start, top, arry , pointer )
ELSE
BEGIN
findmedian( start, top, arry , pointer );
swapup := TRUE;
{start scanning from array top}
s := start; {lower comparison limit}
e := top; {upper comparison limit}
m := start; {location of comparison value}
WHILE e > s DO
BEGIN
IF swapup = TRUE THEN
{scan downward from partition top}
{and exchange if smaller than median}
BEGIN
WHILE( arry[pointer[e]] >= arry[pointer[m]] )
AND (e > m) DO
e := e - 1;
IF e > m THEN
BEGIN
SWAP( pointer[e], pointer[m] );
m := e;
END;
swapup := FALSE;
END
ELSE
{scan upward from a partition start}
{and exchange if larger than median}
BEGIN
WHILE( arry[pointer[s]] <= arry[pointer[m]] )
AND (s < m) DO
s := s + 1;
IF s < m THEN
BEGIN
SWAP( pointer[s], pointer[m] );
m := s;
END;
swapup := TRUE;
END
END;
{sort lower half of partition}
sortsection( start, m-1, arry , pointer );
{sort upper half of partition}
sortsection( m+1, top, arry , pointer);
END
END; {sortsection}
PROCEDURE sort_dir (VAR file_name:standardarray; no_words:INTEGER);
BEGIN {qsort - main program}
FOR i := 1 TO no_words DO
pointer[i] := i;
sortsection( 1, no_words , file_name , pointer );
no_entry := (no_words+1) DIV 2;
IF no_lines + no_entry + 6 > no_max THEN
BEGIN
FOR i := no_lines TO no_max-1 DO
IF want_border THEN
WRITELN(outfil,border);
no_lines := 0;
IF want_border THEN
WRITELN(outfil,top_border);
CLRSCR;
WRITE(outfil,ff);
IF want_border THEN
WRITELN(outfil,top_border);
END;
WRITE(outfil,left_border,' ',EXP);
WRITE(outfil,'Directory:',dir_name[dir_point],
fill_string(' ',26-LENGTH(dir_name[dir_point]) ));
IF LENGTH(cancel) <> 0 THEN
WRITELN(outfil,cancel,right_border)
ELSE
WRITELN(outfil,right_border:45);
WRITELN(outfil,border);
WRITELN(outfil,border);
total_size := 0;
FOR j := 1 TO no_entry DO
BEGIN
WRITE(outfil,left_border);
FOR i := 0 TO 1 DO
BEGIN
IF j+i*no_entry <= no_words THEN
BEGIN
k := pointer[j+i*no_entry];
getfntime(hour,min,sec,fn_time[k]);
getfndate(year,month,day,fn_date[k]);
getfnsize(size,fn_size[k]);
total_size := total_size +
(cl_size*512) * INT( size/(cl_size*512) + 0.99 );
IF (size = 0) AND ( POS('.',file_name[k]) <> 1 ) THEN
total_size := total_size + cl_size*512;
WRITE(outfil,file_name[k],'.',
ext_name[k]);
WRITE(outfil,' ',month:2,'/',day:2,'/',year:2,
' ',hour:2,':',(min DIV 10):1,(min MOD 10):1,
size:7:0);
IF i = 0 THEN
WRITE(outfil,' ');
END
ELSE
WRITE(outfil,' ':35);
END;
WRITELN(outfil,right_border);
END;
WRITELN(outfil,left_border,' ':38,'TOTAL SIZE: ',' ':15,
total_size:8:0,right_border);
WRITELN(outfil,border);
WRITELN(outfil,border);
no_lines := no_lines + no_entry + 6;
END; {qsort}
PROCEDURE setup(drive_no:INTEGER);
BEGIN
comp := CHR(15);
EXP := CHR(14);
cancel := CHR(20);
ff := CHR(12);
LL8 := CHR(27)+CHR(48);
short:= CHR(27)+'C'+CHR(44);
IF NOT compressed THEN comp := '';
IF (outfil_name <> 'LPT1:') AND (outfil_name <> 'lpt1:') THEN
BEGIN
comp := '';
EXP := '';
cancel := '';
{ ff := ''; GO AHEAD AND DO A FORM FEED }
LL8 := '';
short := '';
END;
IF (cl_size = 8) AND (drive_no = 3) THEN
BEGIN
{DOS 2.0/2 SIDE HARD DISK}
drive := $80; { 80H }
biosread(fat_fill,drive,0,0,3,8);
no_sect := 17; { 17}
no_root := 4; { 4}
no_side := 4; { 4}
cl_size := 8; { 8}
first_clust := 34; { 34}
first_dir := 18; { 18}
END
ELSE
BEGIN
drive := drive_no-1;
{read FAT ...side 0, track 0, sector 2}
biosread(fat_fill,drive,0,0,2,2);
CASE fat_fill[0] OF
{DOS 2.0/2 SIDE }
$FD : BEGIN
no_sect := 9;
no_root := 3.5;
no_side := 2;
cl_size := 2;
first_clust := 8;
first_dir := 5;
END;
{DOS 1.1/2 SIDE }
$FF : BEGIN
no_sect := 8;
no_root := 3.5;
no_side := 2;
cl_size := 2;
first_clust := 7;
first_dir := 3;
END;
{DOS 2.0/1 SIDE }
$FC : BEGIN
no_sect := 9;
no_root := 2;
no_side := 1;
cl_size := 1;
first_clust := 8;
first_dir := 5;
END;
{DOS 1.1/1 SIDE }
$FE : BEGIN
no_sect := 8;
no_root := 2;
no_side := 1;
cl_size := 1;
first_clust := 7;
first_dir := 3;
END;
ELSE
END;
END;
one_on := FALSE;
IF compressed THEN
WRITE(outfil,comp,LL8,short);
cluster[1] := first_dir;
dir_name[1] := '\';
dir_num := 1;
parent := 1;
dir_point := 1;
FOR i := 1 TO 50 DO
BEGIN
son[i] := 0;
father[i] := 0;
END;
no_lines := 0;
no_max := 60;
IF compressed THEN
no_max := 38;
side_border := ' ';
IF want_border THEN
BEGIN
no_max := no_max-2;
side_border:= '|';
END;
border := side_border + fill_string(' ',77) + side_border ;
left_border := side_border + fill_string(' ',2) ;
right_border := fill_string(' ',2) + side_border ;
top_border := fill_string('-',79) ;
IF want_border THEN
WRITELN(outfil,top_border);
free_space := free_clusters*(cl_size*512.0);
WRITELN(outfil,left_border,' ':30,'Free: ',free_space:7:0,' ':19,
month:2,'/',date:2,'/',year:2,' ',right_border);
no_lines := no_lines + 1;
END;
PROCEDURE menu(VAR response:INTEGER);
BEGIN
CLRSCR;
GOTOXY(10,3);WRITELN('1) Go');
GOTOXY(10,7);WRITELN('2) Change output defaults');
GOTOXY(10,11);WRITELN('3) Change file defaults');
GOTOXY(10,15);WRITELN('4) Stop');
GOTOXY(1,20);WRITELN('Output defaults: output to ',outfil_name,
' border ',want_border,' compressed ',compressed);
GOTOXY(1,22);WRITELN('File defaults: Drive ',drive_no,
' show hidden ',want_hidden,' show deleted ',want_deleted,
' show dir ',want_dir);
GOTOXY(15,24);WRITE('Enter option ');READLN(response);
CLRSCR;
END;
PROCEDURE display_menu;
BEGIN
CLRSCR;
GOTOXY(1,1);WRITELN('Output defaults: output to ',outfil_name,
' border ',want_border,' compressed ',compressed);
GOTOXY(5,5) ; WRITE(' Output to: ');READLN(outfil_name);
GOTOXY(5,8) ; WRITE(' Want border: ');READLN(alpha);
IF LENGTH(alpha) <> 0 THEN
want_border := (alpha = 'y') OR (alpha = 'Y');
GOTOXY(5,11) ; WRITE(' Compressed: ');READLN(alpha);
IF LENGTH(alpha) <> 0 THEN
compressed := (alpha = 'y') OR (alpha = 'Y');
CLRSCR;
END;
PROCEDURE file_menu;
BEGIN
CLRSCR;
GOTOXY(1,1);WRITELN('File defaults: Drive ',drive_no,
' show hidden ',want_hidden,' show deleted ',want_deleted,
' show dir ',want_dir);
GOTOXY(5,5) ; WRITE(' Drive: ');READLN(drive_no);
GOTOXY(5,8) ; WRITE(' Show hidden files: ');READLN(alpha);
IF LENGTH(alpha) <> 0 THEN
want_hidden := (alpha = 'y') OR (alpha = 'Y');
GOTOXY(5,11) ; WRITE(' Show deleted files:');READLN(alpha);
IF LENGTH(alpha) <> 0 THEN
want_deleted:= (alpha = 'y') OR (alpha = 'Y');
GOTOXY(5,14) ; WRITE(' Show directories: ');READLN(alpha);
IF LENGTH(alpha) <> 0 THEN
want_dir := (alpha = 'y') OR (alpha = 'Y');
CLRSCR;
END;
BEGIN
drive_no := 1;
want_border := TRUE;
compressed := TRUE;
want_hidden := TRUE;
want_deleted := FALSE;
want_dir := FALSE;
outfil_name := 'LPT1:';
response := 1;
WHILE response <> 4 DO
BEGIN
menu(response);
IF response = 2 THEN
display_menu;
IF response = 3 THEN
file_menu;
IF response = 1 THEN
BEGIN
ASSIGN(outfil,outfil_name);
REWRITE(outfil);
get_free_space(free_clusters,total_clusters,cl_size,drive_no);
getdate(year,month,date,hour,min) ;
year := year - 1900;
setup(drive_no);
read_dir (dir,cluster[1],no_root);
sort_dir (file_name,no_words);
WHILE parent <> 0 DO
BEGIN
IF son[parent] <> 0 THEN
BEGIN { step down to son }
dir_point := son[parent];
parent := dir_point;
read_dir (dir,cluster[parent],1.0);
sort_dir (file_name,no_words);
END { then begin }
ELSE
BEGIN
WHILE (son[parent] = 0) AND (parent <> 0) DO
BEGIN { move to next son; or pop to parent }
parent := father[dir_point];
IF father[dir_point+1] = parent THEN
son[parent] := dir_point + 1
ELSE
IF parent <> 0 THEN
son[parent] := 0;
dir_point := parent;
END; { move to next son; or pop to parent }
END; { else begin }
END; { while parent <> 0 }
FOR i := no_lines TO no_max-1 DO
IF want_border THEN
WRITELN(outfil,border);
no_lines := 0;
IF want_border THEN
WRITELN(outfil,top_border);
{ CLRSCR; }
WRITE(outfil,ff);
CLOSE(outfil);
END;
END;
end.