Использование гетов при поиске информации

 
0
 
Delphi, Kylix and Pascal
ava
Rodeon | 07.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;


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


Ответы (20)
ava
Garmahis | 07.12.2016, 09:15 #
Правильнее сделать третью таблицу для связи тегов с документами. В таблице достаточно 2 полей: IDDocument и IDTeg. При таком подходе будет гораздо проще делать выборку по тегам.
ava
Rodeon | 07.12.2016, 09:38 #
Хм... немного не могу понять как оно будет работать?!
У меня и так отдельная таблица с тэгами, в ней всего 1 поле - Char, в каждую строку занесен один тэг. При выводе приказов все поля подгружаются в sCheckListBox, и путем выбора нужных тегов в списке остаются необходимые приказы. Т.е. выбрал например тэги: "2016", "назначения", "ТБ"
выведет все приказы (другая таблица), у которых в строке Tags (длиной 250) встречаются все вышеуказанные слова.

Правильно ли я вас понял, для каждого документа свои тэги будут или как? не пойму предложенной вами реализации.
ava
Vas | 07.12.2016, 21:04 #
Документы
ИД
Название


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

Таблица для связи многие ко многим
ИД_Документа
Ид_Тега
ava
Rodeon | 08.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 findReferencedText)
Таблица для связи многие ко многим

ИД_Документа

Ид_Тега 

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

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



ava
Vas | 08.12.2016, 13:23 #
Цитата (Rodeon @  8.12.2016,  11:51 findReferencedText)
Таким образом избавился от цикла, все делается в 1 запрос. Всем спасибо.


Все верно!
ava
Rodeon | 09.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');
  Rabotniki_IBQuery.SQL.Add(' LEFT JOIN tags on tags.id = document_tag.id_tag where tags.ID in ('+s+')');
  Rabotniki_IBQuery.Open;
end;


Ну и чтобы галочку поставить, что вопрос решенный.  :dance3 
ava
Garmahis | 09.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]))  + ', ';
ava
mailworker5 | 09.12.2016, 18:40 #
http://rusregioninform.ru/stati-i-obzori/l...dit-v-bane.html

Лучшие корпоративы нужно проводить в бане!
Великолепная природа, зеркальная вода, отличная парная.
Это все создаст непринужденную обстановку и, наверняка, поможет добиться желаемых результатов в деловых переговорах.
Проведите Новогодний корпоратив в бане – наберетесь сил, отдохнете и укрепите здоровье
Проведенный в бане корпоратив,улучшает благоприятную атмосферу общения сотрудников,
снимает стрессовое напряжение, нередко возникающее у них в условиях достаточно напряженной и высоко ответственной работы.



ava
mailworker6 | 10.12.2016, 22:37 #
http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

если вас интересует турецкая баня в Москве или хамам,
то вам тем более нужно в «Таёжные бани», где вашему желанию непременно найдётся реализация.
Интересной особенностью турецких бань всегда была было повышенное внимание к внутренней архитектуре и убранству,
которое должно сразу настроить посетителя на то, что он вступает в храм,
храм омовения и чистоты не только тела.
ava
Rodeon | 11.12.2016, 04:53 #
Цитата (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]))  + ', ';


Огромное спасибо. Только попробовал предложенный вами код, все очень и очень стало проще. Теперь все подставляемые значения хранятся в 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;

ava
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!?
ava
Vas | 12.12.2016, 11:38 #
Цитата (Rodeon @  11.12.2016,  10:53 findReferencedText)
Чтобы не делать функцию получения максимального значения ключа, добавляем в саму таблицу для поля/ключа ID триггер

Зачем такие сложности? Чем автоинкрементное поле не угодило в MySQL?
ava
Rodeon | 12.12.2016, 12:40 #
Цитата (Vas @ 12.12.2016,  11:38)
Цитата (Rodeon @  11.12.2016,  10:53 findReferencedText)
Чтобы не делать функцию получения максимального значения ключа, добавляем в саму таблицу для поля/ключа ID триггер


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

Эм... :blush тут такая штука. На самом деле база данных стала FireByrd, а в ней нет по умолчанию поля с автоинкрементом.
Все потому, что я новичок в базах данных и только изучаю.
Сперва была MySQL, но с момента создания темы перешел на FireByrd Embedded по ряду причин, основная это автономность.
ava
Vas | 12.12.2016, 13:02 #
Embedded умеет и мускуль :) Но капризный слегка :)
ava
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.
ava
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
    DropPoint := Catcher.DropPoint;
  finally
  end;
  Msg.Result := 0;
end;


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

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

    Catcher.Free;
ava
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;
ava
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.
ava
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 с сохранением расширения.
ava
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 изменений.
Зарегистрируйтесь или войдите, чтобы написать.
Фирма дня
Вы также можете добавить свою фирму в каталог IT-фирм, и публиковать статьи, новости, вакансии и другую информацию от имени фирмы.
Подробнее
Участники
advanced
Отправить