* example for unit advancedipc by Ondrej Pokorny added

git-svn-id: trunk@31939 -

.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

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.
+

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.
+