1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
| const
Lattice: Array [1..8] of Byte = (0,5,8,16,19,20,25,27);
//0-вырез; #-закрытая часть решетки; Сообщение 8x4=32 символа; Выходное сообщение 11х11=121 символ;
//0####0
//##0###
//####0#
//0#0###
//#0#0##
...
function Kardo(Text: String): String;
var i: Byte;
Key: Array [1..8] of Byte;
Buf: String;
////////////////////Вспомогательный процедуры (начало)//////////////////////////
procedure Sort(var Mas: Array of Byte);
var i,j, Buf: Byte;
begin
i:=0;
While i<Length(Mas)-1 do
begin
While (i<Length(Mas)-1) and (Mas[i]<=Mas[i+1]) do Inc(i);
j:=i;
While (Mas[i]>Mas[i+1]) and (i>=0) do
begin
Buf:=Mas[i];
Mas[i]:=Mas[i+1];
Mas[i+1]:=Buf;
Dec(i);
end;
i:=j;
end;
end;
procedure turn6_5;
var i: Byte;
begin
For i:=1 to 8 do
Key[i]:=4-(Key[i] div 6)+5*(Key[i] mod 6); //отнимаем сразу 1, иначе 5-(n div 6)+5*(n mod 6)-1: формула поворота на 90 градусов, везде по такому же принципу рассчитаны коэффициенты, только в кодировании +1;
Sort(Key);
end;
procedure turn5_6;
var i: Byte;
begin
For i:=1 to 8 do
Key[i]:=5-(Key[i] div 5)+6*(Key[i] mod 5);
Sort(Key);
end;
////////////////////Вспомогательный процедуры (конец)///////////////////////////
begin
For i:=1 to 8 do Key[i]:=Lattice[i];
Result:='';
For i:=1 to 121 do Result:=Result+Chr(Random(32)+Ord('а')); //Я реально не помню код буквы "а"
If Length(Text)>32 then
begin
Buf:=Text;
Delete(Buf,1,32);
SetLength(Text,32);
Result:=Result+Kardo(Buf);
end;
//Text:='Наверное,вкаждомдомеестьсвоеВВС.';
While Length(Text)<32 do Text:=Text+' ';
For i:=Low(Key) to High(Key) do
Result[1+(Key[i] mod 6)+11*(Key[i] div 6)]:=Text[i];
turn6_5; //поворачиваем по часовой стрелке так, что из массива 6х5 мы получим 5х6;
For i:=Low(Key) to High(Key) do
Result[7+(Key[i] mod 5)+11*(Key[i] div 5)]:=Text[8+i];
turn5_6; //так же поворачиваем по часовой стрелке, но уже массив из 5х6 мы получим 6х5;
For i:=Low(Key) to High(Key) do
Result[72+(Key[i] mod 6)+11*(Key[i] div 6)]:=Text[16+i];
turn6_5;
For i:=Low(Key) to High(Key) do
Result[56+(Key[i] mod 6)+11*(Key[i] div 6)]:=Text[24+i];
end;
function DeKardo(Text: String): String;
var Key: Array [1..8] of Byte;
i: Byte;
////////////////////Вспомогательный процедуры (начало)//////////////////////////
procedure Sort(var Mas: Array of Byte);
var i,j, Buf: Byte;
begin
i:=0;
While i<Length(Mas)-1 do
begin
While (i<Length(Mas)-1) and (Mas[i]<=Mas[i+1]) do Inc(i);
j:=i;
While (Mas[i]>Mas[i+1]) and (i>=0) do
begin
Buf:=Mas[i];
Mas[i]:=Mas[i+1];
Mas[i+1]:=Buf;
Dec(i);
end;
i:=j;
end;
end;
procedure turn6_5;
var i: Byte;
begin
For i:=1 to 8 do
Key[i]:=4-(Key[i] div 6)+5*(Key[i] mod 6);
Sort(Key);
end;
procedure turn5_6;
var i: Byte;
begin
For i:=1 to 8 do
Key[i]:=5-(Key[i] div 5)+6*(Key[i] mod 5);
Sort(Key);
end;
////////////////////Вспомогательный процедуры (конец)///////////////////////////
begin
For i:=1 to 8 do Key[i]:=Lattice[i];
If Length(Text)<121 then Exit;
Result:='';
For i:=Low(Key) to High(Key) do
Result:=Result+Text[1+(Key[i] mod 6)+11*(Key[i] div 6)];
//Result[1+(Key[i] mod 6)+11*(Key[i] div 6)]:=Text[i]; - как в кодировании;
turn6_5;
For i:=Low(Key) to High(Key) do
Result:=Result+Text[7+(Key[i] mod 5)+11*(Key[i] div 5)];
//Result[7+(Key[i] mod 5)+11*(Key[i] div 5)]:=Text[8+i]; - как в кодировании;
turn5_6;
For i:=Low(Key) to High(Key) do
Result:=Result+Text[72+(Key[i] mod 6)+11*(Key[i] div 6)];
//Result[72+(Key[i] mod 6)+11*(Key[i] div 6)]:=Text[16+i]; - как в кодировании;
turn6_5;
For i:=Low(Key) to High(Key) do
Result:=Result+Text[56+(Key[i] mod 6)+11*(Key[i] div 6)];
//Result[56+(Key[i] mod 6)+11*(Key[i] div 6)]:=Text[24+i]; - как в кодировании;
end;
...
//ну как пользоваться надеюсь все очевидно
procedure TForm1.Button1Click(Sender: TObject);
var BufStr, Text, Buf: String;
i: Byte;
begin
Text:=Kardo('Наверное,вкаждомдомеестьсвоеВВС.');
Buf:=Text;
For i:=1 to 11 do //чтобы была видна сетка 11х11;
begin
BufStr:=Copy(Buf,1,11);
Delete(Buf,1,11);
Memo1.Lines.Add(BufStr);
end;
Text:=DeKardo(Text);
Memo1.Lines.Add('Декодирование: <'+Text+'>');
end; |
(
Сообщение было отмечено Azrael375 как решение
