Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Базы данных и репортинг > Использование гетов при поиске информации

Автор: Rodeon 7.12.2016, 02:02

Здравствуйте.
Не каждая контора может позволить себе систему электронного документооборота и контроля исполнения поручений, поэтому для своего удобства делаю небольшую прогу по отслеживанию приказов, распоряжений и т.д.
Ситуация следующая:
база данных на MySQL
В первой таблице хранятся тэги, которые подгружаются в CheckListBox, где выбираются (как например: 2016, подписанные, актуальные, 2015 и т.д.)

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

Для поиска нужного документа, выбираю необходимые теги из CheckListBox, запрос формирую подобным образом:

Код


procedure TMainForm.sButton1Click(Sender: TObject);
var
  I, checked : Integer;
  Addon: Boolean;
begin
  checked:= 0;
  Addon:= False;
  for i := 0 to sCheckListBox1.Count - 1 do if sCheckListBox1.Checked[i] then Inc(checked);
  Rabotniki_IBQuery.SQL.Clear;
  Rabotniki_IBQuery.SQL.Add('select * from INFORMATION');
  If checked>0 then
  Begin
    for i := 0 to sCheckListBox1.Items.Count - 1 do
    begin
      if sCheckListBox1.Checked[i]=true then
      Case Addon of
      False: Begin
               Rabotniki_IBQuery.SQL.Add(' WHERE TEGS LIKE ''%'+sCheckListBox1.Items.Strings[i]+'%''');
               Addon:=True;
             End;
      True: Rabotniki_IBQuery.SQL.Add(' OR TEGS LIKE ''%'+sCheckListBox1.Items.Strings[i]+'%''');
      End;
    End;
  End;
  Rabotniki_IBQuery.Open;
end;

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

В шапке опечатка, поздно заметил. smile

Автор: Garmahis 7.12.2016, 09:15

Правильнее сделать третью таблицу для связи тегов с документами. В таблице достаточно 2 полей: IDDocument и IDTeg. При таком подходе будет гораздо проще делать выборку по тегам.

Автор: Rodeon 7.12.2016, 09:38

Хм... немного не могу понять как оно будет работать?!
У меня и так отдельная таблица с тэгами, в ней всего 1 поле - Char, в каждую строку занесен один тэг. При выводе приказов все поля подгружаются в sCheckListBox, и путем выбора нужных тегов в списке остаются необходимые приказы. Т.е. выбрал например тэги: "2016", "назначения", "ТБ"
выведет все приказы (другая таблица), у которых в строке Tags (длиной 250) встречаются все вышеуказанные слова.

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

Автор: Vas 7.12.2016, 21:04

Документы
ИД
Название

Теги
Ид
Название

Таблица для связи многие ко многим
ИД_Документа
Ид_Тега

Автор: Rodeon 8.12.2016, 11:51

Дошло наконец, что вы хотели сказать.
Все сделал, проверил, запрос заботает в таком виде:

Код


SELECT DISTINCT name FROM document_tag
LEFT JOIN document ON document.id = document_tag.id_document
LEFT JOIN tags on tags.id = document_tag.id_tag

Только это полдела, так как он выводить все приказы, в которых есть хотя бы 1 тег.
У меня в таблице:

Цитата(Vas @ 7.12.2016, 21:04

)

Таблица для связи многие ко многим
ИД_Документа
Ид_Тега

каждому документу присваивается несколько тегов:
ИД_Документа     Ид_Тега
1                              1
1                               2
1                               6
2                               1
2                                6
2                               4
и т.д.

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

Добавлено @ 12:05
Все, так вобще хорошо:
в конце добавляет ID тегов, и выводит только те приказы у которых они есть:

Код


SELECT DISTINCT name,document.id,Tags.id FROM document_tag
LEFT JOIN document ON document.id = document_tag.id_document
LEFT JOIN tags on tags.id = document_tag.id_tag where tags.ID in (№раз,№два и т.д. через запятую)

Таким образом избавился от цикла, все делается в 1 запрос. Всем спасибо.

Автор: Vas 8.12.2016, 13:23

Цитата(Rodeon @ 8.12.2016, 11:51

)

