delphi – 我们可以使用TDSProviderConnection来替换进程内DataS
我可以通过进程内DataSnap应用程序访问服务器方法.单击
here以获取详细信息.
但是,进程内数据绑定应用程序还有另一个方面.它是IAppServer或TDataSetProvider. 在Delphi 2009之前,我使用TConnectionBroker和TLocalConnection进行进程内数据访问.新的Delphi 2009/2010 DataSnap允许我们使用TDSProviderConnection作为 这是我的代码的样子: 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将托管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. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |