Можем ли мы использовать TDSProviderConnection для замены TLocalConnection для in-process DataSnap-приложения?

Question

Я могу получить доступ к серверному методу в процессе работы приложения DataSnap. Нажмите here для получения более подробной информации.

Однако есть еще один аспект прикладного процесса ввода данных. Это IAppServer или TDataSetProvider.

До Delphi 2009 я использую TConnectionBroker с TLocalConnection для доступа к процессу обработки данных. Новый Delphi 2009/2010 DataSnap позволяет нам использовать TDSProviderConnection как RemoteServer. Тем не менее, я могу сделать это только для TCP/HTTP-соединения. Я не могу использовать TDSProviderConnection для приложения in-process datasnap. Он предложит «неправильную операцию указателя».

Это как мой код выглядит следующим образом:

var o: TDataModule1; 
    Q: TSQLConnection; 
    c: TEmployeeServerClient; 
begin 
    o := TDataModule1.Create(Self); 
    Q := TSQLConnection.Create(Self); 
    try 
    Q.DriverName := 'DSServer1'; 
    Q.LoginPrompt := False; 
    Q.Open; 

    DSProviderConnection1.SQLConnection := Q; 
    DSProviderConnection1.ServerClassName := 'TEmployeeServer'; 
    DSProviderConnection1.Connected := True; 

    ClientDataSet1.ProviderName := 'DataSetProvider1'; 
    ClientDataSet1.Open; 
    finally 
    o.Free; 
    Q.Free; 
    end; 
end; 

TEmployeeServer класс TDSServerModule потомок, который состоит из TDataSetProvider, TSQLDataset и TSQLConnection, которые соединяются друг с другом.

После отслеживания исходного кода я обнаружил, что TSQLDataSet открыл и переместил набор данных. Причина этой проблемы должна быть связана со следующими 2 способами, которые используют TDBXNoOpRow

function TDSVoidConnectionHandler.CreateDbxRow: TDBXStreamerRow; 
begin 
    Result := TDBXNoOpRow.Create(DBXContext); 
end; 

function TDSServerCommand.CreateParameterRow: TDBXRow; 
begin 
    Result := TDBXNoOpRow.Create(FDbxContext); 
end; 

экземпляр TDBXNoOpRow будет потребленными

procedure TDBXStreamValue.SetRowValue; 
begin 
    if FExtendedType then 
    begin 
    if FStreamStreamReader <> nil then 
     FDbxRow.SetStream(Self, FStreamStreamReader) 
    else if FByteStreamReader <> nil then 
     FDbxRow.SetStream(Self, FByteStreamReader) 
    else 
     inherited SetRowValue; 
    end else 
    inherited SetRowValue; 
end; 

Поскольку TDBXNoOpRow не делает ничего не пакет данных не получает передача вышеуказанным способом. Я подозреваю, что это является причиной проблемы, использующей in-process machanism.

Я не уверен, можем ли мы удалить TLocalConnection и заменить TDSProviderConnection для in-process DataSnap-приложения? Я отслеживал исходный код DBX в течение нескольких дней и даже не могу найти ключ к этой проблеме.

Answer 1

Классический DataSnap

До Delphi 2009, мы можем использовать либо TLocalConnection или TSocketConnection вместе с TConnectionBroker для в процессе или вне процесса коммуникации через IAppServer интерфейс. Существует еще больше соединений DataSnap, поддерживающих IAppServer. Проверка Delphi помогает в деталях.

Новый DataSnap с Delphi 2009

Ранее TSQLConnection использовался только DataSnap сервера. В новом DataSnap мы можем использовать TSQLConnection в клиенте DataSnap. Существует новый вызов драйвера DataSnap, который позволяет нам подключаться к серверу DataSnap по протоколу TCP или HTTP, используя пакет данных REST для многоуровневого приложения. Кроме того, мы можем подключиться к TDSSever (TDSServer.Name) через TSQLConnection.DriverName для входящего соединения. Это дает нам возможность написать масштабируемое многоуровневое приложение DataSnap для использования методов сервера. Подробнее см. Здесь.

