{poresit:

   problem open-connect-disconnect-close
           vs.bind-connect-disconnect-unbind

   vysilat i prijimat by melo jit i ve stavu open,

   pokud ne, pak nema smysl struktura paketu s adresou

}

unit ChnUDP;

          {==========================================================}
          {                                                          }
          {  unit ChnUDP                     Ver 15/08/2001          }
          {                                                          }
          {  Knihovna pro komunikaci v siti                          }
          {  pomoci protokolu UDP                                    }
          {                                                          }
          {  (C)2001, SofCon, Stresovicka 49, 160 00 Praha 6         }
          {           Petr Cernin                                    }
          {                                                          }
          {==========================================================}

interface

uses
  Timer,
  CoDefs,
  CoBase,
  CoIPv4,
  CoUdp,
  Objects,
  ChnVirt,    { Abstraktni komunikacni objekt  }
  uString;    { Dekodovani prikazove radky     }

const
  cName = 'UDP';
  cVer  = 'V1.0, 15.08.2001';

const

  res_ErrUDP_NoNetStack         = $00A0; { Neni nainicializovan TCP/IP stack }
  res_ErrUDP_MemOverflow        = $00A1; { CST_ERR_MEMOVF }
  res_ErrUDP_Syntax             = $00A2; { CST_ERR_SYNTAX }
  res_ErrUDP_InvalidAddress     = $00A3; { CST_ERR_INVADDR }
  res_ErrUDP_PacketSize         = $00A4; { CST_ERR_PKTSIZE }
  res_ErrUDP_BufferSize         = $00A5; { CST_ERR_BUFFSIZE }
  res_ErrUDP_IoBase             = $00A6; { CST_ERR_IOBASE }
  res_ErrUDP_Hardware           = $00A7; { CST_ERR_HARDWARE }
  res_ErrUDP_HostUnreach        = $00A8; { CST_ERR_HOSTUNREACH }
  res_ErrUDP_NetUnreach         = $00A9; { CST_ERR_NETUNREACH }
  res_ErrUDP_Timeout            = $00AA; { CST_ERR_TIMEOUT }
  res_ErrUDP_NicError           = $00AB; { Nespecifikovana chyba NIC }
  res_ErrUDP_IpError            = $00AC; { Nespecifikovana chyba IP  }
  res_ErrUDP_UdpError           = $00AD; { Nespecifikovana chyba UDP }

type


{==========================================================================}
{                           TChnEth01                                      }
{==========================================================================}



  PChnUDP = ^TChnUDP;
  TChnUDP = object( TChnVirt )
  public
    CH_Device     : PCoDevice;
    CH_SendOvlp   : TOverlapped;
    CH_RecvOvlp   : TOverlapped;
    CH_CtrlOvlp   : TOverlapped;
    CH_RecvLen    : Word;

    CH_Suffix     : String[15];
    CH_LocalPort  : Word;
    CH_RemotePort : Word;
    CH_RemoteAddr : TIpAddress;

    { Inicializace objektu }
    constructor Init;
                  { vytvoreni objektu }

    { Inicializace objektu a nastaveni parametru }
    {$ifdef Ver6}
    constructor ChInitParam(S: tParamStr);
    {$endif}
    {$ifdef Ver7}
    constructor ChInitParam(const S: tParamStr);

    {$endif}

    { Zruseni objektu }
    destructor  Done; virtual;


    { Nastaveni a cteni parametru }
    {$ifdef Ver6}
    function  ChSetOneParam(S: tWordString; var CmdL: tCmd): tChResult;
                virtual;
    function  ChGetParam   (S: tParamStr): tParamStr;
                virtual;
    {$endif}
    {$ifdef Ver7}
    function  ChSetOneParam(const S: tWordString; var CmdL: tCmd): tChResult;
                virtual; { nove nastaveni jednoho parametru textove }
    function  ChGetParam   (const S: tParamStr): tParamStr;
                virtual; { prevod parametru kanalu do stringu }
    {$endif}

    { otevreni a zavreni HW kanalu, navazani a zruseni komunikace }
    procedure ChOpen;  { otevreni HW kanalu }
              virtual;
    procedure ChClose; { zavreni HW kanalu }
              virtual;

    procedure ChConnect;    { pocatek navazovani spojeni }
              virtual;
    procedure ChDisConnect; { pocatek ukonceni spojeni   }
              virtual;

    procedure ChTick;
              virtual;

    procedure ChSend(Buff: Pointer; Len: Word); { pocatek vysilani }
              virtual;
    procedure ChSendFlush; { preruseni vysilani }
              virtual;
    procedure ChSendTick; virtual;

    { prijem dat }
    procedure ChReceive(var Len: Word); { prijem zpravy }
              virtual;
    procedure ChReceiveFlush;           { stav jako po inicializaci }
              virtual;

    procedure ChReceiveTick; virtual;


  private

    function  ConvertStatus( Status: TCoStatus ): Word;

  end;



{========================================================================}
{                        TAddChnEtn01                                    }
{========================================================================}

  PAddChnUDP = ^TAddChnUDP;
  TAddChnUDP = object(TAddChnVirt)
    { Funkce provadejici zalozeni a inicializaci daneho kanalu }
    function ChInit: PChnVirt;                                                        virtual;
  end;


  PUdpPacketHeader = ^TUdpPacketHeader;
  TUdpPacketHeader = record
    Address  : TIpAddress;
    Port     : Word;
  end;

  PUdpPacket = ^TUdpPacket;
  TUdpPacket = record
    Header   : TUdpPacketHeader;
    Data     : array[0..511] of Byte;
  end;


implementation

uses
  NumToStr;   { Prevody cisel na string }


type

  PByte = ^Byte;
  PWord = ^Word;

const

{ Automat pro prijem }

  CHS_TryReceive    = 10; { Alokovani pameti pro paket    }

{ Automat pro stav kanalu }

  CHS_CloseToOpen   = 10;
  CHS_OpenToClose   = 11;
  CHS_OpenToConnect = 12;
  CHS_ConnectToOpen = 13;


{ TChnEth01 }


{ Inicializace objektu }

constructor TChnUDP.Init;
begin
  {$ifdef Ver6}
   TChnVirt.Init;
  {$else}
   inherited Init;
  {$endif}

  { Parametry kanalu }

  CH_Type       := cName;
  CH_Name       := CH_Type;
  CH_NumName    := ChNumName(CH_Type);

  CH_LocalPort  := 5000;
  CH_RemotePort := 5000;
  CH_RemoteAddr := MakeIpAddr( 192, 168, 1, 1 );
  CH_Suffix     := '';

  CH_Device     := nil;

  CH_RCtrl      := CHS_TryReceive;
end;

{ Inicializace objektu a nastaveni parametru }
{$ifdef Ver6}
constructor TChnUDP.ChInitParam(S: tParamStr);
{$endif}
{$ifdef Ver7}
constructor TChnUDP.ChInitParam(const S: tParamStr);
{$endif}
begin
  Init;
  ChSetParam(S);
  { CH_Result nastavuje ChSetParam }
end; { ChInitParam }


{ Zruseni objektu }
destructor  TChnUDP.Done;
begin
  if CH_Device <> nil then CoDeleteDevice( CH_Device );

  {$ifdef Ver6}
   TChnVirt.Done;
  {$else}
   inherited Done;
  {$endif}
  { CH_Result nastavuje Done }
end; { Done }


