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 >
Wrap
Pascal/Delphi Source File
|
1998-11-15
|
5KB
|
160 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 FileMatch(fspec, fname : filename) : boolean;
var
SpecPos, NamePos : integer;
next : char;
done : boolean;
begin
if (platform <> platform_linux) and (platform <> platform_fbsd) then
begin
fspec := lowercase(fspec);
fname := lowercase(fname)
end;
NamePos := 1;
SpecPos := 1;
done := false;
repeat
(*
writeln(fspec, '-', fname);
writeln(SpecPos, NamePos);
*)
if (SpecPos>length(fspec)) and (NamePos>length(fname)) then
begin
FileMatch := true;
done := true
end
else if (SpecPos>length(fspec)) and (NamePos<=length(fname)) then
begin
FileMatch := false;
done := true
end
else if (SpecPos<=length(fspec)) and (NamePos>length(fname)) then
begin
FileMatch := false;
done := true
end
else if fspec[SpecPos] = '?' then
begin
inc(SpecPos);
inc(NamePos)
end
else if fspec[SpecPos] = '*' then
begin
if SpecPos = length(fspec) then
begin
FileMatch := true;
done := true
end
else
begin
next := fspec[SpecPos+1];
NamePos := pos(next, fname, NamePos);
if NamePos > 0 then
inc(SpecPos)
else
begin
FileMatch := false;
done := true
end
end
end
else if fspec[SpecPos] = fname[NamePos] then
begin
inc(SpecPos);
inc(NamePos)
end
else
begin
FileMatch := false;
done := true
end
until done;
end;
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.