Форум программистов, компьютерный форум, киберфорум
Наши страницы

Delphi для начинающих

Войти
Регистрация
Восстановить пароль
 
anyakrg
0 / 0 / 0
Регистрация: 22.10.2012
Сообщений: 183
#1

Шифрования текста методом замены - Delphi

23.04.2014, 21:06. Просмотров 1069. Ответов 3
Метки нет (Все метки)

Мне надо, чтобы эта программа, шифровала текст, на русском или английском языке (для каждого есть файл с часто встречающимися словами), и чтобы по выбору в ЛистБоксе, она выбирала один из языков
и шифровала текст методом замены

у меня есть код программы, который просто шифрует и дешифрует
но ее надо СРОЧНО переделать
Delphi
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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
unit SimpleSubstitution;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ValEdit, StdCtrls, XPMan;
 
type
  TRusDstAlphabet = array [Char] of Char;
 
  TfmSubstitution = class(TForm)
    mmDecryptMessage: TMemo;
    mmEncryptMessage: TMemo;
    lbDecryptMessage: TLabel;
    lbEncryptMessage: TLabel;
    btnEncryptMessage: TButton;
    btnDecpyptMessage: TButton;
    btnGenRearrangement: TButton;
    vleSubst: TValueListEditor;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure btnGenRearrangementClick(Sender: TObject);
    procedure btnEncryptMessageClick(Sender: TObject);
    procedure btnDecpyptMessageClick(Sender: TObject);
  private
    { Private declarations }
    RusDstAlphabet: TRusDstAlphabet;
    procedure GenRearrangment;
    function  ValidateRearrangement: Boolean;
    function  UpCaseRus(Ch: Char): Char;
    function  LowCaseRus(Ch: Char): Char;
    procedure RecalcAlphabet(nKey: Integer);
    function  EncryptDecryptString(strMsg: String): String;
  public
    { Public declarations }
  end;
 
var
  fmSubstitution: TfmSubstitution;
 
implementation
 
{$R *.dfm}
 
// функция генерации случайной перестановки
procedure TfmSubstitution.GenRearrangment;
var
  Ch, c: char;
  // нужен для определения встречался ли символ ранее
  WasGen: array [Char] of Boolean;
begin
  // заполняем массив значением False
  FillChar(WasGen, SizeOf(WasGen), False);
  for Ch := 'А' to 'Я' do
    begin
      // генерируем случайный символ до тех пор, пока
      // не будет получен еще не сгенерированный
      repeat
        c := Chr(Ord('А') + random(32));
      until not WasGen[c];
      // помечаем, что символ сгенерирован
      WasGen[c] := True;
      vleSubst.Values[Ch] := c;
    end;
end;
 
// проверяет корректность перестановки введенной пользователем
function TfmSubstitution.ValidateRearrangement: Boolean;
var
  i: Integer;
  s: String;
  Used: array [Char] of Boolean;
begin
  Result := False;
  FillChar(Used, SizeOf(Used), False);
  for i := 1 to vleSubst.RowCount - 1 do
    Begin
      // символ единственный в строчке?
      s := vleSubst.Cells[1, i];
      if (Length(s) <> 1) then
        Exit;
      // символ - буква русского языка?
      s[1] := UpCaseRus(s[1]);
      if not (s[1] in ['А'..'Я']) then
        Exit;
      // уже встречался ранее?
      if Used[s[1]] then Exit;
      Used[s[1]] := True;
    End;
  Result := True;
end;
 
function TfmSubstitution.UpCaseRus(Ch: Char): Char;
begin
  if Ch = 'ё' then Ch := 'Е';
  if Ch in ['а'..'я'] then Dec(Ch, 32);
  Result := Ch;
end;
 
function TfmSubstitution.LowCaseRus(Ch: Char): Char;
begin
  if Ch = 'Ё' then Ch := 'е';
  if Ch in ['А'..'Я'] then Inc(Ch, 32);
  Result := Ch;
end;
 
procedure TfmSubstitution.FormCreate(Sender: TObject);
var
  Ch: char;
begin
  Randomize;
  // инициализация редактора значений
  for Ch := 'А' to 'Я' do
    vleSubst.InsertRow(Ch, '', True);
  // генерация случайной перестанвки
  GenRearrangment;
end;
 
procedure TfmSubstitution.btnGenRearrangementClick(Sender: TObject);
begin
  GenRearrangment;
end;
 
procedure TfmSubstitution.btnEncryptMessageClick(Sender: TObject);
var
  i: Integer;
begin
  // проверяем корректность ввода перестановки
  if ValidateRearrangement then
    begin
      // создаем алфавит преобразования открытого текста
      RecalcAlphabet(0);
      // предотвращаем перерисовку компонента до тех пор, пока не
      // зашифруем все строчки сообщения
      mmEncryptMessage.Lines.BeginUpdate;
      // очищаем текстовый редактор
      mmEncryptMessage.Clear;
      // шифруем открытый текст построчно
      for i := 0 to mmDecryptMessage.Lines.Count - 1 do
        mmEncryptMessage.Lines.Add(EncryptDecryptString(mmDecryptMessage.Lines[i]));
      // разрешаем перерисовку компонента
      mmEncryptMessage.Lines.EndUpdate;
    end
  else
    MessageDlg('Ошибка: символы подстановки заданы не верно', mtError, [mbOk], 0);
