home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WINDEMOS.ZIP / DIRDEMO.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  4.1 KB  |  178 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { This programs demonstrates how to use the WinCrt unit. See the
  9.   Programmer's Guide for more details. For information on writing more
  10.   advanced Windows applications, read about the ObjectWindows
  11.   application framework in the Windows Programming Guide.
  12. }
  13.  
  14. program DirDemo;
  15.  
  16. {$S-}
  17.  
  18. uses WinTypes, WinProcs, WinCrt, WinDos, Strings;
  19.  
  20. const
  21.   MaxDirSize = 512;
  22.   MonthStr: array[1..12, 0..3] of Char = (
  23.     'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  24.     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  25.  
  26. type
  27.   PDirEntry = ^TDirEntry;
  28.   TDirEntry = record
  29.     Attr: Byte;
  30.     Time: Longint;
  31.     Size: Longint;
  32.     Name: array[0..12] of Char;
  33.   end;
  34.   TDirList = array[0..MaxDirSize - 1] of PDirEntry;
  35.  
  36. var
  37.   Count: Integer;
  38.   Path: array[0..fsPathName] of Char;
  39.   DirList: TDirList;
  40.  
  41. function NumStr(N: Integer): PChar;
  42. const
  43.   NumText: array[0..2] of Char = '00';
  44. begin
  45.   NumText[0] := Chr(N div 10 + Ord('0'));
  46.   NumText[1] := Chr(N mod 10 + Ord('0'));
  47.   NumStr := NumText;
  48. end;
  49.  
  50. procedure QuickSort(L, R: Integer);
  51. var
  52.   I, J: Integer;
  53.   X, Y: PDirEntry;
  54. begin
  55.   I := L;
  56.   J := R;
  57.   X := DirList[(L + R) div 2];
  58.   repeat
  59.     while StrComp(DirList[I]^.Name, X^.Name) < 0 do Inc(I);
  60.     while StrComp(DirList[J]^.Name, X^.Name) > 0 do Dec(J);
  61.     if I <= J then
  62.     begin
  63.       Y := DirList[I];
  64.       DirList[I] := DirList[J];
  65.       DirList[J] := Y;
  66.       Inc(I);
  67.       Dec(J);
  68.     end;
  69.   until I > J;
  70.   if L < J then QuickSort(L, J);
  71.   if I < R then QuickSort(I, R);
  72. end;
  73.  
  74. procedure GetPath;
  75. var
  76.   Attr: Word;
  77.   Dir: array[0..fsDirectory] of Char;
  78.   Name: array[0..fsFileName] of Char;
  79.   Ext: array[0..fsExtension] of Char;
  80.   F: File;
  81. begin
  82.   Write('Show directory of? ');
  83.   ReadLn(Path);
  84.   FileExpand(Path, Path);
  85.   if Path[StrLen(Path) - 1] <> '\' then
  86.   begin
  87.     Assign(F, Path);
  88.     GetFAttr(F, Attr);
  89.     if (DosError = 0) and (Attr and faDirectory <> 0) then
  90.       StrLCat(Path, '\', fsPathName);
  91.   end;
  92.   FileSplit(Path, Dir, Name, Ext);
  93.   if Name[0] = #0 then StrCopy(Name, '*');
  94.   if Ext[0] = #0 then StrCopy(Ext, '.*');
  95.   StrECopy(StrECopy(StrECopy(Path, Dir), Name), Ext);
  96. end;
  97.  
  98. procedure FindFiles;
  99. var
  100.   N: Word;
  101.   SearchRec: TSearchRec;
  102. begin
  103.   Count := 0;
  104.   FindFirst(Path, faReadOnly + faDirectory + faArchive, SearchRec);
  105.   while (DosError = 0) and (Count < MaxDirSize) do
  106.   begin
  107.     N := StrLen(SearchRec.Name) + 10;
  108.     GetMem(DirList[Count], N);
  109.     Move(SearchRec.Attr, DirList[Count]^, N);
  110.     Inc(Count);
  111.     FindNext(SearchRec);
  112.   end;
  113. end;
  114.  
  115. procedure SortFiles;
  116. begin
  117.   if Count <> 0 then QuickSort(0, Count - 1);
  118. end;
  119.  
  120. procedure PrintFiles;
  121. var
  122.   I: Integer;
  123.   Total: Longint;
  124.   P: PChar;
  125.   T: TDateTime;
  126.   N: array[0..fsFileName] of Char;
  127.   E: array[0..fsExtension] of Char;
  128. begin
  129.   WriteLn('Directory of ', Path);
  130.   if Count = 0 then
  131.   begin
  132.     WriteLn('No matching files');
  133.     Exit;
  134.   end;
  135.   Total := 0;
  136.   for I := 0 to Count - 1 do
  137.     with DirList[I]^ do
  138.     begin
  139.       P := StrPos(Name, '.');
  140.       if (P = nil) or (P = Name) then
  141.       begin
  142.         StrCopy(N, Name);
  143.         StrCopy(E, '');
  144.       end else
  145.       begin
  146.         StrLCopy(N, Name, P - Name);
  147.         StrCopy(E, P + 1);
  148.       end;
  149.       Write(N, ' ': 9 - StrLen(N), E, ' ': 4 - StrLen(E));
  150.       if Attr and faDirectory <> 0 then
  151.         Write('<DIR>   ')
  152.       else
  153.         Write(Size: 8);
  154.       UnpackTime(Time, T);
  155.       WriteLn(T.Day: 4, '-',
  156.         MonthStr[T.Month], '-',
  157.         NumStr(T.Year mod 100),
  158.         T.Hour: 4, ':',
  159.         NumStr(T.Min));
  160.       Inc(Total, Size);
  161.     end;
  162.   WriteLn(Count, ' files, ', Total, ' bytes, ',
  163.     DiskFree(Ord(Path[0]) - 64), ' bytes free');
  164.   WriteLn;
  165. end;
  166.  
  167. begin
  168.   ScreenSize.X := 64;
  169.   ScreenSize.Y := 256;
  170.   while True do
  171.   begin
  172.     GetPath;
  173.     FindFiles;
  174.     SortFiles;
  175.     PrintFiles;
  176.   end;
  177. end.
  178.