DBXPool повреждает память при сбое подключения
Когда DBXPool используется для DelegateConnection на TSQLConnection, если SQLServer недоступен при вызове TSQLConnection.Open метод, это будет тайм-аут в первый раз. Но если вы впоследствии позвоните Open опять будет плохо себя вести. В моей производственной службе это убивает процесс без какого-либо предупреждения - никаких исключений не возникает, ничего. Процесс просто исчезает... В простом приложении, которое я создал, чтобы проверить DBXPoolдумает TSQLConnection подключен, даже когда это не так.
У кого-нибудь были проблемы с DBXPool как DelegateConnection что можете предложить какие-либо предложения?
Спасибо!
<<< 7/23 редакция № 2 >>>
Я использовал код в редактировании № 1 ниже, чтобы проследить через DBX Framework. Следующий метод вызывается только при использовании DBXPool:
(блок DBXDelegate)
procedure TDBXDelegateConnection.Open;
begin
if not FConnection.IsOpen then
begin
TDBXAccessorConnection(FConnection).Open;
end;
end;
... который вызывает следующий метод, который вызывается независимо от того, используется ли DBXPool:
(блок 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;
Обратите внимание на комментарий. Когда возникает исключение (например, неверное имя пользователя или тайм-аут и т. Д.), Следующий код вызывается только тогда, когда DBXPool не используется.
(блок DBXCommon)
procedure TDBXConnection.Close;
begin
CloseAllCommands;
RollbackAllTransactions;
DerivedClose;
SetTraceInfoEvent(nil);
FreeAndNil(FDatabaseMetaData);
FOpen := false;
end;
Так как FOpen не устанавливается обратно False при использовании DBXPool он выполняет код, который не должен выполняться в следующий раз DerivedOpen вызывается, что приводит к AccessViolation и повреждению памяти. Иногда RTL ловит его, иногда нет (например, мой рабочий сервис убит Windows). Я не смог еще глубже проследить в DBXDelegate, чтобы определить, почему он не перехватывает исключение и не вызывает TDBXConnection.Close,
<<< 7/23 редакция № 1 >>>
По предложению Кена я прилагаю простой пример приложения. Мое сервисное приложение просто умирает. Это приложение показывает нарушение прав доступа в dbxmss.dll (сегодня). Вчера он не вызвал исключение при втором щелчке, он просто возвратил "Подключено" как Истина. Похоже, повреждение памяти для меня...
Создайте и запустите приложение на компьютере с или без SQLServer. Нажмите на каждую кнопку несколько раз. Оба возвращают ошибку при первом клике. "С DBXPool" будет думать, что это связано, начиная со второго щелчка. Если вам повезет, вы можете увидеть AV. Кнопка "W/O DBXPool" будет каждый раз давать сбой, и это правильно.
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 the timeout occurs quickly
SQLConnection1.Params.Values[TDBXPropertyNames.ConnectTimeout] := '1';
SQLConnection2.Params.Values[TDBXPropertyNames.ConnectTimeout] := '1';
end;
end.
1 ответ
Служба поддержки Embarcadero сообщила мне сегодня, что эта проблема исправлена и будет доступна в следующем общем выпуске (например, XE2).