PROTOTYPE DE DC1 PRATIQUE

Pourquoi vous ne donnez pas les propositions de solutions ? Est-ce que ce type de devoir est difficile ?

Mon Essai :

program PROTOTYPE ;
uses wincrt;
var
t:text;

procedure creer(var t:text);
var
i:integer;
ch:string;
begin
rewrite(t);
for i:=1 to 4 do
begin
writeln('Donner la ligne N° ',i,' = ');
readln(ch);
writeln(t,ch);
end;
close(t);
end;

procedure remp(var t:text);
var
ch:array[1..4]of string;
n,i:integer;
begin
reset(t);
n:=0;
while not eof(t) do
begin
n:=n+1;
readln(t,ch[n]);
while pos('a',ch[n])<>0 do
ch[n] [pos('a',ch[n])]:='o';

end;
rewrite(t);
for i:=1 to n do
writeln(t,ch[i]);
close(t);
end;

procedure afficher(var t:text);
var
ch:string;
begin
reset(t);
while not eof(t) do
begin
readln(t,ch);
writeln(ch);
end;
close(t);
end;

begin
assign(t,'C:\BAC2009\DEVOIR.txt');
creer(t);
remp(t);
writeln ('********');
afficher(t);
end.

program
uses wincrt;
type

date=record
jj:1..31;
mm:1..12;
aa:word;
end;

fiche=file of date;
var
d:fiche;
dt:date;

procedure creation(var d:fiche);
var choix:char;
begin
rewrite(d);
repeat
with dt do
begin
write('Donner le jour (1..31) :');readln(jj);
write('Donner le mois (1..12) :');readln(mm);
write('Donner l''anné :');readln(aa);
end;
write(d,dt);
write('Autre date ? (N pour non) = ');
readln(choix);
until upcase(choix)='N';
close(d);
end;

procedure chercher(dt:date;var grand,petit:date);
begin
if dt.aa<petit.aa then
petit:=dt
else
if dt.aa=petit.aa then
if dt.mm<petit.mm then
petit:=dt
else
if dt.mm=petit.mm then
if dt.jj<petit.jj then
petit:=dt;
if dt.aa>grand.aa then
grand:=dt
else
if dt.aa=grand.aa then
if dt.mm>grand.mm then
petit:=dt
else
if dt.mm=grand.mm then
if dt.jj>grand.jj then
grand:=dt;
end;

procedure grandpetit(var d:fiche);
var
d1:fiche;
petit,grand:date;
begin
reset(d);
read(d,petit);
grand:=petit;
while not eof(d) do
begin
read(d,dt);
chercher(dt,grand,petit);
end;
close(d);
assign(d1,'c:\bac2009\d1');
rewrite(d1);
write(d1,grand);
write(d1,petit);
close(d1);
end;

procedure printemp(var d:fiche);
var
d2:fiche;
begin
assign(d2,'c:\bac2009\d2');
rewrite(d2);
reset(d);
while not eof(d) do
begin
read(d,dt);
if (dt.mm in[3..6])then
write(d2,dt);
end;
close(d);
close(d2);
end;

procedure afficher;
var
d1,d2:fiche;
begin
clrscr;
writeln;
assign(d,'c:\bac2009\d');
reset(d);
writeln('Les dates enregistrées sont :');
while not eof(d) do
begin
read(d,dt);
writeln(dt.jj,' : ',dt.mm,' : ',dt.aa);
end;
writeln;
assign(d1,'c:\bac2009\d1');
reset(d1);
writeln('La plus petite et la plus grande dates sont :');
while not eof(d1) do
begin
read(d1,dt);
writeln(dt.jj,' : ',dt.mm,' : ',dt.aa);
end;
writeln;
assign(d2,'c:\bac2009\d2');
reset(d2);
writeln('Les dates du printemps sont :');
while not eof(d2) do
begin
read(d2,dt);
writeln(dt.jj,' : ',dt.mm,' : ',dt.aa);
end;
end;

begin
assign(d,'c:\bac2009\d');
creation(d);
grandpetit(d);
printemp(d);
afficher;
end.

Salut, Rami. Bon travail Surtout, ch[n] [pos('a',ch[n])], c'est très fort.
Voici la correction avec l'utilsation du deuxième fichier T1, qui va être effacé à la fin du travail :
program SUJET1;
uses wincrt;
var t:text;
procedure remplir(var t:text);
var i:integer;
ch:string;
begin
rewrite(t);
for i:=1 to 4 do
begin
write('Donner la ligne N°',i,' ');
readln(ch);
writeln(t,ch);
end;
close(t);
end;
procedure remplace(var t:text);
var t1:text;
i:integer;
ch:string;
begin
reset(t);
assign(t1,'c:\BAC2009\nouveau.txt');
rewrite(t1);
while not eof(t) do
begin
readln(t,ch);
for i:=1 to length(ch) do
if ch[i]='a' then
ch[i]:='o';
writeln(t1,ch);
end;
reset(t1);
rewrite(t);
while not eof(t1) do
begin
readln(t1,ch);
writeln(t,ch);
end;
close(t);
close(t1);
erase(t1);
end;
procedure affiche(var t:text);
var ch:string;
begin
reset(t);
while not eof(t) do
begin
readln(t,ch);
writeln(ch);
end;
close(t);
end;
begin
assign(t,'c:\BAC2009\devoir.txt');
remplir(t);
remplace(t);
affiche(t);
end.
J'attends votre essai pour le deuxième exercice

Salut Ilyes ! Beinvenue chez nous. Excellent travail. Bonne continuation.