Курсовой проект

fabregaz · #1 02.05.2011, 19:17

Задача проекта написать программу, которая позволяет кодировать и декодировать сообщения, заданными способами, например "Шифр Цезаря".
Проблема в том, что я не знаю как это реализовать т.е. как в программу вставить нужный программный код. Если ещё проще, то как сделать так, чтобы после нажатия на кнопку введёный текст зашифровывался?
За основу взят обычный текстовый редактор...

Редактор...

Код:

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus, XPMan, ToolWin, Printers, Buttons;

type
  TForm1 = class(TForm)
    stat1: TStatusBar;
    tlb1: TToolBar;
    XPManifest1: TXPManifest;
    mm1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    redt1: TRichEdit;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N25: TMenuItem;
    pm1: TPopupMenu;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    dlgFind1: TFindDialog;
    dlgReplace1: TReplaceDialog;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    dlgPnt1: TPrintDialog;
    dlgPntSet1: TPrinterSetupDialog;
    N32: TMenuItem;
    dlgFont1: TFontDialog;
    dlgColor1: TColorDialog;
    btn1: TSpeedButton;

    procedure N2Click(Sender: TObject);
    procedure StatusBar(Sender: TObject; var Done:Boolean);
    procedure FormCreate(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure dlgFind1Find(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure dlgReplace1Find(Sender: TObject);
    procedure dlgReplace1Replace(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
//    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  EditFile:string;


implementation

{$R *.dfm}


procedure TForm1.N2Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.StatusBar(Sender: TObject; var Done:Boolean);
var
  MS: TMemoryStatus;
begin
 stat1.Panels[0].Text:='  ' + Application.Hint;
 stat1.Panels[2].Text:='  Время: ' + TimeToStr(Time);
 if GetKeyState(VK_Numlock)=1
 then stat1.Panels[1].Text:='  ' + '"Num Lock" Включен'
 else stat1.Panels[1].Text:='  ' + '"Num Lock" Выключен';
 if GetKeyState(VK_Insert)=1
 then stat1.Panels[3].Text:='  ' + 'Режим замены'
 else stat1.Panels[3].Text:='  ' + 'Режим вставки';
  GlobalMemoryStatus(MS);
 stat1.Panels[4].Text:='  Память загружена на: ' + Format('%d %%', [MS.dwMemoryLoad]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnIdle:=StatusBar;
end;



procedure TForm1.N13Click(Sender: TObject);                  // Вырезать
begin
redt1.CutToClipboard;
end;

procedure TForm1.N14Click(Sender: TObject);                  // Копировать
begin
redt1.CopyToClipboard;
end;

procedure TForm1.N15Click(Sender: TObject);                  // Вставить
begin
redt1.PasteFromClipboard;
end;

procedure TForm1.N18Click(Sender: TObject);                  // Удалить
begin
redt1.ClearSelection;
end;

procedure TForm1.N17Click(Sender: TObject);                  // Выделить всё
begin
redt1.SelectAll;
end;

procedure TForm1.N19Click(Sender: TObject);
begin
dlgFind1.Execute;
end;

procedure TForm1.dlgFind1Find(Sender: TObject);              // Найти
var
 Buff,P,FT: PChar;
 BuffLen: Word;
begin
 with Sender as TFindDialog do
  begin
   GetMem(FT, Length(FindText) + 1);
   StrPCopy(FT, FindText);
   BuffLen:= redt1.GetTextLen + 1;
   GetMem(Buff, BuffLen);
   redt1.GetTextBuf(Buff, BuffLen);
   P:= Buff + redt1.SelStart + redt1.SelLength;
   P:= StrPos(P, FT);
   if P=nil then MessageBeep(0)
   else
    begin
     redt1.SelStart:= P - Buff;
     redt1.SelLength:= Length(FindText);
    end;
   FreeMem(FT, Length(FindText) + 1);
   FreeMem(Buff, BuffLen);
  end;
end;

procedure TForm1.N20Click(Sender: TObject);
begin
dlgReplace1.Execute;
end;

procedure TForm1.dlgReplace1Find(Sender: TObject);           // Найти чтобы заменить
begin
with Sender as TReplaceDialog do
  while True do
   begin
    if redt1.SelText <> FindText then
    dlgFind1Find(Sender);
    if redt1.SelLength = 0 then Break;
    redt1.SelText:= ReplaceText;
    if not (frReplaceAll in Options) then Break;
   end;
end;

procedure TForm1.dlgReplace1Replace(Sender: TObject);        // Заменить
label 10;
begin
 redt1.HideSelection:=true;
 10:
  if pos(dlgReplace1.FindText,redt1.Text)<>0 then
   begin
    redt1.SelStart:=pos(dlgReplace1.FindText,redt1.Text)-1;
    redt1.SelLength:=Length(dlgReplace1.FindText);
    redt1.SelText:=dlgReplace1.ReplaceText;
    goto 10;
   end;
 redt1.HideSelection:=false;
end;

procedure TForm1.N3Click(Sender: TObject);       // Создать
begin
redt1.Lines.Clear;
end;

procedure TForm1.N4Click(Sender: TObject);       // Открыть
begin
if dlgOpen1.Execute then
  begin
   EditFile:=dlgOpen1.FileName;
   redt1.Lines.LoadFromFile(EditFile);
   Form1.Caption:='Документ - '+ExtractFileName(EditFile);
  end;
end;



procedure TForm1.N6Click(Sender: TObject);       // Сохранить
begin
if dlgSave1.Execute then
redt1.Lines.SaveToFile(EditFile);
if redt1.Modified then redt1.Modified:=false;
end;

procedure TForm1.N7Click(Sender: TObject);       // Сохранить как
begin
 if dlgSave1.Execute then
  begin
   EditFile:=dlgSave1.FileName;
   redt1.Lines.SaveToFile(EditFile);
   Form1.Caption:='Документ - '+ExtractFileName(EditFile);
   if redt1.Modified then redt1.Modified:=false;
  end;
end;

procedure TForm1.N32Click(Sender: TObject);      // Настройка печати
begin
dlgPntSet1.Execute;
end;

procedure TForm1.N9Click(Sender: TObject);      // Печать
var
 Stroka:System.TextFile;
 i:integer;
begin
 if dlgPnt1.Execute then
  begin
   AssignPrn(Stroka);
   Rewrite(Stroka);
   Printer.Canvas.Font:=redt1.Font;
   for i:=0 to redt1.Lines.Count-1 do
    Writeln(Stroka,redt1.Lines[i]);
   System.CloseFile(Stroka);
  end;

end;



procedure TForm1.N23Click(Sender: TObject);                 // Шрифт
begin
if dlgFont1.Execute then redt1.Font:=dlgFont1.Font;
end;

procedure TForm1.N25Click(Sender: TObject);                 // Цвет фона
begin
if dlgColor1.Execute then redt1.Color:=dlgColor1.Color;
end;



end.

Код:

/Шифрование Цезаря
function Cesar_Crypt(s:string):string;
const
  SizeA = 33; //Размер алфавита
  RusA = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя'; //Алфавит
var i, P :integer;
    temp:string;
begin
s:=AnsiLowerCase(s);
temp:='';
//удаление символов сообщения, не входящих в наш алфавит
for i := 1 to length(s) do if pos(s[i],RusA)<>0 then temp:=temp+s[i];
s:=temp;
for i:=1 to length(s) do
  begin
  P:=pos(s[i],RusA)+3;
  if P>SizeA then P:=P-SizeA;
  Result:=Result+RusA[P];
  end;
end;

//Дешифрование Цезаря
function Cesar_DeCrypt(s:string):string;
const
  SizeA = 33; //Размер алфавита
  RusA = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя'; //Алфавит
var i, P :integer;
    temp:string;
begin
s:=AnsiLowerCase(s);
temp:='';
//удаление символов сообщения, не входящих в наш алфавит
for i := 1 to length(s) do if pos(s[i],RusA)<>0 then temp:=temp+s[i];
s:=temp;
for i:=1 to length(s) do
  begin
  P:=pos(s[i],RusA)-3;
  if P<=0 then P:=P+SizeA;
  Result:=Result+RusA[P];
  end;
end;

SawA · #2 03.05.2011, 23:11

Код:

function decode(s: string; code: integer): string;
var t: integer;
begin
for t:=1 to length(s) do s[t]:=chr(ord(s[t]) xor code);
result:=s;
end;

функция кодирует и декодирует
вызывается так:

Код:

decode(rezult,1);

где цифра 1 это на сколько позиций сместится по таблице аски
rezult это строковая переменная

далее можно еще поставить функцию ReversString(rezult); которая позволит записать строку в обратном порядке ну можно прописать и так
<Строковая переменная>:=ReversString(decode(rezult,1));

P.S. функцию не я придумывал нашол в нете где не помню уже иначе скинул бы ссылку но работает просто прекрасно, если я не ошибаюсь и это алгоритм цезаря правда без ReversString'a это уже я добавил так сказать свое немножко стандартной функцией делфи

SawA · #3 03.05.2011, 23:14

Да еще следует добавить что в отличие от предложенного вами алгоритма шифрования текста данная функция шифрует любые символы из таблицы аски а не только русский алфавит даже знаки препинания шифрует

Konrad · #4 03.05.2011, 23:24

Ну что тут сказать...
кошмар...

SawA, какое будет значение edit1.Text, если:

PHP код:


		
			
edit1.Text:=chr(ord('z') xor ord('z'));

?

И это не ш. Цезаря.

SawA · #5 03.05.2011, 23:34

Цитата:

Сообщение от Konrad

Ну что тут сказать...
кошмар...

SawA, какое будет значение edit1.Text, если:

PHP код:


		
			
edit1.Text:=chr(ord('z') xor ord('z'));

?

И это не ш. Цезаря.

бес коментариев
посмотри прогу она рабочая

и работает все верно

SawA · #6 03.05.2011, 23:35

а по поводу шифра цезаря я не утверждал что это шифр я его не знаю точно я говорю о шифровании вообще а пользователь задавший вопрос сказал например шифр цезаря а не именно шифр цезаря ему надо

Konrad · #7 03.05.2011, 23:40

Цитата:

Сообщение от SawA

а по поводу шифра цезаря я не утверждал что это шифр я его не знаю точно я говорю о шифровании вообще а пользователь задавший вопрос сказал например шифр цезаря а не именно шифр цезаря ему надо

Короче учи мат часть. Надоедает каждому школьнику объяснять простые вещи.

SawA · #8 03.05.2011, 23:47

Цитата:

Сообщение от Konrad

Короче учи мат часть. Надоедает каждому школьнику объяснять простые вещи.

ну скажите Уважаемый разве в моем случае шифровка не происходит? и разве пользователь не этого хотел? а в том что вы заменили мне код своим кодом и тыкаете что я в чемто не прав то это не обосновано
различия между моим кодом
chr(ord(s[t]) xor code);
и вашим
chr(ord('z') xor ord('z'));
не видно никак?
вы добавили дополнительно функцию ord зачем спрашивается?

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты