Bac 2020

Program bac2020;
Uses Wincrt;
Type
  tab = Array [1..20] Of Integer;
Var
  f,f7,f13: Text;

Procedure creation (Var f,f7,f13:Text);
Begin
  Assign (f,'c:\bac\Nombres.txt');
  Assign (f7,'c:\bac\Divis7.txt');
  Assign (f13,'c:\bac\Divis13.txt');
End;
Function verif (ch:String): Boolean;
Var
  i: Integer;
  test: Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := ch[i] In ['0'..'9'];
  Until (test=False) Or (i=Length(ch));
  verif := test;
End;
Procedure remplir (Var f:Text);
Var
  i,n: Integer;
  ch: String;
Begin
  Rewrite (f);
  Repeat
    Write ('Saisir le nombre d''entiers à saisirs: ');
    Readln (n);
  Until (1<=n);
  For i:=1 To n Do
    Begin
      Repeat
        Writeln ('Saisir un entier: ');
        Readln (ch);
      Until verif(ch);
      Writeln (f,ch);
    End;
  Close (f);
End;

Function divis13 (n:String): Boolean;
Var
  s,sg,v,e: Integer;
Begin
  s := 0;
  sg := -1;
  While Length(n)>=3 Do
    Begin
      Val (Copy(n,Length(n)-2,3),v,e);
      s := s+v*sg;
      sg := -sg;
      Delete (n,Length(n)-2,3);
    End;
  Val (n,v,e);
  s := s+v*sg;
  divis13 := Abs(s) Mod 13=0;
End;

Procedure facteur (ch:String;Var t:tab);
Var
  i,n,e: Integer;
Begin
  For i:=1 To Length(ch) Do
    Begin
      Val (ch[i],n,e);
      t[i] := n;
    End;
End;

Function divis7 (n:String): Boolean;
Var
  t1,t2: tab;
    x,s,i:integer;
Begin
  t2[1] := 1;
  t2[2] := 3;
  t2[3] := 2;
  t2[4] := -1;
  t2[5] := -3;
  t2[6] := -2;
  Repeat
    x := 0;
    s := 0;
    facteur(n,t1);
    For i:=Length(n) Downto 1 Do
      Begin
        x := x+1;
        If (x>6) Then
          x := 1;
        s := s+t1[i]*t2[x];
      End;
    Str (s,n);
  Until (Length(n)<2);
  divis7 := (s=0) Or (s=7);
End;

Procedure traitement (Var f,f7,f13:Text);
Var
  ch: String;
Begin
  Reset (f);
  Rewrite (f7);
  Rewrite (f13);
  While Not (Eof(f)) Do
    Begin
      Readln (f,ch);
      If divis13(ch) Then
        Writeln (f13,ch);
      If divis7(ch) Then
        Writeln (f7,ch);
    End;
  Close (f13);
  Close (f7);
  Close (f);
End;
Begin
  creation (f,f7,f13);
  remplir (f);
    traitement (f,f7,f13);
End.