DBXPool Corrupts Memory on Failure to Connect

When DBXPool is used for the DelegateConnection on a TSQLConnection, if SQLServer is unavailable when you call the TSQLConnection.Open method, it will timeout the first time. But if you subsequently call Open again, it will misbehave. In my production service, it kills the process without any warning -- no exceptions are raised, nothing. The process just disappears... In a simple app I created to test DBXPool, it thinks TSQLConnection is connected, even when it is not.

Has anyone had troubles with the DBXPool as a DelegateConnection that can offer any suggestions?

Thanks!

<<< 7/23 edit #2 >>>

I used the code in edit #1 below to trace through the DBX Framework. The following method is called only when DBXPool is used:

(unit DBXDelegate)

procedure TDBXDelegateConnection.Open;
begin
  if not FConnection.IsOpen then
  begin
    TDBXAccessorConnection(FConnection).Open;
  end;
end;

... which calls the following method, which is called whether or not DBXPool is used:

(unit DBXCommon)

procedure TDBXConnection.Open;
begin
  // mark the state open so memory can be deallocated
  // even if derived open or meta query fail
  FOpen := true;

  DerivedOpen;
  DatabaseMetaData;
end;

Notice the comment. When an exception occurs (e.g., wrong username or timeout, etc.), the following code is only called when DBXPool is not used.

(unit DBXCommon)

procedure TDBXConnection.Close;
begin
  CloseAllCommands;
  RollbackAllTransactions;
  DerivedClose;
  SetTraceInfoEvent(nil);
  FreeAndNil(FDatabaseMetaData);
  FOpen := false;
end;

Because FOpen doesn't get set back to False when DBXPool is used, it causes code to execute that shouldn't the next time DerivedOpen is called, which results in an AccessViolation and memory corruption. Sometimes the RTL catches it, sometimes it doesn't (e.g., my production service is killed by Windows). I haven't been able to trace deeper yet into DBXDelegate to determine why it doesn't catch the exception and call TDBXConnection.Close.

<<< 7/23 edit #1 >>>

Per Ken's suggestion, I am attaching the simple example app. My service app just dies. This app is showing an access violation in dbxmss.dll (today). Yesterday it didn't raise the exception on the second click, it just returned 'Connected' as True. Seems like memory corruption to me...

Build and run the app on a machine with or w/o SQLServer. Click each button a few times. Both return an error on the first click. The 'With DBXPool' will think it's connected beginning with the second click. If you get lucky, you might see the AV. The 'W/O DBXPool' button will fail every time, which is correct.

