program UdpSpd;

uses
  Crt,
  NumToStr,
  CoBase,
  CoIPv4,
  CoEth01,
  CoTcp,
  CoINET;


const

{$IFDEF VERMC}
  IoBase        = $2300;
{$ENDIF}
{$IFDEF VERPC}
  IoBase        = $300;
{$ENDIF}

  MaxBuffSize   = 64;

type

  TTestProcedure = function ( ADev: PCoDevice ): Boolean;



  procedure RunTest( ATestProc: TTestProcedure );
  var
    Status    : TCoStatus;
    Dev       : PCoDevice;
    StartTime : TCoTime;
    StopTime  : TCoTime;
    Address   : TTcpAddress;
  begin
    Status := NetOpenSocket( 'TCP', 'LPORT=5000', '', Dev );

    if Status = CST_SUCCESS then
    begin

      Status := Dev^.CoBind( nil, COF_PROPAGATE, nil );

      if Status = CST_SUCCESS then
      begin

        with Address do
        begin
          Size := SizeOf( TTcpAddress );
          Address := MakeIpAddr( 192, 168, 1, 9 );
          Port := 5000;
        end;

        Status := Dev^.CoConnect( @Address, 0, nil );

        if Status = CST_SUCCESS then
        begin

          StartTime := CoGetTime;

          WriteLn( 'Test running...' );

          if Assigned( ATestProc ) then ATestProc( Dev );

          StopTime  := CoGetTime;

          Write( 'Test stopped after ' );


          WriteLn( CoTimeDistMs(StopTime,  StartTime), 'ms' );


          Status := Dev^.CoDisconnect( 0, nil );

          if Status <> CST_SUCCESS then
          begin
            WriteLn( 'CoDisconnect() failed: ', Dev^.CoStatusToStr( Status ) );
          end;

        end
        else begin
          WriteLn( 'CoConnect() failed: ', Dev^.CoStatusToStr( Status ) );
        end;

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

        if Status <> CST_SUCCESS then
        begin
          WriteLn( 'CoUnbind() failed: ', Dev^.CoStatusToStr( Status ) );
        end;

        CoReleaseDevicePtr( Dev );
      end
      else begin
        WriteLn( 'CoBind() failed: ', Dev^.CoStatusToStr( Status ) );
        CoReleaseDevicePtr( Dev );
      end;

    end
    else begin
      WriteLn( 'NetOpenSocket() failed: ', CoStatusToStr( Status ) );
    end;

  end;



  function  SendTestProc( ADev: PCoDevice ): Boolean; far;
  const
    MaxPasses = 256;

  var
    Buffer  : Pointer;

    Status  : TCoStatus;
    Cnt     : Word;
  begin
    GetMem( Buffer, MaxBuffSize );

    WriteLn( 'Sending ', MaxPasses, ' x ', MaxBuffSize, ' bytes');

    for Cnt := 1 to MaxPasses do
    begin

      Status := ADev^.CoSendBuffer( Buffer, MaxBuffSize, COF_TCP_PUSH, nil );


      if Status <> CST_SUCCESS then
      begin
        WriteLn( 'CoSendBufferTo() failed: ', ADev^.CoStatusToStr( Status ) );
        Break;
      end;

    end;

    FreeMem( Buffer, MaxBuffSize );

  end;



  function  SendTestProcOvlp( ADev: PCoDevice ): Boolean; far;
  const


    MaxPasses = 128;

  var

    Buffer  : Pointer;
    Status  : TCoStatus;
    Cnt     : Word;

    Ovlp1   : TOverlapped;
    Ovlp2   : TOverlapped;
    Ovlp3   : TOverlapped;
  begin
    GetMem( Buffer, MaxBuffSize );

    WriteLn( 'Sending 2 x', MaxPasses, ' x ', MaxBuffSize, ' bytes -- Overlapped');


    FillChar( Ovlp1, SizeOf( Ovlp1 ), 0 );
    FillChar( Ovlp2, SizeOf( Ovlp2 ), 0 );
    FillChar( Ovlp3, SizeOf( Ovlp2 ), 0 );


    for Cnt := 1 to MaxPasses do
    begin

{     Status := ADev^.CoGetIOResult( @Ovlp3, COF_WAIT );


      Status := ADev^.CoSendBuffer( Buffer, MaxBuffSize, 0, @Ovlp3 );}


      Status := ADev^.CoGetIOResult( @Ovlp1, COF_WAIT );

      if Status <> CST_SUCCESS then
      begin
        WriteLn( 'CoSendBufferTo() failed: ', ADev^.CoStatusToStr( Status ) );
        FreeMem( Buffer, MaxBuffSize );
        Exit;
      end;

      Status := ADev^.CoSendBuffer( Buffer, MaxBuffSize, 0, @Ovlp1 );

      Status := ADev^.CoGetIOResult( @Ovlp2, COF_WAIT );

      if Status <> CST_SUCCESS then
      begin
        WriteLn( 'CoSendBufferTo() failed: ', ADev^.CoStatusToStr( Status ) );
        FreeMem( Buffer, MaxBuffSize );
        Exit;
      end;

      Status := ADev^.CoSendBuffer( Buffer, MaxBuffSize, 0, @Ovlp2 );

    end;


    FreeMem( Buffer, MaxBuffSize );

  end;

  function  RecvTestProc( ADev: PCoDevice ): Boolean; far;
  var
    Buffer  : Pointer;

    Status  : TCoStatus;
    Cnt     : Word;
    RecvLen : Word;
  begin
    GetMem( Buffer, MaxBuffSize );

    WriteLn( 'Receiving:' );

    repeat

      Status := ADev^.CoRecvBuffer( Buffer, MaxBuffSize, @RecvLen, 0, nil );

   {  WriteLn( 'RecvLen: ', RecvLen );}

      if Status <> CST_SUCCESS then
      begin
        WriteLn( 'CoSendBufferTo() failed: ', ADev^.CoStatusToStr( Status ) );
        Break;
      end;

    until False;

    FreeMem( Buffer, MaxBuffSize );

  end;



var

  OldExitProc : Pointer;

  procedure MyExitProc; far;
  begin
    {$ifdef VERMC}
    if ExitCode <> 0 then
    begin
      WriteLn( 'ExitCode: ', ExitCode, ' Address: ', PtrToStr( ErrorAddr ) );
      repeat until False;
    end;
    {$ENDIF}
    ExitProc := OldExitProc;
  end;

var
  Status : TCoStatus;

  L : Longint;

begin

  L := 999999999;

  L := L * 5;


  OldExitProc := ExitProc;
  ExitProc := @MyExitProc;

  {$IFDEF VERPC}
  Status := NetOpenStack( 'ETH01', 'IOBASE=$300', 'IPADDR="192.168.1.210"', '' );
  {$ELSE}
  Status := NetOpenStack( 'ETH01', 'IOBASE=$2300', 'IPADDR="192.168.1.210"', '' );
  {$ENDIF}


  if Status = CST_SUCCESS then
  begin

    RunTest( RecvTestProc );

    NetCloseStack( '' );
  end
  else begin
    WriteLn( 'NetOpenStack() failed: ', CoStatusToStr( Status ) );
  end;

{$IFDEF VERMC}
  repeat until False;
{$ENDIF}
end.