{ 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 1 colum display
    -N      Sort by file name
    -S      Sort by file size
    -T      Sort by file date and time
    -D      Delete files
    -F      Fill files
    -?      configure
    -C      confir each file process;
    -P      wait at end;
    -I      (input file) name
    -O      (output file) name
    -L      less or only list
    -X      print extended path

  Directory mask:

    Path, Filename, wildcards, etc.

}

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

uses Dos,crt,too5b,too5s,too5g2;

const
  MaxDirSize = 3000;
  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;
  ok,fil,del,ask,pau,inf,outf :booleAN;
  list,extended:boolean; {parametro list: se vero stampa solo i nomi senza attributi}
  ch:char;
  infname,outfname:string;
  infile,outfile:text;
  pr:integer;

procedure help;
var ch:char;
begin
  clrscr;
  writeln('D ; programma di utilita`; da una base di demo Turbo Pascal 5.5');
  writeln('Questo programma e` PUBLIC DOMAIN; puo` essere liberamente copiato');
  writeln('Per poter essere venduto dovete chiedere autorizzazione a:');
  writeln;
  writexy(25,5,'Palmerini Loris         v. Marconi 3');
  writexy(47,6,'35030 Rubano Padova');
  writexy(47,7,'  Tel 049/631322');
  writexy(1,9,'La sintassi e`:                      D [opzioni] [Maschera di lista]');
  writexy(1,11,'Le Opzioni disponibili sono:');
    writexy(3,13,'-M (More)      = Stampa tutte le informazioni relative ai file in 2 colonne');
    writexy(3,14,'-N (by Name)   = Riordina per nome');
    writexy(3,15,'-S (by Size)   =   " "    per dimensione file');
    writexy(3,16,'-T (by Time)   =   " "    per Data');
    writexy(3,17,'-D (Delete)    = CANCELLA i file visualizzati');
    writexy(3,18,'-F (Fill file) = Riscrive sopra i file una stringa');
    writexy(13,19,'(Serve per non permettere il recupero dei file cancellati}');
    writexy(3,20,'-? (Configura) = Chiede interattivamente le operazioni da compiere');
    writexy(3,21,'-C (Conferma)  = Chiede conferma ad ogni file per le operazioni richieste');
    writexy(3,22,'-P (Pause)     = Alla fine aspetta la press. di un tasto che resta nel buffer');
    gkk(ch);
    gotoxy(1,13);clreop;
    writexy(3,13,'-I (input file) name  = Opera sui file scritti nel file "name"');
    writexy(3,14,'-L (less information or only list) = elenca solo i nomi');
    writexy(3,15,'-O (output file) name = Manda l`output sul file "name"');
    writexy(3,16,'-X (print extended path) = aggiunge il path al nome file');
    writexy(1,24,'La maschera di lista e costituita da  [Percorso][NomeFile (con * e ?)]');
   gkk(ch);;
end;
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;
    ok:boolean;
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 ask then begin
	ok:=false;
	get_boo(wherex,wherey,'?',ok);
	gotoxy(wherex-1,wherey);
      end else ok:=true;
      if ok then begin
	write(' ');
	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 else writehl(' S');
    end;
  end else
    writehl(' S')

end;
procedure write_on_file(path:pathstr);
var
  I, P, cp, y: Integer;
  Total: Longint;
  T: DateTime;
  D:dirstr;
  N: NameStr;
  E: ExtStr;


begin
  assign(outfile,outfname);
  rewrite(outfile);
  if not(list) then
    writeln(outfile,'Directory of '+Path);
  FSplit(Path, D, N, E);
  if (Count = 0) and not(list) then  begin
    WriteLn(outfile,'No matching files');
    Exit;
  end else begin
  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;
      if list then begin
	if extended then
	  writeln(outfile,D+name)
	else
	  writeln(outfile,name);
      end
      else begin
	 Write(outfile,rsped(N,8));
	 if Attr and Directory <> 0 then
	   writeln(outfile,'<DIR>')
	 else
	   write(outfile,'.'+rsped(E,3));
	 if not(Attr and Directory <> 0) then begin
	 Write(outfile,(Size + 1023) shr 10: 3, 'k');
	 Write(outfile,Size: 8);
	 UnpackTime(Time, T);
	 Writeln(outfile,T.Day: 3,'-',
	 MonthStr[T.Month],'-',
	 NumStr(T.Year mod 100, 2),
	 T.Hour: 3, ':',
	 NumStr(T.Min, 2));
      end;
    end;
      Inc(Total, Size);
    end;
    if not(list) then begin
      WriteLn(outfile,'');
      WriteLn(outfile,Count,' files, ',Total,' bytes, ',
      DiskFree(Ord(Path[1])-64),' bytes free');
    end;
  end;
  close(outfile)
end;

procedure PrintFiles(path:pathstr;pr:integer);
var
  I, P, cp, y: Integer;
  Total: Longint;
  T: DateTime;
  D:dirstr;
  N: NameStr;
  E: ExtStr;
