
uses
  Crt,
  Objects,
  NumToStr,
  CoBase,
  CoEth01,
  CoIPv4,
  CoTCP,
  CoINET;

var
  ConnCount : Integer;

type

  PTestConn = ^TTestConn;
  TTestConn = object( TObject )
  public
    Next  : PTestConn;
    Ovlp  : TOverlapped;
    Sock  : PCoDevice;
    Port  : Word;
    State : Integer;

    RecvData : array[0..2047] of Byte;
    RecvSize : Word;

    constructor Init( ASock: PCoDevice; APort: Word );
    procedure Tick;
    procedure Log( S: string );
  end;


  PTestConnServer = ^TTestConnServer;
  TTestConnServer = object( TObject )
  public
    Count : Integer;
    List  : PTestConn;
    Ovlp  : TOverlapped;
    Sock  : PCoDevice;
    State : Integer;
    Port  : Word;

    ClSock : PCoDevice;
    ClAddr : TTcpAddress;

    function  NewConn( ASock: PCoDevice; APort: Word ): PTestConn;
    procedure InsertConn( AConn: PTestConn );
    procedure RemoveConn( AConn: PTestConn );
    procedure EmbedTick;


    constructor Init( APort: Word );
    procedure Tick;
    procedure Log( S: string );
  end;

const

  ST_RECV             = 0;
  ST_RECV_WAIT        = 1;
  ST_SEND             = 2;
  ST_SEND_WAIT        = 3;
  ST_DISCONNECT       = 4;
  ST_DISCONNECT_WAIT  = 5;
  ST_UNBIND           = 6;
  ST_UNBIND_WAIT      = 7;
  ST_CLOSE            = 8;
  ST_FINISHED         = 9;


  ST_SVR_BIND         = 0;
  ST_SVR_BIND_WAIT    = 1;
  ST_SVR_LISTEN       = 2;
  ST_SVR_ACCEPT       = 3;
  ST_SVR_ACCEPT_WAIT  = 4;
  ST_SVR_UNBIND       = 5;
  ST_SVR_UNBIND_WAIT  = 6;
  ST_SVR_CLOSE        = 7;
  ST_SVR_FINISHED     = 8;


constructor TTestConn.Init( ASock: PCoDevice; APort: Word );
begin
  inherited Init;
  Sock := ASock;
  Port := APort;
  State := ST_RECV;
end;


procedure TTestConn.Tick;
var
  Status : TCoStatus;
