Utilisation fichiers creation lecture ecriture bulletin bts

Soyez le premier à donner votre avis sur cette source.

Vue 10 478 fois - Téléchargée 703 fois

Description

Alors voila, j'utilise la création, la lecture, l'écriture et la mise a jour d'un fichier. Il faut savoir que le fichier n'est pas un fichier texte ! les commandes sont différentes...

Le programme a pour but de créer des fiches élèves (des enregistrements) en leur mettant des notes afin de pouvoir simulé un bulletin de fin de trimestre. Les fonctions sont les suivantes : recherche dans le fichier, mise a jour, edition de bulletin, suppression d'une fiche élève...

Bon ben je vous laisse voir par vous meme... si vous avez des questions : arnaudcb@hotmail.com

Source / Exemple :


program bulletin_bts;

uses crt,dos;   {declaration de la bibliotheque graphique et sonore}

type eleve=record	{declaration de type pour l'enregistrement}
                 nom:string;
                 prenom:string;
                 date_naiss:string;
                 adress:string;
                 ville:string;
                 codep:string;
                 tel:string;
                 bac:string;
                 note,bts_blanc:array[1..9] of real;
                 moy_elev:array[1..9] of real;
           end;

var         {declaration des variables du programme principale}

elev:file of eleve;
e:eleve;

y, m, d, dow : Word;

b:Boolean;
ch:integer; {choix pour les menus}
num:integer; {pour la boucle_for }
i:integer;
points:real;
code:string;
admin:string;
nom,prenom,sur:string;

const {declaration des constantes}
	code_admin='tsig';
	fichier='c:\bulletin\eleves.dat';
	mat1:array[1..9] of string = ('Francais','Ang.Ecri','Ang.Oral','Maths','Eco/Droi','Etud Cas','P.T.I','Projet','');
        mat2:array[1..7] of string = ('MATIERES','DST','BTS BLANC','COEFF','POINTS','MOY.ELEV','');
        coef:array[1..9] of integer = (2,2,1,2,3,5,3,4,0);

{############################################################################}

procedure boucle_for(var num:integer);
var i:integer;
BEGIN
     for i:=1 to num do writeln;
END;

procedure creat_fichier;
var i:integer;
BEGIN
{cr,ation du repertoire}
{$I-}     {ici on evite d'arreter le prog si erreur!}
MkDir('C:\bulletin');
{cr,ation du fichier eleves.dat}
Assign(elev,fichier);
rewrite (elev);
{$I+}
if IOResult <> 0 then
   begin
        writeln('Fichier d,j. cr,,.');
        writeln(',crasement du fichier !');
        readln;
   end;
END;

                   {-----CREATION D'UNE FICHE-----}

procedure creat_fiche;
var num,i:integer;n,p,rep:string;erreur:byte;
BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
     	seek(elev,FileSize(elev));
     	With e do begin
                 repeat
           		clrscr;
       	    		writeln('CREATION D''UNE FICHE ELEVE :':50);
           		writeln('*****************************':50);
           		num:=5;boucle_for(num);
           		for i:=1 to 9 do begin
           			note[i]:=0.01;
           			bts_blanc[i]:=0.01;
           		end;
           		write('Nom : ');readln(nom);
           		writeln;
           		write('Prenom : ');readln(prenom);
           		writeln;
           		repeat
                 		write('Ann,e de naissance (AAAA): ');readln(date_naiss);
           		until (length(date_naiss)=4);
           		writeln;
           		write('Adresse : ');readln(adress);
           		writeln;
           		write('Ville : ');readln(ville);
           		writeln;
           		repeat
                 		write('Code postal : ');readln(codep);
           		until (length(codep)=5);
           		writeln;
           		repeat
                 		write('t,l,phonne : ');readln(tel);
           		until (length(tel)=10);
           		writeln;
           		write('BAC : ');readln(bac);
           		clrscr;
           		writeln('VERIFICATION DES DONNEES :':50);
           		writeln('**************************':50);
           		num:=3;
           		boucle_for(num);
           		writeln('Nom               : ':25,nom);
           		writeln;
           		writeln('Prenom            : ':25,prenom);
           		writeln;
           		writeln('Date de naissance : ':25,date_naiss);
           		writeln;
           		writeln('Adresse           : ':25,adress);
           		writeln;
           		writeln('Ville             : ':25,ville);
           		writeln;
           		writeln('Code postal       : ':25,codep);
           		writeln;
           		writeln('T,l,phonne        : ':25,tel);
           		writeln;
           		writeln('BAC               : ':25,bac);
           		num:=2;boucle_for(num);
           		writeln('Etes-vous s-r des donn,es (o/n):':50);
           		write('r,ponse :');
           		readln(rep);
    		until ((rep='o') or (rep='oui') or (rep='Oui') or (rep='OUI'));
    		write(elev,e);
    	end;
    end;
END;

            {**********************-----CREATION D NOTES-----**********************}

procedure creat_note;
var
   i:integer;
   n,p,nom_a,prenom_a:string;nbre:integer;
   trouve:boolean;erreur:byte;f:longint;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE DANS LA BASE DE DONNEE :':50);
       writeln;writeln;writeln;writeln;writeln;writeln;
       write('NOM    : ':20);
       readln(n);
       write('PRENOM : ':20);
       readln(p);
       nbre:=-1;trouve:=false;
       while not eof(elev) and not trouve do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.nom) and (p=e.prenom)) then trouve:=true;
       end;
       If trouve then
       begin
       		seek(elev,nbre);
       		read(elev,e);
       		with e do
       		begin
       			clrscr;
       			writeln('':20,nom);
     			writeln('':20,prenom);
     			writeln;
     			writeln('NOTES :':50);
               		writeln('*******':50);
               		writeln;
               		i:=1;
               		for i:=1 to 8 do begin
                                 repeat
                		  write('Entrer la moyenne de DST en ',mat1[i],' : ');
                                  readln(note[i]);
                                 until (note[i]>=0) and (note[i]<=20);
                                  writeln;
                                 repeat
                                  write('Entrer la moyenne de BTS en ',mat1[i],' : ');
                                  readln(bts_blanc[i]);
                                 until (bts_blanc[i]>=0) and (note[i]<=20);
                                  writeln;
                                  moy_elev[i]:=((note[i]+(bts_blanc[i]*2))/50)*10;
                	end;
       			seek(elev,nbre);
       			write(elev,e);
       		end;
       	end
       	else
       	begin
       		writeln;writeln;writeln;
     		writeln('L'',lSve que vous avez indiqu, n''est pas repertori, dans la base de donn,es');
     		writeln('Il faut tout d''abord cr,er une fiche dans la base de donn,e.');
     		writeln;writeln;writeln;writeln;
     		writeln('[ENTRER]':45);
     		readln;
     	end;
       	close(elev);
       	
      end;
END;

              {**********************-----EDITION D NOTES-----**********************}

procedure editer_note;
var
   i:integer;
   n,p,nom_a,prenom_a:string;nbre:integer;
   trouve:boolean;erreur:byte;f:longint;choix:integer;choix2:string;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE DANS LA BASE DE DONNEE :':50);
       writeln;writeln;writeln;writeln;writeln;writeln;
       write('NOM    : ':20);
       readln(n);
       write('PRENOM : ':20);
       readln(p);
       nbre:=-1;trouve:=false;
       while not eof(elev) and not trouve do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.nom) and (p=e.prenom)) then trouve:=true;
       end;
       If trouve then
       begin
       		seek(elev,nbre);
       		read(elev,e);
       		with e do
       		begin
       			repeat
                               repeat
                                  clrscr;
                                  writeln('EDITION DES NOTES :':50);
                                  writeln('*******************':50);
                                  writeln;writeln;writeln;
                                  for i:=1 to 8 do begin
                                  write('':35);write(i);writeln(' : ',mat1[i]);
                                  end;
                                  writeln;
                                  write('':35);writeln('9 : ','Revenir au menu');
                                  writeln;writeln;
                                  write('MatiSre . ,diter : ':25);readln(choix);
                               until ((choix>0) and (choix<10));
                               if choix<>9 then
                               begin
                                 repeat
                                  clrscr;
                                  writeln;writeln;writeln;writeln;
                                  writeln('La moyenne actuelle de DST en ',mat1[choix],' est : ',note[choix]:0:2);
                                  writeln('La moyenne actuelle de BTS Blanc en ',mat1[choix],' est : ',bts_blanc[choix]:0:2);
                                  writeln;writeln;writeln;
                                  writeln('Voulez vous changer les notes (o/n) ?');
                                  write('Choix : ');readln(choix2);
                                 until ((choix2='o') or (choix2='n'));
                                  if choix2='o' then
                                  begin
                                       repeat
                                  	write('Nouvelle note de DST en ',mat1[choix],' : ');readln(note[choix]);
                                       until (note[choix]>=0) and (note[choix]<=20);
                                       repeat
                                  	write('Nouvelle note de BTS Blanc en ',mat1[choix],' : ');readln(bts_blanc[choix]);
                                       until (bts_blanc[choix]>=0) and (bts_blanc[choix]<=20);
                                  	moy_elev[i]:=((note[i]+(bts_blanc[i]*2))/50)*10;
                                  	seek(elev,nbre);
                                  	write(elev,e);
                                  end;
                               end;
                        until (choix=9);
       		end;
       	end
       	else
       	begin
       		writeln;writeln;writeln;
     		writeln('L'',lSve que vous avez indiqu, n''est pas repertori, dans la base de donn,es');
     		writeln('Il faut tout d''abord cr,er une fiche dans la base de donn,e.');
     		writeln;writeln;writeln;writeln;
     		writeln('[ENTRER]':45);
     		readln;
     	end;
       	close(elev);
       	
      end;
