rss
Rechercher : dans
Par : Pertinence Date Nom d'utilisateur
Statut : Non résolu

Les Fichiers en pascal

Posté par smail, le mardi 4 mai 2004 à 20:20:37
en fait..j'ai besoin de qq petit examples de codes expliquant
l'organisation séquentielle des fichiers en pascal ainsi que les différentes Méthodes d'accès( seq, directe et indexée ) pour cette meme organisation..
Toute réponse sera bien appréciée..merci
Répondre à smail  Signaler ce message aux modérateurs Aller au dernier message

1


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
mohamed, le mercredi 5 mai 2004 à 16:36:26
salut,
voici où vous pouriez regarder
http://158.64.21.3/materials/pascal/tabmat.html#CHAP17

http://www.al.lu/materials/pascal/chaps/chap17/chap1705.htm
regarde aussi sur google
organisation des fichiers en pascal.
bon courage.
Merci
Répondre à mohamed

2


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
mehdi, le vendredi 11 juin 2004 à 15:36:31
Voici un exp pour mieux comprendre
de rien d'avance

(****************************************************)
program classe;
uses crt;
type
enreg = record
nom:string[10];
prenom:string[10];
classe:string[10];
note:real;
end;
fichier = file of enreg;
var
f : fichier;
bufer,buf1,buf2 : enreg;

(***********************************************************­**)
Procedure lire(var x:fichier;y : enreg);
var arret : boolean;
begin
arret:=false;
rewrite(x);
repeat
clrscr;
with y do
begin

write('Nom :');readln(nom);
if length(nom)=0 then arret:=true
else
begin
write('Prenom :');readln(prenom);
write('Classe :');readln(classe);
write('Note :');readln(note);
write(x,y)
end;

end;
until arret=true;
end;
(***********************************************************­**)
Procedure permute(var x,y:enreg);
var temp:enreg;
begin
temp:=x;
x:=y;
y:=temp;
end;
(***********************************************************­**)
Procedure trie(var buf1,buf2:enreg);
var permutation:boolean;
i:Integer;
begin
reset(f);
seek(f,0);
repeat
permutation:=False;
for i:= 0 to filesize(f)-2 do

begin
seek(f,i);
read(f,buf1);
read(f,buf2);
if buf1.note < buf2.note then
begin
seek(f,i);
Write(f,buf2);
Write(f,buf1);
permutation:=true;
end;
end;
until not permutation;
end;
(***********************************************************­**)
Procedure consult(var x:fichier; y:enreg);
var i:integer;
begin
reset(x);
writeln ('nom':20,'note':20);
while not eof(x) do
begin
with y do

begin
read(x,y);
writeln (nom:20,note:20:2);
end;
end;
end;
BEGIN
assign(f,'c:\classe.dat');
clrscr;

lire(f,bufer);

trie(buf1,buf2);
writeln('trie ok !');
consult(f,bufer);
readln;
END.
Répondre à mehdi

3


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
mohamed, le vendredi 11 juin 2004 à 19:58:53
Salut mehdi,
je crois que vous avez un pblème dans la proc trie.
pour les autres très très bien.
bonne chance.
Merci.
Répondre à mohamed

5


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
Smail, le dimanche 13 juin 2004 à 15:45:41
salut mohamed ! comment cava ? e pense que t'a raison..la proc trier est erroné, mais je voulait surtt des codes expliquant les fichiers seq indexées ( tu sait la clés primaire, les clés sec etc )
merci.
Répondre à Smail

4


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
Smail, le dimanche 13 juin 2004 à 15:41:47
salut Mehdi !
en fait ton code je l'ai trés bien compris..je voulais surtout qq codes sur ce qui est des fichiers seq ind ( cles primaires, sec etc..)
merci comme meme !
Répondre à Smail

6


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
Mehdi, le mardi 15 juin 2004 à 17:00:00
bein pour acceder sequencielement à un fichier c-à-d d'un enregistrement à un autre il sufit d'une simple boucle !

Program Hello_world;
Types
Enreg = Record
Nom : String[10];
Prenom : String[10];
End;
Var
Fichier : file of enreg;
Bufer : Enreg;
Begin

Assign(Fichier,'c:\Fichier.dat')

Reset(fichier);{ouvrir en mode utilisation + initialise pointeur à 0 }

