Program server;
{
    $Id: dsocksvr.pp,v 1.1 2000/07/13 06:33:47 michael Exp $
    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.
  
  specifying -b on the command-line will disable blocking.
} 

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;
    
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.OnIdle(Sender : TObject);

begin
  Inc(FCalls);
  Write('.');
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);
  If NonBlocking then
    begin  
    FServer.SetNonBlocking;
    FServer.OnIdle:=@OnIdle;
    end;
  FServer.StartAccepting;
end;
      
Var 
  Application : TServerApp;
  c : char;
    
begin
  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);  
  Application.Run;
  Application.Free;
end.

{
  $Log: dsocksvr.pp,v $
  Revision 1.1  2000/07/13 06:33:47  michael
  + Initial import

  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

}