procedure new_page;
begin
  y:=1;{contatore riga}
  centre(wherey,'Directory of '+Path);
  gotoxy(72,wherey);clreop;
  writehl('Pag. '+sts(cp));
  writeln;writeln;
  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 else begin
  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));
    if Attr and Directory <> 0 then
	Writehl('<DIR>')
    else
     write('.'+rsped(E,3));

    if (pr=1) then
	proc(d,name); {riempie i file con }
    if WideDir then begin
      if not(Attr and Directory <> 0) and (pr<>1) then
	Write((Size + 1023) shr 10: 3, 'k')
      else
       case wherex of
	2..19:write(' ':(20-wherex));
	21..39:write(' ':(40-wherex));
	41..59:write(' ':(60-wherex));
	61..90:begin
		 writeln;
		 y:=y+1;
	       end;
       end;


    end else
    begin
      if not(Attr and Directory <> 0) then
	Write(Size: 8);
      UnpackTime(Time, T);
      Write(T.Day: 3, '-',
        MonthStr[T.Month], '-',
        NumStr(T.Year mod 100, 2),
	T.Hour: 3, ':',
	NumStr(T.Min, 2));
      if wherex>40 then begin
	writeln;
	y:=y+1;
      end

      else gotoxy(40,wherey)
    end;
    if y=25 then begin
	message2('Premere un tasto per continuare',1,0);
	gotoxy(1,wherey);clreol;
	new_page;
	y:=1;
      end;
    Inc(Total, Size);
  end;
  if WideDir and (Count and 3 <> 0) then
    WriteLn;
  WriteLn(sts2(Count,1,0), ' files, ', Total, ' bytes, ',
  DiskFree(Ord(Path[1])-64), ' bytes free');
  end;
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,c: Integer;
  Attr: Word;
  S: PathStr;
  D: DirStr;
  N: NameStr;
  E: ExtStr;
  F: File;
  st:string;
  bh:boolean;
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;
  list:=false;
  extended:=false;
  @Less := nil;
  Path := '';
  c:=ParamCount;
  bh:=false;
  pau:=false;
  i:=1;
  while i<=c do begin
    S := ParamStr(I);
    if S[1] = '-' then begin
      j:=2;
      while j<=Length(S) do begin
        case UpCase(S[J]) of
          'N': Less := LessName;
          'S': Less := LessSize;
          'T': Less := LessTime;
	  'W': WideDir := True;
	  'M': WideDir := false;
	  'D':begin
		DEL:=TRUE;
		pr:=1;
	      end;
	  'F':begin
		fil:=true;
		pr:=1;
	      end;
	  '?':bh:=true;
	  'C':ask:=true;
	  'H':help;
	  'P':pau:=true;
	  'I':begin
		inf:=true;
		infname:=ParamStr(I+1);
		i:=1+1;
	      end;
	  'O':begin
		outf:=true;
		outfname:=ParamStr(I+1);
		i:=i+1;
	      end;
	  'L':list:=true; {formato lista o ridotto}
	  'X':extended:=true; {formato lista con path}
        else
          WriteLn('Invalid option: ', S[J]);
          Halt(1);
	end;
	j:=j+1;
      end;
    end
    else
      Path := S;
    i:=i+1;
  end;
  if bh then begin
    code:=0;
    st:=path;
    repeat
      menu(1,'Directory Program');
      gets(10,3,30,'Direttorio di lavoro?',st,code);
      clrscr;
      s:=copy(st,1,79);
      dir(s);
      printfiles(s,0);
      bh:=true;
      if wherey=25 then writeln;
      get_boo(10,wherey+1,'Ok?',bh);
   until bh;
   path:=s;
   menu(1,'Operazioni sui file(S):');
   get_boo(10,12,'Riempio  ?',fil);
   get_boo(10,14,'Cancello ?',del);
  end else
    dir(path);
end;


begin
  directvideo:=false;
  pr:=0;
  fil:=false;
  del:=false;
  ask:=false;
  inf:=false;
  outf:=false;
  infname:='';
  outfname:='';
  GetCommand;
  if not(ask) and (del or fil) then begin
    write('Attenzione!! Tutti i file verrano ');
    if fil then write(' Riempiti di caratteri (IRRECUPERABILMENTE!)');
    if fil and del then write(' e ');
    if del then write(' Cancellati ');
    writeln('.');
    ok:=false;
    get_boo(1,wherey,'. Sei sicuro di voler procedere?',ok);
  end else
    ok:=true;
  if ok then begin
    PrintFiles(path,pr);
    if outf then
      write_on_file(path);
  end;
  if pau then wait;
{  port[$60]:=80;
  gkk(ch);
  writeln(ch);
  wait;
  close(input);
  assign(input,'pippo');
  rewrite(input);
  writeln(input,'d -p');
  close(input);
  reset(input);
  while not(eof(input)) do   begin
    writeln('Data on input');
    read(input,ch);
    write(ch);
  end;}

end.