END;

		{**********************-----RECHERCHE INFOS ELEVE-----**********************}

procedure search_info;
var
   i:integer;
   n,p:string;nbre:integer;
   trouve:boolean;erreur:byte;choix:integer;choix2:string;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}

    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE DANS LA BASE DE DONNEE :':50);
       writeln;writeln;writeln;writeln;writeln;writeln;
       write('NOM    : ':20);
       readln(n);
       write('PRENOM : ':20);
       readln(p);
       nbre:=-1;trouve:=false;
       while not eof(elev) and not trouve do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.nom) and (p=e.prenom)) then trouve:=true;
       end;
       If trouve then
       begin
       		seek(elev,nbre);
       		read(elev,e);
       		with e do
       		begin
       			repeat
                               repeat
                                  clrscr;
                                  writeln('INFORMATIONS SUR L''ELEVE :':52);
                                  writeln('***************************':52);
                                  writeln;writeln;writeln;
                                  for i:=1 to 8 do
                                  begin
                                  	write('':25);write(i);write(' : ');
                                  	case (i) of
                                  		1:writeln('Nom               : ',nom);
                                  		2:writeln('Prenom            : ',prenom);
                                  		3:writeln('Date de naissance : ',date_naiss);
                                  		4:writeln('Adresse           : ',adress);
                                  		5:writeln('Ville             : ',ville);
                                  		6:writeln('Code postal       : ',codep);
                                  		7:writeln('T,l,phonne        : ',tel);
                                  		8:writeln('BAC               : ',bac);
                                  	end;
                                  end;
                                  writeln;
                                  write('':25);writeln('9 : ','Revenir au menu');
                                  writeln;writeln;
                                  write('Information a editer : ':25);readln(choix);
                               until ((choix>0) and (choix<10));
                               if choix<>9 then
                               begin
                                 repeat
                                  clrscr;
                                  write('':25);
                                  case (choix) of
                                  		1:writeln('Nom               : ',nom);
                                  		2:writeln('Prenom            : ',prenom);
                                  		3:writeln('Date de naissance : ',date_naiss);
                                  		4:writeln('Adresse           : ',adress);
                                  		5:writeln('Ville             : ',ville);
                                  		6:writeln('Code postal       : ',codep);
                                  		7:writeln('T,l,phonne        : ',tel);
                                  		8:writeln('BAC               : ',bac);
                                  	end;
                                  writeln;writeln;writeln;writeln;
                                  writeln('Voulez vous changer l''information (o/n) ?');
                                  write('Choix : ');readln(choix2);
                                 until ((choix2='o') or (choix2='n'));
                                  if choix2='o' then
                                  begin
                                  	writeln;writeln;write('':25);
                                  	case (choix) of
                                  		1:begin;write('Nom               : ');readln(nom);end;
                                  		2:begin;write('Prenom            : ');readln(prenom);end;
                                  		3:begin;
                                                        repeat;
                                                               write('Date de naissance : ');
                                                               readln(date_naiss);
                                                        until ((length(date_naiss)<5) and (length(date_naiss)>0));
                                                end;
                                  		4:begin;write('Adresse           : ');readln(adress);end;
                                  		5:begin;write('Ville             : ');readln(ville);end;
                                  		6:begin;write('Code postal       : ');readln(codep);end;
                                  		7:begin;
                                  			repeat
                                  				write('T,l,phonne        : ');
                                  				readln(tel);
                                  			until ((length(tel)<11) and (length(tel)>0));
                                  		end;
                                  		8:begin;write('BAC               : ');readln(bac);end;
                                  	end;
                                  	seek(elev,nbre);
                                  	write(elev,e);
                                  end;
                               end;
                        until (choix=9);
       		end;
       	end
       	else
       	begin
       		writeln;writeln;writeln;
     		writeln('L'',lSve que vous avez indiqu, n''est pas repertori, dans la base de donn,es');
     		writeln('Il faut tout d''abord cr,er une fiche dans la base de donn,e.');
     		writeln;writeln;writeln;writeln;
     		writeln('[ENTRER]':45);
     		readln;
     	end;
       	close(elev);

      end;
