home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / ipo-101.zip / Samples.zip / LINES.PAS < prev    next >
Pascal/Delphi Source File  |  1998-11-15  |  5KB  |  160 lines
  1. program lines(output);
  2. var
  3.    pc : integer;
  4.    TotalFiles, TotalLines : integer;
  5.  
  6.    procedure syntax;
  7.    begin
  8.       writeln('Lines - Counts the number of lines in the files specified');
  9.       writeln('Syntax: ivm lines filespec1, ... filespecN');
  10.       writeln('        The wildcards ''?'' and ''*'' may be used');
  11.       writeln('For example:');
  12.       writeln('        ivm lines *.pas *.txt');
  13.       writeln('  Counts the number of lines in all files with extensions');
  14.       writeln('  .pas or .txt in the current directory');
  15.       halt
  16.    end;
  17.  
  18.    procedure WriteString(var f : text; s : string; width : integer);
  19.    var
  20.       i : integer;
  21.    begin
  22.       write(f, s);
  23.       for i := 1 to width - length(s) do
  24.          write(f, ' ')
  25.    end;
  26.  
  27.    procedure CountLines(f : filename);
  28.    var
  29.       NumFiles, NumLines : integer;
  30.       DirPart, NamePart, ExtPart : filename;
  31.       fname : filename;
  32.       d : Dir;
  33.  
  34.       function FileMatch(fspec, fname : filename) : boolean;
  35.       var
  36.          SpecPos, NamePos : integer;
  37.          next : char;
  38.          done : boolean;
  39.       begin
  40.          if (platform <> platform_linux) and (platform <> platform_fbsd) then
  41.             begin
  42.                fspec := lowercase(fspec);
  43.                fname := lowercase(fname)
  44.             end;
  45.          NamePos := 1;
  46.          SpecPos := 1;
  47.          done := false;
  48.          repeat
  49.             (*
  50.             writeln(fspec, '-', fname);
  51.             writeln(SpecPos, NamePos);
  52.             *)
  53.             if (SpecPos>length(fspec)) and (NamePos>length(fname)) then
  54.                begin
  55.                   FileMatch := true;
  56.                   done := true
  57.                end
  58.             else if (SpecPos>length(fspec)) and (NamePos<=length(fname)) then
  59.                begin
  60.                   FileMatch := false;
  61.                   done := true
  62.                end
  63.             else if (SpecPos<=length(fspec)) and (NamePos>length(fname)) then
  64.                begin
  65.                   FileMatch := false;
  66.                   done := true
  67.                end
  68.             else if fspec[SpecPos] = '?' then
  69.                begin
  70.                   inc(SpecPos);
  71.                   inc(NamePos)
  72.                end
  73.             else if fspec[SpecPos] = '*' then
  74.                begin
  75.                   if SpecPos = length(fspec) then
  76.                      begin
  77.                         FileMatch := true;
  78.                         done := true
  79.                      end
  80.                   else
  81.                      begin
  82.                         next := fspec[SpecPos+1];
  83.                         NamePos := pos(next, fname, NamePos);
  84.                         if NamePos > 0 then
  85.                            inc(SpecPos)
  86.                         else
  87.                            begin
  88.                               FileMatch := false;
  89.                               done := true
  90.                            end
  91.                      end
  92.                end
  93.             else if fspec[SpecPos] = fname[NamePos] then
  94.                begin
  95.                   inc(SpecPos);
  96.                   inc(NamePos)
  97.                end
  98.             else
  99.                begin
  100.                   FileMatch := false;
  101.                   done := true
  102.                end
  103.          until done;
  104.       end;
  105.  
  106.       function DoCount(name : filename) : integer;
  107.       var
  108.          count : integer;
  109.          f : text;
  110.       begin
  111.          count := 0;
  112.          assign(f, name);
  113.          reset(f);
  114.          while not eof(f) do
  115.             begin
  116.                readln(f);
  117.                inc(count);
  118.             end;
  119.          DoCount := count;
  120.          close(f)
  121.       end;
  122.  
  123.    begin
  124.       NumFiles := 0;
  125.       NumLines := 0;
  126.       f := fexpand(f);
  127.       writeln(f);
  128.       fsplit(f, DirPart, NamePart, ExtPart);
  129.       NamePart := NamePart + ExtPart;
  130.       OpenDir(d, DirPart);
  131.       repeat
  132.          ReadDir(d, fname);
  133.          if fname <> '' then
  134.             begin
  135.                if FileMatch(NamePart, fname) then
  136.                   begin
  137.                      inc(NumFiles);
  138.                      NumLines := DoCount(DirPart+fname);
  139.                      WriteString(output, fname, 16);
  140.                      writeln(NumLines);
  141.                      inc(TotalLines, NumLines)
  142.                   end
  143.             end
  144.       until fname = '';
  145.       CloseDir(d);
  146.       inc(TotalFiles, NumFiles);
  147.    end;
  148.  
  149. begin
  150.    if paramcount < 1 then
  151.       syntax;
  152.    TotalFiles := 0;
  153.    TotalLines := 0;
  154.    for pc := 1 to paramcount do
  155.        CountLines(paramstr(pc));
  156.    writeln('--------------------------');
  157.    writeln('Total Files = ', TotalFiles:10);
  158.    writeln('Total Lines = ', TotalLines:10)
  159. end.
  160.