
02.05.2011, 19:17
|
Прохожий
|
|
Регистрация: 24.03.2011
Сообщения: 1
Версия Delphi: Delphi 7 Lite
Репутация: 10
|
|
Курсовой проект
Задача проекта написать программу, которая позволяет кодировать и декодировать сообщения, заданными способами, например "Шифр Цезаря".
Проблема в том, что я не знаю как это реализовать т.е. как в программу вставить нужный программный код. Если ещё проще, то как сделать так, чтобы после нажатия на кнопку введёный текст зашифровывался?
За основу взят обычный текстовый редактор...
Редактор...
Код:
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;
|