Шифрование Виженера

[Cubar]

Здравствуйте!
Сейчас делаю программу "Шифрование Виженера" на "Borland Delphi 7.0".
Цель: сделать программу, которая шифрует и дешифрует методом Виженера.

Может у кого-нибудь есть готовая программа или кто-нибудь знает, где можно найти исходник программы?

А так, возникла такая проблема:
На поле 3 компонента: TStringGrid (для ввода ключа, для ввода слова, для зашифрованного или дешифрованного слова); 2 компонента: TButton (для шифрования, для дефифрования).
Нужно сделать так, чтобы при каждой введенной букве в поле "TString", курсор переводился на следующее поле.

Вот код, что у меня получился, но он не так, как надо работает, т.е. при вводе первой буквы в поле, буква в первое поле не вводится, а вводится во второе поле и при переходе в другой компонент "TStringGrid", в последнее поле первого компонента вводится 2 буквы:

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
Case Key of
#192..#255: {маленькие и большие буквы}
If Key<>'' then // нажата клавиша
If StringGrid1.Col<StringGrid1.ColCount-1
then // курсор в следующую ячейку таблицы
StringGrid1.Col:=StringGrid1.Col+1
else // курсор в поле StringGrid2
StringGrid2.SetFocus;
#8:;
else
Key:=Chr (0);
end;
end;

Помогите, кто знает!

[puporev]

Посмотри, эдесь что-то есть.
http://programmersforum.ru/showthrea...E8%ED%E5%F0%E0

[Insainer]

А я на VBA писал, сам, алфавит русский заглавный, пробел это - "_", такой замутный код:

Option Explicit
	Dim i, q, k, w, change, lw, lk, g As Integer
	Dim word, code, sym, symk, key, codesym As String
Private Sub CommandButton1_Click()
code = Empty
word = TextBox1
key = TextBox2
lw = Len(word)
g = 0
lk = Len(key)
	For i = 1 To lw
	sym = Mid$(word, i, 1)
	k = Asc(sym)
		If (g + 1) * lk >= i Then Else g = g + 1
		q = (i - (g * lk))
		symk = Mid$(key, q, 1)
		w = Asc(symk)
		If w = 95 Then w = 33 Else w = w - 191
		If k = 95 Then k = 191 + w Else k = k + w
		If k = 224 Then k = 95 Else If k > 224 Then k = k - 33
	codesym = Chr(k)
	code = code + codesym
	Next i
TextBox1 = code
End Sub
	'Программа дешифрования методом Виженера:
Private Sub CommandButton2_Click()
word = Empty
code = TextBox1
key = TextBox2
g = 0
lk = Len(key)
For i = 1 To lw
sym = Mid$(code, i, 1)
k = Asc(sym)
If (g + 1) * lk >= i Then Else g = g + 1
q = (i - (g * lk))
symk = Mid$(key, q, 1)
w = Asc(symk)
If w = 95 Then w = 33 Else w = w - 191
If k = 95 Then k = 191 - w Else k = k - w
If k = 158 Then k = 95 Else If k = 191 Then k = 95 Else If k < 191 Then k = k_
+ 33 codesym = Chr(k)
word = word + codesym
Next i
TextBox1 = word
End Sub

[Cubar]

Спасибо всем, кто помогал мне.
Puporev, в общем, ничего я там не нашел (там описывается "Шифрование Цезаря").

А программу я все-таки сделал:

Шифрование:

procedure TForm1.Button1Click(Sender: TObject);
Var
res:String;
i,j:Word;
begin
If Edit1.Text='' then
  begin
  ShowMessage ('Не введен "ключ". Продолжение НЕВОЗМОЖНО!');
  Exit;
  end;
If Edit2.Text='' then
  begin
  ShowMessage ('Не введено "слово". Продолжение НЕВОЗМОЖНО!');
  Exit;
  end;
SetLength (res,Length (Edit2.Text)); {Динамически устанавливается длина строки "Edit2.Text" и динамический массив "res"}
i:=1;
j:=1;
Repeat
Res[i]:=Chr (Ord (Edit2.Text[i])+Ord(Edit1.Text[j]));
Inc (i);
Inc(j);
If j>length (Edit1.Text) then
j:=1;
Until i>Length (Edit2.Text);
Edit3.Text:=res;
end;