Таким образом избавился от цикла, все делается в 1 запрос. Всем спасибо.

Все верно!

Автор: Rodeon 9.12.2016, 01:14

В виду того, что не нашел бесплатный компонент DbCheckListBox, пришлось по списку выбранных в sCheckListBox-е пунктов пробегать циклом.

Код


procedure TMainForm.sButton1Click(Sender: TObject);
var
  i: Integer;
  s: String;
begin
  i := 0;
  s:='';
  while i < sCheckListBox1.Items.Count do
  Begin
    if (sCheckListBox1.Checked[i]) AND (S<>'') then s:=s+', '+sCheckListBox1.Items.Strings[i];
    if (sCheckListBox1.Checked[i]) AND (S='') then s:=sCheckListBox1.Items.Strings[i];
    Inc(i);
  End;
  Rabotniki_IBQuery.SQL.Clear;
  Rabotniki_IBQuery.SQL.Add('SELECT DISTINCT name,document.id,Tags.id FROM document_tag');
  Rabotniki_IBQuery.SQL.Add(' LEFT JOIN document ON document.id = document_tag.id_document');
  If s<>'' then Rabotniki_IBQuery.SQL.Add(' LEFT JOIN tags on tags.id = document_tag.id_tag where tags.ID in ('+s+')')
  Else Rabotniki_IBQuery.SQL.Add(' LEFT JOIN tags on tags.id = document_tag.id_tag');
  Rabotniki_IBQuery.Open;
end;

Ну и чтобы галочку поставить, что вопрос решенный. smile

Автор: Garmahis 9.12.2016, 09:56

Правильнее работать через Object.
Грузить в sCheckListBox1 записи в цикле по таблице тегов селектишь id и teg и пихаешь вот так:

Код


sCheckListBox1 .Items.AddObject(Rabotniki_IBQuery.FieldByName('Tag').AsString, Pointer(Rabotniki_IBQuery.FieldByName('ID').AsInteger));

Соотвественно id тегов получаешь примерно так:

Код


for i := 0 to sCheckListBox1 .Items.Count - 1 do
  if sCheckListBox1.Checked[i] then
    s := s + IntToStr(Integer(sCheckListBox1.Items.Objects[i]))  + ', ';

Автор: mailworker6 10.12.2016, 22:37

http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

если вас интересует турецкая баня в Москве или хамам,
то вам тем более нужно в «Таёжные бани», где вашему желанию непременно найдётся реализация.
Интересной особенностью турецких бань всегда была было повышенное внимание к внутренней архитектуре и убранству,
которое должно сразу настроить посетителя на то, что он вступает в храм,
храм омовения и чистоты не только тела.

Этот ответ добавлен с нового Винграда - http://ru.vingrad.com/Ispolzovaniye-getov-pri-poiske-informatsii-id584743a6b4c92c457d4850f2#findElement_E7045_584c597720a8ef7c9c64e600_0

Автор: mailworker6 10.12.2016, 22:37

Автор: Rodeon 11.12.2016, 04:53

Цитата(Garmahis @ 9.12.2016, 09:56)

Код


sCheckListBox1 .Items.AddObject(Rabotniki_IBQuery.FieldByName('Tag').AsString, Pointer(Rabotniki_IBQuery.FieldByName('ID').AsInteger));

Соотвественно id тегов получаешь примерно так:

Код


for i := 0 to sCheckListBox1 .Items.Count - 1 do
  if sCheckListBox1.Checked[i] then
    s := s + IntToStr(Integer(sCheckListBox1.Items.Objects[i]))  + ', ';

Огромное спасибо. Только попробовал предложенный вами код, все очень и очень стало проще. Теперь все подставляемые значения хранятся в 1 таблице, у каждого свой уникальный (!!!) ID. При заполнении разных Combobox-ов и CheckBox-ов просто игнорирую null строки. Конечный SQL запрос для вывода в общую базу только вырос.