В Delphi 2009/2010 был добавлен новый компонент соединения DataSnap - TDSProviderConnection. Как видно из названия, оно обеспечивает поставщиков с сервера DataSnap. Для этого соединения требуется, чтобы экземпляр TSQLConnection работал с клиентским уровнем. Таким образом, мы можем использовать один TSQLConnection в клиентском ярусе как внутри процесса, так и вне процесса. И это соответствует философии дизайна масштабируемого многоуровневого приложения DataSnap.

В Интернете доступно множество демонстрационных видеороликов Demo или CodeRage, показывающих, как TDSProviderConnection в клиентском уровне DataSnap. Тем не менее, большинство примеров демонстрирует нестандартный дизайн. Я никогда не нахожу один пример, иллюстрирующий использование TDSProviderConnection для разработки внутри процесса при написании этой темы. Надеюсь, что от других известных или хорошо известных поклонников Delphi.

Сначала я подумал, что легко использовать TDSProviderConnection для разработки в процессе. Но я сталкиваюсь с проблемами, соблюдая правила. Эти проблемы должны быть связаны с ошибками и зрелым дизайном структуры DataSnap. Здесь я расскажу, как решать проблемы.

Разработайте DataSnap модуль

Во-первых, мы создаем простой модуль DataSnap для этого примера. Это экземпляр потомка TDSServerModule с двумя компонентами: TDataSetProvider и экземпляр TClientDataSet. Причина использования TDSServerModule заключается в том, что провайдеры будут определять провайдера в модуле.

MySeverProvider.DFM

object ServerProvider: TServerProvider 
    OldCreateOrder = False 
    OnCreate = DSServerModuleCreate 
    Height = 225 
    Width = 474 
    object DataSetProvider1: TDataSetProvider 
    DataSet = ClientDataSet1 
    Left = 88 
    Top = 56 
    end 
    object ClientDataSet1: TClientDataSet 
    Aggregates = <> 
    Params = <> 
    Left = 200 
    Top = 56 
    end 
end 

MyServerProvider.PAS

type 
    TServerProvider = class(TDSServerModule) 
    DataSetProvider1: TDataSetProvider; 
    ClientDataSet1: TClientDataSet; 
    procedure DSServerModuleCreate(Sender: TObject); 
    end; 

{$R *.dfm} 

procedure TServerProvider.DSServerModuleCreate(Sender: TObject); 
begin 
    ClientDataSet1.LoadFromFile('..\orders.cds'); 
end; 

определить транспортный уровень для модуля провайдера

Поскольку это применение в процессе , мы не действительно необходим физический транспортный уровень для модуля поставщика. Здесь нам нужен TDSServer и экземпляр TDSServerClass, который помогает распространять провайдеры на ClientDataSet на более позднем этапе.

var C: TDSServer: 
    D: TDSServerClass; 
begin 
    C := TDSServer.Create(nil); 
    D := TDSServerClass.Create(nil); 
    try 
    C.Server := D; 
    C.OnGetClass := OnGetClass; 
    D.Start; 

    finally 
    D.Free; 
    C.Free; 
    end; 
end; 

procedure TForm1.OnGetClass(DSServerClass: TDSServerClass; var 
    PersistentClass: TPersistentClass); 
begin 
    PersistentClass := TServerProvider; 
end; 

Использование TDSPROVIDERCONNECTION потреблять DataSnap обслуживание в процессе

Начнем подключить все в контексте DataSnap, чтобы сделать это:

var Q: TSQLConnection; 
    D: TDSServer; 
    C: TDSServerClass; 
    P: TServerProvider; 
    N: TDSProviderConnection; 
