Информационная система анализа типоразмерных характеристик объектов на гибридной аппаратной платформе

Суммарное время функционирования ф предполагает:

- интенсивность отказов пропорциональна числу неустраненных ошибок;

- скорость изменения числа устраненных ошибок, измеряемая относительно суммарного времени функционирования, пропорциональна интенсивности отказов.

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

, (5.8)

где t - время работы до отказа.

Если интенсивность отказов постоянна, то средняя наработка на отказ обратно пропорциональна интенсивности отказов.

Средняя наработка находится по формуле:

, (5.9)

где - средняя наработка на отказ до начала тестирования;

С - коэффициент сжатия тестов;

ф - суммарное время функционирования.

К примеру, если 1 ч тестирования равен 8 ч работы в реальных условиях, то коэффициент сжатия тестов равен 8.

, (5.10)

где f - средняя скорость исполнения программы, отнесенная к числу операторов;

k - является коэффициентом проявления ошибок, который связывает частоту возникновения ошибок со «скоростью ошибок» (скорость, с которой бы встречались ошибки программы, если бы программа выполнялась линейно-последовательно по командам), значение определяют эмпирическим путем по однотипным программам, оно лежит в пределах от 1,54 10^-7 до 3,99 · 10^-7;

- начальное число ошибок программы, его можно рассчитать по модели Шумана на основе статических данных.

Надежность R для оперативного периода вычисляется по формуле:

, (5.11)

Предположим, что в системе работают 500 операторов, скорость работы системы равна 10⁶ операторов в час. Система тестировалась 120 часов, за которые было выявлено 30 ошибок и 12 отказов.

По формуле (5.10) найдём среднюю наработку на отказ перед началом тестирования:

Среднюю наработку на отказ найдём по формуле (5.9):

221,45

Надежность для оперативного периода равную 150 часам найдём по формуле (5.10):

.

5.3.2 Модель Коркорэна

Применение модели предполагает знание следующих ее показателей:

- содержание изменяющейся вероятности отказов для различных источников ошибок и разную вероятность их исправления;

- использование таких параметров, как результат только N испытаний, в которых наблюдается ошибок i-го типа;

- выявление в ходе N испытаний ошибки i-го типа появляется с вероятностью .

Показатель уровня надежности R находится по формуле:

, (5.12)

где N₀ - число безотказных (или безуспешных) испытаний, выполненных в серии из N испытаний;

k - известное число типов ошибок.

Параметр Y_i вычисляется из соотношения:



;

.

где - вероятность выявления при тестировании ошибки i-го типа.

Вероятность б_i основывается на оценке данных предшествующего периода функционирования однотипных программ, либо на основе аппаратной информации. Предположим, что при тестировании программного обеспечения из 70 прогонов 4 закончились с отказом.

Требуется найти вероятность безотказного выполнения программы на момент тестирования.

Надежность составляет 95,24%.



6. ОБЗОР ПРОГРАММНОГО ОБЕСПЕЧЕНИЯ

6.1 Панель администрирования

Для более удобного пользования в программе имеется меню навигации. Перед началом работы требуется подключиться к базе данных, затем выбрать один из пунктов меню: «Администрирование».

Рисунок 6.1 - Меню программы

Выбрав вкладку меню «DB» > «Connect» отправляется запрос на подключение к базе данных. Подключение совершается только при правильном заполнении значений в таблице, пример показан на рисунке 6.2.

Рисунок 6.2 - Таблица значении для подключения к БД

При входе в систему с правами администратора требуется пройти авторизацию (Рисунок 6.3).

Рисунок 6.3 - Процедура авторизации

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

Рисунок 6.4 - Загрузка эталонных изображений

После загрузки эталонов на их основе можно осуществлять анализ и сортировку изображений, которые поступили для распознавания.

В программе имеется возможность самостоятельного выбора изображения для распознавания, а так же с помощью случайной генерации изображения. (рисунок 6.5).

Рисунок 6.5 - Выбор изображения

Далее идет этап анализа, при этом происходит конвертация загруженного изображения в бинарный код. По завершении анализа на экран выводится сообщение о совпадении загруженного ранее изображения с эталонным изображением, находящимся в базе данных программы и их вычислительных параметров, таких как: периметр и площадь объекта, значение хеша, наличие экстремальных координат и вершин образа объекта.

На рисунке 6.6 представлен результат анализа изображения в графическом виде.



Рисунок 6.6 - Результат анализа изображения

При отсутствии совпадений высвечивается сообщение об отсутствии в базе класса, к которому мог бы принадлежать исследуемый объект.

Полученные результаты и данные изображений, подвергнутых обработке, заносятся и хранятся в базе данных.

Рисунок 6.7 - Данные об анализах объектов

6.2 Редактирование кода программы в Borland Delphi 7.0

Для внесения в программу различных изменений необходимо открыть файл проекта программы с помощью Borland Delphi 7.0. Кроме того, для внесения изменений в программный код необходимо зайти в раздел «Программный код» представленный на рисунке 6.8.

Рисунок 6.8 - Редактирование кода в Borland Delphi 7.0

После изменений кода необходимо откомпилировать программу. При обнаружении ошибок следует их исправить и повторить компиляцию.



заключение

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

В результате этого программно - аппаратная платформа формирует набор неизменных признаков за короткий период времени вычисления. Данные признаки используют для распознавания объектов и причисления их к какому - либо классу.

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

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

В отличие от известных аналогов, данная платформа не требует создания специальных мест для анализа объектов и изменения технологических процессов транспортировки исследуемых объектов. Тем самым она является более мобильной и менее затратной в использовании, что в свою очередь повышает эффективность производства.

Одним из известных методов определения количественно - качественных характеристик исследуемого объекта является использование лазерного и видео сканирования, но он требует обязательного прохождения объекта через специальные площадки.

С помощью бинарного и лазерного сканирования линейных размеров и конфигураций объекта получают его плоское и восстановленное «объемное» изображение.

Использование инфра- и ультра- диапазонов восприятия, для получения объемных изображений и видеообразов, повышает информативность анализируемых образов, однако требуют нахождения на определенных фиксированных позициях.

Все перечисленные выше альтернативные решения являются более сложными и вынуждают применять специальное дорогостоящее оборудование.

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



Список использованных источников

1. Бьюли А. Изучаем SQL / А. Бьюли. - Санкт - Петербург - Москва: Символ - Плюс, 2007. - 312 с.

2. Визильтер Ю. В. Обработка и анализ изображений в задачах машинного зрения / Ю. В. Визильтер, С. Ю. Желтов, А. В. Бондаренко. - Москва: Физматкнига, 2010. - 672 с.

3. Горелик А. Л. Методы распознавания / А. Л. Горелик, В. А. Скрипкин. - Москва: Высшая школа, 2004. - 264 с.

4. Гридин В. Н. Адаптивные системы технического зрения / В. Н. Гридин, В. С. Титов, М. И. Труфанов. - Санкт - Петербург: Наука, 2009. - 442 с.

5. Ерош, И. Л. Обработка и распознавание изображений в системах превентивной безопасности / И. Л. Ерош, М. Б. Сергеев, Н. В. Соловьев. - Санкт - Петербург , 2005. - 154 с.

6. Коржинский, С. Н. Изучаем Delphi [Электронный ресурс] / С. Н. Коржинский. - SNK Press Online, 2007. - 344 с. Режим доступа: http://www.snkey.net/books/delphi/.

7. Липаев, В. В. Надежность программных средств / В. В. Липаев. - Москва: Синтег, 1998. - 232 с.

8. Маклаков, С. В. BPWin и ERWin. CASE - средства разработки информационных систем / С. В. Маклаков - Москва: Диалог - МИФИ, 2000. - 256 с.

9. Осипов, Д. Л. Базы данных и Delphi. Теория и практика / Д. Л. Осипов. - Санкт - Петербург: БХВ - Петербург, 2011. - 752 с.

10. Писаревский А. Н. Системы технического зрения / А. Н. Писаревский, А. Ф. Чернявский, Г. К. Афанасьев. - Санкт - Петербург: Машиностроение, 1988. - 424 с.

11. Садыков, С. С. Методы и алгоритмы выделения признаков объектов в системах технического зрения / С. С. Садыков, Н. Н. Стулов. - Москва: Горячая линия - Телеком, 2005. - 204 с.

12. Соммервилл, И. Инженерия программного обеспечения / И. Соммервилл. - Москва: Изд. дом Вильямс, 2002. - 624 с.

13. Справочное руководство по MySQL [Электронный ресурс]: офиц. сайт. - Режим доступа: http://www.mysql.ru/docs/man/.

14. Стулов, Н. Н. Инвариантные к повороту, переносу и изменению масштаба признаки площадных объектов / Н. Н. Стулов, Д. Н. Стародубов // Системы и методы обработки и анализа информации, 2005. - №17. - С. 30 - 37.

15. Фленов, М. Е. Библия Delphi / М. Е. Фленов. - Санкт - Петербург: БХВ - Петербург, 2011. - 686 с.

16. Хомоненко, А. Д. Работа с базами данных в Delphi / А. Д. Хомоненко, В. Э. Гофман. - Санкт - Петербург: БХВ - Петербург, 2003. - 624 с.

17. Шапиро, Л. Компьютерное зрение / Л. Шапиро, Дж. Стокман. -Москва: Бином, 2006. - 752 с.



ПРИЛОЖЕНИЕ А

Функциональная схема программно - аппаратной платформы

Более подробно данная схема рассмотрена в главе 3.

Приложение Б

Структурная схема программно - аппаратной платформы

Общий вид структурной схемы программно - аппаратной платформы анализа типоразмерных характеристик объектов.



Приложение В

Листинг программы

unit Main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, ComCtrls, Grids, md5Hash, DB, mySQLDbTables,

DBGrids, DBCtrls, mySQLDirectQuery,MySQLBatch, ValEdit, Menus;

type

TForm1 = class(TForm)

Label1: TLabel;

Label2: TLabel;

ListBox2: TListBox;

ListBox1: TListBox;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

TabSheet2: TTabSheet;

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

Button1: TButton;

Button3: TButton;

GroupBox2: TGroupBox;

Image2: TImage;

Button2: TButton;

GroupBox1: TGroupBox;

Image1: TImage;

StringGrid4: TStringGrid;

DBGrid1: TDBGrid;

ValueListEditor1: TValueListEditor;

DataSource1: TDataSource;

mySQLTable1: TmySQLTable;

mySQLDatabase1: TmySQLDatabase;

Button5: TButton;

Label3: TLabel;

Button6: TButton;

mySQLQuery1: TmySQLQuery;

mySQLTable2: TmySQLTable;

DataSource2: TDataSource;

Shape1: TShape;

Label4: TLabel;

Shape2: TShape;

Label5: TLabel;

Shape3: TShape;

Label6: TLabel;

Shape4: TShape;

Label7: TLabel;

MainMenu1: TMainMenu;

DB1: TMenuItem;

Connect1: TMenuItem;

Disconnect1: TMenuItem;

Do1: TMenuItem;

Image3: TMenuItem;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

Label8: TLabel;

DBNavigator1: TDBNavigator;

N5: TMenuItem;

Label9: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure ListBox1DblClick(Sender: TObject);

procedure ListBox2Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure Button1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Connect1Click(Sender: TObject);

procedure Disconnect1Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure Image3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure DBGrid1CellClick(Column: TColumn);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2, tools;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

Randomize;

GetAllBMPFiles('images', form1.ListBox1);

end;

procedure TForm1.Button3Click(Sender: TObject);

var rnd:integer;

begin

form1.DBGrid1.Enabled:=False;

form1.MainMenu1.Items.Find('Изображение').Find('Анализ').Enabled:=True;

form1.Button6.Enabled:=True;

cleanTable(form1.StringGrid2);

cleanTable(form1.StringGrid1);

cleanTable(form1.StringGrid4);

rnd := Random(Form1.ListBox1.Count);

form1.ListBox2.Clear;

label9.Caption := ExtractFileDir(ParamStr(0)) + '\\' + Form1.ListBox1.Items[rnd];

LoadBitmap(label9.Caption, form1.Image1);

LoadBitmap(ExtractFileDir(ParamStr(0)) + '\\area\area.bmp', form1.Image2);

ImgToBin(form1.StringGrid1, form1.Image1);

form1.Refresh;

end;

procedure TForm1.ListBox1DblClick(Sender: TObject);

var p:real;

r:integer;

path:string;

begin

form1.Button6.Enabled:=True;

