Topic: [Скрипт] Проверка дубликат записи

Проверка существования дубликата записи перед сохранением.


Проект с примером:
http://myvisualdatabase.com/forum/misc. … download=1



Скрипт

function CheckDublicate (Action, sTable, sField, sValue: string; id: integer;): boolean;
var
   s: string;
   sIdSQL: string;

   arrFields: array of string;
   arrValues: array of string;

   sWhere: string;
   i,c: integer;
begin
    result := False;
    arrFields := SplitString(sField, ';');
    arrValues := SplitString(sValue, ';');
    if Length(arrFields) <> Length(arrFields) then exit;

    sWhere := '';
    c := Length(arrFields)-1;
    for i := 0 to c do
    begin
        if arrValues[i] <> 'NULL' then
            sWhere := sWhere + arrFields[i]+' LIKE ' + arrValues[i] + ' AND '
        else sWhere := sWhere + arrFields[i]+' IS NULL AND '
    end;

    if sWhere<>'' then SetLength(sWhere, Length(sWhere)-4);

    if Action = 'NewRecord' then
    begin
          s := SQLExecute ('SELECT Count(*) FROM '+sTable+' WHERE '+sWhere);
          if StrToInt(s) > 0 then result := True;
    end;

    if Action = 'ShowRecord' then
    begin
          if id <> -1 then sIdSQL := ' AND (id <> '+ IntToStr(id) +')';
          s := SQLExecute ('SELECT Count(*) FROM '+sTable+' WHERE ('+ sWhere +') ' + sIdSQL);
          if StrToInt(s) > 0 then result := True;
    end;
end;



procedure frmEmployee_Button2_OnClick (Sender: string; var Cancel: boolean);
var
    sFields, sValues: string;
begin
    sFields := 'lastname;firstname';
    sValues := frmEmployee.edLastName.sqlValue+';'+frmEmployee.edFistName.sqlValue;

   if CheckDublicate(frmEmployee.dbAction, 'employees', sFields, sValues, frmEmployee.ButtonSave.dbGeneralTableId) then
   begin
        ShowMessage('Person already exists.');
        Cancel := True;
   end;
end;

begin
end.
Dmitry.

Re: [Скрипт] Проверка дубликат записи

Огромное спасибо.

3 (edited by Hram 2015-04-11 07:22:39)

Re: [Скрипт] Проверка дубликат записи

Подскажите, а как можно сравнить значение, выбираемое с ComboBox?
Update.
Разобрался

 CheckDublicate(zapic_na_priem.dbAction, 'zapicnapriem', 'id_price', Inttostr(zapic_na_priem.Usluga.dbItemID), zapic_na_priem.Button4.dbGeneralTableId)

Re: [Скрипт] Проверка дубликат записи

Проверка существования дубликата записи не работает, количество вариантов зависит от последовательности ввода. Пример если ввести пользователя 1;1 потом  2;2 то пользователей 1;2 и 2;1 ввести не получится, если последовательность будет 1;2 далее (1;1 или 2;2)  и после  2;1 то вариантов получается 3.
Помогите нужно иметь возможность ввода 4-х не дублирующихся вариантов, а дубликаты блокировать   
Заранее спасибо

Re: [Скрипт] Проверка дубликат записи

VJM
Действительно, не учитывается это, немного исправил проект, пожалуйста скачайте снова.

Dmitry.

Re: [Скрипт] Проверка дубликат записи

А я при выходе из поля так проверяю. Это кривой способ?

begin
    if sLastActionForm = 'NewRecord' then
        if SQLExecute('SELECT count(id) FROM clients WHERE tel = '+frmClientsAdd.edTel.sqlValue) > 0
            then
                begin
                    MessageDLG('Данный телефон уже есть в базе!'#13#10'"Ищите женщину!" (с)',mtError, mbOK,0);
                    frmClientsAdd.btOk.Enabled := False;
                end
            else
                begin
                    frmClientsAdd.btOk.Enabled := True;
                end;
end;

Re: [Скрипт] Проверка дубликат записи

Raspr
Можно и так, только у вас нет проверки при редактировании записи, если вдруг кто то сменит телефон, который уже есть в базе.

Dmitry.

Re: [Скрипт] Проверка дубликат записи

Добрый день.
Подскажите как в приложенном примере сделать невозможным добавить более одной записи  в графу продукты строку со значением "Одна запись".
Спасибо.

Post's attachments

Attachment icon Пример.zip 356.02 kb, 573 downloads since 2017-11-09 

Re: [Скрипт] Проверка дубликат записи

Так?

Post's attachments

Attachment icon Программа учета.rar 309.02 kb, 846 downloads since 2017-11-09 

Re: [Скрипт] Проверка дубликат записи

Почти.
Только блокировать не все знания, а только "Одна запись" все остальные без ограничений.
И для каждой компании отдельно. То есть для каждой записи отдельно.

Re: [Скрипт] Проверка дубликат записи

Popkov-alex wrote:

Почти.
Только блокировать не все знания, а только "Одна запись" все остальные без ограничений.
И для каждой компании отдельно. То есть для каждой записи отдельно.

тогда так

procedure frmAddSell_Button1_OnClick (Sender: string; var Cancel: boolean);
var
    sFields, sValues: string;
begin
   if frmAddSell.cbProduct.dbItemID<>4 then exit; // значение "Одна запись" имеет идентификатор 4, поэтому проверяем

   sFields := 'id_product';
   sValues := frmAddSell.cbProduct.sqlValue;

   if CheckDublicate(frmAddSell.dbAction, 'sell', sFields, sValues, frmAddSell.Button1.dbGeneralTableId) then
   begin
        ShowMessage('Такая запись уже существует!');
        Cancel := True;
   end;
end;
Dmitry.

Re: [Скрипт] Проверка дубликат записи

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

Re: [Скрипт] Проверка дубликат записи

Popkov-alex wrote:

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

попробуйте так

procedure frmAddSell_Button1_OnClick (Sender: string; var Cancel: boolean);
var
    sFields, sValues: string;
begin
   if frmAddSell.cbProduct.dbItemID<>4 then exit;

   sFields := 'id_product;id_company';
   sValues := frmAddSell.cbProduct.sqlValue+';'+IntToStr(frmCompany.Button10.dbGeneralTableId);

   if CheckDublicate(frmAddSell.dbAction, 'sell', sFields, sValues, frmAddSell.Button1.dbGeneralTableId) then
   begin
        ShowMessage('Такая запись уже существует!');
        Cancel := True;
   end;
end;
Dmitry.

Re: [Скрипт] Проверка дубликат записи

Так работает.
Большое спасибо.