Program Encryption;
{$APPTYPE CONSOLE}
Type
MyArrayType = array of array of Char;
DirectionType = (dRight, dDown, dLeft, dUp);
Var
Matrix: MyArrayType;
LenMyS, I, J: Integer;
MyString: String;
SizeArray: Integer;
InputText, OutputText, KeyText: TextFile;
Procedure Spiral(var M: MyArrayType; SpirWrite: Boolean; var S: String);
Var
CurStep, Step, PosX, PosY: Integer;
Direction: DirectionType; //îò 1 äî 4 - 1 âïðàâî, 2 âíèç, 3 âëåâî, 4 ââåðõ
I: integer;
Begin
Randomize;
I:=1;
PosX:=round(SizeArray/2)+1;
PosY:=round(SizeArray/2)+1;
CurStep:=1;
Step:=1; //÷åðåç ñêîëüêî øàãîâ ïîâåðíóòü
Direction:=dRight; //íàïðàâëåíèå ñïèðàëè íà ïåðâîì øàãå
if Not SpirWrite {çíà÷èò ÷òåíèå èç ìàññèâà} then S := '';
while (PosX>0) and (PosX<=SizeArray) and (PosY>0) and (PosY<=SizeArray) do
Begin
if SpirWrite then
M[PosX, PosY]:=S[I]
else
S:=S+M[PosX, PosY];
//äâèæåíèå ìàòðèöû ïî ñïèðàëè
case Direction of
dRight: Begin
PosY:=PosY+1;
if CurStep=Step then
Begin
CurStep:=1;
Direction:=dDown;
writeln(KeyText, 'R ',PosY,',',PosX);
End
else
CurStep:=CurStep+1
End;
dDown: Begin
PosX:=PosX+1;
if CurStep=Step then
Begin
CurStep:=1;
Direction:=dLeft;
Step:=Step+1;
writeln(KeyText, 'D ',PosY,',',PosX);
End
else
CurStep:=CurStep+1
End;
dLeft: Begin
PosY:=PosY-1;
if CurStep=Step then
Begin
CurStep:=1;
Direction:=dUp;
writeln(KeyText, 'L ',PosY,',',PosX);
End
else
CurStep:=CurStep+1
End;
dUp: Begin
PosX:=PosX-1;
if CurStep=Step then
Begin
CurStep:=1;
Direction:=dRight;
Step:=Step+1;
writeln(KeyText, 'U ',PosY,',',PosX);
End
else
CurStep:=CurStep+1
End
End;
Inc(I)
End
End;
Procedure CheckAndFixString(var S: String; NeedLength: Integer);
Begin
if (NeedLength>=1) or (NeedLength<=255) then
Begin
if Length(S)>NeedLength then
S:=Copy(S,1,NeedLength)
else
while length(S)<NeedLength do
S:=S + ' '
End
End;
Begin
AssignFile(InputText, 'D:\Ðàáîòû ïî ÎÀèÏ\2 ñåìåñòð\InputString.txt');
Reset(InputText);
AssignFile(KeyText, 'D:\Ðàáîòû ïî ÎÀèÏ\2 ñåìåñòð\Key.txt');
Rewrite(KeyText);
Readln(InputText, MyString);
LenMyS:=length(MyString);
if Trunc(sqrt(LenMyS)) mod 2 = 0 then
SizeArray:=Trunc(sqrt(LenMyS))+1
else
SizeArray:=Trunc(sqrt(LenMyS))+2;
writeln('The required size of the matrix = ',SizeArray,'x',SizeArray);
Setlength(Matrix, SizeArray+1, SizeArray+1);
WriteLn('The length of the string = ',LenMyS);
CheckAndFixString(MyString, sqr(SizeArray));
LenMyS:=length(MyString);
WriteLn('Required the length of the string = ',LenMyS);
Spiral(Matrix, True, MyString);
Assign(OutputText, 'D:\Ðàáîòû ïî ÎÀèÏ\2 ñåìåñòð\SpirOut.txt');
Rewrite(OutputText);
for I:=1 to SizeArray do
Begin
for J:=1 to SizeArray do
Write(OutputText, Matrix[i,j]);
WriteLn(OutputText)
End;
Close(OutputText);
Close(KeyText);
writeln('Press Enter to exit...');
readln;
End.