Решаем задачи Абрамян на Паскале. Text60

Text60. Дана строка и файл с русским текстом, зашифрованным по правилу, описанному в задании Text59. Данная строка представляет собой первую расшифрованную строку текста. Расшифровать остальные строки и заменить в файле зашифрованный текст на расшифрованный. Если информации для расшифровки недостаточно, то исходный файл не изменять.

Решение:

program Text60;
var
  F_in,F_out: Text;
  Name,S,SKey,STemp:string;
  C:Char;
  i:integer;

Function Key(Code,EnCode:Char):Char;
var
 itemp:integer;
begin
  if (ord(Code) in [224..239]) and (ord(EnCode) in [224..239]) then
   begin
    itemp:=ord(Code)-ord(EnCode);
    if itemp<0 then itemp:=itemp+31;
   end
  else
  if (ord(Code) in [160..175,224..239]) and (ord(EnCode) in [160..175,224..239]) then
   begin
    itemp:=ord(Code)-ord(EnCode);
    if itemp>49 then itemp:=itemp-49;
    if itemp<0 then itemp:=itemp+79;
   end
  else itemp:=-1;

if itemp<>-1 then
   begin
    Key:=chr(48+itemp);
   end
  else
   Key:='-';
end;

Function EnCode(C,pos:char): char;
var
 N,error:integer;
 i:Integer;
begin
 val(pos,N,error);
 for i:=1 to N do
  begin
   if (ord(C) in [129..159,161..175,225..239]) then C:=chr(ord(C)-1)
    else if (ord(C)=128) then C:=chr(159)
    else if (ord(C)=160) then C:=chr(239)
    else if (ord(C)=224) then C:=chr(175);
   end;
  EnCode:=C;
 end;

begin
 Write('S: ');
 Readln(S);
 Write('File name: ');
 Readln(Name);

Assign(F_in,Name);
 Reset(F_in);

SKey:='----------';
 i:=0;
 While not eoln(F_in) do
  begin
   Read(F_in,C);
   inc(i);
   SKey[(i-1 mod 10)+1]:=Key(C,S[(i-1 mod 10)+1]);
  end;

Close(F_in);
 Reset(F_in);
 Assign(F_out,'~'+Name);
 Rewrite(F_out);

While not eof(F_in) do
  begin
   i:=0;
   While not eoln(F_in) do
    begin
     inc(i);
     Read(F_in,C);
     C:=EnCode(C,SKey[((i-1) mod 10)+1]);
     Write(F_out,C);
    end;
   Readln(F_in);
   Writeln(F_out);
  end;
 Close(F_in);
 Close(F_out);
end.

program Text60;

var

F_in,F_out: Text;

Name,S,SKey,STemp:string;

C:Char;

i:integer;

Function Key(Code,EnCode:Char):Char;

var

itemp:integer;

begin

if (ord(Code) in [224..239]) and (ord(EnCode) in [224..239]) then

begin

itemp:=ord(Code)-ord(EnCode);

if itemp<0 then itemp:=itemp+31;

end

else

if (ord(Code) in [160..175,224..239]) and (ord(EnCode) in [160..175,224..239]) then

begin

itemp:=ord(Code)-ord(EnCode);

if itemp>49 then itemp:=itemp-49;

if itemp<0 then itemp:=itemp+79;

end

else itemp:=-1;

if itemp<>-1 then

begin

Key:=chr(48+itemp);

end

else

Key:='-';

end;

Function EnCode(C,pos:char): char;

var

N,error:integer;

i:Integer;

begin

val(pos,N,error);

for i:=1 to N do

begin

if (ord(C) in [129..159,161..175,225..239]) then C:=chr(ord(C)-1)

else if (ord(C)=128) then C:=chr(159)

else if (ord(C)=160) then C:=chr(239)

else if (ord(C)=224) then C:=chr(175);

end;

EnCode:=C;

end;

begin

Write('S: ');

Readln(S);

Write('File name: ');

Readln(Name);

Assign(F_in,Name);

Reset(F_in);

SKey:='----------';

i:=0;

While not eoln(F_in) do

begin

Read(F_in,C);

inc(i);

SKey[(i-1 mod 10)+1]:=Key(C,S[(i-1 mod 10)+1]);

end;

Close(F_in);

Reset(F_in);

Assign(F_out,'~'+Name);

Rewrite(F_out);

While not eof(F_in) do

begin

i:=0;

While not eoln(F_in) do

begin

inc(i);

Read(F_in,C);

C:=EnCode(C,SKey[((i-1) mod 10)+1]);

Write(F_out,C);

end;

Readln(F_in);

Writeln(F_out);

end;

Close(F_in);

Close(F_out);

end.

Другие задачи из раздела Text можно посмотреть здесь.

Комментарии 1

var
  s, n, st, sc: string;
  f: text;
  c: char;
  i, cx, x, err: integer;
  a: array [1..10] of integer;

begin
  readln(s);
  readln(n);
  assign(f, n);
  reset(f);
  readln(f, st);
  for i := 1 to length(s) do
  begin
    inc(cx);
    if (ord(s[i]) >= 1072) and (ord(s[i]) <= 1103) then
      if ord(st[i]) - ord(s[i]) < 0 then
        a[cx] := (ord(st[i]) - 1071) + (1103 - ord(s[i]))
      else
        a[cx] := ord(st[i]) - ord(s[i]);
    if (ord(s[i]) >= 1040) and (ord(s[i]) <= 1071) then
      if ord(st[i]) - ord(s[i]) < 0 then
        a[cx] := (ord(st[i]) - 1039) + (1071 - ord(s[i]))
      else
        a[cx] := ord(st[i]) - ord(s[i]);
    if cx = 10 then cx := 0;
  end;
  s := '';
  for i := 1 to 10 do 
  begin
    str(a[i], st);
    s := s + st;
  end;
  reset(f);
  while not eof(f) do
  begin
    cx := 0;
    while not eoln(f) do
    begin
      read(f, c);
      inc(cx);
      sc := copy(s, cx, 1);
      val(sc, x, err);
      if (ord(c) >= 1072) and (ord(c) <= 1103) then
        if ord(c) - x < 1072 then 
          c := chr(1103 - (x - (ord(c) - 1071)))
        else 
          c := chr(ord(c) - x);
      if (ord(c) >= 1040) and (ord(c) <= 1071) then 
        if ord(c) - x < 1040 then 
          c := chr(1071 - (x - (ord(c) - 1039)))
        else
          c := chr(ord(c) - x);
      write(c);
      if cx = 10 then cx := 0;
    end; 
    readln(f);
    writeln;
  end;
end.

var

s, n, st, sc: string;

f: text;

c: char;

i, cx, x, err: integer;

a: array [1..10] of integer;

begin

readln(s);

readln(n);

assign(f, n);

reset(f);

readln(f, st);

for i := 1 to length(s) do

begin

inc(cx);

if (ord(s[i]) >= 1072) and (ord(s[i]) <= 1103) then

if ord(st[i]) - ord(s[i]) < 0 then

a[cx] := (ord(st[i]) - 1071) + (1103 - ord(s[i]))

else

a[cx] := ord(st[i]) - ord(s[i]);

if (ord(s[i]) >= 1040) and (ord(s[i]) <= 1071) then

if ord(st[i]) - ord(s[i]) < 0 then

a[cx] := (ord(st[i]) - 1039) + (1071 - ord(s[i]))

else

a[cx] := ord(st[i]) - ord(s[i]);

if cx = 10 then cx := 0;

end;

s := '';

for i := 1 to 10 do

begin

str(a[i], st);

s := s + st;

end;

reset(f);

while not eof(f) do

begin

cx := 0;

while not eoln(f) do

begin

read(f, c);

inc(cx);

sc := copy(s, cx, 1);

val(sc, x, err);

if (ord(c) >= 1072) and (ord(c) <= 1103) then

if ord(c) - x < 1072 then

c := chr(1103 - (x - (ord(c) - 1071)))

else

c := chr(ord(c) - x);

if (ord(c) >= 1040) and (ord(c) <= 1071) then

if ord(c) - x < 1040 then

c := chr(1071 - (x - (ord(c) - 1039)))

else

c := chr(ord(c) - x);

write(c);

if cx = 10 then cx := 0;

end;

readln(f);

writeln;

end;

end.

Ответить

Решаем задачи Абрамян на Паскале. Text60

Комментарии:

Комментарии 1

Добавить комментарий Отменить ответ