home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / UDIR11.ZIP / UDIR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-09-29  |  30.1 KB  |  784 lines
  1. {$I-,S-}
  2. {$M 8192,8192,655360}
  3. PROGRAM
  4.        {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  5.        {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  6.        {}{}{}{}                                {}{}{}{}
  7.        {}{}{}{}     THE_ULTIMATE_DIRECTORY     {}{}{}{}
  8.        {}{}{}{}                                {}{}{}{}
  9.        {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  10.        {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  11. ;
  12. Uses Dos,crt;
  13.  
  14. const
  15.     MaxFiles =1024;                        {max # of files in any directory}
  16.     
  17.     MonthStr: array[1..12] of string[3] = (
  18.         'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  19.         'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  20.  
  21.     subtotals:boolean={false}true;
  22.     paged    :boolean=false;
  23.     depth    :byte   =23;
  24.     clust_size:integer = 1024;
  25.     
  26. type
  27.     dirptr = ^dirrectype;               {a pointer to a record of}
  28.     dirrectype = record                 {directory names         }
  29.                  dirname : pathstr;
  30.                  nextdir : dirptr;      {a pointer to the next record}
  31.              end;
  32.  
  33.     FilPtr   = ^FilRec;                    {why not use just an array of}
  34.     FilRec   = record                    {records rather than an array of}
  35.                Attr: Byte;                {pointers to records? Well, I want}
  36.                Time: Longint;            {to use the DIRDEMO sort routines}
  37.                Size: Longint;            {and that program from Borland uses}
  38.                Name: pathstr;           {this structure,so...I used a simi-}
  39.                ext : extstr;            {data structure, but added one field}
  40.              end;
  41.     FileAra  = array[0..MaxFiles - 1] of FilPtr;
  42.  
  43.     LessFunc= function(X, Y: FilPtr): Boolean;
  44.  
  45.     st5     = string[5];
  46.     st12    = string[12];
  47.     st64    = string[64];
  48.  
  49. Var
  50.     Files   : FileAra;
  51.  
  52.     head    ,
  53.     cur     : dirptr;
  54.  
  55.     dp      : dirrectype;
  56.  
  57.     Less    : LessFunc;
  58.  
  59.     Stop    ,
  60.     DoChg   : boolean;
  61.  
  62.     curdir  : st64;
  63.  
  64.     disp    : byte;
  65.     Fattr   ,
  66.     Filatr  : word;
  67.     count   ,
  68.     lncnt   : integer;
  69.     slack   ,
  70.     clusters, 
  71.     tot_clusters, 
  72.     tot_slack ,
  73.     gr_tot_clusters,
  74.     gr_tot_slack ,
  75.     total   ,
  76.     totcount: longint;
  77.     filepath: pathstr;
  78.     mask    : st12;
  79.  
  80. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  81. {}                                        {} {Converts an integer number to}
  82. {} function NumStr(N, D: Integer): String;{} {a string and pads on the left}
  83. {}                                        {} {with 0's.                    }
  84. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  85.  
  86. begin
  87.     NumStr[0] := Chr(D);
  88.     while D > 0 do
  89.     begin
  90.         NumStr[D] := Chr(N mod 10 + Ord('0'));
  91.         N := N div 10;
  92.         Dec(D);
  93.     end;
  94. end;
  95.  
  96. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  97. {}                                        {} {Converts a longint to a string}
  98. {} function longst(N, D: Longint): String;{} {and pads on the left with blank}
  99. {}                                        {} {spaces.}
  100. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  101.  
  102. var LS : String;
  103. begin
  104.     LS[0] := chr(D);
  105.     while D > 0 do
  106.     begin
  107.         LS[D] := chr(N mod 10 + Ord('0'));
  108.         N := N div 10;
  109.         Dec(D);
  110.     end;
  111.     D:= 1;
  112.     while Ls[D]='0' do
  113.     begin
  114.         Ls[D]:=' ';
  115.         inc(D);
  116.     end;
  117.     Longst := LS;
  118. end;
  119.  
  120. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  121. {}                              {}
  122. {} function attrstr(a:byte):st5;{} {Turns an attribute byte into a string}
  123. {}                              {}
  124. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  125.  
  126. var attrib : st5;
  127. begin
  128.     attrib:='.....';
  129.     If a AND archive  <> 0 then attrib[1] := 'A';  { If archive bit set }
  130.     If a AND directory<> 0 then attrib[2] := 'D';  { If directory }
  131.     If a AND sysfile  <> 0 then attrib[3] := 'S';  { If system    }
  132.     If a AND hidden   <> 0 then attrib[4] := 'H';  { If hidden    }
  133.     If a AND readonly <> 0 then attrib[5] := 'R';  { If read-only }
  134.     attrstr:=attrib;
  135. end;
  136.  
  137. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  138. {}                              {}
  139. {}   Function GetKey : char;    {}  {replaces ReadKey, eliminates need for}
  140. {}                              {}  {CRT.TPU}
  141. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  142.  
  143.     var ch : char;
  144.     Begin
  145.       Inline(
  146.       $B4/$0C        {       MOV  AH,$0C      ;clear buffer}
  147.       /$B0/$08       {       MOV  AL,8        ;get a char}
  148.       /$CD/$21       {SPCL:  INT  $21         ;Call DOS}
  149.       /$3C/$00       {       CMP  AL,0        ;If it's a 0 byte}
  150.       /$75/$04       {       JNZ  CHRDY       ;is spec., get second byte}
  151.       /$B4/$08       {       MOV  AH,8        ;else set up for another}
  152.       /$EB/$F6       {       JMP  SHORT SPCL  ;and get it}
  153.       /$88/$46/<CH   {CHRDY: MOV  <CH[BP],AL  ;else put into function return}
  154.        );
  155.       GetKey := Ch;
  156.     end; {Inline function GetKey}
  157.  
  158.  
  159. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  160. {}                                        {} {Converts a set of date #s }
  161. {} function JDays(yy,mm,dd:word):longint; {} {to a julian day number. }
  162. {}                                        {}
  163. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  164.  
  165. var
  166.     DayFromZero,
  167.     LeapYearDays:longint;
  168. begin
  169.  
  170.     DayFromZero := ( 365 * yy ) + (31 * Pred(mm)) + Dd ;
  171.     If mm > 2 then DayFromZero := DayFromZero - Trunc(0.4 * mm + 2.3)
  172.         else if mm < 2 then dec(yy);
  173.     LeapYearDays := (yy div 4) - (yy div 100)
  174.         + (yy div 400) - (yy div 4000);
  175.     JDays := DayFromZero + LeapYearDays ;
  176. end;
  177.  
  178. (* THE FOLLOWING IS BORROWED FROM THE DIRDEMO.PAS PROGRAM FROM BORLAND *)
  179. (**)                                                                 (**)
  180. (**)            {$F+}                                                (**)
  181. (**)            function LessName(X, Y: FilPtr): Boolean;            (**)
  182. (**)            begin                                                (**)
  183. (**)                LessName := X^.Name < Y^.Name;                   (**)
  184. (**)            end;                                                 (**)
  185. (**)            function LessSize(X, Y: FilPtr): Boolean;            (**)
  186. (**)            begin                                                (**)
  187. (**)                LessSize := X^.Size < Y^.Size;                   (**)
  188. (**)            end;                                                 (**)
  189. (**)            function LessTime(X, Y: FilPtr): Boolean;            (**)
  190. (**)            begin                                                (**)
  191. (**)                LessTime := X^.Time > Y^.Time;                   (**)
  192. (**)            end;                                                 (**)
  193. (**)            function LessAttr(X, Y: FilPtr): Boolean;            (**)
  194. (**)            begin                                                (**)
  195. (**)                LessAttr := X^.Attr < Y^.Attr;                   (**)
  196. (**)            end;                                                 (**)
  197. (**)            function LessExt(X, Y:  FilPtr): Boolean;            (**)
  198. (**)            begin                                                (**)
  199. (**)                LessExt := X^.Ext < Y^.Ext;                      (**)
  200. (**)            end;                                                 (**)
  201. (**)            {$F-}                                                (**)
  202. (**)                                                                 (**)
  203. (**)                                                                 (**)
  204. (**)            procedure QuickSort(L, R: Integer);                  (**)
  205. (**)            var                                                  (**)
  206. (**)                I, J: Integer;                                   (**)
  207. (**)                X, Y: FilPtr;                                    (**)
  208. (**)            begin                                                (**)
  209. (**)                I := L;                                          (**)
  210. (**)                J := R;                                          (**)
  211. (**)                X := Files[(L + R) div 2];                       (**)
  212. (**)                repeat                                           (**)
  213. (**)                    while Less(Files[I], X) do Inc(I);           (**)
  214. (**)                    while Less(X, Files[J]) do Dec(J);           (**)
  215. (**)                    if I <= J then                               (**)
  216. (**)                    begin                                        (**)
  217. (**)                      Y := Files[I];                             (**)
  218. (**)                      Files[I] := Files[J];                      (**)
  219. (**)                      Files[J] := Y;                             (**)
  220. (**)                      Inc(I);                                    (**)
  221. (**)                      Dec(J);                                    (**)
  222. (**)                    end;                                         (**)
  223. (**)                until I > J;                                     (**)
  224. (**)                if L < J then QuickSort(L, J);                   (**)
  225. (**)                if I < R then QuickSort(I, R);                   (**)
  226. (**)            end;                                                 (**)
  227. (**)                                                                 (**)
  228. (**)            procedure SortFiles;                                 (**)
  229. (**)            begin                                                (**)
  230. (**)                if (Count <> 0) and (@Less <> nil) then          (**)
  231. (**)                  QuickSort(0, Count - 1);                       (**)
  232. (**)            end;                                                 (**)
  233. (**)                                                                 (**)
  234. (************************ END OF BORROWED CODE *************************)
  235.  
  236. {}{}{}{}{}{}{}{}{}{}{}
  237. {}                  {}
  238. {} Procedure Usage; {}  {Describes proper usage of switches to the user.}
  239. {}                  {}
  240. {}{}{}{}{}{}{}{}{}{}{}
  241. begin
  242.     writeln('  +----------------------------------------------------------------------+');
  243.     writeln('  |**** The Ultimate Directory Lister, ver 1.1 (c) FastAid Co.,1990-95***|');
  244.     writeln('  +----------------------------------------------------------------------+');
  245.     writeln('USAGE:');
  246.     writeln('UDIR Path[!] [/A|H|R|S|D] [/n|e|s|t|a|u] [/P] [/T] [/[1|2|3|4|5|6] [/W|X|Y|Z]');
  247.     writeln('   or: @parmfile where PARMFILE contains several sets of parameters');
  248.     writeln('WHERE: ! = Stop the listing after the specified directory.');
  249.     writeln('       /[A|H|R|S|D]=attribute.......................Default is ALL FILES');
  250.     writeln('       /[n|e|s|t|a]=sort name,ext,size,time,attrib..Default is unsorted');
  251.     writeln('       /[W|X|Y|Z]=cluster size:512,1024,2048,4096...Default is 1024');
  252.     writeln('       /P = paging..................................Default is off');
  253.     writeln('       /T = subtotals shown.........................Default is off');
  254.     writeln('       /1 = FileSpec................................Default is "7"');
  255.     writeln('       /2 = %1 FileSpec %2');
  256.     writeln('       /3 = FileSpec + size');
  257.     writeln('       /4 = FileSpec + size + cluster size +slack');
  258.     writeln('       /5 = FileSpec + size + age');
  259.     writeln('       /6 = FileSpec + size + date + time + attrib');
  260.     writeln('       /7 = no FileSpec, directories and totals only');
  261.     writeln('       /? = this screen');
  262.     writeln;
  263.     writeln('       FileSpecs are shown for specified directory and all ');
  264.     writeln('       child directories. The default is the current directory.');
  265.     writeln('       See : UDIR.DOC for examples and instructions on how to');
  266.     write  ('             interpret the output.');
  267.     halt(1);
  268. end;
  269.  
  270. {}{}{}{}{}{}{}{}{}{}{}{}{}{}
  271. {}                        {}
  272. {} procedure testforpage; {}  {Called after every writeln() to see if }
  273. {}                        {}  {there's a need to pause the output.    }
  274. {}{}{}{}{}{}{}{}{}{}{}{}{}{}
  275.  
  276. var k:char;
  277. begin 
  278.     inc(lncnt);
  279.     if (lncnt mod depth = 0) and paged  {Normally, depth is 23, but for }
  280.     then                                {HP110 it will be 14 for a 16 line}
  281.     begin                               {screen.}
  282.         write('---MORE---',^M);
  283.         K := getkey;
  284.         write('          ',^M);
  285.     end;
  286. end;
  287.  
  288. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{This is needed because the specified}
  289. {}                                    {}{directory must be forced into the }
  290. {}procedure initlist(dname : pathstr);{}{first place in the list. If the root}
  291. {}                                    {}{directory is specified, that must be}
  292. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{put in the list and kept as the first}
  293.                                         {record in the list.}
  294. begin
  295.     new(head);                          {initialize the list}
  296.     head^.dirname := dname;             {Put the beginning directory at the}
  297.     head^.nextdir := NIL;               {head of the list.}
  298. end;
  299.  
  300. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  301. {}                                                                {}
  302. {} Procedure insert_in_list(var headptr:dirptr; FQName : string );{}
  303. {}                                                                {}
  304. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  305. var temp_ptr : dirptr;                  {Set up two more dirptrs.}
  306.     search   : dirptr;
  307.     found    : boolean;
  308.  
  309. begin
  310.         new(temp_ptr);                  {Put the directory name in the }
  311.         temp_ptr^.dirname := FQName;    {temp record. Set the pointer to }
  312.         temp_ptr^.nextdir := nil;       {nil.}
  313.  
  314.         search := headptr;              {assign headptr to search(ptr) }
  315.         if search = nil then headptr := temp_ptr
  316.         else                            {NOW, if search is nil then assign}
  317.         begin                           {temp_ptr to headptr. This takes }
  318.                                         {care of the beginning of the list.}
  319.             found := false;
  320.             while (search <> nil) and not found do {OTHERWISE DO A LINEAR }
  321.                 if search^.dirname < FQName then   {SEARCH!}
  322.                 begin
  323.                     cur := search;
  324.                     search := search^.nextdir;
  325.                 end
  326.                 else found := true;
  327.             temp_ptr^.nextdir := search;
  328.  
  329.         if search = headptr then headptr := temp_ptr
  330.         else cur^.nextdir := temp_ptr;
  331.     end;
  332. end;
  333.  
  334. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  335. {}                                  {} {recursively, find all subdirectories}
  336. {} Procedure FindDirs(Dir : String);{} {but filter out the "." and ".." }
  337. {}                                  {} {directories.}
  338. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{} 
  339. var
  340.     sr : searchrec;
  341.     begin
  342.         If DoChg then FindFirst(dir+'*.*', AnyFile, sr);
  343.         While DosError = 0 do
  344.             begin
  345.                 If (sr.Attr = $10) and (sr.Name <> '.') and (sr.Name <> '..')
  346.                 then
  347.                     begin
  348.                         insert_in_list(head, dir+sr.Name+'\');
  349.                         DoChg := True;
  350.                         FindDirs(dir + sr.Name + '\');
  351.                     end;
  352.                 DoChg := False;
  353.                 FindNext(sr);
  354.             end;
  355. end;
  356.  
  357. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  358. {}                                                        {} 
  359. {} procedure GetParms(var fpath:pathstr; var mask:st12);  {}
  360. {}                                                        {} 
  361. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  362. var
  363.     I,J ,
  364.     code: Integer;
  365.     fspec,
  366.     Parm: comStr;
  367.     Dir : DirStr;
  368.     Name: NameStr;
  369.     Ext : ExtStr;
  370.     Fl  : File;
  371.  
  372. begin
  373.     @Less := nil;                       {start with no sorting as default}
  374.     Fattr := 0;                         {start with no attributes set}
  375.     disp  := 7;                         {display format : just FQNs }
  376.     fspec := '';
  377.     subtotals:={false}true;
  378.     paged := false;
  379.     stop  := false;
  380.     mask  := '*.*';
  381.     fspec := curdir + '\';
  382.     if fspec[4]='\' then delete(fspec,4,1);
  383.     if paramcount > 0 then
  384.         begin
  385.             for I := 1 to ParamCount do {read in all the parameters}
  386.             begin
  387.                 Parm := ParamStr(I);
  388.                 if (Parm[1] = '-') or (Parm[1]='/')
  389.                 then
  390.                     for J := 2 to Length(Parm) do
  391.                     case Parm[J] of
  392.                         'e': Less := LessExt;
  393.                         'n': Less := LessName;
  394.                         's': Less := LessSize;
  395.                         't': Less := LessTime;
  396.                         'a': Less := LessAttr;
  397.                         'A': fattr:= fattr or archive;
  398.                         'H': fattr:= fattr or hidden;
  399.                         'R': fattr:= fattr or readonly;
  400.                         'S': fattr:= fattr or sysfile;
  401.                         'D': fattr:= fattr or directory;
  402.                         '1'..
  403.                         '7': val(parm[J],disp,code);
  404.                         'p',
  405.                         'P': paged:= true;
  406.                         '?',
  407.                         'h',
  408.                         'H': usage;
  409.                         'T': subtotals:=true;
  410.                         'w',
  411.                         'W': clust_size:= 512;
  412.                         'x',
  413.                         'X': clust_size:=1024;
  414.                         'y',
  415.                         'Y': clust_size:=2048;
  416.                         'z',
  417.                         'Z': clust_size:=4096;
  418.                         else begin
  419.                             WriteLn('Invalid option: ',Parm[1], Parm[J]);
  420.                             usage;
  421.                             Halt(1);
  422.                             end;
  423.                     end {case}
  424.                 else                    {a parameter with neither '/'nor'-'}
  425.                     begin
  426.                         fspec := parm;
  427.                         if parm = '' then fspec := curdir+'\';
  428.                     end;
  429.             end;
  430.         end;                            {we now have a filespec}
  431.         {CHECK OUT THE FILESPEC}
  432.         {IT COULD BE ANY OF THE FOLLOWING : \, \XXX, C:, C:\, C:\XXX,
  433.                                             C:\*.* , C:*.PAS, C:\XXX\*.*,etc}
  434.                                         {pick up FSpec from default or parm}
  435.         if pos('!',FSpec)<>0 then
  436.             begin
  437.                 delete(FSpec,pos('!',FSpec),1);
  438.                 stop := true;
  439.             end;
  440.         if FSpec[Length(Fspec)] <> '\' then
  441.         begin                           {check for \ at end}
  442.             Assign(Fl, FSpec);
  443.             GetFAttr(Fl, FilAtr);
  444.             if (DosError = 0) and (FilAtr and Directory <> 0) then
  445.             Fspec := Fspec + '\';       {if it's a directory,add \ }
  446.         end;
  447.  
  448.         FSpec := fexpand(FSpec);        {first, get a complete filespec}
  449.         fsplit (FSpec,Dir,Name,Ext);    {then break it up into parts.}
  450.  
  451.         if (Dir[2]=':') and (Dir[1]<>curdir[1]) then
  452.             begin                       {possible change of disk?}
  453.                 {$I-} chdir(Dir); {$I+}
  454.                 if ioresult <> 0 then
  455.                 begin
  456.                     writeln('Invalid path or drive ',copy(Dir,1,3),
  457.                                    ' is not ready.');
  458.                     chdir(curdir);
  459.                     halt(1);
  460.                 end;
  461.             end;
  462.         if name = '' then name :='*.';
  463.         if ext  = '' then ext  :='*';
  464.         fpath := dir; mask := name+ext;
  465.         if Fattr = 0 then Fattr := anyfile;
  466.         {if no attributes specified,default to anyfiles.}
  467. end;
  468.  
  469. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  470. {}                                    {}
  471. {} procedure Format_And_Display_Files;{}
  472. {}                                    {}
  473. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  474. var
  475.     I, J, P: Integer;
  476.     subtot : Longint;
  477.     T      : DateTime;
  478.     N      : pathStr;
  479.     E      : ExtStr;
  480.     dot    : string[1];
  481.     prnbuff,
  482.     padding, subtotstr: string;
  483.     y,dy,m,
  484.     DayOfWeek:word;
  485.     CurrDay,
  486.     FileDay,
  487.     DifferenceInDays : LongInt;
  488.  
  489. begin
  490.     subtot := 0;
  491.     tot_clusters:=0;
  492.     tot_slack:=0;
  493.  
  494.     if disp = 5 then
  495.         begin                           {Unpack the date and get currday,once}
  496.              getdate(y,m,dy,dayofweek);
  497.              Currday := JDays(y,m,dy);
  498.         end;
  499.  
  500.     for I  := 0 to Count-1 do
  501.     with Files[I]^ do
  502.     begin
  503.         P    := Pos('.', Name);
  504.         if P > 1 then
  505.         begin
  506.             N  := Copy(Name, 1, P -1);
  507.             E  := Copy(Name, P + 1, 3);
  508.             dot:='.';
  509.         end else
  510.         begin
  511.             N  := Name;
  512.             E  := '';
  513.             dot:=' ';
  514.         end;
  515.         prnbuff := '';
  516.         padding := copy('                             ',1,30-length(N+E));
  517.         if disp in [1,3,4,5,6,7]        {set up fully qualified filename}
  518.         then prnbuff := prnbuff + N+dot+E;
  519.  
  520.                                         {add %1 and %2 for special case }
  521.         if disp = 2 then prnbuff := '%1 '+N+dot+E+' %2';
  522.  
  523.         if disp in [3,4,5,6,7]   then
  524.             begin
  525.                 prnbuff := prnbuff + padding;
  526.                 if attr and directory <> 0 then
  527.                     prnbuff := prnbuff + '   <DIR>'
  528.                 else
  529.                     prnbuff := prnbuff + Longst(size,8);
  530.             end;
  531.  
  532.         if disp =4 then
  533.             begin
  534.                 clusters:= size div clust_size;
  535.                 slack   := size mod clust_size;
  536.                 if slack > 0 then       {compute the slack and adjust up}
  537.                 begin
  538.                     clusters:=clusters+1;
  539.                     slack:= clust_size-slack;
  540.                 end;
  541.  
  542.                 prnbuff := prnbuff+longst(clusters,6)+'*'+longst(clust_size,4)
  543.                            +'= '+longst(clusters*clust_size,8)
  544.                            +longst(slack,8)+' loss';
  545.                 tot_clusters:=tot_clusters+clusters;
  546.                 tot_slack:=tot_slack+slack;    {add to accumulators.}
  547.             end;
  548.  
  549.  
  550.  
  551.  
  552.         if disp =5 then                 {find the age of the file, in days.}
  553.            begin
  554.                unpacktime(time,T);
  555.                if T.month=0 then T.month := 1;
  556.                FileDay := JDays(T.Year,T.month,T.day);
  557.  
  558.                DifferenceInDays := (CurrDay - FileDay);
  559.                if differenceInDays = 0  then
  560.                    prnbuff:=prnbuff+'     TODAY''S DATE'
  561.                else if DifferenceInDays < 0 then
  562.                    prnbuff:=prnbuff+'      FUTURE DATE'
  563.                else if differenceindays > 0 then
  564.                    prnbuff:=prnbuff+longst(DifferenceinDays,6)+' day(s) old';
  565.             end;
  566.  
  567.         if disp = 6 then
  568.            begin
  569.                unpacktime(time,T);
  570.                if T.month=0 then T.month := 1;
  571.                prnbuff := prnbuff + longst(T.day,4)+'-'+monthstr[T.Month]+'-'+
  572.                           Longst(T.year mod 100,2)+
  573.                           longst(T.Hour,4)+':'+
  574.                           numstr(T.Min,2);
  575.                prnbuff := prnbuff + ' '+attrstr(attr);
  576.            end;
  577.  
  578.         if disp<>7 then writeln(prnbuff)
  579.           {else
  580.             if attr and directory <> 0 then
  581.               begin
  582.                     prnbuff := prnbuff + '   <DIR>';
  583.                     writeln(prnbuff);
  584.                     testforpage;
  585.               end};
  586.         if disp<>7 then testforpage;
  587.         Inc(subTot, Size);
  588.  
  589.     end;
  590.  
  591.     if (subtotals) and (count<>0) then
  592.     begin
  593.         if disp = 4  then
  594.         begin
  595.             writeln('# files ',count:3, subtot:28,tot_clusters:6,
  596.                     tot_clusters*clust_size:15,tot_slack:8,' loss');
  597.             inc(gr_tot_clusters,tot_clusters);
  598.             inc(gr_tot_slack, tot_slack);
  599.         end
  600.         else
  601.         begin
  602.             if disp=7 then
  603.               begin
  604.                 {filesplit;}
  605.                 if subtot<0 then subtot:=0;
  606.                 write(cur^.dirname,' ');
  607.                 if wherex<50 then gotoxy(50,wherey);
  608.                 str(subTot:11,subtotstr);
  609.                 if subtot>999 then
  610.                   begin
  611.                     insert(',',subtotstr,9);
  612.                     delete(subtotstr,1,1);
  613.                   end;
  614.                 if subtot>999999 then
  615.                   begin
  616.                     insert(',',subtotstr,5);
  617.                     delete(subtotstr,1,1);
  618.                   end;
  619.                 writeln(Count:3,' files ',subtotstr,' bytes');
  620.               end else
  621.             WriteLn(Count:3, ' files, ', subTot:11, ' bytes ');
  622.         end;
  623.         inc(total, subtot);
  624.         inc(totcount,count);
  625.         testforpage;
  626.     end;
  627. end;
  628.  
  629. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  630. {}                          {}
  631. {} procedure run_thru_list; {}
  632. {}                          {}
  633. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  634. var sr  : searchrec;
  635.  
  636.     procedure add_to_filist;            {move(,,) means all the data to a}
  637.        var  p:byte;xt:extstr;
  638.        begin                            {new memory location.}
  639.             p := pos('.',sr.name);
  640.             if p = 0 then xt := '' else xt := copy(sr.name,p+1,3);
  641.             GetMem(files[Count], sizeof(files[count]^));
  642.                                         {Get memory in the size of the }
  643.                                         {variable files[count]^ and assign}
  644.                                         {the pointer to the variable to the}
  645.                                         {pointer variable files[count].}
  646.                                         
  647.             Move(sr.Attr, Files[Count]^, Length(sr.name) + 10);
  648.                                         {Now look at the searchrec, "sr".}
  649.                                         {move everything from the sr.attr}
  650.                                         {field to files[count]^ up to and}
  651.                                         {including the time, size, and the}
  652.                                         {sr.name. Then modify the name field}
  653.                                         {in files[count]^ and in }
  654.             files[count]^.name := cur^.dirname+sr.name;
  655.             files[count]^.ext := xt;    {files[count]^.ext, directly.}
  656.             Inc(Count);                 
  657.        end;
  658.  
  659. begin
  660.     total:=0;
  661.     totcount:=0;
  662.     tot_clusters:=0;                    {initialize variables in the}
  663.     tot_slack:=0;                       {procedure.}
  664.     cur := head;                        {go to the head of the list}
  665.     
  666.     while cur <> NIL do                 {work thru the list until you hit NIL}
  667.         begin
  668.             count:=0;
  669.             fillchar(files,sizeof(files),0);
  670.             findfirst(cur^.dirname+mask, anyfile,sr);
  671.             while (DosError = 0) and (Count < MaxFiles) do
  672.             begin
  673.                 if ((fattr=anyfile) or (sr.attr and fattr<>0))
  674.                     and (sr.name <> '.')
  675.                     and (sr.name <> '..')
  676.                     and (sr.attr <> volumeID)
  677.                     and (sr.attr <> 15) {15 is attr of LFN junk in directory}
  678.                                         {IF no attribute is selected then }
  679.                                         {default is ALL files,even directories}
  680.                 then add_to_filist;     {otherwise extract files with Fattr}
  681.                                         {I want to extract all files with }
  682.                                         {any of the attributes that have been}
  683.                                         {set BUT no others. AND filter out the}
  684.                                         {'.' and '..'  files.}
  685.                 findnext(sr);
  686.             end;
  687.             if count <> 0 then
  688.             begin
  689.                 sortfiles;              {if sorting is chosen,sort only the}
  690.                 Format_And_Display_Files;             {chosen files}
  691.             end;
  692.             if count<>0 then
  693.             repeat
  694.               dec(count);
  695.               freemem(files[count],sizeof(files[count]^));
  696.             until count=0;
  697.             cur := cur^.nextdir;
  698.             if stop then cur := NIL;
  699.         end;                            {go to the next directory}
  700.  
  701.         if subtotals then
  702.         if disp = 4 then
  703.             writeln('TOTALS  ',totcount:3, total:28,gr_tot_clusters:6,
  704.                      gr_tot_clusters*clust_size:15,
  705.                      (gr_tot_slack*100.0/total):8:2,' %loss')
  706.         else
  707.             writeln( TotCount:5,' files ',(total div 1024):27,' total Kbytes.');
  708.         chdir(curdir);
  709. end;
  710.  
  711. {}{}{}{}{}{}{}{}{}{}{}{}
  712. {}                    {}
  713. {} procedure GitNGo;  {}
  714. {}                    {}
  715. {}{}{}{}{}{}{}{}{}{}{}{}
  716. begin
  717.     GetParms(filepath,mask);
  718.     initlist(filepath);
  719.     FindDirs(filepath);
  720.     run_thru_list;
  721. end;
  722.  
  723. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  724. {}                            {}
  725. {} procedure input_from_file; {}
  726. {}                            {}
  727. {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
  728. var inf : text;
  729.     fn  ,
  730.     param: string;
  731.     ioerr: byte;
  732.  
  733. begin
  734.     param := paramstr(1);
  735.     if param[1] = '@' then
  736.         begin
  737.             fn := copy (paramstr (1),2,length (paramstr (1)));
  738.             assign(inf,fn);
  739.             {$I-} reset(inf);
  740.             IOerr := IOResult; {$I+}
  741.             if IOerr <> 0 then
  742.                 begin
  743.                     writeln('@file ',fn,' was not found.');
  744.                     halt;
  745.                 end
  746.             else if IOerr = 0 then
  747.                 while( not eof(inf)) do
  748.                 begin
  749.                     readln(inf,string(ptr(prefixseg,$80)^)); {jam line into PSP}
  750.                     GitNGo;
  751.                     writeln;
  752.                 end;
  753.         end
  754.     else GitNGo {all by itself}
  755. end;
  756.  
  757. {}{}{}{}{}{}{}{}{}{}
  758. {}                {}
  759. {} procedure init;{}
  760. {}                {}
  761. {}{}{}{}{}{}{}{}{}{}
  762.  
  763. begin
  764.     lncnt := 0;
  765.     totcount := 0;
  766.     gr_tot_clusters:=0; 
  767.     gr_tot_slack:=0;                 {initialize variables}
  768.     getdir(0,curdir);                   {get current dir}
  769.     DoChg  := true;
  770. end;
  771.  
  772.  
  773. begin
  774.     init;
  775.     input_from_file;{?}
  776. end.
  777. (* REVISION HISTORY
  778. ver 0.50 released to public domain September 3, 1990
  779. ver 0.60 fixed inability of UDIR without parameters to run in the root 
  780.          directory. See lines 380-1. September 4, 1990
  781. ver 1.10 fixed heap overflow problem (lines 692-696); filtered out false
  782.          directory entries in Win95 LFN structure. September 29, 1995 
  783. *)
  784.