begin 
    P := TServerProvider.Create(nil); 
    D := TDSServer.Create(nil); 
    C := TDSServerClass.Create(nil); 
    Q := TSQLConnection.Create(nil); 
    N := TDSProviderConnection.Create(nil); 
    try 
    C.Server := D; 
    C.OnGetClass := OnGetClass; 

    D.Start; 

    Q.DriverName := 'DSServer'; 
    Q.LoginPrompt := False; 
    Q.Open; 

    N.SQLConnection := Q; 
    N.ServerClassName := 'TServerProvider'; 
    N.Connected := True; 

    ClientDataSet1.RemoteServer := N; 
    ClientDataSet1.ProviderName := 'DataSetProvider1'; 
    ClientDataSet1.Open; 

    ShowMessage(IntToStr(ClientDataSet1.RecordCount)); 
    finally 
    N.Free; 
    Q.Free; 
    C.Free; 
    D.Free; 
    P.Free; 
    end; 
end; 

Если вы используете Delphi версии 14.0 .3513.24210 или ранее этого, вы обнаружите, что это не сработает, после этого возникает исключение исключения «Неверная операция указателя».

Я нашел все проблемы, с которыми столкнулись до сих пор, и исправлены следующие.

Troubleshoot: Недопустимая операция указатель

Существует ошибка в DSUtil.StreamToDataPacket. У меня есть файл в QC#78666.

Вот исправление без изменения исходного кода DBX:

unit DSUtil.QC78666; 

interface 

implementation 

uses SysUtils, Variants, VarUtils, ActiveX, Classes, DBXCommonResStrs, DSUtil, 
    CodeRedirect; 

type 
    THeader = class 
    const 
     Empty  = 1; 
     Variant  = 2; 
     DataPacket = 3; 
    end; 

    PIntArray = ^TIntArray; 
    TIntArray = array[0..0] of Integer; 

    TVarFlag = (vfByRef, vfVariant); 
    TVarFlags = set of TVarFlag; 

    EInterpreterError = class(Exception); 

    TVariantStreamer = class 
    private 
    class function ReadArray(VType: Integer; const Data: TStream): OleVariant; 
    public 
    class function ReadVariant(out Flags: TVarFlags; const Data: TStream): OleVariant; 
    end; 

const 
    EasyArrayTypes = [varSmallInt, varInteger, varSingle, varDouble, varCurrency, 
        varDate, varBoolean, varShortInt, varByte, varWord, varLongWord]; 

    VariantSize: array[0..varLongWord] of Word = (0, 0, SizeOf(SmallInt), SizeOf(Integer), 
    SizeOf(Single), SizeOf(Double), SizeOf(Currency), SizeOf(TDateTime), 0, 0, 
    SizeOf(Integer), SizeOf(WordBool), 0, 0, 0, 0, SizeOf(ShortInt), SizeOf(Byte), 
    SizeOf(Word), SizeOf(LongWord)); 

class function TVariantStreamer.ReadArray(VType: Integer; const Data: TStream): OleVariant; 
var 
    Flags: TVarFlags; 
    LoDim, HiDim, Indices, Bounds: PIntArray; 
    DimCount, VSize, i: Integer; 
    V: OleVariant; 
    LSafeArray: PSafeArray; 
    P: Pointer; 
