加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

delphi – 我们可以使用TDSProviderConnection来替换进程内DataS

发布时间:2020-12-15 09:23:51 所属栏目:大数据 来源:网络整理
导读:我可以通过进程内DataSnap应用程序访问服务器方法.单击 here以获取详细信息. 但是,进程内数据绑定应用程序还有另一个方面.它是IAppServer或TDataSetProvider. 在Delphi 2009之前,我使用TConnectionBroker和TLocalConnection进行进程内数据访问.新的Delphi 20
我可以通过进程内DataSnap应用程序访问服务器方法.单击 here以获取详细信息.

但是,进程内数据绑定应用程序还有另一个方面.它是IAppServer或TDataSetProvider.

在Delphi 2009之前,我使用TConnectionBroker和TLocalConnection进行进程内数据访问.新的Delphi 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确实打开并遍历数据集.问题的原因应该与以下两种使用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源代码,甚至找不到这个问题的线索.

解决方法

经典DataSnap

在Delphi 2009之前,我们可以将TLocalConnection或TSocketConnection与TConnectionBroker一起用于通过IAppServer接口进行进程内或进程外通信.还有更多支持IAppServer的DataSnap连接.检查德尔福有助于了解详情.

来自Delphi 2009的新DataSnap

以前,TSQLConnection仅用于DataSnap服务器.在新的DataSnap中,我们可以在DataSnap客户端中使用TSQLConnection.有一个新的驱动程序调用DataSnap允许我们使用REST数据包通过TCP或HTTP协议连接到DataSnap服务器以进行多层应用.此外,我们可以通过TSQLConnection.DriverName使用连接到TDSSever(TDSServer.Name)进行进程内连接.这有利于我们编写可扩展的多层DataSnap应用程序来使用服务器方法.有关详细信息,请参见此处

在Delphi 2009/2010中,引入了一个新的DataSnap连接组件 – TDSProviderConnection.顾名思义,它从DataSnap服务器提供提供程序.此连接需要TSQLConnection实例才能在客户端层中使用.因此,我们可以在进程内或进程外的客户端层中使用单个TSQLConnection.这实现了可扩展的多层DataSnap应用程序的设计理念.

Web上有许多演示或CodeRage视频,展示了如何在DataSnap客户端层中使用TDSProviderConnection.但是,大多数示例仅显示进程外设计.在编写本主题时,我从未找到一个示例说明TDSProviderConnection在进程内设计中的用法.希望有更多来自其他着名或知名的德尔福粉丝.

起初,我认为将TDSProviderConnection用于进程内设计很容易.但我遵守规则时遇到问题.这些问题应该与错误和DataSnap框架的成熟设计有关.我将在这里展示如何处理这些问题.

设计DataSnap模块

首先,我们为此示例设计了一个简单的DataSnap模块.这是一个包含2个组件的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或之前的版本,您会发现它不起作用,之后会出现“无效指针操作”异常.

我发现到目前为止所遇到的所有问题,修复如下.

疑难解答:无效的指针操作

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,SizeOf(SmallInt),SizeOf(Integer),SizeOf(Single),SizeOf(Double),SizeOf(Currency),SizeOf(TDateTime),SizeOf(WordBool),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^,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,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中有2个方法,GetStream和SetStream用于子序列操作.这是导致异常的原因.

修复TDBXNoOpRow问题后,数据包将成功传输到ClientDataSet.

修复方法如下:

unit DBXCommonServer.QC78752;

interface

uses SysUtils,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,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提交.问题是由于以下两种方法:

>过程TDBXStreamValue.SetValue
>功能
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,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,DSServer,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.

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读