Дешифрование:

procedure TForm1.Button2Click(Sender: TObject);
Var
text:String;
i,j:Word;
begin
If Edit1.Text='' then
  begin
  ShowMessage ('Не введен "ключ". Продолжение НЕВОЗМОЖНО!');
  Exit;
  end;
If Edit2.Text='' then
  begin
  ShowMessage ('Не введено "слово". Продолжение НЕВОЗМОЖНО!');
  Exit;
  end;
SetLength (text,Length (Edit2.Text));
i:=1;
j:=1;
Repeat
text[i]:=Chr(Ord (Edit2.Text[i])-Ord (Edit1.Text[j]));
Inc(i);
Inc(j);
If j>Length (Edit1.Text)then
j:=1;
Until i>Length (Edit2.Text);
Edit4.Text:=text;
end;

[puporev]

Puporev, в общем, ничего я там не нашел (там описывается "Шифрование Цезаря").

Но от Stringgrida то ты отказался? А это был главный вопрос темы.

[Karyuudo]

Помогите, с алгоритмом тем что выше, так же с тем что и щас выложу проблема возникла, незнаю что делать.. всётоже, только текст пишется в мемо, вообщем при вводе некоторых символов, например буква ц в ключе, урезает число строк, которые шифруются, например вместо 10 строчек 1-3
вот алгоритм по которому шифруется:
procedure TForm1.Button1Click(Sender: TObject);
Var i:integer;s,k:string;
begin
S:=memo1.Text;
k:=Edit2.Text;
for i := 1 to Length(s) do
s[i]:=Chr( Ord(s[i])+Ord(k[i mod length(k)+1]));
memo2.Text:=s
end;
причем он глючит не всегда а только иногда и если текст длинный, в коротких текстах иногда не глючит.. вот например ввел длиннющий текст, и сделал ключ солне и все прекрасно работает.. а если добавить ц, будет уже обрезаться... например если сделать солнце, то он зашифрует только 1 строчку.. (всего их там около 40+пробелы между ними)

[mihali4]

Метод вижинера
http://www.programmersforum.ru/showthread.php?t=10763
http://www.programmersforum.ru/showthread.php?t=7853
У вас, видимо, поиск по форуму ну ни в какую?

[salima]

Подскажите пожалуйста с задачей :чтобы зашифровать текст из 121 букв, его можно записать в квадратную матрицу порядка 11 по строкам, а затем прочитать по спирали, начиная с центра (т.е. с элемента, имеющего индексы 6,6).
• Зашифровать данный текст.
• Расшифровать данный текст
с чего начать?

[Serge_Bliznykov]

ой, преподы придумывают одно и то же...
Это я уже когда-то писал.
Ниже программа шифрации, результат помещает в файл SpirOut.txt

разбирайтесь:

const
  SizeArray = 11;
type 
  MyArrayType = array [1..SizeArray, 1..SizeArray] of string[1];
  DirectionType = (dRight, dDown, dLeft, dUp);

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
  i := 1;
  PosX := 6;  {round(SizeArray/2)}
  PosY := 6;
  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;
               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;
  f      : text;

begin
  myS := '1234567890 This is just my favorite tesing string - you need very long string!';

  i:= length( myS );
  WriteLn('len S =',i);

  DoCheck_and_Fix_String( myS, 121);

  i:= length( myS );
  WriteLn('len (fixed)=',i);

  Spiral(Matrix, true, myS );

  {выведем матрицу с помещенным туда текстом в текстовый файл} 
  Assign(f, 'SpirOut.txt');
  Rewrite(f);
  for i:=1 to 11 do 
    begin
      for j:=1 to 11 do
        Write(f, Matrix[i,j]);
      WriteLn(f);
    end;   
  Close(f);
end.

[Alter]

Без исходника, потому-как там достаточно просто, обычное сканирования матрицы: http://www.programmersforum.ru/attac...9&d=1213033151