begin 
    VarClear(Result); 
    Data.Read(DimCount, SizeOf(DimCount)); 
    VSize := DimCount * SizeOf(Integer); 
    GetMem(LoDim, VSize); 
    try 
    GetMem(HiDim, VSize); 
    try 
     Data.Read(LoDim^, VSize); 
     Data.Read(HiDim^, VSize); 
     GetMem(Bounds, VSize * 2); 
     try 
     for i := 0 to DimCount - 1 do 
     begin 
      Bounds[i * 2] := LoDim[i]; 
      Bounds[i * 2 + 1] := HiDim[i]; 
     end; 
     Result := VarArrayCreate(Slice(Bounds^,DimCount * 2), VType and varTypeMask); 
     finally 
     FreeMem(Bounds); 
     end; 
     if VType and varTypeMask in EasyArrayTypes then 
     begin 
     Data.Read(VSize, SizeOf(VSize)); 
     P := VarArrayLock(Result); 
     try 
      Data.Read(P^, VSize); 
     finally 
      VarArrayUnlock(Result); 
     end; 
     end else 
     begin 
     LSafeArray := PSafeArray(TVarData(Result).VArray); 
     GetMem(Indices, VSize); 
     try 
      FillChar(Indices^, VSize, 0); 
      for I := 0 to DimCount - 1 do 
      Indices[I] := LoDim[I]; 
      while True do 
      begin 
      V := ReadVariant(Flags, Data); 
      if VType and varTypeMask = varVariant then 
       SafeArrayCheck(SafeArrayPutElement(LSafeArray, Indices^, V)) 
      else 
       SafeArrayCheck(SafeArrayPutElement(LSafeArray, Indices^, TVarData(V).VPointer^)); 
      Inc(Indices[DimCount - 1]); 
      if Indices[DimCount - 1] > HiDim[DimCount - 1] then 
       for i := DimCount - 1 downto 0 do 
       if Indices[i] > HiDim[i] then 
       begin 
        if i = 0 then Exit; 
        Inc(Indices[i - 1]); 
        Indices[i] := LoDim[i]; 
       end; 
      end; 
     finally 
      FreeMem(Indices); 
     end; 
     end; 
    finally 
     FreeMem(HiDim); 
    end; 
    finally 
    FreeMem(LoDim); 
    end; 
end; 

class function TVariantStreamer.ReadVariant(out Flags: TVarFlags; const Data: TStream): OleVariant; 
var 
    I, VType: Integer; 
    W: WideString; 
    TmpFlags: TVarFlags; 
begin 
    VarClear(Result); 
    Flags := []; 
    Data.Read(VType, SizeOf(VType)); 
    if VType and varByRef = varByRef then 
    Include(Flags, vfByRef); 
    if VType = varByRef then 
    begin 
    Include(Flags, vfVariant); 
    Result := ReadVariant(TmpFlags, Data); 
    Exit; 
    end; 
    if vfByRef in Flags then 
    VType := VType xor varByRef; 
    if (VType and varArray) = varArray then 
    Result := ReadArray(VType, Data) else 
    case VType and varTypeMask of 
    varEmpty: VarClear(Result); 
    varNull: Result := NULL; 
    varOleStr: 
    begin 
     Data.Read(I, SizeOf(Integer)); 
     SetLength(W, I); 
     Data.Read(W[1], I * 2); 
     Result := W; 
    end; 
    varDispatch, varUnknown: 
     raise EInterpreterError.CreateResFmt(@SBadVariantType,[IntToHex(VType,4)]); 
    else 
    TVarData(Result).VType := VType; 
    Data.Read(TVarData(Result).VPointer, VariantSize[VType and varTypeMask]); 
    end; 
end; 

procedure StreamToDataPacket(const Stream: TStream; out VarBytes: OleVariant); 
var 
    P: Pointer; 
    ByteCount: Integer; 
    Size: Int64; 
begin 
    Stream.Read(Size, 8); 
    ByteCount := Integer(Size); 
    if ByteCount > 0 then 
    begin 
    VarBytes := VarArrayCreate([0, ByteCount-1], varByte); 
    P := VarArrayLock(VarBytes); 
    try 
//  Stream.Position := 0; // QC#78666 "Mismatched in datapacket" with DSUtil.StreamToDataPacket 
     Stream.Read(P^, ByteCount); 
     Stream.Position := 0; 
    finally 
     VarArrayUnlock(VarBytes); 
    end; 
    end 
    else 
    VarBytes := Null; 
end; 

procedure StreamToVariantPatch(const Stream: TStream; out VariantValue: OleVariant); 
var 
    Flags: TVarFlags; 
    Header: Byte; 