Чтобы наглядно было, мало ли кому понадобится (сделал маленькую базу на 3 колонки (ID, Type, Status):

Код


procedure TPrikazForm.FormCreate(Sender: TObject);
begin
  MainForm.IBQuery1.Active:=False;  {Активируем}
  MainForm.IBQuery1.SQL.Clear; {Очищаем строку запроса}
  MainForm.IBQuery1.SQL.Text:='Select * From PRIKAZ_TYPE'; {Выбираем всю таблицу}
  MainForm.IBQuery1.Active:=true;  {Активируем}
  If MainForm.IBQuery1.RecordCount>0 then  {Проверяем колличество записей}
  Begin
    sComboBox1.items.clear; {Очищаем комбобоксы}
    sComboBox2.items.clear;
    while not MainForm.IBQuery1.Eof do {В цикле заполняем sComboBox-ы}
    begin {Так как значений в поле "Type" у меня 3 штуки, а значений в поле "Status" у меня 5, причем специально сделал вразнобой, внес проверку на Null, все выбираемые параметры внес в 1 таблицу, так как все подгружается 1 циклом, вместо обращения к нескольким таблицам}
      If MainForm.IBQuery1.FieldByName('Type').Value<>Null then sComboBox1.Items.AddObject(MainForm.IBQuery1.FieldByName('Type').AsString, Pointer(MainForm.IBQuery1.FieldByName('ID').AsInteger));  {я наверное не правильно назову, но создаем в комбобоксе индексированные записи}
      If MainForm.IBQuery1.FieldByName('Status').Value<>Null then sComboBox2.Items.AddObject(MainForm.IBQuery1.FieldByName('Status').AsString, Pointer(MainForm.IBQuery1.FieldByName('ID').AsInteger));
      MainForm.IBQuery1.Next;
    End;
    sComboBox1.ItemIndex:=0; 
    sComboBox2.ItemIndex:=0;
  End;
end;

В итоге, после выбора в sComboBox-ах нужных строк, индексы в таблице, соответствующие именно выбранным строковым значениям получаем следующим образом, как пример:

Код


procedure TPrikazForm.sBitBtn3Click(Sender: TObject);
begin
  SMemo1.Lines.Add(IntToStr(Integer(sComboBox2.Items.Objects[sComboBox2.ItemIndex]))); {т.е. в Мемо вносится именно ID соответствующее в таблице, в то время как sComboBox2.ItemIndex будет иным.}
end;

Автор: Rodeon 11.12.2016, 10:53

В таблице "PRIKAZ" основной ключ ID, но у него нет автоинкремента.
Чтобы не делать функцию получения максимального значения ключа, добавляем в саму таблицу для поля/ключа ID триггер:

Код


SET SQL DIALECT 3;
CREATE GENERATOR GEN_PRIKAZ_ID;
SET TERM ^ ;
CREATE OR ALTER TRIGGER PRIKAZ_BI FOR PRIKAZ
ACTIVE BEFORE INSERT POSITION 0
as
begin
  if (new.id is null) then
    new.id = gen_id(gen_prikaz_id,1);
end
^
SET TERM ; ^

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

Далее загружаю данные из дочернего окна PrikazForm:

Код


procedure TPrikazForm.sBitBtn3Click(Sender: TObject);
begin
  with MainForm.IBQuery1 do
  begin
    Active:=false;
    Sql.Clear;
    if not Transaction.InTransaction then Transaction.StartTransaction;
    ParamCheck := True;
    SQL.Add('INSERT INTO PRIKAZ (NOMER_PRIKAZ, DATA_PRIKAZ, STATUS_PRIKAZ, TIP_PRIKAZ, NAME_PRIKAZ, FILE_PRIKAZ, TAG, KOMMENT_PRIKAZ) VALUES (:NOMER_PRIKAZ, :DATA_PRIKAZ, :STATUS_PRIKAZ, :TIP_PRIKAZ, :NAME_PRIKAZ, :FILE_PRIKAZ, :TAG, :KOMMENT_PRIKAZ)');
    Params[0].AsString := sEdit1.Text;
    Params[1].AsDate := sDateEdit1.Date;
    Params[2].AsString := IntToStr(Integer(sComboBox2.Items.Objects[sComboBox2.ItemIndex]));
    Params[3].AsString := IntToStr(Integer(sComboBox1.Items.Objects[sComboBox1.ItemIndex]));
    Params[4].AsString := sMemo1.Lines.Text;
    Params[5].AsString := sEdit2.Text;
    Params[6].AsString := sCheckListBox1.Items.Text;
    Params[7].AsString := sMemo2.Lines.Text;
    try
      ExecSql;
      except
        on E: Exception Do
        Begin
        {Что-то пошло не так :-(}
        End;
      end;
    Close;
    if Transaction.InTransaction then Transaction.Commit;
  END;
end;

Все работает, проверил. Может знатоки посоветуют где можно улучшить, как ранее советовал Garmahis!?

Автор: Vas 12.12.2016, 11:38

Цитата(Rodeon @ 11.12.2016, 10:53

)

Чтобы не делать функцию получения максимального значения ключа, добавляем в саму таблицу для поля/ключа ID триггер

Зачем такие сложности? Чем автоинкрементное поле не угодило в MySQL?

Автор: Rodeon 12.12.2016, 12:40

Цитата(Vas @ 12.12.2016, 11:38)

Цитата(Rodeon @ 11.12.2016, 10:53

)

Зачем такие сложности? Чем автоинкрементное поле не угодило в MySQL?

Эм...

тут такая штука. На самом деле база данных стала FireByrd, а в ней нет по умолчанию поля с автоинкрементом.
Все потому, что я новичок в базах данных и только изучаю.
Сперва была MySQL, но с момента создания темы перешел на FireByrd Embedded по ряду причин, основная это автономность.

Автор: Vas 12.12.2016, 13:02

В таком случает триггер отличный вариант.

[off]
Embedded умеет и мускуль smile

Но капризный слегка smile

[/off]

Автор: Rodeon 12.12.2016, 14:25

Да простят меня модераторы, буду описывать план действий дальнейшего создания приложения.

Сегодня реализуем Drag & Drop файла (-ов) приказа на форму программы, открытие окна для ввода данных по приказу и сохранения всех данных в базу.
Изначально решил, что после добавления приказа, файлы (jpg, pdf) будут копироваться в определенную папку на жестком диске, рядом с программой.
Но имя им будет присвоено на основе MD5 хеша (расширение сохраняем), тем самым убиваем сразу 3 зайцев:
1. удобно проверить если уже подобный файл добавлен (совпадут хеши).
2. более короткое имя файла становится автоматом (32 символа, вместо N-го которым у нас привыкли обзывают других отделы, от этого много косяков потом бывает).
3. При несанкционированном доступе к папке фиг найдешь что-то, так как все файлы будут иметь имя 32 символа.

Собственно, таблица для хранения файлов приказов будет такой:
Первичный ключ:

Код


ALTER TABLE FILE_PRIKAZ
ADD CONSTRAINT PK_FILE_PRIKAZ
PRIMARY KEY (ID)

Сама таблицу:

Код


CREATE TABLE FILE_PRIKAZ (
    ID INTEGER NOT NULL,
    ID_PRIKAZ INTEGER,
    SHORT_NAME CHAR(37),
    FULL_NAME CHAR(255))

Создаем генератор:

Код


CREATE SEQUENCE GEN_FILE_PRIKAZ_ID

Создаем триггер автоинкремента:

Код


CREATE OR ALTER TRIGGER FILE_PRIKAZ_BI FOR FILE_PRIKAZ
ACTIVE BEFORE INSERT POSITION 0
as
begin
  if (new.id is null) then
    new.id = gen_id(GEN_FILE_PRIKAZ_ID,1);
end

В базе:
ID - тут будет уникальный индекс.
ID_PRIKAZ - индекс на ID приказа.
SHORT_NAME - имя файла(32) + точка(1) и расширение (4)
FULL_NAME - имя файла по факту (ограничение имени файла NTFS - 255 символов)
Т.е. визуально для пользователя будет выводится FULL_NAME, фактически везде SHORT_NAME.

Автор: Rodeon 12.12.2016, 14:44

Обрабатываем взброса файлов на форму (исходники нашел на просторах интернета, самую малостью изменил под свои нужды):
Для события создания формы добавляем:

Код


procedure TMainForm.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Self.Handle, True);
end;

В Uses добавляем:

Код


ShellAPI

Добавил глобальный объект:

Код


  Catcher: TFileCatcher;

Создаем новый тип:

Код


type
  TFileCatcher = class(TObject)
  private
    fDropHandle: HDROP;
    function GetFile(Idx: Integer): string;
    function GetFileCount: Integer;
    function GetPoint: TPoint;
  public
    constructor Create(DropHandle: HDROP);
    destructor Destroy; override;
    property FileCount: Integer read GetFileCount;
    property Files[Idx: Integer]: string read GetFile;
    property DropPoint: TPoint read GetPoint;
  end;

Для формы добавляем новую процедуру:

Код


type
  TMainForm = class(TForm)
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;

Добавляем функции, процедуры и т.д.:

Код


implementation

{$R *.dfm}

constructor TFileCatcher.Create(DropHandle: HDROP);
begin
  inherited Create;
  fDropHandle := DropHandle;
end;

destructor TFileCatcher.Destroy;
begin
  DragFinish(fDropHandle);
  inherited;
end;

function TFileCatcher.GetFile(Idx: Integer): string;
var
  FileNameLength: Integer;
begin
  FileNameLength := DragQueryFile(fDropHandle, Idx, nil, 0);
  SetLength(Result, FileNameLength);
  DragQueryFile(fDropHandle, Idx, PChar(Result), FileNameLength + 1);
end;

function TFileCatcher.GetFileCount: Integer;
begin
  Result := DragQueryFile(fDropHandle, $FFFFFFFF, nil, 0);
end;

function TFileCatcher.GetPoint: TPoint;
begin
  DragQueryPoint(fDropHandle, Result);
end;

procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
var
  I: Integer;
  DropPoint: TPoint;
begin
  Catcher := TFileCatcher.Create(Msg.Drop);
  try
    begin {Тут у меня добавлено вызов окна заполнения данных по приказу и вывод в Memo списка файлов, чисто для визуализации, так как фактически список хранится в Catcher}
      if Not Assigned(PrikazForm) then Application.CreateForm(TPrikazForm, PrikazForm);
      PrikazForm.Show;
      for I := 0 to Pred(Catcher.FileCount) do PrikazForm.sMemo3.Lines.Add(ExtractFileName(Catcher.Files[i]));
    end;
    DropPoint := Catcher.DropPoint;
  finally
  end;
  Msg.Result := 0;
end;

Таким образом:
Catcher.FileCount у нас хранится количество файлов.
Catcher.Files[N] - имя файла номер N.

Не забываем после окончания работ с полученным списком файлов уничтожить объект:

Код


    Catcher.Free;

Автор: Rodeon 12.12.2016, 15:22

Перепробовал несколько готовых модулей получения хеша, CRC32 короткое имя, самое то MD5, собственно сам модуль:
Добавляем в программу:

Код


Uses
  md5Module

Собственно сам модуль:

Код


unit md5Module;

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.

Вызываем следующим образом (на выходе строка длиной 32 символа):

Код


function md5(S: String): String;

Добавлено через 7 минут и 20 секунд
Для добавления в базу потребуются преобразования имени файла:
Получить имя файла, без пути и расширения:

Код


S:=ChangeFileExt(ExtractFileName(Catcher.Files[i]),'');

Получить расширение имени файла:

Код


S:=ExtractFileExt(Catcher.Files[i]);

И все вместе, получаем имя файла преобразованное в MD5 + расширение:

Код


S:=md5(ChangeFileExt(ExtractFileName(Catcher.Files[i]),''))+ExtractFileExt(Catcher.Files[i]);

Автор: Rodeon 12.12.2016, 19:19

Чтобы получить ID созданной записи в таблице PRIKAZ (для увязки файлов ID_PRIKAZ.FILE_PRIKAZ к приказу) необходимо обратится к генератору:
добавим переменную, в которую будем получать ID:

Код


Var
  ID_return: Integer;

После создания записи в таблице PRIKAZ получаем ID этой записи:

Код


  with MainForm.IBQuery1 do
  begin
    SQL.Clear;
    SQL.Add('select gen_id(gen_prikaz_id, 0) from rdb$database'); {тут указан генератор, на который накручен триггер для автоинкремента, 0 для того что не увеличиваем, а берем как раз последний}
    Open;
    ID_return:=FieldByName('GEN_ID').AsInteger; 
    Close;
  end;

Теперь у нас в переменной ID_return последний ID таблицы PRIKAZ.

P.S. как оказалось в FireByrd-е мало того, что нету поля с автоинкрементом, так еще и нет метода подобному GetInsertID.

Автор: Rodeon 12.12.2016, 19:40

Заполняем таблицу FILE_PRIKAZ (помним, что для поля ID.FILE_PRIKAZ ранее создан триггер-автоинкремент, в Catcher у нас хранятся файлы дропнутые на форму, в ID_return хранится ID.PRIKAZ только что созданного приказа):

Код


  If Catcher.FileCount>0 then
  Begin
    For i:=0 to Catcher.FileCount-1 do
    Begin
      with MainForm.IBQuery1 do
      begin
        Active:=false;
        Sql.Clear;
        SQL.Add('INSERT INTO FILE_PRIKAZ (ID_PRIKAZ, SHORT_NAME, FULL_NAME) VALUES');
        SQL.Add(' (:ID_PRIKAZ, :SHORT_NAME, :FULL_NAME)');
        Params[0].AsInteger := ID_return;
        Params[1].AsString := md5(ChangeFileExt(ExtractFileName(Catcher.Files[i]),''))+ExtractFileExt(Catcher.Files[i]);
        Params[2].AsString := ExtractFileName(Catcher.Files[i]);
        try
          ExecSql;
        except
          on E: Exception do
          Begin
          {×òî-òî ïîøëî íå òàê}
          End;
        end;
        Close;
        if Transaction.InTransaction then Transaction.Commit;
        CopyFile(PChar(Catcher.Files[i]),PChar(ExtractFilePath(Application.ExeName)+'Prikaz\'+md5(ChangeFileExt(ExtractFileName(Catcher.Files[i]),''))+ExtractFileExt(Catcher.Files[i])),True);
      end;
    End;
  end;

Т.е., что мы сделали:
в ID_PRIKAZ записали ID приказа.
в SHORT_NAME записали MD5 от реального имени файла + расширение сохранили
в FULL_NAME записали реальное имя файла, которое и будет участвовать в последующем в визуализации.
Помимо этого скопировали все файлы в подпапку, где лежит сама программа с новыми именами MD5 с сохранением расширения.

Автор: Rodeon 14.12.2016, 19:49

Для тегов у нас таблица:

Код


CREATE TABLE PRIKAZ_TAGS (
    ID_PRIKAZ  INTEGER NOT NULL,
    ID_TAGS    INTEGER NOT NULL
);

Добавляем тэги с базу PRIKAZ_TAGS сопоставляя с индексом последнего приказа ID_return:

Код


  With MainForm.IBQuery1 do
  begin
    Transaction.Active:= False; {Если не дизактивировать будет ошибка об открытой транзакции}
    Transaction.StartTransaction; {Начинаем локальную транзакцию, далее до Commit данные в базе не появятся, тем самым все действия в цикле выполняются "виртуально"}
    for i := 0 to sCheckListBox1.Items.Count - 1 do if sCheckListBox1.Checked[i] Then
    Begin
      SQL.Text:=('INSERT INTO PRIKAZ_TAGS (ID_PRIKAZ, ID_TAGS) VALUES (:ID_PRIKAZ, :ID_TAGS)');
      ParamByname('ID_PRIKAZ').AsInteger := ID_return;
      ParamByname('ID_TAGS').AsInteger := Integer(sCheckListBox1.Items.Objects[i]);
      try
        ExecSQL;
      except
        Transaction.Rollback; {если что-то пошло не так, делаем откат}
      End;
    End;
    Transaction.Commit; {заносим строки в базу}
  End;

P.S. Да поправят меня знатоки: размер транзакции может быть до 16 мб, Commit желательно делать каждые 1000 изменений.