Program S8 ;
Type
tab = array[1..255] Of integer;
Var
ch : string;
Tk : tab;
//**************************************
Function verif(ch:String) : boolean;
Var
ok : boolean;
i : integer;
Begin
ok := true;
i := 1;
While (ok) And (i<=length(ch)) Do
If (ch[i] In ['A'..'Z']) Then
i := i+1
Else
ok := false;
verif := ok;
End;
//**************************************
Function occurrence(c:char; ch:String) : integer;
Var
i,occ : integer;
Begin
occ := 0;
For i:=1 To length(ch) Do
If (c=ch[i]) Then
occ := occ+1;
occurrence := occ;
End;
//**************************************
Procedure valeurK(ch:String; Var Tk:tab);
Var
i : integer;
Tocc : tab;
Begin
For i:=1 To length(ch) Do
Tocc[i] := occurrence(ch[i],ch);
For i:=1 To length(ch) Do
If (Tocc[i] Mod 2=0) Then
Tk[i] := Tocc[i] Div 2
Else
Tk[i] := Tocc[i]*2;
End;
//**************************************
Function remplacement(ch:String;Tk:tab) : string;
Var
chres : string;
i,v,d : integer;
Begin
chres := '';
For i:=1 To length(ch) Do
Begin
v := ord(ch[i])+Tk[i];
If (v>(65+25)) Then
Begin
d := v-(65+26);
chres := chres+chr(65+d) ;
End
Else
chres := chres+chr(v);
End;
remplacement := chres;
End;
//**************************************
Begin
Repeat
write('Saisir une chaîne ch: ') ;
readln(ch);
Until (length(ch)>0) And (verif(ch));
valeurK(ch,Tk);
writeln;
writeln('-----------------------------------------');
writeln;
writeln('Le mot crypté: ',remplacement(ch,Tk));
writeln;
writeln('------------------------------------------');
End.
Inscription à :
Publier les commentaires (Atom)
