Der Quellcode:
program suchen;
uses crt,sysutils;
const n='aufgabe.tex';
var a:text;
{Auslesen der Dateien und schreiben in neue Datei}
procedure lesen(d:string);
var f:text;
c,s:string;
b:boolean;
begin
b:=false;
assignfile(f,d);
{$i-} reset(f);
if ioresult=0 then
begin
while not eof(f) do
begin
readln(f,c);
while length(c)>0 do
begin
if pos(#10,c)>0
then
begin
s:=copy(c,1,pos(#10,c));
delete(c,1,pos(#10,c));
end
else
begin
s:=copy(c,1,length(c));
delete(c,1,length(c));
end;
if length(s)>0 then
begin
if (b) and (pos('\end{hmaufgabe}',s)=0) then writeln(a,s);
if (((not b) and (pos(paramstr(1),s)>0))
OR ((not b) and (pos(paramstr(2),s)>0))
OR ((not b) and (pos(paramstr(3),s)>0))
OR ((not b) and (pos(paramstr(4),s)>0))
OR ((not b) and (pos(paramstr(5),s)>0))) then
begin
b:=true;
writeln(a,'\item');
end;
if (pos('\end{hmaufgabe}',s)>0) then b:=false;
end;
end;
end;
closefile(f); {$i+}
end;
end;
{Suchen der Labels}
procedure suche(s,t:string);
var r :integer;
p :tsearchrec;
begin
r:=findfirst(s+t,faanyfile,p);
while (r=0) do
begin
if ((p.attr<>32) and
(p.name[1]<>'.')) then suche(s+p.name+'/',t)
else
begin
if (p.name[1]<>'.') and
(extractfileext(p.name)='.tex') then lesen(s+p.name);
end;
r:=findnext(p);
end;
findclose(p);
end;
{Header-Datei kopieren}
procedure dateikopie;
var lesen:string;
var quelle,ziel:text;
const quelldat='header.tex';
const zieldat='aufgabe.tex';
begin
assign(quelle,quelldat);
assign(ziel,zieldat);
reset(quelle);
rewrite(ziel);
while not eof(quelle) do begin
readln(quelle,lesen);
writeln(ziel,lesen);
end;
close(quelle);
close(ziel);
end;
{Hauptprogramm}
begin
clrscr;
if paramstr(1)<>'' then
begin
dateikopie;
writeln('> Header-Datei kopiert ...');
assign(a,n);
append(a);
suche('./','*.*');
writeln('> Suche im aktuellen Verzeichnis ...');
writeln('> Elemente werden in "aufgabe.tex" gespeichert...');
writeln(a,'\end{enumerate}');
writeln(a,'\end{document}');
close(a);
end
else writeln('> Kein Parameter angegeben!');
writeln('> Ende');
writeln;
end.
