I have DataSnap Server with connection to MS SQL Server database. I use Zeos Connection objects. Client is Android application. Both are made in Delphi XE10.2. When my android client lost connection to DataSnap Server connection to MS SQL Server remains still active and never close. If I gracefully closes Android client application it does not happen. After some disconnections I get message db error 10029 - Maximum number of DBPROCESSes already allocated and I must restart my DataSnap server. What should I do.
DataSnap server application looks like this.
ServerContainer Unit Form :
object ServerContainer1: TServerContainer1
OldCreateOrder = False
Height = 271
Width = 415
object DSServer1: TDSServer
Left = 96
Top = 11
end
object DSTCPServerTransport1: TDSTCPServerTransport
PoolSize = 100
Server = DSServer1
Filters = <>
Left = 96
Top = 73
end
object DSServerClass1: TDSServerClass
OnGetClass = DSServerClass1GetClass
Server = DSServer1
Left = 200
Top = 19
end
end
Code :
unit ServerContainerUnit1;
interface
uses System.SysUtils, System.Classes,
Datasnap.DSTCPServerTransport,
Datasnap.DSServer, Datasnap.DSCommonServer,
IPPeerServer, IPPeerAPI, Datasnap.DSAuth;
type
TServerContainer1 = class(TDataModule)
DSServer1: TDSServer;
DSTCPServerTransport1: TDSTCPServerTransport;
DSServerClass1: TDSServerClass;
procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
var PersistentClass: TPersistentClass);
private
{ Private declarations }
public
end;
var
ServerContainer1: TServerContainer1;
implementation
{$R *.dfm}
uses
ServerMethodsUnit1, main;
procedure TServerContainer1.DSServerClass1GetClass(
DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;
end.
Server Methods Unit looks like this :
Print screen of form
There is no code except EchoString and ReverseString function in this unit
On the client side I have DataModule with TSQLConnection, TDSProviderConnection and many TClientDataSets
One of procedure's in my client app looks like this :
procedure A();
begin
try
DM.PingCDS.Close;
DM.PingCDS.Open;
except
DM.Konekcija.Close;
DM.Konekcija.Open;
end;
DM.KorisnikCDS.Close;
DM.KorisnikCDS.Params.ParamByName('aplikacija').Value := 'S';
DM.KorisnikCDS.Open;
while not DM.KorisnikCDS.Eof do
begin
i := DM.KorisnikCDS.RecNo;
k := TKorisnik.Create;
k.user_name := DM.KorisnikCDSUSER_NAME.AsString;
k.pass := 'd' + inttostr(i);
k.IDKorisnik := DM.KorisnikCDSID_KORISNIK.AsInteger;
k.ImeIPrezime := DM.KorisnikCDSIME.AsString + ' ' + DM.KorisnikCDSPREZIME.AsString;
k.frame := TframeKorisnik.Create(hbKorisnici);
k.frame.Parent := hbKorisnici;
k.frame.Korisnik := k;
k.frame.Position.X := 10 + (i - 1) * k.frame.Width;
k.frame.Position.Y := 0;
k.frame.Name := 'frameKorisnik' + IntToStr(k.IDKorisnik);
k.frame.lblUserName.Text := k.user_name;
k.frame.Opacity := 0.7;
ms := TMemoryStream.Create;
(DM.KorisnikCDSSLIKA as TBlobField).SaveToStream(ms);
ms.Position := 0;
k.frame.imgKorisnik.Bitmap.LoadFromStream(ms);
ms.Free;
k.frame.OnTap := TapKorisnik;
//k.frame.OnMouseUp := KornisnikMouseUP;
ListaKorisnika.Add(k);
DM.KorisnikCDS.Next;
end;
DM.KorisnikCDS.Close;
end;
You can see that I created Ping query to determine is Connection to DataSnap Server still alive. If not I reconnect. I think that is the problem. If connection to DataSnap server broke, SQL connection still stay active and when I reconnect to DataSnap server I see new SQL Connection in Activity monitor. Old one never disconnect
This is print screen of Activity monitor with few connections that never ends.
Print screen of Activity monitor
I hope any one of you can help me
Related
With the TIdTCPServer component of Indy, a package is received in two fractions but the client sent one with 64 KB.
How do I receive the complete package in the Server OnExecute event?
Now I put a prototype (Server and Client) code to recreate the situation.
Server Code
procedure TFrmServer.IdTCPServer1Execute(AContext: TIdContext);
Var
ReceivedBytesTCP : Integer;
IBuf : TIdBytes;
begin
if Not AContext.Connection.IOHandler.InputBufferIsEmpty then Begin
Try
ReceivedBytesTCP := AContext.Connection.IOHandler.InputBuffer.Size;
SetLength(IBuf,ReceivedBytesTCP);
AContext.Connection.IOHandler.ReadBytes(IBuf,ReceivedBytesTCP,False);
AContext.Connection.IOHandler.Write(IBuf,Length(IBuf),0);
Except
On E : Exception Do Begin
Memo1.Lines.Add('Except Server TCP: ' + E.Message);
End;
End;
End Else Begin
Sleep(1);
End;
end;
Client Code
procedure TFrm_TCP_Client.BtnSendClick(Sender: TObject);
Var
IBuf,RBuf : TIdBytes;
I : Integer;
LenPacket : Integer;
begin
LenPacket := StrToInt(EdtLength.Text);
if IdTCPClient1.Connected then Begin
SetLength(IBuf,LenPacket);
for I := 1 to LenPacket do
IBuf[I] := 1;
IdTCPClient1.IOHandler.Write(IBuf,Length(IBuf),0);
I := 0;
Repeat
IdTCPClient1.IOHandler.CheckForDataOnSource(50);
Inc(I);
Until Not IdTCPClient1.IOHandler.InputBufferIsEmpty or (I >= 10);
If Not IdTCPClient1.IOHandler.InputBufferIsEmpty Then Begin
SetLength(RBuf,IdTCPClient1.IOHandler.InputBuffer.Size);
IdTCPClient1.IOHandler.ReadBytes(RBuf,IdTCPClient1.IOHandler.InputBuffer.Size,False);
if Length(RBuf) = Length(IBuf) then
Memo1.Lines.Add('Response Received OK: '+IntToStr(Length(RBuf)))
Else
Memo1.Lines.Add('Response Received With Different Length: '+IntToStr(Length(RBuf)));
if Not IdTCPClient1.IOHandler.InputBufferIsEmpty then
Memo1.Lines.Add('Llego otro Mensaje');
End Else Begin
Memo1.Lines.Add('NO Response Received');
End;
End;
end;
How to know that a message is the first or the second fragment?
How to force the receive of second fragment?
There is no 1-to-1 relationship between sends and reads in TCP. It is free to fragment data however it wants to optimize network transmissions. TCP guarantees only that data is delivered, and in the same order it was sent, but nothing about HOW data is fragmented during transmission. TCP will reconstruct the fragments on the receiving end. This is simply how TCP works, it is not unique to Indy. Every TCP app has to deal with this issue regardless of which TCP framework is used.
If you are expecting 64KB of data, then simply read 64KB of data, and let the OS and Indy handle the fragments internally for you. This fragmentation of TCP is exactly why Indy's IOHandler uses an InputBuffer to collect the fragments when piecing data back together.
Update: stop focusing on fragments. That is an implementation detail at the TCP layer, which you are not operating at. You don't need to deal with fragments in your code. Let Indy handle it for you. Just focus on your application level protocol instead.
And FYI, you have essentially implemented an ECHO client/server solution. Indy has actual ECHO client/server components, TIdECHO and TIdECHOServer, you should have a look at them.
In any case, your server-side exception handling is very problematic. It is not syncing with the main UI thread (OnExecute is called in a worker thread). But, more importantly, it as preventing TIdTCPServer from processing any notifications issued by Indy itself when the client connection is lost/disconnected, so the client thread will keep running and not stop until you deactivate the server. DO NOT swallow Indy's own exceptions (which are derived from EIdException). If you need to catch them in your code, you should re-raise them when done, let TIdTCPServer process them. But, in your example, it would be easier to remove the try..except altogether and use the server's OnException event instead.
Also, your client-side reading loop is wrong for what you are attempting to do with it. You are not initializing IBuf correctly. But, more importantly, you are using a very short timeout (TCP connections may have latency), and you are breaking your reading loop as soon as any data arrives or 500ms max have elapsed, even if there is more data still coming. You should be reading until there is nothing left to read.
Try something more like this instead:
Server:
procedure TFrmServer.IdTCPServer1Execute(AContext: TIdContext);
var
IBuf : TIdBytes;
begin
AContext.Connection.IOHandler.ReadBytes(IBuf, -1);
AContext.Connection.IOHandler.Write(IBuf);
end;
procedure TFrmServer.IdTCPServer1Exception(AContext: TIdContext, AException: Exception);
var
Msg: string;
begin
if AException <> nil then
Msg := AException.Message
else
Msg := 'Unknown';
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add('Except Server TCP: ' + Msg);
end
);
end;
Client:
procedure TFrm_TCP_Client.BtnSendClick(Sender: TObject);
Var
IBuf,RBuf : TIdBytes;
LenPacket : Integer;
begin
if not IdTCPClient1.Connected then Exit;
LenPacket := StrToInt(EdtLength.Text);
if LenPacket < 1 then Exit;
SetLength(IBuf, LenPacket);
FillBytes(IBuf, LenPacket, $1);
try
IdTCPClient1.IOHandler.InputBuffer.Clear;
IdTCPClient1.IOHandler.Write(IBuf);
except
Memo1.Lines.Add('Request Send Error');
Exit;
end;
try
while IdTCPClient1.IOHandler.CheckForDataOnSource(500) do;
if not IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.ReadBytes(RBuf, IdTCPClient1.IOHandler.InputBuffer.Size, True);
if Length(RBuf) = Length(IBuf) then
Memo1.Lines.Add('Response Received OK: ' + IntToStr(Length(RBuf)))
else
Memo1.Lines.Add('Response Received With Different Length. Expected: ' + IntToStr(Length(IBuf)) + ', Got: ' + IntToStr(Length(RBuf)));
end
else
Memo1.Lines.Add('NO Response Received');
except
Memo1.Lines.Add('Response Receive Error');
end;
end;
A better solution would be to not rely on such logic at all, be more explicit about the structure of your data protocol, for instance <length><data>, eg:
Server:
procedure TFrmServer.IdTCPServer1Execute(AContext: TIdContext);
var
IBuf : TIdBytes;
LenPacket : Int32;
begin
LenPacket := AContext.Connection.IOHandler.ReadInt32;
AContext.Connection.IOHandler.ReadBytes(IBuf, LenPacket, True);
AContext.Connection.IOHandler.Write(LenPacket);
AContext.Connection.IOHandler.Write(IBuf);
end;
procedure TFrmServer.IdTCPServer1Exception(AContext: TIdContext, AException: Exception);
var
Msg: string;
begin
if AException <> nil then
Msg := AException.Message
else
Msg := 'Unknown';
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add('Except Server TCP: ' + Msg);
end
);
end;
Client:
procedure TFrm_TCP_Client.BtnSendClick(Sender: TObject);
Var
IBuf,RBuf : TIdBytes;
LenPacket : Int32;
begin
if not IdTCPClient1.Connected then Exit;
LenPacket := StrToInt(EdtLength.Text);
if LenPacket < 1 then Exit;
SetLength(IBuf, LenPacket);
FillBytes(IBuf, LenPacket, $1);
try
IdTCPClient1.IOHandler.InputBuffer.Clear;
IdTCPClient1.IOHandler.Write(LenPacket);
IdTCPClient1.IOHandler.Write(IBuf);
except
Memo1.Lines.Add('Request Send Error');
Exit;
end;
try
IdTCPClient1.IOHandler.ReadTimeout := 5000;
LenPacket := IdTCPClient1.IOHandler.ReadInt32;
IdTCPClient1.IOHandler.ReadBytes(RBuf, LenPacket, True);
except
Memo1.Lines.Add('Response Receive Error');
Exit;
end;
Memo1.Lines.Add('Response Received OK');
end;
I am using TIdTCPServer in my application. Here hardware acting as tcp client. Client establishes the connection with SYN command (observed in wire shark which is a tool). My application has multiple clients so every client connects to my server. For the first time connection, data sending & receiving is fine. But when hardware power off & on happens, my server not able to send data, to hardware, until application restart. Following are the observations regarding this:
1.When first time client connects SYN with Seq No = 0 received, SYN ACK with Seq No = 1 send to the client from server
2.Data sending & receiving are working fine
3.Hardware power off happened
4.In command prompt by using “netstat” i observed there is connection established for the disconnected IP & port number.
5.I send some data (in wire shark it displayed 6 times retransmission)
6.After this in “command prompt” corresponded connection established data not appeared
7.I send data to client now "Connection closed" exception raised by the IdTCPServer (after this exception, in on except, i closed the connection by using connection.disconnect in code & deleted that particular client from Locklist of IdTCPServer.)
8.Hardware powered on & send SYN with Seq No = 0
9.In wire shark SYN ACK with Seq No like 45678452 sent to hardware
10.After that in command prompt connection establishment was observed
11.I tried to send data to client, but “Locklist” not updated with the client IP& port again so data not sent the client (my code is like if IP not present in “Locklist” then not sending data).
Is there any solutions?
Following is my code:
try
for Count := 0 to frmtcpserver.IdTCPServer1.Contexts.LockList.Count - 1
do
begin
if TIdContext(frmtcpserver.IdTCPServer1.Contexts.LockList.Items[Count]).Binding.PeerIP = Destination_IP then
begin
DestinationIPIdx := Count;
end;
end;
frmtcpserver.IdTCPServer1.Contexts.UnlockList;
if DestinationIPIdx > -1 then
begin
// sending data here
TIdContext(frmtcpserver.IdTCPServer1.Contexts.LockList.Items[DestinationIPIdx])
.Connection.IOHandler.Write(TempBuf, NoofBytesToSend,0);
end;
end;
on E: EidException do
begin
TIdContext(frmtcpserver.IdTCPServer1.Contexts.LockList.Items[DestinationIPIdx]).Connection.Disconnect;
frmtcpserver.IdTCPServer1.Contexts.LockList.Delete(DestinationIPIdx);
end;
You are calling Contexts.LockList() WAY too many times. The contexts list is protected by a critical section. The calls to LockList() and UnlockList() MUST be balanced or you will deadlock the server, preventing clients from connecting and disconnecting.
LockList() returns the actual list. So, you should lock it once, access its items as needed, and then unlock it once.
Try something more like this instead:
list := frmtcpserver.IdTCPServer1.Contexts.LockList;
try
for i := 0 to list.Count - 1 do
begin
ctx := TIdContext(list[i]);
if ctx.Binding.PeerIP = Destination_IP then
begin
// sending data here
try
ctx.Connection.IOHandler.Write(TempBuf, NoofBytesToSend, 0);
except
on E: EIdException do
begin
ctx.Connection.Disconnect;
end;
end;
break;
end;
end;
finally
frmtcpserver.IdTCPServer1.Contexts.UnlockList;
end;
That being said, if the server's OnExecute event is communicating back and forth with the client then it is generally not safe to directly send data to a client from outside of the client's OnExecute event, like you are doing. You risk corrupting the communications. It is safer to give each client context its own thread-safe queue of outgoing data, and then use the OnExecute event to send that data when it is safe to do so. For example:
type
TMyContext = class(TIdServerContext)
public
Queue: TThreadList;
...
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
destructor Destroy; override;
end;
PIdBytes := ^TIdBytes;
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
inherited;
Queue := TThreadList.Create;
end;
destructor TMyContext.Destroy;
var
list: TList;
I: integer;
begin
list := Queue.LockList;
try
for i := 0 to list.Count-1 do
begin
PIdBytes(list[i])^ := nil;
Dispose(list[i]);
end;
finally
Queue.UnlockList;
end;
Queue.Free;
inherited;
end;
procedure TFrmTcpServer.FormCreate(Sender: TObject);
begin
IdTCPServer1.ContextClass := TMyContext;
end;
procedure TFrmTcpServer.IdTCPServer1Execute(AContext: TIdContext);
var
Queue: TList;
tmpList: TList;
i: integer;
begin
...
tmpList := nil;
try
Queue := TMyContext(AContext).Queue.LockList;
try
if Queue.Count > 0 then
begin
tmpList := TList.Create;
tmpList.Assign(Queue);
Queue.Clear;
end;
finally
TMyContext(AContext).Queue.UnlockList;
end;
if tmpList <> nil then
begin
for i := 0 to tmpList.Count-1 do
begin
AContext.Connection.IOHandler.Write(PIdBytes(tmpList[i])^);
end;
end;
finally
if tmpList <> nil then
begin
for i := 0 to tmpList.Count-1 do
begin
PIdBytes(tmpList[i])^ := nil;
Dispose(tmpList[i]);
end;
end;
tmpList.Free;
end;
...
end;
var
list: TList;
ctx: TIdContext;
I: integer;
data: PIdBytes;
begin
list := IdTCPServer1.Contexts.LockList;
try
for i := 0 to list.Count - 1 do
begin
ctx := TIdContext(list[i]);
if ctx.Binding.PeerIP = Destination_IP then
begin
New(data);
try
data^ := Copy(TempBuf, 0, NoofBytesToSend);
TMyContext(ctx).Queue.Add(data);
except
data^ := nil;
Dispose(data);
end;
break;
end;
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
I have inherited an extensive (199 commands) Delphi 7 Indy 9 app that I am upgrading to Indy 10 (in D10.1). I have upgraded all the code, and it compiles and runs. The problem I have is that now in Indy 10 all the handlers also return a response code (and text) in addition to the coded response that they did under Indy 9.
For example:
// server
procedure TFormMain.IdCmdTCPServer1loginCommand(ASender: TIdCommand);
var
Rights: String;
begin
if BillingUserRegistered(ASender.Params[0], ASender.Params[1], Rights) then
begin
myClient := TClientData.Create;
myClient.ClientName := ASender.Params[0];
myClient.ClientHost := #32; // indy9 was .Thread.Connection.LocalName;
myClient.ID := Now;
ASender.Context.Data := myClient;
ListBox1.Items.AddObject(
PadR(myClient.ClientName,12,' ') + '=' +
FormatDateTime('yyyy-mm-dd hh:nn:ss', myClient.ID),
TDateTimeO.Create(myClient.ID));
ASender.Context.Connection.IOHandler.WriteLn('SUCCESS' + ' ' + Rights)
end
else
ASender.Context.Connection.IOHander.WriteLn('Login failed!');
end;
...
// client side
function TfrmLogin.VerifyUserNameAndPassword(username, password: String): Boolean;
var
response, response1: String;
begin
frmMain.IdTCPClient1.IOHandler.WriteLn('login' + ' ' +
username + ' ' + password)
response := frmMain.IdTCPClient1.IOHandler.ReadLn();
// I have to add this now to capture the response code too!
response1 := frmMain.IdTCPClient1.IOHandler.ReadLn(); // 200 OK
// ------------------------------------------------------
if Copy(response,1,7) = 'SUCCESS' then
begin
rights := Copy(response,9,4);
There are a lot of command handlers, and they all have their own custom responses. That's a lot of code to change at the client. Is there a way I can tell the IdCmdTCPServer to suppress the standard '200 Ok' response if the command handler already provides it's own? Or am I in for a long night?
Thanks
If you need to suppress the default command responses, you can either:
clear the TIdCommandHandler's ReplyNormal and ExceptionReply properties (this also works in Indy 9, except that ExceptionReply was ReplyExceptionCode in that version), and the server's CommandHandlers.ExceptionReply property (Indy 10 only).
set the TIdCommand.PerformReply property to false in your OnCommand handler (this also works in Indy 9):
procedure TFormMain.IdCmdTCPServer1loginCommand(ASender: TIdCommand);
var
...
begin
ASender.PerformReply := False;
...
end;
set the server's CommandHandlers.PerformReplies property to false (Indy 10 only - it will set TIdCommand.PerformReply to false by default):
IdCmdTCPServer1.CommandHandlers.PerformReplies := False;
On the other hand, you should consider using the command handler responses the way they are designed to be used, eg:
procedure TFormMain.IdCmdTCPServer1loginCommand(ASender: TIdCommand);
var
Rights: String;
begin
if ASender.Params.Count = 2 then
begin
if BillingUserRegistered(ASender.Params[0], ASender.Params[1], Rights) then
begin
...
ASender.Reply.SetReply('SUCCESS', Rights);
end
else
ASender.Reply.SetReply('ERROR', 'Login failed!');
end
else
ASender.Reply.SetReply('ERROR', 'Wrong number of parameters!');
end;
I would even go as far as saying that you should set the TIdCommandHandler.NormalReply.Code property to SUCCESS and the TIdCommandHandler.ExceptionReply.Code property to ERROR, and then you can do this inside your OnCommand handler:
procedure TFormMain.IdCmdTCPServer1loginCommand(ASender: TIdCommand);
var
Rights: String;
begin
if ASender.Params.Count <> 2 then
raise Exception.Create('Wrong number of parameters!');
if not BillingUserRegistered(ASender.Params[0], ASender.Params[1], Rights) then
raise Exception.Create('Login failed!');
...
ASender.Text.Text := Rights;
end;
With that said, any of these approaches should work fine without changing your existing client code. However, in Indy 10, I would suggest using SendCmd() instead of WriteLn()/ReadLn() directly:
function TfrmLogin.VerifyUserNameAndPassword(username, password: String): Boolean;
var
response: String;
begin
response := frmMain.IdTCPClient1.SendCmd('login ' + username + ' ' + password);
if response = 'SUCCESS' then
begin
rights := frmMain.IdTCPClient1.LastCmdResult.Text.Text;
...
end else begin
// error message in frmMain.IdTCPClient1.LastCmdResult.Text.Text ...
end;
end;
Alternatively, you can let SendCmd() raise an exception if it does not receive a SUCCESS reply:
function TfrmLogin.VerifyUserNameAndPassword(username, password: String): Boolean;
begin
try
frmMain.IdTCPClient1.SendCmd('login ' + username + ' ' + password, 'SUCCESS');
except
on E: EIdReplyRFCError do begin
// error message in E.Message ...
...
Exit;
end;
end;
rights := frmMain.IdTCPClient1.LastCmdResult.Text.Text;
...
end;
SendCmd() does exist in Indy 9, but it only supports numeric-based response codes, which you are not using. As you can see above, SendCmd() in Indy 10 supports string-based response codes as well as numeric ones.
On a side note: in your server code, the OnCommand handler runs in a worker thread, so your use of ListBox1.Items.AddObject() is not thread-safe. Any access to the UI must be synchronized with the main UI thread, using techniques like TThread.Synchronize(), TThread.Queue(), TIdSync, TIdNotify, etc, eg:
procedure TFormMain.IdCmdTCPServer1loginCommand(ASender: TIdCommand);
var
Rights: String;
myClient: TClientData;
begin
if ASender.Params.Count = 2 then
begin
if BillingUserRegistered(ASender.Params[0], ASender.Params[1], Rights) then
begin
myClient := TClientData(ASender.Context.Data);
if myClient = nil then
begin
myClient := TClientData.Create;
ASender.Context.Data := myClient;
end;
myClient.ID := Now;
myClient.ClientName := ASender.Params[0];
myClient.ClientHost := GStack.HostByAddress(ASender.Context.Binding.PeerIP, ASender.Context.Binding.IPVersion);
// In Indy 9, this would be:
// myClient.ClientHost := GStack.WSGetHostByAddr(ASender.Thread.Connection.Socket.PeerIP);
// NOT ASender.Thread.Connection.LocalName!
TThread.Queue(nil,
procedure
begin
ListBox1.Items.AddObject(
PadR(myClient.ClientName,12,' ') + '=' + FormatDateTime('yyyy-mm-dd hh:nn:ss', myClient.ID),
TDateTimeO.Create(myClient.ID));
end
);
ASender.Reply.SetReply('SUCCESS', Rights);
end
else
ASender.Reply.SetReply('ERROR', 'Login failed!');
end
else
ASender.Reply.SetReply('ERROR', 'Wrong number of parameters!');
end;
Make sure your BillingUserRegistered() function is similarly thread-safe, if it is not already.
This question directly relates to my Previous Question.
I have a need to create a TClientDataSet on a client from an Oracle 11g cursor contained in a package. I am using Delphi XE2 and DBExpress to connect to the DB and DataSnap to send the data back to the client.
When I configure the TSQLStoredProc to the TClientDataset at design time I can return the cursor as a TClientDataset with no problem and get expected results.
When I try to execute the Stored Procedure at runtime it returns an empty TClientDataset.
Is it possible to configure and execute an Oracle 11g Stored Procedure using TSQLStoredProc at runtime?
DataSnap Server
Design time Data Module code [View as Text]
object StrProc1: TSQLStoredProc
SchemaName = 'xxxx'
MaxBlobSize = -1
Params = <
item
DataType = ftWideString
Precision = 2000
Name = 'ABBR'
ParamType = ptInput
Value = 'ZZZTOP'
end
item
DataType = ftCursor
Precision = 8000
Name = 'RES'
ParamType = ptOutput
Size = 8000
end>
PackageName = 'KP_DATASNAPTEST'
SQLConnection = SQLConnection1
StoredProcName = 'GETFAXDATA'
Left = 408
Top = 72
end
object DataSetProvider1: TDataSetProvider
DataSet = StrProc1
Left = 408
Top = 120
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
ProviderName = 'DataSetProvider1'
Left = 408
Top = 176
end
function to execute Design Time config
function TKPSnapMethods.getCDS_Data3: OLEVariant;
begin
self.ClientDataSet1.Open;
result:= self.ClientDataSet1.Data;
self.SQLConnection1.Close;
end;
function to execute Runtime configuration This is the code that returns an empty ClientDataSet. The objective is to connect the pieces, set the value of the parameter, open the CDS and return the CDS.Data
function TKPSnapMethods.getCDS_Data2(schema: String): OleVariant;
var
cds: TClientDataSet;
dsp: TDataSetProvider;
strProc: TSQLStoredProc;
ProcParams: TList;
begin
strProc := TSQLStoredProc.Create(self);
try
strProc.SQLConnection:= SQLCon;//<--A TSQLConnection
dsp := TDataSetProvider.Create(self);
try
dsp.DataSet := strProc;
cds := TClientDataSet.Create(self);
try
cds.DisableStringTrim := True;
cds.ReadOnly := True;
cds.SetProvider(dsp);
ProcParams:= TList.Create;
try
//Load Stored Procedure Parameters
SQLCon.GetProcedureParams('GETFAXDATA','KP_DATASNAPTEST',Schema,ProcParams);
LoadParamListItems(StrProc.Params,ProcParams);
strProc.ParamByName('ABBR').AsString := 'ZZZTOP';//<--Assign Parms
strProc.MaxBlobSize := -1;
strProc.SchemaName:= Schema;
strproc.PackageName:='KP_DATASNAPTEST';
strProc.StoredProcName:= 'GETFAXDATA';
cds.Open;
Result := cds.Data;
finally
FreeProcParams(ProcParams);
end;
finally
FreeAndNil(cds);
end;
finally
FreeAndNil(dsp);
end;
finally
FreeAndNil(strProc);
self.SQLCon.Close;
end;
end;
Client Code this is just a test form that creates a connection to the DataSnap Server executes the ServerMethods and displays the results in a string grid.
procedure TForm1.Button1Click(Sender: TObject);
var
proxy:TKpSnapMethodsClient;
cds :TClientDataSet;
field: TField;
r,c:integer;
begin
r:=0;
c:=0;
SQLConTCPSERV.Connected := True; //TSQLConnection
proxy:= TKPSnapMethodsClient.Create(SQLConTCPSERV.DBXConnection,false);
cds:= TClientDataSet.Create(nil);
try
//cds.Data:= proxy.getCDS_Data2('TESTTH');//<--Runtime function
cds.Data:= proxy.getCDS_Data3; //<--Design time function
if cds <> nil then
begin
cds.Open;
cds.First;
//String grid to display CDS contents.
strGrid1.ColCount:= cds.FieldCount; //returns correct #
strGrid1.RowCount:= cds.RecordCount;
while not cds.Eof do //<--runtime wont make it past here
begin
for field in cds.fields do //loop fields
begin
strgrid1.Cells[c,r]:= field.Text; //display results.
c:=c+1;
end;
c:=0;
r:=r+1;
cds.Next;
end;
end
else showmessage('DataSet is NIL');
finally
cds.Free;
proxy.Free;
SQLConTCPSERV.Connected := False;
end;
end;
Once agian I must confess I am new to the Delphi language. I have searched google, code.google, the Embarcadero Developer Network and DBExpress documentation all to no avail.
I just don't understand why there would be a difference between design time and runtime.
I've resolved the issue. the problem is in the order of assigning values to the TSQLStoredProc component.
when calling this code:
strproc.PackageName:='KP_DATASNAPTEST';
strProc.StoredProcName:= 'GETFAXDATA';
the parameters are cleared. Below is the code to set the StoredProcName found in Data.SqlExpr
procedure TSQLStoredProc.SetStoredProcName(Value: UnicodeString);
begin
//if FStoredProcName <> Value then
//begin
FStoredProcName := Value;
SetCommandText(Value);
if Assigned(FProcParams) then // free output params if any
FreeProcParams(FProcParams);
//end;
end;
As you can see if FProcParams are assigned then FreeProcParams is call which frees the params. Because I was setting the StroredProcName after I was assigning the param values the code was executing with cleared params and returning an empty cursor.
the order that produces correct results at runtime [from getCDS_Data2] is as follows:
strProc.SchemaName:= Schema;
SQLCon.GetProcedureParams('GETFAXDATA','KP_DATASNAPTEST',Schema,ProcParams);
LoadParamListItems(StrProc.Params,ProcParams);
strproc.PackageName:='KP_DATASNAPTEST';
strProc.StoredProcName:= 'GETFAXDATA';
strProc.MaxBlobSize := -1;
strProc.ParamCheck:=true;
strProc.ParamByName('ABBR').AsString := 'ZZZTOP';
cds.Open;
So I'm having this code that processes what the client sends on a pattern. If he sends 'getBENUds', the server sends the DataSet for this table back using the SaveToString method.
Then, this is sent to the client. (I'm using Synapse).
procedure TTCPSocketThrd.Execute;
var s: String;
strm: TMemoryStream;
ADO_CON: TADOConnection;
ADO_QUERY: TADOQuery;
DS_PROV: TDataSetProvider;
DS_CLIENT: TClientDataSet;
begin
CoInitialize(nil);
Sock := TTCPBlockSocket.Create;
try
Sock.Socket := CSock;
Sock.GetSins;
with Sock do
begin
repeat
if terminated then break;
s := RecvTerminated(60000,'|');
if s = 'getBENUds' then
begin
//ini ADO_CON
ADO_CON := TADOConnection.Create(Form1);
ADO_CON.ConnectionString := 'not for public';
ADO_CON.LoginPrompt := false;
ADO_CON.Provider := 'SQLOLEDB.1';
ADO_CON.Open;
//ini ADO_QUERY
ADO_QUERY := TADOQuery.Create(ADO_CON);
ADO_QUERY.Connection := ADO_CON;
//ini DS_PROV
DS_PROV := TDataSetProvider.Create(ADO_CON);
DS_PROV.DataSet := ADO_QUERY;
//ini DS_CLIENT
DS_CLIENT := TClientDataSet.Create(ADO_CON);
DS_CLIENT.ProviderName := 'DS_PROV';
//SQLQUERY Abfrage
ADO_QUERY.SQL.Clear;
ADO_QUERY.SQL.Add('SELECT * FROM BENU');
ADO_QUERY.Open;
//DSCLIENTDATASET bauen
strm := TMemoryStream.Create;
DS_CLIENT.Open;
DS_CLIENT.SaveToStream(strm);
end
else if s = 'getBESTEds' then
...
The line it says: DS_CLIENT.Open an exception is thrown:
An exception has been thrown: class EDatabaseError. Text: 'missing data-provider or data package'.
The data-provider has been set as can be seen above to 'DS_PROV', so it has to be the missing data package.
But shouldn't the ClientDataSet get its data from the DataSetProvider which in turn gets it from the ADOQuery that gets the data from the database?
This is as far as I get with my level of knowledge. I hope its not too difficult, because in my eyes, everything I did was correct.
Use
DS_CLIENT.SetProvider(DS_PROV);
or after DS_PROV creation: (at this time your component has really no name)
DS_PROV.name := 'DS_PROV';