Les Fichiers en pascal

Résolu/Fermé
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. 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. 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. 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. @mohamedsalut 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. 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. @Mehdisalut 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. 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
    -1
    1. 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
      -1
      1. 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
        1. 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
          1. coment utiliser la fonction seek et qu'est qu'elle prend en parametre
            0
            1. 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
              1. 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
                1. 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. 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
                2. 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. 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. comment creer un fichier
                    0
                  3. Modérateur
                    @140856Tu 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
                  4. Modérateur
                    @140856Remarque, 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
                3. 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
                  1. 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
                    1. salut ts le monde
                      voila je vx ecrire un programme pascal qui transforme le montant en chiffre d'une facture en lettres...
                      merci
                      0
                      1. 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
                        1. 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
                          1. 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
                            1. voici un site mes amis pour le 4si de la tunisie www.4si.xooit.fr
                              3
                              1. 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
                                1. procedure de suppression d'un element dans un fichier. merci d'avance
                                  3
                                  1. Modérateur
                                    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
                                • 1
                                • 2