Bac 2013 (23/05 à 10h)

Program bac2013;
Uses Wincrt;
Var
  f1,f2: Text;

Procedure creation (Var f1,f2:Text);
Begin
  Assign (f1,'c:\bac\revision bac\phrases.txt');
  Assign (f2,'c:\bac\revision bac\resultat.txt');
End;

Function verif (ch:String): Boolean;
Var
  i: Integer;
  test: Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := ch[i] In ['A'..'Z','a'..'z',' '];
  Until (test=False) Or (i=Length(ch));
  verif := test;
End;

Procedure remplir (Var f1:Text);
Var
  n,i: Integer;
  ch: String;
Begin
  Repeat
    Write ('Saisir N: ');
    Readln (n);
  Until (n<=50);
  Rewrite (f1);
  For i:=1 To n Do
        begin
            Repeat
          Write ('Saisir la phrase ',i,' : ');
          Readln (ch);
        Until (Pos('  ',ch)=0) And (verif(ch));
            writeln (f1,ch);
        end;
  Close (f1);
End;
Function crypt (ch:String;n:Integer): String;
Var
  i,j: Integer;
Begin
  For i:=1 To Length(ch) Do
    For j:=1 To n Do
      If ch[i]='Z' Then
        ch[i] := 'A'
      Else If ch[i]='z' Then
             ch[i] := 'a'
      Else
        ch[i] := Succ(ch[i]);
  crypt := ch;
End;
Function cryptage (ch:String): String;
Var
  i: Integer;
  ch1: String;
Begin
  ch := ch+' ';
  ch1 := '';
  i := 0;
  Repeat
    i := i+1;
    ch1 := ch1+crypt(Copy(ch,1,Pos(' ',ch)-1),i)+' ';
    Delete (ch,1,Pos(' ',ch));
  Until (ch='');
  cryptage := Copy (ch1,1,Length(ch1)-1);
End;

Procedure traitement (Var f1,f2:Text);
Var
  ch: String;
Begin
  Reset (f1);
  Rewrite(f2);
  While Not (Eof(f1)) Do
    Begin
      Readln (f1,ch);
      Writeln (f2,cryptage(ch));
    End;
  Close (f1);
  Close (f2);
End;

Procedure affiche (Var f:Text);
Var
  ch: String;
Begin
  Reset (f);
  While Not (Eof(f)) Do
    Begin
      Readln (f,ch);
      Writeln (ch);
    End;
  Close (f);
End;
Begin
  creation (f1,f2);
  remplir (f1);
  traitement (f1,f2);
  affiche (f2);
End.