begin 
    if Assigned(Stream) then 
    begin 
    Stream.Position := 0; 
    Stream.Read(Header, 1); 
    if Header = THeader.Variant then 
     VariantValue := TVariantStreamer.ReadVariant(Flags, Stream) 
    else if Header = THeader.DataPacket then 
     StreamToDataPacket(Stream, VariantValue) 
    else 
     Assert(false); 
    end; 
end; 

var QC78666: TCodeRedirect; 

initialization 
    QC78666 := TCodeRedirect.Create(@StreamToVariant, @StreamToVariantPatch); 
finalization 
    QC78666.Free; 
end. 

Troubleshoot: Я до сих пор сталкиваются с «Invalid Pointer Operation» после того, как применить DSUtil.StreamToDataPacket патч

Я подал эту проблему QC#78752. В процессе DataSnap создается экземпляр TDSServerCommand.Способ TDSServerCommand создания TDBXNoOpRow экземпляра:

function TDSServerCommand.CreateParameterRow: TDBXRow; 
begin 
    Result := TDBXNoOpRow.Create(FDbxContext); 
end; 

Большинство методов в TDBXNoOpRow не реализован. Существует два метода в классе: TDBXNoOpRow, GetStream и SetStream используются в операциях подпоследовательности. Именно по этой причине вызывают исключение.

После устранения проблемы TDBXNoOpRow пакет данных будет успешно переноситься в ClientDataSet.

Исправление выглядит следующим образом:

unit DBXCommonServer.QC78752; 

interface 

uses SysUtils, Classes, DBXCommon, DSCommonServer, DBXCommonTable; 

type 
    TDSServerCommand_Patch = class(TDSServerCommand) 
    protected 
    function CreateParameterRowPatch: TDBXRow; 
    end; 

    TDBXNoOpRowPatch = class(TDBXNoOpRow) 
    private 
    function GetBytesFromStreamReader(const R: TDBXStreamReader; out Buf: TBytes): Integer; 
    protected 
    procedure GetStream(DbxValue: TDBXStreamValue; var Stream: TStream; var IsNull: 
     LongBool); override; 
    procedure SetStream(DbxValue: TDBXStreamValue; StreamReader: TDBXStreamReader); 
     override; 
    function UseExtendedTypes: Boolean; override; 
    end; 

    TDBXStreamValueAccess = class(TDBXByteArrayValue) 
    private 
    FStreamStreamReader: TDBXLookAheadStreamReader; 
    end; 

implementation 

uses CodeRedirect; 

function TDSServerCommand_Patch.CreateParameterRowPatch: TDBXRow; 
begin 
    Result := TDBXNoOpRowPatch.Create(FDbxContext); 
end; 

procedure TDBXNoOpRowPatch.GetStream(DbxValue: TDBXStreamValue; var Stream: TStream; 
    var IsNull: LongBool); 
var iSize: integer; 
    B: TBytes; 
begin 
    iSize := GetBytesFromStreamReader(TDBXStreamValueAccess(DbxValue).FStreamStreamReader, B); 
    IsNull := iSize = 0; 
    if not IsNull then begin 
    Stream := TMemoryStream.Create; 
    Stream.Write(B[0], iSize); 
    end; 
end; 

procedure TDBXNoOpRowPatch.SetStream(DbxValue: TDBXStreamValue; StreamReader: 
    TDBXStreamReader); 
var B: TBytes; 
    iSize: integer; 
begin 
    iSize := GetBytesFromStreamReader(StreamReader, B); 
    Dbxvalue.SetDynamicBytes(0, B, 0, iSize); 
end; 

function TDBXNoOpRowPatch.GetBytesFromStreamReader(const R: TDBXStreamReader; out Buf: TBytes): 
    Integer; 
const BufSize = 50 * 1024; 
var iPos: integer; 
    iRead: integer; 
