Browse Source

+ Added nonblocking option

michael 25 years ago
parent
commit
6dbd3bdb9f
1 changed files with 35 additions and 4 deletions
  1. 35 4
      fcl/tests/dsocksvr.pp

+ 35 - 4
fcl/tests/dsocksvr.pp

@@ -19,23 +19,30 @@ Program server;
   Otherwise it will open a unix socket. You can connect by 
   running the 'sockcli' or 'dsockcli' programs in another 
   terminal.
+  
+  specifying -b on the command-line will disable blocking.
 } 
 
-uses ssockets;
+uses sysutils,ssockets,getopts;
 
 const
   ThePort=4100;
   TheSocket = 'ServerSoc';
+
+Var 
+  DoInet,NonBlocking : boolean;
   
 Type
   TServerApp = Class(TObject)
   Private 
+    FCalls : longint;
     FServer : TSocketServer;
   Public
     Constructor Create(Port : longint);
     Constructor Create(Socket : String);
     Destructor Destroy;override;
     Procedure OnConnect (Sender : TObject; Data : TSocketStream);
+    Procedure OnIdle(Sender : TObject);
     Procedure Run;
   end;
     
@@ -75,6 +82,12 @@ begin
   FServer.StopAccepting;
 end;
 
+Procedure TServerApp.OnIdle(Sender : TObject);
+
+begin
+  Inc(FCalls);
+  Write('.');
+end;
 Procedure TServerApp.Run;
 
 begin
@@ -83,14 +96,29 @@ begin
     Writeln ('socket : ',(FServer as TUnixServer).Filename)
   else If FServer is TINetServer Then
     Writeln ('port : ',(FServer as TInetServer).port);
+  If NonBlocking then
+    begin  
+    FServer.SetNonBlocking;
+    FServer.OnIdle:=@OnIdle;
+    end;
   FServer.StartAccepting;
 end;
       
 Var 
   Application : TServerApp;
-  
+  c : char;
+    
 begin
-  If (ParamCount=1) and (paramstr(1)='-i') then
+  DoInet:=False;
+  NonBlocking:=False;
+  repeat 
+    c:=getopt('ib');
+    case c of
+    'b' : NonBlocking:=True;
+    'i' : DoInet:=True;
+    end;
+  until c=EndOfOptions;  
+  If DoInet then
     Application:=TServerApp.Create(ThePort)
   else
     Application:=TServerApp.Create(TheSocket);  
@@ -100,7 +128,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2000-03-22 20:21:18  michael
+  Revision 1.2  2000-03-26 13:41:36  michael
+  + Added nonblocking option
+
+  Revision 1.1  2000/03/22 20:21:18  michael
   + Added ssockets examples
 
 }