Read(fichier,bufer){variable déclarée du meme type que l'enregistrement utillisé}

Writeln('Nom','Prenom');
For i:=0 to filesize(fichier)-1 do {N.B : fichier commence de 0 pas de 1}
BEGIN
With bufer do
Begin
Seek(fichier,i)
Writeln(Nom:20,Prenom:20);
End;
END;
ENd.
Répondre à Mehdi

7


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
Smail, le mercredi 16 juin 2004 à 03:33:31
salut Mehdi !
j'ai compris ton exp sauf que je veut qq chose de + avancé tu me comprends sur les fichiers seq indexées plutot

merci
Répondre à Smail

8


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
MOHAMED, le jeudi 17 juin 2004 à 16:05:45
Salut SMAIL,
notre frère mehdi a bien présenté son pg, seulement pour plus de présition il (on) doit ajouter à son enreg un champ comme identifiant de l'enreg( dans la destion des BDD on l'appele CLE PRIMAIRE), dans l'expl de notre frère mehdi s'il y a deux pour ne pas dire 3 ou + de personnes qui ont le même NOM ou le même prenom ou les 2 ensembles et on vous demande de donner par expl les info concernant mehdi alors de quel mehdi sagit -il.
mais si vous avez un numéro pour chaque personne là si on vous demande les infos de la pers N°1 vous l'aurez sans pblèmes.
j'espère que vous m'avez compris, à+.
bonne chance.
Merci
Répondre à MOHAMED

9


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
Smail, le jeudi 17 juin 2004 à 19:18:07
salu Mohammed !
et ben je vous ai compris mais reste qq confusions que je fait tjs..en fait j'ai vu l@ que tu m'a envoyé elle est tres interessante et j'ai pour vrai compris beaucoup sauf que je voudrait que tu m'explique ces qq phrases stp
- parlant de l'organisation indéxée: "Dans cette organisation, chaque enregistrement est identifié par une clé et à chaque clé est associée un numéro d'enregistrement qui renvoie à l'enregistrement correspondant." tu sait le prob c que dans notre cours d'université on ai allé un peu loin avec les fichiers séquentiels et le site que tu m'a conseillé a savoir "http://www.al.lu/materials/pascal" ne detaille pas les fichiers sequentiels.
un dernier point mohammed est ce que dire "ceci est 1 fichier seq indexée" est la meme chose que dire "ceci est 1 fichier seq à accès indéxée"
merci encore une fois Mohammed
Répondre à Smail

10


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
Ayoub, le vendredi 4 mai 2007 à 01:32:12
pour l'exempple de mehdi moi g un tp ou on me demande de trier le fichier sans utiliser l'acces direct (seek) avec un acces sequentiel (while not eof()), et ca me prend la tete!!!!
un fichier de phrases par ordre decroissant!
aidez moi si vous le pouvez!!!
Répondre à Ayoub

11


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
patricia, le dimanche 8 juillet 2007 à 12:44:32
bonjour, je m'appelle patricia, j'ai un projet sur lequel je n'arrive pas à avancer, c'est la gestion d'un train.
reservation d'une place, confirmation ou annulation de la réservation, consultation du train(nbre de places libres de chaque caractéristiques. le train à n wagons, chaque wagons à 12 compartiments, chaque compartiments à 6places.
Répondre à patricia

12


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
hermann, le samedi 1 septembre 2007 à 17:40:38
coment utiliser la fonction seek et qu'est qu'elle prend en parametre
Configuration: Windows XP
Internet Explorer 6.0
Répondre à hermann

