Les Fichiers en pascal

Résolu/Fermé
smail -  
 et merci beaucoup -
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

25 réponses

  • 1
  • 2
  1. mehdi
     
    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.
    25
    1. mohamed
       
      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.
      0
    2. Smail
       
      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 !
      0
    3. Smail > mohamed
       
      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.
      0
    4. Mehdi
       
      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.
      0
    5. Smail > Mehdi
       
      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
      0
  2. ahmed002007
     
    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.
    3
  3. ahmed.scof Messages postés 4 Statut Membre
     
    voici un site mes amis pour le 4si de la tunisie www.4si.xooit.fr
    3
  4. delia
     
    procedure de suppression d'un element dans un fichier. merci d'avance
    3
    1. KX Messages postés 19031 Statut Modérateur 3 020
       
      Si l'ordre n'est pas important, ceci devrait suffire :
      type elem=byte; // par exemple
     fichier=file of elem;

procedure supprimer(var f:fichier;e:elem);
var i:longint;
    x:elem;
begin
seek(f,1);
i:=0;
while not eof(f) do
      begin
      read(f,x);
      if x=e then begin
                  i:=filepos(f)-1;
                  break;
                  end;
      end;
if i=0 then writeln('element introuvable')
       else begin
            seek(f,filesize(f)-1);
            read(f,x);
            seek(f,i);
            write(f,x);
            seek(f,filesize(f)-1);
            truncate(f);
            writeln('element supprime a la position ',i);
            end;
