Arfizato

sa

Jun 25th, 2020
1,360
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Program Cryptage;
  2. Uses Wincrt;
  3. Type
  4.   mat = Array[1..20,1..10] Of Char;
  5. Var
  6.   f,fcr: Text;
  7.   cle: String;
  8.   m: mat;
  9.   l: Integer;
  10.  
  11. Function verif(ch:String): Boolean;
  12. Var
  13.   i: Integer;
  14. Begin
  15.   i := 1;
  16.   While (i<=Length(ch)) And (ch[i] In ['A'..'Z']) Do
  17.     i := i+1;
  18.   verif := i>Length(ch);
  19. End;
  20.  
  21. Function distinct(ch:String): Boolean;
  22. Var
  23.   v: Boolean;
  24.   i: Integer;
  25. Begin
  26.   i := 1;
  27.   Repeat
  28.     i := i+1;
  29.     v := Pos(ch[i],Copy(ch,1,i-1))=0;
  30.   Until Not(v) Or (i=Length(ch));
  31.   distinct := v;
  32. End;
  33.  
  34. Procedure saisie( Var cle:String);
  35. Begin
  36.   Repeat
  37.     Write(
  38.         'saisir un mot cle constituee de lettres majuscules distinctes de longueur entre 5 et 10 : '
  39.     );
  40.     Readln(cle);
  41.   Until (Length(cle)>=5) And (Length(cle)<=10) And (verif(cle)) And (distinct(cle));
  42. End;
  43.  
  44. Procedure rempm(Var m:mat;Var fcr:Text;i:Integer;Var l:Integer);
  45. Var
  46.   j,c: Integer;
  47.   ch: String;
  48. Begin
  49.   Reset(fcr);
  50.   l := 1;
  51.   While Not Eof(fcr) Do
  52.     Begin
  53.       Readln(fcr,ch);
  54.       While (i Mod (Length(ch))<>0) Do
  55.         ch := ch+' ';
  56.       For j:=1 To Length(ch) Do
  57.         Begin
  58.           For c:= 1 To i Do
  59.             Begin
  60.               m[c,l] := ch[j];
  61.               If (c=i) Then
  62.                 l := l+1;
  63.             End;
  64.         End;
  65.     End;
  66.   Close(fcr);
  67. End;
  68.  
  69. Procedure crypter(Var m:mat;Var fcr,f:Text;cle:String;Var l:Integer);
  70. Begin
  71.   Rewrite(f);
  72.   rempm(m,fcr,Length(cle),l);
  73.   Close(f);
  74. End;
  75.  
  76. Procedure affiche(Var f:Text);
  77. Var
  78.   ch: String;
  79. Begin
  80.   Reset(f);
  81.   While (Not(Eof(f))) Do
  82.     Begin
  83.       Readln(f,ch);
  84.       Writeln(ch);
  85.     End;
  86.   Close(f);
  87. End;
  88.  
  89. Procedure affmat(m:mat;l,c:Integer);
  90. Var
  91.   i,j: Integer;
  92. Begin
  93.   For i:= 1 To l Do
  94.     Begin
  95.       For j:= 1 To c Do
  96.         Writeln(m[l,c]);
  97.     End;
  98. End;
  99. Begin
  100. assign(fcr,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\Source.txt');
  101. assign(f,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\Crypt.txt');
  102. ReWrite(fcr);
  103. close(fcr);
  104.   saisie(cle);
  105.   crypter(M,fcr,f,cle,l);
  106.   affmat(m,l,Length(cle));
  107.   affiche(f);
  108. End.
RAW Paste Data