Паскаль / do9 / iriepas201 / Irie Pascal / samples / lines

program lines(output);
var
   pc : integer;
   TotalFiles, TotalLines : integer;

   procedure syntax;
   begin
      writeln('Lines - Counts the number of lines in the files specified');
      writeln('Syntax: ivm lines filespec1, ... filespecN');
      writeln('        The wildcards ''?'' and ''*'' may be used');
      writeln('For example:');
      writeln('        ivm lines *.pas *.txt');
      writeln('  Counts the number of lines in all files with extensions');
      writeln('  .pas or .txt in the current directory');
      halt
   end;

   procedure WriteString(var f : text; s : string; width : integer);
   var
      i : integer;
   begin
      write(f, s);
      for i := 1 to width - length(s) do
         write(f, ' ')
   end;

   procedure CountLines(f : filename);
   var
      NumFiles, NumLines : integer;
      DirPart, NamePart, ExtPart : filename;
      fname : filename;
      d : Dir;

      function DoCount(name : filename) : integer;
      var
         count : integer;
         f : text;
      begin
         count := 0;
         assign(f, name);
         reset(f);
         while not eof(f) do
            begin
               readln(f);
               inc(count);
            end;
         DoCount := count;
         close(f)
      end;

   begin
      NumFiles := 0;
      NumLines := 0;
      f := fexpand(f);
      writeln(f);
      fsplit(f, DirPart, NamePart, ExtPart);
      NamePart := NamePart + ExtPart;
      OpenDir(d, DirPart);
      repeat
         ReadDir(d, fname);
         if fname <> '' then
            begin
               if FileMatch(NamePart, fname) then
                  begin
                     inc(NumFiles);
                     NumLines := DoCount(DirPart+fname);
                     WriteString(output, fname, 16);
                     writeln(NumLines);
                     inc(TotalLines, NumLines)
                  end
            end
      until fname = '';
      CloseDir(d);
      inc(TotalFiles, NumFiles);
   end;

begin
   if paramcount < 1 then
      syntax;
   TotalFiles := 0;
   TotalLines := 0;
   for pc := 1 to paramcount do
       CountLines(paramstr(pc));
   writeln('--------------------------');
   writeln('Total Files = ', TotalFiles:10);
   writeln('Total Lines = ', TotalLines:10)
end.