classique DataSnap
Avant Delphi 2009, nous pouvons utiliser soit TLocalConnection ou TSocketConnection avec TConnectionBroker pour en cours ou hors processus de communication via l'interface IAppServer. Il y a encore plus de connexion DataSnap qui supporte IAppServer. Vérifiez Delphi aide pour plus de détails.
New DataSnap de Delphi 2009
Auparavant, TSQLConnection a été utilisé uniquement dans le serveur DataSnap. Dans le nouveau DataSnap, nous pouvons utiliser TSQLConnection dans le client DataSnap. Il existe un nouvel appel de pilote DataSnap qui nous permet de nous connecter à un serveur DataSnap via le protocole TCP ou HTTP à l'aide du paquet de données REST pour une application multiniveau. En outre, nous pouvons utiliser connect to TDSSever (TDSServer.Name) via TSQLConnection.DriverName pour la connexion in-process. Cela nous permet d'écrire une application DataSnap multiniveau évolutive pour consommer les méthodes serveur. Voir ici pour plus de détails.
Dans Delphi 2009/2010, un nouveau composant de connexion DataSnap - TDSProviderConnection a été introduit. Comme son nom l'indique, il fournit des fournisseurs à partir du serveur DataSnap. Cette connexion nécessite une instance TSQLConnection pour fonctionner dans le niveau client. Ainsi, nous pouvons utiliser une seule TSQLConnection dans le niveau client, en cours ou hors processus. Et qui répondent à la philosophie de conception de l'application DataSnap multiniveau évolutive.
Il existe de nombreuses vidéos de démonstration ou CodeRage disponibles sur le Web montrant comment TDSProviderConnection dans le niveau client DataSnap. Cependant, la plupart des exemples ne montrent qu'une conception hors processus. Je ne trouve jamais un exemple illustrant l'utilisation de TDSProviderConnection pour la conception en cours lors de l'écriture de ce sujet. J'espère qu'il y a plus d'autres fans célèbres ou bien connus de Delphi. Dans un premier temps, j'ai pensé qu'il est facile d'utiliser TDSProviderConnection pour la conception en cours de processus. Mais je fais face à des problèmes tout en suivant les règles. Ces problèmes doivent être liés aux bogues et à la conception mature de la structure DataSnap. Je montrerai ici comment traiter les problèmes.
Conception d'un module DataSnap
D'abord, nous concevons un module simple DataSnap pour cet exemple. Il s'agit d'une instance descendante TDSServerModule avec 2 composants: TDataSetProvider et une instance TClientDataSet. La raison pour laquelle TDSServerModule est utilisé est de gérer les fournisseurs définis dans le module.
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;
définir une couche de transport pour le module de fournisseur
Comme il est une application en cours , nous ne le faisons pas vraiment besoin d'une couche de transport physique pour le module fournisseur. Nous avons besoin ici d'une instance TDSServer et TDSServerClass qui permet de propager les fournisseurs vers ClientDataSet à un stade ultérieur.
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;
Utilisez TDSProviderConnection pour consommer le in-process service DataSnap
Nous commençons brancher tout dans le contexte DataSnap pour le faire:
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;
Si vous utilisez la version Delphi 14.0 .3513.24210 ou avant cela, vous trouverez que cela ne fonctionne pas, une exception "opération de pointeur invalide" augmenter après cela.
J'ai trouvé tous les problèmes rencontrés jusqu'à présent et les fixes sont les suivants.
Dépanner: opération pointeur non valide
Il y a un bogue dans DSUtil.StreamToDataPacket. J'ai déposer un rapport dans QC#78666.
Voici une solution sans modifier le code source 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.
Dépanner: Je rencontre encore « Opération pointeur non valide » après application DSUtil.StreamToDataPacket patcher
J'ai déposé ce problème QC#78752. Un DataSnap in-process crée une instance de TDSServerCommand.Une méthode de TDSServerCommand créer par exemple TDBXNoOpRow:
function TDSServerCommand.CreateParameterRow: TDBXRow;
begin
Result := TDBXNoOpRow.Create(FDbxContext);
end;
La plupart des méthodes TDBXNoOpRow n'est pas mis en œuvre. Il existe 2 méthodes dans la classe TDBXNoOpRow, GetStream et SetStream sont utilisées dans les opérations de sous-séquence. C'est la raison qui provoque l'exception. Après correction du problème TDBXNoOpRow, le paquet de données sera transporté vers ClientDataSet avec succès.
Le correctif est comme suit:
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.
Dépanner: Les deux patchs appliqués et de travail pour l'exemple, mais je rencontre encore « Opération pointeur non valide »
Ce problème a également déposé en QC#78752. Le problème est dû à des 2 méthodes suivantes:
- procédure TDBXStreamValue.SetValue
- fonction TDBXLookAheadStreamReader.ConvertToMemoryStream: TStream;
TDBXLookAheadStreamReader.ConvertToMemoryStream retourner un objet FStream réussi à TDBXStreamValue.SetValue. Cet objet stream devient un autre objet géré de TDBXStreamValue. Il se trouve qu'un objet Stream géré par deux objets et l'exception soulevée lorsque ces 2 objets tentent de libérer l'objet 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;
Le correctif est comme suit:
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.
Dépanner: I rencontre des fuites de mémoire après la fermeture de l'application
Il existe une fuite de mémoire dans TDSServerConnection pour une connexion en cours de processus. J'ai déposé un rapport au QC#78696.
Voici le correctif:
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.