| Vladimir_S |
16.02.2014 10:30 |
Вложений: 2
Цитата:
Сообщение от mariafs
(Сообщение 1004990)
Очень-очень нужна помощь. У меня в распоряжении только сутки(
|
Да в общем-то нет проблем, вот только... Вы (а точнее Ваши преподы), я надеюсь, понимаете, что обратно расшифровать зашифрованный таким образом текст в принципе невозможно, поскольку различить гласную (ну или там запятую), которая не изменилась при шифровании, и гласную, которая явилась результатом сдвига кода согласной, невозможно. Ну раз это не требуется... Да, и еще одно. Я, извините, сделал для латиницы, потому что с кириллицей заморачиваться мне довольно муторно (у меня DOS-кодировка). Но если Вам нужна кириллица, просто перенабейте константу-множество, записав туда русские буквы. Или добавьте их. Ну и пути к файлам (где у меня обращение к диску D) поставьте свои.
Код:
Const
Consonant=['b','c','d','f','g','h','j','k','l','m','n','p',
'q','r','s','t','v','w','x','z','B','C','D','F',
'G','H','J','K','L','M','N','P','Q','R','S','T',
'V','W','X','Z'];
Var
f1,f2:Text;
S:String;
i:Byte;
YN:Char;
Function Change(C:Char):Char;
begin
If C in Consonant then Change:=CHR(ORD(C)-5) else Change:=C;
end;
Procedure Coding;
begin
ReSet(f1);
ReWrite(f2);
Repeat
If Not(EoF(f1)) then
begin
Readln(f1,S);
for i:=1 to Length(S) do Write(f2,Change(S[i]));
Writeln(f2);
end;
Until EoF(f1);
Close(f1);
Close(f2);
end;
Procedure Show(var fx:Text);
begin
Writeln;
ReSet(fx);
Repeat
Readln(fx,S);
Writeln(S);
Until EoF(fx);
Close(fx);
end;
Begin
Assign(f1,'D:\Inp.txt');
Assign(f2,'D:\Out.txt');
Coding;
Write('Show the input file (Y/N)? ');
Readln(YN);
If (YN='Y') or (YN='y') then Show(f1);
Writeln;
Write('Show the encoded file (Y/N)? ');
Readln(YN);
If (YN='Y') or (YN='y') then
begin
Show(f2);
Readln;
end;
End.
|
