I created a stand-alone Datasnap TCP/IP server using the Wizard. I selected sample methods (echostring and reversestring). I saved the server and ran it. Then I created a client application, and using the file-new-other, added a ClientModule to that client project, along with the ClientClasses unit. On the main form. I added a button. On the button's onclick event handler, I added the following code:
procedure TForm1.Button1Click(Sender: TObject);
begin
if ClientModule1.SQLConnection1.Connected then
begin
Button1.Text := 'Open';
ClientModule1.SQLConnection1.Close;
end
else
begin
Button1.Text := 'Close';
// ClientModule1.SQLConnection1.Open;
ClientModule1.ServerMethods1Client.ReverseString('myteststring');
end;
end;
The purpose here is to simulate a situation where the client is logging into and logging out of the server regularly rather than keeping a connection. This is especially important on apps deployed to mobile.
You can see I commented out the Connection.Open, because the first call to the ServerMethods1client opens the connection. The generated code is shown here:
function TClientModule1.GetServerMethods1Client: TServerMethods1Client;
begin
if FServerMethods1Client = nil then
begin
SQLConnection1.Open;
FServerMethods1Client := TServerMethods1Client.Create(SQLConnection1.DBXConnection, FInstanceOwner);
end;
Result := FServerMethods1Client;
end;
Now the problem arises. On first click to the button, the connection is opened, and the method is called. On the second click to the button, the connection is closed.
On the 3rd click, an exception is raised "Operation Failed. Connection was Closed" is raised from with the TDBXCommand code.
As a workaround, I tried this:
procedure TForm1.Button1Click(Sender: TObject);
begin
if ClientModule1.SQLConnection1.Connected then
begin
Button1.Text := 'Open';
ClientModule1.SQLConnection1.Close;
ClientModule1.ServerMethods1Client := nil;
end
else
begin
Button1.Text := 'Close';
// ClientModule1.SQLConnection1.Open;
ClientModule1.ServerMethods1Client.ReverseString('myteststring');
end;
end;
This does sort-of solve the problem, since the ClientModule1's FServerMethods1Client instance is reset so the create code runs again like it did on the first run.
The only other problem now, is (I am using Eurekalog) it creates a memory leak.
What am I doing wrong? What's the right way to connected/disconnect from a Datasnap server repeatedly without restarting the app?
The reason for the first error is that the code that binds the client side proxy (which allows server methods to be called) is tied to the local SQL connection. Note the call to create the proxy class:
FServerMethods1Client := TServerMethods1Client.Create(SQLConnection1.DBXConnection, ...)
The underlying DBExpress connection is passed by reference, and the proxy class uses that connection to call the server. You closed and re-opened the connection, but the underlying DBExpress connection that ServerMethodsClient1 was using has been destroyed. Thus, you receive the "Connection was closed" exception. The connection that ServerMethodsClient1 was using has been closed. You have to recreate ServerMethodsClient1 as you did in your second example.
I can't answer your second question, as I believe it is ARC specific. For a VCL DataSnap app, I would call ServerMethodsClient1.Free rather than setting it to nil. Based on my very, very limited understanding of Delphi's ARC implementation (which is all from the newsgroups), I believe you should call ServerMethodsClient1.DisposeOf, since the class descends from TComponent
But I'm not sure about that. I'm sure someone will jump on here that understands ARC and the proper solution to destroy the object rather than having a memory leak.
In my Android FMX implementation, I only call servermethods to get stuff done. (ie I don't use Datasnap data components). There's too much uncontrolled data transmission overhead to the Datasnap architecture to contemplate anything else realistically on a mobile device... To get around it (and not have memory leaks), I now create local instances of the TServermethods1Client as and when I need them and free them in context:
function TClientModule1.PostTheLog: Boolean;
var
Server: TServerMethods1Client;
begin
Server := TServerMethods1Client.Create(ClientModule1.SQLConnection1.DBXConnection);
try
UserID := Server.GetUserID;
...
finally
Server.Free;
end;
end;
Now the ClientModule1.SQLConnection1 can be connected and disconnected at will (preferably connected just before any call to a servermethod, and disconnected thereafter) and no further issues arise.
Which then begs the question: In which ideal world would the publicly accessible ServerMethods1Client actually be useful?
I have an application (the "server") which updates a block of data in memory - around 100k bytes - every second.
There are 1 to 4 other instances of a "client" application running on other workstations on the same network, and these need to read the same 100k image every second.
This has been implemented up til now by writing the image to a file on the server and having the clients read from that file across the network. This has worked with no problems for many years, but lately (coincident with a move to windows 8-based hardware) it has developed a problem where the file becomes inaccessible to all nodes except one. Exiting the client application running on this node frees up the file and it then becomes accessible again to everyone.
I'm still perplexed as to the the cause of this lockout, but I'm wondering if it may be the mechanism discussed here, where a file isn't closed due to a network glitch. I'm thinking that having the clients request the data over TCP/IP would avoid this.
There doesn't need to be any handshaking other than the clients failing to connect or read data - the server just needs to go about it's business and respond to requests by grabbing the data and sending it. I'm pretty hazy however about the best architecture to achieve this. Are TidTCPClient and TidTCPServer going to cut it? I'm assuming the clients would request the data in a thread, but does this mean the server needs to run a thread continuously to respond to requests?
TIdTCPServer is a multi-threaded component. Its clients run in worker threads that it manages for you. All you have to do is implement the OnExecute event to send your data.
TIdTCPClient is not a multi-threaded component. It runs in whatever thread you use it in. So if you need to read data continuously, best to run your own worker thread to handle the reading. Indy has a TIdThreadComponent component that wraps a thread, or you can write your own TThread code manually.
100K is not a lot of data, so I would suggest simply forgetting the file altogether and allocate a buffer in memory instead. Your TIdTCPServer.OnExecute event handler can read from that buffer whenever needed. And I wouldn't even bother having the clients request data, just have the server continuously push the latest data to active clients.
Try something like this:
server:
var
Buffer: TIdBytes;
Lock: TMREWSync;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
begin
Lock.BeginRead;
try
AContext.Connection.IOHandler.Write(Buffer);
finally
Lock.EndRead;
end;
Sleep(1000);
end;
procedure TForm1.UpdateBuffer;
begin
Lock.BeginWrite;
try
// update the Buffer content as needed...
finally
Lock.EndWrite;
end;
end;
initialization
Lock := TMREWSync.Create;
SetLength(Buffer, 1024 * 100);
finalization
SetLength(Buffer, 0);
Lock.Free;
client:
procedure TForm1.IdThreadComponent1Run(Sender: TIdThreadComponent);
var
Buffer: TIdBytes;
begin
IdTCPClient1.IOHandler.ReadBytes(Buffer, 1024 * 100);
// use Buffer as needed...
end;
procedure TForm1.Connect;
begin
IdTCPClient1.Connect;
try
IdThreadComponent1.Start;
except
IdTCPClient1.Disconnect;
raise;
end;
end;
procedure TForm1.Disconnect;
begin
IdTCPClient1.Disconnect;
IdThreadComponent1.Stop;
end;
I'm again in a situation where I've spend an obscene amount of time on trying to customize datasnap callback samples to my needs.
I'm old school OOP programmer and have several very large Object hierakies in my "toolbox" PODO style :-) .. and having this great datasnap feature, I want to utilize the forces of the callback.
BUT - when I implement it ... it simply fails ... (FASTMM4 reports mem leaks).
Try and create a simple VCL datasnap server - TCP.
And add a button and this source ...
procedure TForm1.Button1Click(Sender: TObject);
var
// AObject : TObject;
aJSONVal : TJSONValue;
begin
// AObject := TObject.Create;
// ServerContainer1.DSServer1.BroadcastObject('SomeChannel','SomeCallbackID', AObject);
// AObject.Free;
aJSONVal := TJSONObject.Create;
ServerContainer1.DSServer1.BroadcastMessage('SomeChannel','SomeCallbackID',aJSONVal);
// aJSONVal.Free; // Mat pointed out that this is done by the broadcast.
end;
It will work - as long as you keep using TJSONValue ...
But try and switch the commented code - and you will see what I mean.
I could of course change all my existing code to JSON ... but that is simply not acceptable.
Does anyone have any idea on how to use the BroadcastOBJECT or NotifyOBJECT ?
Regards
Bjarne
The object which you give to a Notify or Broadcast call is then owned by that call. Therefore do not call "AObject.Free;" or "aJSONVal.Free;". Doing so will often result in an Access Violation or other memory management related problems.
Note also that Broadcasted messages get put in a queue on the server and are later sent, in a different thread. Meaning, when your call to Broadcast returns, it hasn't actually sent the message to all the clients yet.
I hope that helps,
Mat
Possible answer: Your question was vague but based on what you've said, I'd start here:
Delphi XE help: (ms-help://embarcadero.rs_xe/vcl/DSServer.TDSServer.BroadcastObject.html): function BroadcastObject(const ChannelName: String; const CallbackId: String; const Msg: TObject): boolean; overload;
The second overload sends an object to all client callbacks with a given registered callback identifier. For this purpose, an additional CallbackId parameter is required in the call."
You are using the second overload which takes 3 params - are your callback identifiers set up properly?
I haven't programmed in Delphi for a while and frankly didn't think I'll ever have to but...
Here I am, desperately trying to find some information on the matter and it's so scarce nowadays, I can't find anything. So maybe you guys could help me out.
Currently my application uses Synapse library to make HTTP calls, but it doesn't allow for setting a timeout. Usually, that's not a big problem, but now I absolutely must to have a timeout to handle any connectivity issues nicely.
What I'm looking for, is a library (synchronous or not) that will allow making HTTP requests absolutely transparent for the user with no visible or hidden delays. I can't immediately kill a thread right now, and with possibility of many frequent requests to the server that is not responding, it's no good.
EDIT: Thanks everybody for your answers!
You will always have to take delays and timeouts into account when doing network communication. The closest you can get IMHO is to put network communication in a thread. Then you can check if the thread finishes in the desired time and if not just let it finish, but ignore the result (there's no safe way to abort a thread). This has an additional advantage: you can now just use synchronous network calls which are a lot easier to read.
In synapse, the timeout is available from the TSynaClient object, which THttpSend decends from. So all you have to do to adjust for timeout (assuming your using the standard functions) is to copy the function your using, add a new parameter and set the Timeout to what you need. For example:
function HttpGetTextTimeout(const URL: string;
const Response: TStrings;
const Timeout:integer): Boolean;
var
HTTP: THTTPSend;
begin
HTTP := THTTPSend.Create;
try
HTTP.Timeout := Timeout;
Result := HTTP.HTTPMethod('GET', URL);
if Result then
Response.LoadFromStream(HTTP.Document);
finally
HTTP.Free;
end;
end;
Synapse defaults to a timeout of 5000 and does timeout if you wait long enough. Since its tightly contained, synapse runs perfectly fine in threads.
[Known to work on D2010 only]
You can use MSXML to send client requests (add msxml and ole2 to your uses clause). The trick is to use IServerXMLHTTPRequest rather than IXMLHTTPRequest, as the former allows timeouts to be specified. The code below shows the Execute() method of a thread:
procedure TClientSendThread.Execute;
const
LResolveTimeoutMilliseconds = 2000;
LConnectTimeoutMilliseconds = 5000;
LSendTimeoutMilliseconds = 5000;
LReceiveTimeoutMilliseconds = 10000;
var
LHTTPServer: IServerXMLHTTPRequest;
LDataStream: TMemoryStream;
LData: OleVariant;
begin
{Needed because this is inside a thread.}
CoInitialize(nil);
LDataStream := TMemoryStream.Create;
try
{Populate ....LDataStream...}
LData := MemoryStreamToOleVariant(LDataStream);
LHTTPServer := CreateOleObject('MSXML2.ServerXMLHTTP.3.0') as IServerXMLHTTPRequest;
LHTTPServer.setTimeouts(
LResolveTimeoutMilliseconds,
LConnectTimeoutMilliseconds,
LSendTimeoutMilliseconds,
LReceiveTimeoutMilliseconds
);
LHTTPServer.open('POST', URL, False, 0, 0);
LHTTPServer.send(LData);
FAnswer := LHTTPServer.responseText;
finally
FreeAndNil(LDataStream);
CoUninitialize;
end;
end;
I recently discovered an extremely annoying behavior of this MSXML technique in which GET requests will not be re-sent if the URL remains unchanged for subsequent sendings; in other words, the client is caching GET requests. This does not happen with POST.
Obviously, once the timeouts occur, the Execute method completes and the thread is cleaned up.
Synapse can be configured to raise an Exception when network errors occur.
RaiseExcept
Check http://synapse.ararat.cz/doc/help/blcksock.TBlockSocket.html#RaiseExcept:
If True, winsock errors raises
exception. Otherwise is setted
LastError value only and you must
check it from your program! Default
value is False.
There is a problem I am unable to solve. I created two service applications in Delphi and tried to post messages within them. Of course, there are no windows in such applications and PostMessage needs a window handle parameter to send a message.
Therefore, I created a window handle using the AllocateHWnd(MyMethod: TWndMethod) function and passed, as the 'MyMethod' parameter, a procedure I want to be called when a message is received. If it was a windowed application, PostMessage() called using the handle returned by the AllocateHWnd method would certainly send a message that would then be received by the 'MyMethod' procedure.
The situation, however, is different in my service applications. I do not understand why, but in one of them posting messages this way works fine, whereas in the second one it does not (the messages are not received at all). Only when the service is being stopped do I notice that two messages are received by 'MyMethod': WM_DESTROY and WM_NCDESTROY. The messages I send using PostMessage are never received by this procedure. On the other hand, the first service always receives all messages I send.
Could you please give me a clue that would help me find the reason of the second service not receiving my messages? I do not know in what way they can differ. I checked the settings of the services and they seem to be identical. Why then one of them works fine and the second one does not (as far as sending messages is concerned)?
Thanks for any advice.
Mariusz.
Without more information it will be difficult to help you debug this, especially why it works in one service but not in the other. However:
Instead of trying to fix the problem in your code you might want to remove the windows altogether, and use PostThreadMessage() instead of PostMessage(). For the posting of messages to work correctly you need a message loop, but not necessarily receiving windows.
Edit: I'm trying to reply to all your answers in one go.
First - if you want to make your life easy you should really check out OmniThreadLibrary by gabr. I don't know whether it does work in a Windows service application, I don't even know whether that has been tried yet. You could ask in the forum. It has however a lot of great features and is worth looking into, if only for the learning effect.
But of course you can also program this for yourself, and you will have to for Delphi versions prior to Delphi 2007. I will simply add some snippets from our internal library, which has evolved over the years and works in several dozen programs. I don't claim it to be bug-free though. You can compare it with your code, and if anything sticks out, feel free to ask and I'll try to clarify.
This is the simplified Execute() method of the worker thread base class:
procedure TCustomTestThread.Execute;
var
Msg: TMsg;
begin
try
while not Terminated do begin
if (integer(GetMessage(Msg, HWND(0), 0, 0)) = -1) or Terminated then
break;
TranslateMessage(Msg);
DispatchMessage(Msg);
if Msg.Message = WM_USER then begin
// handle differently according to wParam and lParam
// ...
end;
end;
except
on E: Exception do begin
...
end;
end;
end;
It is important to not let exceptions get unhandled, so there is a top-level exception handler around everything. What you do with the exception is your choice and depends on the application, but all exceptions have to be caught, otherwise the application will get terminated. In a service your only option is probably to log them.
There is a special method to initiate thread shutdown, because the thread needs to be woken up when it is inside of GetMessage():
procedure TCustomTestThread.Shutdown;
begin
Terminate;
Cancel; // internal method dealing with worker objects used in thread
DoSendMessage(WM_QUIT);
end;
procedure TCustomTestThread.DoSendMessage(AMessage: Cardinal;
AWParam: integer = 0; ALParam: integer = 0);
begin
PostThreadMessage(ThreadID, AMessage, AWParam, ALParam);
end;
Posting WM_QUIT will cause the message loop to exit. There is however the problem that code in descendant classes could rely on Windows messages being properly handled during shutdown of the thread, especially when COM interfaces are used. That's why instead of a simple WaitFor() the following code is used to free all running threads:
procedure TCustomTestController.BeforeDestruction;
var
i: integer;
ThreadHandle: THandle;
WaitRes: LongWord;
Msg: TMsg;
begin
inherited;
for i := Low(fPositionThreads) to High(fPositionThreads) do begin
if fPositionThreads[i] <> nil then try
ThreadHandle := fPositionThreads[i].Handle;
fPositionThreads[i].Shutdown;
while TRUE do begin
WaitRes := MsgWaitForMultipleObjects(1, ThreadHandle, FALSE, 30000,
QS_POSTMESSAGE or QS_SENDMESSAGE);
if WaitRes = WAIT_OBJECT_0 then begin
FreeAndNil(fPositionThreads[i]);
break;
end;
if WaitRes = WAIT_TIMEOUT then
break;
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
on E: Exception do
// ...
end;
fPositionThreads[i] := nil;
end;
end;
This is in the overridden BeforeDestruction() method because all threads need to be freed before the destructor of the descendant controller class begins to free any objects the threads might use.
I'd suggest you consider using named pipes for IPC. That is what they are designed to do:
Looking for an alternative to windows messages used in inter-process communication
As Mghie mentioned, you need a message processing loop. That's why PeekMessage returns the messages correctly. It's not that the messages aren't there, it's that you aren't processing them. In a standard application, Delphi creates a TApplication class and calls Application.Run. This IS the message processing loop for a normal app. It basically consists of:
repeat
try
HandleMessage;
except
HandleException(Self);
end;
until Terminated;
If you want your service application to handle messages, you'll need to perform the same kind of work.
There's an example of using a service and handling PostThreadMessage dispatches here. Keep in mind, as Mick mentioned, you cannot use message handling between applications of differing security contexts (particularly in Vista). You should use named pipes or similar. Microsoft discusses this here.
Edit:
Based on the code snippet that you posted, you may just be fighting a threading issue. AllocHWnd is not thread safe. See here for a really detailed explanation of the issue and a version that works correctly in threads.
Of course, this still leads us back to why you aren't using PostThreadMessage instead. The way your code sample is structured, it would be trivial to make the message handling a function of the thread and then pass it down into the class for disposition.
Thanks for all your answers. I think we can forget about the problem. I created a new service application and performed quick post message tests. The messages were delivered correctly, so I hope I can now state that normally everything works fine and something is wrong only with this one service I described. I know it is stupid, but I will just try to copy one fragment of code after another from the 'bad' service to a new one. Maybe this will help me find the reason of the problem.
I hope I can now consider the message-waiting loop unnecessary as long as everything works fine without it, can't I?
If it comes to the privileges, Microsoft says: "UAC uses WIM to block Windows messages from being sent between processes of different privilege levels.". My Vista's UAC is off and I did not set any privileges for those services I described. Apart from that I do not send messages between different processes. Messages are sent within one process.
To give you the idea of what I am doing, I'll show you a code snippet from a test service application.
uses ...;
type
TMyThread = class;
TMyClass = class
private
FThread: TMyThread;
procedure ReadMessage(var Msg: TMessage);
public
FHandle: HWND;
constructor Create;
destructor Destroy; override;
end;
TMyThread = class(TThread)
private
FMyClass: TMyClass;
protected
procedure Execute; override;
constructor Create(MyClass: TMyClass); reintroduce;
end;
implementation
{ TMyClass }
constructor TMyClass.Create;
begin
inherited Create;
FHandle := AllocateHWnd(ReadMessage);
FThread := TMyThread.Create(Self);
end;
destructor TMyClass.Destroy;
begin
FThread.Terminate;
FThread.WaitFor;
FThread.Free;
DeallocateHWnd(FHandle);
inherited Destroy;
end;
procedure TMyClass.ReadMessage(var Msg: TMessage);
begin
Log.Log('message read: ' + IntToStr(Msg.Msg));
end;
{ TMyThread }
constructor TMyThread.Create(MyClass: TMyClass);
begin
inherited Create(True);
FMyClass := MyClass;
Resume;
end;
procedure TMyThread.Execute;
begin
while not Terminated do
begin
//do some work and
//send a message when finished
if PostMessage(FMyClass.FHandle, WM_USER, 0, 0) then
Log.Log('message sent')
else
Log.Log('message not sent: ' + SysErrorMessage(GetLastError));
//do something else...
Sleep(1000);
end;
end;
This is only an example, but functioning of my real code bases on the same idea. When you create an object of this class, it will create a thread that will start sending messages to that class. Log.Log() saves data into a text file. When I use this code in a new service application, everything works fine. When i put it into the 'broken' service, it does not. Please note that I do not use any message-waiting loop to receive messages. I created a new service and just put the code above into it, then created an object of the class. That's all.
If I get to know why this does not work in the 'broken' service, I'll write about it.
Thanks for the time you devoted me.
Mariusz.
Here's what I would try:
Check the return value and GetLastError of PostMessage
Is this a Vista/2008 machine? If yes, check if the sending application have sufficient priviliges to do send the message.
I have to have more information to help you further.
I spent long hours trying to find the reason of the messages not being received. As I showed in my code snippet, the constructor of the class creates a window handle which I used to send messages to. As long as the class was constructed by the main thread, everything worked fine for the window handle (if I understand it correctly) existed in the context of the main thread which, by default, awaits messages. In the 'broken' service, as I called it by mistake, my class was created by another thread, so the handle must have existed in the context of that thread. Therefore, when I sent messages using this window handle, they were received by that thread, not by the main one. Because of the fact that this thread did not have any message-waiting loop, my messages were not received at all.
I just did not know it worked this way. To solve the problem in an easy way, I create and destroy the class in the main thread even though I use it in the second one.
Thanks for your time and all the information you gave me.
Mghie, I think you are absolutely right. I implemented a message waiting loop this way:
procedure TAsyncSerialPort.Execute;
var
Msg: tagMSG;
begin
while GetMessage(Msg, 0, 0, 0) do
begin
{thread message}
if Msg.hwnd = 0 then
begin
case Msg.message of
WM_DATA_READ: Log.Log('data read');
WM_READ_TIMEOUT: Log.Log('read timeout');
WM_DATA_WRITTEN: Log.Log('data written');
WM_COMM_ERROR: Log.Log('comm error');
else
DispatchMessage(Msg);
end;
end
else
DispatchMessage(Msg);
end;
end;
I'm doing it for the first time, so please, could you check the code whether it is correct? In fact, this is my real class code snippet (the logs will be substituted with a real code). It handles overlapped comm port. There are two threads that send thread messages to the thread above, informing it that they wrote or received some data from comm port, etc. When the thread gets such a message, it takes an action - it gets the received data from a queue, where the threads first put it and then calls an external method that, lets say, analyses the received data. I don't want to go into details for it is unimportant :). I send thread messages like this: PostThreadMessage(MyThreadId, WM_DATA_READ, 0, 0).
This code works properly as I checked, but I would like to be sure everything is correct, so I'm asking you about that. I would be grateful if you answered.
To free the thread I do the following:
destructor TAsyncSerialPort.Destroy;
begin
{send a quit message to the thread so that GetMessage returns false and the loop ends}
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
{terminate the thread but wait until it finishes before the following objects
(critical sections) are destroyed for the thread might use them before it quits}
Terminate;
if Suspended then
Resume;
WaitFor;
FreeAndNil(FLock);
FreeAndNil(FCallMethodsLock);
inherited Destroy;
end;
I hope this is the proper way to end the message loop.
Thank you very much for your help.
BTW, I hope my English language is understandable, isn't it? :) Sorry if you have difficulties understanding me.
There's one trick in message loops in threads. Windows won't create a message queue for a thread immediately so there will be some time when posting messages to a thread will fail. Details are here. In my msg loop thread I use the technique MS proposes:
constructor TMsgLoopThread.Create;
begin
inherited Create(True);
FEvMsgQueueReady := CreateEvent(nil, True, False, nil);
if FEvMsgQueueReady = 0 then
Error('CreateEvent: '+LastErrMsg);
end;
procedure TMsgLoopThread.Execute;
var
MsgRec: TMsg;
begin
// Call fake PeekMessage for OS to create message queue for the thread.
// When it finishes, signal the event. In the main app execution will wait
// for this event.
PeekMessage(MsgRec, 0, WM_USER, WM_USER, PM_NOREMOVE);
SetEvent(FEvMsgQueueReady);
...
end;
// Start the thread with waitinig for it to get ready
function TMsgLoopThread.Start(WaitInterval: DWORD): DWORD;
begin
inherited Start;
Result := WaitForSingleObject(FEvMsgQueueReady, WaitInterval);
end;
But in your case I'd strongly recommend using other means of IPC.