Решение проблем дисконнекта в 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 в России

Подписаться