Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Использование гетов при поиске информации, Как лучше реализовать? 
V
    Опции темы
Rodeon
  Дата 7.12.2016, 02:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



Здравствуйте.
Не каждая контора может позволить себе систему электронного документооборота и контроля исполнения поручений, поэтому для своего удобства делаю небольшую прогу по отслеживанию приказов, распоряжений и т.д.
Ситуация следующая:
база данных на 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 

Это сообщение отредактировал(а) Rodeon - 7.12.2016, 02:06
PM MAIL   Вверх
Garmahis
Дата 7.12.2016, 09:15 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 23.12.2004

Репутация: нет
Всего: 4



Правильнее сделать третью таблицу для связи тегов с документами. В таблице достаточно 2 полей: IDDocument и IDTeg. При таком подходе будет гораздо проще делать выборку по тегам.
PM   Вверх
Rodeon
Дата 7.12.2016, 09:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



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

Правильно ли я вас понял, для каждого документа свои тэги будут или как? не пойму предложенной вами реализации.
PM MAIL   Вверх
Vas
Дата 7.12.2016, 21:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 828
Регистрация: 29.6.2005
Где: Stavropol region

Репутация: 23
Всего: 28



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


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

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


--------------------
И опыт, сын ошибок трудных, И гений, парадоксов друг, И случай, бог изобретатель. ... (А.С. Пушкин)
PM MAIL   Вверх
Rodeon
Дата 8.12.2016, 11:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



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

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 запрос. Всем спасибо.

Это сообщение отредактировал(а) Rodeon - 8.12.2016, 12:07
PM MAIL   Вверх
Vas
Дата 8.12.2016, 13:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 828
Регистрация: 29.6.2005
Где: Stavropol region

Репутация: 23
Всего: 28



Цитата(Rodeon @  8.12.2016,  11:51 Найти цитируемый пост)
Таким образом избавился от цикла, все делается в 1 запрос. Всем спасибо.

 
Все верно! 

Это сообщение отредактировал(а) Vas - 8.12.2016, 13:27


--------------------
И опыт, сын ошибок трудных, И гений, парадоксов друг, И случай, бог изобретатель. ... (А.С. Пушкин)
PM MAIL   Вверх
Rodeon
Дата 9.12.2016, 01:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



В виду того, что не нашел бесплатный компонент 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 

Это сообщение отредактировал(а) Rodeon - 9.12.2016, 01:17
PM MAIL   Вверх
Garmahis
Дата 9.12.2016, 09:56 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 23.12.2004

Репутация: нет
Всего: 4



Правильнее работать через 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]))  + ', ';

PM   Вверх
mailworker6
Дата 10.12.2016, 22:37 (ссылка)    |    (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered











http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

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

Этот ответ добавлен с нового Винграда - http://vingrad.com
  Вверх
mailworker6
Дата 10.12.2016, 22:37 (ссылка)    |    (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered











http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

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

Этот ответ добавлен с нового Винграда - http://vingrad.com
  Вверх
mailworker6
Дата 10.12.2016, 22:37 (ссылка)    |    (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered











http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

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

Этот ответ добавлен с нового Винграда - http://vingrad.com
  Вверх
mailworker6
Дата 10.12.2016, 22:37 (ссылка)    |    (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered











http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

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

Этот ответ добавлен с нового Винграда - http://vingrad.com
  Вверх
mailworker6
Дата 10.12.2016, 22:37 (ссылка)    |    (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered











http://tuvaonline.ru/banja_ydovolctvie_i_polza.dhtml

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

Этот ответ добавлен с нового Винграда - http://vingrad.com
  Вверх
Rodeon
Дата 11.12.2016, 04:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



Цитата(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;


PM MAIL   Вверх
Rodeon
Дата 11.12.2016, 10:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



В таблице "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!?
PM MAIL   Вверх
Vas
Дата 12.12.2016, 11:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 828
Регистрация: 29.6.2005
Где: Stavropol region

Репутация: 23
Всего: 28



Цитата(Rodeon @  11.12.2016,  10:53 Найти цитируемый пост)
Чтобы не делать функцию получения максимального значения ключа, добавляем в саму таблицу для поля/ключа ID триггер

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

Это сообщение отредактировал(а) Vas - 12.12.2016, 11:38


--------------------
И опыт, сын ошибок трудных, И гений, парадоксов друг, И случай, бог изобретатель. ... (А.С. Пушкин)
PM MAIL   Вверх
Rodeon
Дата 12.12.2016, 12:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



Цитата(Vas @ 12.12.2016,  11:38)
Цитата(Rodeon @  11.12.2016,  10:53 Найти цитируемый пост)
Чтобы не делать функцию получения максимального значения ключа, добавляем в саму таблицу для поля/ключа ID триггер

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

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

PM MAIL   Вверх
Vas
Дата 12.12.2016, 13:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 828
Регистрация: 29.6.2005
Где: Stavropol region

Репутация: 23
Всего: 28



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

[off]
Embedded умеет и мускуль smile Но капризный слегка smile
[/off]

Это сообщение отредактировал(а) Vas - 12.12.2016, 13:05


--------------------
И опыт, сын ошибок трудных, И гений, парадоксов друг, И случай, бог изобретатель. ... (А.С. Пушкин)
PM MAIL   Вверх
Rodeon
Дата 12.12.2016, 14:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



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

Сегодня реализуем 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.

PM MAIL   Вверх
Rodeon
Дата 12.12.2016, 14:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



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

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, 14:56
PM MAIL   Вверх
Rodeon
Дата 12.12.2016, 15:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



Перепробовал несколько готовых модулей получения хеша, 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]);

PM MAIL   Вверх
Rodeon
Дата 12.12.2016, 19:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



Чтобы получить 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.
PM MAIL   Вверх
Rodeon
Дата 12.12.2016, 19:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



Заполняем таблицу 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 с сохранением расширения.
PM MAIL   Вверх
Rodeon
Дата 14.12.2016, 19:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 124
Регистрация: 28.8.2008
Где: Россия, Ухта

Репутация: нет
Всего: нет



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

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 изменений.
PM MAIL   Вверх
Страницы: (2) [Все] 1 2 
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Базы данных и репортинг"
Vit
Петрович

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами


Обязательно указание:

1. Базы данных (Paradox, Oracle и т.п.)

2. Способа доступа (ADO, BDE и т.д.)


  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • Вопросы по SQL и вопросы по базам данных не связанные с Дельфи задавать здесь

FAQ раздела лежит здесь!


Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Vit, Петрович.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Базы данных и репортинг | Следующая тема »


 




[ Время генерации скрипта: 0.2814 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.