Найдена ошибка в 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
|
а все так безобидно начиналось. 