Project1.dpr

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 301
  ClientWidth = 562
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 40
    Top = 8
    Width = 75
    Height = 25
    Caption = 'With DBXPool'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 40
    Top = 39
    Width = 75
    Height = 25
    Caption = 'W/O DBXPool'
    TabOrder = 1
    OnClick = Button2Click
  end
  object SQLConnection1: TSQLConnection
    DriverName = 'MSSQL'
    GetDriverFunc = 'getSQLDriverMSSQL'
    LibraryName = 'dbxmss.dll'
    LoginPrompt = False
    Params.Strings = (
      'DriverUnit=DBXMSSQL'

        'DriverPackageLoader=TDBXDynalinkDriverLoader,DBXCommonDriver150.' +
        'bpl'

        'DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader,Borla' +
        'nd.Data.DbxCommonDriver,Version=15.0.0.0,Culture=neutral,PublicK' +
        'eyToken=91d62ebb5b0d1b1b'

        'MetaDataPackageLoader=TDBXMsSqlMetaDataCommandFactory,DbxMSSQLDr' +
        'iver150.bpl'

        'MetaDataAssemblyLoader=Borland.Data.TDBXMsSqlMetaDataCommandFact' +
        'ory,Borland.Data.DbxMSSQLDriver,Version=15.0.0.0,Culture=neutral' +
        ',PublicKeyToken=91d62ebb5b0d1b1b'
      'GetDriverFunc=getSQLDriverMSSQL'
      'LibraryName=dbxmss.dll'
      'VendorLib=sqlncli10.dll'
      'MaxBlobSize=-1'
      'OSAuthentication=False'
      'PrepareSQL=True'
      'ErrorResourceFile='
      'drivername=MSSQL'
      'schemaoverride=%.dbo'
      'HostName=127.0.0.1'
      'Database=database'
      'User_Name=username'
      'Password=password'
      'blobsize=-1'
      'localecode=0000'
      'isolationlevel=ReadCommitted'
      'os authentication=False'
      'prepare sql=False'
      'DelegateConnection=DBXPool'
      'DBXPool.MaxConnections=20'
      'DBXPool.MinConnections=1'
      'DBXPool.ConnectTimeout=1000'
      'DBXPool.DriverUnit=DBXPool'
      'DBXPool.DelegateDriver=True'
      'DBXPool.DBXPool.MaxConnections=20'
      'DBXPool.DBXPool.MinConnections=1'
      'DBXPool.DBXPool.ConnectTimeout=1000'
      'DBXPool.DBXPool.DriverUnit=DBXPool'
      'DBXPool.DBXPool.DelegateDriver=True'
      'DBXPool.DBXPool.DriverName=DBXPool'
      'DBXPool.DriverName=DBXPool')
    VendorLib = 'sqlncli10.dll'
    Left = 8
    Top = 8
  end
  object SQLConnection2: TSQLConnection
    DriverName = 'MSSQL'
    GetDriverFunc = 'getSQLDriverMSSQL'
    LibraryName = 'dbxmss.dll'
    LoginPrompt = False
    Params.Strings = (
      'DriverUnit=DBXMSSQL'

        'DriverPackageLoader=TDBXDynalinkDriverLoader,DBXCommonDriver150.' +
        'bpl'

        'DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader,Borla' +
        'nd.Data.DbxCommonDriver,Version=15.0.0.0,Culture=neutral,PublicK' +
        'eyToken=91d62ebb5b0d1b1b'

        'MetaDataPackageLoader=TDBXMsSqlMetaDataCommandFactory,DbxMSSQLDr' +
        'iver150.bpl'

        'MetaDataAssemblyLoader=Borland.Data.TDBXMsSqlMetaDataCommandFact' +
        'ory,Borland.Data.DbxMSSQLDriver,Version=15.0.0.0,Culture=neutral' +
        ',PublicKeyToken=91d62ebb5b0d1b1b'
      'GetDriverFunc=getSQLDriverMSSQL'
      'LibraryName=dbxmss.dll'
      'VendorLib=sqlncli10.dll'
      'MaxBlobSize=-1'
      'OSAuthentication=False'
      'PrepareSQL=True'
      'ErrorResourceFile='
      'drivername=MSSQL'
      'schemaoverride=%.dbo'
      'HostName=127.0.0.1'
      'Database=database'
      'User_Name=username'
      'Password=password'
      'blobsize=-1'
      'localecode=0000'
      'isolationlevel=ReadCommitted'
      'os authentication=False'
      'prepare sql=False')
    VendorLib = 'sqlncli10.dll'
    Left = 8
    Top = 39
  end
end

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBXMSSQL, StdCtrls, DB, SqlExpr, DBXPool;

type
  TForm1 = class(TForm)
    Button1: TButton;
    SQLConnection1: TSQLConnection;
    SQLConnection2: TSQLConnection;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  DBXCommon;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  SQLConnection1.Close;
  SQLConnection1.Open;
  if SQLConnection1.Connected then
    MessageDlg('connected connection 1', mtInformation, [mbOK], 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SQLConnection2.Close;
  SQLConnection2.Open;
  if SQLConnection2.Connected then
    MessageDlg('connected connection 2', mtInformation, [mbOK], 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // for testing purposes, shorten the timeout so that 开发者_如何学Pythonthe timeout occurs quickly
  SQLConnection1.Params.Values[TDBXPropertyNames.ConnectTimeout] := '1';
  SQLConnection2.Params.Values[TDBXPropertyNames.ConnectTimeout] := '1';
end;

end.

---

Embarcadero Support notified me today that this issue has been fixed and will be available in the next general release (e.g., XE2).