I am using Russell Libby Pipes last modified in 2010. I have a TpServer sending/receiving messages with multiple TpClients. This worked fine under Delphi7 but now in XE (recently upgraded Pipes also to 2010) a string comes through with #0 between characters eg. '9'#0'8'#0'. I suspect Unicode is the problem but the solution has evaded me. Here are my Server send and Client receive routines. Any help is appreciated.
procedure TfrmServer.CommSend(aStr: String);
begin // Broadcast message; Messages are kept as short as possible
editSend.Text := aStr;
try
Size := editSend.GetTextBuf(Buffer, 250); // Put text into buffer
PipeServer.Broadcast(Buffer^, Size*2); // Send the message to the Clients
Application.ProcessMessages;
except
end;
end;
PROCEDURE TfrmClient.PipeMessage(Sender: TObject; Pipe: Cardinal; Stream: TStream);
VAR // Incoming message
xInStream: TStringStream;
xSize: Integer;
BEGIN // Message received from network
xInStream := TStringStream.Create('');
TRY
xSize := Stream.Size;
xInStream.CopyFrom(Stream, xSize); // Copy stream to local variable
editRcvd.Text := xInStream.DataString;
frmOptions.NetMessage(editRcvd.Text);
EXCEPT
ShowMessage('DMS Client - Message Error: ' + editRcvd.Text); // Debug
END;
xInStream.Free; // Erases any contents
END;
Related
I have an application that makes thousands of HTTP requests along the day.
For best performance, I decided to create only once the IdHTTP object and use this same object for all requests.
This is where the problem begins. While creating one IdHTTP for each request, everything went fine.
The code is pretty basic:
constructor HTTPThread.Create;
begin
inherited Create(false);
httpObject:= TIdHTTP.Create(Nil);
sslObject:= TIdSSLIOHandlerSocketOpenSSL.Create(Nil);
sslObject.SSLOptions.Method:= sslvTLSv1_2;
httpObject.IOHandler:= sslObject;
httpObject.Request.Accept:= frmHTTPRequests.Edit1.Text;
httpObject.Request.UserAgent:= frmHTTPRequests.Edit3.Text;
httpObject.ReadTimeout:= 15000;
httpObject.HandleRedirects:= true;
FreeOnTerminate:= true;
OnTerminate:= TerminateProc;
end;
procedure HTTPThread.DoRequests;
var
htmlSource: string;
begin
try
htmlSource:= httpObject.Get(Link);
//a bunch of other stuff with HTML source
except
on E : Exception do
Synchronize(procedure
begin
errorList.Add(E.Message);
errorList.SaveToFile('Error.txt');
end);
end;
end;
I created this except saving the Error.txt file to watch what is happening...
The code runs fine sometimes for the first 1k requests, sometimes for the first 2k, it varies. Suddently, it starts writing on the TXT file the same error:
Connection reset by peer. domain.com - Socket Error # 10054
I tried to disconnect the httpObject, tried httpObject.Request.Clear, nothing seems to work.
Are there any chance to make this work?
For some reasons Indy doesn't close socket when server respond with Connection reset by peer, so you need to do it manually.
procedure HTTPThread.DoRequests;
const
MAX_TRIES_COUNT = 5;
var
htmlSource: string;
TriesCount: Integer;
begin
TriesCount := 0;
repeat
try
htmlSource:= httpObject.Get(Link);
//a bunch of other stuff with HTML source
except
on E: Exception do
begin
if E.Message.Contains('by peer') then
begin
httpObject.Disconnect;
// Try to solve network connection issues
Continue;
end
else
begin
// Some other error handlers
end;
end;
inc(TriesCount);
end;
until (httpObject.ResponseCode = 200) or (TriesCount > MAX_TRIES_COUNT);
end;
P.S. I don't recommend you to use Synchronize() for threads synchronization. Try to use TCriticalSection or TMonitor instead.
I wrote a communication class based on TThread, which would send some data and receive a reply.
I want the method to:
sent the data (this is a non blocking procedure)
wait for a reply or timeout
show the data received in a vcl control
give back control to the caller
Here is how I try to do,
procedure TForm1.Button1Click(Sender: TObject);
begin
for i := 1 to 5 do // send 5 commands
mycomm.SendCommand();
end;
procedure TMyComm.ShowData();
begin
Form1.Memo1.Lines.Add('Frame received');
end;
procedure TMyComm.SendCommand();
begin
//build frame and put it on interface here
//...
event.WaitFor(3000);
//show received frame if no timeout in VCL
//...
end;
procedure TMyComm.Execute();
begin
while not Terminated do
begin
if receive() then //blocks until frame is received
begin
Synchronize(ShowData); //hangs :-(
event.SetEvent;
end;
end,
end;
Of course this will result in a deadlock, but how can I achieve that my VCL is updated immediately after each received frame?
You can use a anonymous thread, this will only execute the rest of the code after the thread has finished, change it to suite your needs.
You can find the AnonThread Unit in :
C:\Users\Public\Documents\RAD Studio\12.0\Samples\Delphi\RTL\CrossPlatform Utils
uses
AnonThread
var
GetFrame :TAnonymousThread<Boolean>;
begin
GetFrame := TAnonymousThread<Boolean>.Create(function : Boolean
begin
// Start your execution
end,
procedure (AResult : Boolean)
begin
// Wil only execute after the thread has run its course, also safe to do UI updates
end,
procedure (AException : Exception)
begin
ShowMessage('Error : ' + AException.Message);
end);
I have a important problem with building Indy Server/Clients realtime monitoring system...
I am using DELPHI 2010, and Indy version is 10.5.5.........
My purpose is that many client side PCs send screenshots continuosely(4~10fps) to Server, and Server have to send these screenshots frames to some monitoring PCs.
In other words....
Many clients -----send streams--------> to Server
Some monitors <---receive streams----- from Server
Of course, In the case of one client and one monitor with server works well...
But if connecting another clients or monitors, then server have been raising exceptions "Access violation at address 000000000.....", or "Invalid pointer operations" and disconnects client's connection or monitor's one.
At the result, client or monitor will be disconnected from server....
I have used idTCPClient component, described client and monitor code using thread for sending and receiving stream.
I am sure there is no problem with client and monitor side's Code...
But I think that there will be absolutely problem with server side.
For server side, I have used two TidTCPServer controls...
One is to receive streams from client PCs.And another is to send streams to monitor PCs.
server code is like below...
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
Hb: TIdIOHandler;
TempStr: TStrings;
begin
Hb := AContext.Connection.IOHandler;
if Not Hb.InputBufferIsEmpty then
Begin
Hb.CheckForDisconnect(True, True);
AContext.Connection.IOHandler.CheckForDisconnect(True, True);
recv_Stream := TMemoryStream.Create;
recv_Stream.Clear;
if (ReceiveStream(AContext, TStream(recv_Stream)) = False) then
begin
ROutMsg :=AContext.Binding.PeerIP+' -> receiving failed: ' + IntToStr(recv_Stream.Size)+'byte';
recv_Stream.Free;
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Seek(0, soFromBeginning);
ROutMsg :=AContext.Binding.PeerIP+' -> captionString received('+
IntToStr(recv_Stream.Size)+' byte) : "'+StringFromStream(TStream(recv_Stream))+'"';
recv_Stream.Free;
end
else
begin
ROutMsg :=AContext.Binding.PeerIP+' -> screenshot received: ' + KBStr(recv_Stream.Size)+' KB';
if G_Sendable = False then
begin
send_Stream:=TMemoryStream.Create;
send_Stream.Clear;
recv_Stream.Seek(0, soFromBeginning);
send_Stream.Seek(0, soFromBeginning);
send_Stream.CopyFrom(recv_Stream, recv_Stream.Size);
G_Sendable :=True;
end;
recv_Stream.Free;
end;
end;
Application.ProcessMessages;
WaitForSingleObject(Handle, 1);
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
begin
if G_Sendable then
begin
send_Stream.Seek(0,soFromBeginning);
if (SendStream(AContext, TStream(send_Stream)) = False) then
begin
SOutMsg :=AContext.Binding.PeerIP+' -> sending failed -> ' + KBStr(send_Stream.Size)+' KB';
send_Stream.Free;
G_Sendable :=False;
Exit;
end;
SOutMsg :=AContext.Binding.PeerIP+' -> sending successful-> ' + KBStr(send_Stream.Size)+' KB';
send_Stream.Free;
G_Sendable :=False;
end;
Application.ProcessMessages;
WaitForSingleObject(Handle, 1);
end;
What should I do for multi-clients connections with realtime exchange of streams...
Every client PC send screenshot stream 4~10 times per second...
And these streams must be sent to monitors corresponding
Please give me advice....
Your code is not even close to being thread-safe, which is why you are having errors. Every client thread in IdTCPServer_Recv is receiving their respective screeshots to a single shared recv_Stream variable, and then copying that data to a single shared send_Stream variable. All clients connected to IdTCPServer_Send are then reading and sending the same send_Stream at the same time. You are trampling memory all over the place.
You need to use a local variable instead of a shared variable to receive each screenshot, and you need to use a separate TStream object for each monitor client. Don't use a shared TStream for sending, and certainly don't use a global boolean variable to let each monitor client go at it. Have IdTCPServer_RecvExecute() actively create and pass along a new TMemoryStream object to each monitor client that needs to send the current screenshot.
Try something more like this:
uses
..., IdThreadSafe;
type
TMonitorContext = class(TIdServerContext)
public
Screenshots: TIdThreadSafeObjectList;
ScreenshotEvent: THandle;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
destructor Destroy; override;
end;
TScreenshotInfo = class
public
ClientIP: string;
ClientPort: TIdPort;
Data: TMemoryStream;
constructor Create;
destructor Destroy; override;
end;
constructor TMonitorContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList);
begin
inherited;
Screenshots := TIdThreadSafeObjectList.Create;
Screenshots.OwnsObjects := True;
ScreenshotEvent := CreateEvent(null, True, False, nil);
end;
destructor TMonitorContext.Destroy;
begin
Screenshots.Free;
CloseHandle(ScreenshotEvent);
inherited;
end;
constructor TScreenshotInfo.Create;
begin
inherited;
Data := TMemoryStream.Create;
end;
destructor TScreenshotInfo.Destroy;
begin
Data.Free;
inherited;
end;
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
recv_stream: TMemoryStream;
monitors, queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
monitor: TMonitorContext;
begin
recv_stream := TMemoryStream.Create;
try
if not ReceiveStream(AContext, recv_stream) then
begin
ROutMsg := AContext.Binding.PeerIP + ' -> receiving failed: ' + IntToStr(recv_Stream.Size) + ' byte';
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Position := 0;
ROutMsg := AContext.Binding.PeerIP + ' -> captionString received(' +
IntToStr(recv_Stream.Size) + ' byte) : "' + StringFromStream(recv_Stream) + '"';
end
else
begin
ROutMsg := AContext.Binding.PeerIP + ' -> screenshot received: ' + KBStr(recv_Stream.Size) + ' KB';
monitors := IdTCPServer_Send.Contexts.LockList;
try
// alternatively, only queue the screenshot to particular monitors
// that are actually interested in this client...
for i := 0 to monitors.Count-1 do
begin
monitor := TMonitorContext(monitors[i]);
screenshot := TScreenshotInfo.Create;
try
recv_Stream.Position := 0;
screenshot.Data.CopyFrom(recv_stream, 0);
screenshot.Data.Position := 0;
queue := monitor.Screenshots.LockList;
try
queue.Add(screenshot);
SetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
except
screenshot.Free;
end;
end;
finally
IdTCPServer_Send.Contexts.UnlockList;
end;
end;
finally
recv_stream.Free;
end;
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.FormCreate(Sender: TObject);
begin
IdTCPServer_Send.ContextClass := TMonitorContext;
end;
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
var
monitor: TMonitorContext;
queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
begin
monitor := TMonitorContext(AContext);
if WaitForSingleObject(monitor.ScreenshotEvent, 1000) <> WAIT_OBJECT_0 then Exit;
screenshot := nil;
try
queue := monitor.Screenshots.LockList;
try
if queue.Count > 0 then
begin
screenshot := TScreenshotInfo(queue[0]);
queue.Delete(0);
end;
if queue.Count = 0 then
ResetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
if screenshot = nil then Exit;
// you should send screenshot.ClientIP and screenshot.ClientPort to
// this monitor so it knows which client the screenshot came from...
if not SendStream(AContext, screenshot.Data) then
begin
SOutMsg := AContext.Binding.PeerIP + ' -> sending failed -> ' + KBStr(screenshot.Data.Size) + ' KB';
Exit;
end;
SOutMsg := AContext.Binding.PeerIP + ' -> sending successful-> ' + KBStr(screenshot.Data.Size) + ' KB';
finally
screenshot.Free;
end;
end;
On the 'monitor' side, a TIdTCPClient in a thread can listen for incoming screenshot data from the server. I have posted a blog article about server-side push messaging technique with Indy (source code) here:
Indy 10 TIdTCPServer: Server-side message push example
Additional server-side code is required to direct the incoming data to the monitoring clients. Actually you only need to add 'tags' (which could be boolean flags) to the context, indicating wether this connection is sending or monitoring screenshot data. How to assign custom properties to connection context and iterating over them is already answered in other questions here on SO.
After reading this very interesting topic on stackoverflow --> How to wait for COM port receive event before sending more data in a loop
I've ran into many problems and i've tried many solutions ... nothing work well unfortunately !
Many serial port libraries are event-driven and i'm having a hard time understanding them.
I've tried with Asyncpro, Synaser and TComport.
Is it possible to have a function like this:
SerialSendandReply(tx string here,timeout) return rx string and if timeout send a error string
Response from the device are withing milliseconds a blocking way to do it would be better?
Like this:
Dosomething here
showmessage(SerialSendandReply('test',100 )); //100 ms timeout
dosomething else
With this code
TForm1 = class(TForm)
...
private
IOEvent : THandle; // used for IO events
IORx : string;
Comport : TapdComport;
...
procedure TForm1.ComportTriggerAvail(CP: TObject; Count: Word);
var i : integer;
begin
for i:=1 to Count do
IORx:=IORx+Comport.GetChar;
SetEvent(IOEvent);
end;
function TForm1.SerialSAWR(tx : string; TimeOut : integer) : boolean;
begin
Result := False;
try
IORx := ''; // your global var
ResetEvent(IOEvent);
Comport.PutString(tx);
Result := WaitForSingleObject(IOEvent, TimeOut) = WAIT_OBJECT_0;
except
on E : Exception do
// dosomething with exception
end;
end;
// constructor part
IOEvent := CreateEvent(nil, True, False, nil);
// destructor part
if IOEvent <> 0 then
CloseHandle(IOEvent);
Then i've tried to call this function :
if SerialSAWR('test'; 5000) then showmessage(IORx);
Sending is working great but doesn't return anything in the string.
Any advices?
Thank you very much!
Regards,
Laurent
I use TComPort and have created the following routine to do what you ask. TComPort monitors received characters in its monitoring thread and my routine waits for characters without calling Application.ProcessMessages. It may not be the most elegant code but it works fine.
function TArtTComPort.SerialPort_AwaitChars(AMinLength: integer;
ATerminator: char; AQtyAfterTerm: integer; ARaise: boolean): string;
var
fDueBy : TDateTime;
function IsEndOfReplyOrTimeout( var AStr : string ) : boolean;
var
I : integer;
begin
Result := False;
If ATerminator <> #0 then
begin
I := Length( AStr ) - AQtyAfterTerm;
If I > 0 then
Result := AStr[I] = ATerminator;
end;
If not Result then
Result := Length(AStr) >= AMinLength;
// Un-comment this next line to disable the timeout.
//Exit;
If not Result then
begin
Result := Now > fDueBy;
If Result then
If ARaise then
raise EArtTComPort.Create( 'Serial port reply timeout' )
else
AStr := '';
end;
end;
var
Events : TComEvents;
iCount : integer;
S : string;
begin
Assert( AMinLength > 0, 'Invalid minimum length' );
If not FComPort.Connected then
begin
Result := '';
Exit;
end;
fDueBy := Now + (FTimeoutMS * TDMSec );
Result := '';
Repeat
// Setup events to wait for:
Events := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
evCTS, evDSR, evError, evRLSD, evRx80Full];
// Wait until at least one event happens.
FComPort.WaitForEvent(
Events,
FStopEvent.Handle,
FTimeOutMS);
If Events = [] then // timeout
begin
If ARaise then
raise EArtTComPort.Create( 'Serial port reply timeout' )
end
else
begin
If evRxChar in Events then
begin
iCount := FComport.InputCount;
FComPort.ReadStr( S, iCount );
Result := Result + S;
end;
end;
until IsEndOfReplyOrTimeout( Result );
end;
I switched for nrComm Lib (v9.31)... very simple of use and well supported.
The only drawback is that isn't free and open source ... but it's worth it !
It's also thread-safe which is good too :).
Thank you very much everyone for the replies!
You are trying to do async I/O from the main thread. This will never play well with the GUI.
Doing complex async I/O is better suited in a separate thread. I have a blocking serial communication package (I think Synaser also has a blocking mode) and a function like this:
function TransmitReceive(const msg: AnsiString; var reply: AnsiString;
timeOut: Integer): Boolean;
Put the complex code logic inside a thread.execute and trig the start of the logic with an event signal.
Communicate results etc to the main thread through PostMessage calls for example.
This is my first post here - so be gentle :-)
I want to build a client/server application that uses datasnap for data transport.
This is a fairly simple task - and there are lots of examples to learn from.
BUT - Having a Datasnap server (build from Delphi XE wizard) I find myself running into a problem, and I hope someone can guide me into the right direction.
Server and Client run on same PC (that is the design for now).
Server is running Session lifecycle.
Server and Client shares a class (posted below)..
The Server provides a simple method - GetServerObject which uses the GetNewObject method.
The Server itself is a VCL application - main form is fmServer.
OnCreate instatiates the Servers FormObject property (FormObject := TMyDataObject.Create);
function TServerMethods2.GetNewObject: TMyDataObject;
begin
Result := TMyDataObject.Create;
end;
function TServerMethods2.GetServerObject: TMyDataObject;
begin
Result := GetNewObject;
if not Result.Assign(fmServer.FormObject) then
raise Exception.Create('Server error : Assign failed!');
end;
All this is pretty trivial - and my problem only appears if I twist my Client application into a multithreaded monster :-) (read - more than 1 thread).
So here is the Thread code for the client.
TDataThread = class(TThread)
private
DSConn: TSQLConnection;
protected
procedure Execute; override;
public
constructor Create(aConn: TSQLConnection); overload;
end;
constructor TDataThread.Create(aConn: TSQLConnection);
begin
inherited Create(False);
DSConn := aConn.CloneConnection;
FreeOnTerminate := true;
end;
procedure TDataThread.Execute;
var
DSMethod: TServerMethods2Client;
aDataObject : TMyDataObject;
begin
NameThreadForDebugging('Data');
{ Place thread code here }
DSMethod := nil;
try
while not terminated do
begin
sleep(10);
if DSConn.Connected then
begin
try
if DSMethod = nil then
DSMethod := TServerMethods2Client.Create(DSConn.DBXConnection,false);
if DSMethod <> nil then
try
aDataObject := DSMethod.GetserverObject;
finally
freeandnil(aDataObject);
end;
except
freeandnil(DSMethod);
DSConn.Connected := False;
end
end
else
begin
// connect
try
sleep(100);
DSConn.Open;
except
;
end;
end;
end;
finally
freeandnil(DSMethod);
DSConn.Close;
freeandnil(DSConn);
end;
When I create more than 1 of these threads - eventually I will get an error (being "cannot instatiate ... " or some "remote dbx error ..." .. and so on.
I simply cannot get this to work - so that I can spawn hundreds of threads/connections to a datasnap server.
I know this question is tricky - but my hope is that someone is smarter than me :-)
If I try the same client thread code - but accessing a more simple server method (lets say echostring from sample) then I can run it with hundreds of threads.
Perhaps Im answering myself here - but Im too blind to realize it :-)
unit uDataObject;
interface
uses
SysUtils;
Type
TMyDataObject = class(TObject)
private
fString: String;
fInteger: Integer;
public
constructor Create; virtual;
destructor Destroy; override;
function Assign(aSource: TMyDataObject): boolean;
property aString: String read fString write fString;
property aInteger: Integer read fInteger write fInteger;
end;
implementation
{ TMyDataObject }
function TMyDataObject.Assign(aSource: TMyDataObject): boolean;
begin
if aSource <> nil then
begin
try
fString := aSource.aString;
fInteger := aSource.aInteger;
Result := True;
except
Result := false;
end;
end
else
Result := false;
end;
constructor TMyDataObject.Create;
begin
inherited;
Randomize;
fString := 'The time of creation is : ' + FormatDateTime('ddmmyyyy hh:nn:ss:zzz', Now);
fInteger := Random(100);
end;
destructor TMyDataObject.Destroy;
begin
inherited;
end;
end.
All help is appreciated
This has mostly been answered in the comments and the bug report, but... The problem you are seeing is caused by a multithreading issue in XE's marshaller code. If two threads (or two clients) call a server server method which takes in or return user defined types (any type which will use the marshaller/unmarshaller) at the same time, then an exception could happen.
I am unaware of a perfect workaround for XE, but if it is possible to not use user-defined types, then you shouldn't see multithreading issues.
Mat
When the simple server method is working, i think your problem has to be found i somethin the "real" code is doing or using.
It could be in the connection (try changing your simpler code to use the connection)
Your problem can also be then CloneConnection. The Cloned connection is freed, when the connection it is cloned from is freed. See
http://docwiki.embarcadero.com/VCL/en/SqlExpr.TSQLConnection.CloneConnection