Решение проблем дисконнекта в IBX

Базируется на переписке ThreeDHead и Vlad Filippov:

окончательный вариант для IBX 6.03 выглядит так:

//--------------------------------------------
//IBCustomDataSet.pas
//--------------------------------------------

procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
begin
if Active then
Active := False;
if FQSelect <> nil then
try // <--- My changes
FQSelect.FreeHandle;
except // <--- My changes
end; // <--- My changes
if FQDelete <> nil then
try // <--- My changes
FQDelete.FreeHandle;
except // <--- My changes
end; // <--- My changes
if FQInsert <> nil then
try // <--- My changes
FQInsert.FreeHandle;
except // <--- My changes
end; // <--- My changes
if FQModify <> nil then
try // <--- My changes
FQModify.FreeHandle;
except // <--- My changes
end; // <--- My changes
if FQRefresh <> nil then
try // <--- My changes
FQRefresh.FreeHandle;
except // <--- My changes
end; // <--- My changes
FInternalPrepared := false;
if Assigned(FBeforeTransactionEnd) then
   FBeforeTransactionEnd(Sender);
end;

procedure TIBCustomDataSet.InternalClose;
begin
if Assigned(Transaction) then
  Transaction.CheckAutoStop;
try // <--- My changes
FQSelect.Close;
except // <--- My changes end;
// <--- My changes ClearBlobCache;
FreeRecordBuffer(FModelBuffer);
FreeRecordBuffer(FOldBuffer);
FCurrentRecord := -1;
FOpen := False;
FRecordCount := 0;
FDeletedRecords := 0;
FRecordSize := 0;
FBPos := 0;
FOBPos := 0;
FCacheSize := 0;
FOldCacheSize := 0;
FBEnd := 0;
FOBEnd := 0;
ReallocMem(FBufferCache, 0);
ReallocMem(FOldBufferCache, 0);
BindFields(False);
FUpdatesPending := false;
if DefaultFields then
DestroyFields;
end;

//--------------------------------------------
IBSQL.pas
//--------------------------------------------

procedure TIBSQL.FreeHandle;
var
isc_res: ISC_STATUS;
begin
try
{ The following two lines merely set the SQLDA count
variable FCount to 0, but do not deallocate
That way the allocations can be reused for
a new query sring in the same SQL instance }
FSQLRecord.Count := 0;
FSQLParams.Count := 0;
if (FHandle <> nil) and (not CheckStatusVector([isc_network_error]))
then // <--- My changes (NB)
begin
isc_res :=
Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop),
     False);
if (StatusVector^ = 1) and (isc_res > 0) and (isc_res <>
     isc_bad_stmt_handle) and
(isc_res <> isc_lost_db_connection) then
IBDataBaseError;
end;
finally
FPrepared := False;
FHandle := nil;
end;
end;

//--------------------------------------------
//IBDatabase.pas
//--------------------------------------------

procedure TIBDatabase.InternalClose(Force: Boolean);
var
i: Integer;
begin
CheckActive;
{ Tell all connected transactions that we're disconnecting.
This is so transactions can commit/rollback, accordingly
   }
for i := 0 to FTransactions.Count - 1 do
begin
try
if FTransactions[i] <> nil then
Transactions[i].BeforeDatabaseDisconnect(Self);
except
if not Force then
raise;
end;
end;
for i := 0 to FSQLObjects.Count - 1 do
begin
try
if FSQLObjects[i] <> nil then
try // <--- My changes
SQLObjects[i].DoBeforeDatabaseDisconnect;
except // <--- My changes
end; // <--- My changes
except
if not Force then
raise;
end;
end;
if (not HandleIsShared) then // <--- My changes (NB)
begin // <--- My changes (NB)
if (not CheckStatusVector([isc_network_error])) and //<--- My changes (NB)
(Call(isc_detach_database(StatusVector,@FHandle),False) > 0) and //<--- My changes (NB)
(not Force) then // <--- My changes (NB)
IBDataBaseError;
end // <--- My changes (NB)
else
begin
FHandle := nil;
FHandleIsShared := False;
end;
if not (csDesigning in ComponentState) then
MonitorHook.DBDisconnect(Self);
for i := 0 to FSQLObjects.Count - 1 do
if FSQLObjects[i] <> nil then
SQLObjects[i].DoAfterDatabaseDisconnect;
end;

procedure TIBTransaction.EndTransaction(Action: TTransactionAction; Force: Boolean);
var
status: ISC_STATUS;
i: Integer;
begin
CheckInTransaction;
case Action of
TARollback, TACommit:
begin
if (HandleIsShared) and
(Action <> FDefaultAction) and (not Force) then
IBError(ibxeCantEndSharedTransaction, [nil]);
for i := 0 to FSQLObjects.Count - 1 do
if FSQLObjects[i] <> nil then
try // <--- My changes
SQLObjects[i].DoBeforeTransactionEnd;
except // <--- My changes
end; // <--- My changes
...................далее без изменений

Подпишитесь на новости Firebird в России