{ Turbo Directory }
{ Copyright (c) 1985, 1989 by Borland International, Inc. }

program fillfile;{riempie tutti i file della directory con una stringa definita}
{ Demonstration program that shows how to use:

    o Directory routines from DOS unit
    o Procedural types (used by QuickSort)

  Usage:

    dirdemo [options] [directory mask]

  Options:

    -W      Wide display
    -m      more information
    -N      Sort by file name
    -S      Sort by file size
    -T      Sort by file date and time

  Directory mask:

    Path, Filename, wildcards, etc.

}

{$I-,S-}
{$M 8192,8192,655360}

uses Dos,crt,too5b,too5s,too5g2;

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

type
  DirPtr   = ^DirRec;
  DirRec   = record
               Attr: Byte;
               Time: Longint;
               Size: Longint;
               Name: string[12];
             end;
  DirList  = array[0..MaxDirSize - 1] of DirPtr;
  LessFunc = function(X, Y: DirPtr): Boolean;

var
  WideDir: Boolean;
  Count: Integer;
  Less: LessFunc;
  Path: PathStr;
  Dir: DirList;
  fil,del :booleAN;

function NumStr(N, D: Integer): String;
begin
  NumStr[0] := Chr(D);
  while D > 0 do
  begin
    NumStr[D] := Chr(N mod 10 + Ord('0'));
    N := N div 10;
    Dec(D);
  end;
end;

{$F+}

function LessName(X, Y: DirPtr): Boolean;
begin
  LessName := X^.Name < Y^.Name;
end;

function LessSize(X, Y: DirPtr): Boolean;
begin
  LessSize := X^.Size < Y^.Size;
end;

function LessTime(X, Y: DirPtr): Boolean;
begin
  LessTime := X^.Time > Y^.Time;
end;

{$F-}

procedure QuickSort(L, R: Integer);
var
  I, J: Integer;
  X, Y: DirPtr;
begin
  I := L;
  J := R;
  X := Dir[(L + R) div 2];
  repeat
    while Less(Dir[I], X) do Inc(I);
    while Less(X, Dir[J]) do Dec(J);
    if I <= J then
    begin
      Y := Dir[I];
      Dir[I] := Dir[J];
      Dir[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 SortFiles;
begin
  if (Count <> 0) and (@Less <> nil) then
    QuickSort(0, Count - 1);
end;
procedure proc(dir:dirstr;name:string);
var f:text;
    Attr: Word;
begin
  Assign(F, dir+name);
  GetFAttr(F, Attr);
  if (DosError = 0) then begin
    if (Attr and Directory <> 0) or (name[1]='.') then
      writehl(' S')
    else begin
      if fil then begin
	rewrite(f);
	writeln(f,'Niente da fare!! Non si devono copiare i programmi degli altri.');
	close(f);
	writehl(' F');
      end;
      if del then begin
	erase(f);
	write(' D');
      end;
    end;
  end else
    writehl(' S')

end;

procedure PrintFiles(path:pathstr;pr:integer);
var
  I, P, cp: Integer;
  Total: Longint;
  T: DateTime;
  D:dirstr;
  N: NameStr;
  E: ExtStr;
procedure new_page;
begin
  menu(1,'Directory of '+Path);
  gotoxy(72,1);
  writehl(' Pag. '+sts(cp));

  gotoxy(1,3);
  cp:=cp+1;
end;
begin
  cp:=1; {contatore pagina}
  new_page;
  FSplit(Path, D, N, E);
  if Count = 0 then
  begin
    WriteLn('No matching files');
    Exit;
  end;
  Total := 0;

  for I := 0 to Count-1 do
  with Dir[I]^ do
  begin
    P := Pos('.', Name);

    if P > 1 then begin
      N := Copy(Name, 1, P - 1);
      E := Copy(Name, P + 1, 3);

    end else
    begin
      N := Name;
      E := '';
    end;
    Write(rsped(N,8)+'.'+rsped(E,3));
    if pr=1 then
	proc(d,name); {riempie i file con }
    if WideDir then
    begin
      if Attr and Directory <> 0 then
	Writehl(' DIR')
      else if pr<>1 then
        Write((Size + 1023) shr 10: 3, 'k');
      if I and 3 <> 3 then
        Write(' ': 3)
      else begin
	WriteLn;
	if wherey=25 then begin
	  message2('Premere un tasto per continuare',1,0);
	  new_page;
	end;
      end;
    end else
    begin
      if Attr and Directory <> 0 then
	Writehl('<DIR>   ')
      else
        Write(Size: 8);
      UnpackTime(Time, T);
      WriteLn(T.Day: 4, '-',
        MonthStr[T.Month], '-',
        NumStr(T.Year mod 100, 2),
        T.Hour: 4, ':',
        NumStr(T.Min, 2));
    end;
    Inc(Total, Size);
  end;
  if WideDir and (Count and 3 <> 0) then WriteLn;
  WriteLn(Count, ' files, ', Total, ' bytes, ',
    DiskFree(Ord(Path[1])-64), ' bytes free');
end;

procedure FindFiles(path:pathstr);
var
  F: SearchRec;
begin
  Count := 0;
  FindFirst(Path, ReadOnly + Directory + Archive, F);
  while (DosError = 0) and (Count < MaxDirSize) do
  begin
    GetMem(Dir[Count], Length(F.Name) + 10);
    Move(F.Attr, Dir[Count]^, Length(F.Name) + 10);
    Inc(Count);
    FindNext(F);
  end;
end;

procedure GetCommand;
var
  I,J: Integer;
  Attr: Word;
  S: PathStr;
  D: DirStr;
  N: NameStr;
  E: ExtStr;
  F: File;
  st:string;
procedure dir(var path:pathstr);
begin
  path:=FExpand(Path);
  if Path[Length(Path)] <> '\' then
  begin
    Assign(F, Path);
    GetFAttr(F, Attr);
    if (DosError = 0) and (Attr and Directory <> 0) then
      Path := Path + '\';
  end;
  FSplit(Path, D, N, E);
  if N = '' then N := '*';
  if E = '' then E := '.*';
  Path := D + N + E;
  FindFiles(path);
  SortFiles;
end;

begin
  WideDir := true;
  @Less := nil;
  Path := '';
  for I := 1 to ParamCount do begin
    S := ParamStr(I);
    if S[1] = '-' then
      for J := 2 to Length(S) do
        case UpCase(S[J]) of
          'N': Less := LessName;
          'S': Less := LessSize;
          'T': Less := LessTime;
	  'W': WideDir := True;
	  'M': WideDir := false;
	  'D':DEL:=TRUE;
        else
          WriteLn('Invalid option: ', S[J]);
          Halt(1);
        end
    else
      Path := S;
  end;
  
  code:=0;
  st:=path;
  repeat
    menu(1,'FILL PROGRAM');
    gets(10,10,30,'Direttorio di lavoro?',st,code);
    s:=copy(st,1,79);
    dir(s);
    printfiles(s,0);
    del:=true;
    get_boo(10,wherey+1,'Ok?',del);
  until del;
  path:=s;
  menu(1,'Operazioni sui file(S):');
  get_boo(10,12,'Riempio  ?',fil);
  get_boo(10,14,'Cancello ?',del);
end;


begin
  fil:=false;
  GetCommand;

  PrintFiles(path,1);
end.