Go Windows Forum
PC Hilfe Forum => Programmierung und Scripting => Thema gestartet von: bagira am 12. Januar 2011, 18:09:10
-
Hallo,
Mein Enkel hatte ein Programm in Pascal geschrieben, das in Unterverzeichnissen und deren Dateien nach bestimmten vierstelligen Zahlencodes sucht und dann gezielte Abschnitte dieser Dateien in eine andere Datei kopiert.
Leider kopiert das Programm alles doppelt in die neue Datei. Wo liegt der Fehler und wieso doppelt?
-
Da müßte man den Source-Code des Programms sehen.
-
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. -
Das ist mir zu kompliziert. Erstens weil ich Pascal nicht kenne und zweitens weil der Code wirklich völlig unstrukturiert ist (keine Tabs etc.). Unlesbar. Und 135 Zeilen habe ich mir auch nicht vorgestellt...
-
Tja, wie gesagt, meine Enkel haben sich im Pascal irgend wie verheddert, jetzt brauche ich einen guten Rat.
-
Fehler gefunden
: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.