end;
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. les Fichiers en pascal
     
    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
    2
  7. marwa
     
    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
    2
  9. Ayoub
     
    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!!!
    1
  10. quentinfaletti Messages postés 6 Statut Membre 3
     
    voila j'ai une grosse colle pour tout les mordus de programmation !!! je suis en première année d'IUT et je ne comprends strictement rien à ces exercices. Je tiens à préciser que je ne suis ni feignant ni bête, mais je ne comprends vraiment pas grand chose en programmation, donc si des personnes pourraient m'aider sa serait vraiment cool car je n'ai plus de programmation de l'année mais la note compte énormément pour mes partiels. Voici les exercices :

    Ex1 (1 pt): Ecrire un programme en Pascal pour demander à l'utilisateur de saisir son
    nom et prénom ainsi que son sexe (M pour homme et F pour femme) et puis afficher à
    l'écran le message : « Bonjour Monsieur Nom Prénom » si c'est un homme ou
    « Bonjour Madame/Mademoiselle Nom Prénom » si c'est une femme (1pts).
    Indice : utiliser la structure if then else

    Ex2 (2 pts): Construire et tester un programme éditant à l'écran les valeurs de la
    fonction G telle que G(x) = exp(-x*x/2)/sqrt(2 * PI) pour x variant de -2.5 à 2.5 par
    pas de 0.2.
    Indice : On créera la fonction Pascal
    function G(X:real) : real ;
    begin
    G := {à compléter} ;
    end ;
    {PI est la constant =3.14}

    Ex3 (2 pts): Ecrire un programme en Pascal pour trouver l'élément le plus maximum
    et minimum dans un tableau dont la taille et la valeur de chaque élément doivent être
    saisies au clavier.

    Ex4 (3 pts): Tri par sélection: perm(x,y) est une procédure échangeant les contenus des
    mémoires x et y ; On considère l'algorithme de tri croissant des n éléments d'un
    tableau a:
    Pour i=1 à n-1 faire
    Pour j=i +1 à n faire
    Si a[i] > a[j] alors faire perm(a[i],a[j]) finSi
    FinPour
    FinPour
    Construire des modules (procedures ou functions) de
    a/ Permutation des contenus de 2 mémoires de type REAL (0.5 pt).
    b/ Tri croissant par selection des éléments de type REAL d'un tableau de N
    éléments saisis au clavier (comme l'exercice 3) (1.5 pts).
    c/ Construire un programme principal qui teste la procédure de tri. Modifier les
    modules et le programme principal afin qu'il trie une liste de noms par ordre
    alphabétique (1 pt).

    Merci à tous, vraiment.
    1
    1. KX Messages postés 19031 Statut Modérateur 3 020
       
      Voici de quoi comprendre : le cours de Pascal que je conseille à chaque fois ;-)
      Si tu n'es "ni feignant ni bête", tu trouveras rapidement les réponses tout seul
      En effet, ta "grosse colle pour tout les mordus de programmation" c'est de la blague !
      0
    2. quentinfaletti Messages postés 6 Statut Membre 3
       
      pfiou tu as de la " chance " de comprendre moi je ne pige rien! merci pour le cours je vais voir ça de suite !
      0
  11. patricia
     
    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.
    0
  12. hermann
     
    coment utiliser la fonction seek et qu'est qu'elle prend en parametre
    0
  13. gammoudi
     
    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
    0
  14. mbhk
     
    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.
    0
    1. MIMOUTT Messages postés 1 Date d'inscription   Statut Membre
       
      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.
      0
  15. aziz_b
     
    salut, est ce que vous pouvez m'envoyer des exercices sur les enregistrement et les fichiers par mail, cordialement
    abdelaziz.boussida@yahoo.fr
    0
    1. pachaa
       
      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.
      0
    2. 140856
       
      comment creer un fichier
      0
      1. KX Messages postés 19031 Statut Modérateur 3 020 > 140856
         
        Tu as deux types de fichiers : texte ou binaire
        Dans le premier tu écris du texte comme sur l'écran, le deuxième tu écris des valeurs de n'importe quel type.

        1. Tu définis le type du fichier
        var t:text; // fichier texte
        var f:file of integer; // fichier binaire contenant des entiers

        2. Tu attribues un chemin d'accès à ton fichier
        assign(t,'C:\Test\Mon fichier texte.txt'); // en chemin absolu
        assign(f,'Mon fichier binaire.bin'); // en chemin relatif

        Remarque : on peut faire des chemins absolus ou relatifs pour les deux types de fichiers, et l'extension du fichier n'a aucune importance.

        3. Tu créés le fichier
        rewrite(t);
        rewrite(f);

        éventuellement pour les fichiers textes, tu peux écrire à la fin du fichier s'il existe déjà :
        append(t);

        4. Tu écris dans le fichier
        a) fichier texte :
        writeln(t,'Ceci est la première ligne de mon fichier texte.');
        writeln(t,'Et voici la deuxième !');
        s:='Et enfin la troisième...'; // var s:string;
        writeln(t,s);

        b) fichier binaire : (ici on a pris un fichier d'entier)
        write(f,15);
        write(f,-64);
        n:=5; // var n:integer;
        write(f,n);
        0
      2. KX Messages postés 19031 Statut Modérateur 3 020 > 140856
         
        Remarque, il ne faut pas oublier de fermer le fichier avant la fin du programme sinon certaines données pourrait ne pas être écrite dans le fichier.

        close(t);
        close(f);
        0
  16. gammoudi
     
    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!!!!
    0
  17. shipirou Messages postés 7 Statut Membre
     
    salut ts le monde
    voila je vx ecrire un programme pascal qui transforme le montant en chiffre d'une facture en lettres...
    merci
    0
  18. trapnest
     
    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)
    0
  19. red-miha
     
    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.
    0
  20. israel
     
    slt,
    vaila j ai projet sur le quel j ai du mal a avancer au fait il s agit de creer un fichier sequentiel en pascal:
    1 creation d un fichier
    2 eture sequentiel d unfichier
    3 suppression d enregistrement
    4 insertion d enregidtrement a la fin d un fichier
    5 affichage sur ecran ou impresssion des enregistrements d un fichiers
    merci d avance
    0
  21. adriannaa
     
    slt tout le monde,j'ai besoin de quelques exemples des tris appliqués sur des fichiers en pascal,j'attends vos reponses,et merci d'avance..
    0
  • 1
  • 2