home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / turbo5 / dirdemo.pas < prev    next >
Pascal/Delphi Source File  |  1988-10-09  |  5KB  |  239 lines

  1. { Copyright (c) 1985, 88 by Borland International, Inc. }
  2.  
  3. program DirDemo;
  4. { Demonstration program that shows how to use:
  5.  
  6.     o Directory routines from DOS unit
  7.     o Procedural types (used by QuickSort)
  8.  
  9.   Usage:
  10.  
  11.     dirdemo [options] [directory mask]
  12.  
  13.   Options:
  14.  
  15.     -W      Wide display
  16.     -N      Sort by file name
  17.     -S      Sort by file size
  18.     -T      Sort by file date and time
  19.  
  20.   Directory mask:
  21.  
  22.     Path, Filename, wildcards, etc.
  23.  
  24. }
  25.  
  26. {$I-,S-}
  27. {$M 8192,8192,655360}
  28.  
  29. uses Dos;
  30.  
  31. const
  32.   MaxDirSize = 512;
  33.   MonthStr: array[1..12] of string[3] = (
  34.     'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  35.     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  36.  
  37. type
  38.   DirPtr   = ^DirRec;
  39.   DirRec   = record
  40.                Attr: Byte;
  41.                Time: Longint;
  42.                Size: Longint;
  43.                Name: string[12];
  44.              end;
  45.   DirList  = array[0..MaxDirSize - 1] of DirPtr;
  46.   LessFunc = function(X, Y: DirPtr): Boolean;
  47.  
  48. var
  49.   WideDir: Boolean;
  50.   Count: Integer;
  51.   Less: LessFunc;
  52.   Path: PathStr;
  53.   Dir: DirList;
  54.  
  55. function NumStr(N, D: Integer): String;
  56. begin
  57.   NumStr[0] := Chr(D);
  58.   while D > 0 do
  59.   begin
  60.     NumStr[D] := Chr(N mod 10 + Ord('0'));
  61.     N := N div 10;
  62.     Dec(D);
  63.   end;
  64. end;
  65.  
  66. {$F+}
  67.  
  68. function LessName(X, Y: DirPtr): Boolean;
  69. begin
  70.   LessName := X^.Name < Y^.Name;
  71. end;
  72.  
  73. function LessSize(X, Y: DirPtr): Boolean;
  74. begin
  75.   LessSize := X^.Size < Y^.Size;
  76. end;
  77.  
  78. function LessTime(X, Y: DirPtr): Boolean;
  79. begin
  80.   LessTime := X^.Time > Y^.Time;
  81. end;
  82.  
  83. {$F-}
  84.  
  85. procedure QuickSort(L, R: Integer);
  86. var
  87.   I, J: Integer;
  88.   X, Y: DirPtr;
  89. begin
  90.   I := L;
  91.   J := R;
  92.   X := Dir[(L + R) div 2];
  93.   repeat
  94.     while Less(Dir[I], X) do Inc(I);
  95.     while Less(X, Dir[J]) do Dec(J);
  96.     if I <= J then
  97.     begin
  98.       Y := Dir[I];
  99.       Dir[I] := Dir[J];
  100.       Dir[J] := Y;
  101.       Inc(I);
  102.       Dec(J);
  103.     end;
  104.   until I > J;
  105.   if L < J then QuickSort(L, J);
  106.   if I < R then QuickSort(I, R);
  107. end;
  108.  
  109. procedure GetCommand;
  110. var
  111.   I,J: Integer;
  112.   Attr: Word;
  113.   S: PathStr;
  114.   D: DirStr;
  115.   N: NameStr;
  116.   E: ExtStr;
  117.   F: File;
  118. begin
  119.   WideDir := False;
  120.   @Less := nil;
  121.   Path := '';
  122.   for I := 1 to ParamCount do
  123.   begin
  124.     S := ParamStr(I);
  125.     if S[1] = '-' then
  126.       for J := 2 to Length(S) do
  127.         case UpCase(S[J]) of
  128.           'N': Less := LessName;
  129.           'S': Less := LessSize;
  130.           'T': Less := LessTime;
  131.           'W': WideDir := True;
  132.         else
  133.           WriteLn('Invalid option: ', S[J]);
  134.           Halt(1);
  135.         end
  136.     else
  137.       Path := S;
  138.   end;
  139.   Path := FExpand(Path);
  140.   if Path[Length(Path)] <> '\' then
  141.   begin
  142.     Assign(F, Path);
  143.     GetFAttr(F, Attr);
  144.     if (DosError = 0) and (Attr and Directory <> 0) then
  145.       Path := Path + '\';
  146.   end;
  147.   FSplit(Path, D, N, E);
  148.   if N = '' then N := '*';
  149.   if E = '' then E := '.*';
  150.   Path := D + N + E;
  151. end;
  152.  
  153. procedure FindFiles;
  154. var
  155.   F: SearchRec;
  156. begin
  157.   Count := 0;
  158.   FindFirst(Path, ReadOnly + Directory + Archive, F);
  159.   while (DosError = 0) and (Count < MaxDirSize) do
  160.   begin
  161.     GetMem(Dir[Count], Length(F.Name) + 10);
  162.     Move(F.Attr, Dir[Count]^, Length(F.Name) + 10);
  163.     Inc(Count);
  164.     FindNext(F);
  165.   end;
  166. end;
  167.  
  168. procedure SortFiles;
  169. begin
  170.   if (Count <> 0) and (@Less <> nil) then
  171.     QuickSort(0, Count - 1);
  172. end;
  173.  
  174. procedure PrintFiles;
  175. var
  176.   I, P: Integer;
  177.   Total: Longint;
  178.   T: DateTime;
  179.   N: NameStr;
  180.   E: ExtStr;
  181. begin
  182.   WriteLn('Directory of ', Path);
  183.   if Count = 0 then
  184.   begin
  185.     WriteLn('No matching files');
  186.     Exit;
  187.   end;
  188.   Total := 0;
  189.   for I := 0 to Count-1 do
  190.   with Dir[I]^ do
  191.   begin
  192.     P := Pos('.', Name);
  193.     if P > 1 then
  194.     begin
  195.       N := Copy(Name, 1, P - 1);
  196.       E := Copy(Name, P + 1, 3);
  197.     end else
  198.     begin
  199.       N := Name;
  200.       E := '';
  201.     end;
  202.     Write(N, ' ': 9 - Length(N), E, ' ': 4 - Length(E));
  203.     if WideDir then
  204.     begin
  205.       if Attr and Directory <> 0 then
  206.         Write(' DIR')
  207.       else
  208.         Write((Size + 1023) shr 10: 3, 'k');
  209.       if I and 3 <> 3 then
  210.         Write(' ': 3)
  211.       else
  212.         WriteLn;
  213.     end else
  214.     begin
  215.       if Attr and Directory <> 0 then
  216.         Write('<DIR>   ')
  217.       else
  218.         Write(Size: 8);
  219.       UnpackTime(Time, T);
  220.       WriteLn(T.Day: 4, '-',
  221.         MonthStr[T.Month], '-',
  222.         NumStr(T.Year mod 100, 2),
  223.         T.Hour: 4, ':',
  224.         NumStr(T.Min, 2));
  225.     end;
  226.     Inc(Total, Size);
  227.   end;
  228.   if WideDir and (Count and 3 <> 0) then WriteLn;
  229.   WriteLn(Count, ' files, ', Total, ' bytes, ',
  230.     DiskFree(Ord(Path[1])-64), ' bytes free');
  231. end;
  232.  
  233. begin
  234.   GetCommand;
  235.   FindFiles;
  236.   SortFiles;
  237.   PrintFiles;
  238. end.
  239.