+ Added ssockets examples

fcl/tests/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v0.99.13 [2000/02/14]
+# Makefile generated by fpcmake v0.99.13 [2000/02/08]
 #
 
 defaultrule: all
@@ -185,6 +185,9 @@ endif
 # Targets
 
 override EXEOBJECTS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testcgi tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testproc
+ifeq ($(OS_TARGET),linux)
+override EXEOBJECTS+=sockcli isockcli dsockcli socksvr isocksvr dsocksvr
+endif
 ifeq ($(OS_TARGET),win32)
 override EXEOBJECTS+=showver
 endif
@@ -793,16 +796,6 @@ override FPCOPT+=-Xs -OG2p3 -n
 endif
 endif
 
-# Strip
-ifdef STRIP
-override FPCOPT+=-Xs
-endif
-
-# Optimizer
-ifdef OPTIMIZE
-override FPCOPT+=-OG2p3
-endif
-
 # Verbose settings (warning,note,info)
 ifdef VERBOSE
 override FPCOPT+=-vwni

fcl/tests/Makefile.fpc

@@ -8,6 +8,7 @@ programs=stringl dparser fstream mstream list threads testrtf \
          b64test b64test2 b64enc b64dec restest testz testz2 \
          istream doecho testproc
 programs_win32=showver
+programs_linux=sockcli isockcli dsockcli socksvr isocksvr dsocksvr
 
 rst=restest
 

fcl/tests/README

@@ -37,3 +37,9 @@ restest.pp   test program for resourcestrings with GNU gettext. (MVC)
 istream.pp   testprogram for input/output streams.
 testproc.pp  testprogram for TProcess object. Needs doecho to be compiled
              also.
+socksvr.pp   Unix socket server application. Tests TUnixServer in ssockets.
+isocksvr.pp   Inet socket server application. Tests TInetServer in ssockets.
+dsocksvr.pp   Unix socket server application. Tests ssockets.
+sockcli.pp   Unix socket client application. Tests TUnixStream in ssockets.
+isockcli.pp   Inet socket server application. Tests TInetStream in ssockets.
+dsockcli.pp   Dual socket server application. Tests ssockets.

fcl/tests/dsockcli.pp

@@ -0,0 +1,50 @@
+Program Client;
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  Dual socket client program. Before running this, run either
+  'isocksvr', 'dsocksvr' or 'dsocksvr -i' in another terminal 
+  or in the  background.
+  
+  Make sure you run this with the same protocol as the server.
+}
+
+uses ssockets;
+   
+Const 
+  TheSocket = 'ServerSoc';
+  TheHost = 'localhost';   
+  ThePort = 4100;
+        
+var 
+  Stream : TSocketStream;
+  S : String;
+  i : longint;
+  
+begin
+  S:='This is a textstring sent by the client'#10;
+  If (ParamCount=1) and (paramstr(1)='-i') then
+    Stream:=TInetSocket.Create(TheHost,ThePort)
+  else
+    Stream:=TUnixSocket.Create(TheSocket);
+  With Stream do
+    begin
+    For I:=1 to 10 do
+      Write(S[1],Length(S));      
+    S:='QUIT'#10;  
+    Write(S[1],Length(S));
+    Free;  
+    end;
+end.

fcl/tests/dsocksvr.pp

@@ -0,0 +1,106 @@
+Program server;
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  Dual server program. This will listen on port 4100 till 
+  a client connects if '-i' is on the command-line. 
+  Otherwise it will open a unix socket. You can connect by 
+  running the 'sockcli' or 'dsockcli' programs in another 
+  terminal.
+} 
+
+uses ssockets;
+
+const
+  ThePort=4100;
+  TheSocket = 'ServerSoc';
+  
+Type
+  TServerApp = Class(TObject)
+  Private 
+    FServer : TSocketServer;
+  Public
+    Constructor Create(Port : longint);
+    Constructor Create(Socket : String);
+    Destructor Destroy;override;
+    Procedure OnConnect (Sender : TObject; Data : TSocketStream);
+    Procedure Run;
+  end;
+    
+Constructor TServerApp.Create(Port : longint);
+
+begin
+  FServer:=TINetServer.Create(Port);  
+  FServer.OnConnect:=@OnConnect;
+end;
+
+Constructor TServerApp.Create(Socket : String);
+
+begin
+  FServer:=TUnixServer.Create(Socket);  
+  FServer.OnConnect:=@OnConnect;
+end;
+
+Destructor TServerApp.Destroy;
+
+begin
+  FServer.Free;
+end;
+
+Procedure TServerApp.OnConnect (Sender : TObject; Data : TSocketStream);
+
+
+Var Buf : ShortString;
+    Count : longint;
+    
+begin
+  Repeat 
+    Count:=Data.Read(Buf[1],255);
+    SetLength(Buf,Count);
+    Write('Server got : ',Buf);
+  Until (Count=0) or (Pos('QUIT',Buf)<>0);    
+  Data.Free;
+  FServer.StopAccepting;
+end;
+
+Procedure TServerApp.Run;
+
+begin
+  Write ('Listening on ');
+  if FServer is TUnixServer Then
+    Writeln ('socket : ',(FServer as TUnixServer).Filename)
+  else If FServer is TINetServer Then
+    Writeln ('port : ',(FServer as TInetServer).port);
+  FServer.StartAccepting;
+end;
+      
+Var 
+  Application : TServerApp;
+  
+begin
+  If (ParamCount=1) and (paramstr(1)='-i') then
+    Application:=TServerApp.Create(ThePort)
+  else
+    Application:=TServerApp.Create(TheSocket);  
+  Application.Run;
+  Application.Free;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-03-22 20:21:18  michael
+  + Added ssockets examples
+
+}

fcl/tests/isockcli.pp

@@ -0,0 +1,49 @@
+Program Client;
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  TInetSocket client program. Before running this, run either
+  'isocksvr' or 'dsocksvr -i' in another terminal or in the 
+  background.
+}
+
+uses ssockets;
+   
+Const 
+  TheHost = 'localhost';   
+  ThePort = 4100;
+        
+var 
+  S : String;
+  i : longint;
+  
+begin
+  S:='This is a textstring sent by the client'#10;
+  With TInetSocket.Create(TheHost,ThePort) do
+    begin
+    For I:=1 to 10 do
+      Write(S[1],Length(S));      
+    S:='QUIT'#10;  
+    Write(S[1],Length(S));
+    Free;  
+    end;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-03-22 20:21:18  michael
+  + Added ssockets examples
+
+}

fcl/tests/isocksvr.pp

@@ -0,0 +1,87 @@
+Program server;
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  TInetServer server program. This will listen on port 4100 till 
+  a client connects. You can connect by running the 'isockcli' or 
+  'dsockcli -i' programs in another terminal.
+} 
+
+uses ssockets;
+
+const
+  ThePort=4100;
+
+Type
+  TINetServerApp = Class(TObject)
+  Private 
+    FServer : TInetServer;
+  Public
+    Constructor Create(Port : longint);
+    Destructor Destroy;override;
+    Procedure OnConnect (Sender : TObject; Data : TSocketStream);
+    Procedure Run;
+  end;
+    
+Constructor TInetServerApp.Create(Port : longint);
+
+begin
+  FServer:=TINetServer.Create(Port);  
+  FServer.OnConnect:=@OnConnect;
+end;
+
+Destructor TInetServerApp.Destroy;
+
+begin
+  FServer.Free;
+end;
+
+Procedure TInetServerApp.OnConnect (Sender : TObject; Data : TSocketStream);
+
+
+Var Buf : ShortString;
+    Count : longint;
+    
+begin
+  Repeat 
+    Count:=Data.Read(Buf[1],255);
+    SetLength(Buf,Count);
+    Write('Server got : ',Buf);
+  Until (Count=0) or (Pos('QUIT',Buf)<>0);    
+  Data.Free;
+  FServer.StopAccepting;
+end;
+
+Procedure TInetServerApp.Run;
+
+begin
+  FServer.StartAccepting;
+end;
+      
+Var 
+  Application : TInetServerApp;
+  
+begin
+  Application:=TInetServerApp.Create(ThePort);
+  Application.Run;
+  Application.Free;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-03-22 20:21:18  michael
+  + Added ssockets examples
+
+}

fcl/tests/sockcli.pp

@@ -0,0 +1,45 @@
+Program Client;
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  TUnixSocket client program. Before running this, run either
+  'socksvr', or 'dsocksvr' in another terminal 
+  or in the  background.
+}
+
+uses ssockets;
+        
+var 
+  S : String;
+  i : longint;
+  
+begin
+  S:='This is a textstring sent by the client'#10;
+  With TUnixSocket.Create('ServerSoc') do
+    begin
+    For I:=1 to 10 do
+      Write(S[1],Length(S));      
+    S:='QUIT'#10;  
+    Write(S[1],Length(S));
+    Free;  
+    end;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-03-22 20:21:18  michael
+  + Added ssockets examples
+ 
+}

fcl/tests/socksvr.pp

@@ -0,0 +1,87 @@
+Program server;
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  TUnixServerApp server program. This will listen on a socket till 
+  a client connects. You can connect by running the 'dsockcli' or 
+  'sockcli' programs in another terminal.
+} 
+
+uses ssockets;
+
+const
+  SPath='ServerSoc';
+
+Type
+  TUnixServerApp = Class(TObject)
+  Private 
+    FServer : TUnixServer;
+  Public
+    Constructor Create(SockName : String);
+    Destructor Destroy;override;
+    Procedure OnConnect (Sender : TObject; Data : TSocketStream);
+    Procedure Run;
+  end;
+    
+Constructor TUnixServerApp.Create(SockName : String);
+
+begin
+  FServer:=TUnixServer.Create(SockName);  
+  FServer.OnConnect:=@OnConnect;
+end;
+
+Destructor TUNixServerApp.Destroy;
+
+begin
+  FServer.Free;
+end;
+
+Procedure TUnixServerApp.OnConnect (Sender : TObject; Data : TSocketStream);
+
+
+Var Buf : ShortString;
+    Count : longint;
+    
+begin
+  Repeat 
+    Count:=Data.Read(Buf[1],255);
+    SetLength(Buf,Count);
+    Write('Server got : ',Buf);
+  Until (Count=0) or (Pos('QUIT',Buf)<>0);    
+  Data.Free;
+  FServer.StopAccepting;
+end;
+
+Procedure TUnixServerApp.Run;
+
+begin
+  FServer.StartAccepting;
+end;
+      
+Var 
+  Application : TUnixServerApp;
+  
+begin
+  Application:=TUnixServerApp.Create(SPath);
+  Application.Run;
+  Application.Free;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-03-22 20:21:18  michael
+  + Added ssockets examples
+
+}