hg S’enregistrer Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie

Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie  forum informatique Tunisie Index du Forum

hg Bac Tunisie Algorithmique et programmation TIC réseaux php javascript sql access activités programmation c
hg
FAQ FAQ Rechercher Rechercher Membres Membres Groupes Groupes Profil Profil Se connecter pour vérifier ses messages privés Messages Privés Connexion Connexion


 Forum de l'excellence et l'excellence en innovation 
Pour participer à notre Forum, vous devez
 
inscrire sur notre forum a partir d'ici
 
  NB :
Les membres ''zéro messages'' seront supprimés automatiquement après un nombre de jours donné !!!!
             
   
 
  
forum d'aide informatique : internet, réseau, programmation informatique ...
program complet ne veut pas marcher
 
 
Poster un nouveau sujet   Répondre au sujet    Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie Index du Forum -> Algorithmique & programmation -> Aidez-moi
hg Sujet précédent :: Sujet suivant   hd
Auteur Message
A7M3D92
recent membre
recent membre

Hors ligne

Inscrit le: 20 Oct 2009
Messages: 39
Point(s): 49
Moyenne de points: 0

Posté le: Lun 23 Nov - 23:54 (2009)    Sujet du message: program complet ne veut pas marcher Répondre en citant

PublicitéSupprimer les publicités ?
SALéM
program app;
uses wincrt;
type
enfant = record
mat:integer;
nom:string[30];
age:integer;
adr:string[30];
end;
fichier = file of enfant;
var
en:enfant;
f,f2:fichier;
p,c:integer;


procedure creation(var f:fichier);
begin
{$i-}
assign(f,'c:\app.txt');
reset(f);
{$i+}
if (ioresult <> 0) then
writeln(' le fichier specifié n''existe pas');
end;


procedure remplir(var f:fichier);
var
rep:char;
begin
repeat
with en do
begin
repeat
writeln('donner le matricule de l''enfant');
readln(mat);
until (mat<=9999) and (mat>=1000);
writeln('donner le nom de l''enfant');
readln(nom);
repeat
writeln('donner l''age de l''enfant');
readln(age);
until (age<=5) and (age>=3);
writeln('donner l''adresse de l''enfant');
readln(adr);
end;
write(f,en);
repeat
writeln('autre enfant? O/N');
rep:=readkey;
until upcase(rep) in ['O','N'];
until upcase(rep) = 'N';
end;


procedure menu;
begin
clrscr;
gotoxy(10,5);
write('1:creation de fichier d''enfant');
gotoxy(10,6);
write('2:remplir le fichier d''enfant');
gotoxy(10,7);
write('3:modifier un enfant à une position donnee');
gotoxy(10,8);
write('4:supprimer un enfant en fonction de sa matricule');
gotoxy(10,9);
write('5:ajouter un enfant à une position donnee');
gotoxy(10,10);
write('6:transferer les enfants d''un agedonne dans un deuxieme fichier');
gotoxy(10,11);
write('7:chercher les enfants de matricule paire');
gotoxy(10,12);
write('8:sortie');
gotoxy(20,20);
write('donner votre choix');
end;


procedure modifier(var f:fichier);
var
rep:char;
begin
repeat
writeln('donner une position d''un enfant pour le modifier');
readln(p);
until p in [0..filesize(f)-1];
seek(f,p);
repeat
with en do
begin
repeat
writeln('donner le matricule de l''enfant');
readln(mat);
until (mat<=9999) and (mat>=1000);
writeln('donner le nom de l''enfant');
readln(nom);
repeat
writeln('donner l''age de l''enfant');
readln(age);
until (age<=5) and (age>=3);
writeln('donner l''adresse de l''enfant');
readln(adr);
end;
write(f,en);
repeat
writeln('autre enfant? O/N');
rep:=readkey;
until (upcase(rep) in ['O','N']) ;
until upcase(rep) = 'N';
end;