{$ifdef Ver6}
function TChnUDP.ChSetOneParam( S: TWordString;
 var CmdL: TCmd ): tChResult;
{$endif}
{$ifdef Ver7}
function TChnUDP.ChSetOneParam( const S: TWordString;
  var CmdL: TCmd ): tChResult;
{$endif}
type
  TParam = (
    P_ERR,
    P_RPO,       { Vzdaleny port (Remote Port)              }
    P_RAD,       { Vzdalena adresa (Remote Address)         }
    P_LPO,       { Lokalni port (Local Port                 }
    P_SFX        { Pripova instance UdpMux                  }
   );

const
  StrParam = 'RPO|RAD|LPO|SFX';

var
  Value    : Longint;
  StrValue : TCmdString;
  Result   : TChResult;
  Param    : TParam;
  Error    : Boolean;

begin
  Result := res_Ok;
  Error  := False;

  if S = '|' then
  begin
    ChNextSetParam( CmdL.ReadRest );
    Result := ChResult;
  end
  else begin
    Param := TParam( NDelim( S, StrParam ) );

    case Param of

    {----------------------------------------------}
      P_ERR:
      begin
      {$ifdef Ver6}
       Result := TChnVirt.ChSetOneParam( S, CmdL );
      {$else}
       Result := inherited ChSetOneParam( S, CmdL );
      {$endif}
      end;

    {----------------------------------------------}
      P_RPO:
      begin
        CmdL.ReadLVal( Value, Error );

        if not Error then
        begin

          if (Value > 0) and (Value <= $FFFF) then
          begin
            CH_RemotePort := Value;
          end
          else
            Error := True;

        end;
      end;

    {----------------------------------------------}
      P_RAD:
      begin
        StrValue := CmdL.ReadString;
        if not Error then
        begin
          Error := StrToIpAddr( StrValue, CH_RemoteAddr ) <> CST_SUCCESS;
        end;
      end;

    {----------------------------------------------}
      P_LPO:
      begin
        CmdL.ReadLVal( Value, Error );

        if not Error then
        begin

          if (Value > 0) and (Value <= $FFFF) then
          begin
            CH_LocalPort := Value;
          end
          else
            Error := True;

        end;
      end;

    {----------------------------------------------}
      P_SFX:
      begin
        StrValue := CmdL.ReadString;
        if not Error then
        begin
          CH_Suffix := StrValue;
        end;
      end;


    end; {case}

    if Error then Result := CH_NumName or res_ErrParamStr;
  end;

  ChSetOneParam := Result;

end;


{ prevod par kanalu do stringu }
{$ifdef Ver6}
function  TChnUDP.ChGetParam(S: tParamStr): tParamStr;
{$endif}
{$ifdef Ver7}
function  TChnUDP.ChGetParam(const S: tParamStr): TParamStr;
{$endif}
var
  TmpStr : TParamStr;
begin
  TmpStr :=
    'NAM='   + CH_Name +
    ' LPO=$' + WordStrDec( CH_LocalPort, 0 ) +
    ' RAD='''  + IpAddrToStr( CH_RemoteAddr ) + '''' +
    ' RPO=$' + WordStrDec( CH_RemotePort, 0 ) +
    ' SFX=''' + CH_Suffix + '''';

  ChGetParam := TmpStr;
end;

{----------------------------------------}

{ Otevreni kanalu, pripojeni lokalni adresy }

procedure TChnUDP.ChOpen;
var
  Status   : TCoStatus;
  UdpMux   : PCoDevice;
  Address  : TUdpAddress;
  Timeouts : TCoDeviceTimeouts;
begin

  if CH_Ctrl = CHS_Close then
  begin

    { Ziskame ukazatel na zarizeni UDPMUX }
    UdpMux := CoOpenDevice( 'UDPMUX' + CH_Suffix );

    if UdpMux <> nil then
    begin
      { Vytvorime zarizeni UDP }

      Status := CoCreateDevice( 'UDP', '',
        'LPORT=' + WordStrDec( CH_LocalPort, 0 ) +
        ' RPORT=' + WordStrDec( CH_RemotePort, 0 ) +
        ' RADDR="' + IpAddrToStr( CH_RemoteAddr ) + '"',
        UdpMux, CH_Device );

      { Ukazatel na UdpMux uz nebudeme potrebovat }
      CoReleaseDevicePtr( UdpMux );

      if Status = CST_SUCCESS then
      begin

        CH_Device^.CoGetTimeouts( Timeouts );

        { Timeouty nechame na aplikaci, zde
          nastavime nejake max. hodnoty,
          pro uplne zruseni timeoutu, nastavit 0 }

        with Timeouts do
        begin
          SendTimeout    := 16 * 1000; { ms }
          RecvTimeout    := 16 * 1000;
          IoctlTimeout   := 16 * 1000;
          ConnectTimeout := 16 * 1000;
          DisconnTimeout := 16 * 1000;
          BindTimeout    := 16 * 1000;
          UnbindTimeout  := 16 * 1000;
          OptTimeout     := 16 * 1000;
        end;

        CH_Device^.CoSetTimeouts( Timeouts );

        Address.Size := SizeOf( TUdpAddress );
        Address.Address := IP_ADDR_ANY;
        Address.Port := CH_LocalPort;

        { Bind na implicitni adresu }
        Status := CH_Device^.CoBind( @Address, COF_PROPAGATE, @CH_CtrlOvlp );

        case Status of

          CST_SUCCESS:
          begin
            CH_Ctrl := CHS_Open;
            CH_State := CH_Ctrl;
          end;

          CST_PENDING:  CH_Ctrl := CHS_CloseToOpen;

        else
          { Nejaka chyba, zustaneme ve stavu CHS_Close }

          ChSetResult( ConvertStatus( Status ) );

        end;
      end
      else
        ChSetResult( ConvertStatus( Status ) );

    end
    else
      ChSetResult( CH_NumName or res_ErrUDP_NoNetStack );

  end
  else
    ChSetResult( CH_NumName or res_ErrNoClose );

end;

{ Uzavreni kanalu, odpojeni lokalni adresy }

procedure TChnUDP.ChClose;
var
  Status : TCoStatus;
begin
  if CH_Ctrl = CHS_Open then
  begin
    Status := CH_Device^.CoUnbind( COF_PROPAGATE, @CH_CtrlOvlp );

    case Status of

      CST_SUCCESS:
      begin
        CH_Ctrl := CHS_Close;
        CH_State := CH_Ctrl;
      end;

      CST_PENDING:  CH_Ctrl := CHS_OpenToClose;

    else
      ChSetResult( ConvertStatus( Status ) );
    end;

  end
  else
    ChSetResult( CH_NumName or res_ErrNoOpen );
end;

{ Navazani spojeni s druhou stanici }

procedure TChnUDP.ChConnect;
var
  Status  : TCoStatus;
  Address : TUdpAddress;
begin

  if CH_Ctrl = CHS_Open then
  begin
    Address.Size := SizeOf( TUdpAddress );
    Address.Address := CH_RemoteAddr;
    Address.Port := CH_RemotePort;

    Status := CH_Device^.CoConnect( @Address, COF_PROPAGATE, @CH_CtrlOvlp );

    case Status of
      CST_SUCCESS:
      begin
        CH_Ctrl := CHS_Connect;
        CH_State := CH_Ctrl;
      end;

      CST_PENDING:  CH_Ctrl := CHS_OpenToConnect;

    else
      ChSetResult( ConvertStatus( Status ) );
    end;

  end
  else
    ChSetResult( CH_NumName or res_ErrNoOpen );

end;

{ Ukonceni spojeni s druhou stanici }

procedure TChnUDP.ChDisconnect;
var
  Status : TCoStatus;
begin

  if CH_Ctrl = CHS_Connect then
  begin
    Status := CH_Device^.CoDisconnect( COF_PROPAGATE, @CH_CtrlOvlp );

    case Status of

      CST_SUCCESS:
      begin
        CH_Ctrl := CHS_Open;
        CH_State := CHS_Open;
      end;

      CST_PENDING:  CH_Ctrl := CHS_ConnectToOpen;

    else
      ChSetResult( ConvertStatus( Status ) );
    end;

  end
  else
    ChSetResult( CH_NumName or res_ErrNoConnect );
end;


procedure TChnUDP.ChTick;
var
  Status : TCoStatus;

begin
  case CH_Ctrl of


  {----------------}
    CHS_Close:
    begin
      { stabilni stav, tady pouze cekame na volani ChOpen }
    end;

  {----------------}
    CHS_CloseToOpen:
    begin
      Status := CH_Device^.CoGetIOResult( @CH_CtrlOvlp, 0 );

      case Status of

        CST_SUCCESS:
        begin
          CH_Ctrl := CHS_Open;
          CH_State := CH_Ctrl;
        end;

        CST_PENDING: {cekame dale};

      else
        { nejaka chyba }
        ChSetResult( ConvertStatus( Status ) );
        CH_Ctrl := CHS_Close;
      end

    end;

  {----------------}
    CHS_OpenToClose:
    begin

      Status := CH_Device^.CoGetIOResult( @CH_CtrlOvlp, 0 );

      case Status of

        CST_SUCCESS:
        begin
          CH_Ctrl := CHS_Close;
          CH_State := CH_Ctrl;
        end;


        CST_PENDING: {cekame dale};

      else
        { nejaka chyba }
        ChSetResult( ConvertStatus( Status ) );
        CH_Ctrl := CHS_Open;
      end

    end;

  {----------------}
    CHS_Open:
    begin
      { stabilni stav, tady pouze cekame na volani ChConnect nebo ChClose }
    end;

  {----------------}
    CHS_OpenToConnect:
    begin
      Status := CH_Device^.CoGetIOResult( @CH_CtrlOvlp, 0 );

      case Status of

        CST_SUCCESS:
        begin
          CH_Ctrl := CHS_Connect;
          CH_State := CH_Ctrl;
        end;


        CST_PENDING: {cekame dale};

      else
        { nejaka chyba }
        ChSetResult( ConvertStatus( Status ) );
        CH_Ctrl := CHS_Open;
      end
    end;

  {----------------}
    CHS_ConnectToOpen:
    begin

      Status := CH_Device^.CoGetIOResult( @CH_CtrlOvlp, 0 );

      case Status of

        CST_SUCCESS:
        begin
          CH_Ctrl := CHS_Open;
          CH_State := CH_Ctrl;
        end;


        CST_PENDING: {cekame dale};

      else
        { nejaka chyba }
        ChSetResult( ConvertStatus( Status ) );
        CH_Ctrl := CHS_Connect;
      end

    end;

  {----------------}
    CHS_Connect:
    begin
      { stabilni stav, tady pouze cekame na volani ChDisconnect }
    end;

  end;
end;


procedure TChnUDP.ChSendTick;
var
  Status : TCoStatus;
begin

  case CH_SCtrl of

  {----------------}
    CHS_SendReady:
    begin
      { stabilni stav, cekame na volani ChSend }
    end;

  {----------------}
    CHS_SendNoReady:
    begin
      Status := CH_Device^.CoGetIOResult( @CH_SendOvlp, 0 );

      case Status of

        CST_SUCCESS: CH_SCtrl := CHS_SendReady;
        CST_PENDING: {nic} ;

      else
        { Nastala chyba }

        ChSetSendResult( ConvertStatus( Status ) );
        CH_SCtrl := CHS_SendReady;

      end;
    end;

  end;
end;


{ Odeslani ramce }
procedure TChnUDP.ChSend( Buff: Pointer; Len: Word );
var
  Status  : TCoStatus;
  Address : TUdpAddress;
begin
  if CH_Ctrl = CHS_Connect then
  begin
    if CH_SCtrl = CHS_SendReady then
    begin

      if Len > SizeOf( TUdpPacketHeader ) then
      begin

        Address.Size    := SizeOf( TUdpAddress );
        Address.Address := PUdpPacket(Buff)^.Header.Address;
        Address.Port    := PUdpPacket(Buff)^.Header.Port;

        Status := CH_Device^.CoSendBufferTo(
          @PUdpPacket(Buff)^.Data, Len - SizeOf( TUdpPacketHeader ), 0,
          @Address, @CH_SendOvlp );

        case Status of
          CST_SUCCESS: {nic};
          CST_PENDING: CH_SCtrl := CHS_SendNoReady;
        else
          { nejaka chyba }
          ChSetSendResult( ConvertStatus( Status ) );
        end;

      end
      else
        ChSetSendResult( res_ErrUDP_PacketSize );

    end
    else
      ChSetSendResult( CH_NumName or res_ErrNoSendReady );
  end
  else
    ChSetSendResult( CH_NumName or res_ErrNoConnect );
end;


procedure TChnUDP.ChSendFlush;
begin
  if CH_Ctrl = CHS_Connect then
  begin
    if CH_SCtrl = CHS_SendNoReady then
    begin
      CH_Device^.CoCancelIo( @CH_SendOvlp, 0 ) ;
    end;
  end
  else
    ChSetSendResult( CH_NumName or res_ErrNoConnect );
end;



procedure TChnUDP.ChReceiveTick;
var
  Status : TCoStatus;
begin
  case CH_RCtrl of

  {----------------}
    CHS_TryReceive:
    begin
      Status := CH_Device^.CoRecvBuffer( @PUdpPacket(CH_RMess)^.Data,
                  CH_MRMess - SizeOf( TUdpPacketHeader ),
                  @CH_RecvLen, 0, @CH_RecvOvlp );

      case Status of
        CST_SUCCESS: CH_RCtrl := CHS_ReceiveReady;
        CST_PENDING: CH_RCtrl := CHS_ReceiveNoReady;

      else
        { Chyba, zustaneme tam kde jsme }

        CHSetReceiveResult( ConvertStatus( Status ) );
      end;
    end;

  {----------------}
    CHS_ReceiveNoReady:
    begin
      Status := CH_Device^.CoGetIoResult( @CH_RecvOvlp, 0 );
      case Status of
        CST_SUCCESS: CH_RCtrl := CHS_ReceiveReady;
        CST_PENDING: {zustanem zde};
      else
        { Chyba }
        ChSetReceiveResult( ConvertStatus( Status ) );
        CH_RCtrl := CHS_TryReceive;
      end;
    end;

  {----------------}
    CHS_ReceiveReady:
    begin
      CH_Device^.CoTick; { at se aspon neco deje }
      { zde cekame na volani ChReceive }
    end;

  end;

end;


procedure TChnUDP.ChReceive(var Len: Word );
begin
  if CH_Ctrl = CHS_Connect then
  begin
    if CH_RCtrl = CHS_ReceiveReady then
    begin
      Len := CH_RecvLen + SizeOf( TUdpPacketHeader );
      CH_RCtrl := CHS_TryReceive;
    end
    else begin
      ChSetReceiveResult( CH_NumName or res_ErrNoReceiveReady );
    end;
  end
  else
    ChSetReceiveResult( CH_NumName or res_ErrNoConnect );
end;


procedure TChnUDP.ChReceiveFlush;
begin
  if CH_Ctrl = CHS_Connect then
  begin

    CH_Device^.CoFlushReceiveQueue;

    if CH_RCtrl = CHS_ReceiveNoReady then
    begin
      CH_Device^.CoCancelIO( @CH_RecvOvlp, 0 );
    end;

    CH_RCtrl := CHS_TryReceive;
  end
  else
    ChSetReceiveResult( CH_NumName or res_ErrNoConnect );
end;


function TChnUDP.ConvertStatus( Status: TCoStatus ): Word;
begin

  case Status and 255 of

    CST_ERR_MEMOVF      : ConvertStatus := res_ErrUDP_MemOverflow;
    CST_ERR_SYNTAX      : ConvertStatus := res_ErrUDP_Syntax;
    CST_ERR_INVADDR     : ConvertStatus := res_ErrUDP_InvalidAddress;
    CST_ERR_PKTSIZE     : ConvertStatus := res_ErrUDP_PacketSize;
    CST_ERR_BUFFSIZE    : ConvertStatus := res_ErrUDP_BufferSize;
    CST_ERR_IOBASE      : ConvertStatus := res_ErrUDP_IoBase;
    CST_ERR_HARDWARE    : ConvertStatus := res_ErrUDP_Hardware;
    CST_ERR_HOSTUNREACH : ConvertStatus := res_ErrUDP_HostUnreach;
    CST_ERR_NETUNREACH  : ConvertStatus := res_ErrUDP_NetUnreach;
    CST_ERR_TIMEOUT     : ConvertStatus := res_ErrUDP_Timeout;

  else

    case Status shr 8 of
      DEV_CLASS_NIC : ConvertStatus := res_ErrUDP_NicError;
      DEV_CLASS_IP  : ConvertStatus := res_ErrUDP_IpError;
    else
      ConvertStatus := res_ErrUDP_UdpError;
    end;

  end;

end;

{========================================================================}
{      O b j e k t   k a n a l u    v     C h n C o l l e c t i o n      }
{========================================================================}

function TAddChnUDP.ChInit:PChnVirt;
begin
  ChInit := New(PChnUDP, Init);
end;


{========================================================================}

begin

  ChnCollection^.Insert( New( PAddChnUDP, Init( nil ) ) );

  {$ifdef HardLock}
   if not TestHardLock then RunError( 99 );
  {$endif}

end.