begin
  case State of

  {----------------------------------------------------------------}
    ST_RECV:
    begin
      Log( 'Recv' );

      Status := Sock^.CoRecvBuffer( @RecvData, SizeOf(RecvData),
        @RecvSize, 0, @Ovlp );

      case Status of

        CST_PENDING: State := ST_RECV_WAIT;

        CST_SUCCESS:
        begin
          State := ST_SEND;
        end;

      else
        if Status and 255 = CST_TCP_ERR_CONNCLOSING then
        begin
          State := ST_DISCONNECT;
        end
        else begin
          Log( 'CoRecvBuff() failed: ' + Sock^.CoStatusToStr( Status ) );
          State := ST_UNBIND;
        end;
      end;

    end;

  {----------------------------------------------------------------}
    ST_RECV_WAIT:
    begin
      Status := Sock^.CoGetIOResult( @Ovlp, 0 );

      case Status of
        CST_PENDING: ;
        CST_SUCCESS: State := ST_SEND;
      else

        if Status and 255 = CST_TCP_ERR_CONNCLOSING then
        begin
          State := ST_DISCONNECT;
        end
        else begin
          Log( 'CoRecvBuff() failed: ' + Sock^.CoStatusToStr( Status ) );
          State := ST_UNBIND;
        end;
      end;
    end;

  {----------------------------------------------------------------}
    ST_SEND:
    begin
      Log( 'Send' + WordStrDec( RecvSize, 0) );

      Status := Sock^.CoSendBuffer( @RecvData, RecvSize, 0, @Ovlp );

      case Status of

        CST_PENDING: State := ST_SEND_WAIT;

        CST_SUCCESS:
        begin
          State := ST_RECV;
        end;

      else
        if Status and 255 = CST_ERR_NOTBOUND then
        begin
          Status := Sock^.CoSendBuffer( @RecvData, RecvSize, 0, @Ovlp );
        end;

        if Status and 255 = CST_TCP_ERR_CONNCLOSING then
        begin
          State := ST_DISCONNECT;
        end
        else begin
          Log( 'CoSendBuff() failed: ' + Sock^.CoStatusToStr( Status ) );
          State := ST_UNBIND;
        end;
      end;

    end;

  {----------------------------------------------------------------}
    ST_SEND_WAIT:
    begin
      Status := Sock^.CoGetIOResult( @Ovlp, 0 );

      case Status of
        CST_PENDING: ;
        CST_SUCCESS: State := ST_RECV;
      else
        if Status and 255 = CST_ERR_NOTBOUND then
        begin
          Status := Sock^.CoSendBuffer( @RecvData, RecvSize, 0, @Ovlp );
        end;

        if Status and 255 = CST_TCP_ERR_CONNCLOSING then
        begin
          State := ST_DISCONNECT;
        end
        else begin
          Log( 'CoSendBuff() failed: ' + Sock^.CoStatusToStr( Status ) );
          State := ST_UNBIND;
        end;
      end;
    end;

  {----------------------------------------------------------------}
    ST_DISCONNECT:
    begin
      Log( 'Disconnect'  );
      Status := Sock^.CoDisconnect( 0, @Ovlp );

      case Status of
        CST_PENDING: State := ST_DISCONNECT_WAIT;
        CST_SUCCESS: State := ST_CLOSE;
      else
        Log( 'CoDisconnect() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_CLOSE;
      end;

    end;

  {----------------------------------------------------------------}
    ST_DISCONNECT_WAIT:
    begin
      Status := Sock^.CoGetIOResult( @Ovlp, 0 );

      case Status of
        CST_PENDING: ;
        CST_SUCCESS: State := ST_UNBIND;
      else
        Log( 'CoDisconnect() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_UNBIND;
      end;
    end;

  {----------------------------------------------------------------}
    ST_UNBIND:
    begin
      Log( 'Unbind' );

      Status := Sock^.CoUnbind( 0, @Ovlp );

      case Status of
        CST_PENDING: State := ST_UNBIND_WAIT;
        CST_SUCCESS: State := ST_CLOSE;
      else
        Log( 'CoUnbind() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_CLOSE;
      end;
    end;

  {----------------------------------------------------------------}
    ST_UNBIND_WAIT:
    begin
      Status := Sock^.COGetIOResult( @Ovlp, 0 );

      case Status of
        CST_PENDING: ;
        CST_SUCCESS: State := ST_CLOSE;
      else
        Log( 'CoUnbind() failed: ' + Sock^.CoStatusToStr( Status ));
        State := ST_CLOSE;
      end;
    end;

  {----------------------------------------------------------------}
    ST_CLOSE:
    begin
      Log( 'Close' );
      NetCloseSocket( Sock );
      State := ST_FINISHED;
    end;

  {----------------------------------------------------------------}
    ST_FINISHED:
    begin
    end;

  else
    RunError( 255 );
  end;
end;

procedure TTestConn.Log( S: string );
begin
{  WriteLn( 'Conn(,', Port, '): ', S );}
end;


constructor TTestConnServer.Init( APort: Word );
var
  Status : TCoStatus;
begin
  inherited Init;
  Port := APort;

  Status := NetOpenSocket( 'TCP', 'LPORT=' +
    WordStrDec( APort, 0 ), '', Sock );

  if Status <> CST_SUCCESS then
  begin
    Log( 'NetOpenSocket() failed: ' + CoStatusToStr( Status ) );
    Fail;
  end;

  State := ST_SVR_BIND;
end;

function TTestConnServer.NewConn( ASock: PCoDevice; APort: Word ): PTestConn;
begin
  NewConn := New( PTestConn, Init( ASock, APort  ))
end;

procedure TTestConnServer.InsertConn( AConn: PTestConn );
begin
  Inc( Count );
  Inc( ConnCount );
  AConn^.Next := List;
  List := AConn;
  Log( 'InsertConn - ' +
    (IntegerStrDec( Count, 0 ) + ',' + IntegerStrDec( ConnCount, 0 ) ) );
end;


procedure TTestConnServer.RemoveConn( AConn: PTestConn );
var
  P    : PTestConn;
  Prev : PTestConn;
begin
  Prev := nil;
  P := List;
  while (P <> nil) and (P <> AConn) do
  begin
    Prev := P;
    P := P^.Next;
  end;

  if P <> nil then
  begin
    Dec( Count );
    Dec( ConnCount );
    Log( 'RemoveConn - ' +
    (IntegerStrDec( Count, 0 ) + ',' + IntegerStrDec( ConnCount, 0 ) ) );
    if Prev <> nil then
    begin
      Prev^.Next := P^.Next;
    end
    else
      List := P^.Next;
  end;
end;

procedure TTestConnServer.EmbedTick;
var
  P    : PTestConn;
  Prev : PTestConn;
  Temp : PTestConn;
begin
  P := List;
  Prev := nil;

  while P <> nil do
  begin
    P^.Tick;

    if P^.State = ST_FINISHED then
    begin
      Dec( Count );
      Dec( ConnCount );
      { Odstraneni ukoncene instance spojeni }

      if Prev = nil then
      begin
        List := P^.Next;
      end
      else
        Prev^.Next := P^.Next;

      Temp := P;
      P := P^.Next;

      Temp^.Free;
    end
    else begin
      Prev := P;
      P := P^.Next;
    end;
  end;

end;

procedure TTestConnServer.Tick;
var
  Status : TCoStatus;
begin
  case State of

    ST_SVR_BIND:
    begin
      Log( 'CoBind' );

      Status := Sock^.CoBind( nil, COF_PROPAGATE, @Ovlp );

      case Status of

        CST_PENDING: State := ST_SVR_BIND_WAIT;

        CST_SUCCESS:
        begin
          State := ST_SVR_LISTEN;
        end;

      else
        Log( 'CoBind() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_UNBIND;
      end;

    end;

    ST_SVR_BIND_WAIT:
    begin
      Status := Sock^.CoGetIOResult( @Ovlp, 0 );

      case Status of
        CST_PENDING: ;
        CST_SUCCESS: State := ST_SVR_LISTEN;
      else
        Log( 'CoBind() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_UNBIND;
      end;
    end;

    ST_SVR_LISTEN:
    begin
      Log( 'CoListen' );

      Status := Sock^.CoListen( 5, 0, nil );

      if Status <> CST_SUCCESS then
      begin
        Log( 'CoListen() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_UNBIND;
      end
      else begin
        State := ST_SVR_ACCEPT;
      end;

    end;

    ST_SVR_ACCEPT:
    begin
      Status := Sock^.CoAccept( @ClAddr, ClSock, nil, 0, @Ovlp );

      case Status of

        CST_PENDING: State:= ST_SVR_ACCEPT_WAIT;

        CST_SUCCESS:
        begin
          InsertConn( NewConn( ClSock, Port ) );

          State := ST_SVR_ACCEPT;
        end;

      else
        Log( 'CoAccept() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_UNBIND;
      end;


    end;

    ST_SVR_ACCEPT_WAIT:
    begin
      Status := Sock^.CoGetIOResult( @Ovlp, 0 );

      case Status of
        CST_PENDING: ;
        CST_SUCCESS:
        begin
          InsertConn( NewConn( ClSock, Port ) );

          State := ST_SVR_ACCEPT;
        end
      else
        Log( 'CoAccept() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_UNBIND;
      end;
    end;


    ST_SVR_UNBIND:
    begin
      Log( 'Unbind' );

      Status := Sock^.CoUnbind( 0, nil );

      case Status of
        CST_PENDING: State := ST_SVR_UNBIND_WAIT;
        CST_SUCCESS: State := ST_SVR_CLOSE;
      else
        Log( 'CoUnbind() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_CLOSE;
      end;

    end;

    ST_SVR_UNBIND_WAIT:
    begin
      Status := Sock^.CoGetIoResult( @Ovlp, 0 );
      case Status of
        CST_PENDING: ;
        CST_SUCCESS: State := ST_SVR_CLOSE;
      else
        Log( 'CoUnbind() failed: ' + Sock^.CoStatusToStr( Status ) );
        State := ST_SVR_CLOSE;
      end;
    end;

    ST_SVR_CLOSE:
    begin
      State := ST_SVR_BIND;

{      Log( 'Close' );
      NetCloseSocket( Sock );
      State := ST_SVR_FINISHED;}
    end;

    ST_SVR_FINISHED:
    begin
    end;

  else
    RunError( 255 );
  end;

  EmbedTick;
end;

procedure TTestConnServer.Log( S: string );
begin
  WriteLn( 'Svr(', Port, '): ', S );
end;



var
  Status : TCoStatus;
  Servers: array[0..11 ] of PTestConnServer;
  I : Integer;

begin
  ClrScr;

  Status := NetOpenStack( 'ETH01', 'IOBASE=$310',
             'IPADDR="192.168.1.210" NETMASK="255.255.255.0"', '' );

  if Status <> CST_SUCCESS then
  begin
    WriteLn( 'NetOpenStack() failed: ' + CoStatusToStr( Status ) );
    Exit;
  end;


  for I := 0 to 11 do
  begin
    Servers[ I ] := New( PTestConnServer, Init( 5000 + I ) );
  end;

  repeat

    for I := 0 to 11 do
    begin
      if Servers[ I ] <> nil then Servers[ I ]^.Tick;
    end;

  until Keypressed;

end.