2009-10-14 157 views
4

我可以通過進程內DataSnap應用程序訪問服務器方法。詳情請點擊here我們可以使用TDSProviderConnection替換進程內DataSnap應用程序的TLocalConnection嗎?

然而,在進程的DataSnap申請的另一個方面。它是IAppServer或TDataSetProvider。

至2009年德爾福在此之前,我用TConnectionBroker與TLocalConnection的進程的DataSnap訪問。新德爾福2009/2010的DataSnap允許我們使用TDSProviderConnection爲 REMOTESERVER。但是,我只能使它適用於TCP/HTTP連接。我無法將TDSProviderConnection用於進程內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沒有什麼,數據包不會被消耗按上述方法轉移。我懷疑這是使用進程內機制的問題的原因。

我不能,如果我們能夠扔掉TLocalConnection肯定,並通過TDSProviderConnection的進程的DataSnap應用程序取代?我追蹤了幾天的DBX源代碼,甚至無法找到關於此問題的線索。

回答

6

經典的DataSnap

在2009年之前的Delphi,我們可以連同TConnectionBroker使用任一TLocalConnection或TSocketConnection用於過程或外的過程通信經由IAppServer接口。還有更多支持IAppServer的DataSnap連接。檢查德爾福幫助的細節。

新的DataSnap從2009年德爾福

此前,設爲TSQLConnection在僅DataSnap服務器使用。在新的DataSnap中,我們可以在DataSnap客戶端中使用TSQLConnection。有一個新的驅動程序調用DataSnap,它允許我們使用用於多層應用程序的REST數據包通過TCP或HTTP協議連接到DataSnap服務器。此外,我們可以通過TSQLConnection.DriverName使用連接到TDSSever(TDSServer.Name)進行進程內連接。這有利於我們編寫可擴展的多層DataSnap應用程序來使用服務器方法。詳情請看這裏。引入TDSProviderConnection -

在Delphi 2009/2010,新的DataSnap連接組件。顧名思義,它從DataSnap服務器提供提供商。此連接需要TSQLConnection實例在客戶端層使用。因此,我們可以在進程內或進程外的客戶端層使用單個TSQLConnection。這符合可擴展多層DataSnap應用程序的設計理念。

有許多演示或CodeRage視頻的可在網上展示瞭如何在TDSProviderConnection DataSnap客戶機層。但是,大多數示例只顯示了流程外設計。我從來沒有找到一個例子來說明在寫這個主題的過程中設計TDSProviderConnection的用法。希望有更多來自其他着名或知名的德爾福球迷。

起初,我還以爲它是易於使用TDSProviderConnection在流程設計。但我遵守規則時會遇到問題。這些問題應該與錯誤和DataSnap框架的成熟設計有關。我會在這裏展示如何處理這些問題。

設計一個的DataSnap模塊

首先,我們設計了這個例子簡單的DataSnap模塊。這是一個TDSServerModule後代實例,包含2個組件: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或之前,你會發現它不起作用,之後會引發「無效的指針操作」異常。

我發現迄今爲止所面臨的所有問題,固定如下。

故障排除:無效的指針操作

有在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. 

疑難解答:我仍然遇到「無效的指針操作」之後申請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. 

故障排除:兩個應用補丁和工作的例子,但我還是會遇到「無效的指針操作」

這個問題也提交QC#78752。問題是由於以下2種方法:

  1. 過程TDBXStreamValue.SetValue
  2. 功能 TDBXLookAheadStreamReader.ConvertToMemoryStream: T流;

TDBXLookAheadStreamReader.ConvertToMemoryStream返回託管的FStream對象到TDBXStreamValue.SetValue。此流對象成爲TDBXStreamValue的另一個管理對象。事實證明,一個Stream對象由兩個對象管理和異常升高時,這兩個對象嘗試釋放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. 
相關問題