cleanTable(form1.StringGrid2);

cleanTable(form1.StringGrid1);

cleanTable(form1.StringGrid4);

form1.ListBox2.Clear;

form1.Refresh;

path := ExtractFileDir(ParamStr(0));

LoadBitmap(path + '\\area\\area.bmp', form1.Image2);

form1.Label9.Caption := path + '\\' + Form1.ListBox1.Items[form1.ListBox1.ItemIndex];

LoadBitmap(form1.Label9.Caption, form1.Image1);

ImgToBin(form1.StringGrid1, form1.Image1);

end;

procedure TForm1.ListBox2Click(Sender: TObject);

begin

if Form1.ListBox2.Items.Count = Form1.ListBox1.Items.Count then

begin

Form1.ListBox1.Selected[form1.ListBox2.ItemIndex];

Form1.ListBox1.ItemIndex:= form1.ListBox2.ItemIndex;

form1.ListBox1.SetFocus;

ListBox1Click(ListBox1);

form1.Refresh;

end;

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

end;

//выводим массив таблицы

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if form1.StringGrid1.Cells[ACol,ARow]<>'' then

begin

if form1.StringGrid1.Cells[Acol, ARow] = '0' then

begin

form1.StringGrid1.Canvas.Brush.Color:=clYellow;

form1.StringGrid1.Canvas.FillRect(Rect);

form1.StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid1.Cells[Acol,Arow]);

end;

if Perimeter(form1.StringGrid1, Acol,Arow) = True then

begin

form1.StringGrid1.Canvas.Brush.Color:=clRed;

form1.StringGrid1.Canvas.FillRect(Rect);

form1.StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid1.Cells[Acol,Arow]);

end;

if Vertex(StringGrid1, Acol, Arow) = True then

begin

form1.StringGrid1.Canvas.Brush.Color:=clBlue;

form1.StringGrid1.Canvas.FillRect(Rect);

form1.StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid1.Cells[Acol,Arow]);

end;

if Extrema(StringGrid1, Acol, Arow) = True then

begin

form1.StringGrid1.Canvas.Brush.Color:=clPurple;

form1.StringGrid1.Canvas.FillRect(Rect);

form1.StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid1.Cells[Acol,Arow]);

end;

if Centroid(StringGrid1, Acol, Arow) = True then

begin

form1.StringGrid1.Canvas.Brush.Color:=clGreen;

form1.StringGrid1.Canvas.FillRect(Rect);

form1.StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid1.Cells[Acol,Arow]);

end;

end

else

begin

form1.StringGrid1.Canvas.Brush.Color:=clWhite;

form1.StringGrid1.Canvas.FillRect(Rect);

form1.StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid1.Cells[Acol,Arow]);

end;

end;

procedure TForm1.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if form1.StringGrid2.Cells[ACol,ARow]<>'' then

begin

if form1.StringGrid2.Cells[Acol, ARow] = '0' then

begin

form1.StringGrid2.Canvas.Brush.Color:=clYellow;

form1.StringGrid2.Canvas.FillRect(Rect);

form1.StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid2.Cells[Acol,Arow]);

end;

if Perimeter(form1.StringGrid2, Acol,Arow) = True then

begin

form1.StringGrid2.Canvas.Brush.Color:=clRed;

form1.StringGrid2.Canvas.FillRect(Rect);

form1.StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid2.Cells[Acol,Arow]);

end;

if Vertex(StringGrid2, Acol, Arow) = True then

begin

form1.StringGrid2.Canvas.Brush.Color:=clBlue;

form1.StringGrid2.Canvas.FillRect(Rect);

form1.StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid2.Cells[Acol,Arow]);

end;

if Extrema(StringGrid2, Acol, Arow) = True then

begin

form1.StringGrid2.Canvas.Brush.Color:=clPurple;

form1.StringGrid2.Canvas.FillRect(Rect);

form1.StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid2.Cells[Acol,Arow]);

end;

if Centroid(StringGrid2, Acol, Arow) = True then

begin

form1.StringGrid2.Canvas.Brush.Color:=clGreen;

form1.StringGrid2.Canvas.FillRect(Rect);

form1.StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid2.Cells[Acol,Arow]);

end;

end

else

begin

form1.StringGrid2.Canvas.Brush.Color:=clWhite;

form1.StringGrid2.Canvas.FillRect(Rect);

form1.StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top, form1.StringGrid2.Cells[Acol,Arow]);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var List: TList;

begin

Form1.mySQLDatabase1.ConnectionCharacterSet:='cp1251';

Form1.mySQLDatabase1.Host := Form1.ValueListEditor1.Values['HOST'];

Form1.mySQLDatabase1.UserName := Form1.ValueListEditor1.Values['USER'];

Form1.mySQLDatabase1.UserPassword:=form1.ValueListEditor1.Values['PASSWORD'];

Form1.mySQLDatabase1.Connect;

form1.mySQLDatabase1.SelectDB(form1.ValueListEditor1.Values['DB']);

form1.mySQLTable1.TableName:='list';

form1.mySQLTable1.Open;

if form1.mySQLDatabase1.Connected = True then

begin

form1.MainMenu1.Items.Find('DB').Find('Connect').Visible:=False;

form1.MainMenu1.Items.Find('DB').Find('Disconnect').Visible:=True;

form1.MainMenu1.Items.Find('Изображение').Enabled:=True;

form1.ListBox1.Enabled:=True;

form1.Button5.Enabled:=True;

form1.Button3.Enabled:=True;

form1.Label3.Caption:='Connected';

form1.Button1.Enabled := False;

end;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

form2.Show;

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

form1.mySQLDatabase1.Disconnect;

if form1.mySQLDatabase1.Connected = False then

begin

form1.ListBox1.Enabled:=False;

form1.MainMenu1.Items.Find('Изображение').Find('Анализ').Enabled:=False;

form1.MainMenu1.Items.Find('DB').Find('Connect').Visible:=True;

form1.MainMenu1.Items.Find('DB').Find('Disconnect').Visible:=False;

form1.MainMenu1.Items.Find('Изображение').Enabled:=False;

form1.Button5.Enabled:=False;

form1.Label3.Caption:='Disconnected';

form1.Button1.Enabled := True;

form1.Button3.Enabled := False;

form1.Button6.Enabled := False;

LoadBitmap(ExtractFileDir(ParamStr(0)) + '\\area\\area.bmp', form1.Image1);

LoadBitmap(ExtractFileDir(ParamStr(0)) + '\\area\\area.bmp', form1.Image2);

cleanTable(form1.StringGrid2);

cleanTable(form1.StringGrid1);

end;

end;

procedure TForm1.Button6Click(Sender: TObject);

var st:TStringList;

hash,hash2,p,s,p2,s2,col_v,col_e,col_v2,col_e2:string;

path,parent:variant;

begin

form1.DBGrid1.Enabled:=True;

st := TStringList.Create();

st.Clear;

hash := QuotedStr(getValHash(form1.StringGrid1));

p := getValP(form1.StringGrid1);

s := getValS(form1.StringGrid1);

col_v := getValVertex(form1.StringGrid1);

col_e := getValExtrems(form1.StringGrid1);

st.Add('SELECT * FROM benchmarks WHERE hash=' + hash + ';');

form1.mySQLTable2.TableName := 'benchmarks';

form1.mySQLTable2.Open;

form1.mySQLQuery1.SQL := st;

form1.mySQLQuery1.Active := True;

path := form1.mySQLQuery1.FieldValues['path'];

parent := form1.mySQLQuery1.FieldValues['hash'];

form1.mySQLQuery1.Active := False;

if path <> Null then

begin

if parent <> '-' then

begin

LoadBitmap(path, form1.Image2);

ImgToBin(form1.StringGrid2, form1.Image2);

end;

hash2 := QuotedStr(getValHash(form1.StringGrid2));

p2 := getValP(form1.StringGrid2);

s2 := getValS(form1.StringGrid2);

ShowMessage('Совпадение с эталоном' + chr(13) + 'hash (изображения): ' + hash + chr(13) + 'hash (эталона): ' + hash2 + chr(13) + 'P (изображения): ' + p + chr(13)+ 'P (эталона): ' + p2 + chr(13) + 'S (изображения): ' + s + chr(13)+ 'S (эталона): ' + s2);

