belazzzmotors
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
народ!помогите мне,дураку,курсовую доделать.эта программа строку,состоящую из 121 символа,зашифровывает в матрицу,начиная с центра матрицы.а мне еще нужно,чтобы она обратно расшифровывала матрицу в строку.помогите,пожалуйста!вот прога:
type
MyArrayType = array [1..11, 1..11] of string;
DirectionType = (dRight, dDown, dLeft, dUp);
procedure Spiral(var M : MyArrayType; SpirWrite : boolean; var S : string);
var
CurStep, Step, PosX, PosY : integer;
Direction : DirectionType;
i: integer;
BEGIN
i := 1;
PosX := 6;
PosY := 6;
CurStep := 1;
Step := 1;
Direction := dRight;
if Not SpirWrite then S := '';
while (PosX>0) and (PosX<=11) and (PosY>0) and (PosY<=11) 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;
end else
CurStep := CurStep + 1;
end; dDown :
begin
PosX := PosX + 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dLeft;
Step := Step + 1;
end else
CurStep := CurStep + 1;
end; dLeft :
begin
PosY := PosY - 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dUp;
end else
CurStep := CurStep + 1;
end; dUp :
begin
PosX := PosX - 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dRight;
Step := Step + 1;
end else
CurStep := CurStep + 1;
end;
end;
inc(i);
end;
END;
procedure DoCheck_and_Fix_String( var S : string; NeedLength : integer);
BEGIN
if (NeedLength<1) or (NeedLength>255) then Exit;
if Length(S) > NeedLength then
S := Copy(S,1, NeedLength)
else
while length(S)<NeedLength do S := S + ' ';
END;
var
Matrix : MyArrayType;
i, j : integer;
myS : string;
fd,fz : text;
BEGIN
Assign(fd,'D:\pascal\kurs.dat');
Assign(fz,'D:\pascal\kurs.res');
reset(fd);
Rewrite(fz);
read(fd,myS);
DoCheck_and_Fix_String( myS, 121);
Spiral(Matrix, true, myS );
for i:=1 to 11 do
begin
for j:=1 to 11 do
Write(fz, Matrix[i,j]);
writeln(fz);
end;
Close(fd);
close(fz);
END. |
