How to receive a 100-byte-string with following conditions using TIdTcpClient ?:
If nothing comes in, the Read call shall be blocking and thread will wait eternally
If 100 bytes were received the Read call should return the byte string
If more than 0 bytes, but less than 100 were received, Read call should return after some timeout (say 1 second) in order to return at least something in a reasonable time, without producing timeout exception, because exception handling in Delphi IDE's debug mode hasn't been made convenient.
My not optimal code for now is as follows:
unit Unit2;
interface
uses
System.Classes, IdTCPClient;
type
TTcpReceiver = class(TThread)
private
_tcpc: TIdTCPClient;
_onReceive: TGetStrProc;
_buffer: AnsiString;
procedure _receiveLoop();
procedure _postBuffer;
protected
procedure Execute(); override;
public
constructor Create(); reintroduce;
destructor Destroy(); override;
property OnReceive: TGetStrProc read _onReceive write _onReceive;
end;
implementation
uses
System.SysUtils, Vcl.Dialogs, IdGlobal, IdExceptionCore;
constructor TTcpReceiver.Create();
begin
inherited Create(True);
_buffer := '';
_tcpc := TIdTCPClient.Create(nil);
//_tcpc.Host := '192.168.52.175';
_tcpc.Host := '127.0.0.1';
_tcpc.Port := 1;
_tcpc.ReadTimeout := 1000;
_tcpc.Connect();
Suspended := False;
end;
destructor TTcpReceiver.Destroy();
begin
_tcpc.Disconnect();
FreeAndNil(_tcpc);
inherited;
end;
procedure TTcpReceiver.Execute;
begin
_receiveLoop();
end;
procedure TTcpReceiver._postBuffer();
var buf: string;
begin
if _buffer = '' then Exit;
buf := _buffer;
_buffer := '';
if Assigned(_onReceive) then begin
Synchronize(
procedure()
begin
_onReceive(buf);
end
);
end;
end;
procedure TTcpReceiver._receiveLoop();
var
c: AnsiChar;
begin
while not Terminated do begin
try
c := AnsiChar(_tcpc.IOHandler.ReadByte());
_buffer := _buffer + c;
if Length(_buffer) > 100 then
_postBuffer();
except
//Here I have to ignore EIdReadTimeout in Delphi IDE everywhere, but I want just to ignore them here
on ex: EIdReadTimeout do _postBuffer();
end;
end;
end;
end.
TCP is stream oriented, not message oriented like UDP is. Reading arbitrary bytes without any structure to them is bad design, and will easily corrupt your communications if you stop reading prematurely and then the bytes you wanted to read arrive after you have stopped reading. The bytes are not removed from the socket until they are read, so the next read may have more/different bytes than expected.
If you are expecting 100 bytes, then just read 100 bytes and be done with it. If the sender only sends 50 bytes, it needs to tell you that ahead of time so you can stop reading after 50 bytes are received. If the sender is not doing that, then this is a very poorly designed protocol. Using a timeout to detect end-of-transmission in general is bad design. Network lag could easily cause false detections.
TCP messages should be adequately framed so that the receiver knows exactly where one message ends and the next message begins. There are three ways to do that in TCP:
use fixed-length messages. The receiver can keep reading until the expected number of bytes has arrived.
send a message's length before sending the message itself. The receiver can read the length first and then keep reading until the specified number of bytes has arrived.
terminate a message with a unique delimiter that does not appear in the message data. The receiver can keep reading bytes until that delimiter has arrived.
That being said, what you are asking for can be done in TCP (but shouldn't be done in TCP!). And it can be done without using a manual buffer at all, use Indy's built-in buffer instead. For example:
unit Unit2;
interface
uses
System.Classes, IdTCPClient;
type
TTcpReceiver = class(TThread)
private
_tcpc: TIdTCPClient;
_onReceive: TGetStrProc;
procedure _receiveLoop;
procedure _postBuffer;
protected
procedure Execute; override;
public
constructor Create; reintroduce;
destructor Destroy; override;
property OnReceive: TGetStrProc read _onReceive write _onReceive;
end;
implementation
uses
System.SysUtils, Vcl.Dialogs, IdGlobal;
constructor TTcpReceiver.Create;
begin
inherited Create(False);
_tcpc := TIdTCPClient.Create(nil);
//_tcpc.Host := '192.168.52.175';
_tcpc.Host := '127.0.0.1';
_tcpc.Port := 1;
end;
destructor TTcpReceiver.Destroy;
begin
_tcpc.Free;
inherited;
end;
procedure TTcpReceiver.Execute;
begin
_tcpc.Connect;
try
_receiveLoop;
finally
_tcpc.Disconnect;
end;
end;
procedure TTcpReceiver._postBuffer;
var
buf: string;
begin
with _tcpc.IOHandler do
buf := ReadString(IndyMin(InputBuffer.Size, 100));
{ alternatively:
with _tcpc.IOHandler.InputBuffer do
buf := ExtractToString(IndyMin(Size, 100));
}
if buf = '' then Exit;
if Assigned(_onReceive) then
begin
Synchronize(
procedure
begin
if Assigned(_onReceive) then
_onReceive(buf);
end
);
end;
end;
procedure TTcpReceiver._receiveLoop;
var
LBytesRecvd: Boolean;
begin
while not Terminated do
begin
while _tcpc.IOHandler.InputBufferIsEmpty do
begin
_tcpc.IOHandler.CheckForDataOnSource(IdTimeoutInfinite);
_tcpc.IOHandler.CheckForDisconnect;
end;
while _tcpc.IOHandler.InputBuffer.Size < 100 do
begin
// 1 sec is a very short timeout to use for TCP.
// Consider using a larger timeout...
LBytesRecvd := _tcpc.IOHandler.CheckForDataOnSource(1000);
_tcpc.IOHandler.CheckForDisconnect;
if not LBytesRecvd then Break;
end;
_postBuffer;
end;
end;
end.
On a side note, your statement that "exception handling in Delphi IDE's debug mode hasn't been made convenient" is simply ridiculous. Indy's IOHandler has properties and method parameters for controlling exception behavior, and also if you don't like the way the debugger handles exceptions then simply configure it to ignore them. You can configure the debugger to ignore specific exception types, or you can use breakpoints to tell the debugger to skip handling exceptions in specific blocks of code.
There's an overloaded version of the Execute function of the TDBXCallback calls in Data.DBXJSon that looks like this
function Execute(Arg: TObject): TObject; overload; virtual; abstract;
Which in my Datasnap client, I've implemented like this:
type
ServerChannelCallBack = class(TDBXCallback)
public
function Execute(const Arg: TJSONValue): TJSONValue; overload; override; // this works!
function Execute(Arg: TObject): TObject; overload; override; // this doesn't
end;
function ServerChannelCallBack.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
Result := TObject.Create; // is this correct?
try
if Arg is TStringList then
begin
FormClient.QueueLogMsg('ServerChannel', 'Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
FormClient.QueueLogMsg('ServerChannel', TStringList(Arg)[i]);
end;
finally
end;
end;
This is called from the Datasnap server like this:
procedure TFormServer.Button2Click(Sender: TObject);
var
sr: TStringList;
begin
sr := TStringList.Create;
try
sr.Add('one');
sr.Add('two');
ServerContainer2.DSServer1.BroadcastObject('SERVERCHANNEL', sr);
finally
// sr
end;
end;
This is following on from an example in the video presented by Matt DeLong
Heavyweight Callbacks with DataSnap - Part 1: Thick Client
The callback works perfectly, but only exactly once! On the second call from the server (Button2Click), I get an AV in the client. It might be a bug in the DBX code. I don't know. I can't trace in there. Or perhaps I have initialized the Result from the ServerChannelCallBack.Execute incorrectly. Any assistance is appreciated.
UPDATE
The callback is registered on the client like this:
TFormClient = class(TForm)
CMServerChannel: TDSClientCallbackChannelManager;
...
private
ServerChannelCBID: string;
...
procedure TFormClient.FormCreate(Sender: TObject);
begin
ServerChannelCBID := DateTimeToStr(now);
CMServerChannel.RegisterCallback(
ServerChannelCBID,
ServerChannelCallback.Create
);
...
I'm basing this answer on the DataSnap Server + Client projects which can be downloaded from inside Delphi Seattle using `File | Open from version control'
https://radstudiodemos.svn.sourceforge.net/svnroot/radstudiodemos/branches/RadStudio_XE/Delphi/DataSnap/CallbackChannels
that's mentioned here: http://edn.embarcadero.com/article/41374.
The forms in both the server and client require a slight correction to get them to compile, name to add JSon to their Uses list.
On the server form, I've added the following:
procedure TForm3.Button1Click(Sender: TObject);
var
sr: TStringList;
begin
Inc(CallbackCount); // A form variable
sr := TStringList.Create;
try
sr.Add('Callback: ' + IntToStr(CallbackCount));
sr.Add('two');
ServerContainer1.DSServer1.BroadcastObject('ChannelOne', sr);
finally
// No need for sr.free
end;
end;
(I'm using ChannelOne for consistency with the client)
and on the client I have:
function TCallbackClient.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
// Result := TObject.Create; // is this correct?
Result := TJSONTrue.Create;
try
if Arg is TStringList then
begin
QueueLogValue('Server: Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
QueueLogValue('Server:' + TStringList(Arg)[i]);
end;
finally
end;
end;
With those variations from the code you've shown in your q, the server and client run fine, and I can click the server button as many times as I like and neither the server nor any of the clients get "stuck". So I think your problem must be specific to something in the code you are using, but at least the linked project gives you something to work from and compare with.
Btw, I changed the TCallbackClient.Execute return type to TJSONTrue.Create (same as the other override) because that's what it says in Marco Cantu's Delphi 2010 Handbook says it should return, admittedly in the context of a "lightweight" callback while a ServerMethod is executing: returning TJSONFalse tells the server to cancel the executing ServerMethod. However, the callbacks from the server work equally well with the TObject.Create you used.
Im writing an Indy chat app, and am wondering if there is a way for the server component to tell the client that there is a string waiting, or even a way for the client to have an "OnExecute" like event.
This is what i have now:
server:
procedure TServer.ServerExecute(AContext: TIdContext);
var
sResponse: string;
I: Integer;
list: Tlist;
begin
List := Server.Contexts.LockList;
sResponse:= AContext.Connection.Socket.ReadLn;
try
for I := 0 to List.Count-1 do
begin
try
TIdContext(List[I]).Connection.IOHandler.WriteLn(sResponse);
except
end;
end;
finally
Server.Contexts.UnlockList;
end;
end;
Client:
procedure TForm1.Button1Click(Sender: TObject);
var
sMsg : string;
begin
Client.Socket.WriteLn(edit1.Text);
sMsg := Client.Socket.ReadLn;
Memo1.Lines.Add(sMsg);
end;
The problem is when i have 2 or more clients running the messages keep stacking because the button only processes 1 message a time. I'd like a way for the client to wait for messages and when it is triggered it processes those messages, like it does now under the button procedure. I've tried to put the "readln" part under a timer, but that causes some major problems.
Im Using Delphi 2010 and Indy 10
procedure TForm1.Timer1Timer(Sender: TObject);
var
sMsg : string;
begin
IdIOHandlerStack1.CheckForDataOnSource(0);
sMsg := IdIOHandlerStack1.InputBuffer.AsString;
if not (sMsg = '') then
begin
Memo1.Lines.Add(IdIOHandlerStack1.InputBuffer.AsString);
IdIOHandlerStack1.InputBuffer.Clear;
end;
end;
I am writing an application which should draw a circle in place where user clicks a mouse. To achieve that i am hooking the mouse globally using SetWindowHookEx(WH_MOUSE,...)
The hooking, and the procedure that processes mouse action is in DLL. The procedure posts a registered message when it finds that mouse button was clicked using PostMessage(FindWindow('TMyWindow',nil), MyMessage, 0,0);
My application with TMyWindow form processes the messages in WndProc procedure. I check whether the message that came is the same as my registered one and only then draw the circle. After drawing the circle i create a timer, which should free the image after 500ms.
So everything seems to work just fine until i actually click on any part of my application form (for example click on still existing circle that was drawn not long ago). When i do that, form starts receiving my registered messages infinitely ans of course circle drawing procedure gets called every time.
I dont understand why is it doing so. Why is it working fine when i click somewhere off my application form but hangs when i click inside my form?
Let me know if you need more details.
Thanks
EDIT 1:
Main unit. $202 message is WM_LBUTTONUP.
unit main;
interface
uses
HookCommon,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, AppEvnts;
type
TTimer2 = class(TTimer)
private
FShape: TShape;
public
destructor Destroy; override;
property Shape: TShape read FShape write FShape;
end;
type
TShowMouseClick = class(TForm)
timerCountTimer: TTimer;
tray: TTrayIcon;
popMenu: TPopupMenu;
mnuExit: TMenuItem;
mnuActive: TMenuItem;
N1: TMenuItem;
mnuSettings: TMenuItem;
timersStx: TStaticText;
procedure timerCountTimerTimer(Sender: TObject);
procedure mnuExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
timerList: TList;
procedure shape();
procedure freeInactive(var Msg: TMessage); message WM_USER + 1545;
public
shapeColor: Tcolor;
procedure TimerExecute(Sender: TObject);
protected
procedure WndProc(var Message: TMessage); override;
{ Public declarations }
end;
var
ShowMouseClick: TShowMouseClick;
implementation
{$R *.dfm}
uses settings;
{$REGION 'Hide from TaskBar'}
procedure TShowMouseClick.FormActivate(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TShowMouseClick.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
{$ENDREGION}
procedure TShowMouseClick.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
if (Message.Msg = HookCommon.MouseHookMessage) and
(Message.WParam = $202) then
shape;
end;
procedure TShowMouseClick.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
WindowState := wsMaximized;
mnuActive.Checked := true;
HookCommon.HookMouse;
timerList := TList.Create;
timerList.Clear;
shapeColor := clGreen;
end;
procedure TShowMouseClick.FormDestroy(Sender: TObject);
begin
HookCommon.UnHookMouse;
end;
procedure TShowMouseClick.mnuExitClick(Sender: TObject);
begin
Close;
end;
procedure TShowMouseClick.timerCountTimerTimer(Sender: TObject);
begin
timersStx.Caption := 'Active timers: ' + IntToStr(timerList.Count);
end;
procedure TShowMouseClick.shape;
var
tm: TTimer2;
begin
tm := TTimer2.Create(nil);
tm.Tag := 0 ;
tm.Interval := 1;
tm.OnTimer := TimerExecute;
tm.Shape := nil;
timerList.Add(tm);
timersStx.Caption := 'Active timers: ' + IntToStr(timerList.Count);
tm.Enabled := true;
end;
procedure TShowMouseClick.TimerExecute(Sender: TObject);
var
img: TShape;
snd: TTimer2;
begin
snd := nil;
if Sender is TTimer2 then
snd := TTimer2(Sender);
if snd = nil then Exit;
if snd.Tag = 0 then
begin
snd.Interval := 500;
img := TShape.Create(nil);
img.Parent := ShowMouseClick;
img.Brush.Color := clGreen;
img.Shape := stCircle;
img.Width := 9;
img.Height := 9;
img.Left := Mouse.CursorPos.X-4;
img.Top := Mouse.CursorPos.Y-3;
snd.Tag := 1;
snd.Shape := img;
end else begin
snd.Enabled := false;
PostMessage(ShowMouseClick.Handle,WM_USER + 1545 , 0,0);
Application.ProcessMessages;
end;
end;
procedure TShowMouseClick.freeInactive(var Msg: TMessage);
var
i: integer;
begin
for i := timerList.Count - 1 downto 0 do
if TTimer2(timerList[i]).Enabled = false then
begin
TTimer2(timerList[i]).Free;
timerList.Delete(i);
end;
end;
destructor TTimer2.Destroy;
begin
FreeAndNil(FShape);
inherited;
end;
end.
Common unit.
unit HookCommon;
interface
uses Windows;
var
MouseHookMessage: Cardinal;
procedure HookMouse;
procedure UnHookMouse;
implementation
procedure HookMouse; external 'MouseHook.DLL';
procedure UnHookMouse; external 'MouseHook.DLL';
initialization
MouseHookMessage := RegisterWindowMessage('MouseHookMessage');
end.
DLL code.
library MouseHook;
uses
Forms,
Windows,
Messages,
HookCommon in 'HookCommon.pas';
{$J+}
const
Hook: HHook = 0;
{$J-}
{$R *.res}
function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
notifyTestForm : boolean;
begin
notifyTestForm := false;
if msgID = $202 then
notifyTestForm := true;
if notifyTestForm then
begin
PostMessage(FindWindow('TShowMouseClick', nil), MouseHookMessage, MsgID, 0);
end;
Result := CallNextHookEx(Hook,nCode,MsgID,Data);
end;
procedure HookMouse; stdcall;
begin
if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE,#HookProc,HInstance,0);
end;
procedure UnHookMouse; stdcall;
begin
UnhookWindowsHookEx(Hook);
Hook:=0;
end;
exports
HookMouse, UnHookMouse;
begin
end.
The source of the mouse hook stuff is this
Why is it working fine when i click somewhere off my application form
but hangs when i click inside my form?
You're not posting the message to other windows when you click on them. First you should ask yourself, "what happens if I posted a message in my hook callback to all windows which are posted a WM_LBUTTONUP?".
Replace this line
PostMessage(FindWindow('TShowMouseClick', nil), MouseHookMessage, MsgID, 0);
in your dll code, with this:
PostMessage(PMouseHookStruct(Data).hwnd, MouseHookMessage, MsgID, 0);
It doesn't matter if the other applications would know or not what MouseHookMessage is, they will ignore the message. Launch your application and click the mouse wildly to other windows. Generally nothing will happen. Unless you click in the client area of any Delphi application. You'll instantly freeze it.
The answer to this question lies in both how a VCL message loop runs and how a WH_MOUSE hook works. A quote from MouseProc callback function's documentation.
[..] The system calls this function whenever an application calls the
GetMessage or PeekMessage function and there is a mouse message to be
processed.
Suppose you launch your application and the mouse is hooked, then you hover the mouse on your form and wait till your application calls 'WaitMessage', that it is idle. Now click in the client area to generate mouse messages. What happens is that the OS places messages to your application's main thread's message queue. And what your application does is that to remove and dispatch these messages with PeekMessage. This is where applications differ. The VCL first calls 'PeekMessage' with 'PM_NOREMOVE' passed in 'wRemoveMsg' parameter, while most other applications either removes the message with a call to 'PeekMessage' or do the same by using 'GetMessage'.
Now suppose it is 'WM_LBUTTONUP's turn. Refer to the quote above. As soon as PeekMessage is called, the OS calls the MouseProc callback. The call happens from 'user32.dll', that is, when your hook callback is called the statement following the 'PeekMessage' is not executed yet. Also, remember the VCL loop, the message is still in the queue, it has not been removed. Now, your callback function posts a message to the same message queue and returns. Execution returns to the VCL message loop and VCL again calls 'PeekMessage', this time to remove and dispatch the message, but instead of removing the 'WM_LBUTTONUP', it removes the custom message that you posted. 'WM_LBUTTONUP' remains in the queue. After the custom message is dispatched, since 'WM_LBUTTONUP' is still in the queue, 'PeekMessage' is again called, and again the OS calls the callback so that the callback can post another custom message to be removed instead of the mouse message. This loop effectively freezes the application.
To resolve, either post your message to a different thread that has its own message loop which would in some way synchronize with the main thread, or, I would not especially advice it but, instead of posting the message, send it. As an alternative you can remove the 'WM_LBUTTONUP' message yourself from the queue if one exists:
procedure TShowMouseClick.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
if (Message.Msg = HookCommon.MouseHookMessage) and
(Message.WParam = $202) then begin
if PeekMessage(Msg, Handle, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE) then
DispatchMessage(Msg); // or eat if you don't need it.
..
end;
The disadvantage to this approach is that, the PeekMessage itself, as mentioned above, will cause another custom message to be posted, so you'll be receiving those in pairs.
Either your Mouse click or your MyMessage messages are not removed from the Message Queue (unlikely) or they are somehow echoed back, or your code loops in a recursion.
I would try to remove any code from your TMyWindow.WndProc and replace it with some innocuous code (like an OutputDebugString to see it called in the message area of the IDE) to see if it is still looping or not.
Something like:
with Message do
case Msg of
WM_MyMessage: OutputDebugString('MyMessage received. Drawing a circle');
else
inherited WndProc(Message);
If it's only writing once per click, then the recursion is in your handling of the message (or in the timer handler) to draw/erase the circle.
If it's looping, then your click generates multiple messages or 1 that is spinning forever...
Update:
After giving a look at your code, I'd change the way you deal with the timers.
- Don't create the timer with an interval of 1 for the purpose of creating the shape. You'll be flooding your app with Timer events.
- As soon as you enter the Execute, disable the timer
- Avoid calling Application.ProcessMessages.
- You may have some reasons, but I find this very convoluted when it seems to me that a simple OnMouse event on your form could achieve this easily.
This happens because FindWindow actually sends messages on its own that also wind up in your hook. Specifically, it sends a WM_GETTEXT to get the window's title.
To avoid that, do the FindWindow up front (outside the hook's callback).
I have a Delphi application with a Indy TCPServer and TCPClient. I use the AContext.Bindind.Handle for the identification of each connection (wrong?).
So I have a grid which displayed the connections and I will remove the entry after disconnection:
procedure TfrmMain.serverIndyDisconnect(AContext: TIdContext);
var I:Integer;
begin
for I := 0 to gridClients.RowCount - 1 do
begin
if gridClients.Cells[0, I] = IntToStr(AContext.Binding.Handle) then
begin
gridClients.Rows[I].Delete(I);
end;
end;
WriteLogEntry('Connection closed... (' + AContext.Binding.PeerIP+')');
end;
But in the Disconnect Event, the Handle is already empty (it's ever 401xxxxx, so the last Integer number).
Ideas?
You do not mention which version of Delphi or Indy you are using, but the following holds for D2010 and Indy 10.x.
I've used the "AContext.Data" property for identification of the client. I usually Create an object there and release it when the disconnect event happens.
New OnConnect() code:
procedure TfrmMain.serverIndyConnect(AContext: TIdContext);
begin
AContext.Data := TMyObject.Create(NIL);
// Other Init code goes here, including adding the connection to the grid
end;
Modified OnDisconnect() code below:
procedure TfrmMain.serverIndyDisconnect(AContext: TIdContext);
var I:Integer;
begin
for I := 0 to gridClients.RowCount - 1 do
begin
if gridClients.Cells[0, I] = IntToStr(AContext.Data) then
begin
gridClients.Rows[I].Delete(I);
end;
end;
WriteLogEntry('Connection closed... (' + AContext.Binding.PeerIP+')');
end;