home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / utility / tdir92.zip / TD.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-05  |  19KB  |  500 lines
  1. Program TreeDir;
  2.  
  3. { ─────────────────────────────────────────────────────────────────── }
  4. { Name:      TD.PAS -> TD.EXE                                         }
  5. { Date:      12/10/90                                                 }
  6. { By:        J. Rockford Cogar, 119 Oklahoma Ave, Oak Ridge, TN 37830 }
  7. { Compiler:  Borland Turbo Pascal 6.0                                 }
  8. { Purpose:   Show File Storage on a Subdirectory Basis                }
  9. { ─────────────────────────────────────────────────────────────────── }
  10.  
  11. USES
  12.   Dos;
  13.  
  14. CONST
  15.   carry      = 1;
  16.   directory  = $10;    { directory attribute }
  17.   NumberDirs = 1024;   { 1024 records should be enough room for directory data }
  18.   ActiveCol  = 23;     { output column during 'explore' }
  19.  
  20.   PROGNAME : string[52] = 'TreeDir. Shows File Storage on a Subdirectory Basis.';
  21.   PROGBY   : string[39] = 'By: J. Rockford Cogar, Oak Ridge TN USA';
  22.   PROMPT1  : string[23] = 'Processing Directory: \';
  23.   CRLF     : string[2]  = #13#10;
  24.   PROMPT2  : string[12] = 'Subdirectory';
  25.   PROMPT3  : string[13] = 'Storage in KB';
  26.  
  27. TYPE
  28.    fname = array[1..80] of char;
  29.    str80 = string[80];            { generic string }
  30.  
  31.    DTransA_ = record
  32.           filler    : array[1..21] of byte;
  33.           attribute : byte;
  34.           file_time : word;
  35.           file_date : word;
  36.           file_size : array[1..2] of word;
  37.           file_name : fname;
  38.           end;
  39.  
  40.    SubDir_ = record
  41.            Size  : longint;    { bytes in the subdir           4 }
  42.            Index : integer;    { index of the previous record  2 }
  43.            Level : integer;    { depth in the tree             2 }
  44.            Name  : string[13]; { name of a subdirectory       13 }
  45.           end;                 { Total bytes:                 21 }
  46.  
  47. VAR
  48.   SubDir        : array[0..NumberDirs] of SubDir_;  { array of recs to store dir info in }
  49.   filestorage   : longint;                          { temp var to store bytes in a subdir }
  50.   pattern       : string[70];                       { directory search pattern }
  51.   sdir          : str80;                            { scaler string for filenames }
  52.   OldDir        : str80;                            { current subdirectory at startup }
  53.   fir           : integer;                          { index for subdirectories }
  54.   CurDir        : str80;                            { explore time current directory }
  55.   by            : byte;                             { generic byte }
  56.   level         : integer;                          { level in the dir tree }
  57.   prev          : integer;                          { previous subdirectory index }
  58.   next          : integer;                          { next subdirectory index }
  59.   curr          : integer;                          { current subdirectory index }
  60.   ostr          : str80;                            { final output string }
  61.   spstr         : str80;                            { string of space chars }
  62.   maxlen        : integer;                          { max filename length }
  63.   maxlevel      : integer;                          { max level reached }
  64.   padlen        : integer;                          { numb spaces to padd with }
  65.   maxsize       : longint;                          { largest amount storage in a dir }
  66.   CurNumbLen    : integer;                          { length of the current number string }
  67.   NumbPad       : integer;                          { length of the largest number string }
  68.   vmode         : byte;                             { video mode at startup }
  69.   color         : integer;                          { text color }
  70.   clrstr        : str80;                            { clear string }
  71.   curtype       : integer;                          { cursor size }
  72.  
  73. { init global data }
  74. { ─────────────────────────────────────────────────────────────────────────── }
  75. procedure init;
  76. begin { procedure init() }
  77.   fillchar(SubDir,sizeof(SubDir_) * NumberDirs, #0);
  78.   SubDir[0].Name:='ROOT'#0;
  79.   pattern:='*.*'#0;
  80.   fillchar(clrstr[1],79 - ActiveCol,' ');
  81.   clrstr[0]:=chr(79 - ActiveCol);
  82.  
  83.    asm
  84.      xor ax,ax              { zero a register }
  85.      mov word ptr level,ax  { zero out: level }
  86.      mov word ptr prev,ax   { zero out: prev  }
  87.      mov word ptr next,ax   { zero out: next  }
  88.      mov word ptr curr,ax   { zero out: curr  }
  89.      mov word ptr fir,ax    { zero out: fir   }
  90.    end;
  91.  
  92.  end; { procedure init() }
  93. { ─────────────────────────────────────────────────────────────────────────── }
  94.  
  95. { start of a bunch of small procs that are used to avoid the use of }
  96. { writeln() and the CRT unit. This makes TD.EXE 2KB smaller.        }
  97.  
  98. { move the cursor }
  99. { ─────────────────────────────────────────────────────────────────────────── }
  100. procedure tgotoxy(x, y: integer);
  101. begin
  102.  asm
  103.   mov ah,2           { move cursor function }
  104.   mov bh,0           { video page zero      }
  105.   mov dl,byte ptr x  { fetch col number     }
  106.   mov dh,byte ptr y  { fetch row number     }
  107.   int 10h            { call VIDEO BIOS      }
  108.  end;
  109. end;
  110. { ─────────────────────────────────────────────────────────────────────────── }
  111.  
  112. { write text to STDOUT }
  113. { ──────────────────────────────────────────────────────────────────────── }
  114. procedure putln(VAR strg: str80);
  115. begin
  116.  ASM
  117.   push ds
  118.   lds  si,dword ptr [bp+4]
  119.   mov  cl,byte ptr ds:[si]
  120.   mov  ch,0
  121.   mov  bx,1
  122.   inc  si
  123.   mov  dx,si
  124.   mov  ah,040h
  125.   int  21h
  126.   pop  ds
  127.   end;
  128. end;
  129. { ──────────────────────────────────────────────────────────────────────── }
  130.  
  131. { BIOS version of 'C' putchar() }
  132. { ─────────────────────────────────────────────────────────────────────────── }
  133. procedure PutCh(cha : char);
  134. begin
  135.  asm
  136.   mov ah,0eh          { Write tty function            }
  137.   mov bl,0fh          { white color for graphics mode }
  138.   mov al,byte ptr cha { fetch char to output          }
  139.   int 10h             { call VIDEO BIOS               }
  140.  end;
  141. end;
  142. { ─────────────────────────────────────────────────────────────────────────── }
  143.  
  144. { Get Cursor Position. High byte is Row, low byte is column }
  145. { ─────────────────────────────────────────────────────────────────────────── }
  146. function GetXY: integer;
  147. VAR
  148.   retv: integer;
  149. begin
  150.  asm
  151.   mov ah,03h               { read cursor position function }
  152.   mov bh,00h               { video page zero               }
  153.   int 10h                  { call VIDEO BIOS               }
  154.   mov word ptr retv,dx     { copy to a temp VAR            }
  155.  end;
  156.  GetXY:=retv;
  157. end;
  158. { ─────────────────────────────────────────────────────────────────────────── }
  159.  
  160. { Get Cursor type }
  161. { ─────────────────────────────────────────────────────────────────────────── }
  162. function GetCurType: integer;
  163. VAR
  164.   retv: integer;
  165. begin
  166.  asm
  167.   mov ah,03h               { read cursor position function }
  168.   mov bh,00h               { video page zero               }
  169.   int 10h                  { call VIDEO BIOS               }
  170.   mov word ptr retv,cx     { copy to a temp VAR            }
  171.  end;
  172.  GetCurType:=retv;
  173. end;
  174. { ─────────────────────────────────────────────────────────────────────────── }
  175.  
  176. { Set Cursor type }
  177. { ─────────────────────────────────────────────────────────────────────────── }
  178. procedure SetCurType(ctype: integer);
  179. begin
  180.  asm
  181.   mov ah,01h               { set cursor type function }
  182.   mov cx,word ptr ctype    { fetch cursor type        }
  183.   int 10h                  { call VIDEO BIOS          }
  184.  end;
  185. end;
  186. { ─────────────────────────────────────────────────────────────────────────── }
  187.  
  188. { a BIOS 'C' Puts() }
  189. { ─────────────────────────────────────────────────────────────────────────── }
  190. procedure Puts(VAR outstr: str80);
  191. VAR
  192.   x     : integer; { glyph column index }
  193.   y     : integer; { glyph row index    }
  194.   len   : integer; { string length      }
  195.   i     : integer; { output byte index  }
  196. begin
  197.   len:=length(outstr); { get string length   }
  198.   x:=lo(GetXY);        { get glyph col index }
  199.   y:=hi(GetXY);        { get glyph row index }
  200.  
  201.   for i:=1 to len do     { loop through the string }
  202.     begin
  203.       PutCh(outstr[i]);  { out a char      }
  204.       inc(x);            { next column     }
  205.       tgotoxy(x,y);      { move the cursor }
  206.     end;
  207.  
  208. end;
  209. { ─────────────────────────────────────────────────────────────────────────── }
  210.  
  211. { position cursor then output a string }
  212. { ─────────────────────────────────────────────────────────────────────────── }
  213. procedure PutsXY(x,y: integer; VAR outstr: str80);
  214. begin
  215.   tgotoxy(x,y);  { set cursor }
  216.   Puts(outstr);  { write the string with BIOS }
  217. end;
  218. { ─────────────────────────────────────────────────────────────────────────── }
  219.  
  220. { a simple clear screen proc }
  221. { ─────────────────────────────────────────────────────────────────────────── }
  222. procedure ClearScrn(color : integer);
  223. begin
  224.  asm
  225.   mov ah,06h            { Scroll Up function  }
  226.   mov al,0h             { clear whole window  }
  227.   mov bh,byte ptr color { fetch output color  }
  228.   xor cx,cx             { start at 'home'     }
  229.   mov dx,01950h         { bot right corner    }
  230.   int 10h               { call VIDEO BIOS     }
  231.  end;
  232. end;
  233. { ─────────────────────────────────────────────────────────────────────────── }
  234.  
  235. { initialize the video }
  236. { ─────────────────────────────────────────────────────────────────────────── }
  237. procedure VideoInit;
  238. begin
  239.  
  240.   asm
  241.     mov bh,0              { video page number                          }
  242.     mov ah,8              { Video BIOS call to attribute at the cursor }
  243.     int 10h               { call video BIOS                            }
  244.     mov bl,ah             { copy to operate on                         }
  245.     and bh,00h            { get rid of the high byte                   }
  246.     mov word ptr color,bx { save away the color                        }
  247.   end;
  248.  
  249.   curtype:=GetCurType; { cursor type        }
  250.   ClearScrn(color);    { clear whole screen }
  251.   tgotoxy(0,0);        { home the cursor    }
  252. end;
  253. { ─────────────────────────────────────────────────────────────────────────── }
  254.  
  255. { 'make' a long string of spaces have 'numb' length }
  256. { ─────────────────────────────────────────────────────────────────────────── }
  257. procedure padstr(numb : integer; VAR ostr : str80);
  258. begin
  259.   if (numb < 0) then exit;   { range check      }
  260.   if (numb > 0) then fillchar(ostr,numb + 1,' ');
  261.   ostr[0]:=chr(numb);        { init length byte }
  262. end;
  263. { ─────────────────────────────────────────────────────────────────────────── }
  264.  
  265. { get the current directory string. Without the volume letter }
  266. { ─────────────────────────────────────────────────────────────────────────── }
  267. function GetCurDir(VAR DirStr : str80): integer;
  268. VAR
  269.   rg : registers;
  270.   i  : integer;
  271. begin { function GetCurDir() }
  272.  
  273.   rg.dx := 0;              {get current directory -- default drive}
  274.   rg.ds := seg(DirStr[1]);
  275.   rg.si := ofs(DirStr[1]);
  276.   rg.ax := $4700;
  277.   msdos(rg);
  278.  
  279.   i:=0;
  280.  
  281.   while (DirStr[i+1] <> #0) do inc(i);  { calc 'C' string length }
  282.  
  283.   DirStr[0]:=chr(i);  { insert the string length }
  284.   GetCurDir:=i;       { ret string length        }
  285. end;                  { function GetCurDir       }
  286. { ─────────────────────────────────────────────────────────────────────────── }
  287.  
  288. { convert a 'C' string into a Turbo Pascal string }
  289. { ─────────────────────────────────────────────────────────────────────────── }
  290. function BuildString(VAR instr: fname; size : integer) : str80;
  291. VAR
  292.  i      : integer;  { loop index    }
  293.  outstr : str80;    { output string }
  294. begin
  295.   i := 1;     { start at offset of 1 }
  296.  
  297.   while (instr[i] <> #0) and (i <= size) do
  298.     begin
  299.       outstr[i]:=instr[i];  { copy the byte }
  300.       Inc(i);               { inc the loop counter }
  301.     end;
  302.  
  303.   outstr[0]:=chr(i - 1);   { set the length byte }
  304.   BuildString := outstr;   { 'return' the result }
  305. end;
  306. { ─────────────────────────────────────────────────────────────────────────── }
  307.  
  308. { explore all directories on this volume. fill the record(s) SubDir[] with data for all subdirectories }
  309. { ─────────────────────────────────────────────────────────────────────────── }
  310. procedure explore;
  311. VAR
  312.    DTransA    : DTransA_;                 { data transfer record        }
  313.    Regs       : registers;                { standard interrupt 'union'  }
  314.    SubDirStr  : string[70];               { current subdirectory string }
  315.    dta_save   : array[1..2] of integer;   { DTA address                 }
  316.    LowWord    : word;                     { low word of the file size   }
  317.    HighWord   : word;                     { high word of the file size  }
  318.    fbytes     : longint;                  { bytes in a subdirectory     }
  319. { ─────────────────────────────────────────────────────────────────────────── }
  320. begin
  321.  
  322.    with Regs,DTransA do
  323.      begin
  324.       ax := $2F00;          { get DTA }
  325.       msdos(Dos.Registers(Regs));
  326.       dta_save[1] := es;
  327.       dta_save[2] := bx;
  328.  
  329.       ax := $1A00;          { set DTA }
  330.       ds := seg(DTransA);
  331.       dx := ofs(DTransA);
  332.       msdos(Regs);
  333.  
  334.       ds := seg(pattern[1]);
  335.       dx := ofs(pattern[1]);
  336.       ax := $4E00;          { find 1st file }
  337.       cx := $FF;
  338.       msdos(Regs);
  339.  
  340.       while (flags and carry) = 0 do          { loop through everything }
  341.         begin
  342.          SubDirStr:= BuildString(file_name, sizeof(file_name) );
  343.  
  344.          if ((attribute and directory) <> 0) and (SubDirStr <> '.') and ( SubDirStr <> '..') then
  345.           begin  { -------------- if the filename has a directory attribute -------------- }
  346.             SubDirStr := SubDirStr+chr(0);  { makes the string 'extra long' }
  347.             ax := $3B00;    { CHDIR }
  348.             ds := seg(SubDirStr[1]);
  349.             dx := ofs(SubDirStr[1]);
  350.             msdos(Regs);     { drop down into that directory }
  351.             inc(fir);
  352.             inc(level);
  353.  
  354.             prev:=curr;               { save this subdir index       }
  355.             curr:=next + 1;           { bump down to the next subdir }
  356.             SubDir[curr].Index:=prev; { save index for later }
  357.             next:=curr;
  358.             SubDir[curr].Level:=Level; { save tree level }
  359.  
  360.             if (curr > NumberDirs) then exit; { range check }
  361.  
  362.             SubDir[curr].Name:=SubDirStr;   { setup to update the status line }
  363.             PutsXY(ActiveCol,2,clrstr);     { clear to end of line }
  364.             LowWord:=GetCurDir(CurDir);
  365.             PutsXY(ActiveCol,2,CurDir);     { write new dir name }
  366.  
  367.             explore;  { call this proc to dig down into the next subdir }
  368.  
  369.             ax := $3B00;    { back up to parent subdir }
  370.             SubDirStr := '..'#0;
  371.             ds := seg(SubDirStr[1]);
  372.             dx := ofs(SubDirStr[1]);
  373.             msdos(Regs);
  374.  
  375.             LowWord:=GetCurDir(CurDir);
  376.             if (CurDir[0] = #0) then CurDir:='ROOT';
  377.             PutsXY(ActiveCol,2,clrstr);  { clear to end of line }
  378.             PutsXY(ActiveCol,2,CurDir);  { write new dir name }
  379.  
  380.             dec(level);  { we are now one level higher }
  381.             curr:=prev;  { set index to the previous subdir }
  382.             prev:=SubDir[curr].Index
  383.  
  384.            end   { -------------- if the filename has a directory attribute -------------- }
  385.          else
  386.            begin { -------------- For regular filenames  -------------- }
  387.             LowWord:= file_size[1];
  388.             HighWord:= file_size[2];
  389.  
  390.             fbytes:=(HighWord * 65536) + LowWord;
  391.  
  392.             if (GetCurDir(CurDir) > 0) then  { not root dir }
  393.               begin
  394.                 SubDir[curr].Size:= SubDir[curr].Size + fbytes; { sum used storage }
  395.               end
  396.             else                             { root dir     }
  397.               begin
  398.                 SubDir[0].Size:= SubDir[0].Size + fbytes; { sum used storage }
  399.               end;
  400.  
  401.             end;  { -------------- For regular filenames  -------------- }
  402.  
  403.          ax := $4F00;       { get next file }
  404.          msdos(Regs);
  405.         end;                { end of the WHILE loop }
  406.  
  407.       ax := $1A00;          { reset DTA }
  408.       ds := dta_save[1];
  409.       dx := dta_save[2];
  410.       msdos(Regs);
  411.  
  412.      end;             { end of the WITH block }
  413.  
  414. end;
  415. { ─────────────────────────────────────────────────────────────────────────── }
  416.  
  417. { ─────────────────────────────────────────────────────────────────────────── }
  418. begin  { main() }
  419.   init;        { initialize global data  }
  420.   VideoInit;   { initialize the video    }
  421.  
  422.   PutsXY(0,0,PROGNAME);
  423.   PutsXY(0,1,PROGBY);
  424.   PutsXY(0,2,PROMPT1);
  425.  
  426.   getdir(0,OldDir);  { save the current directory }
  427.  
  428.   if (paramcount > 0) then  { if there was a parameter string }
  429.     begin
  430.       chdir(paramstr(1) );  { assume it was a drive:\subdir string }
  431.     end;
  432.  
  433.   chdir('\');        { switch to the root directory }
  434.  
  435.   SetCurType($3800);   { off the cursor }
  436.   explore;             { explore all directories on the current volume }
  437.   SetCurType(curtype); { restore the cursor }
  438.  
  439.   chdir(OldDir);  { restore the old directory }
  440.  
  441.   ClearScrn(color);  { clear whole screen }
  442.   tgotoxy(0,0);      { home cursor        }
  443.  
  444.   prev:=0;      { init some counters }
  445.   maxlevel:=0;
  446.   maxlen:=0;
  447.   maxsize:=0;
  448.  
  449.   for fir:=0 to next do  { find max level and name length }
  450.     begin
  451.       if (SubDir[fir].Level > maxlevel) then maxlevel:=SubDir[fir].Level;
  452.       if (length(SubDir[fir].Name) > maxlen) then maxlen:=length(SubDir[fir].Name);
  453.       if (SubDir[fir].Size > maxsize) then maxsize:=SubDir[fir].Size;
  454.     end;
  455.  
  456.   maxsize:=maxsize div 1024;
  457.   str(maxsize, pattern);         { int to string }
  458.   NumbPad:=length(pattern) + 1;  { length of the largest number string }
  459.  
  460.   putln(PROMPT2);                { send header text to STDOUT }
  461.   clrstr[0]:=#3;
  462.   putln(clrstr);
  463.   putln(PROMPT3);
  464.   putln(CRLF);
  465.  
  466.   fillchar(clrstr[1],28,#196);   { make a divider bar }
  467.   clrstr[29]:=#13;
  468.   clrstr[30]:=#10;
  469.   clrstr[0]:=#30;
  470.   putln(clrstr);                 { send divider to STDOUT }
  471.  
  472.   for fir:=0 to next do                           { loop through the whole list }
  473.     begin
  474.       ostr[0]:=#0;
  475.       filestorage:= SubDir[fir].Size div 1024;    { bytes to KiloBytes }
  476.       padstr(SubDir[fir].Level * 2, ostr);        { init string to 'level' spaces Times 2 }
  477.       sdir:=SubDir[fir].Name;                     { copy name to a scaler }
  478.       by:=byte(sdir[0]);                          { adjust for trailing }
  479.       sdir[0]:=chr(by - 1);                       { nulls }
  480.       ostr:= ostr + '\' + sdir;                   { add the filename }
  481.  
  482.       str(filestorage,pattern);                   { int to string }
  483.       CurNumbLen:=length(pattern);                { length of the current number string }
  484.  
  485.       padlen:= (maxlen + (2 * maxlevel)) - length(ostr); { calc pad length }
  486.       padlen:=padlen + (NumbPad - CurNumbLen);           { to right justify the numbers }
  487.  
  488.       padstr(padlen,spstr);                       { build a pad string }
  489.       ostr:=ostr + spstr;                         { add the pad string }
  490.  
  491.       ostr:=ostr + pattern;                       { add number string }
  492.       ostr:=ostr + CRLF;                          { add EOL }
  493.       putln(ostr);                                { write the data to STDOUT }
  494.     end;                                          { loop end }
  495.  
  496. end.  { main() }
  497. { ─────────────────────────────────────────────────────────────────────────── }
  498.  
  499.  
  500.