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.     );
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
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
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