Найдена ошибка в IBX.

Всем известно что метод Locate у любых наследников tDataSet не должен возбуждать исключительную ситуацию (Exception) если не нашел искомую запись.
Однако в IBX, иногда, он это делает.
А именно, если выполнить присваивание закладки (Bookmark) ссылающейся на несуществующую запись, то он это сделает "молча", не возбуждая исключения. Естественно, после этого реальная позиция в наборе данных не отражает требования пользователя. Уже это можно считать ошибкой. Но, если после этого еще и вызвать Locate ищущий несуществующую в наборе данных запись, то вместо того что-бы получить результат False, мы получаем исключительную ситуацию EDatabaseError с текстом "Record not found".
Проще всего, это можно продемонстрировать на следующем примере:

Код

procedure Test; var  db :TIBDatabase;  Tr :TIBTransaction;  qs :TIBQuery;  qe :TIBQuery;  s :String; begin //  // создание необходимых компонент  db := TIBDatabase.Create(nil);  Tr := TIBTransaction.Create(nil);  qs := TIBQuery.Create(nil);  qe := TIBQuery.Create(nil);  try    // настройка компонентов    db.DatabaseName := 'C:\$Prg\Договора\v4\###\DB.GDB';    db.Params.Values['user_name' ] := 'SYSDBA';    db.Params.Values['password'  ] := 'masterkey';    db.LoginPrompt := False;    Tr.DefaultDatabase := db;    qs.Database := db;    qs.Transaction := tr;    qe.Database := db;    qe.Transaction := tr;    // создание тестовой таблицы    db.Open;    tr.StartTransaction;    try      qe.SQL.Text := 'CREATE TABLE Test_Table (F INTEGER)';      qe.ExecSQL;    except    end;    tr.Commit;    // добавление записи в тестовую таблицу    tr.StartTransaction;    qe.SQL.Text := 'INSERT INTO Test_Table VALUES (1)';    qe.ExecSQL;    // получение первой записи    qs.SQL.Text := 'SELECT * FROM Test_Table';    qs.Open;    // удаление всех записей    qe.SQL.Text := 'DELETE FROM Test_Table';    qe.ExecSQL;    // подтвердить транзакцию    s := qs.Bookmark;  // посвольку Commit закроет qs, сохраним позицию в нем    tr.Commit;    qs.Open;           // откроем закрытый Commit'ом qs    qs.Bookmark := s;  // вернем его в прежнюю позицию    // попытаться найти любую запись    ShowMessage('Сейчас будем выполнять Locate');    if  qs.Locate('F',1,[])  then      ShowMessage('Locate нашел запись')    else      ShowMessage('Locate не нашел запись')   ;  finally    // удалить тестовую таблицу    if  not tr.InTransaction  then  tr.StartTransaction;    try      qe.SQL.Text := 'DROP TABLE Test_Table';      qe.ExecSQL;    except    end;    tr.Commit;    // "грохнуть" все созданные компоненты    qs.Free;    qe.Free;    tr.Free;    db.Free;  end; end;

В нем, вместо последовательно получения сообщений:
'Сейчас будем выполнять Locate'
'Locate не нашел запись'

Мы получим:
'Сейчас будем выполнять Locate'
'Record not found' <- результат возникшего в Locate исключения EDatabaseError.
Не стану "нагружать" Вас рассказами почему это происходит, а сразу перейду к тому как исправить.
Сделать это не сложно. Но, поскольку в мире "бродят" несколько версий IBX, я не стану выкладывать сюда исправленный модуль, а приведу алгоритм исправления для версии v6.03. Если Вы используете другую версию IBX, то Вы сможете подправить ее самостоятельно.
Итак. Исправления нужно внести в файл IBCustomDataSet.pas. Там, нужно добавить одну строчку в тело метода TIBCustomDataSet.InternalGetRecord.
У себя, в v6.03, я сделал это так:

Код

function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode;  DoCheck: Boolean): TGetResult; begin  result := grError;  case GetMode of    gmCurrent:    begin      if (FCurrentRecord >= 0) then      begin        if FCurrentRecord < FRecordCount then          ReadRecordCache(FCurrentRecord, Buffer, False)        else        begin          while (not FQSelect.EOF) and                (FCurrentRecord >= FRecordCount) do          begin            if FQSelect.Next = nil then              break;            FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);            Inc(FRecordCount);          end;          FCurrentRecord := FRecordCount - 1;          if (FCurrentRecord >= 0) then            ReadRecordCache(FCurrentRecord, Buffer, False);        end;        result := grOk; {$IfDef NoChangesBySAP} // before changes by SAP {$Else}                 // after changes by SAP        if (FCurrentRecord < 0) then  result := grBOF; // <<<<<<<<< добавленная мною строка {$EndIf}      end      else        result := grBOF;    end;    gmNext:    begin      result := grOk;      if FCurrentRecord = FRecordCount then        result := grEOF      else      if FCurrentRecord = FRecordCount - 1 then      begin        if (not FQSelect.EOF) then        begin          FQSelect.Next;          Inc(FCurrentRecord);        end;        if (FQSelect.EOF) then        begin          result := grEOF;        end        else        begin          Inc(FRecordCount);          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);        end;      end      else        if (FCurrentRecord < FRecordCount) then        begin          Inc(FCurrentRecord);          ReadRecordCache(FCurrentRecord, Buffer, False);        end;    end;    else { gmPrior }    begin      if (FCurrentRecord = 0) then      begin        Dec(FCurrentRecord);        result := grBOF;      end      else        if (FCurrentRecord > 0) and                    (FCurrentRecord <= FRecordCount) then        begin          Dec(FCurrentRecord);          ReadRecordCache(FCurrentRecord, Buffer, False);          result := grOk;        end        else          if (FCurrentRecord = -1) then            result := grBOF;    end;  end;  if result = grOk then    result := AdjustCurrentRecord(Buffer, GetMode);  if result = grOk then    with PRecordData(Buffer)^ do    begin      rdBookmarkFlag := bfCurrent;      GetCalcFields(Buffer);    end  else    if (result = grEOF) then    begin      CopyRecordBuffer(FModelBuffer, Buffer);      PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;    end    else      if (result = grBOF) then      begin        CopyRecordBuffer(FModelBuffer, Buffer);        PRecordData(Buffer)^.rdBookmarkFlag := bfBOF;      end      else        if (result = grError) then        begin          CopyRecordBuffer(FModelBuffer, Buffer);          PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;        end; end;

В версии IBX v6.08, текст этого метода идентичен, поэтому Вы можете его туда просто скопировать. Про другие версии не знаю, но думаю что он уже давно не меняется.

Однако, стоит обратить внимание, что после исправления этой ошибки, в приведенном выше примере, Вы вообще не увидите сообщение 'Сейчас будем выполнять Locate'. Вместо него Вы сразу получите 'Record not found' - результат возникшего исключения EDatabaseError при выполнении строки:

Код

qs.Bookmark := s;  // вернем его в прежнюю позицию

Но это естественно правильно. Ведь присваиваемая закладка ссылается на уже не существующую запись. А что бы у Вас не оставалось сомнения в правильности этого, скажу что теперь, поведение IBX становится таким-же как и поведение ADO в подобных ситуациях - проверено .

Добавлено @ 11:20
Ой, совсем забыл:

• После внесения иправления в IBCustomDataSet.pas обеспечте его обязательную перекомпиляцию
• Если Вы используете компиляцию своих приложений с пакетами, то естественно, Вам обязательно надо будеит пересобрать пакет IBX

а все так безобидно начиналось.

А в Борланд написал?