Arfizato

hobi

Jun 25th, 2020
1,535
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. Function verif(ch:String): Boolean;
  11. Var
  12.   i: Integer;
  13. Begin
  14.   i := 1;
  15.   While (i<=Length(ch)) And (ch[i] In ['A'..'Z']) Do
  16.     i := i+1;
  17.   verif := i>Length(ch);
  18. End;
  19. Function distinct(ch:String): Boolean;
  20. Var
  21.   v: Boolean;
  22.   i: Integer;
  23. Begin
  24.   i := 1;
  25.   Repeat
  26.     i := i+1;
  27.     v := Pos(ch[i],Copy(ch,1,i-1))=0;
  28.   Until Not(v) Or (i=Length(ch));
  29.   distinct := v;
  30. End;
  31. Procedure saisie( Var cle:String);
  32. Begin
  33.   Repeat
  34.     Write(
  35.         'saisir un mot cle constituee de lettres majuscules distinctes de longueur entre 5 et 10 : '
  36.     );
  37.     Readln(cle);
  38.   Until (Length(cle)>=5) And (Length(cle)<=10) And (verif(cle)) And (distinct(cle));
  39. End;
  40. Procedure affmat(m:mat;l,c:Integer);
  41. Var
  42.   i,j: Integer;
  43. Begin
  44.   For i:= 1 To l Do
  45.     Begin
  46.       For j:= 1 To c Do
  47.         Write(m[l,c]);
  48.     End;
  49.         writeln;
  50. End;
  51. Procedure rempm(Var m:mat;Var fcr:Text;i:Integer;Var l:Integer);
  52. Var
  53.   j,c: Integer;
  54.   ch: String;
  55. Begin
  56.   Reset(fcr);
  57.     ReWrite(f);
  58.   l := 1;
  59.     WRITELN(i);
  60.   While Not Eof(fcr) Do
  61.     Begin
  62.        
  63.       Readln(fcr,ch);
  64.             //writeln('s');
  65.       While ((Length(ch)) Mod I <>0) Do                    
  66.         ch := ch+' ';
  67.      
  68.           For c:= 1 To i Do
  69.             Begin
  70.               m[C,L] := ch[1];
  71.                             delete(ch,1,1);
  72.                             write(m[c,l]:4);
  73.               If (c=i) Then
  74.                             BEGIN
  75.                                 writeln;
  76.                 l := l+1;
  77.                             end;
  78.                             //writeln(l);
  79.             End;
  80.        
  81.     End;
  82.         //affmat(m,l,i);
  83.   Close(fcr);
  84.     close(f);
  85. End;
  86.  
  87. Procedure rempf(Var f:Text;m:mat;cle:String;l,c:Integer);
  88. Var
  89.   ch: String;
  90.   q,j,i: Integer;
  91. Begin
  92.   Rewrite(f);
  93.   ch := '';
  94.   For q:= 1 To c Do
  95.     Begin
  96.       For i:= 1 To c Do
  97.         Begin
  98.           ch := ch+cle[q];
  99.           For j:=1 To l Do
  100.             ch := ch+m[c,l];
  101.         End;
  102.     End;
  103.   Close(f);
  104. End;
  105.  
  106. Procedure crypter(Var m:mat;Var fcr,f:Text;cle:String;Var l:Integer);
  107. Begin
  108.   rempm(m,fcr,Length(cle),l);
  109.             //writeln('d');
  110.   //rempf(f,m,cle,l,Length(cle));
  111.             //writeln('qqqs');
  112. End;
  113. Procedure affiche(Var f:Text);
  114. Var
  115.   ch: String;
  116. Begin
  117.   Reset(f);
  118.   While (Not(Eof(f))) Do
  119.     Begin
  120.       Readln(f,ch);
  121.       Writeln(ch);
  122.     End;
  123.   Close(f);
  124. End;
  125.  
  126. Begin
  127.   Assign(fcr,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\Source.txt');
  128.   Assign(f,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\Crypt.txt');
  129.   saisie(cle);
  130.   crypter(M,fcr,f,cle,l);
  131.             //writeln('s');
  132.     //affmat(m,l,Length(cle));
  133.             //writeln('sqqq');
  134.   affiche(f);
  135.             //writeln('ZAZA');
  136. End.
RAW Paste Data