Turbo Pascal 7.0 / TP7 / WINDEMOS / DIRDEMO

{************************************************}
{                                                }
{   Turbo Pascal for Windows                     }
{   Demo program                                 }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

{ This programs demonstrates how to use the WinCrt unit. See
  Chapter 14 in the Programmer's Guide for more details. For
  information on writing more advanced Windows applications, read
  about the ObjectWindows application framework in the Windows
  Programming Guide. }

program DirDemo;

{$S-}

uses WinTypes, WinProcs, WinCrt, WinDos, Strings;

const
  MaxDirSize = 512;
  MonthStr: array[1..12, 0..3] of Char = (
    'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

type
  PDirEntry = ^TDirEntry;
  TDirEntry = record
    Attr: Byte;
    Time: Longint;
    Size: Longint;
    Name: array[0..12] of Char;
  end;
  TDirList = array[0..MaxDirSize - 1] of PDirEntry;

var
  Count: Integer;
  Path: array[0..fsPathName] of Char;
  DirList: TDirList;

function NumStr(N: Integer): PChar;
const
  NumText: array[0..2] of Char = '00';
begin
  NumText[0] := Chr(N div 10 + Ord('0'));
  NumText[1] := Chr(N mod 10 + Ord('0'));
  NumStr := NumText;
end;

procedure QuickSort(L, R: Integer);
var
  I, J: Integer;
  X, Y: PDirEntry;
begin
  I := L;
  J := R;
  X := DirList[(L + R) div 2];
  repeat
    while StrComp(DirList[I]^.Name, X^.Name) < 0 do Inc(I);
    while StrComp(DirList[J]^.Name, X^.Name) > 0 do Dec(J);
    if I <= J then
    begin
      Y := DirList[I];
      DirList[I] := DirList[J];
      DirList[J] := Y;
      Inc(I);
      Dec(J);
    end;
  until I > J;
  if L < J then QuickSort(L, J);
  if I < R then QuickSort(I, R);
end;

procedure GetPath;
var
  Attr: Word;
  Dir: array[0..fsDirectory] of Char;
  Name: array[0..fsFileName] of Char;
  Ext: array[0..fsExtension] of Char;
  F: File;
begin
  Write('Show directory of? ');
  ReadLn(Path);
  FileExpand(Path, Path);
  if Path[StrLen(Path) - 1] <> '\' then
  begin
    Assign(F, Path);
    GetFAttr(F, Attr);
    if (DosError = 0) and (Attr and faDirectory <> 0) then
      StrLCat(Path, '\', fsPathName);
  end;
  FileSplit(Path, Dir, Name, Ext);
  if Name[0] = #0 then StrCopy(Name, '*');
  if Ext[0] = #0 then StrCopy(Ext, '.*');
  StrECopy(StrECopy(StrECopy(Path, Dir), Name), Ext);
end;

procedure FindFiles;
var
  N: Word;
  SearchRec: TSearchRec;
begin
  Count := 0;
  FindFirst(Path, faReadOnly + faDirectory + faArchive, SearchRec);
  while (DosError = 0) and (Count < MaxDirSize) do
  begin
    N := StrLen(SearchRec.Name) + 10;
    GetMem(DirList[Count], N);
    Move(SearchRec.Attr, DirList[Count]^, N);
    Inc(Count);
    FindNext(SearchRec);
  end;
end;

procedure SortFiles;
begin
  if Count <> 0 then QuickSort(0, Count - 1);
end;

procedure PrintFiles;
var
  I: Integer;
  Total: Longint;
  P: PChar;
  T: TDateTime;
  N: array[0..fsFileName] of Char;
  E: array[0..fsExtension] of Char;
begin
  WriteLn('Directory of ', Path);
  if Count = 0 then
  begin
    WriteLn('No matching files');
    Exit;
  end;
  Total := 0;
  for I := 0 to Count - 1 do
    with DirList[I]^ do
    begin
      P := StrPos(Name, '.');
      if (P = nil) or (P = Name) then
      begin
        StrCopy(N, Name);
        StrCopy(E, '');
      end else
      begin
        StrLCopy(N, Name, P - Name);
        StrCopy(E, P + 1);
      end;
      Write(N, ' ': 9 - StrLen(N), E, ' ': 4 - StrLen(E));
      if Attr and faDirectory <> 0 then
        Write('<DIR>   ')
      else
        Write(Size: 8);
      UnpackTime(Time, T);
      WriteLn(T.Day: 4, '-',
        MonthStr[T.Month], '-',
        NumStr(T.Year mod 100),
        T.Hour: 4, ':',
        NumStr(T.Min));
      Inc(Total, Size);
    end;
  WriteLn(Count, ' files, ', Total, ' bytes, ',
    DiskFree(Ord(Path[0]) - 64), ' bytes free');
  WriteLn;
end;

begin
  ScreenSize.X := 64;
  ScreenSize.Y := 256;
  while True do
  begin
    GetPath;
    FindFiles;
    SortFiles;
    PrintFiles;
  end;
end.