I am working on DataSnap project in Delphi XE2 using TCP/IP protocol that needs to pass a stream of binary data to the server as a method parameter. The problem I am running into is that there seems to be a size limit of about 32 KB on the stream contents. Beyond this limit the stream received at the server is empty. If I pass additional method parameters they arrive intact so it seems to be an issue at the parameter level.
Here is how the DataSnap service class is declared:
TDataSnapTestClient = class(TDSAdminClient)
private
FSendDataCommand: TDBXCommand;
public
constructor Create(ADBXConnection: TDBXConnection); overload;
constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
destructor Destroy; override;
procedure SendData(Data: TStream);
end;
The approach I am using should work, at least according to the article by Jim Tierney. That said, there apparently have been changes since Delphi 2009 that have broken Jim Tierney's sample code.
DataSnap Server Method Stream Parameters
Any ideas on how to resolve this issue would be greatly appreciated.
DataSnap transfers the data in 32k chunks. The receiving end has no way of knowing how many bytes will be received until after all chunks have been reassembled. Once all the data has been received, DataSnap doesn't set the size of the TStream that received the data, so you can't use it until you move it to another stream that knows how many bytes are in the stream.
I know that pulling 32k+ from a DataSnap server is not the same as pushing 32k+ to a DataSnap server, but this may work for you as well. Try running the TStream through this code after the DataSnap server finishes receiving the data:
procedure CopyStreamToMemoryStream(const ASource: TStream; var ADest: TMemoryStream; const Rewind: Boolean = True);
const
LBufSize = $F000;
var
LBuffer: PByte;
LReadCount: Integer;
begin
GetMem(LBuffer, LBufSize);
ADest.Clear;
try
repeat
LReadCount := ASource.Read(LBuffer^, LBufSize);
if LReadCount > 0 then
ADest.WriteBuffer(LBuffer^, LReadCount);
until LReadCount < LBufSize;
finally
FreeMem(LBuffer, LBufSize);
end;
if Rewind then
ADest.Seek(0, TSeekOrigin.soBeginning);
end;
I can't remember where I found this code (years ago), so I can't give credit where credit is due, but it has been working for me reliably for years now.
I got thinking about it and it occurred to me that transferring the data to another memory stream just wastes memory, especially if the file is very large. All we need to do is count the bytes and set the stream size, right?!
procedure FixStream(const AStream: TStream);
const
LBufSize = $F000;
var
LBuffer: PByte;
LReadCount, StreamSize: Integer;
begin
GetMem(LBuffer, LBufSize);
try
StreamSize := 0;
repeat
LReadCount := AStream.Read(LBuffer^, LBufSize);
Inc(StreamSize, LReadCount);
until LReadCount < LBufSize;
AStream.Size := StreamSize;
finally
FreeMem(LBuffer, LBufSize);
end;
end;
Do you want to give that a try? I'm not able to test the code right now or I would...
Related
This code work's fine when I send data across the LAN with an Indy client component, but when I receive data from an external application from the web, it's causing it to fail. Could there be something on the client-side that is causing IdTCPServer to disconnect before all the data is read? An average of 33,000 characters are being sent by the client. Any suggestions?
procedure TFrmMain.IdTCPServer1Execute(AContext: TIdContext);
var
strm: TMemoryStream;
RxBuf: TIdBytes;
begin
Memo1.Clear;
strm := TMemoryStream.Create;
try
// read until disconnected
AContext.Connection.IOHandler.ReadStream(strm, -1, true);
strm.Position := 0;
ReadTIdBytesFromStream(strm, RxBuf, strm.Size);
finally
strm.Free;
end;
Memo1.Lines.Add(BytesToString(RxBuf));
AContext.Connection.IOHandler.WriteLn('000');
end;
I also tryed this other code, in this case unlike the first code it only reads part of the data beeing sent. Is there a way to make the IdTCPServer Handler wait until all the data is collected?
procedure TFrmMain.IdTCPServer1Execute(AContext: TIdContext);
var
RxBuf: TIdBytes;
begin
RxBuf := nil;
with AContext.Connection.IOHandler do
begin
CheckForDataOnSource(10);
if not InputBufferIsEmpty then
begin
InputBuffer.ExtractToBytes(RxBuf);
end;
end;
AContext.Connection.IOHandler.WriteLn('000');
Memo1.Lines.Add( BytesToString(RxBuf) );
end;
This code you posted as an answer is all wrong.
First off, you can't use BytesToString() on arbitrary byte blocks, that won't handle multi-byte encodings like UTF-8 correctly.
Also, you are not looking for the EOT terminator correctly. There is no guarantee that it will be the last byte of RxBuf after each read, if the client sends multiple XML messages. And even if it were, using Copy(BytesToString(), ...) to extract it into a string will never result in a blank string, like your code is expecting.
If the client sends an EOT terminator at the end of the XML, there is no need for a manual reading loop. Simply call TIdIOHandler.ReadLn() with the EOT terminator, and let it handle the read looping internally until the EOT is reached.
Also, the CoInitialize() and CoUninitialize() calls should be done in the OnConnect and OnDisconnect events, respectively (actually, they would be better called in a TIdThreadWithTask descendant assigned to the TIdSchedulerOfThread.ThreadClass property, but that is a more advanced topic for another time).
Try something more like this:
procedure TFrmMain.IdTCPServer1Connect(AContext: TIdContext);
begin
CoInitialize(nil);
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
procedure TFrmMain.IdTCPServer1Disconnect(AContext: TIdContext);
begin
CoUninitialize();
end;
procedure TFrmMain.IdTCPServer1Execute(AContext: TIdContext);
var
XML: string;
begin
cdsSurescripts.Close;
XML := AContext.Connection.IOHandler.ReadLn(#4);
Display('CLIENT', XML);
AContext.Connection.IOHandler.WriteLn('000');
end;
Personally, I would take a different approach. I would suggest using an XML parser that supports a push model. Then you can read arbitrary blocks of bytes from the connection and push them into the parser, letting it fire events to you for completed XML elements, until the terminator is reached. This way, you don't have to waste time and memory buffering the entire XML in memory before you can then process it.
For further reference to anyone, I had to create a loop and wait for an EOT chr(4) send by the client in order to collect all the data on the IdTCPServer1Execute. This happens because the data is fragmented by Indy, The code looks something like this:
procedure TFrmMain.IdTCPServer1Execute(AContext: TIdContext);
var
Len: Integer;
Loop: Boolean;
begin
CoInitialize(nil);
cdsSurescripts.Close;
Loop := True;
while Loop = true do
begin
if AContext.Connection.IOHandler.Readable then
begin
AContext.Connection.IOHandler.ReadBytes( RxBuf,-1, True);
Len := Length(BytesToString(RxBuf));
if Copy(BytesToString(RxBuf), Len, 1) = '' then
begin
loop := False;
end;
end;
end;
Display('CLIENT', BytesToString(RxBuf));
AContext.Connection.IOHandler.WriteLn('000');
CoUninitialize();
end;
I'm using FireMonkey in Delphi 10.1 Berlin for developing an Android mobile client application, and I'm using VCL in Delphi 10.1 Berlin for developing a Windows server application.
In the mobile application, I am using TIdTCPClient for sending the following record:
PSampleReq = ^TSampleReq ;
TSampleReq = packed record
Value1: array [0..10] of Char;
Value2: array [0..59] of Char;
Value3: array [0..40] of Char;
Value4: Int64;
Value5: array [0..9] of Char;
Value6: array [0..9] of Char;
Value7: Integer;
end;
I have filled the packet with data and am sending the packet using the following code:
FIdTCPClient.IOHandler.Write(RawToBytes(TSampleReq,SizeOf(TSampleReq)));
While reading the data in the Server application, I am not able to read the Value5, Value6and Value7 fields. Below is the code that is reading the data:
Move(tyTIDBytes[0], SampleReq, SizeOf(TSampleReq));
For receiving the data which is send from the client socket, I have used the TIDTcpServer and handled the below code in Execute method:
TServerRecord = packed record
PointerMessage : TIndyBytes;
ClientSocket : TIdTCPConnection;
end;
Var
ReceivedIDBytes: TServerRecord;
begin
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.InputBuffer.ExtractToBytes(ReceivedIDBytes.PointerMessage.tyTIDBytes) ;
ReceivedIDBytes.ClientSocket := AContext.Connection;
MessageProcessorThread.ProcessMessageQueue.Enqueue(ReceivedIDBytes);
end;
After this I'm processing the data from Queue and the processing method I have mentioned below:
var
InputRec: TServerRecord;
begin
InputRec := DBWorkerThread.DBWorkerQueue.Dequeue;
MessageHeaderPtr := #InputRec.PointerMessage.tyTIDBytes[0];
iHMMessageCode := StrToIntDef( Trim(MessageHeaderPtr^.MessageCode), UNKNOWN_MESSAGE_CODE);
case iHMMessageCode of
1001:
begin
Move(InputRec.PointerMessage.tyTIDBytes[0], SampleReq, SizeOf(TSampleReq));
end;
end;
And in this I'm not able to read the Value5, Value6 and Value7 fields.
With the below Link, I have found some optimized technique and how I can handle the packets properly without any packet missing. Please help me out to resolve this issue.
Sending the right record size over socket
Your use of ExtractToBytes() is completely wrong. That method returns whatever arbitrary bytes are stored in the InputBuffer at that particular moment, which may be less than, or more than, what you are actually expecting.
If your client is sending a fixed-sized record each time, you should be reading exactly that many bytes, no more, no less:
var
ReceivedIDBytes: TServerRecord;
begin
AContext.Connection.IOHandler.ReadBytes(ReceivedIDBytes.PointerMessage.tyTIDBytes, SizeOf(TSampleReq)); // <-- HERE!!!
ReceivedIDBytes.ClientSocket := AContext.Connection;
MessageProcessorThread.ProcessMessageQueue.Enqueue(ReceivedIDBytes);
end;
However, if the size of the record depends on the message code, then your client should send the number of bytes in a record before sending the actual record bytes:
var
tyTIDBytes: TIdBytes;
begin
tyTIDBytes := RawToBytes(TSampleReq, SizeOf(TSampleReq));
FIdTCPClient.IOHandler.Write(Int32(Length(tyTIDBytes)));
FIdTCPClient.IOHandler.Write(tyTIDBytes);
end;
And then the server can read the byte count before reading the bytes:
var
ReceivedIDBytes: TServerRecord;
begin
AContext.Connection.IOHandler.ReadBytes(ReceivedIDBytes.PointerMessage.tyTIDBytes, AContext.Connection.IOHandler.ReadInt32); // <-- HERE!!!
ReceivedIDBytes.ClientSocket := AContext.Connection;
MessageProcessorThread.ProcessMessageQueue.Enqueue(ReceivedIDBytes);
end;
using Delphi XE2 and TJvHidDevice class from Jedi library, I managed to successfully communicate with a USB device (pic32mx7 board, with my code running on it). The usual way of "send request, wait for single response" works.
The problem is with a command that results in a larger number of consecutive responses. If those responses are sent by the device as fast as possible - or even if I add a small delay between them like 5ms - I lose packets (reports? frames?). The OnDeviceData event simply doesn't seem to fire for all of them. If I add larger delays in the device's code, the problem goes away.
I used USBPcap program to capture USB data and dump it to a file which, once I open it in WireShark, contains all of the data sent by the device (I send 255 packets as a test, with all zeroes and one "1" shifting its place by 1 position in every packet). So, I think both the device and Windows are doing their job.
To make sure my Delphi code is not faulty, I tried the Jedi example project "DevReader" (here is the main.pas code) which dumps data on screen and it is missing packets as well.
I feel like there should be more information on the net about Jedi's USB classes but I am having trouble finding it.
I may be able to avoid this problem by aggregating/condensing the device's responses, but would still like to know what's going on.
Edit:
Tried from a console app: packets were not lost anymore.
Modified the Jedi demo app to only count received packets and update a counter label on screen (no forced window repaint) - no lost packets.
Added sleep(1) in the OnData event - no lost packets.
Added sleep(2) in the OnData event - losing packets again.
This looks like the Jedi thread that reads data must not be delayed by any processing - shouldn't there be some buffering of data going on (by Windows?) that would allow for this type of processing delays? Judging by the packet loss "pattern" it seems as if there is buffering, but it is insufficient because I can receive e.g. 30 packets then lose 5 then receive another 20 etc.
I will modify my code to copy the data and exit the OnData event as quickly as possible so that the thread has minimum "downtime" and I will report the outcome.
Since the cause of the problem appears to be related to the amount of time the USB reading thread is blocked by Synchronise, i.e. the data processing carried out by the main thread, I made changes in the thread code, (TJvHidDeviceReadThread class, JvHidControllerClass.pas unit). Any code that used this unit and the classes contained should still work without any modifications, nothing public was changed.
New behavior: every time the data is read, it is placed in a thread safe list. Instead of Synchronise it now uses Queue, but only if it is not queued already. The Queued method reads from the thread safe list until it is empty. It fires an event (same event as in the old code) for each buffered report in the list. Once the list is empty, the "Queued" flag is reset and the next read will cause Queuing again.
In the tests so far I did not encounter lost packets.
The thread class was extended:
TJvHidDeviceReadThread = class(TJvCustomThread)
private
FErr: DWORD;
// start of additions
ReceivedReports : TThreadList;
Queued: boolean;
procedure PushReceivedReport(const bytes: array of byte; const NumBytesRead: cardinal);
function PopReceivedReport(var ReportID: byte; var ReportBytes: TBytes): boolean;
procedure FlushBuffer;
// end of additions
procedure DoData;
procedure DoDataError;
constructor CtlCreate(const Dev: TJvHidDevice);
protected
procedure Execute; override;
public
Device: TJvHidDevice;
NumBytesRead: Cardinal;
Report: array of Byte;
constructor Create(CreateSuspended: Boolean);
//added destructor:
destructor Destroy; override;
end;
In the implementation section, the following was modified:
constructor TJvHidDeviceReadThread.CtlCreate(const Dev: TJvHidDevice);
begin
inherited Create(False);
// start of changes
ReceivedReports := TThreadList.Create;
// end of changes
Device := Dev;
NumBytesRead := 0;
SetLength(Report, Dev.Caps.InputReportByteLength);
end;
procedure TJvHidDeviceReadThread.Execute;
...
...
...
//replaced: Synchronize(DoData); with:
PushReceivedReport (Report, NumBytesRead);
...
And the following was added:
type
TReport = class
ID: byte;
Bytes: TBytes;
end;
destructor TJvHidDeviceReadThread.Destroy;
var
l: TList;
begin
RemoveQueuedEvents (self);
try
l := ReceivedReports.LockList;
while l.Count>0 do
begin
TReport(l[0]).Free;
l.Delete(0);
end;
finally
ReceivedReports.UnlockList;
FreeAndNil (ReceivedReports);
end;
inherited;
end;
procedure TJvHidDeviceReadThread.FlushBuffer;
var
ReportID: byte;
ReportBytes: TBytes;
begin
while PopReceivedReport (ReportID, ReportBytes) do
Device.OnData(Device, ReportID, ReportBytes, length(ReportBytes));
end;
function TJvHidDeviceReadThread.PopReceivedReport(var ReportID: byte; var ReportBytes: TBytes): boolean;
var
l: TList;
rep: TReport;
begin
l := ReceivedReports.LockList;
rep := nil;
try
result := l.Count>0;
if result
then
begin
rep := l[0];
l.Delete(0);
end
else Queued := false;
finally
ReceivedReports.UnlockList;
end;
if result then
begin
ReportID := rep.ID;
SetLength(ReportBytes, length(rep.Bytes));
System.move (rep.Bytes[0], ReportBytes[0], length(rep.Bytes));
rep.Free;
end;
end;
procedure TJvHidDeviceReadThread.PushReceivedReport(const bytes: array of byte; const NumBytesRead: cardinal);
var
rep: TReport;
begin
rep := TReport.Create;
setlength (rep.Bytes, NumBytesRead-1);
rep.ID := Bytes[0];
System.move (Bytes[1], rep.Bytes[0], NumBytesRead-1);
// explicitely lock the list just to provide a locking mechanism for the Queue flag as well
ReceivedReports.LockList;
try
if not Queued then
begin
Queued := true;
Queue (FlushBuffer);
end;
ReceivedReports.Add(rep);
finally
ReceivedReports.UnlockList;
end;
end;
I have a problem with Indy TCP connection. I use Turbo Delphi 2006 with Indy 10.
I want to send multiple TCP packages from idTCPClient to idTCPServer.
It works finely, when I want to send only one package, or I insert a sleep(100) command between two calls of the function. But if I call this function too frequently, it doesn't call the server's onExecute every time.
My code for sending:
procedure SendData(var data: TIdBytes) ;
begin
FormMain.IdTCPClient.Connect ;
FormMain.IdTCPClient.Socket.Write(data);
FormMain.IdTCPClient.Disconnect ;
end ;
I call this function several times (5-10 times in a second), and want to process all of these packages in my server application:
procedure TFormMain.IdTCPServerMainExecute(AContext: TIdContext);
var
data: TIdBytes ;
begin
AContext.Connection.IOHandler.ReadBytes(data, 4, false)
// processing data
end
Thank you for your answers in advance!
Every time you call Connect(), you are creating a new connection, and TIdTCPServer will start a new thread to handle that connection (unless you enable thread pooling, that is). Is that what you really want? It would be more efficient to have the client leave the connection open for a period of time and reuse the existing connection as much as possible. Disconnect the connection only when you really do not need it anymore, such as when it has been idle for awhile. Establishing a new connection is an expensive operation on both ends, so you should reduce that overhead as much as possible.
On the client side, when you call Write(data), it will send the entire TIdBytes, but you are not sending the length of that TIdBytes to the server so it knowns how many bytes to expect. TIdIOHandler.Write(TIdBytes) does not do that for you, you have to do it manually.
On the server side, you are telling ReadBytes() to read only 4 bytes at a time. After each block of 4 bytes, you are exiting the OnExecute event handler and waiting for it to be called again to read the next block of 4 bytes. Unless the length of the client's source TIdBytes is an even multiple of 4, ReadBytes() will raise an exception (causing the server to disconnect the connection) when it tries to read the client's last block that is less than 4 bytes, so your server code will not receive that block.
Try this instead:
procedure SendData(var data: TIdBytes) ;
begin
FormMain.IdTCPClient.Connect;
try
FormMain.IdTCPClient.IOHandler.Write(Longint(Length(data)));
FormMain.IdTCPClient.IOHandler.Write(data);
finally
FormMain.IdTCPClient.Disconnect;
end;
end;
procedure TFormMain.IdTCPServerMainExecute(AContext: TIdContext);
var
data: TIdBytes;
begin
with AContext.Connection.IOHandler do
ReadBytes(data, ReadLongint, false);
// process data
end;
With that said, if changing the client code to send the TIdBytes length is not an option for whatever reason, then use this server code instead:
procedure TFormMain.IdTCPServerMainExecute(AContext: TIdContext);
var
LBytes: Integer;
data: TIdBytes;
begin
// read until disconnected. returns -1 on timeout, 0 on disconnect
repeat until AContext.Connection.IOHandler.ReadFromSource(False, 250, False) = 0;
AContext.Connection.IOHandler.InputBuffer.ExtractToBytes(data);
// process data
end;
Or:
procedure TFormMain.IdTCPServerMainExecute(AContext: TIdContext);
var
strm: TMemoryStream;
data: TIdBytes;
begin
strm := TMemoryStream.Create;
try
// read until disconnected
AContext.Connection.IOHandler.ReadStream(strm, -1, True);
strm.Position := 0;
ReadTIdBytesFromStream(strm, data, strm.Size);
finally
strm.Free;
end;
// process data
end;
Or:
procedure TFormMain.IdTCPServerMainExecute(AContext: TIdContext);
var
strm: TMemoryStream;
begin
strm := TMemoryStream.Create;
try
// read until disconnected
AContext.Connection.IOHandler.ReadStream(strm, -1, True);
// process strm.Memory up to strm.Size bytes
finally
strm.Free;
end;
end;
When I try to create a custom Transport Filter for datasnap and use it, when I run the client app i get an error stating:
Exception TDBXError in Module ProjectAdminClient.exe. Filter Log Rejected setup parameter FilterUnit given value 1024. At this point the server communication is not possible due to this incompatibility.
What is causing this?
Are you using Filter parameters? I've also created custom transport filters, but never encountered this error. Here's an example do-nothing log filter...
unit LogFilter;
interface
uses
SysUtils, DBXPlatform, DBXTransport;
type
TLogFilter = class(TTransportFilter)
public
constructor Create; override;
destructor Destroy; override;
function ProcessInput(const Data: TBytes): TBytes; override;
function ProcessOutput(const Data: TBytes): TBytes; override;
function Id: UnicodeString; override;
end;
const
LogFilterName = 'Log';
implementation
uses
CodeSiteLogging;
constructor TLogFilter.Create;
begin
inherited Create;
CodeSite.Send(csmBlue,'TLogFilter.Create');
end;
destructor TLogFilter.Destroy;
begin
CodeSite.Send(csmBlue,'TLogFilter.Destroy');
inherited Destroy;
end;
function TLogFilter.ProcessInput(const Data: TBytes): TBytes;
begin
Result := Data;
CodeSite.Send(csmYellow, 'ProcessInput ' + IntToStr(Length(Data)),
TEncoding.ASCII.GetString(Data));
end;
function TLogFilter.ProcessOutput(const Data: TBytes): TBytes;
begin
Result := Data;
CodeSite.Send(csmOrange, 'ProcessOutput ' + IntToStr(Length(Data)),
TEncoding.ASCII.GetString(Data));
end;
function TLogFilter.Id: UnicodeString;
begin
Result := LogFilterName;
end;
initialization
TTransportFilterFactory.RegisterFilter(LogFilterName, TLogFilter);
finalization
TTransportFilterFactory.UnregisterFilter(LogFilterName);
end.
This one works just fine for me (one of the example from my upcoming Delphi XE DataSnap Development Essentials courseware manual).
Groetjes, Bob Swart
I found this question when I had a similar problem using Dr Bob's LogFilter from his Delphi 2010 Datasnap Whitepaper.
The problem, at least partially, is that I had the ZLibCompression filter loaded at the same time I was trying to work with the log filter. The clue was in the ServerContainerUnit1.dfm
Filters = <
item
FilterId = 'ZLibCompression'
Properties.Strings = (
'CompressMoreThan=1024')
end>
I saw the 1024 which was also in the error and figured it was worth trying without the ZLib filter. I removed it from the client and server. Now the log filter works. I get the server time and get breakpoints to work in the LogFilter code.