form1.mySQLDatabase1.Execute('INSERT INTO list VALUES(0,' + hash + ',' + p + ','+ s + ',' + col_v + ',' + col_e + ',' + QuotedStr(parent) + ',' + QuotedStr(StringReplace(form1.Label9.Caption, '\', '\\',[rfReplaceAll, rfIgnoreCase])) + ');');

end

else

begin

st.Clear;

st.Add('SELECT * FROM benchmarks WHERE p=' + p + ' and s=' + s + ';');

form1.mySQLQuery1.SQL := st;

form1.mySQLQuery1.Active:=True;

path := form1.mySQLQuery1.FieldValues['path'];

parent := form1.mySQLQuery1.FieldValues['hash'];

if path <> Null then

begin

if parent <> '-' then

begin

LoadBitmap(path, form1.Image2);

ImgToBin(form1.StringGrid2, form1.Image2);

end;

hash2 := QuotedStr(getValHash(form1.StringGrid2));

p2 := getValP(form1.StringGrid2);

s2 := getValS(form1.StringGrid2);

ShowMessage('Совпадение с эталоном' + chr(13) + 'hash (изображения): ' + hash + chr(13) + 'hash (эталона): ' + hash2 + chr(13) + 'P (изображения): ' + p + chr(13)+ 'P (эталона): ' + p2 + chr(13) +'S (изображения): ' + s + chr(13)+ 'S (эталона): ' + s2);

form1.mySQLDatabase1.Execute('INSERT INTO list VALUES(0,' + hash + ',' + p + ','+ s + ',' + col_v + ',' + col_e + ',' + QuotedStr(parent) + ',' + QuotedStr(StringReplace(form1.Label9.Caption, '\', '\\',[rfReplaceAll, rfIgnoreCase])) + ');');

end

else

begin

ImgToBin(form1.StringGrid1, form1.Image1);

cleanTable(form1.StringGrid2);

ShowMessage('Нет совпадений');

form1.mySQLDatabase1.Execute('INSERT INTO list VALUES(0,' + hash + ',' + p + ',' + s + ',' + col_v + ',' + col_e + ',' + QuotedStr('-') + ',' + QuotedStr(StringReplace(form1.Label9.Caption, '\', '\\',[rfReplaceAll, rfIgnoreCase])) + ');');

end;

end;

st.Free;

form1.mySQLTable1.Refresh;

form1.Button6.Enabled:=False;

form1.mySQLQuery1.Active:=False;

end;

procedure TForm1.Connect1Click(Sender: TObject);

begin

form1.Button1.Click;

end;

procedure TForm1.Disconnect1Click(Sender: TObject);

begin

form1.Button5.Click;

end;

procedure TForm1.N3Click(Sender: TObject);

begin

end;

procedure TForm1.Image3Click(Sender: TObject);

begin

form1.Button3.Click;

end;

//Процедура аутентификации

procedure TForm1.N4Click(Sender: TObject);

var pass:string;

begin

pass:=InputBox('Auth','Введите пароль','');

if md5(pass) = 'd8578edf8458ce06fbc5bb76a58c5ca4' then

begin

form2.Show;

end

else

ShowMessage('Неверный пароль !');

end;

procedure TForm1.N5Click(Sender: TObject);

begin

Application.Terminate;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Application.Terminate;

end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);

var path_parent,parent,path:Variant;

st:TStringList;

begin

if form1.mySQLDatabase1.Connected = True then

begin

path := form1.DBGrid1.DataSource.DataSet.Fields.Fields[7].Value;

parent := form1.DBGrid1.DataSource.DataSet.Fields.Fields[6].Value;

if path <> Null then

begin

LoadBitmap(path, form1.Image1);

form1.Refresh;

ImgToBin(form1.StringGrid1, form1.Image1);

end;

form1.Image1.Repaint;

form1.Image1.Refresh;

form1.Refresh;

if parent <> '-' then

begin

st := TStringList.Create();

st.Clear;

st.Add('SELECT * FROM benchmarks WHERE hash=' + QuotedStr(parent) + ';');

form1.mySQLTable2.TableName:='benchmarks';

form1.mySQLTable2.Open;

form1.mySQLQuery1.SQL := st;

form1.mySQLQuery1.Active:=True;

path_parent := form1.mySQLQuery1.FieldValues['path'];

if path <> Null then

begin

LoadBitmap(path_parent, form1.Image2);

form1.Refresh;

ImgToBin(form1.StringGrid2, form1.Image2);

end;

end

else

begin

LoadBitmap(ExtractFileDir(ParamStr(0)) + '\\area\area.bmp', form1.Image2);

form1.Refresh;

cleanTable(form1.StringGrid2);

end;

form1.Image1.Repaint;

form1.Image1.Refresh;

form1.Refresh;

form1.mySQLQuery1.Active:=False;

end;

end;

end.

____________________________________________________________

unit tools;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, ComCtrls, Grids, md5Hash, DB, mySQLDbTables,

DBGrids, DBCtrls, mySQLDirectQuery,MySQLBatch;

function Perimeter(SG:TStringGrid; col, row:integer):bool;

function Centroid(SG:TStringGrid; col, row:integer):bool;

function CheckVoidSG(SG:TStringGrid):bool;

procedure cleanTable(SG:TStringGrid);

function Extrema(SG:TStringGrid; col, row:integer):bool;

function Area(col, row, max_x, max_y, min_x, min_y:integer):bool;

procedure GetAllBMPFiles( Path: string; Lb: TListBox );

function getValCentroid(SG:TStringGrid):string;

function getValP(SG:TStringGrid):string;

function getValS(SG:TStringGrid):string;

function getValHash(SG:TStringGrid):string;

function getValVertex(SG:TStringGrid):string;

function getValExtrems(SG:TStringGrid):string;

function MaxP(m:array of real):integer;

procedure LoadBitmap(path:String; img:TImage);

procedure ImgToBin(M:TStringGrid; img:TImage);

function StringToHex(S: String): String;

function Vertex(SG:TStringGrid; col, row:integer):bool;

procedure SmoothResize(Src, Dst: TBitmap);

procedure xy_max_and_min(SG:TStringGrid; var max_x, max_y, min_x, min_y:integer);

implementation

type

TRGBArray = array[Word] of TRGBTriple;

pRGBArray = ^TRGBArray;

function Perimeter(SG:TStringGrid; col, row:integer):bool;

var c1,c2,c3,c4,c5:string;

begin

Result:=False;

if (col <> 0) and (row <> 0) and (col <> SG.ColCount - 1) and (row <> SG.RowCount - 1) then

begin

c1 := SG.Cells[col, row - 1];

c2 := SG.Cells[col + 1, row];

c3 := SG.Cells[col, row + 1];

c4 := SG.Cells[col - 1, row];

c5 := SG.Cells[col, row];

if ((c1 = '1') or (c2 = '1') or (c3 = '1') or (c4 = '1')) and (c5 = '0') then

Result := True;

end

else

begin

if SG.Cells[col, row] = '0' then

Result := True;

end;

end;

procedure xy_max_and_min(SG:TStringGrid; var max_x, max_y, min_x, min_y:integer);

var i,j:integer;

begin

min_x := 65;

min_y := 65;

max_x := -1;

max_y := -1;

for j:=0 to SG.RowCount - 1 do

for i:=0 to SG.ColCount - 1 do

if Extrema(SG, j, i) = True then

begin

if i > max_x then

max_x:=i;

if i < min_x then

min_x:=i;

if j > max_y then

max_y:=j;

if j < min_y then

min_y:=j;

end;

end;

function Area(col, row, max_x, max_y, min_x, min_y:integer):bool;

begin

Result := False;

if ((col >= min_x) and (col <= max_x)) and ((row >= min_y) and (row <= max_y)) then

begin

Result := True;

end;

end;

function Vertex(SG:TStringGrid; col, row:integer):bool; //определение вершины образа

var c1,c2,c3,c4,c5,c6,c7,c8,c9:integer;

begin

Result:=False;

if Perimeter(SG, col, row) = True then

begin

if (col <> 0) and (row <> 0) and (col <> SG.ColCount - 1) and (row <> SG.RowCount - 1) then

begin

c1 := strtoint(SG.Cells[col, row]);

c2 := strtoint(SG.Cells[col, row - 1]);

c3 := strtoint(SG.Cells[col + 1, row - 1]);

c4 := strtoint(SG.Cells[col + 1, row]);

c5 := strtoint(SG.Cells[col + 1, row + 1]);

c6 := strtoint(SG.Cells[col, row + 1]);

c7 := strtoint(SG.Cells[col - 1, row + 1]);

c8 := strtoint(SG.Cells[col - 1, row]);

c9 := strtoint(SG.Cells[col - 1, row - 1]);

if c1 + c2 + c3 + c4 + c5 + c6 + c7 + c8 + c9 = 5 then

Result:=True;

end

else

if ((row = 0) and (col = 0)) or ((row = 0) and (col = SG.ColCount - 1)) or ((row = SG.RowCount - 1) and (col = 0)) or ((row = SG.RowCount - 1) and (col = SG.ColCount - 1)) then

begin

Result:=True;

end

else

begin

c1 := strtoint(SG.Cells[col, row]);

if row = 0 then

begin

c2 := strtoint(SG.Cells[col - 1, row]);

c3 := strtoint(SG.Cells[col, row + 1]);

c4 := strtoint(SG.Cells[col + 1, row]);

end;

if col = 0 then

begin

c2 := strtoint(SG.Cells[col, row - 1]);

c3 := strtoint(SG.Cells[col, row + 1]);

c4 := strtoint(SG.Cells[col + 1, row]);

end;

if row = SG.RowCount - 1 then

begin

c2 := strtoint(SG.Cells[col - 1, row]);

c3 := strtoint(SG.Cells[col + 1, row]);

c4 := strtoint(SG.Cells[col, row -1]);

end;

if col = SG.ColCount - 1 then

begin

c2 := strtoint(SG.Cells[col, row - 1]);

c3 := strtoint(SG.Cells[col, row + 1]);

c4 := strtoint(SG.Cells[col - 1, row]);

end;

if (c2 = 1) or (c3 = 1) or (c4 = 1) then

Result := True;

end;

end;

end;

function Extrema(SG:TStringGrid; col, row:integer):bool;

var i,k:integer;

begin

Result := False;

if Vertex(SG, col, row) = True then

if (row <> 0) and (col <> 0) and (row <> SG.RowCount-1) and (col <> SG.ColCount - 1) then

begin

k := 0;

for i := 0 to SG.ColCount - 1 do

k := k + strtoint(SG.Cells[i, row + 1]);

if k = SG.ColCount then

Result := True;

k := 0;

for i := 0 to SG.ColCount - 1 do

k := k + strtoint(SG.Cells[i, row - 1]);

if k = SG.ColCount then

Result := True;

if Result = False then

begin

k := 0;

for i := 0 to SG.RowCount - 1 do

k := k + strtoint(SG.Cells[col + 1, i]);

if k = SG.RowCount then

Result := True;

k := 0;

for i := 0 to SG.RowCount - 1 do

k := k + strtoint(SG.Cells[col - 1, i]);

if k = SG.RowCount then

Result := True;

end;

end

else

Result := True;

end;

function CheckVoidSG(SG:TStringGrid):bool; //проверка отсутствия значений в таблице

var r,i,j:integer;

begin

Result:=False;

r:=0;

for i := 0 to SG.RowCount - 1 do

for j := 0 to SG.ColCount - 1 do

if SG.Cells[j,i] <>'' then

r := r + 1;

if r = (SG.ColCount * SG.RowCount) then

Result := True;

end;

procedure SmoothResize(Src, Dst: TBitmap); //сжатие изображения

var

x, y: Integer;

xP, yP: Integer;

xP2, yP2: Integer;

SrcLine1, SrcLine2: pRGBArray;

t3: Integer;

z, z2, iz2: Integer;

DstLine: pRGBArray;

DstGap: Integer;

w1, w2, w3, w4: Integer;

begin

Src.PixelFormat := pf24Bit;

Dst.PixelFormat := pf24Bit;

if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then

Dst.Assign(Src)

else

begin

DstLine := Dst.ScanLine[0];

DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);

xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);

yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);

yP := 0;

for y := 0 to pred(Dst.Height) do

begin

xP := 0;

SrcLine1 := Src.ScanLine[yP shr 16];

if (yP shr 16 < pred(Src.Height)) then

SrcLine2 := Src.ScanLine[succ(yP shr 16)]

else

SrcLine2 := Src.ScanLine[yP shr 16];

z2 := succ(yP and $FFFF);

iz2 := succ((not yp) and $FFFF);

for x := 0 to pred(Dst.Width) do

begin

t3 := xP shr 16;

z := xP and $FFFF;

w2 := MulDiv(z, iz2, $10000);

w1 := iz2 - w2;

w4 := MulDiv(z, z2, $10000);

w3 := z2 - w4;

DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +

SrcLine1[t3 + 1].rgbtRed * w2 +

SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;

DstLine[x].rgbtGreen :=

(SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +

SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;

DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +

SrcLine1[t3 + 1].rgbtBlue * w2 +

SrcLine2[t3].rgbtBlue * w3 +

SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;

Inc(xP, xP2);

end; {for}

Inc(yP, yP2);

DstLine := pRGBArray(Integer(DstLine) + DstGap);

end; {for}

end; {if}

end; {SmoothResize}

procedure GetAllBMPFiles( Path: string; Lb: TListBox ); //выбор изображения

var

sRec: TSearchRec;

isFound: boolean;

begin

isFound := FindFirst( Path + '\*.bmp', faAnyFile, sRec ) = 0;

while isFound do

begin

if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then

begin

if ( sRec.Attr and faDirectory ) = faDirectory then

GetAllBMPFiles( Path + '\' + sRec.Name, Lb );

Lb.Items.Add( Path + '\' + sRec.Name );

end;

Application.ProcessMessages;

isFound := FindNext( sRec ) = 0;

end;

FindClose( sRec );

end;

function MaxP(m:array of real):integer; // определение необходимости данной функции

var

maxNO, i:integer;

r, max:real;

begin

max := 0;

maxNO := 0;

for i:= 0 to Length(m) -1 do

begin

if m[i] > max then

begin

max := m[i];

maxNO := i;

end;

end;

Result := maxNO;

end;

procedure cleanTable(SG:TStringGrid);

var i,j:integer;

begin

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

SG.Cells[j,i]:='';

end;

procedure LoadBitmap(path:String; img:TImage); // загрузка изображения

var bm: TBitmap;

begin

bm := TBitmap.Create;

bm.LoadFromFile(path);

SmoothResize(bm, Img.Picture.Bitmap);

Img.Refresh();

end;

procedure ImgToBin(M:TStringGrid; img:TImage); // преобразование изображения в

var x,y,p,s: integer; // таблицу

begin

for y := 0 to Img.Height - 1 do begin

for x := 0 to Img.Width - 1 do begin

if Img.Canvas.Pixels[x,y]<>0 then p:=1 else p:=0;

M.Cells[x,y]:=IntToStr(p);

end;

end;

end;

function StringToHex(S: String): String; //преобразование в 16, в строку

var I: Integer;

begin

Result:= '';

for I := 1 to length (S) do

Result:= Result+IntToHex(ord(S[i]),2);

end;

function Centroid(SG:TStringGrid; col, row:integer):bool;

var x,y,buff,xc,yc:integer;

N,sumx,sumy:cardinal;

begin

Result:=False;

sumx:=0;sumy:=0;N:=0;

// Алгоритм вычисления центра масс образа

for y := 0 to SG.RowCount - 1 do

for x := 0 to SG.ColCount - 1 do

begin

buff := strtoint(SG.Cells[y,x]);

if buff = 0 then buff := 1 else buff := 0;

sumx := sumx + x * buff;

sumy := sumy + y * buff;

N := N + buff;

end;

// получение координат центра масс образа

xc:= round(sumx/N);

yc:= round(sumy/N);

if (col = xc) and (row = yc) then

Result:=True;

end;

function getValCentroid(SG:TStringGrid):string; //возвращение координаты центра

var i,j:integer;

begin

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

if Centroid(SG, j, i) = True then

begin

Result := 'x: ' + inttostr(j) + ' / y: '+ inttostr(i);

end;

end;

function getValExtrems(SG:TStringGrid):string;

var i,j,e:integer;

begin

e:=0;

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

if Extrema(SG, j, i) = True then

e := e + 1;

Result := inttostr(e);

end;

function getValVertex(SG:TStringGrid):string;

var i,j,v:integer;

begin

v:=0;

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

if Vertex(SG, j, i) = True then

v := v + 1;

Result := inttostr(v);

end;

function getValP(SG:TStringGrid):string; //получение значения периметра

var i,j,p:integer;

begin

p:=0;

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

if Perimeter(SG, j, i) = True then

p := p + 1;

Result := inttostr(p);

end;

function getValS(SG:TStringGrid):string; //получение значения площади

var i,j,s:integer;

begin

s:=0;

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

if SG.Cells[j,i] = '0' then

s := s + 1;

Result := inttostr(s);

end;

function getValHash(SG:TStringGrid):string; // получение хэша таблицы

var str_for_hash:string;

i,j:integer;

max_x, max_y, min_x, min_y:integer;

begin

xy_max_and_min(SG, max_x, max_y, min_x, min_y);

str_for_hash:='';

for i:=0 to SG.RowCount - 1 do

for j:=0 to SG.ColCount - 1 do

if Area(j,i,max_x, max_y, min_x, min_y) = True then

begin

//SG.Cells[i,j]:='0';

str_for_hash := str_for_hash + SG.Cells[i,j];

end;

if str_for_hash <> '' then

Result:=md5(StringToHex(str_for_hash));

end;

end.

unit md5Hash;

interface

uses

Windows, SysUtils;

function md5(S: String): String;

implementation

type

TArrayOfByte = Array of Byte;

TArrayOfDWORD = Array of DWORD;

THash = Array[0..3] of DWORD;

const

BlockSize = 4;

HashSize = 16;

BuffSize = 64;

function LRot32(A: DWORD; B: Byte): DWORD;

begin

Result:= (A shl B) or (A shr (32-B));

end;

procedure Compressor(Hash, Buffer: Pointer; IV: LongWord = 0);

var

A, B, C, D: DWORD;

begin

A := TArrayOfDWORD(Hash)[0];

B := TArrayOfDWORD(Hash)[1];

C := TArrayOfDWORD(Hash)[2];

D := TArrayOfDWORD(Hash)[3];

Buffer := Pointer(DWORD(Buffer) + IV);

A := B + LRot32(A + (D xor (B and (C xor D))) + TArrayOfDWORD(Buffer)[ 0] + $D76AA478, 7);

D := A + LRot32(D + (C xor (A and (B xor C))) + TArrayOfDWORD(Buffer)[ 1] + $E8C7B756, 12);

C := D + LRot32(C + (B xor (D and (A xor B))) + TArrayOfDWORD(Buffer)[ 2] + $242070DB, 17);

B := C + LRot32(B + (A xor (C and (D xor A))) + TArrayOfDWORD(Buffer)[ 3] + $C1BDCEEE, 22);

A := B + LRot32(A + (D xor (B and (C xor D))) + TArrayOfDWORD(Buffer)[ 4] + $F57C0FAF, 7);

D := A + LRot32(D + (C xor (A and (B xor C))) + TArrayOfDWORD(Buffer)[ 5] + $4787C62A, 12);

C := D + LRot32(C + (B xor (D and (A xor B))) + TArrayOfDWORD(Buffer)[ 6] + $A8304613, 17);

B := C + LRot32(B + (A xor (C and (D xor A))) + TArrayOfDWORD(Buffer)[ 7] + $FD469501, 22);

A := B + LRot32(A + (D xor (B and (C xor D))) + TArrayOfDWORD(Buffer)[ 8] + $698098D8, 7);

D := A + LRot32(D + (C xor (A and (B xor C))) + TArrayOfDWORD(Buffer)[ 9] + $8B44F7AF, 12);

C := D + LRot32(C + (B xor (D and (A xor B))) + TArrayOfDWORD(Buffer)[10] + $FFFF5BB1, 17);

B := C + LRot32(B + (A xor (C and (D xor A))) + TArrayOfDWORD(Buffer)[11] + $895CD7BE, 22);

A := B + LRot32(A + (D xor (B and (C xor D))) + TArrayOfDWORD(Buffer)[12] + $6B901122, 7);

D := A + LRot32(D + (C xor (A and (B xor C))) + TArrayOfDWORD(Buffer)[13] + $FD987193, 12);

C := D + LRot32(C + (B xor (D and (A xor B))) + TArrayOfDWORD(Buffer)[14] + $A679438E, 17);

B := C + LRot32(B + (A xor (C and (D xor A))) + TArrayOfDWORD(Buffer)[15] + $49B40821, 22);

A := B + LRot32(A + (C xor (D and (B xor C))) + TArrayOfDWORD(Buffer)[ 1] + $F61E2562, 5);

D := A + LRot32(D + (B xor (C and (A xor B))) + TArrayOfDWORD(Buffer)[ 6] + $C040B340, 9);

C := D + LRot32(C + (A xor (B and (D xor A))) + TArrayOfDWORD(Buffer)[11] + $265E5A51, 14);

B := C + LRot32(B + (D xor (A and (C xor D))) + TArrayOfDWORD(Buffer)[ 0] + $E9B6C7AA, 20);

A := B + LRot32(A + (C xor (D and (B xor C))) + TArrayOfDWORD(Buffer)[ 5] + $D62F105D, 5);

D := A + LRot32(D + (B xor (C and (A xor B))) + TArrayOfDWORD(Buffer)[10] + $02441453, 9);

C := D + LRot32(C + (A xor (B and (D xor A))) + TArrayOfDWORD(Buffer)[15] + $D8A1E681, 14);

B := C + LRot32(B + (D xor (A and (C xor D))) + TArrayOfDWORD(Buffer)[ 4] + $E7D3FBC8, 20);

A := B + LRot32(A + (C xor (D and (B xor C))) + TArrayOfDWORD(Buffer)[ 9] + $21E1CDE6, 5);

D := A + LRot32(D + (B xor (C and (A xor B))) + TArrayOfDWORD(Buffer)[14] + $C33707D6, 9);

C := D + LRot32(C + (A xor (B and (D xor A))) + TArrayOfDWORD(Buffer)[ 3] + $F4D50D87, 14);

B := C + LRot32(B + (D xor (A and (C xor D))) + TArrayOfDWORD(Buffer)[ 8] + $455A14ED, 20);

A := B + LRot32(A + (C xor (D and (B xor C))) + TArrayOfDWORD(Buffer)[13] + $A9E3E905, 5);

D := A + LRot32(D + (B xor (C and (A xor B))) + TArrayOfDWORD(Buffer)[ 2] + $FCEFA3F8, 9);

C := D + LRot32(C + (A xor (B and (D xor A))) + TArrayOfDWORD(Buffer)[ 7] + $676F02D9, 14);

B := C + LRot32(B + (D xor (A and (C xor D))) + TArrayOfDWORD(Buffer)[12] + $8D2A4C8A, 20);

A := B + LRot32(A + (B xor C xor D) + TArrayOfDWORD(Buffer)[ 5] + $FFFA3942, 4);

D := A + LRot32(D + (A xor B xor C) + TArrayOfDWORD(Buffer)[ 8] + $8771f681, 11);

C := D + LRot32(C + (D xor A xor B) + TArrayOfDWORD(Buffer)[11] + $6D9D6122, 16);

B := C + LRot32(B + (C xor D xor A) + TArrayOfDWORD(Buffer)[14] + $FDE5380C, 23);

A := B + LRot32(A + (B xor C xor D) + TArrayOfDWORD(Buffer)[ 1] + $A4BEEA44, 4);

D := A + LRot32(D + (A xor B xor C) + TArrayOfDWORD(Buffer)[ 4] + $4BDECFA9, 11);

C := D + LRot32(C + (D xor A xor B) + TArrayOfDWORD(Buffer)[ 7] + $F6BB4B60, 16);

B := C + LRot32(B + (C xor D xor A) + TArrayOfDWORD(Buffer)[10] + $BEBFBC70, 23);

A := B + LRot32(A + (B xor C xor D) + TArrayOfDWORD(Buffer)[13] + $289B7EC6, 4);

D := A + LRot32(D + (A xor B xor C) + TArrayOfDWORD(Buffer)[ 0] + $EAA127FA, 11);

C := D + LRot32(C + (D xor A xor B) + TArrayOfDWORD(Buffer)[ 3] + $D4EF3085, 16);

B := C + LRot32(B + (C xor D xor A) + TArrayOfDWORD(Buffer)[ 6] + $04881D05, 23);

A := B + LRot32(A + (B xor C xor D) + TArrayOfDWORD(Buffer)[ 9] + $D9D4D039, 4);

D := A + LRot32(D + (A xor B xor C) + TArrayOfDWORD(Buffer)[12] + $E6DB99E5, 11);

C := D + LRot32(C + (D xor A xor B) + TArrayOfDWORD(Buffer)[15] + $1FA27CF8, 16);

B := C + LRot32(B + (C xor D xor A) + TArrayOfDWORD(Buffer)[ 2] + $C4AC5665, 23);

A := B + LRot32(A + (C xor (B or (not D))) + TArrayOfDWORD(Buffer)[ 0] + $F4292244, 6);

D := A + LRot32(D + (B xor (A or (not C))) + TArrayOfDWORD(Buffer)[ 7] + $432AFF97, 10);

C := D + LRot32(C + (A xor (D or (not B))) + TArrayOfDWORD(Buffer)[14] + $AB9423A7, 15);

B := C + LRot32(B + (D xor (C or (not A))) + TArrayOfDWORD(Buffer)[ 5] + $FC93A039, 21);

A := B + LRot32(A + (C xor (B or (not D))) + TArrayOfDWORD(Buffer)[12] + $655B59C3, 6);

D := A + LRot32(D + (B xor (A or (not C))) + TArrayOfDWORD(Buffer)[ 3] + $8F0CCC92, 10);

C := D + LRot32(C + (A xor (D or (not B))) + TArrayOfDWORD(Buffer)[10] + $FFEFF47D, 15);

B := C + LRot32(B + (D xor (C or (not A))) + TArrayOfDWORD(Buffer)[ 1] + $85845DD1, 21);

A := B + LRot32(A + (C xor (B or (not D))) + TArrayOfDWORD(Buffer)[ 8] + $6FA87E4F, 6);

D := A + LRot32(D + (B xor (A or (not C))) + TArrayOfDWORD(Buffer)[15] + $FE2CE6E0, 10);

C := D + LRot32(C + (A xor (D or (not B))) + TArrayOfDWORD(Buffer)[ 6] + $A3014314, 15);

B := C + LRot32(B + (D xor (C or (not A))) + TArrayOfDWORD(Buffer)[13] + $4E0811A1, 21);

A := B + LRot32(A + (C xor (B or (not D))) + TArrayOfDWORD(Buffer)[ 4] + $F7537E82, 6);

D := A + LRot32(D + (B xor (A or (not C))) + TArrayOfDWORD(Buffer)[11] + $BD3AF235, 10);

C := D + LRot32(C + (A xor (D or (not B))) + TArrayOfDWORD(Buffer)[ 2] + $2AD7D2BB, 15);

B := C + LRot32(B + (D xor (C or (not A))) + TArrayOfDWORD(Buffer)[ 9] + $EB86D391, 21);

Inc(TArrayOfDWORD(Hash)[0], A);

Inc(TArrayOfDWORD(Hash)[1], B);

Inc(TArrayOfDWORD(Hash)[2], C);

Inc(TArrayOfDWORD(Hash)[3], D);

end;

function HashToStr(Hash: Pointer): String;

var

i: Byte;

begin

Result := '';

for i := 0 to HashSize - 1 do

Result := Result + IntToHex(TArrayOfByte(Hash)[i], 2);

end;

function md5(S: String): String;

var

CurrentHash: THash;

Len, LenHI, LenLO: LongWord;

i: LongWord;

begin

Result := '';

Len := Length(S);

LenHI := Len shr 29;

LenLO := Len * 8;

S := S + #$80;

Inc(Len);

for i := 0 to BuffSize - (Len mod BuffSize) - 1 do S := S + #0;

if (Len mod BuffSize > 56) then

for i := 0 to BuffSize - 1 do S := S + #0;

TArrayOfDWORD(S)[(Length(S) div BlockSize) - 1] := LenHI;

TArrayOfDWORD(S)[(Length(S) div BlockSize) - 2] := LenLO;

CurrentHash[0] := $67452301;

CurrentHash[1] := $EFCDAB89;

CurrentHash[2] := $98BADCFE;

CurrentHash[3] := $10325476;

for i := 0 to (Length(S) div BuffSize) - 1 do

Compressor(@CurrentHash, PChar(S), i * BuffSize);

Result := LowerCase(HashToStr(@CurrentHash));

end;

end.

Размещено на Allbest.ru