program file1;
uses crt;
 
procedure up(var s: string);
var
  i: Integer;
begin
  for i := 1 to Length(s) do
    s[i] := UpCase(s[i]);
end;
 
var
  F: Text;
  s: string;
  sortie: boolean;
begin
  clrscr;
 
  assign(F, 'c:\tp\exercice.txt');
  rewrite(F);
  sortie := false;
 
  repeat
    writeln('Entrez une chaine a ecrire dans le fichier');
    readln(s);
    up(s);
    if (s = 'FIN') then
      sortie := true
    else
      writeln(F, s);
  until sortie = true;
 
  close(F);
  readln;
end.

program file2;
uses crt;
 
var
  F: Text;
  tableau: array[1..10] of string;
  NbrEnregistrement: integer;
  i: integer;
begin
  clrscr;
 
  assign(F, 'c:\tp\exercice.txt');
  reset(F);
  NbrEnregistrement := 0;
 
  while ((not eof(F)) and (NbrEnregistrement < 10)) do
  begin
    readln(F, tableau[NbrEnregistrement + 1]);
    NbrEnregistrement := NbrEnregistrement + 1;
  end;
 
  for i := 1 to NbrEnregistrement do
    writeln(tableau[i]);
 
  close(F);
  readln;
end.

program file2;
uses crt;
 
function FileExists(FileName: string): Boolean;
var
  F: file;
begin
{$I-}
  Assign(F, FileName);
  FileMode := 0;
  Reset(F);
  Close(F);
{$I+}
  FileExists := (IOResult = 0) and (FileName <> '');
end;
 
begin
 
end.

program getattrib; 
 
uses
  Dos;
 
function FileExists(FileName: string): Boolean; 
var 
  F: file; 
begin 
  {$I-} 
  Assign(F, FileName); 
  FileMode := 0; 
  Reset(F); 
  Close(F);
 {$I+} 
 FileExists := (IOResult = 0) and (FileName <> ''); 
end;
 
var 
  F: file; 
  attribut: Word; 
  filename: string; 
 
begin 
  writeln('Entrez le nom complet du fichier : '); 
  readln(filename); 
  if (FileExists(filename)) then 
    begin 
      assign(F, filename); 
      reset(F); 
      GetFAttr(F, attribut); 
      if attribut and ReadOnly <> 0 then 
        Writeln('Fichier en lecture seule'); 
      if attribut and Hidden <> 0 then 
        Writeln('Fichier cache'); 
      if attribut and SysFile <> 0 then 
        Writeln('Fichier systeme'); 
      if attribut and VolumeID <> 0 then 
        Writeln('Unité de volume'); 
      if attribut and Directory <> 0 then 
        Writeln('Répertoire'); 
      if attribut and Archive <> 0 then 
        Writeln('Archive'); 
      close(F); 
    end 
  else 
    writeln('Fichier Inexistant sur le disque!'); 
  readln; 
end.

uses Dos, Crt;
 
var
  FileCount: Integer;
  extension: string[5];
  s: string;
 
procedure FindFile(DirName: string);
var
  DirInfo: SearchRec;
begin
 
  FindFirst(DirName + extension, Archive, DirInfo);
  while DosError = 0 do
  begin
    Writeln(DirInfo.Name);
    FileCount := Filecount + 1;
    FindNext(DirInfo);
  end;
  Writeln;
 
end;
 
procedure FindDir(PathName: string);
var
  DirInfo: SearchRec;
begin
 
  FindFirst(PathName + '*', Directory, DirInfo);
 
  while DosError = 0 do
  begin
    if ((DirInfo.Name <> '..') and (DirInfo.Name <> '.')) then
    begin
      Writeln('Repertoire de : ', PathName + DirInfo.Name + '\');
      FindFile(PathName + DirInfo.Name + '\');
      if Keypressed then
        Readln;
      FindDir(PathName + DirInfo.Name + '\');
    end;
    FindNext(DirInfo);
  end;
 
end;
 
begin
 
  ClrScr;
 
  FileCount := 0;
  s := ParamStr(1);
  extension := ParamStr(2);
  FindFile(s);
  FindDir(s);
 
  Writeln(FileCount, ' fichiers trouvés!');
  Readln;
 
end.

program annuaire;
uses crt, strTest;
type
  Personne = record
    nom: string[30];
    telephone: string[10];
    nCarte: word;
  end;
  FPersonne = file of Personne;
 
procedure DisplayMenu;
begin
  writeln('1. Ajouter une personne');
  writeln('2. Afficher le contenu du fichier');
  writeln('3. Quitter le programme');
end;
 
function FileExists(FileName: string): Boolean;
var
  F: file;
begin
{$I-}
  Assign(F, FileName);
  FileMode := 0;
  Reset(F);
  Close(F);
{$I+}
  FileExists := (IOResult = 0) and (FileName <> '');
end;
 
procedure AjoutePersonne(var F: FPersonne; P: Personne);
begin
  reset(F);
  seek(F, FileSize(F));
 
  write(F, P);
 
  close(F);
end;
 
procedure DisplayFile(var F: FPersonne);
var
  P: Personne;
begin
  reset(F);
  while not eof(F) do
  begin
    read(F, P);
    writeln('Nom : ', P.nom);
    writeln('Telephone : ', P.telephone);
    writeln('Numero de carte banquaire : ', P.nCarte);
    writeln;
  end;
  close(F);
end;
 
var
  F: FPersonne;
  P: Personne;
  choix: integer;
begin
  clrscr;
  choix := 0;
  assign(F, 'c:\tp\annuaire.dat');
  rewrite(F);
 
  repeat
    writeln;
    DisplayMenu;
    repeat
{$I-}
      write('Entrez un choix : ');
      readln(choix);
{$I+}
    until IOResult = 0;
    writeln;
    case choix of
      1:
        begin
          repeat
            Write('Entrez le nom : ');
            readln(P.nom);
          until isString(P.nom);
          repeat
            Write('Entrez le numero de telephone : ');
            readln(P.telephone);
          until isNumber(P.telephone);
          repeat
{$I-}
            Write('Entrez le numero de carte banquaire : ');
            readln(P.nCarte);
{$I+}
          until IOResult = 0;
          AjoutePersonne(F, P);
        end;
      2:
        begin
          writeln('Contenu du fichier...');
          DisplayFile(F);
        end;
      3: ;
    else
      writeln('Entrée incorrecte!');
    end;
  until choix = 3;
 
end.