M1RAI

Untitled

Oct 10th, 2019
100
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program ex3;
  2. uses wincrt;
  3. type
  4. fiche=file of integer;
  5. var
  6. f:fiche;
  7. n:integer;
  8.  
  9. procedure saisie( var n:integer);
  10. begin
  11.      repeat
  12.            writeln('n=');
  13.            readln(n);
  14.      until (n>=10) and (n<=500)
  15. end;
  16.  
  17. procedure remp (var f:fiche; n:integer);
  18. var i,x:integer;
  19. begin
  20.      assign(f,'C:\Travail Pascal\Fichier d entiers\ex3.dat');
  21.      i:=0;
  22.      while not(eof(f)) and (i<=n) do
  23.      begin
  24.           repeat
  25.           read(x);
  26.           until (x>=1)and (x<=10000);
  27.      write(f,x);
  28.      end;
  29. close(f);
  30. end;
  31.  
  32. function verif(Y:integer):boolean;
  33. var chy:string;OK:boolean;
  34. begin
  35.      ok:=false;
  36.      repeat
  37.      begin
  38.           chy:='';
  39.           str(y,chy);
  40.           if (length(chy)=4)
  41.              then
  42.                  if ((y div 1000)+(y div 100)+(y div 10)+(y mod 10) = 20)
  43.                      then OK:=true
  44.  
  45.            else
  46.            if (length(chy)=3)
  47.                then
  48.                    if ((y div 100)+(y div 10)+(y mod 10) = 20)
  49.                         then OK:=true;
  50.  
  51.      end;
  52.      until (OK=true);
  53.      verif:=OK;
  54. end;
  55.  
  56. procedure affiche (var f:fiche; n:integer);
  57. var i,x:integer; ch:string;
  58. begin
  59.      reset(f);
  60.      i:=0;
  61.      while not(eof(f)) and (i<=n) do
  62.      begin
  63.           i:=i+1;
  64.           ch:='';
  65.           str(x,ch);
  66.           if (length(ch)=20) and verif(x)
  67.              then write(f,x);
  68.      end;
  69. close(f);
  70. end;
  71.  
  72. begin
  73. saisie(n);
  74. remp(f,n);
  75. affiche(f,n);
  76. end.
RAW Paste Data