13


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
les Fichiers en pascal, le samedi 6 octobre 2007 à 16:56:52
Bonjour, la fonction seek permet d'accéder à un élément d'un fichier.
elle a deux paramètres
seek(nom_logique du fichier,num d'ordre du fichier auquel on veut accéder).
Ce num vaut 0 pour le 1er élément
Répondre à les Fichiers en pascal

14


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
gammoudi, le mardi 9 octobre 2007 à 22:58:53
Je voix bien que la chose n'est pas claire pour le Mode D'accès.
On deux modes d'accès: direct et indirecte (séquentiel).
1- le mode ne dépend du type de fichier mais plutôt il dépend surtout de l'environnement de stockage.
Dans un accès séquentiel on ne peut pas accéder à un niveau d'un fichier qu'après avoir parcourir les éléments suivant et c'est clair qu'avec ce mode d'accès on ne peut pas utiliser l’instruction SEEK car c'est le synonyme d'accès direct, dans un exemple ci-dessus on parle d'un fichier à accès séquentiel et on a utilisé la commande SEEK (ce qui est contradictoire).
pour celui qui veut trier le contenu d'un fichier à accès séquentiel , il n'a qu'a copier le contenu vers un tableau de même type, le trier puis avec la commande REWRITE on ouvre le fichier pour récrire de nouveau le contenu qui est déjà trié.
Bonne chance
Répondre à gammoudi

15


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
mbhk, le mardi 23 octobre 2007 à 13:27:23
program application_ficher;
uses wincrt;

type
chaine=string[15];

info=record
nom:chaine;
note:real;
end;

fichier=file of info;

var
fnote:fichier;
v:info;
c:char;
p:integer;

{_________________________________}

procedure ouvrir(var f:fichier);
var
ok:boolean;
begin
{$i-}reset(f);{$i+}

ok:=ioresult=0;

if not ok then
begin
writeln('le fichier n''existe pas création en cours...');
rewrite(f);
end;
end;

{_________________________________}

procedure ajout(var f:fichier);
var
v:info;
c:char;
begin


seek(f,filesize(f));

repeat
write('nom : ');
readln(v.nom);

write('note: ');
readln(v.note);

write(f,v);

writeln('voulez vous ajouter un autre enregistrement ... O / N : ');
c:=readkey;

until upcase(c)='N';

end;

{_________________________________}

procedure ecrire;
begin

writeln('___________________________');
writeln(' n° nom note ');
writeln('___________________________');

end;

{_________________________________}

procedure affiche(var f:fichier);
var
v:info;
begin

ecrire;

reset(f);

while not eof(f) do
begin
read(f,v);
writeln(filepos(f)-1:3,v.nom:10,v.note:10:2);
end;

writeln('___________________________');


end;

{_________________________________}

procedure element(var f:fichier;var p:integer);

begin

repeat
write('position de l''element : ');
readln(p);
until p in [0..filepos(f)-1];

end;

{_________________________________}

procedure modifier(var f:fichier; p:integer);
var
v:info;
begin

element(f,p);
write('nom : ');
readln(v.nom);

write('note: ');
readln(v.note);

seek(f,p);

write(f,v);

end;

{_________________________________}

function recherche(var f:fichier;n:chaine):integer;
var
v:info;
i:integer;
begin
reset(f);

i:=-1;

repeat
read(f,v);
until (eof(f)) or (v.nom=n);

if v.nom=n then
i:=filepos(f)-1;

recherche:=i;
end;

{_________________________________}

procedure modifier2(var f:fichier);
var
v:info;
n:chaine;
p:integer;
begin
write('donner le nom à modifier : ');
readln(n);

p:=recherche(f,n);

if p=-1 then
writeln('le nom n''existe pas...')
else
begin
write('nom : ');
readln(v.nom);

write('note: ');
readln(v.note);

seek(f,p);

write(f,v);
end;
end;

{_________________________________}

procedure efface_audela(var f:fichier);
var
v:info;
p:integer;
begin
element(f,p);
seek(f,p);
truncate(f);
end;

{_________________________________}

procedure supprime(var f:fichier);
var
v:info;
p,i:integer;
fox:fichier;
begin
assign(fox,'c:\tpmbhk\fox.txt');
rewrite(fox);

element(f,p);


reset(f);
for i:=0 to p-1 do
begin
read(f,v);
write(fox,v);
end;

seek(f,p+1);
for i:=P+1 to filesize(f)-1 do
begin
read(f,v);
write(fox,v);
end;

close(fox);
close(f);
erase(f);
rename(fox,'c:\tpmbhk\blocnote.txt');
end;

{_________________________________}

procedure menu;
var
choix,n:integer;
c:char;

begin


writeln(' ________________menu_____________');
writeln(' | |');
writeln(' |new 0 |');
writeln(' |ajout 1 |');
writeln(' |modification par num° 2 |');
writeln(' |modification par nom 3 |');
writeln(' |efface_audela 4 |');
writeln(' |supprime un element 5 |');
writeln(' |affichage 6 |');
writeln(' | |');
writeln(' _________________________________');
writeln('');
repeat
writeln('entrez votre choix : 0/1/2/3/4/5/6 :');
readln(choix);
until choix in [0..6];

clrscr;
case choix of
0:begin

writeln('ajout de nouvelle(s) valeur(s) dans un fichier vide');
ecrire;
rewrite(fnote);
ajout(fnote);
clrscr;
affiche(fnote);

end;

1:begin
writeln('ajout de nouvelle(s) valeur(s) dans le meme fichier');

affiche(fnote);
ajout(fnote);
clrscr;
affiche(fnote);

end;


2:begin

writeln('modification d''un enregistrement par num°...');
affiche(fnote);
modifier(fnote,p);
affiche(fnote);
end;

3:begin

writeln('modification d''un enregistrement par nom...');
affiche(fnote);
modifier2(fnote);
affiche(fnote);
end;

4:begin

writeln('suppression des enregistrements au-delà d''un num°...');
affiche(fnote);
efface_audela(fnote);
affiche(fnote);
end;

5:begin
writeln('suppression d''un enregistrements à partir de son num°...');
affiche(fnote);
supprime(fnote);
affiche(fnote);
end;

6:begin
clrscr;
affiche(fnote);

end;
end;
end;










{_________________________________}

begin
assign(fnote,'c:\tpmbhk\blocnote.txt');

ouvrir(fnote);

repeat
clrscr;
menu;
writeln('~~~~~~~~~~~~~~~~~~~~~~~~~');
writeln('voulez vous quitter o/n : ');
writeln('');
writeln('~~~~~~~~~~~~~~~~~~~~~~~~~');
c:=readkey;

until upcase(c)='O';



close(fnote);


end.
Répondre à mbhk

19


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
MIMOUTT, le mercredi 28 novembre 2007 à 08:36:01
Bonjour mbhk,

Priére m'envoyer l'enoncé du probleme dont vous avez donner la solution le 23 octobre 2007 à 13 h 27 et qui concerne les fichiers en pascal.

Merci d'avance.
Répondre à MIMOUTT

16


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
aziz_b, le mardi 23 octobre 2007 à 15:37:12
salut, est ce que vous pouvez m'envoyer des exercices sur les enregistrement et les fichiers par mail, cordialement
abdelaziz.boussida@yahoo.fr
Répondre à aziz_b

23


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
pachaa, le mercredi 23 avril 2008 à 13:58:51
program classe;
uses crt;
type
enreg = record
nom:string[10];
prenom:string[10];
classe:string[10];
note:real;
end;
fichier = file of enreg;
var
f : fichier;
bufer,buf1,buf2 : enreg;

(***********************************************************­**)
Procedure lire(var x:fichier;y : enreg);
var arret : boolean;
begin
arret:=false;
rewrite(x);
repeat
clrscr;
with y do
begin

write('Nom :');readln(nom);
if length(nom)=0 then arret:=true
else
begin
write('Prenom :');readln(prenom);
write('Classe :');readln(classe);
write('Note :');readln(note);
write(x,y)
end;

end;
until arret=true;
end;
(***********************************************************­**)
Procedure permute(var x,y:enreg);
var temp:enreg;
begin
temp:=x;
x:=y;
y:=temp;
end;
(***********************************************************­**)
Procedure trie(var buf1,buf2:enreg);
var permutation:boolean;
i:Integer;
begin
reset(f);
seek(f,0);
repeat
permutation:=False;
for i:= 0 to filesize(f)-2 do

begin
seek(f,i);
read(f,buf1);
read(f,buf2);
if buf1.note < buf2.note then
begin
seek(f,i);
Write(f,buf2);
Write(f,buf1);
permutation:=true;
end;
end;
until not permutation;
end;
(***********************************************************­**)
Procedure consult(var x:fichier; y:enreg);
var i:integer;
begin
reset(x);
writeln ('nom':20,'note':20);
while not eof(x) do
begin
with y do

begin
read(x,y);
writeln (nom:20,note:20:2);
end;
end;
end;
BEGIN
assign(f,'c:\classe.dat');
clrscr;

lire(f,bufer);

trie(buf1,buf2);
writeln('trie ok !');
consult(f,bufer);
readln;
END.
Répondre à pachaa

17


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
marwa, le mercredi 31 octobre 2007 à 18:56:26
j ve qq dui me aide pour bien comprendre la prhrammation merci
et aussi ... j ve savoir un site qui m'aide a faire des execices
Répondre à marwa

18


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
gammoudi, le mercredi 31 octobre 2007 à 22:04:20
Bonjour,
je ai rien compris de cette demand
ve qq dui me aide pour bien comprendre la prhrammation merci
et aussi ... j ve savoir un site qui m'aide a faire des execices

je me demande si c'est du serieux!!!!
Répondre à gammoudi

20


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
shipirou, le samedi 1 décembre 2007 à 21:46:05
salut ts le monde
voila je vx ecrire un programme pascal qui transforme le montant en chiffre d'une facture en lettres...
merci
Répondre à shipirou

21


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
ahmed002007, le lundi 3 décembre 2007 à 19:35:09
program ahmed;
uses wincrt;
type
reel=file of real;
var
note,mention,note_sup:reel;
(***********************************************)
procedure creation(var note,mention:reel);
begin
assign(note,'C:\notes.FCH');
assign(mention,'C:\mentions.FCH');
{$I-}
reset(note);
if ioresult<>0 then rewrite(note);
reset(mention);
if ioresult<>0 then rewrite(mention);
{$I+}
end;
(************************************************)
procedure saisie(var note:reel);
var
v:real;
begin
reset(note);
repeat
repeat
write('donner une note entre 0 et 20:');readln(v);
until v<=20;
writeln;
if (v>=0) then write(note,v);
until (v<0) ;
end;
(*************************************************)
procedure remplir(var note,mention:reel);
var
v:real;
begin
reset(note);
reset(mention);
while not(eof(note)) do
begin
read(note,v);
if v>=14 then write(mention,v);
end;
close(note);
close(mention);
end;
(****************************************************)
procedure tronquage(var note,note_sup:reel);
var
v:real;
p:integer;
begin
reset(note);
p:=filesize(note);
if p>=10 then
begin
assign(note_sup,'C:\note_suppl.FCH');
rewrite(note_sup);
seek(note,p div 2);
while not(eof(note)) do
begin
read(note,v);
write(note_sup,v);
end;
seek(note,p div 2);
truncate(note);
close(note_sup);
end;
close(note);
end;
(****************************************************)
procedure affiche(var mention:reel);
var
v:real;
t:integer;
begin
reset(mention);
clrscr;
t:=filesize(mention);
if t=0 then writeln('il n''y a pas de mention')
else
begin
writeln('il y a ',t,' eleves et les notes sont :');
while not(eof(mention)) do
begin
read(mention,v);
write(' ',v:2:2);
end;
end;
close(mention);
end;
(****************************************************)
(** Programme Principal **)
begin
creation(note,mention);
saisie(note);
remplir(note,mention);
tronquage( note,note_sup);
affiche(mention);
readln;
affiche(note);
readln;
if filesize(note_sup)<>0 then
begin
affiche(note_sup);
end
else
begin
writeln('pas de note sup');
end;
end.
Répondre à ahmed002007

22


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
trapnest, le lundi 21 avril 2008 à 20:59:01
comment réaliser un programme pascal qui permet d'établir la facture détaillée de plusieurs produits (désignation, quantité, prix unitaire n TVA%) le programme doit sortir les détails par produit acheté;ainsi que le total HT( hors taxes) et le totalc (toutes taxes comprises)
Répondre à trapnest

24


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
red-miha, le jeudi 24 avril 2008 à 15:33:01
voici un ti exp pr les fichiers en pascal pr un parking des voitures
program parking;
LABEL a,b,d;
const n=60;



type voiture = record
mat:string[10];
typ,cst:string[15];
crb,col:string[10];
suiv,n_p,n_r:integer;
option:string;
end;

table=array[1..n]of voiture;

var t : table;
m,k : char;
i,y,j :integer;
cle : string[10];

(******** hachage*****)
function h(cle:string):integer ;
var c,a:integer;
BEGIN
y:= 0;
for i :=1 to 9 do
begin
val(cle[i],c,a);
y:= c*i + y;
end;
h:=y mod 50;
END;
(****initialisation*****)
procedure init;
var i:integer ;
BEGIN
for i:= 1 to n do
begin
t[i].mat:='';
t[i].suiv:=-1;
end
END;
(*****insertion****)
procedure ins;
BEGIN
j:=1;
while(j=1) do
begin
k:= 'o';
while k='o' do
Begin
write('le matricule : ');
readln(cle);
if not(len(cle)) then writeln('Erreur')
else k:= 'n';
End;
y := h(cle) + 1;
if t[y].mat ='' then
begin
t[y].mat := cle ;
t[y].suiv := -1;
j:=0;
end else
begin
if (compr(t[y].mat,cle)=1) then
begin
writeln('Ce matricule existe deja !');
end else
begin
i:=51;
while (t[i].mat <> '') and (i<=60) do i := i +1;
if i > 60 then
begin
writeln ('espace des collisions insufisant');
j:=0;
end else
begin
t[i].mat := cle;
t[i].suiv := t[y].suiv;
t[y].suiv := i;
j:=0;
y:=i;
end;
end;
end;
end;
if (j=0) and (i<=60) then
begin
with t[y] do
begin
write('Le constructeur : '); readln(cst);
write('Le type : '); readln(typ);
write('Le couleur : '); readln(col);
write('Nomnre de places : '); readln(n_p);
write('Nombre portes : '); readln(n_r);
write('Carburant : '); readln(crb);
writeln('Les options : '); readln(option);
end;
end;


END;
(*****affichage*****)
procedure aff;
Begin
for i:= 1 to 60 do
begin
if t[i].mat<>'' then
begin
with t[i] do
begin
writeln('-------------------------');
writeln('Le matricule : ',mat);
writeln('Le constructeur : ',cst);
writeln('Le type : ',typ);
writeln('Le couleur : ',col);
writeln('Nomnre de places : ',n_p);
writeln('Nombre portes : ',n_r);
writeln('Carburant : ',crb);
writeln('Les options : ',option);
writeln('-------------------------');
end;
end;
end;
End;
(*****recherche****)
procedure recherche;
var nbr : integer;
BEGIN
j:=0;
nbr:=1;
write('Que vous voulez chercher?');
readln(cle);
y:= h(cle) + 1;
if t[y].mat='' then writeln('---1pas de resultat')
else
begin
while (compr(t[y].mat,cle)=0) and (t[y].suiv<>-1) do
begin
y:=t[y].suiv;
inc(nbr);
end;
if compr(t[y].mat,cle)=1 then
begin
with t[y] do
begin
writeln('---------------------------');
writeln('Le matricule : ',mat);
writeln('Le type : ',typ);
writeln('Le constucteur : ',cst);
writeln('Le couleur : ',col);
writeln('Nombres de places : ',n_p);
writeln('Nombres de portes : ',n_r);
writeln('Le carburant : ',crb);
writeln('Les options : ',option);
j:=1;
writeln('nombre d''acce au tableau : ',nbr);
writeln('---------------------------');
end;
end;


if (t[y].suiv=-1) and (j=0) then writeln('----3pas de resultat');
end;
END;
(*****spprimer****)
procedure supr;
var ins : boolean;
Begin
ins := false;
write('Donnez moi le matricule : '); readln(cle);
y := h(cle) +1;

if t[y].mat ='' then writeln('Erreur')
else
begin
while not(ins) do
begin
if (compr(t[y].mat,cle)=1)then
begin
if t[y].suiv<> -1 then
begin
i:=t[y].suiv;
with t[y] do
begin
mat:=t[i].mat;
cst:=t[i].cst;
typ:=t[i].typ;
col:=t[i].col;
n_p:=t[i].n_p;
n_r:=t[i].n_r;
crb:=t[i].crb;
option:=t[i].option;
suiv:=t[i].suiv;
ins := true;
t[i].mat:='';
t[i].suiv:=-1;
end;
end else
begin t[y].mat := ''; t[y].suiv:=-1; ins := true; end;
end else
begin
if t[y].suiv = -1 then writeln ('pas trouver!')
else y:= t[y].suiv;
end;
end;
end;
End;
(***** le programme****)

BEGIN

a : writeln(' Bien venue');
writeln('Ajouter 1');
writeln('Rechercher 2');
writeln('Suprimer 3');
writeln('Pourcentage 4');
writeln('Afficher 5');
writeln('Initialisation 6');
writeln('Quitter 7');
readln(m);
case m of
'1' :
begin k:= 'o';
while (k='o') do
begin
begin
ins;
d : writeln('voulez vous ajouter une autre voiture o/n? ');
readln(k);
if k='n' then
else begin
if k='o' then
else
begin
writeln ('erreur');
goto d;
end;
end;
end;
end;
end;
'2' : recherche;
'3' : supr ;
'5' : aff;
'6' : init;
'7' : exit;
else
begin
writeln('erreur');
goto a;
end;

end;
goto a;
END.
Répondre à red-miha

25


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs
ahmed.scof, le mercredi 21 mai 2008 à 21:39:34
voici un site mes amis pour le 4si de la tunisie www.4si.xooit.fr
Répondre à ahmed.scof

26


  • Ce message vous semble utile, votez !
  • Signaler ce message aux modérateurs