end;
 
procedure TfmSubstitution.btnDecpyptMessageClick(Sender: TObject);
var
  i: Integer;
begin
  // проверяем корректность ввода перестановки
  if ValidateRearrangement then
    begin
      // создаем алфавит преобразования шифрованного текста
      RecalcAlphabet(1);
      mmDecryptMessage.Lines.BeginUpdate;
      mmDecryptMessage.Clear;
      // дешифруем шифрованный текст построчно
      for i := 0 to mmEncryptMessage.Lines.Count - 1 do
        mmDecryptMessage.Lines.Add(EncryptDecryptString(mmEncryptMessage.Lines[i]));
      mmDecryptMessage.Lines.EndUpdate;
    end
  else
    MessageDlg('Ошибка: символы подстановки заданы не верно', mtError, [mbOk], 0);
end;
 
procedure TfmSubstitution.RecalcAlphabet(nKey: Integer);
var
  Ch: Char;
  i: Integer;
begin
  // предварительно все символы в алфавите шифрования
  // соответствуют символам из незашифрованного алфавита
  for Ch := Low(RusDstAlphabet) to High(RusDstAlphabet) do
    RusDstAlphabet[Ch] := Ch;
  // формируем алфавит отдельно для каждого из регистров букв
  // здесь для верхнего
  for i := 1 to vleSubst.RowCount - 1 do
    RusDstAlphabet[vleSubst.Cells[nKey, i][1]] := vleSubst.Cells[1 - nKey, i][1];
  // здесь для нижнего
  for i := 1 to vleSubst.RowCount - 1 do
    RusDstAlphabet[LowCaseRus(vleSubst.Cells[nKey, i][1])] :=
        LowCaseRus(vleSubst.Cells[1 - nKey, i][1]);
end;
 
function TfmSubstitution.EncryptDecryptString(strMsg: String): String;
var
  i: Integer;
begin
  // преобразуем строчку посимвольно
  for i := 1 to Length(strMsg) do
    strMsg[i] := RusDstAlphabet[strMsg[i]];
  Result := strMsg;
end;
 
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
23.04.2014, 21:06
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Шифрования текста методом замены (Delphi):

Программа шифрования и дешифрования файла методом простой замены - Delphi
Очень нужно написать программу шифрования и дешифрования файла методом простой замены. Для доступа к файлу необходимо запрашивать пароль. К...

Делфи шифрования текста методом Тритемиуса - Delphi
Люди, срочно помогите, нашел программу которая расшифровывается драные введение в тексбокс, мне нужно что бы она зашифровывал, уже целых 5...

Шифрование текста методом замены букв - Delphi
Помогите написать код: при нажатии на кнопку в окне memo должны меняться символы, например: из РТЙЧЕФ в привет, дана таблица символов: ...

Шифрования текста - Delphi
Здравствуйте. Столкнулся с такой проблемой, что примеры шифрования, например xor, что я сумел найти в интернете, шифруют некоторые...

Программа шифрования и дешифрования текста - Delphi
Ребята заканчиваю учиться на программиста! До диплома осталось 3 дня помогите пожалуйста программой для шифрования текста и дешифрования!...

Шифрование строки методом циклической замены - Delphi
Дана строка - предложение на украинском языке и число k (0 &lt; k &lt; 10). Зашифровать строку , выполнив циклическую замену каждой буквы на...

3
Worf
43 / 43 / 6
Регистрация: 06.02.2014
Сообщений: 233
23.04.2014, 21:16 #2
К чему переделка кода, когда написать свой намного проще и быстрее!
Делаешь 2 массива символов для латиницы и киррилицы и 2 массива с заменой, в зависимости от выбранного пункта будешь юзать разный массив и всё.
В цикле по символу прогоняешь его по массиву и, в зависимости от совпадения, заменяешь альтернативным с другого массива и не надо будет столько кода писать.
0
anyakrg
0 / 0 / 0
Регистрация: 22.10.2012
Сообщений: 183
23.04.2014, 21:38  [ТС] #3
Worf, ну вот просто маленькая проблема, что в основной программе у меня выполняется дешифрование
т.е. нам известен шифр (то есть какая буква какой была заменена)
0
Worf
43 / 43 / 6
Регистрация: 06.02.2014
Сообщений: 233
24.04.2014, 04:13 #4
Ну, и в чём тогда проблема, дешиврование делаешь по обратному принципу, то есть цикл по массиву замен
0
24.04.2014, 04:13
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.04.2014, 04:13
Привет! Вот еще темы с ответами:

Простое шифрование методом замены символов - Delphi
Всем привет. Нужна помощь в написании программы, которая бы шифровала и расшифровывала мой текст. Метод очень простой - замена...

Создать приложение для шифрования/дешифрования файла ASCII методом - Delphi
Необходимо создать приложение для шифрования/дешифрования файла ASCII методом в Delphi. Так же должен присутствовать исходный код...

Прогрмама для замены текста - Delphi
Помогите кто чем может, нужен мануал или если кто то знает (напишите в лс ) как написать программу которая будет заменят текст в...

Реализация поиска и замены текста - Delphi
Использую компонент TRichEdit, для поиска и замены использую TFindDialog, TReplaceDialog. Нашла в интернете такую процедуру: ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru