diff --git a/.gitattributes b/.gitattributes index 1d63f958e4..de734a0a2c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1981,6 +1981,8 @@ packages/fcl-base/examples/testcont.pp svneol=native#text/plain packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain packages/fcl-base/examples/testez.pp svneol=native#text/plain packages/fcl-base/examples/testhres.pp svneol=native#text/plain +packages/fcl-base/examples/testipc_client.pp svneol=native#text/plain +packages/fcl-base/examples/testipc_server.pp svneol=native#text/plain packages/fcl-base/examples/testmime.pp svneol=native#text/plain packages/fcl-base/examples/testnres.pp svneol=native#text/plain packages/fcl-base/examples/testol.pp svneol=native#text/plain diff --git a/packages/fcl-base/examples/testipc_client.pp b/packages/fcl-base/examples/testipc_client.pp new file mode 100644 index 0000000000..d045b4b1f5 --- /dev/null +++ b/packages/fcl-base/examples/testipc_client.pp @@ -0,0 +1,97 @@ +program testipc_client; + +{$MODE ObjFPC} +{$H+} + +uses + Classes, SysUtils, AdvancedIPC; + +const + STRINGMESSAGE_WANTS_RESPONSE = 3; + STRINGMESSAGE_NO_RESPONSE = 2; + MESSAGE_STOP = 4; + +var + xClient, xClientNotRunning: TIPCClient; + xStream, xResponseStream: TStringStream; + xRequestID: Integer; + xMsgType: TMessageType; + I: Integer; +begin + xClient := nil; + xClientNotRunning := nil; + xStream := nil; + xResponseStream := nil; + try + xResponseStream := TStringStream.Create('OK'); + + //check connection to to the "hello" server (that has to run) + + xClient := TIPCClient.Create(nil); + xClient.ServerID := 'hello'; + + if not xClient.ServerRunning then + begin + Writeln('ERROR: Server '+xClient.ServerID+' is not running.'); + Writeln('Closing'); + Exit; + end; + + //first send some messages to server that is not running + xClientNotRunning := TIPCClient.Create(nil); + xClientNotRunning.ServerID := 'not_running'; + + if xClientNotRunning.ServerRunning then + begin + Writeln('ERROR: Server '+xClientNotRunning.ServerID+' is running. This test needs that the server doesn''t run.'); + Writeln('Closing'); + Exit; + end; + + for I := 1 to 10 do + begin + FreeAndNil(xStream); + xStream := TStringStream.Create('Message '+IntToStr(I)); + xStream.Position := 0; + xClientNotRunning.PostRequest(STRINGMESSAGE_NO_RESPONSE, xStream); + end; + + FreeAndNil(xClientNotRunning); + + //now send messages to the "hello" server + FreeAndNil(xStream); + xStream := TStringStream.Create('I want some response.'); + xStream.Position := 0; + if xClient.SendRequest(STRINGMESSAGE_WANTS_RESPONSE, xStream, 100, xRequestID) and + xClient.PeekResponse(xResponseStream, xMsgType, 100) + then + Writeln('Request-response test OK.') + else + Writeln('ERROR: Request-response test failed.'); + + FreeAndNil(xStream); + xStream := TStringStream.Create('I do not want any response.'); + xStream.Position := 0; + if xClient.SendRequest(STRINGMESSAGE_NO_RESPONSE, xStream, 100, xRequestID) then + begin + if xClient.PeekResponse(xResponseStream, xMsgType, 100) then + Writeln('ERROR: I received a response even that I didn''t want any. What happened?') + else + Writeln('Request test OK.'); + end else + Writeln('ERROR: Request test failed.'); + + if xClient.SendRequest(MESSAGE_STOP, nil, 100) and + not xClient.ServerRunning + then + Writeln('Server was sucessfully stopped.') + else + Writeln('ERROR: I could not stop the server.') + finally + xClient.Free; + xClientNotRunning.Free; + xStream.Free; + xResponseStream.Free; + end; +end. + diff --git a/packages/fcl-base/examples/testipc_server.pp b/packages/fcl-base/examples/testipc_server.pp new file mode 100644 index 0000000000..17746e0895 --- /dev/null +++ b/packages/fcl-base/examples/testipc_server.pp @@ -0,0 +1,105 @@ +program testipc_server; + +{$MODE ObjFPC} +{$H+} + +uses + Classes, SysUtils, AdvancedIPC; + +const + STRINGMESSAGE_WANTS_RESPONSE = 3; + STRINGMESSAGE_NO_RESPONSE = 2; + MESSAGE_STOP = 4; + +var + xServer: TIPCServer; + xStream, xResponseStream: TStringStream; + xMsgID: Integer; + xMsgType: TMessageType; + xNotRunningMessagesCount: Integer; +begin + xServer := nil; + xStream := nil; + xResponseStream := nil; + try + xStream := TStringStream.Create(''); + xResponseStream := TStringStream.Create('OK'); + + //first get all messages from the hello server + xServer := TIPCServer.Create(nil); + xServer.ServerID := 'hello'; + xServer.StartServer; + + WriteLn('Server ', xServer.ServerID, ' started.'); + WriteLn('-----'); + + while True do + begin + if xServer.PeekRequest(xMsgID{%H-}, xMsgType{%H-}) then + begin + case xMsgType of + STRINGMESSAGE_WANTS_RESPONSE, STRINGMESSAGE_NO_RESPONSE: + begin + xServer.ReadRequest(xMsgID, xStream); + WriteLn('Received string message:'); + WriteLn(xStream.DataString); + if xMsgType = STRINGMESSAGE_WANTS_RESPONSE then + begin + xResponseStream.Position := 0; + xServer.PostResponse(xMsgID, STRINGMESSAGE_NO_RESPONSE, xResponseStream); + WriteLn('Posting response.'); + end; + WriteLn('-----'); + end; + MESSAGE_STOP: + begin + WriteLn('Stopping '+xServer.ServerID+' server.'); + WriteLn('-----'); + Break; + end; + end; + end else + Sleep(50); + end; + + FreeAndNil(xServer); + + //now try to get all unhandled messages from the not_running server + //please see that the messages are not peeked in the order they have been posted (this is correct/designed behavior). + xServer := TIPCServer.Create(nil); + xServer.ServerID := 'not_running'; + xServer.StartServer(False); + + WriteLn(''); + WriteLn('Server ', xServer.ServerID, ' started.'); + WriteLn('-----'); + + xNotRunningMessagesCount := 0; + while xServer.PeekRequest(xStream, xMsgID, xMsgType) do + begin + if xMsgType = STRINGMESSAGE_NO_RESPONSE then + begin + WriteLn('Received message: ', xStream.DataString); + Inc(xNotRunningMessagesCount); + end else + WriteLn('ERROR: Wrong message type: ', xMsgType); + + WriteLn('-----'); + end; + + if xNotRunningMessagesCount <> 10 then + begin + WriteLn('ERROR: Wrong message count: ', xNotRunningMessagesCount); + WriteLn('-----'); + end; + + WriteLn('Stopping '+xServer.ServerID+' server.'); + WriteLn('-----'); + FreeAndNil(xServer); + finally + xServer.Free; + xStream.Free; + xResponseStream.Free; + end; +end. +