END;

		{**********************-----EFFACER UNE FICHE ELEVE-----**********************}

procedure delete_fiche;
var
   i:integer;
   n,p:string;nbre:integer;
   trouve:boolean;erreur:byte;choix:string;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE DANS LA BASE DE DONNEE :':50);
       writeln;writeln;writeln;writeln;writeln;writeln;
       write('NOM    : ':20);
       readln(n);
       write('PRENOM : ':20);
       readln(p);
       nbre:=-1;trouve:=false;
       while not eof(elev) and not trouve do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.nom) and (p=e.prenom)) then trouve:=true;
       end;
       If trouve then
       begin
       		seek(elev,nbre);
       		read(elev,e);
       		with e do
       		begin
                               repeat
                                  clrscr;
                                  writeln('FICHE EN COUR DE SUPPRESSION :':52);
                                  writeln('******************************':52);
                                  writeln;writeln;writeln;
                                  for i:=1 to 8 do
                                  begin
                                  	write('':25);
                                  	case (i) of
                                  		1:writeln('Nom               : ',nom);
                                  		2:writeln('Prenom            : ',prenom);
                                  		3:writeln('Date de naissance : ',date_naiss);
                                  		4:writeln('Adresse           : ',adress);
                                  		5:writeln('Ville             : ',ville);
                                  		6:writeln('Code postal       : ',codep);
                                  		7:writeln('T,l,phonne        : ',tel);
                                  		8:writeln('BAC               : ',bac);
                                  	end;
                                  end;
                                  writeln;
                                  writeln;writeln;
                                  write('Voulez-vous vraiment effacer cette fiche (o/n)? ':25);readln(choix);
                               until ((choix='o') or (choix='n'));
                               if choix='o' then
                               begin
                                  	nom:='';
                                  	prenom:='';
                                  	date_naiss:='';
                                  	adress:='';
                                  	ville:='';
                                  	codep:='';
                                  	tel:='';
                                  	bac:='';
                                  	for i:=1 to 8 do
                                  	begin
                                  		note[i]:=0;
                                  		bts_blanc[i]:=0;
                                  		moy_elev[i]:=0;
                                  	end;
                                  	seek(elev,nbre);
                                  	write(elev,e);
                               end;
       		end;
       	end
       	else
       	begin
       		writeln;writeln;writeln;
     		writeln('L'',lSve que vous avez indiqu, n''est pas repertori, dans la base de donn,es');
     		writeln('Il faut tout d''abord cr,er une fiche dans la base de donn,e.');
     		writeln;writeln;writeln;writeln;
     		writeln('[ENTRER]':45);
     		readln;
     	end;
       	close(elev);

      end;
END;

		{**********************-----BULLETIN-----**********************}

procedure bulletin(n:string;p:string);
var i:integer;ch:string;
l:integer;som_points:real;som_coef:integer;
nom2,prenom2:string;
BEGIN

     som_coef:=0;som_points:=0;
     Assign(elev,'c:\bulletin\eleves.dat');
     reset(elev);
     clrscr;
     writeln('RECHERCHE DANS LA BASE DE DONNEE :':50);
     writeln;writeln;writeln;writeln;writeln;writeln;
     write('NOM    : ':20);
     readln(n);
     write('PRENOM : ':20);
     readln(p);
     b:=false;
     while not eof(elev) and not b do
     begin
          read(elev,e);
          with e do
                          begin
                               if (nom=n) and (prenom=p) then
                                            begin
                                                 b:=true;
                                                      begin
GetDate(y,m,d,dow);{recuperation de la date actuelle}
clrscr;writeln;
writeln('Nom      : ':15,nom);
write('Prenom   : ':15,prenom);
write('':48);
if m<=12 then writeln(y-1:0,' - ',y:0)
         else writeln(y:0,' - ',y+1:0);
writeln;
writeln('ÉÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍ»':68);
writeln('º ':9,mat2[1],' º ',mat2[2],'  º ',mat2[3],' º ',mat2[4],' º ',mat2[5],'  º ',mat2[6],'  º ');
writeln('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍ͹':68);
for i:=1 to 8 do
begin
     	write('º ':9);
     	write(mat1[i]);
     	l:=length(mat1[i]);
     	case l of
             1:write('        º');
             2:write('       º');
             3:write('      º');
             4:write('     º');
             5:write('    º');
             6:write('   º');
             7:write('  º');
             8:write(' º');
     	end;
     	if note[i]<10 then write(' ',note[i]:2:2,' º ')
             	      else write('',note[i]:2:2,' º ');
	write('  ');
	if bts_blanc[i]<10 then write(' ',bts_blanc[i]:2:2,'   º   ')
                 	         else write('',bts_blanc[i]:2:2,'   º   ');
	write(coef[i],'   º ');
	points:=((bts_blanc[i]*coef[i]));
	som_points:=som_points+points;
	som_coef:=som_coef+coef[i];
	if points<10 then write('  ',points:2:2,'  º')
        	     else write(' ',points:2:2,'  º');
	if (bts_blanc[i]+note[i])/2>=10 then writeln('   ',((bts_blanc[i]*2)+note[i])/3:2:2,'   º')
                	                else writeln('    ',((bts_blanc[i]*2)+note[i])/3:2:2,'   º');