begin 
    Result := 0; 
    while not R.Eos do begin 
    SetLength(Buf, Result + BufSize); 
    iPos := Result; 
    iRead := R.Read(Buf, iPos, BufSize); 
    Inc(Result, iRead); 
    end; 
    SetLength(Buf, Result); 
end; 

function TDBXNoOpRowPatch.UseExtendedTypes: Boolean; 
begin 
    Result := True; 
end; 

var QC78752: TCodeRedirect; 

initialization 
    QC78752 := TCodeRedirect.Create(@TDSServerCommand_Patch.CreateParameterRow, @TDSServerCommand_Patch.CreateParameterRowPatch); 
finalization 
    QC78752.Free; 
end. 

Troubleshoot: применяется как пластыри и работать на примере, но я до сих пор сталкиваются с «Invalid Pointer Operation»

Эта проблема также подал в QC#78752. Проблема связана со следующими методами: 2

1. процедура TDBXStreamValue.SetValue
2. функция TDBXLookAheadStreamReader.ConvertToMemoryStream: TStream;

TDBXLookAheadStreamReader.ConvertToMemoryStream возвращает управляемый объект FStream для TDBXStreamValue.SetValue. Этот объект stream станет другим управляемым объектом TDBXStreamValue. Оказывается, что объект потока управляется двумя объектами и исключение возникает, когда эти 2 объекта пытаются освободить объект Stream:

procedure TDBXStreamValue.SetValue(const Value: TDBXValue); 
begin 
    if Value.IsNull then 
    SetNull 
    else 
    begin 
    SetStream(Value.GetStream(False), True); 
    end; 
end; 
function TDBXLookAheadStreamReader.ConvertToMemoryStream: TStream; 
... 
begin 
    if FStream = nil then 
    Result := nil 
    else 
    begin 
    Count := Size; 
    if not (FStream is TMemoryStream) then 
    begin 
     ... 
     StreamTemp := FStream; 
     FStream := Stream; 
     FreeAndNil(StreamTemp); 
    end; 
    FStream.Seek(0, soFromBeginning); 
    FHasLookAheadByte := false; 
    Result := FStream; 
    end; 
end; 

Исправление выглядит следующим образом:

unit DBXCommon.QC78752; 

interface 

implementation 

uses SysUtils, Classes, DBXCommon, CodeRedirect; 

type 
    TDBXLookAheadStreamReaderAccess = class(TDBXStreamReader) 
    private 
    FStream: TStream; 
    FEOS:    Boolean; 
    FHasLookAheadByte: Boolean; 
    FLookAheadByte:  Byte; 
    end; 

    TDBXLookAheadStreamReaderHelper = class helper for TDBXLookAheadStreamReader 
    private 
    function Accessor: TDBXLookAheadStreamReaderAccess; 
    public 
    function ConvertToMemoryStreamPatch: TStream; 
    end; 

function TDBXLookAheadStreamReaderHelper.Accessor: 
    TDBXLookAheadStreamReaderAccess; 
begin 
    Result := TDBXLookAheadStreamReaderAccess(Self); 
end; 

function TDBXLookAheadStreamReaderHelper.ConvertToMemoryStreamPatch: TStream; 
var 
    Stream: TMemoryStream; 
    StreamTemp: TStream; 
    Count: Integer; 
    Buffer: TBytes; 
    ReadBytes: Integer; 
begin 
    if Accessor.FStream = nil then 
    Result := nil 
    else 
    begin 
    Count := Size; 
    if not (Accessor.FStream is TMemoryStream) then 
    begin 
     Stream := TMemoryStream.Create; 
     if Count >= 0 then 
     Stream.SetSize(Count); 
     if Accessor.FHasLookAheadByte then 
     Stream.Write(Accessor.FLookAheadByte, 1); 
     SetLength(Buffer, 256); 
     while true do 
     begin 
     ReadBytes := Accessor.FStream.Read(Buffer, Length(Buffer)); 
     if ReadBytes > 0 then 
      Stream.Write(Buffer, ReadBytes) 
     else 
      Break; 
     end; 
     StreamTemp := Accessor.FStream; 
     Accessor.FStream := Stream; 
     FreeAndNil(StreamTemp); 
     Result := Accessor.FStream; 
    end else begin 
     Stream := TMemoryStream.Create; 
     Accessor.FStream.Seek(0, soFromBeginning); 
     Stream.CopyFrom(Accessor.FStream, Accessor.FStream.Size); 
    end; 
    Stream.Seek(0, soFromBeginning); 
    Accessor.FHasLookAheadByte := false; 

    Result := Stream; 
// Stream := TMemoryStream.Create; 
// Stream.LoadFromStream(FStream); 
// FStream.Seek(0, soFromBeginning); 
// Result := Stream; 
    end; 
end; 

var QC78752: TCodeRedirect; 

initialization 
    QC78752 := TCodeRedirect.Create(@TDBXLookAheadStreamReader.ConvertToMemoryStream, @TDBXLookAheadStreamReader.ConvertToMemoryStreamPatch); 
finalization 
    QC78752.Free; 
end. 

Устранение неполадок: Я обнаружение утечек памяти после закрытия приложения

Утечка памяти в TDSServerConnection для подключения к процессу. Я подал отчет в QC#78696.

Вот исправление:

unit DSServer.QC78696; 

interface 

implementation 

uses SysUtils, 
    DBXCommon, DSServer, DSCommonServer, DBXMessageHandlerCommon, DBXSqlScanner, 
    DBXTransport, 
    CodeRedirect; 

type 
    TDSServerConnectionHandlerAccess = class(TDBXConnectionHandler) 
    FConProperties: TDBXProperties; 
    FConHandle: Integer; 
    FServer: TDSCustomServer; 
    FDatabaseConnectionHandler: TObject; 
    FHasServerConnection: Boolean; 
    FInstanceProvider: TDSHashtableInstanceProvider; 
    FCommandHandlers: TDBXCommandHandlerArray; 
    FLastCommandHandler: Integer; 
    FNextHandler: TDBXConnectionHandler; 
    FErrorMessage: TDBXErrorMessage; 
    FScanner: TDBXSqlScanner; 
    FDbxConnection: TDBXConnection; 
    FTransport: TDSServerTransport; 
    FChannel: TDbxChannel; 
    FCreateInstanceEventObject: TDSCreateInstanceEventObject; 
    FDestroyInstanceEventObject: TDSDestroyInstanceEventObject; 
    FPrepareEventObject: TDSPrepareEventObject; 
    FConnectEventObject: TDSConnectEventObject; 
    FErrorEventObject: TDSErrorEventObject; 
    FServerCon: TDSServerConnection; 
    end; 

    TDSServerConnectionPatch = class(TDSServerConnection) 
    public 
    destructor Destroy; override; 
    end; 

    TDSServerDriverPatch = class(TDSServerDriver) 
    protected 
    function CreateConnectionPatch(ConnectionBuilder: TDBXConnectionBuilder): TDBXConnection; 
    end; 

destructor TDSServerConnectionPatch.Destroy; 
begin 
    inherited Destroy; 
    TDSServerConnectionHandlerAccess(ServerConnectionHandler).FServerCon := nil; 
    ServerConnectionHandler.Free; 
end; 

function TDSServerDriverPatch.CreateConnectionPatch(
    ConnectionBuilder: TDBXConnectionBuilder): TDBXConnection; 
begin 
    Result := TDSServerConnectionPatch.Create(ConnectionBuilder); 
end; 

var QC78696: TCodeRedirect; 

initialization 
    QC78696 := TCodeRedirect.Create(@TDSServerDriverPatch.CreateConnection, @TDSServerDriverPatch.CreateConnectionPatch); 
finalization 
    QC78696.Free; 
end.