procedure supprimer(var f:fichier);
var
mat2,i:integer;
b:boolean;
begin
repeat
writeln('donner le matricule de l''enfant');
readln(mat2);
until (mat2<=9999) and (mat2>=1000);
reset(f);
b:=false;
while (not(eof(f)) and b=false) do
begin
read(f,en);
if (en.mat = mat2) then
begin
b:=true;
p:=filepos(f)
end;
end;
if b=false then
begin
writeln('l''enfant du mattricule donné n''existe pas');
end
else
begin
if (p <> filesize(f)-1) then
begin
for i:=p-1 to (filesize(f)-2) do
begin
seek(f,i+1);
read(f,en);
seek(f,i);
write(f,en)
end;
seek(f,filesize(f)-1);
truncate(f);
end
else
seek(f,filesize(f)-1);
truncate(f);
end;
end;


procedure ajouter(var f:fichier);
var
i:integer;
begin
repeat
writeln('donner une position d''un enfant pour le modifier');
readln(p);
until p in [0..filesize(f)];
if (p=filesize(f)) then
begin
seek(f,p);
with en do
begin
repeat
writeln('donner le matricule de l''enfant');
readln(mat);
until (mat<=9999) and (mat>=1000);
writeln('donner le nom de l''enfant');
readln(nom);
repeat
writeln('donner l''age de l''enfant');
readln(age);
until (age<=5) and (age>=3);
writeln('donner l''adresse de l''enfant');
readln(adr);
end;
write(f,en);
end
else
for i:=filesize(f) downto p+1 do
begin
seek(f,i-1);
read(f,en);
seek(f,i);
write(f,en);
end;
seek(f,p);
with en do
begin
repeat
writeln('donner le matricule de l''enfant');
readln(mat);
until (mat<=9999) and (mat>=1000);
writeln('donner le nom de l''enfant');
readln(nom);
repeat
writeln('donner l''age de l''enfant');
readln(age);
until (age<=5) and (age>=3);
writeln('donner l''adresse de l''enfant');
readln(adr);
end;
write(f,en);
end;


procedure transfert(var f,f2:fichier);
var
age2:integer;
begin
repeat
writeln('donner l''age de l''enfant à trasnferer');
readln(age2);
until (age2<=5) and (age2>=3);
{$i-}
assign(f2,'c:\app.txt');
reset(f2);
{$i+}
if (ioresult <> 0) then
writeln(' le fichier specifié n''existe pas');
while (not(eof(f))) do
begin
read(f,en);
if (en.age=age2) then
write(f2,en);
end;
end;


function paire(x:integer):boolean;
begin
if x=0 then
paire:=true
else
if x=1 then
paire:=false
else
paire:=paire(x-2);
end;


procedure chercher(var f:fichier);
begin
reset(f);
while (not(eof(f))) do
begin
read(f,en);
if (paire(en.mat)=true) then
begin
with en do
begin
writeln('matricule= ',mat,'/ nom= ',nom,' / age= ',age,' / adresse= ',adr);
end;
end;
end;




{*PP*}
begin
menu;
repeat
repeat
gotoxy(20,21);
read(c);
until c in [1..8];
   case c of
1:begin
creation(f);
menu;
end;
2:begin
remplir(f);
menu;
end;
3:begin
modifier(f);
menu;
end;
4:begin
supprimer(f);
menu;
end;
5:begin
ajouter(f);
menu;
end;
6:begin
transfert(f,f2);
menu;
end;
7:begin
chercher(f);
menu;
end;
8:exit;
end;
until (c in [1..8]);
end.




telecharger le ici


aider moi à le faire marcher
j'ai un devoire pratique demain


 
Revenir en haut
A7M3D92
recent membre
recent membre

Hors ligne

Inscrit le: 20 Oct 2009
Messages: 39
Point(s): 49
Moyenne de points: 0

Posté le: Mar 24 Nov - 22:50 (2009)    Sujet du message: program complet ne veut pas marcher Répondre en citant

j'ai trouver la solution Smile
il manque END; à la fin du procedure chercher


 
Revenir en haut
Contenu Sponsorisé






Posté le: Aujourd’hui à 14:39 (2016)    Sujet du message: program complet ne veut pas marcher

 
Revenir en haut
Montrer les messages depuis:   
bg bd
Poster un nouveau sujet   Répondre au sujet    Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie Index du Forum -> Algorithmique & programmation -> Aidez-moi Toutes les heures sont au format GMT + 1 Heure
 
Page 1 sur 1

 
Sauter vers:  
Index | créer forum gratuit | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation