M1RAI

BAC_PRATIQUE_2017

Jun 25th, 2020
1,532
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..200,1..10] OF char;
  5. var
  6. cle:string;
  7. fs,fc:text;
  8. s:integer;
  9.  
  10.  
  11. function verif(cle:string):Boolean;
  12. VAR i:Byte;
  13. begin
  14.             i:=1;
  15.             while(cle[i] in['A'..'Z']) AND (i<=Length(cle)) Do
  16.                 i:=i+1;
  17.             verif:= i>length(cle);
  18. end;
  19.  
  20. procedure saisie(VAR cle:string);
  21. begin
  22.         repeat
  23.                         write('Veuillez saisir le clé du cryptage:');
  24.                         readln(cle);
  25.         until (length(cle) in[5..10]) AND (verif(cle));
  26. end;
  27.  
  28. procedure espace(x:string;s:integer);
  29. begin
  30.                 if Length(x) mod s <> 0
  31.                 then
  32.                         Repeat
  33.                                     x:=x+' ';
  34.                         until length(x) mod s = 0;
  35. end;
  36.  
  37. procedure rempm(Var M:mat;taille,s:integer;x:string);
  38. var l,c:integer;
  39. begin
  40.                     for l:=1 to taille do
  41.                     begin
  42.                             for c:=1 to s do
  43.                             begin
  44.                                     M[l,c] := x[1];
  45.                                     delete(x,1,1);
  46.                             end;
  47.                     end;
  48. end;
  49.  
  50.  
  51. procedure rempfc(var fc:text;M:MAT;s,taille:integer;cle:string);
  52. Var l,c:integer;
  53. ch,bigboi:string;
  54. begin
  55.         ReWrite(fc);
  56.         bigboi:='';
  57.         for c:= 1 to s do
  58.         begin
  59.                                 for l:=1 to taille do
  60.                                 begin
  61.                                         ch:=ch[c];
  62.                                         ch:= ch + M[l,c];
  63.                                 end;
  64.                                 bigboi:=bigboi + ch;
  65.         end;
  66.         writeln(fc,bigboi);
  67.         close(fc);
  68. end;
  69.  
  70. Procedure crypt_aff(VAR fs,fc:text ; cle:string; s:integer);
  71. Var
  72. M:MAT;
  73. taille:integer;
  74. x,ch,w:string;
  75. begin
  76.             reset(fs);
  77.             while not(eof(fs)) do
  78.             begin
  79.                     readln(fs,x);
  80.                     espace(x,s);
  81.                     taille:= length(x) div s;
  82.                     rempm(M,taille,s,x);
  83.                     rempfc(fc,M,s,taille,cle);
  84.             end;
  85.             close(fs);
  86.             reset(fc);
  87.             while not(eof(fc)) do
  88.             begin
  89.                     readln(fc,w);
  90.                     writeln(w);
  91.             end;
  92.             close(fc);
  93. end;
  94.  
  95.  
  96.  
  97.  
  98. begin
  99.         assign(fs,'C:\Pascal\BAC_PRATIQUE_2017\Source.txt');
  100.         assign(fc,'C:\Pascal\BAC_PRATIQUE_2017\Crypt.txt');
  101.         saisie(cle);
  102.         s:= length(cle);
  103.         Crypt_aff(fs,fc,cle,s);
  104. end.
RAW Paste Data