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.
(编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |
