經典的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種方法:
- 過程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, 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.