end;{FIN DU BEGIN (FOR)}

writeln('ÈÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍ͹':68);
  write('º ':39);
textcolor(green);write('TOTAL');textcolor(white);write(' º');write(' ',som_points:2:2);write('  º');
if (som_points/som_coef)<10 then writeln('    ',(som_points/som_coef):2:2,'   º')
                            else writeln('   ',(som_points/som_coef):2:2,'   º');
writeln('ÈÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍO':68);
textcolor(red+blink);
if (som_points/som_coef)>=9.98 then writeln('AVIS FAVORABLE AU BTS !':50)
                               else writeln('AVIS DEFAVORABLE AU BTS !':50);
textcolor(white);
writeln;

 writeln('[ENTRER]':45);
     readln;
                                                      end;
                                                 
                                            end;
                          end;
   end;
     if not b then begin
     writeln;writeln;writeln;
     writeln('L'',lSve que vous avez indiqu, n''est pas repertori, dans la base de donn,es');
     writeln('Il faut tout d''abord cr,er une fiche dans la base de donn,e.');
     writeln;writeln;writeln;writeln;
     writeln('[ENTRER]':45);
     readln;
                   end;
     close(elev);

END;

procedure lecture;
var
i:integer;n,p,nom_a,prenom_a,choix2:string;choix:integer;
erreur:byte;trouve:boolean;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
     		while not eof(elev) do begin
     			with e do begin
     				read(elev,e);
     				writeln(nom);
     				writeln(prenom);
     				writeln(date_naiss);
     				writeln(adress);
     				writeln(ville);
     				writeln(codep);
     				writeln(tel);
     				writeln(bac);
     				for i:=1 to 8 do begin
     				write(note[i],'/');
     				write(bts_blanc[i],'/');
     				write(moy_elev[i],'/');writeln;
     				end;
     				readln;
     			end;
     		end;
     	end;
END;

		{**********************-----RECHERCHE PAR NOM-----**********************}

procedure search_nom;
var
   i:integer;
   n,p:string;nbre,nbre_trouve:integer;place:array[1..999] of integer;
   trouve:boolean;erreur:byte;choix:string;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE PAR NOM DANS LA BASE DE DONNEE :':60);
       writeln('******************************************':60);
       writeln;writeln;writeln;writeln;writeln;
       write('NOM    : ':20);
       readln(n);
       nbre:=-1;trouve:=false;nbre_trouve:=0;
       while not eof(elev) do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.nom)) then begin
                                         nbre_trouve:=nbre_trouve+1;
                                         place[nbre_trouve]:=nbre;
                                    end;
       end;
       writeln;writeln;write('':18);
       if nbre_trouve=0 then writeln('Aucun ,lSve n''a ,t, trouv, dans notre fichier.')
                        else if (nbre_trouve=1) then writeln(nbre_trouve,' ,lSve trouv, correspond . la recherche.')
                                                else writeln(nbre_trouve,' ,lSves trouv,s correspondent . la recherche.');
       writeln;writeln;readln;clrscr;
       if nbre_trouve<>0 then
       for i:=1 to nbre_trouve do
       begin
            seek(elev,place[i]);
            read(elev,e);
            with e do
            begin
                 clrscr;
                 writeln;
                 write('':35);
                 writeln('ELEVE Nø=',i);
                 writeln;
                 writeln;
                 writeln('Nom               : ':25,nom);
           	 writeln('Prenom            : ':25,prenom);
           	 writeln('Date de naissance : ':25,date_naiss);
           	 writeln('Adresse           : ':25,adress);
           	 writeln('Ville             : ':25,ville);
           	 writeln('Code postal       : ':25,codep);
           	 writeln('T,l,phonne        : ':25,tel);
           	 writeln('BAC               : ':25,bac);
           	 writeln;writeln;
                 write('':15);
           	 if i<>nbre_trouve then writeln('APPUYER SUR [ENTER] POUR PASSER AU SUIVANT !')
                 		   else writeln('APPUYER SUR [ENTER] POUR TERMINER':45);
                 readln;
            end;
       end;
     end;
END;

		{**********************-----RECHERCHE PAR DATE DE NAISSANCE-----**********************}

procedure search_date_naiss;
var
   i:integer;
   n,p:string;nbre,nbre_trouve:integer;place:array[1..999] of integer;
   trouve:boolean;erreur:byte;choix:string;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE PAR DATE DE NAISSANCE DANS LA BASE DE DONNEE :':74);
       writeln('**************-----------------*************************':74);
       writeln;writeln;writeln;writeln;writeln;
       write('DATE    : ':20);
       readln(n);
       nbre:=-1;trouve:=false;nbre_trouve:=0;
       while not eof(elev) do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.date_naiss)) then begin
                                         nbre_trouve:=nbre_trouve+1;
                                         place[nbre_trouve]:=nbre;
                                    end;
       end;
       writeln;writeln;write('':18);
       if nbre_trouve=0 then writeln('Aucun ,lSve n''a ,t, trouv, dans notre fichier.')
                        else if (nbre_trouve=1) then writeln(nbre_trouve,' ,lSve trouv, correspond . la recherche.')
                                                else writeln(nbre_trouve,' ,lSves trouv,s correspondent . la recherche.');
       writeln;writeln;readln;clrscr;
       if nbre_trouve<>0 then
       for i:=1 to nbre_trouve do
       begin
            seek(elev,place[i]);
            read(elev,e);
            with e do
            begin
                 clrscr;
                 writeln;
                 write('':35);
                 writeln('ELEVE Nø=',i);
                 writeln;
                 writeln;
                 writeln('Nom               : ':25,nom);
           	 writeln('Prenom            : ':25,prenom);
           	 writeln('Date de naissance : ':25,date_naiss);
           	 writeln('Adresse           : ':25,adress);
           	 writeln('Ville             : ':25,ville);
           	 writeln('Code postal       : ':25,codep);
           	 writeln('T,l,phonne        : ':25,tel);
           	 writeln('BAC               : ':25,bac);
           	 writeln;writeln;
                 write('':15);
           	 if i<>nbre_trouve then writeln('APPUYER SUR [ENTER] POUR PASSER AU SUIVANT !')
                 		   else writeln('APPUYER SUR [ENTER] POUR TERMINER':45);
                 readln;
            end;
       end;
     end;
END;

		{**********************-----RECHERCHE PAR VILLE-----**********************}

procedure search_ville;
var
   i:integer;
   n,p:string;nbre,nbre_trouve:integer;place:array[1..999] of integer;
   trouve:boolean;erreur:byte;choix:string;

BEGIN
    {$I-}
    Assign(elev,fichier);
    reset(elev);
    {$I+}
    erreur:=IOResult;
    if erreur<> 0 then begin
        clrscr;writeln('Le fichier n''est pas cr,,');readln;
     end
     else begin
       clrscr;
       writeln('RECHERCHE PAR VILLE DANS LA BASE DE DONNEE :':58);
       writeln('**************-----*************************':58);
       writeln;writeln;writeln;writeln;writeln;
       write('VILLE    : ':20);
       readln(n);
       nbre:=-1;trouve:=false;nbre_trouve:=0;
       while not eof(elev) do begin
       		read(elev,e);
       		nbre:=nbre+1;
       		If ((n=e.ville)) then begin
                                         nbre_trouve:=nbre_trouve+1;
                                         place[nbre_trouve]:=nbre;
                                    end;
       end;
       writeln;writeln;write('':18);
       if nbre_trouve=0 then writeln('Aucun ,lSve n''a ,t, trouv, dans notre fichier.')
                        else if (nbre_trouve=1) then writeln(nbre_trouve,' ,lSve trouv, correspond . la recherche.')
                                                else writeln(nbre_trouve,' ,lSves trouv,s correspondent . la recherche.');
       writeln;writeln;readln;clrscr;
       if nbre_trouve<>0 then
       for i:=1 to nbre_trouve do
       begin
            seek(elev,place[i]);
            read(elev,e);
            with e do
            begin
                 clrscr;
                 writeln;
                 write('':35);
                 writeln('ELEVE Nø=',i);
                 writeln;
                 writeln;
                 writeln('Nom               : ':25,nom);
           	 writeln('Prenom            : ':25,prenom);
           	 writeln('Date de naissance : ':25,date_naiss);
           	 writeln('Adresse           : ':25,adress);
           	 writeln('Ville             : ':25,ville);
           	 writeln('Code postal       : ':25,codep);
           	 writeln('T,l,phonne        : ':25,tel);
           	 writeln('BAC               : ':25,bac);
           	 writeln;writeln;
                 write('':15);
           	 if i<>nbre_trouve then writeln('APPUYER SUR [ENTER] POUR PASSER AU SUIVANT !')
                 		   else writeln('APPUYER SUR [ENTER] POUR TERMINER':45);
                 readln;
            end;
       end;
     end;
END;

{############################################################################}
{###########################  MENUS  ########################################}
{############################################################################}

procedure menu_princ(var ch:integer);
BEGIN
     clrscr;
     writeln;
     textcolor(red);
     writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»':45);
     write('º  ':29);textcolor(green+blink);
     write('MENU PRINCIPAL');textcolor(red);
     writeln(' º');
     writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍO':45);
     textcolor(white);
     num:=5;
     boucle_for(num);
     writeln('':25,'1 : Gestion fiche ,lSve');
     writeln('':25,'2 : Consultation fiche ,lSve');
     writeln('':25,'3 : Quitter');
     boucle_for(num);
     write('CHOIX : ':2);
     readln(ch);
END;

procedure menu_1(var ch:integer);
BEGIN
     clrscr;
     writeln;
     textcolor(red);
     writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»':45);
     write('º  ':31);textcolor(green+blink);
     write('MENU GESTION');textcolor(red);
     writeln(' º');
     writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍO':45);
     textcolor(white);
     num:=3;
     boucle_for(num);
     writeln('':25,'1 : Cr,ation d''une fiche');
     writeln('':25,'2 : Entrer toutes les notes');
     writeln('':25,'3 : Editer les notes');
     writeln('':25,'4 : Editer une fiche');
     writeln('':25,'5 : Supprimer une fiche');
     writeln('':25,'6 : Menu pr,c,dent');
     writeln('':25,'7 : Quitter');
     boucle_for(num);
     write('CHOIX : ':2);
     {$I-}
     readln(ch);
     {$I+}
END;

procedure menu_2(var ch:integer);
BEGIN
     clrscr;
     writeln;
     textcolor(red);
     writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»':45);
     write('º  ':26);textcolor(green+blink);
     write('MENU CONSULTATION');textcolor(red);
     writeln(' º');
     writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍO':45);
     textcolor(white);
     num:=5;
     boucle_for(num);
     writeln('':25,'1 : Recherche d''un ,lSve');
     writeln('':25,'2 : Consultation d''un bulletin d''un ,lSve');
     writeln('':25,'3 : Menu pr,c,dent');
     writeln('':25,'4 : Quitter');
     boucle_for(num);
     write('CHOIX : ':2);
     readln(ch);
END;

procedure menu_setup(var ch:integer);
BEGIN
     clrscr;
     writeln;
     textcolor(red);
     writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»':45);
     write('º  ':32);textcolor(green+blink);
     write('MENU SETUP ');textcolor(red);
     writeln(' º');
     writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍO':45);
     textcolor(white);
     num:=5;
     boucle_for(num);
     writeln('':25,'1 : Cr,ation et initialisation du fichier.');
     writeln('':25,'2 : Annuler.');
     writeln('':25,'3 : Quitter.');
     boucle_for(num);
     write('CHOIX : ':2);
     readln(ch);
END;

procedure menu_3(var ch:integer);
BEGIN
     clrscr;
     writeln;
     textcolor(red);
     writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»':45);
     write('º  ':26);textcolor(green+blink);
     write(' MENU  RECHERCHE ');textcolor(red);
     writeln(' º');
     writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍO':45);
     textcolor(white);
     num:=5;
     boucle_for(num);
     writeln('':25,'1 : Recherche par Nom');
     writeln('':25,'2 : Recherche par Date de naissance');
     writeln('':25,'3 : Recherche par Ville');
     writeln('':25,'4 : Recherche par Bac');
     writeln('':25,'5 : Menu pr,c,dent');
     writeln('':25,'6 : Quitter');
     boucle_for(num);
     write('CHOIX : ':2);
     readln(ch);
END;

{############################################################################}
{############################################################################}
{#############################  PROG PRINCIPAL  #############################}
{############################################################################}
{############################################################################}

BEGIN
textcolor(white);
clrscr;
repeat
      admin:='';
      menu_princ(ch);
      case ch of
           1:begin
             repeat
              clrscr;
              num:=8;
              boucle_for(num);
              if admin<>'tsig' then begin
              write('CODE ADMINISTRATEUR : ':50);readln(admin);
              end;
              if admin=code_admin then
               begin
                 repeat
                  menu_1(ch);
                  case ch of
                       1:creat_fiche;
                       2:creat_note;
                       3:editer_note;
                       4:search_info;
                       5:delete_fiche;
                       6:begin
                              ch:=0;
                              admin:='';
                       end;
                       7:exit;
                  end;
                 until ((ch=0) or (ch=1) or (ch=2) or (ch=3) or (ch=4) or (ch=5) or (ch=6) or (ch=7))
               end
              else
               begin
                 num:=5;
                 boucle_for(num);
                 textcolor(red+blink);
                 writeln('MOT DE PASS ERRONER !!!':55);
                 textcolor(white);
                 delay(2000);
               end;
             until admin<>'tsig';
             end;
           2:begin
                 repeat
                  menu_2(ch);
                  case ch of
                       1:begin
                       		repeat
                       		  menu_3(ch);
                       		  case ch of
                       		  	1:begin;search_nom;ch:=7;end;
                       		  	2:begin;search_date_naiss;ch:=7;end;
                       		  	3:begin;search_ville;ch:=7;end;
                       		  	4:begin;ch:=7;end;
                       		  	5:ch:=5;
                       		  	6:exit;
                       		  end;
                       		until ((ch=0) or (ch=1) or (ch=2) or (ch=3) or (ch=4) or (ch=5) or (ch=6))
                       	end;
                       2:begin
                              {lecture;}
                              bulletin(nom,prenom);
                              ch:=5;
                       end;
                       3:ch:=0;
                       4:exit;
                  end;
                 until ((ch=0) or (ch=1) or (ch=2) or (ch=3) or (ch=4))
             end;
           3:exit;
           999:begin {menu cach, pr l administrateur}
                    writeln('Etes-vous sur de vouloir lancer le setup?');
                    writeln('Ceci efface toutes les donn,es enregistr,es!!');
                    write('S-r (Oui) ? ');readln(sur);
                    if sur='Oui' then begin
                                        repeat
                                         menu_setup(ch);
                                         case ch of
                                              1:creat_fichier;
                                              2:ch:=0;
                                              3:exit;
                                         end;
                                        until ((ch=0) or (ch=1) or (ch=2) or (ch=3))
                                    end;
               end;
          end;
until ch=3;

END.

©ª³Zz ¹ º » O ¿ À Á Â Ã Ä Å È É Ê Ë Ì Í Î Ù Ú Û Ü Ý ß î ð ò ÷ þ ÿ

Conclusion :


Bon il faut pour l'executer copier le code dans un nouveau fichier du bloc note et l'enregistrer sous un *.pas ! Bien sur il vous faut turbo pascal 7... il est gratuit et il est proposé sur le site de borland.
Certains caractères ne passent pas lorsque l'on est pas dans turbo pascal, mais redeviennent normaux sous pascal alors pas d'inquiétude !
allez bon courage... @++

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
4
Date d'inscription
mercredi 9 avril 2003
Statut
Membre
Dernière intervention
10 juin 2003

Juste pour votre information, afin que le code fonctionne il faut absolument que le dossier et le fichier existe dans le lecteur C :
c:\bulletin\eleves.dat

voir ligne 36 pour le changer :
fichier='c:\bulletin\eleves.dat';

bon courage à tous,

BR freemanolimit.
Messages postés
1
Date d'inscription
jeudi 6 novembre 2008
Statut
Membre
Dernière intervention
6 novembre 2008

ca marche pas
Messages postés
4
Date d'inscription
mercredi 9 avril 2003
Statut
Membre
Dernière intervention
10 juin 2003

Hello,

Merci pour ton intervention CIREC!
Effectivement le code admin se trouve au début lors des déclarations des variables...
Si tu as d'autres questions ZOOTECH n'hesite pas :)
Messages postés
3811
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
15 juin 2020
30
@Zoootech:

il y a tout dans le code ^^
code_admin='tsig';

il faut lire le code si déjà.
Messages postés
2
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
10 mai 2008

J'ATTEND VOTRE REPONSE
Afficher les 9 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (freemanolimit)