2.3 Код программы
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Mask, XPMan;
type
TForm1 = class (TForm)
Image1: TImage;
Label1: TLabel;
MaskEdit1: TMaskEdit;
ButtonTest: TButton;
Button1: TButton;
XPManifest1: TXPManifest;
Button2: TButton;
procedure FormCreate (Sender: TObject);
procedure SetCaptcha;
function TestCaptcha (C: String): Boolean;
procedure ButtonTestClick (Sender: TObject);
procedure Image1Click (Sender: TObject);
procedure Captcha (Code: string);
function RandStr (len: integer): string;
procedure Button1Click (Sender: TObject);
procedure Button2Click (Sender: TObject);
end;
var
Form1: TForm1;
CurCod: string;
implementation
{$R *. dfm}
// ************************************************************
// Создание формы
procedure TForm1. FormCreate (Sender: TObject);
begin
SetCaptcha;
end;
// ************************************************************
// Клик по картинке, обновление капчи
procedure TForm1. Image1Click (Sender: TObject);
begin
SetCaptcha;
end;
procedure TForm1. Button1Click (Sender: TObject);
begin
SetCaptcha;
end;
// ************************************************************
// Генерация капчи
procedure TForm1. SetCaptcha;
begin
CurCod: = RandStr (6);
Captcha (CurCod);
end;
// ************************************************************
// Создание случайной строки
function TForm1. RandStr (len: integer): string;
const
alfa=QWERTYUIOPASDFGHJKLZXCVBNM;
var
i: integer;
begin
randomize;
result: =;
for i: = 1 to len do
result: =result+alfa [random (length (alfa) - 1) +1];
end;
// ************************************************************
procedure TForm1. Captcha (Code: string);
const
lines = 3;
var
x,y,g: integer;
begin
// Установки картинки
Image1. Canvas. Brush. Color: = clWhite;
Image1. Canvas. Brush. Style: = bsSolid;
Image1. Canvas. FillRect (Image1. Canvas. ClipRect);
// Точки на капче
for x: = 0 to Image1. Width - 1 do
for y: = 0 to Image1. Height - 1 do
if Random (1000) mod 2 = 0 then begin
g: = Random (100) +100;
Image1. Canvas. Pixels [x,y]: = rgb (g,g,g);
end;
// Буквы на капче
Image1. Canvas. Brush. Style: = bsClear;
for x: = 1 to 6 do begin
g: = Random (100) +100;
// Случайный цвет
case Random (3) of
0: Image1. Canvas. Font. Color: = rgb (g,0,0);
1: Image1. Canvas. Font. Color: = rgb (0,g,0);
2: Image1. Canvas. Font. Color: = rgb (0,0,g);
end;
// Случайный шрифт
case random (2) of
0: Image1. Canvas. Font. Style: = [fsBold];
1: Image1. Canvas. Font. Style: = [];
end;
// Случайный размер и положение
Image1. Canvas. Font. Size: = 15 + Random (6);
Image1. Canvas. TextOut ( (x-1) *15+10,random (image1. Height-Image1. Canvas. TextHeight (1)), Code [x]);
end;
// Линии на капче
Image1. Canvas. Pen. Color: = clBlack;
for x: = 0 to lines - 1 do begin
Image1. Canvas. MoveTo (0, Random (Image1. Height));
Image1. Canvas. LineTo (Image1. Width, Random (Image1. Height));
end;
end;
// ************************************************************ // Проверка
procedure TForm1. ButtonTestClick (Sender: TObject);
begin
if TestCaptcha (MaskEdit1. Text) then
ShowMessage (Капча верная! )
else
ShowMessage (Капча неверная! )
end;
// ************************************************************
// Функция проверки
function TForm1. TestCaptcha (C: String): Boolean;
begin
Result: = (CurCod = C);
end;
// ************************************************************
procedure TForm1. Button2Click (Sender: TObject);
begin
close;
end;
end.
- Введение
- 1. Теоретические основы противодействию интернет-ботам
- 1.1 Понятие CAPTCHA
- 1.2 Алгоритм CAPTCHA-проверки
- 1.3 Распознавание защищенной надписи
- 1.4 Альтернативные способы защиты
- 2. Практическая часть
- 2.1 Описание программы
- 2.2 Блок-схема программы
- 2.3 Код программы
- 2.4 Результаты тестирования программы
- Заключение