unit CoTCP;

  {==========================================================}
  {                                                          }
  {  unit CoTCP                          24/02/2003          }
  {                                      Verze 1.3f          }
  {  !!! v pripade zmeny zmenit cislo verze CoEthDef.cVer    }
  {							     }
  {  Knihovna protokolu TCP nad IP verze 4                   }
  {                                                          }
  {                                                          }
  {  (C)2002, SofCon, Stresovicka 49, 160 00 Praha 6         }
  {           Petr Cernin                                    }
  {                                                          }
  {==========================================================}


{ TODO:

  * MiniportCancel
  * Co dela accept, pokud je jiz spojeni s danou stanici a portem
    navazano ? (takova situace muze nastat v pripade opakovani SYN segmentu..??asi)
  * Pokud pri vysilani uvedeme priznak COF_TCP_COPY, muze dojit k
    totalnimu zaplneni pameti, kde uz nic nepomuze..=>alokovat
    nektere pozadavky na heapu hptCtrl, nebo blokovat vysilani
    dokud se neuvolni pamet
  * Zkontrolovat, zda po ukonceni spojeni, vraci vsechny
    nevyrizene pozadavky na prijem CST_TCP_ERR_CONNCLOSING..
}

{ Zmeny:

    [1] 15.11.2002 Verze 1.2
          - Pridan parametr RTSYNLIMIT
    [2] 09.12.2002 Verze 1.3b
          - Oprava MiniportGetOption a MiniportSetOption
    [3] 20.02.2003 Verze 1.3c
          - Oprava ukoncovani spojeni. V nekterych pripadech
            nebyla data po asynchronnim zavolani MiniportDisconnect
            spolehlive odeslana.
    [4] 24.02.2003 Verze 1.3d
          - Oprava opravy [3] ;-) Spojeni se ukoncilo, aniz by se
            odeslala vsechna data.
    [5] 16.5.2003  Verze 1.3e
          - Oprava obsluhu RST segmentu ve stavech
            TCP_CONCLOSING, TCP_LASTACK (nedochazelo k ukonceni spojeni)
    [6] XX.12.2003 Verze 1.3f
          - Oprava preteceni pri zvetseni okna nad 32kB
          - Oprava chyb pri navazovani spojeni pomoci CoAccept
}


{ define DEBUG_TCP}
{ define DEBUG_TCPMUX}

{ define DEBUG_TCP_NAGLE}
{ define DEBUG_TCP_RTO}
{ define DEBUG_TCP_BUFFER}
{ define DEBUG_TCP_TX}
{ define DEBUG_TXP_TX_COPY}
{ define DEBUG_TCP_WND}
{ define DEBUG_TCP_ACK}
{ define DEBUG_TCP_CWND}    { Debug congestion control }
{ define DEBUG_TCP_PROTOREG}

interface

uses
  Objects,
  NumToStr,
  CoIPv4,
  CoBase;


const

  { Maximalni delka TCP hlavicky, kterou
   muze vygenerovat zarizeni
    TCoTCP }

  MAX_TCP_HEADER_SIZE = 20 + 4;

type


  PTcpHeader = ^TTcpHeader;
  TTcpHeader = packed record
    SourcePort : Word;             { Zdrojovy port                    }
    DestPort   : Word;             { Cilovy port                      }
    SeqNumber  : Longint;          { Cislo prvniho odesilaneho oktetu }
    AckNumber  : Longint;          { Cislo ocekavaneho oktetu         }
    DataOfs    : Byte;             { Delka zahlavi, horni ctyri bity  }
    Control    : Byte;             { Ridici bity                      }
    Window     : Word;             { Velikost okna                    }
    Checksum   : Word;             { Kontrolni soucet                 }
    UrgPtr     : Word;             { Ukazatel nalehavych dat          }
  end;


  PTcpAddress = ^TTcpAddress;
  TTcpAddress = record
    Size    : Byte;
    Address : TIpAddress;
    Port    : Word;
  { TOS     : Byte; }
  end;

const

  COF_TCP_PUSH       = 1;          { Odeslani dat okamzite s priznakem PSH }
  COF_TCP_COPY       = 2;          { Prekopirovani dat do bufferu     }

const

  COPT_TCP_LPORT      = 256;        { Lokalni port                     }
  COPT_TCP_RADDR      = 258;        { Remote address                   }
  COPT_TCP_DACK       = 259;        { Delay ack time [ms]              }
  COPT_TCP_NAGLE      = 260;        { Nagle time [ms] , 0=off          }
  COPT_TCP_TIMEWAIT   = 261;        { Cekani v timewait, 0=off         }
  COPT_TCP_RTLIMIT    = 262;        { Maximalni pocet opakovani        }
  COPT_TCP_RTSYNLIMIT = 263;        { Maximalni pocet opakovany SYN    }
  COPT_TCP_MINWND     = 264;        { Minimalni velikost okna          }
  COPT_TCP_MAXWND     = 265;        { Maximalni velikost okna          }

const

  CST_TCP_ERR_CONNCLOSING  = 200;      { Spojeni se uzavira               }
  CST_TCP_ERR_CONNREFUSED  = 201;      { Spojeni odmitnuto                }
  CST_TCP_ERR_CONNRESET    = 202;      { Spojeni resetovano               }
  CST_TCP_ERR_NORESPONSE   = 203;      { Druha stanice neodpovida         }
  CST_TCP_ERR_PORTENGAGED  = 204;      { Port je obsazen                  }


  { Chyba CST_ERR_PORTENGAGED muze vzniknou v situaci, kdy:
    Pomoci zarizeni bylo navazano spojeni (zarizeni se u vrstvy TCPMUX
    preregistrovalo, aby prijimalo pouze pakety tohoto spojeni). Pote
    bylo spojeni zruseno, ale nebyl zavolan Bind. Pokud mezitim co
    bylo navazano spojeni se nejaka jina zasuvka napichla na stejny
    port a je ve stavu TCP_LISTEN, pak je tento port obsazen. A zarizeni
    jiz nemuze vice cihat na tomto portu. Chybu konkretne vraci
    funkce Connect, pri opetovnem pokusu o navazani spojeni.
    Je potreba provest Unbind a Bind na jinem portu, nebo uzavrit to zarizeni,
    ktere port blokuje.
  }


const

  IOCTL_TCP_WAIT_ESTABLISHED = 256;


const { Stavy TCP automatu }

  TCP_NOTBOUND      = 0;
  TCP_CLOSED        = 1;
  TCP_LISTEN        = 2;
  TCP_SYN_SENT      = 3;
  TCP_SYN_RECEIVED  = 4;
  TCP_ESTABLISHED   = 5;
  TCP_FIN_WAIT1     = 6;
  TCP_FIN_WAIT2     = 7;
  TCP_CLOSE_WAIT    = 8;
  TCP_LAST_ACK      = 9;
  TCP_CLOSING       = 10;
  TCP_TIME_WAIT     = 11;


const

  TCP_OPT_EOL      = 0; { End Of Option List   }
  TCP_OPT_NOP      = 1; { No Opearation        }
  TCP_OPT_MSS      = 2; { Maximum segment size }


const


  TCP_CTRL_FIN     = $01;
  TCP_CTRL_SYN     = $02;
  TCP_CTRL_RST     = $04;
  TCP_CTRL_PSH     = $08;
  TCP_CTRL_ACK     = $10;
  TCP_CTRL_URG     = $20;

  TCP_CTRL_MSS     = $100;  { Interni priznak, nevysila se.. }

type


  TTcpRecvBuff = object
  public
    Buff : Pointer;
    Size : Word;
    Head : Word;
    Tail : Word;

    { Head ukazuje na nejstarsi data ve fronte }
    { Tail ukazuje za nejnovejsi data ve fronte (kam se bude zapisovat) }

    { Pokud Head = Tail .. fronta je prazdna }

    function  Initialize( ASize: Word ): Boolean;
    procedure Finalize;
    procedure Enqueue( ABuff: Pointer; ASize: Word );
    function  Dequeue( AMaxSize: Word; var ASize: Word ): Pointer;

    function  UsedBytes: Word;
    function  FreeBytes: Word;
  end;


  TTcpRequestBuff = record
    Handle  : TCoRequest;  { Ukazatel na pozadavek       }
    Buff    : Pointer;     { Data pozadavku              }
    Size    : Word;        { Velikost dat                }
    Offset  : Word;        { Offset nezpracovanych data  }
  end;



  TTcpTCB = record

    State : Word;

    { Nasledujici "zkratky" identifikatoru viz. RFC-793 }

    SND : record
      UNA : Longint;  { Zacatek nepotvrzenych dat }
      NXT : Longint;  { Konec odeslanych dat nepotvrzenych dat }
      WND : Word;     { Velikost vysilaciho okna  }
      UP  : Word;     { }
      WL1 : Longint;
      WL2 : Longint;
      ISS : Longint;  { Pocatecni seq cislo       }

      MSS : Word;     { MSS prijaty s SYN segmentem     }
      WRI : Longint;  { Konec neodeslanych dat ve fronte }
      PSS : Longint;  { Konec dat, ktera se maji promptne odeslat }
      PSH : Boolean;  { PSS je platna     }

      CWND    : Word; { Congestion windows }
      SSTRESH : Word; { Slow Start Threshold }
    end;

    RCV : record
      WUP : Longint;  { Zacatek okna pri poslednim vysilani?? }
      NXT : Longint;  { Aktualni zacatek okna     }
      WND : Longint;  { Velikost prijimaciho okna }
      UP  : Word;     { }
      IRS : Longint;  { Pocatecni seq cislo       }

      MSS : Word;     { Max MSS, ktery tato strana prijima }
      BRD : Longint;  { Seq priste kopirovanych dat do aplikacniho bufferu }
      PSS : Longint;  { Konec dat, ktera se maji promptne predat aplikaci }
      PSH : Boolean;  { Polozka PSS je platna }
    end;

    { WUP + WND .. je to co zna protejsi stanice}

  end;



  TTcpSegment = record
    SEQ : Longint;    { Cislo segmentu            }
    ACK : Longint;    { Potrzeni segmentu         }
    LEN : Word;       { Delka segmentu            }
    WND : Word;       { Velikost okna             }
   {UP  : Word;       { Urgentni ukazatel         }
   {PRC : Word;       { Priorita                  }
    CTL : Byte;       { Ridici bity               }
  end;




  { Struktura TTcpRTO slouzi k obsluhe a mereni RTT a vypoctu RTO casovace
    (tj. casovace pro opakovani vysilani segmentu, pro ktere
     neprislo zadne potvrzeni }

  TTcpRTO = record
    Timer      : TCoTimer;  { Casovac RTO                           }
    Scheduled  : Boolean;   { True, pokud je casovac naplanovany,
                              tj. byla zavolana metoda CoStartTimer }
    Updated    : Boolean;   { Po inicializaci nastaveno na False,
                              pri prvni volani TcpRTOUpdate na True }
    { Pomocne promenne pro odhad RTT }
    Estimating : Boolean;   { Probiha mereni RTT                    }
    SendSeq    : Longint;   { SEQ prvniho oktetu v mericim segmentu }
    SendTime   : TCoTime;   { Cas odeslani mericiho segmentu        }

    { Pomocne promenne pro vypocet RTO }
    SRTT       : TCoTime;   { Smoothed Round Trip Time              }
    RTTVAR     : TCoTime;   { Round Trip Time Variation             }
    RTO        : TCoTime;   { Aktualni hodnota RTO                  }

    Retry      : Integer;   { Pocet opakovani segmentu,
                              prekroceni nastavene hodnoty zpusobi
                              uzavreni spojeni                      }
  end;



  TTcpAccept = record

    { Parametry volani MiniportAccept }
    Handle     : PCoRequest;
    Filter     : TCoAcceptFilterProc;
    DevicePtr  : ^PCoDevice;
    AddressPtr : PCoAddress;

    { Nove vytvorena zasuvka }
    Address    : TCoAddress;
    Device     : PCoDevice;
    WaitOvlp   : TOverlapped;      { Struktura IOCTL operace, cekani
                                     na dokonceni navazani spojeni }

    { Backlog }
    BackLog    : TCoPacketQueue;   { Fronta SYN segmentu cekajicich stanic }
  end;

  TTcpAck = record
    Timer        : TCoTimer;
    Scheduled    : Boolean;
    QuickMode    : Boolean;        { Vypnuti zpozdeneho odesilani odpovedi }
  end;

  TTcpNagle = record
    Timer        : TCoTimer;
    Scheduled    : Boolean;
  end;

  TTcpTimeWait = record
    Timer        : TCoTimer;
    Scheduled    : Boolean;
  end;


  TTcpSettings = record
    RTLimit        : Integer;      { Maximalni pocet opakovani segmentu   }
    RTSynLimit     : Integer;      { Max. pocet opakovani SYN segmentu    }
    TimeWaitDelay  : TCoTime;      { Cekani v TIME_WAIT, 0=off            }
    NagleDelay     : TCoTime;      { Zpozdene odesilani dat, 0=off        }
    AckDelay       : TCoTime;      { Zpozdene odesilani potvrzeni         }
    MinWindow      : Word;         { Minimalni velikost okna              }
    MaxWindow      : Word;         { Maximalni velikost okna              }
  end;

  PCoTCP = ^TCoTCP;
  TCoTCP = object( TCoDevice )

    TCB               : TTcpTCB;

    { Adresy specifikovane pri konfiguraci }

    TCP_DefLocalAddr  : TTcpAddress;    { Lokalni adresa }
    TCP_DefRemoteAddr : TTcpAddress;    { Vzdalena adresa }

    { Adresy, se kterymi se aktualne pracuje }

    TCP_LocalAddrMask : TIpIoctlAddrMask;

    TCP_LocalAddr     : TTcpAddress;    { Lokalni   TCP adresa }
    TCP_RemoteAddr    : TTcpAddress;    { Vzdalena  TCP adresa }


    { Nastaveni nekterych parametru }
    TCP_Settings      : TTcpSettings;

    { Fronta TCP_TxQ obsahuje vsechny neodvysilane a odvysilane a nepotvrzene
      pozadavky. Fronta se spravuje pomoci metod TcpTxQxxx. }

    TCP_TxQ           : TCoDeviceRequestQueue;
    TCP_TxQ_NXT       : PCoDeviceRequestQueueLink;


    { TCP_RxQ je fronta aplikacnich pozadavku na prijem.
      Pokud je prijat segment a v teto fronte je alespon jeden cekajici
      pozadavek, muzou byt prijata data prekopirovana primo do bufferu
      aplikace (misto toho, aby byly nejdrive ulozeny do vyrovnavaci pameti).
      Fronta se spravuje pomoci metod TcpRxQxxx }

    TCP_RxQ           : TCoDeviceRequestQueue;

    { Soucet velikost vsech nezamplnenych aplikacnich bufferu
      blokovanych v prijimaci fronte }
    TCP_RxQSize       : Longint;

    { Kruhovy prijimaci buffer }

    TCP_RxBuffer      : TTcpRecvBuff;

    TCP_OFOQueue      : TCoPacketQueue;


    TCP_SentList      : TCoDeviceRequestQueue;


    TCP_Passive       : Boolean;

    { Pozadavky Bind, Unbind, Ioctl }
    TCP_ReqList       : TCoDeviceRequestQueue;

    TCP_Ack           : TTcpAck;

    TCP_Nagle         : TTcpNagle;

    TCP_RTO           : TTcpRTO;

    TCP_Accept        : TTcpAccept;

    TCP_TimeWait      : TTcpTimeWait;

    TCP_Registered    : Boolean; { Zarizeni je registrovane u nizzsi vrstvy }

    { Priznak TCP_ClosePending rika, ze uzivatel zavolal metodu CoDisconnect, v
      okamziku, kdy jeste nebyly odvysilany vsechny data ve fronte.
      Pokud je priznak TCP_ClosePending nastaven, dojde po odvysilani
      vsech segmentu z fronty k odeslani FIN segmentu a k prechodu ze stavu
      TCP_ESTABLISHED do TCP_FIN_WAIT1 }
    TCP_ClosePending  : Boolean;

    { Byl odeslan priznak FIN }
    TCP_FINSent       : Boolean;

    { TCP_CloseHandle je ukazatel na pozadavek na ukonceni spojeni. Pozadavek
      je potvrzen az v okamziku, kdy od cilove stanice prijde FIN a ACK
      naseho FINU }
    TCP_CloseHandle   : PCoRequest;


    { TCP_OpenHandle je ukazatel na pozadavek na navazani spojeni. Pozadavek
      je potvrzen az v okamziku, kdy s cilovou stanici navazeme spojeni }
    TCP_OpenHandle    : PCoRequest;


    TCP_UnbindHandle  : PCoRequest;

    TCP_CtrlHandle    : PCoRequest; { Pozadavek Get/SetOption }


    TCP_ChildSocket   : Boolean;

    function SID: TString12;

  {---- metody pro odesilani segmentu nizsi vrstve }

    { Metoda __TcpSendSegment odesle APacket nizsi vrstve. Pokud
      odeslani segmentu neni provedeno okamzite, vytvoreny pozadavek
      na odeslani je ulozen do seznamu TCP_SentList a obsluha je
      dokoncena v metode ProtocolSendComplete. V pripade chyby
      je vyslany segment opakovan celkem 3 krat. APacket musi obsahovat
      vyplnenou hlavicku TCP protokolu }

    function  __TcpSendSegment( APacket: PCoPacket;
                AIpAddress: TIpAddress; ACtx: Word ): TCoStatus;

    { Metoda TCoSendSegment odesle jeden TCP segment s daty ulozenymi ve
      strukture APacket. Metoda doplni do struktury APacket hlavicku TCP
      segmentu a preda APacket nizsi vrstve. Hlavicka TCP segmentu
      je vyplnena podle parametru ASeq, AAck a ACtrl, zdrojovy port je
      vytazen z TCP_LocalAddress, cilovy port z parametru AAddress. Pokud
      polozka ACtrl ma nastaveny bit TCP_CTRL_MSS, je spolu s segmentem
      odeslan option MSS }

    function  TcpSendSegment( APacket: PCoPacket; ASeq, AAck: Longint;
                ACtrl: Word; AAddress: PTcpAddress; ACtx: Word ): TCoStatus;

    { Metoda TCoSendCtrlSegment odesle jeden TCP segment bez dat.
      Metoda se chova identicky s metodou TcpSendSegment }

    function  TcpSendCtrlSegment( ASeq, AAck: Longint; ACtrl: Word;
                AAddress : PTcpAddress; ACtx: Word ): TCoStatus;


  {---- metody pro praci z frontou vysilacich aplikacnich bufferu }

    { Metoda TcpTxQTransmit odesle cast vysilaci fronty nizsi vrstve.
      Vysila se pocinaje oktetem s poradovym cislem ASeq blok o velikosti
      ASize. Metoda zformuje jeden nebo vice segmentu o maximalni mozne
      delce a odesle je pomoci LowerSendBufferTo. Pro kazdy odeslany
      segment metoda musi vytvorit zvlastni Request, ktery se musi zrusit
      v metode ProtocolSendComplete. Metoda neposunuje zadna ukazovatka
      v TCB strukture ani TXP_TxQ_NXT. Vraci True, pokud byl odvysilan FIN}

    function  TcpTxQTransmit( ASeq, ASize: Longint; ACtrl: Word ): Boolean;

    { Metoda TcpTxQCommit provadi dokonceni obsluhy pozadavku na vysilani.
      Po provedeni jsou vsechny pozadavky na vysilani oktetu s poradovym
      cislem mensim nez ASeq vraceny zpet aplikacni vrstve s navratovym
      kodem CST_SUCCESS. Tyto pozadavky jsou z vysilaci fronty odstraneny.
      Metoda neposunuje zadna ukazovatvka v TCB strukture ani TXP_TxQ_NXT }
    procedure TcpTxQCommit( ASeq: Longint );

    { Metoda TcpTXQFlush provadi vyprazdneni cele vysilaci fronty. Vsechny
      pozadavky jsou vraceny aplikacni vrstve s navratovym kodem AStatus.
      Metoda neposunuje zadna ukazovatka v TCB strukture ani TXP_TxQ_NXT }
    procedure TcpTxQFlush( AStatus: TCoStatus );

    { Metoda TcpTxQInsert provadi vlozi pozadavek na vysilani na konec
      vysilaci fronty.
    }
    function  TcpTxQInsert( ARequest: PCoRequest; ABuffer: Pointer;
                ABuffSize: Word ): TCoStatus;

  {---- metody pro praci z frontou prijimacich aplikacnich bufferu }

    { Metoda TcpRxQInsert vlozi do prijimaci fronty pozadavek. Spolu s
      pozadavkem je v teto fronte ulozena adresa a velikost bufferu
      aplikacni vrstvy. Pozadavky ve fronte budou vraceny aplikacni
      vrstve az po zavolani nektere z metoda TcpRxQCommit, TcpRxQFlush.
      Metoda nastavuje polozku TCP_RxQSize }
    procedure TcpRxQInsert( ARequest: PCoRequest; ABuffer: Pointer;
                ABuffSize: Word );

    { Metoda TcpRxQCommit prekopiruje blok dat ABuffer o velikost ASize,
      do prvniho nebo nekolika prvnich aplikacnich bufferu blokovanych
      v prijimaci fronte. Vsechny zcela zaplnene buffery jsou vraceny
      aplikacni vrstve. Pokud je nastaven priznak APush, pak je i posledni
      zcasti zaplneny buffer vracen aplikacni vrstve. Metoda nastavuje
      polozku TCP_RxQSize }
    function  TcpRxQCommit( ABuffer: Pointer; ASize: Word;
                APush: Boolean ): TCoStatus;


    { Metoda TcpRxQFlush vrati vsechny pozadavky z prijimaci fronty aplikacni
      vrstve. Prvni pozadavek (pokud byl alespon jeden bajt bufferu zaplnen)
      muze vrati CST_SUCCESS. Ostatni pozadavky na prijem vrati navratovy
      kod AStatus. Metoda nastavuje polozku TCP_RxQSize na nulu }
    procedure TcpRxQFlush( AStatus : TCoStatus );


    { Metoda TcpProcessData zpracovava prichozi data segmentu.
      Data jsou bud prekopirovana do aplikacniho bufferu, ulozena
      do prijimaci fronty nebo do Out of Order seznamu.. }
    { Zapisuje jen do velikosti prijimaciho okna }
    procedure TcpProcessData( ASeq: Longint; APacket: PCoPacket );



    { Metoda TcpSendData odesle nejaka data z vysilaci fronty, pokud
      to v danem okamziku dovoluje prijimaci okno druhe strany }
    procedure TcpCheckAndSendData;


    {------------------------------------------------------------}
    { Metody pro praci s casovace Delayed ACK                    }
    {------------------------------------------------------------}

    procedure TcpAckSend;

    procedure TcpAckSendDelayed;

    procedure TcpAckTimerStop;

    procedure TcpAckTimerExpired;

    {------------------------------------------------------------}
    { Metody pro praci s casovacem pro opozdene odesilani dat    }
    {------------------------------------------------------------}

    procedure TcpNagleTimerStart;

    procedure TcpNagleTimerStop;

    procedure TcpNagleTimerExpired;

    {------------------------------------------------------------}
    { Metody pro praci s RTO casovacem                           }
    {------------------------------------------------------------}

    { Inicializace RTO casovace }
    procedure  TcpRTOInit;
    { Zastaveni RTO casovace }
    procedure  TcpRTOTimerStop;
    { Naplanovani RTO casovace }
    procedure  TcpRTOTimerRestart;

    procedure  TcpRTOBeginEstimate( ASeq: Longint );
    { Nastaveni hodnot RTO, SRTT a RTTVAR podle naposledy namerene
    { hodnoty RTT (Round Trip Time) }
    { ARTT je milisekundach }
    procedure  TcpRTOUpdate( ARTT: Longint );
    { Obsluha RTO casovace }
    procedure  TcpRTOTimerExpired;

    {------------------------------------------------------------}
    { Metody pro praci s back logem                              }
    {------------------------------------------------------------}

    function  TcpBacklogAccept: TCoStatus;

    procedure TcpBacklogFlush;

    {------------------------------------------------------------}
    { Metody pro praci s time wait casovacem                     }
    {------------------------------------------------------------}

    { Spusteni casovace Time Wait }
    procedure TcpTimeWaitTimerStart;

    { Zastaveni casovace Time Wait }
    procedure TcpTimeWaitTimerStop;

    { Obsluhe Time Wait casovace }
    procedure TcpTimeWaitTimerExpired;


    { Metoda volana pri tvrde chybe, spojeni je okamzite ukonceno,
      vsechny pozadavky na vysilani, prijem, navazani, prip. ukonceni
      spojeni jsou vraceny s chybou }
    procedure TcpError( AStatus: TCoStatus );


    function  TcpCreateChildSocket( ASynSegment: PCoPacket;
                var ADevice: PCoDevice ): TCoStatus;


    function  TcpSetRemoteAddr( AAddress: PTcpAddress ): TCoStatus;

    function  TcpResetRemoteAddr: TCoStatus;

    { Funkce zvoli nahodne pocatecni seq cislo pro vysilane oktety }

    function  TcpChooseISN( ALocalAddr, ARemoteAddr: PTcpAddress ): Longint;

    function  TcpIsValidAddress( AAddress : PTcpAddress; ALocal: Boolean ): Boolean;


    procedure TcpReceiveSegment( APacket: PCoPacket );


    function  TcpBind_1( AFlags: Word;
                AHandle: PCoRequest ): TCoStatus;

    function  TcpBind_2( AFlags: Word ): TCoStatus;


    function  TcpUnbind_1( AFlags: Word; AHandle: PCoRequest ): TCoStatus;


    function  TcpSetOptString( AParams: PString ): TCoStatus;

    function  TcpGetOptString( ABuffer: PString; ABuffSize: Word ): TCoStatus;


    function  MiniportInit( var ADevParams: TCoDeviceParameters ):
                Boolean; virtual;

    procedure MiniportDone; virtual;

    {function  MiniportSendPacket( APacket: PCoPacket; AFlags: Word;
                AAddress: PCoAddress; AHandle: PCoRequest ):
                TCoStatus; virtual;}

    function  MiniportSendBuffer( ABuffer: Pointer; ABuffSize: Word;
                AFlags: Word; AAddress: PCoAddress;
                AHandle: PCoRequest ): TCoStatus; virtual;


    function  MiniportRecvBuffer( ABuffer: Pointer; ABuffSize: Word;
                ARecvLen: PWord; AFlags: Word; AAddress: PCoAddress;
                AHandle: PCoRequest ): TCoStatus; virtual;


    function  MiniportIoctl( AClassId: Word; AFlags: Word; ACode: Word;
                ABuffer: Pointer; ABuffSize: Word; AHandle: PCoRequest ):
                TCoStatus; virtual;

    function  MiniportConnect( AAddress: PCoAddress; AFlags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;

    function  MiniportDisconnect( AFlags: Word; AHandle: PCoRequest ):
                TCoStatus; virtual;

    function  MiniportBind( AAddress: PCoAddress; AFlags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;

    function  MiniportUnbind( AFlags: Word; AHandle: PCoRequest ):
                TCoStatus; virtual;


    function  MiniportAccept( AAddress: PCoAddress; var AComBase: PCoDevice;
                AFilter: TCoAcceptFilterProc; Flags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;

    function  MiniportListen( ABacklog: Word; AFlags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;


    procedure MiniportCancel( ACancelAll: Boolean ); virtual;


    function  MiniportSetOption( ALevel: Word; AOption: Word;
                ABuffer: Pointer; ABuffSize: Word; AFlags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;

    function  MiniportGetOption( ALevel: Word; AOption: Word;
                ABuffer: Pointer; ABuffSize: Word; AFlags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;


    procedure MiniportTimer( ATimer: PCoTimer; ACtxWord: Word;
                ACtxPtr: Pointer ); virtual;

    procedure MiniportTick; virtual;

    function  MiniportStatusToStr( AStatus: TCoStatus;
                var AResult: TCoErrString ): Boolean; virtual;

    { async funkce }
    function  ProtocolReceiveFilter( APacket: PCoPacket{;
                UserVal: Word} ): Boolean; virtual;

    procedure ProtocolReceive( APacket: PCoPacket ); virtual;

    function  ProtocolBindComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolUnbindComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

(*  function  ProtocolConnectComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolDisconnectComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;
*)
    function  ProtocolIoctlComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolGetOptionComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolSetOptionComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolSendComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;
(*
    procedure ProtocolSignal( ASignal: PCoSignal ); virtual;
*)

  end;



  {=======================================================================}
  { TCoTcpProtoDeviceList                                                 }
  {=======================================================================}

  { Pokud pri registraci specifikujeme pouze DstPort a polozky
    SrcAddr a StcPort ponechame nulove, pak bude TCP Multiplexer
    smerovat do nasi zasuvky vsechny pakety bez ohledu na zdrojovou stanici }

  PTcpMuxSelector = ^TTcpMuxSelector;
  TTcpMuxSelector = record
    SrcAddr : TIpAddress;                { Adresa vzdalene stanice         }
    SrcPort : Word;                      { Port na vzdalene stanici        }
    DstPort : Word;                      { Port na lokalni stanici         }
  end;


  PTcpMuxDeviceListItem = ^TTcpMuxDeviceListItem;
  TTcpMuxDeviceListItem = record
    Device   : PCoDevice;                { Zarizeni lokalni TCP zasuvky    }
    Selector : TTcpMuxSelector;
    Next     : PTcpMuxDeviceListItem;    { Ukazatel na dalsi zaznam v tab. }
  end;


  PATcpMuxDeviceListItem = ^TATcpMuxDeviceListItem;
  TATcpMuxDeviceListItem = array[0..$FFF8 div
    SizeOf( PTcpMuxDeviceListItem )] of PTcpMuxDeviceListItem;


  PTcpMuxDeviceList = ^TTcpMuxDeviceList;
  TTcpMuxDeviceList = object( TCoDeviceList )

    { Hash tabulka prijimajicich TCP zasuvek }

    Table     : PATcpMuxDeviceListItem;
    TableSize : Integer;

    constructor Init( ATableSize: Integer );
    destructor Done; virtual;

  {---- vsehchny nasledujici funkce musi byt synchronizovane a reentrantni }

    { Param je ukazatel na strukturu TTcpMuxSelector, ktera specifikuje
      parametry prichozich paketu, ktere chceme prijimat }

    function  AddDevice( ADevice: PCoDevice; ASubId: Integer; Param: Pointer;
                ParamSize: Word ): TCoStatus; virtual;

    function  RemoveDevice( ADevice: PCoDevice;
                ASubId: Integer ): TCoStatus; virtual;

    function  ChangeDeviceParam( ADevice: PCoDevice; ASubId: Integer;
                Param: Pointer; ParamSize: Word): TCoStatus; virtual;

    function  DispatchPacket( APacket: PCoPacket ): TCoStatus; virtual;
    function  DispatchSignal( ASignal: PCoSignal ): TCoStatus; virtual;

  end;


  {=======================================================================}
  { TCoTcpMux                                                             }
  {=======================================================================}

  { Multiplexer TCP protokolu,
  }

  PCoTcpMux = ^TCoTcpMux;
  TCoTcpMux = object( TCoDevice )

    TCPMUX_TempHandle  : PCoRequest;   { Pomocny handle pozadavku          }
    TCPMUX_Bound       : Boolean;      { Priznak asociovane lokalni adresy }

    TCPMUX_ReqList     : TCoDeviceRequestQueue;

    function  TcpMuxBind( AAddress: PCoAddress; AFlags: Word ): TCoStatus;
    function  TcpMuxUnbind( AFlags: Word ): TCoStatus;

  {------}

    function  MiniportInit( var ADevParams: TCoDeviceParameters ):
                Boolean; virtual;

    procedure MiniportDone; virtual;

    function  MiniportSendPacket( APacket: PCoPacket; AFlags: Word;
                AAddress: PCoAddress; AHandle: PCoRequest ):
                TCoStatus; virtual;

    function  MiniportBind( AAddress: PCoAddress; AFlags: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;

    function  MiniportUnbind( AFlags: Word; AHandle: PCoRequest ):
                TCoStatus; virtual;

    function  MiniportIoctl( ALevel: Word; AFlags: Word; ACode: Word;
                ABuffer: Pointer; ABuffSize: Word;
                AHandle: PCoRequest ): TCoStatus; virtual;


    procedure MiniportCancel( ACancelAll: Boolean ); virtual;

    { async funkce }
    function  ProtocolReceiveFilter( APacket: PCoPacket{;
                UserVal: Word} ): Boolean; virtual;

    procedure ProtocolReceive( APacket: PCoPacket ); virtual;


    function  ProtocolSendComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolBindComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolUnbindComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

    function  ProtocolIoctlComplete( AHandle: PCoRequest;
                Status: TCoStatus ): Boolean; virtual;

  end;



implementation

const

  RQ_SEND_CONCURENT = [RQ_TYPE_SENDBUFFER, RQ_TYPE_CONNECT, RQ_TYPE_DISCONNECT,
                       RQ_TYPE_UNBIND, RQ_TYPE_IOCTL ];

const

  TcpMuxName  : String[6] = 'TCPMUX';

  TcpMuxClass : TCoDeviceClass =
   ( ClassName : @TcpMuxName;
     ClassId   : DEV_CLASS_TCPMUX;
     VmtLink   : Ofs(TypeOf(TCoTcpMux)^);
     Init      : @TCoTcpMux.Init
   );


  TcpName     : String[3] = 'TCP';

  TcpClass : TCoDeviceClass =
   ( ClassName : @TcpName;
     ClassId   : DEV_CLASS_TCP;
     VmtLink   : Ofs(TypeOf(TCoTcp)^);
     Init      : @TCoTcp.Init
   );



type

  TPseudoHeader = packed
  record
    Source   : TIpAddress;     { Zdrojova IP adresa                }
    Dest     : TIpAddress;     { Cilova IP adresa                  }
    Unused   : Byte;           { = 0                               }
    Protocol : Byte;           { Cislo protokolu                   }
    Length   : Word;           { Delka dat a hlavicky TCP segmentu }
  end;


const

  TCP_MAX_RTO  = 60 * 1000; { Maximalni retransmittion timeout (ms) }
  TCP_MIN_RTO  = 1  * 1000; { Minimalni retransmittion timeout (ms) }

type

  {---------------------------------------------}
  { Info struktura pozadavku ve vysilaci fronte }

  PTcpTxUserBlock = ^TTcpTxUserBlock;
  TTcpTxUserBlock = record

    QLink     : TCoDeviceRequestQueueLink; { Musi byt na zacatku TTcpUserBlock !!!}

    BuffSeq   : Longint;
    BuffPtr   : Pointer;
    BuffSize  : Word;

  { V pripade, ze uzivatel pri vysilani uvede priznak COF_COPY
    pak se vytvori v ramci TCP vrstvy extra request a data
    se prekopiruji do nove alokovaneho bloku.. Ukazatel na tyto data
    je uveden v polozce OrigPtr a jejich velikost je v OrigSize.
    Pokud je OrigPtr <> nil, je potreba po odvysilani totoho pozadavku
    tyto data uvolnit a vysledek operace se nikam nepredava.
    Pokud je OrigPtr = nil, pak se jedna o bezny pozadavek, ktery
    se preda aplikacni vrstve pomoci UpperComplete }

    OrigPtr   : Pointer;
    OrigSize  : Word;

    Reserved  : array[0..3] of Byte;
  end;

  {---------------------------------------------}
  { Info struktura pozadavku v prijimaci fronte }

  PTcpRxUserBlock = ^TTcpRxUserBlock;
  TTcpRxUserBlock = record

    QLink     : TCoDeviceRequestQueueLink;

    BuffPtr   : Pointer;   { Ukazatel na buffer                }
    BuffSize  : Word;      { Celkova velikost bufferu          }
    Written   : Word;      { Pocet zapsanych bajtu             }

    InMiniportRecv : Boolean;

    Reserved  : array[0..11] of Byte;
  end;

const

  TCP_PKT_NORMAL        = 0;  { Bezny segment }
  TCP_PKT_UNBIND        = 1;  { Posledni RST segment, poslany v unbind }

type


  {-------------------------------------------------------------}
  { Info struktura pozadavku na vysilani predaneho nizsi vrstve }

  PTcpSentUserBlock = ^TTcpSentUserBlock;
  TTcpSentUserBlock = record
    QLink      : TCoDeviceRequestQueueLink;

    Packet     : PCoPacket;  { Vysilany paket }
    Address    : TIpAddress; { Adresa stanice }
    RetryCount : Integer;    { Kolikrat se pokus o vysilani jeste muze opakovat }

    Context    : Word;       { V jake souvislosti byl paket odeslan .. TCP_PKT_xxx }

    {.. mozna pribyde cilova adresa... uvidime az podle ProtocolComplete..}

    Reserved   : array[0..9] of Byte;
  end;


  {-------------------------------------------------------------}
  { Info struktura ostatnich pozadavku                          }
  { Bind, Unbind, Connect, Disconnect ...                       }

const

  TCP_REQ_UPPER = 0;
  TCP_REQ_BIND  = 1;

type

  PTcpUserBlock = ^TTcpUserBlock;
  TTcpUserBlock = record
    QLink      : TCoDeviceRequestQueueLink;
    ReqType    : Word;
    Reserved   : array[0..17] of Byte;
  end;


  {-------------------------------------------------------------}
  { Info struktura pozadavku tridy TCPMUX                       }

const

  TCPMUX_REQ_UPPER   = 0;
  TCPMUX_REQ_ICMPMSG = 1;

type

  PTcpMuxUserBlock = ^TTcpMuxUserBlock;
  TTcpMuxUserBlock = packed record
    ReqType  : Word;
    QLink    : TCoDeviceRequestQueueLink;
    Packet   : PCoPacket;
    Icmp     : TIoctlIcmpDestUnreach;
    Reserved : array[23..31] of Byte;
  end;


  function IsValidTcpPort( Port: Longint ): Boolean;
  begin
    IsValidTcpPort := (Port >= 1) and (Port <= 65535);
  end;


  function IsValidTcpAddress( Addr: PTcpAddress ): Boolean;
  begin
    IsValidTcpAddress := (Addr^.Size = SizeOf( TTcpAddress )) and
                         IsValidHostAddr( Addr^.Address ) and
                         IsValidTcpPort(Addr^.Port)
  end;





const

  TCP_TIMER_ACK          = 1;
  TCP_TIMER_NAGLE        = 2;
  TCP_TIMER_RETRANSMIT   = 3;
  TCP_TIMER_TIMEWAIT     = 4;


  { Identicke s funkci INC (akorat nevyvola vyjimku pri preteceni)}

  function ULONG_INC( A: Longint ): Longint; inline
   ( $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $05/$01/$00/ {     ADD  AX, 1  }
     $83/$D2/$00  {     ADC  DX, 0  }
   );

  { Identicke s funkci DEC (akorat nevyvola vyjimku pri preteceni)}

  function ULONG_DEC( A: Longint ): Longint; inline
   ( $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $2D/$01/$00/ {     SUB  AX, 1  }
     $83/$DA/$00  {     SBB  DX, 1  }
   );

  function ULONG_ADD( A, B: Longint ): Longint; inline
   ( $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $5B/         {     POP  BX     }
     $59/         {     POP  CX     }
     $03/$C3/     {     ADD  AX, BX }
     $13/$D1      {     ADC  DX, CX }
   );


  function ULONG_SUB( A, B: Longint ): Longint; inline
   ( $5B/         {     POP  BX     }
     $59/         {     POP  CX     }
     $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $2B/$C3/     {     SUB  AX, BX }
     $1B/$D1      {     SBB  DX, CX }
   );


  function ULONG_LT( A, B: Longint ): Boolean; inline
   (
     $5B/         {     POP  BX     }
     $59/         {     POP  CX     }
     $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $2B/$C3/     {     SUB  AX, BX }
     $1B/$D1/     {     SBB  DX, CX }
     $33/$C0/     {     XOR  AL, AL }
     $D1/$E2/     {     SHL  DX, 1  }
     $D1/$D0      {     RCL  AL, 1  }
   );


  function ULONG_LE( A, B: Longint ): Boolean; inline
   (
     $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $5B/         {     POP  BX     }
     $59/         {     POP  CX     }
     $2B/$C3/     {     SUB  AX, BX }
     $1B/$D1/     {     SBB  DX, CX }
     $33/$C0/     {     XOR  AL, AL }
     $F7/$D2/     {     NOT  DX, DX }
     $D1/$E2/     {     SHL  DX, 1  }
     $D1/$D0      {     RCL  AL, 1  }
   );


  function ULONG_GT( A, B: Longint ): Boolean; inline
   (
     $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $5B/         {     POP  BX     }
     $59/         {     POP  CX     }
     $2B/$C3/     {     SUB  AX, BX }
     $1B/$D1/     {     SBB  DX, CX }
     $33/$C0/     {     XOR  AL, AL }
     $D1/$E2/     {     SHL  DX, 1  }
     $D1/$D0      {     RCL  AL, 1  }
   );


  function ULONG_GE( A, B: Longint ): Boolean; inline
   (
     $5B/         {     POP  BX     }
     $59/         {     POP  CX     }
     $58/         {     POP  AX     }
     $5A/         {     POP  DX     }
     $2B/$C3/     {     SUB  AX, BX }
     $1B/$D1/     {     SBB  DX, CX }
     $33/$C0/     {     XOR  AL, AL }
     $F7/$D2/     {     NOT  DX, DX }
     $D1/$E2/     {     SHL  DX, 1  }
     $D1/$D0      {     RCL  AL, 1  }

   );


{  function ULONG_BTW( A, M1, M2: Longint ): Boolean;
  begin
  end;}



                  {     POP  AX     }
                  {     POP  DX     }  { DX:AX = A  }
                  {     POP  BX     }
                  {     POP  CX     }  { CX:BX = M1 }
                  {     SUB  BX, AX }
                  {     SBB  DX, CX }  { DX:AX = A - M1 }
                  {     POP  SI     }
                  {     POP  DI     }  { DI:SI = M2 }
                  {     SUB  SI, BX }
                  {     SBB  DI, CX }  { DI:SI = M2 - M1 }
                  {     SUB  SI, AX }
                  {     SBB  DI, DX }  { CMP DI:SI, DX:AX }



  {$IFDEF DEBUG_TCP}
  function TcpStateToStr( State: Byte ): TString16;
  begin
    case State of
      TCP_NOTBOUND      : TcpStateToStr := 'TCP_NOTBOUND';
      TCP_CLOSED        : TcpStateToStr := 'TCP_CLOSED';
      TCP_LISTEN        : TcpStateToStr := 'TCP_LISTEN';
      TCP_SYN_SENT      : TcpStateToStr := 'TCP_SYN_SENT';
      TCP_SYN_RECEIVED  : TcpStateToStr := 'TCP_SYN_RECEIVED';
      TCP_ESTABLISHED   : TcpStateToStr := 'TCP_ESTABLISHED';
      TCP_FIN_WAIT1     : TcpStateToStr := 'TCP_FIN_WAIT1';
      TCP_FIN_WAIT2     : TcpStateToStr := 'TCP_FIN_WAIT2';
      TCP_CLOSE_WAIT    : TcpStateToStr := 'TCP_CLOSE_WAIT';
      TCP_LAST_ACK      : TcpStateToStr := 'TCP_LAST_ACK';
      TCP_CLOSING       : TcpStateToStr := 'TCP_CLOSING';
      TCP_TIME_WAIT     : TcpStateToStr := 'TCP_TIME_WAIT';
    end;
  end;
  {$ENDIF}


  {----------------------------------------------------------------------}
  {  TTcpRecvBuff                                                        }
  {----------------------------------------------------------------------}


  {-------------------------------
  { TTcpRecvBuff.Initialize
  {---
  { !@#
  {---
  }

  function TTcpRecvBuff.Initialize( ASize: Word ): Boolean;
  begin
    GetMem( Buff, ASize );
    if Buff <> nil then
    begin
      Size := ASize;
      Initialize := True;
    end
    else begin
      Size := 0;
      Initialize := False;
    end;

    Head := 0;
    Tail := 0;
  end;

  {-------------------------------
  { TTcpRecvBuff.Finalize
  {---
  { !@#
  {---
  }

  procedure TTcpRecvBuff.Finalize;
  begin
    if Buff <> nil then
    begin
      FreeMem( Buff, Size );
      Size :=0 ;
    end;
  end;

  {-------------------------------
  { TTcpRecvBuff.UsedBytes
  {---
  { !@#
  {---
  }

  function TTcpRecvBuff.UsedBytes: Word;
  begin
    if Tail >= Head then
    begin
      UsedBytes := Tail - Head;
    end
    else
      UsedBytes := Size - (Head - Tail);
  end;

  {-------------------------------
  { TTcpRecvBuff.FreeBytes
  {---
  { !@#
  {---
  }

  function TTcpRecvBuff.FreeBytes: Word;
  begin
    if Tail >= Head then
    begin
      FreeBytes := Size - (Tail - Head);
    end
    else
      FreeBytes := Head - Tail;
  end;

  {-------------------------------
  { TTcpRecvBuff.Enqueue
  {---
  { !@#
  {---
  }

  procedure TTcpRecvBuff.Enqueue( ABuff: Pointer; ASize: Word );
  var
    Count : Word;
  begin
    {$IFDEF DEBUG_TCP_BUFFER}
    WriteLn( SID,  'RxBuffer.Enqueue ', ASize, ' bytes' );
    {$ENDIF}


    if Head > Tail then
    begin
      {   0          tail      head     size
          |-----------|*********|--------|
                         free
      }

      Count := Head - Tail;
      if ASize < Count then Count := ASize;
      MemCopy( @PByteArray(Buff)^[Tail], ABuff, Count );
      Inc( Tail, Count );
    end
    else begin
      {   0          head      tail     size
          |***********|---------|********|
              free                 free
      }


      { Budeme kopirovat nejspis na dvakrat }

      Count := Size - Tail;

      if ASize <= Count then
      begin
        MemCopy( @PByteArray(Buff)^[Tail], ABuff,  ASize );
        Inc( Tail, ASize );
      end
      else begin
        MemCopy( @PByteArray(Buff)^[Tail],  ABuff, Count );
        Tail := ASize - Count;
        MemCopy( Buff, @PByteArray(ABuff)^[ Count ], Tail );
      end;
    end;

    if Tail = Size then Tail := 0;
  end;

  {-------------------------------
  { TDataRoundBuff.Dequeue
  {---
  { !@#
  {---
  }

  function  TTcpRecvBuff.Dequeue( AMaxSize: Word; var ASize: Word ): Pointer;
  begin
    Dequeue := @PByteArray(Buff)^[Head];

    if Head > Tail then
    begin
      {   0          tail      head     size
          |************|---------|********|
              used                  used
      }

      if AMaxSize > Size - Head then
      begin
        ASize := Size - Head;
        Head := 0;
      end
      else begin
        ASize := AMaxSize;
        Inc( Head, ASize );
      end;

    end
    else begin
      {   0          head      tail     size
          |-----------|*********|--------|
                         used
      }

      if AMaxSize > Tail - Head then
      begin
        ASize := Tail - Head;
        Inc( Head, ASize );

        if Head = Size then
        begin
          Head := 0;
          Tail := 0;
        end;
      end
      else begin
        ASize := AMaxSize;
        Inc( Head, ASize );
      end;

    end;

    {$IFDEF DEBUG_TCP_BUFFER}
    WriteLn( SID,  'RxBuffer.Dequeue ', ASize, ' bytes' );
    {$ENDIF}

  end;

  {----------------------------------------------------------------------}
  {  TCoTCP                                                              }
  {----------------------------------------------------------------------}

  function TCoTCP.SID: TString12;
  begin
    SID := WordStrDec( TCP_DefLocalAddr.Port, 0 ) + ' ';
  end;

  {-------------------------------
  { TTCoTCP.MiniportInit
  {---
  { !@#
  {---
  }

  function  TCoTCP.MiniportInit( var ADevParams: TCoDeviceParameters ):
                Boolean;
  begin

    with ADevParams do
    begin

      with Timeouts do
      begin
        SendTimeout       :=  0;
        RecvTimeout       :=  0;
        ConnectTimeout    :=  0;
        DisconnTimeout    :=  0;
        AcceptTimeout     :=  0;
        IoctlTimeout      :=  0;

        Properties := Properties or CPR_STREAM;
      end;

    end;

    CO_Heap[ hptUser ]^.Release;
    CO_Heap[ hptUser ] := New( PCoGlobalHeap, Init( 16384 ) ); { 16kB }

    CO_ClassId := DEV_CLASS_TCP;


    FillChar( TCB, SizeOf( TCB ), 0 );

    with TCP_DefLocalAddr do
    begin
      Size    := SizeOf( TTcpAddress );
      Port    := 5000;
      Address := MakeIpAddr( 0, 0, 0, 0 );
    end;

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


    with TCP_Settings do
    begin
      RTLimit        := 10;           { Max. pocet opakovani             }
      RTSynLimit     := 3;            { Max. pocet opakovani SYN segmentu}
      TimeWaitDelay  := 0;       {ms} { Cekani v TIME_WAIT               }
      NagleDelay     := 200;     {ms} { Zpozdene odesilani dat, 0=off    }
      AckDelay       := 200;     {ms} { Zpozdene odesilani potvrzeni     }
      MinWindow      := 4096;    {B}  { Maximalni velikost okna          }
      MaxWindow      := 4096;    {B}  { Minimalni velikost okna          }
    end;


    { Fronta TCP_TxQ -- fronta pozadavku na vysilani }

    TCP_TxQ.Initialize;

    TCP_TxQ_NXT := nil;

    { Fronta TCP_RxQ -- fronta pozadavku na prijem }

    TCP_RxQ.Initialize;

    TCP_RxQSize   := 0;

    { Kruhovy prijimaci buffer }

{    TCP_RxBuffer.Initialize( TCP_Settings.MaxWindow ); -- provadi MiniportBind}

    { Out-of-order fronta }

    {!@# Casem mozna omezit pocet polozek v OFO fronte... }
    TCP_OFOQueue.Initialize( 0 { MaxCount } );

    { Fronta pozadavku na vysilani poslanych nizsi vrstve }
    TCP_SentList.Initialize;


    TCP_Passive := False;

    with TCP_Accept do
    begin
      Handle  := nil;
      Device  := nil;
      BackLog.Initialize( 0 );
    end;

    TCP_ReqList.Initialize;


    with TCP_Ack do
    begin
      QuickMode := False;
      Scheduled := False;
    end;


    TcpRTOInit;


    TCP_FINSent := False;

    TCP_ClosePending := False;

    TCP_CloseHandle  := nil;

    TCP_OpenHandle   := nil;

    CO_RecvDeviceList := New( PTcpMuxDeviceList, Init( 7 ) );

    MiniportInit := CO_RecvDeviceList <> nil;

    UpperEnableReceive;

    TCB.State := TCP_NOTBOUND;

  end;


  {-------------------------------
  { TTCoTCP.MiniportDone
  {---
  { !@#
  {---
  }


  procedure TCoTCP.MiniportDone;
  begin

    { Kruhovy prijimaci buffer }

    TCP_RxBuffer.Finalize;

    { Out-of-order fronta }

    TCP_OFOQueue.Finalize;

    with TCP_Accept do
    begin
      BackLog.Finalize;
    end;

  end;


  {-------------------------------
  { TTCoTCP.__TcpSendSegment
  {---
  { !@#
  {---
  }


  function  TCoTCP.__TcpSendSegment( APacket: PCoPacket; AIpAddress: TIpAddress; ACtx: Word ): TCoStatus;
  var
    User      : PTcpSentUserBlock;
    Request   : PCoRequest;
    Status    : TCoStatus;
    IpDevAddr : TIpDevAddress;
  begin

    Request := CoAllocRequest( hptUser );

    if Request <> nil then
    begin
      User := PTcpSentUserBlock( @CoGetDeviceSlot( Request )^.User );

      with User^ do
      begin
        Packet     := APacket;
        Address    := AIpAddress;
        Packet^.AddRef;
        Context    := ACtx;
        RetryCount := 2;     { Dva pokusy o vyslani po chybe }

      end;

      repeat

        { Odesleme pripraveny segment }

        IpDevAddr.Size     := SizeOf( TIpDevAddress );
        IpDevAddr.Node     := AIpAddress;
        IpDevAddr.Protocol := IP_PROTO_TCP;

        Status := LowerSendPacketTo( APacket, 0, @IpDevAddr , Request );

        if Status = CST_PENDING then
        begin
          { Paket byl predan nizsi vrstve.. zbytek v ProtocolSendComplete }
          TCP_SentList.InsertTail( @User^.QLink, Request );
          Break;
        end
        else begin

          if (Status <> CST_SUCCESS) and (User^.RetryCount > 0) then
          begin
            Dec( User^.RetryCount );
            Continue;  { Pokusime se jeste jednou.. }
          end;

          { Bud uspech nebo jsme vycerpali vsechny pokusy }
          CoReleasePacket( User^.Packet );
          CoFreeRequest( Request );

          Break;
        end;

      until False; { nekonecna smycka }

    end
    else
      Status := CST_ERR_MEMOVF;

    __TcpSendSegment := Status;
  end;

  {-------------------------------
  { TTCoTCP.TcpSendSegment
  {---
  { !@#
  {---
  }


  function  TCoTCP.TcpSendSegment( APacket: PCoPacket; ASeq, AAck: Longint;
    ACtrl: Word; AAddress: PTcpAddress; ACtx: Word ): TCoStatus;
  type

    PTcpHeader_MSS = ^TTcpHeader_MSS;
    TTcpHeader_MSS = packed
    record
      Header : TTcpHeader;
      Kind   : Byte;         { 4 bajty, neni potreba End Of List Option }
      Length : Byte;
      MSS    : Word;
    end;

  var

    Status    : TCoStatus;
    Header    : PTcpHeader;
    HdrLen    : Byte;

    PseudoHdr : TPseudoHeader;

  begin

    if ACtrl and TCP_CTRL_MSS <> 0 then
    begin
      { Do hlavicky pribalime option MSS }

      ACtrl := ACtrl and not TCP_CTRL_MSS;

      HdrLen := SizeOf( TTcpHeader_MSS );;

      Header := APacket^.AddHeader( SizeOf( TTcpHeader_MSS ) );

      with PTcpHeader_MSS( Header )^ do
      begin
        Kind   := TCP_OPT_MSS;
        Length := 4;
        MSS    := Swap( CO_DeviceState.MTU - MAX_TCP_HEADER_SIZE );
      end;

    end
    else begin
      { Standardni kratka hlavicka bez options }
      HdrLen := SizeOf( TTcpHeader );
      Header := APacket^.AddHeader( SizeOf( TTcpHeader ) );
    end;

    with Header^ do
    begin
      SourcePort := Swap( TCP_LocalAddr.Port );
      DestPort   := Swap( AAddress^.Port );
      SeqNumber  := SwapL( ASeq );
      AckNumber  := SwapL( AAck );
      DataOfs    := (HdrLen div 4) shl 4;
      Control    := ACtrl;
      {$IFDEF DEBUG_TCP_WND}
      WriteLn( SID,  'TcpSendSegment() WND=', TCB.RCV.WND );
      {$ENDIF}
      Window     := Swap( TCB.RCV.WND );
      Checksum   := 0;
      UrgPtr     := 0;
    end;

    { Do kontrolniho souctu se zapocitava i tzv. pseudo hlavicka }

    with PseudoHdr do
    begin
      Source     := SwapL( TCP_LocalAddr.Address );
      Dest       := SwapL( AAddress^.Address );
      Unused     := 0;
      Protocol   := IP_PROTO_TCP;
      Length     := Swap( APacket^.DataSize );
    end;

    Header^.CheckSum := Swap(
      IpCheckSumEx( APacket^.DataPtr, APacket^.DataSize,
        IpCheckSum( @PseudoHdr, SizeOf( PseudoHdr ) ) ) );

    TcpSendSegment := __TcpSendSegment( APacket, AAddress^.Address, ACtx );

  end;


  {-------------------------------
  { TTCoTCP.TcpSendCtrlSegment
  {---
  { !@#
  {---
  }


  function  TCoTCP.TcpSendCtrlSegment( ASeq, AAck: Longint; ACtrl: Word;
    AAddress : PTcpAddress; ACtx: Word ): TCoStatus;
  var
    Packet : PCoPacket;
    Status : TCoStatus;
  begin
    { Alokujeme prazdny paket, delka dat = 0 }
    Packet := CoAllocPacket( MAX_TCP_HEADER_SIZE, 0 {Data}, 0, hptCtrl );

    if Packet <> nil then
    begin
      Status := TcpSendSegment( Packet, ASeq, AAck, ACtrl, AAddress, ACtx );
      Packet^.Release;
    end
    else
      Status := CST_ERR_MEMOVF;

    TcpSendCtrlSegment := Status;
  end;


  {-------------------------------
  { TTCoTCP.TcpSendFIN
  {---
  { !@#
  {---
  }


  { Metoda TcpTxQTransmit odesle cast vysilaci fronty nizsi vrstve.
    Vysila se pocinaje oktetem s poradovym cislem ASeq blok o velikosti
    ASize. Metoda zformuje jeden nebo vice segmentu o maximalni mozne
    delce a odesle je pomoci LowerSendBufferTo. Pro kazdy odeslany
    segment metoda musi vytvorit zvlastni Request, ktery se musi zrusit
    v metode ProtocolSendComplete. Metoda neposunuje zadna ukazovatka
    v TCB strukture ani TXP_TxQ_NXT }
  { Vraci True, pokud byl odeslan FIN }
  function  TCoTCP.TcpTxQTransmit( ASeq, ASize: Longint; ACtrl: Word ): Boolean;
  var
    Link      : PCoDeviceRequestQueueLink;
    User      : PTcpTxUserBlock absolute Link;

    BuffPtr   : Pointer;
    BuffSize  : Word;

    Packet    : PCoPacket;

    PktPtr    : Pointer;
    PktSize   : Word;

    PartSize  : Word;

    FirstFlag : Boolean;

    Ctrl      : Word;

  begin
    TcpTxQTransmit := False;

    {$IFDEF DEBUG_TCP_TX}
    WriteLn( SID,  'TcpTxQTransmit Seq=', ASeq, ' Size=', ASize );
    {$ENDIF}

    {!@# muzeme taky zacit s TCP_TxQ_NXT misto s TXP_TxQ.Head }

    ACtrl := ACtrl or TCP_CTRL_ACK;

    { Nejprve najdeme buffer, se kterym zacneme }

    Link := TCP_TxQ.Head;

    while (Link <> nil) and
          ULONG_GE( ASeq, ULONG_ADD( User^.BuffSeq, User^.BuffSize)) do
    begin
      Link := Link^.Next;
    end;

    { TCP_MTU }

    if Link <> nil then
    begin

      { BuffPtr je ukazatel do bufferu aplikacni vrstvy }
      { BuffSize je velikost bufferu aplikacni vrstvy }

      BuffPtr  := User^.BuffPtr;
      Inc( PtrRec(BuffPtr).Ofs, ULONG_SUB( ASeq, User^.BuffSeq) );
      BuffSize := User^.BuffSize - ULONG_SUB( ASeq, User^.BuffSeq );

      FirstFlag := True;

      while (Link <> nil) and (ASize > 0) do
      begin

        { Vypocteme jak velky bude odesilany paket }

        PktSize := ASize;
        if PktSize > TCB.SND.MSS then PktSize := TCB.SND.MSS;

        { Alokujeme paket o velikosti maximalne MSS nebo poctu
          oktetu, ktere zbyvaji jeste odeslat }

        Packet := CoAllocPacket( MAX_TCP_HEADER_SIZE, PktSize, 0, hptUser ) ;

        if Packet <> nil then
        begin

          { PktOfs je offset do bufferu paketu, ktery se odesle nizsi vrstve }
          PktPtr  := Packet^.DataPtr;

          repeat

            { Zjistime kolik dat se bude z aplikacniho bufferu kopirovat }
            if BuffSize < PktSize then
            begin
              PartSize := BuffSize;  { Kopirujeme cely aplikacni bufferu }
            end
            else
              PartSize := PktSize;   { Kopirujeme jen cast aplikacniho b. }

            { Zkopirujeme data }
            MemCopy( PktPtr, BuffPtr, PartSize );

            { Posuneme ukazovatko v bufferu paketu za zkopirovana data }
            Inc( PtrRec(PktPtr).Ofs, PartSize );

            { Posuneme ukazovatko v aplikacnim bufferu }
            Dec( BuffSize, PartSize );

            Dec( PktSize, PartSize );

            if BuffSize = 0 then
            begin
              { Posuneme se na dalsi aplikacni buffer }
              Link := Link^.Next;
              { User == Link!! }
              if Link = nil then Break;

              BuffPtr := User^.BuffPtr;
              BuffSize := User^.BuffSize;
            end
            else
              Inc( PtrRec(BuffPtr).Ofs, PartSize );

          until PartSize = 0;

          { Zkratime pripraveny paketu jen na velikost dat, ktere
            jsme do nej zapsali }
          Packet^.RemoveTrailer( PktSize );

          { Snizime celkovy pocet oktetu k odeslani }
          Dec( ASize, Packet^.DataSize );

          { Odeslani segmentu.. }

          { Urcime priznaky, ktere pouzijeme pro odeslani segmentu.. }
          { MSS, SYN posilame jen u prvniho segmentu  }
          { ACK posilame u kazdeho segmentu           }
          { PSH, FIN posilame u posledniho segmentu   }

          if not FirstFlag then
          begin
            Ctrl := Ctrl and not (TCP_CTRL_MSS or TCP_CTRL_SYN);
          end
          else begin
            Ctrl := ACtrl;
            FirstFlag := False;
          end;

          PktSize := Packet^.DataSize;

          if TCP_ClosePending and (ASize = 0) and
             ULONG_GE( ULONG_ADD( ASeq, PktSize ), TCB.SND.WRI) then { je to posledni segment }
          begin
            { Posledni segment -- posleme FIN pokud se uzavira spojeni }
            {$IFDEF DEBUG_TCP_TX}
            WriteLn( SID,  'TcpTxQTransmit: appending FIN bit to segment ', ASeq );
            {$ENDIF}

            Ctrl := ACtrl or TCP_CTRL_FIN;
            TCP_FINSent := True;
            TcpTxQTransmit := True;
          end;

          TcpSendSegment( Packet, ASeq {SEQ}, TCB.RCV.NXT {ACK} , Ctrl,
            @TCP_RemoteAddr, TCP_PKT_NORMAL );

          {!@# co se statusem TcpSendSegment..?}

          { !! zde nelze pouzit Packet^.DataSize, protoze
            TcpSendSegment prodlouzi delku paketu minimalne o TCP hlavicku }
          Inc( ASeq, PktSize );

          CoReleasePacket( Packet );

        end
        else begin
          Break;
          { Nebyl naalokovan paket }
          { Chyba..MemOvf..}
        end;

      end;

    end;

  end;


  { Metoda TcpTxQCommit provadi dokonceni obsluhy pozadavku na vysilani.
    Po provedeni jsou vsechny pozadavky na vysilani oktetu s poradovym
    cislem mensim nez ASeq vraceny zpet aplikacni vrstve s navratovym
    kodem CST_SUCCESS. Tyto pozadavky jsou z vysilaci fronty odstraneny.
    Metoda neposunuje zadna ukazovatvka v TCB strukture ani TXP_TxQ_NXT }
  procedure TCoTCP.TcpTxQCommit( ASeq: Longint );
  var
    Link : PCoDeviceRequestQueueLink;
    User : PTcpTxUserBlock absolute Link;
  begin
    Link := TCP_TxQ.Head;

    while (Link <> nil) and
          (ASeq >= ULONG_ADD( User^.BuffSeq, User^.BuffSize)) do
    begin
      TCP_TxQ.RemoveHead;

      if User^.OrigPtr = nil then
      begin
        UpperComplete( Link^.Request, CST_SUCCESS );
      end
      else begin
        { Prekopirovany pozadavek pomoci COF_COPY }
        { Uvolnime data }
        CO_Heap[ hptUser ]^.FreePtr( User^.OrigPtr, User^.OrigSize );
        { Uvolnime pozadavek }
        CoFreeRequest( Link^.Request );
      end;

      Link := TCP_TxQ.Head;
    end;

  end;

  { Metoda TcpTXQFlush provadi vyprazdneni cele vysilaci fronty. Vsechny
    pozadavky jsou vraceny aplikacni vrstve s navratovym kodem AStatus.
    Metoda neposunuje zadna ukazovatka v TCB strukture ani TXP_TxQ_NXT }
  procedure TCoTCP.TcpTxQFlush( AStatus: TCoStatus );
  var
    Link : PCoDeviceRequestQueueLink;
    User : PTcpTxUserBlock absolute Link;
  begin
    Link := TCP_TxQ.RemoveHead;
    while Link <> nil do
    begin

      if User^.OrigPtr = nil then
      begin
        UpperComplete( Link^.Request, AStatus );
      end
      else begin
        { Prekopirovany pozadavek pomoci COF_COPY }
        { Uvolnime data }
        CO_Heap[ hptUser ]^.FreePtr( User^.OrigPtr, User^.OrigSize );
        { Uvolnime pozadavek }
        CoFreeRequest( Link^.Request );
      end;

      Link := TCP_TxQ.RemoveHead;
    end;
  end;

  { Metoda TcpTxQInsert provadi vlozi pozadavek na vysilani na konec
    vysilaci fronty.
  }
  function  TCoTCP.TcpTxQInsert( ARequest: PCoRequest;
    ABuffer: Pointer; ABuffSize: Word ): TCoStatus;
  var
    User : PTcpTxUserBlock;

    FreeSpace : Word;      { Pro kopirovani }
    FreePtr   : Pointer;   { Pro kopirovani }
  begin
    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpTxQInsert() ', ABuffSize, ' bytes' );
    {$ENDIF}

    {..}

    if ARequest = nil then
    begin

      { Pokud neni specifikovat request z aplikacni vrstvy, pak
        vytvorime vlastni a data prekopirujeme nove alokovaneho bufferu }


      if TCP_TxQ.Tail <> nil then
      begin
       { Pokud uz ve vysilaci fronte je nejaky request, pak zjistime
         zda data nemuzeme prikopirovat rovnou k nemu }
       User := PTcpTxUserBlock( TCP_TxQ.Tail );

       if User^.OrigPtr <> nil then
       begin
         { Zjistime kolik zbyva mista v poslednim requestu }

         FreeSpace := User^.OrigSize - User^.BuffSize -
               (PtrRec(User^.OrigPtr).Ofs - PtrRec( User^.BuffPtr ).Ofs);

         { Pripadne zkratime }

         if FreeSpace > ABuffSize then FreeSpace := ABuffSize;

         { Je co a kam kopirovat ? }
         if FreeSpace > 0 then
         begin
           {$ifdef DEBUG_TXP_TX_COPY}
           WriteLn( SID,  'TcpTxQInsert: copy data to recent request [', FreeSpace, ']' );
           {$endif}

           { Kam budeme kopirovat }
           FreePtr := User^.BuffPtr;
           Inc( PtrRec( FreePtr ).Ofs, User^.BuffSize );

           { Zkopirujeme data }
           MemCopy( FreePtr, ABuffer, FreeSpace );

           { Upravime ukazovatka }
           Inc( User^.BuffSize, FreeSpace );

           { Upravime lokalni promenne; pro zbytek alokujeme
             novy buffer }
           Inc( PtrRec( ABuffer ).Ofs, FreeSpace );
           Dec( ABuffSize, FreeSpace );
         end;
       end;
      end;


      if ABuffSize > 0 then
      begin
        { Zbyly nejake data, pro ktere musime vytvorit extra pozadavek }

        { Alokujeme pozadavek }
        ARequest := CoAllocRequest( hptUser );

        if ARequest <> nil then
        begin
          User := PTcpTxUserBlock( @CoGetDeviceSlot( ARequest )^.User );

          FreeSpace := 128;
          if ABuffSize > FreeSpace then FreeSpace := ABuffSize;

          User^.OrigPtr := CO_Heap[ hptUser ]^.AllocPtr( FreeSpace );

          {$ifdef DEBUG_TXP_TX_COPY}
          WriteLn( SID,  'TcpTxQInsert: copy data to new request [', ABuffSize, ']' );
          {$endif}

          if User^.OrigPtr <> nil then
          begin
            User^.OrigSize := FreeSpace;
            MemCopy( User^.OrigPtr, ABuffer, ABuffSize );
            ABuffer := User^.OrigPtr;
          end
          else begin
            CoFreeRequest( ARequest );
            TcpTxQInsert := CST_ERR_MEMOVF;
            Exit;
          end;
        end
        else begin
          TcpTxQInsert := CST_ERR_MEMOVF;
          Exit;
        end;

      end;

    end
    else begin
      User := PTcpTxUserBlock( @CoGetDeviceSlot( ARequest )^.User );
      User^.OrigPtr := nil;
    end;

    if ABuffSize > 0 then
    begin

      { Do user struktury zapiseme ukazatel na buffer, jeho delku,
        a cislo prvniho oktetu v bufferu. Tyto ukazovatka
        se v prubehu vysilani posunuji }

      with User^ do
      begin
        BuffPtr  := ABuffer;   { Ukazatel na data }
        BuffSize := ABuffSize; { Delka dat }

        if TCP_TxQ.Tail = nil then
        begin
          BuffSeq := TCB.SND.NXT;
        end
        else begin
          BuffSeq := ULONG_ADD( PTcpTxUserBlock(TCP_TxQ.Tail)^.BuffSeq,
                       PTcpTxUserBlock(TCP_TxQ.Tail)^.BuffSize);
        end;

      end;

      TCP_TxQ.InsertTail( @User^.QLink, ARequest );

    end;

    TcpTxQInsert := CST_SUCCESS;
  end;


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



  { Metoda TcpRxQInsert vlozi do prijimaci fronty pozadavek. Spolu s
    pozadavkem je v teto fronte ulozena adresa a velikost bufferu
    aplikacni vrstvy. Pozadavky ve fronte budou vraceny aplikacni
    vrstve az po zavolani nektere z metoda TcpRxQCommit, TcpRxQFlush.
    Metoda nastavuje polozku TCP_RxQSize }
  procedure TCoTCP.TcpRxQInsert( ARequest: PCoRequest;
    ABuffer: Pointer; ABuffSize: Word );
  var
    User : PTcpRxUserBlock;
  begin

    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpRxQInsert()', ABuffSize, ' bytes' );
    {$ENDIF}


    User := PTcpRxUserBlock( @CoGetDeviceSlot( ARequest )^.User );

    with User^ do
    begin
      BuffPtr  := ABuffer;
      BuffSize := ABuffSize;
      Written  := 0;

      InMiniportRecv := False;
    end;

    Inc( TCP_RxQSize, ABuffSize );

    TCP_RxQ.InsertTail( @User^.QLink, ARequest );
  end;

  { Metoda TcpRxQCommit prekopiruje blok dat ABuffer o velikost ASize,
    do prvniho nebo nekolika prvnich aplikacnich bufferu blokovanych
    v prijimaci fronte. Vsechny zcela zaplnene buffery jsou vraceny
    aplikacni vrstve. Pokud je nastaven priznak APush, pak je i posledni
    z casti zaplneny buffer vracen aplikacni vrstve. Metoda nastavuje
    polozku TCP_RxQSize }
  function  TCoTCP.TcpRxQCommit( ABuffer: Pointer; ASize: Word;
              APush: Boolean ): TCoStatus;
  var
    Link     : PCoDeviceRequestQueueLink;
    User     : PTcpRxUserBlock absolute Link;

    Dest     : Pointer;
    Slot     : PCoRequestSlot;

    CopySize : Word;
  begin
    TcpRxQCommit := CST_PENDING;

    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpRxQCommit() ', ASize, ' bytes' );
    {$ENDIF}

    while (TCP_RxQ.Head <> nil) and (ASize > 0) do
    begin
      Link := TCP_RxQ.Head;

      { Vypocitame kolik bajtu budeme kopirovat }

      {$IFDEF DEBUG_TCP_BUFFER}
      WriteLn( SID,  'User^.ABuffSize: ', User^.BuffSize, 'Push: ', APush );
      {$ENDIF}

      CopySize := User^.BuffSize;
      if CopySize > ASize then CopySize := ASize;

      { Prekopirovani dat }

      MemCopy( User^.BuffPtr, ABuffer, CopySize );

      { Posunuti ukazovatek }

      with User^ do
      begin
        Inc( PtrRec(BuffPtr).Ofs, CopySize );
        Inc( Written, CopySize );
        Dec( BuffSize, CopySize );
      end;

      Inc( PtrRec( ABuffer ).Ofs, CopySize );
      Dec( ASize, CopySize );

      Dec( TCP_RxQSize, CopySize );

      if (User^.BuffSize = 0) or APush then
      begin
        { Buffer byl zcela zaplnen prip. je nastaven priznak APush }

        { Predame pozadavek aplikacni vrstve }

        Slot := CoGetDeviceSlot( Link^.Request );

        { Ulozime pocet prekopirovanyc bajtu }

        with TCoRecvBufferParams( Slot^.Params ) do
        begin
          RecvLen^ := User^.Written;
        end;

        { Pokud je nastaven push, buffer nemusi byt vyplnen zcela }
        if APush then  Dec( TCP_RxQSize, User^.BuffSize );

        { Vratime aplikacni vrstve }

        if not User^.InMiniportRecv then
        begin
          UpperComplete( Link^.Request, CST_SUCCESS );
        end
        else
          TcpRxQCommit := CST_SUCCESS;

        { Odstranime pozadavek ze seznamu }
        TCP_RxQ.RemoveHead;
      end;

    end;

    { Test-- tahle chyba by nemela nastavat, vzdy bychom meli prekopirovat
      vse.. ledaze by se to tu trochu upravilo a vracel se pocet prekopirovanych
      bajtu }
    if ASize > 0 then
      RunError( 255 );
  end;


  { Metoda TcpRxQFlush vrati vsechny pozadavky z prijimaci fronty aplikacni
    vrstve. Prvni pozadavek (pokud byl alespon jeden bajt bufferu zaplnen)
    muze vrati CST_SUCCESS. Ostatni pozadavky na prijem vrati navratovy
    kod AStatus. Metoda nastavuje polozku TCP_RxQSize na nulu }

  procedure TCoTCP.TcpRxQFlush( AStatus : TCoStatus );
  var
    Link  : PCoDeviceRequestQueueLink;
    User  : PTcpRxUserBlock absolute Link;
    Slot  : PCoRequestSlot;
  begin
    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpRxQFlusht()' );
    {$ENDIF}


    Link := TCP_RxQ.RemoveHead;

    while Link <> nil do
    begin

      Slot := CoGetDeviceSlot( Link^.Request );

      { Ulozime pocet prekopirovanyc bajtu }
      with TCoRecvBufferParams( Slot^.Params ) do
      begin
        { RecvLen je promenna predana funkci CoRecvBuffer(From) }
        RecvLen^ := User^.Written;
      end;

      if User^.Written > 0 then
      begin
        { Predame pozadavek aplikacni vrstve }
        UpperComplete( Link^.Request, CST_SUCCESS );
      end
      else
        UpperComplete( Link^.Request, AStatus );

      Link := TCP_RxQ.RemoveHead;
    end;

    TCP_RxQSize := 0;
  end;



  { Zaradi data segmentu na spravne misto ve fronte }
  { Zapisuje jen do velikosti prijimaciho okna }
  procedure  TCoTCP.TcpProcessData( ASeq: Longint; APacket: PCoPacket );

  label
    L_InsertToQueue;

  type

    POFOSegmentInfo = ^TOFOSegmentInfo;
    TOFOSegmentInfo = record
      Seq    : Longint;
      EndSeq : Longint;
    end;

  var

    SegSize : Word;
    SegEnd  : Longint;

    P       : PCoPacket;

    PSeq    : Longint;

    { Vlozeni dat segmentu do Out Of Order fronty. Pri vkladani
      jsou zruseny vsechny segementy, ktere jsou pokryty vkladanym
      segmentem..}

    { Vsechny segmentu v OFO fronty maji v prvnich osmi bajtech
      polozky Address ulozenou strukturu TOfoSegmentInfo }

    procedure InsertToOfoQ( ASeq: Longint; APacket: PCoPacket );
    var
      P       : PCoPacket;
      Prev    : PCoPacket;
      Temp    : PCoPacket;

      EndSeq  : Longint;

    begin
      { !!! dodelat--pocitat overhead OFO ze seznamu a kdyztak provest zceleni }

      { Cislo posledniho oktetu vkladaneho segmentu + 1 }
      EndSeq := ASeq + APacket^.DataSize;

      P := TCP_OFOQueue.Head;

      { Najdeme prvni segment, ktery zacina pozdeji nez vkladany segment }

      while (P <> nil) and (POFOSegmentInfo(@P^.Address)^.Seq < ASeq ) do
      begin
        P := P^.QNext;
      end;

      { Pokud se predchozi segment prekryva s vkladanym segmentem
        osekneme jej }

      if P <> nil then
      begin
        Prev := P^.QPrev;

        if (Prev <> nil) and (ASeq < POFOSegmentInfo(@Prev^.Address)^.EndSeq) then
        begin
          Prev^.RemoveTrailer( POFOSegmentInfo(@Prev^.Address)^.EndSeq - ASeq );
          POFOSegmentInfo(@Prev^.Address)^.EndSeq := ASeq;
        end;
      end;

      { Vyjmene ze seznamu vsechny segmenty, ktere jsou vkladanym
        segmentem plne pokryty }

      while (P <> nil) and (POFOSegmentInfo(@P^.Address)^.EndSeq <= EndSeq ) do
      begin
        Temp := P^.QNext;
        TCP_OFOQueue.Remove( P );
        P := Temp;
      end;

      { Pokud se konec vkladaneho segmentu nachazi uprostred jineho
        segmentu, zkratime ho }

      if (P <> nil) and (EndSeq > POFOSegmentInfo(@P^.Address)^.Seq) then
      begin
        P^.RemoveHeader( EndSeq - POFOSegmentInfo(@P^.Address)^.Seq );
        POFOSegmentInfo(@P^.Address)^.Seq := EndSeq;
      end;

      { A nyni vlozime prichozi segment do seznamu }

      with POFOSegmentInfo(@APacket^.Address)^ do
      begin
        Seq    := ASeq;
        EndSeq := ASeq + APacket^.DataSize;
      end;

      TCP_OFOQueue.InsertBefore( APacket, P );
    end;



    { Pokud nemuze byt paket zpracovan cely funkce vraci False }

    function  ProcessInOrderPacket( APacket: PCoPacket ): Boolean;
    var
      P    : Pointer;
      Size : Word;
    begin

      if TCP_RxQSize + TCP_RxBuffer.FreeBytes >= APacket^.DataSize then
      begin

        { Zpracovani paketu od RCV.NXT }

        { Pokud existuji pripravene aplikacni bufferu,
          pak do nich paket nebo jeho cast soupneme }

        if TCP_RxQSize > 0 then
        begin
          { Vzdy kdyz aplikace doda buffer, prekopiruji se do nej
            data z kruhove fronty pokud tam nejake jsou. Tudiz pokud jsou
            k dispozici buffery aplikace, pak v kruhove fronte neni
            ani jeden bajt...
          }
          if TCP_RxBuffer.UsedBytes > 0 then RunError( 255 );

          if TCP_RxQSize >= APacket^.DataSize then
          begin
            { Cely paket se vejde do aplikacniho bufferu }

            with APacket^ do
            begin
              TcpRxQCommit( DataPtr, DataSize,
                PTcpHeader(Header)^.Control and TCP_CTRL_PSH <> 0 );

              TCB.RCV.BRD := ULONG_ADD( TCB.RCV.BRD, DataSize );
            end;

          end
          else begin
            { Cast paketu zkopirujeme do aplikacniho bufferu
              a tim ho zcela zaplnime }
            Size := TCP_RxQSize;

            P    := APacket^.DataPtr;

            TcpRxQCommit( P, Size, False );

            TCB.RCV.BRD := ULONG_ADD( TCB.RCV.BRD, Size );

            if PTcpHeader(APacket^.Header)^.Control and TCP_CTRL_PSH <> 0 then
            begin
              TCB.RCV.PSH := True;
              TCB.RCV.PSS := ULONG_ADD( TCB.RCV.NXT, APacket^.DataSize );
            end;

            { A zbytek se musi hodit do kruhoveho prijimaciho bufferu }
            Inc( PtrRec(P).Ofs, Size );

            TCP_RxBuffer.Enqueue( P, APacket^.DataSize - Size );
          end;

        end
        else begin

          if PTcpHeader(APacket^.Header)^.Control and TCP_CTRL_PSH <> 0 then
          begin
            TCB.RCV.PSH := True;
            TCB.RCV.PSS := ULONG_ADD( TCB.RCV.NXT, APacket^.DataSize );
          end;

          { Cely paket presuneme do kruhoveho bufferu, protoze
            zadne aplikacni buffery nejsou pripraveny }
          TCP_RxBuffer.Enqueue( APacket^.DataPtr, APacket^.DataSize );
        end;

        TCB.RCV.NXT := ULONG_ADD( TCB.RCV.NXT, APacket^.DataSize );

        ProcessInOrderPacket := True;
      end
      else
        ProcessInOrderPacket := False;

    end;



  begin
    { Prichozi segmenty se zarucene nachazeji alespon z casti v
      prijimacim okne }
    SegSize := APacket^.DataSize;
    SegEnd  := ULONG_ADD( ASeq, SegSize );

    { Zaradit do seznamu/fronty segmentu }

    if SegSize = 0 then Exit; { Drop segment }

    if ASeq = TCB.RCV.NXT then
    begin

  L_InsertToQueue:

      { Nejcastejsi pripad, segment navazuje na predchozi segment }

      if not ProcessInOrderPacket( APacket ) then
      begin
        ;{!@#...paket nebyl zpracovan.. co ted?}
      end;

      P := TCP_OFOQueue.Head;

      if P <> nil then
      begin
        PSeq := POFOSegmentInfo(@P^.Address)^.Seq;

        while ULONG_LE( PSeq, TCB.RCV.NXT ) do
        begin

          if ULONG_GE( ULONG_ADD( PSeq, P^.DataSize ), TCB.RCV.NXT ) then
          begin
            { Segment obsahuje data, ktera byla jiz prekopirovana }
            { Zahodime jej }
          end
          else begin

            if ULONG_LT( PSeq, TCB.RCV.NXT ) then
            begin
              { osekneme data segmentu, tak aby zacinal
                na TCB.RCV.NXT }

              P^.RemoveHeader( ULONG_SUB( TCB.RCV.NXT, PSeq ) );
              POFOSegmentInfo(@P^.Address)^.Seq := TCB.RCV.NXT;
            end;

            if not ProcessInOrderPacket( P ) then
            begin
              { Paket neni kam ulozit.. nechame jej tedy v OFO fronte,
                uz pripraveny pro priste...}
              Break;
            end;

          end;

          { Vyjmeme paket z fronty a uvolnime z pameti }
          TCP_OFOQueue.RemoveHead^.Release;

          P := TCP_OFOQueue.Head;
          if P = nil then Break;

          PSeq := POFOSegmentInfo(@P^.Address)^.Seq;

        end;
      end;

    end
    else if ULONG_LT( ASeq, TCB.RCV.NXT ) then
    begin
      { Retransmission }

      { Oseknout zacatek segmentu, jinak jako predchozi vetev }

      APacket^.RemoveHeader( ULONG_SUB( TCB.RCV.NXT, ASeq ) );

      goto L_InsertToQueue;
    end
    else begin
      { Out of order segment }

      InsertToOfoQ( ASeq, APacket );
    end;

  end;

  {-------------------------------
  { TCoTCP.TcpChooseISN
  {---
  { Vyber ISN pro nove vytvarene spojeni. ISN je potreba vybrat
  { tak, aby nekolidovalo s SEQ pripadnych bloudicich segmentu v siti.
  { Pro kazde spojeni (lokalni a vzdalena adresa) je vypoctena hodnota
  { ISN ke ktere je pricteno cislo vypoctene z aktualniho casu.
  { (za kazdou 1ms - 1024)
  {---
  }


  function TCoTCP.TcpChooseISN( ALocalAddr, ARemoteAddr: PTcpAddress ): Longint;
  var
    Result  : Longint;

    HashVal : Longint;

    procedure MakeHash( Addend: Longint );
    begin
      HashVal := ((HashVal and $1FFF) shl 19 + (HashVal shr 19)) xor Addend;
    end;

  begin
    { Za 1 ms muzeme vyslat max. 1 kB }
    { Co 30 minut bude na nule - kvuli preteceni }
    Result := (CoGetTimeMs mod 1000 * 60 * 30) * 1024;

    HashVal := ALocalAddr^.Address;
    MakeHash( ARemoteAddr^.Address );
    MakeHash( ALocalAddr^.Port );
    MakeHash( ARemoteAddr^.Port );

    Result := ULONG_ADD( Result, HashVal );

    TcpChooseISN := Result;
  end;

  {-------------------------------
  { TCoTCP.TcpIsValidAddr
  {---
  { !@#
  {---
  }

  function TCoTcp.TcpIsValidAddress( AAddress: PTcpAddress; ALocal: Boolean ): Boolean;
  begin
    { Nesmi to byt bcast 255.255.255.255 }

    TcpIsValidAddress := False;

    if AAddress^.Size = SizeOf( TTcpAddress ) then
    begin

      if not ALocal then
      begin
        { Test na 0.0.0.0 }
        if AAddress^.Address = IP_ADDR_ANY then Exit;
      end;

      { Test na vseobecny bcast }
      if AAddress^.Address = IP_ADDR_BROADCAST then Exit;

      { Stanice ve stejne siti }
      if (AAddress^.Address and TCP_LocalAddrMask.NetMask =
         TCP_LocalAddrMask.Address and TCP_LocalAddrMask.NetMask) then
      begin
         { Bcast ve stejne siti }
         if AAddress^.Address and not TCP_LocalAddrMask.NetMask = 255 then Exit;
      end;

      {!@# doplnit dalsi testy}

      TcpIsValidAddress := True;
    end;

  end;



  {-------------------------------
  { TCoTCP.MiniportBind
  {---
  { !@#
  {---
  }


  function TCoTCP.MiniportBind( AAddress: PCoAddress; AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
    User   : PTcpUserBlock;
  begin

    case TCB.State of

      TCP_NOTBOUND:
      begin

        TCP_ChildSocket := False;

        { Kontrola parametru nez se vubec do neceho pustime.. }


        if CoIsAddrValid( AAddress ) then
        begin
          TCP_LocalAddr.Size := SizeOf( TCP_LocalAddr );
          TCP_LocalAddr.Port := PTcpAddress(AAddress)^.Port;
        end
        else begin
          TCP_LocalAddr := TCP_DefLocalAddr;
        end;

        if TcpIsValidAddress( @TCP_LocalAddr, True ) then
        begin

          if AFlags and COF_PROPAGATE <> 0 then
          begin
            { Automaticky bind nizsi vrstvy }
            Status := LowerBind( nil, COF_PROPAGATE or COF_QUIET, AHandle );

            case Status of

              CST_SUCCESS:
              begin
                Status := TcpBind_1( AFlags, AHandle );
              end;

              CST_PENDING:
              begin
                User := PTcpUserBlock( @CoGetDeviceSlot( AHandle )^.User );

                with User^ do
                begin
                  ReqType := TCP_REQ_BIND;
                end;

                TCP_ReqList.InsertTail( @User^.QLink, AHandle );
              end;

            end;

          end
          else begin

            Status := TcpBind_1( AFlags, AHandle );
          end;

        end
        else
          Status := CST_ERR_INVADDR;

      end;

    else

      {$IFDEF DEBUG_TCP}
      WriteLn( SID,  'MiniportBind: Invalid state' );
      {$ENDIF}

      Status := CST_ERR_ISBOUND;
    end;

    MiniportBind := Status;
  end;



  {-------------------------------
  { TCoTCP.TcpBind_1
  {---
  { Prvni cast Bind TCP protokolu
  { Zjisteni lokalni IP adresy
  {---
  { Vola se z MiniportBind nebo z ProtocolBindComplete
  }

  function TCoTCP.TcpBind_1( AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;
  var
    User   : PTcpUserBlock;
    Status : TCoStatus;
  begin
    { Zjistime IP adresu a masku z IPV4 vrstvy }
    Status := LowerIoctl( DEV_CLASS_IPV4, 0, IOCTL_IPV4_GETIPADDRMASK,
                @TCP_LocalAddrMask, SizeOf( TIpIoctlAddrMask ), AHandle );

    case Status of

      CST_SUCCESS:
      begin
        TCP_LocalAddr.Address := TCP_LocalAddrMask.Address;
        Status := TcpBind_2( AFlags );
      end;

      CST_PENDING:
      begin
        User := PTcpUserBlock( @CoGetDeviceSlot( AHandle )^.User );

        with User^ do
        begin
          ReqType := TCP_REQ_BIND;
        end;

        TCP_ReqList.InsertTail( @User^.QLink, AHandle );
      end;

    else
      { Pri chybe asi nic.. }
    end;

    TcpBind_1 := Status;
  end;

  {-------------------------------
  { TCoTCP.TcpBind_2
  {---
  { Druha dokoncovaci cast Bind TCP protokolu
  {
  {---
  { Tato metoda se vola z TcpBind_1 nebo z ProtocolIoctlComplete
  }

  function TCoTCP.TcpBind_2( AFlags: Word ): TCoStatus;
  var
    Status   : TCoStatus;
    Selector : TTcpMuxSelector;
  begin

    { Alokace kruhoveho bufferu }

    if TCP_RxBuffer.Initialize( TCP_Settings.MaxWindow ) then
    begin
      { Napojeni na nizzsi vrstvu }

      Selector.DstPort := TCP_LocalAddr.Port;
      Selector.SrcPort := 0;
      Selector.SrcAddr := 0;

      Status := LowerAddToReceiveList( 0, @Selector, SizeOf( Selector ) );

      if Status = CST_SUCCESS then
      begin
        TCP_Registered := True;
        TCP_Passive := False;
        TCB.State := TCP_LISTEN;

        Status := CST_SUCCESS;
      end;

      TCB.State := TCP_CLOSED;
    end
    else
      Status := CST_ERR_MEMOVF;


    TcpBind_2 := Status;
  end;



  {-------------------------------
  { TCoTCP.MiniportUnbind
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportUnbind( AFlags: Word; AHandle: PCoRequest ):
    TCoStatus;

  var
    Status : TCoStatus;
  begin
    case TCB.State of

      TCP_NOTBOUND:
      begin
        Status := CST_ERR_NOTBOUND;
      end;

    { Unbind by se mel chovat jako ABORT podle RFC793 }

    {--------------------------------------------------------------}
      TCP_CLOSED:
      begin
        Status := TcpUnbind_1( AFlags, AHandle );
      end;

    {--------------------------------------------------------------}
      TCP_LISTEN:
      begin
        { Zrusime vsechny pozadavky na prijem }

        TcpRxQFlush( CST_ERR_NOTBOUND );
        Status := TcpUnbind_1( AFlags, AHandle );
      end;

    {--------------------------------------------------------------}
      TCP_SYN_SENT:
      begin
        { Zrusime vsechny casovace }

        TcpRTOTimerStop;
        TcpNagleTimerStop;
        TcpAckTimerStop;
        TcpTimeWaitTimerStop;

        { Zrusime vsechny pozadavky na prijem a vysilani }

        TcpRxQFlush( CST_ERR_NOTBOUND );
        TcpTxQFlush( CST_ERR_NOTBOUND );

        { Potvrdime pozadavek na navazani spojeni }

        if TCP_OpenHandle <> nil then
        begin
          UpperComplete( TCP_OpenHandle, CST_ERR_NOTBOUND );
          TCP_OpenHandle := nil;
        end;

        Status := TcpUnbind_1( AFlags, AHandle );
      end;

    {--------------------------------------------------------------}
      TCP_SYN_RECEIVED,
      TCP_ESTABLISHED,
      TCP_FIN_WAIT1,
      TCP_FIN_WAIT2,
      TCP_CLOSE_WAIT:
      begin

        { Zrusime vsechny casovace }

        TcpRTOTimerStop;
        TcpNagleTimerStop;
        TcpAckTimerStop;
        TcpTimeWaitTimerStop;

        { Zrusime vsechny pozadavky na prijem a vysilani }

        TcpRxQFlush( CST_ERR_NOTBOUND );
        TcpTxQFlush( CST_ERR_NOTBOUND );

        { Zrusime pozadavek na connect, pripadne disconnect }

        if TCP_OpenHandle <> nil then
        begin
          UpperComplete( TCP_OpenHandle, CST_ERR_NOTBOUND );
          TCP_OpenHandle := nil;
        end;

        if TCP_CloseHandle <> nil then
        begin
          UpperComplete( TCP_CloseHandle, CST_ERR_NOTBOUND );
          TCP_CloseHandle := nil;
        end;

        { Posleme RST segment }

        TcpSendCtrlSegment( TCB.SND.NXT, 0, TCP_CTRL_RST, @TCP_RemoteAddr,
                            TCP_PKT_UNBIND );

        { Je potreba zajistit odvysilani tohot segmentu, z
          tzn. unbind nesmi vratit vysledek, dokud nebude odvysilan...}

        { Zbytek unbind se dokonci az po odvysilani RST segmentu
          v ProtocolSendCompleted }

        TCB.State := TCP_CLOSED;

        TCP_UnbindHandle := AHandle;

        Status := CST_PENDING;
      end;

    {--------------------------------------------------------------}
      TCP_CLOSING,
      TCP_LAST_ACK,
      TCP_TIME_WAIT:
      begin
        { Zrusime vsechny casovace }

        TcpRTOTimerStop;
        TcpNagleTimerStop;
        TcpAckTimerStop;
        TcpTimeWaitTimerStop;

        { Zrusime pozadaevk na disconnect }

        if TCP_CloseHandle <> nil then
        begin
          UpperComplete( TCP_CloseHandle, CST_ERR_NOTBOUND );
          TCP_CloseHandle := nil;
        end;


        Status := TcpUnbind_1( AFlags, AHandle );
      end;

    else
      RunError( 255 );
    end;

    MiniportUnbind := Status;

  end;

  {-------------------------------
  { TCoTCP.TcpUnbind_1
  {---
  { !@#
  {---
  }

  function TCoTCP.TcpUnbind_1( AFlags: Word; AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
  begin

    { Pokud byl soket otevren pomoci Accept, tj. TCP_ChildSocket = True,
      pak je odstranen z receive list nizsi vrstvy pri rozpojeni spojeni }

    if not TCP_ChildSocket then
    begin
      Status := LowerRemoveFromReceiveList( 0 );
      TCP_Registered := False;
    end
    else
      Status := CST_SUCCESS;


    if Status = CST_SUCCESS then
    begin
      { Uvolneni kruhoveho bufferu }

      TCP_RxBuffer.Finalize;

      TCB.State := TCP_NOTBOUND;

      if AFlags and COF_PROPAGATE <> 0 then
      begin
        Status := LowerUnbind(
                    COF_PROPAGATE or COF_QUIET or COF_IFNOTUSED, AHandle );

        if Status = CST_PENDING then
        begin
          TCP_UnbindHandle := AHandle;
        end;

      end;

    end;

    TcpUnbind_1 := Status;
  end;

  {-------------------------------
  { TCoTCP.MiniportConnect
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportConnect( AAddress: PCoAddress; AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;
  label
    L_TCP_LISTEN;
  var
    Status : TCoStatus;
  begin

    if TCP_ChildSocket then
    begin
      Status := CST_ERR_INVALID; {!@# vracet jinou chybu }
    end
    else begin

      case TCB.State of

      {--------------------------------------------------------------}
        TCP_NOTBOUND:
        begin
          Status := CST_ERR_NOTBOUND;
        end;

        TCP_CLOSED:
        begin
          TCB.State := TCP_LISTEN;
          goto L_TCP_LISTEN;
        end;

      {--------------------------------------------------------------}
        TCP_LISTEN:
      L_TCP_LISTEN:
        begin
          { Musime zjistit, zda jsme vubec zaregistrovani u
            nizsi vrstvy.. pokud bylo uz pomoci toho zarizeni navazano,
            mohlo byt zaregistrovano na stejnem portu i jine zarizeni, ktere
            prave nasloucha..pak bychom meli vratit chybu CST_ERR_PORTENGAGED }

          if TCP_Registered then
          begin

            {!@#1 nebylo by vhodne se v tomto stavu u nizsi vrstvy preregistrovat?}

            if CoIsAddrValid( AAddress ) then
            begin
              CoCopyAddress( @TCP_RemoteAddr, AAddress );
            end
            else begin
              TCP_RemoteAddr := TCP_DefRemoteAddr;
            end;


            if TcpIsValidAddress( @TCP_RemoteAddr, False{Remote} ) then
            begin

              { Smazene obsah Backlogu }
              TcpBacklogFlush;

              TCP_Ack.Scheduled := False;

              { Tento TCP modul aktivne navaze spojeni.. }
              TCP_Passive := False;

              { Vybereme pocatecni Seq cislo pro vysilani }
              TCB.SND.ISS := TcpChooseISN( @TCP_LocalAddr, @TCP_RemoteAddr );

              TCB.SND.MSS := 536; { Default }

              TCB.RCV.WND := TCP_Settings.MinWindow;

              { Odesleme prvni synchronizacni segment.. }
              TcpSendCtrlSegment( TCB.SND.ISS {SEQ}, 0 {ACK},
                TCP_CTRL_SYN or TCP_CTRL_MSS, @TCP_RemoteAddr, TCP_PKT_NORMAL );

              TCB.SND.UNA := TCB.SND.ISS;
              TCB.SND.NXT := ULONG_INC( TCB.SND.ISS );
              TCB.SND.WRI := TCB.SND.NXT;

              TCB.State := TCP_SYN_SENT;

              TCP_OpenHandle := AHandle;

              TCP_FINSent := False;

              TCP_ClosePending := False;

              { Restartujeme RTO Timer }
              TcpRTOTimerRestart;

              Status := CST_PENDING;
            end
            else
              Status := CST_ERR_INVADDR;
          end
          else
            Status := CST_TCP_ERR_PORTENGAGED;
        end;

      else
        Status := CST_ERR_ISCONN;
      end;

    end;

    MiniportConnect := Status;
  end;

  {-------------------------------
  { TCoTCP.MiniportDisconnect
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportDisconnect( AFlags: Word; AHandle: PCoRequest ):
    TCoStatus;
  var
    Status : TCoStatus;
  begin

    { Disconnect by se mel chovat jako CLOSE podle RFC 793 }

    { Po prevedeni Disconnect by mel automat skoncit ve stavu TCP_LISTEN }
    { Mozna by se po provedeni disconnect mela nastavit
      promenna Passive na False }

    case TCB.State of

      TCP_NOTBOUND:
      begin
        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'MiniportDisconnect() called in TCP_NOTBOUND' );
        {$ENDIF}
        Status := CST_ERR_NOTBOUND;
      end;

      TCP_CLOSED:
      begin
        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'MiniportDisconnect() called in TCP_CLOSED' );
        {$ENDIF}
        Status := CST_ERR_NOTCONN;
      end;

      TCP_LISTEN:
      begin
        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'MiniportDisconnect() called in TCP_LISTEN' );
        {$ENDIF}

        TcpRxQFlush( CST_ERR_NOTCONN );

        Status := CST_SUCCESS;

        if TCP_ChildSocket then
        begin
          LowerRemoveFromReceiveList( 0 );
          TCP_Registered := False;

          TCB.State := TCP_CLOSED;
        end
        else begin

          if (TcpResetRemoteAddr = CST_SUCCESS) and TCP_Passive then
          begin
            TCB.State := TCP_LISTEN;
          end
          else
            TCB.State := TCP_CLOSED;
        end;

      end;

      TCP_SYN_SENT:
      begin
        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'MiniportDisconnect() called in TCP_SYN_SENT' );
        {$ENDIF}

        TcpRxQFlush( CST_ERR_NOTCONN );

        if TCP_ChildSocket then
        begin
          LowerRemoveFromReceiveList( 0 );
          TCP_Registered := False;
        end
        else begin

          if (TcpResetRemoteAddr = CST_SUCCESS) and TCP_Passive then
          begin
            TCB.State := TCP_LISTEN;
          end
          else
            TCB.State := TCP_CLOSED;

        end;

        Status := CST_SUCCESS;

      end;

      TCP_SYN_RECEIVED, {!@# nemelo by se v TCP_SYN_RECEIVED vracet CONN_CLOSING ?? }
      TCP_ESTABLISHED:
      begin

        if ULONG_LE( TCB.SND.WRI, TCB.SND.NXT ) {nejsou data k vyslani} then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'MiniportDisconnect() immediate disconnect' );
          {$ENDIF}

          { Posleme segment s FIN }
          TcpSendCtrlSegment( TCB.SND.NXT, TCB.RCV.NXT,
            TCP_CTRL_ACK or TCP_CTRL_FIN, @TCP_RemoteAddr, TCP_PKT_NORMAL );

          TCP_FINSent := True;

          TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );

          { RTO pro opakovani FIN segmentu }
          TcpRTOTimerRestart;

          { Je potreba si zapamatovat Handle Disconnect requestu,
            potvrdime jej az bude spojeni opravdu ukonceno }
          TCP_CloseHandle  := AHandle;

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  '--> TCP_FIN_WAIT1' );
          {$ENDIF}

          TCB.State := TCP_FIN_WAIT1;

        end
        else begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'MiniportDisconnect() disconnect scheduled' );
          {$ENDIF}

          { Do TCP_FIN_WAIT1 se prejde az z TCP_ESTABLISHED, az budou
            odvysilany vsechny pakety }

          { Po odvysilani vsech paketu se posle FIN segment.. }

          { Je potreba si zapamatovat Handle Disconnect requestu,
            potvrdime jej az bude spojeni opravdu ukonceno }
          TCP_CloseHandle  := AHandle;


          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  '--> TCP_FIN_WAIT1' );
          {$ENDIF}

          TCB.State := TCP_FIN_WAIT1;

        end;

        TCP_ClosePending := True;

        Status := CST_PENDING;

      end;


      TCP_FIN_WAIT1,
      TCP_FIN_WAIT2:
      begin
        Status := CST_TCP_ERR_CONNCLOSING;
      end;



      TCP_CLOSE_WAIT:
      begin

        if ULONG_LE( TCB.SND.WRI, TCB.SND.NXT ) {nejsou data k vyslani} then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'MiniportDisconnect() immediate disconnect' );
          {$ENDIF}

          { Posleme segment s FIN }
          TcpSendCtrlSegment( TCB.SND.NXT, TCB.RCV.NXT,
            TCP_CTRL_ACK or TCP_CTRL_FIN, @TCP_RemoteAddr, TCP_PKT_NORMAL );

          TCP_FINSent := True;

          TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );

          { RTO pro opakovani FIN segmentu }
          TcpRTOTimerRestart;

          { Je potreba si zapamatovat Handle Disconnect requestu,
            potvrdime jej az bude spojeni opravdu ukonceno }
          TCP_CloseHandle  := AHandle;

          TCB.State := TCP_LAST_ACK;

        end
        else begin

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'MiniportDisconnect() disconnect scheduled' );
          {$ENDIF}

          { Do TCP_LAST_ACK se prejde az z TCP_CLOSEWAIT, az budou
            odvysilany vsechny pakety }

          { Po odvysilani vsech paketu se posle FIN segment.. }

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  '--> TCP_FIN_WAIT1' );
          {$ENDIF}

          TCB.State := TCP_FIN_WAIT1;


          { Je potreba si zapamatovat Handle Disconnect requestu,
            potvrdime jej az bude spojeni opravdu ukonceno }
          TCP_CloseHandle  := AHandle;

        end;

        Status := CST_PENDING;

        TCP_ClosePending := True;

      end;

      TCP_CLOSING,
      TCP_LAST_ACK,
      TCP_TIME_WAIT:
      begin
        { Tohle by asi nikdy nemuze nastat..protoze TCoDevice
          nepropusti pozadavek dalsi pozadavek disconnect, dokud
          nebude tento proveden }
        Status := CST_TCP_ERR_CONNCLOSING;
      end;

    end;

    MiniportDisconnect := Status;

  end;

  {-------------------------------
  { TCoTCP.MiniportAccept
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportAccept( AAddress: PCoAddress;
    var AComBase: PCoDevice; AFilter: TCoAcceptFilterProc; Flags: Word;
    AHandle: PCoRequest ): TCoStatus;
  label
    L_TCP_LISTEN;
  var
    Status : TCoStatus;
  begin

    if TCP_ChildSocket then
    begin
      Status := CST_ERR_INVALID; {!@# vracet jinou chybu }
    end
    else begin

      case TCB.State of

        TCP_NOTBOUND:
        begin
          Status := CST_ERR_NOTBOUND;
        end;

        TCP_CLOSED:
        begin
          TCB.State := TCP_LISTEN;

          goto L_TCP_LISTEN;
        end;

        TCP_LISTEN:
      L_TCP_LISTEN:
        begin

          TCP_Passive := True;

          TCB.SND.MSS := 536; { Default }

          TCP_Accept.Handle     := AHandle;
          TCP_Accept.AddressPtr := AAddress;
          TCP_Accept.Filter     := AFilter;
          TCP_Accept.DevicePtr  := @AComBase;
          TCP_Accept.Device     := nil;

          if TCP_Accept.Backlog.Count > 0 then
          begin
            Status := TcpBacklogAccept;
          end
          else
            Status := CST_PENDING;

        end;

      else
        {!@# mozna bycho se meli v nekterych stavech chovat trosku jinak..
             napr. TCP_CLOSE_WAIT..}

        Status := CST_ERR_ISCONN;
      end;

    end;

    MiniportAccept := Status;
  end;


  {-------------------------------
  { TCoTCP.TcpAcceptBacklog
  {---
  { !@#
  {---
  }

  function TCoTCP.TcpBacklogAccept: TCoStatus;
  var
    ASynSegment : PCoPacket;
    Status      : TCoStatus;
  begin
    Status := CST_PENDING;

    if TCP_Accept.Handle <> nil then
    begin

      repeat

        ASynSegment := TCP_Accept.BackLog.RemoveHead;

      until (ASynSegment = nil) or (not Assigned( TCP_Accept.Filter )) or
            (TCP_Accept.Filter( @ASynSegment^.Address ));

      if ASynSegment <> nil then
      begin

        CoCopyAddress( @TCP_Accept.Address, @ASynSegment^.Address );

        { Filter neni nastaven, nebo adresa prosla filtrem }

        Status := TcpCreateChildSocket( ASynSegment, TCP_Accept.Device );

        CoReleasePacket( ASynSegment );

        if Status = CST_SUCCESS then
        begin
          { Posleme IOCTL, pomoci ktereho budeme cekat
            na dokonceni spojeni }

          Status := TCP_Accept.Device^.CoIoctl( DEV_CLASS_TCP, 0,
            IOCTL_TCP_WAIT_ESTABLISHED, nil, 0, @TCP_Accept.WaitOvlp );

          case Status of

            CST_SUCCESS:
            begin
              TCP_Accept.DevicePtr^  := TCP_Accept.Device;

              if TCP_Accept.AddressPtr <> nil then
              begin
                CoCopyAddress( TCP_Accept.AddressPtr, @TCP_Accept.Address );
              end;

              UpperComplete( TCP_Accept.Handle, CST_SUCCESS );

              TCP_Accept.Handle := nil;
              TCP_Accept.Device := nil;
            end;

            CST_PENDING:  ;  { Dokoncime v MiniportTick }

          else
            { Nastala nejaka chyba }

            { Hruby zpusoben uvolnime vznikajici zasuvku }
            TCP_Accept.Device^.CoDetachDevice;
            TCP_Accept.Device^.Release;
            TCP_Accept.Device := nil;

            TCP_Accept.DevicePtr^ := nil;

            if TCP_Accept.AddressPtr <> nil then
            begin
              TCP_Accept.AddressPtr^.Size := 0;
            end;

            { Nejaka chyba }

            UpperComplete( TCP_Accept.Handle, Status );

            TCP_Accept.Handle := nil;
            TCP_Accept.Device := nil;

          end;
        end
        else begin
          { TcpCreateChildSocket vratil chybu }

          TCP_Accept.DevicePtr^ := nil;

          if TCP_Accept.AddressPtr <> nil then
          begin
            TCP_Accept.AddressPtr^.Size := 0;
          end;

          { Nejaka chyba }

          UpperComplete( TCP_Accept.Handle, Status );

          TCP_Accept.Handle := nil;
          TCP_Accept.Device := nil;
        end;

      end;


    end
    else
      RunError( 255 );

    TcpBackLogAccept := Status;
  end;

  {-------------------------------
  { TCoTCP.TcpBacklogFlush
  {---
  { !@#
  {---
  }


  procedure TCoTcp.TcpBacklogFlush;
  begin
    TCP_Accept.Backlog.RemoveAll;
  end;


  {-------------------------------
  { TCoTCP.TcpCreateChildSocket
  {---
  { !@#
  {---
  }

  function  TCoTCP.TcpCreateChildSocket( ASynSegment: PCoPacket;
    var ADevice: PCoDevice ): TCoStatus;
  var
    NewDev   : PCoTcp;
    LowerDev : PCoDevice;
    Status   : TCoStatus;
    Selector : TTcpMuxSelector;
  begin

    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpCreateChildSocket()' );
    {$ENDIF}


    LowerDev := __GetLowerDevice;

    { Vytvori plne specifikovany soket, ktery je ve stavu TCP_LISTEN
      a preda mu synchronizacni segment }

    NewDev := New( PCoTcp, Init );

    { Nastavime, nektere parametry, tak aby se soket tvaril
      jako ze byla zavolana metoda Bind }

    NewDev^.TCP_LocalAddr  := TCP_LocalAddr;
    NewDev^.TCP_DefLocalAddr := TCP_LocalAddr;

    CoCopyAddress( @NewDev^.TCP_RemoteAddr, @ASynSegment^.Address );
    CoCopyAddress( @NewDev^.TCP_DefRemoteAddr, @ASynSegment^.Address );

    NewDev^.TCP_Passive := False;
    NewDev^.TCP_ChildSocket := True;

    NewDev^.TCB := TCB;

    { Pripojeni nove TCP zasuvky k TCP multiplexeru }

    Status := NewDev^.CoAttachDevice( LowerDev );

    CoReleaseDevicePtr( LowerDev );

    if Status = CST_SUCCESS then
    begin

      { Potrebujeme, aby prvni segment, ktery soket obdrzi byl SYN segment
        ulozeny v backlogu .. }

      NewDev^.CO_ReceiveQ.InsertTail( ASynSegment );

      if not NewDev^.TCP_RxBuffer.Initialize( TCP_Settings.MaxWindow ) then
      begin
        Status := CST_ERR_MEMOVF;
      end;

      if Status = CST_SUCCESS then
      begin
        { Zaneseni nove TCP zasuvky do seznamu TCP multiplexeru }

        Selector.DstPort := TCP_LocalAddr.Port;
        Selector.SrcPort := PTcpAddress(@ASynSegment^.Address)^.Port;
        Selector.SrcAddr := PTcpAddress(@ASynSegment^.Address)^.Address;

        Status := NewDev^.LowerAddToReceiveList( 0, @Selector,
                    SizeOf( Selector ) );

        if Status = CST_SUCCESS then
        begin
          TCP_Registered := True;
          ADevice := NewDev;
        end
        else begin
          NewDev^.CoDetachDevice;
          NewDev^.Release;
        end;

      end
      else begin
      {$ifdef DEBUG_TCP}
        WriteLn( SID,  'TcpCreateChildSocket() CoDetachDevice()' );
      {$endif}
        NewDev^.CoDetachDevice;
        NewDev^.Release;
        NewDev := nil;
      end;

    end
    else begin
      NewDev^.Release;
      NewDev := nil;
    end;


    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpCreateChildSocket() -- exit' );
    {$ENDIF}

    TcpCreateChildSocket := Status;
  end;


  procedure TCoTCP.TcpError( AStatus: TCoStatus );
  begin
    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpError() Status=', AStatus );
    {$ENDIF}

    if TCB.State <> TCP_NOTBOUND then
    begin

      { Zrusime vsechny pozadavky }
      TcpTxQFlush( AStatus );
      TcpRxQFlush( AStatus );

      if TCP_OpenHandle <> nil then
      begin
        UpperComplete( TCP_OpenHandle, AStatus );
        TCP_OpenHandle := nil;
      end;

      if TCP_CloseHandle <> nil then
      begin
        UpperComplete( TCP_CloseHandle, AStatus );
        TCP_CloseHandle := nil;
      end;

      { Zrusime vsechny casovace }
      TcpAckTimerStop;
      TcpNagleTimerStop;
      TcpRTOTimerStop;
      TcpTimeWaitTimerStop;

      TcpResetRemoteAddr;

      TCB.State := TCP_CLOSED;
    end;
  end;

  {-------------------------------
  { TCoTCP.MiniportTick
  {---
  { !@#
  {---
  }

  procedure TCoTCP.MiniportTick;
  var
    Status : TCoStatus;
  begin
    if TCP_Accept.Device <> nil then
    begin
      { Cekame do te doby, nez bude nove vytvareny soket ve stavu
        TCP_ESTABLISHED .. }

      Status := TCP_Accept.Device^.CoGetIOResult( @TCP_Accept.WaitOvlp, 0 );

      case Status of

        CST_PENDING:
        begin
          { Spojeni jeste nebylo navazano }
        end;

        CST_SUCCESS:
        begin

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'MiniportTick() child socket connected' );
          {$ENDIF}

          TCP_Accept.DevicePtr^  := TCP_Accept.Device;

          if TCP_Accept.AddressPtr <> nil then
          begin
            CoCopyAddress( TCP_Accept.AddressPtr, @TCP_Accept.Address );
          end;

          UpperComplete( TCP_Accept.Handle, CST_SUCCESS );

          TCP_Accept.Handle := nil;
          TCP_Accept.Device := nil;
        end;

      else

        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'MiniportTick() child socket error' );
        {$ENDIF}

        { Nastala nejaka chyba }

        { Hruby zpusoben uvolnime vznikajici zasuvku }
        TCP_Accept.Device^.CoDetachDevice;
        TCP_Accept.Device^.Release;
        TCP_Accept.Device := nil;

        TCP_Accept.DevicePtr^ := nil;

        if TCP_Accept.AddressPtr <> nil then
        begin
          TCP_Accept.AddressPtr^.Size := 0;
        end;

        { Vratime probihajici Accept s chybou }

        UpperComplete( TCP_Accept.Handle, Status );
        TCP_Accept.Handle := nil;

      end;
    end;
  end;



  {-------------------------------
  { TCoTCP.MiniportListen
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportListen( ABacklog: Word; AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;

  label
    L_TCP_LISTEN;

  var
    Status : TCoStatus;

  begin
    if TCP_ChildSocket then
    begin
      Status := CST_ERR_INVALID; {!@# vracet jinou chybu }
    end
    else begin

      case TCB.State of

      {--------------------------------------------------------------}
        TCP_NOTBOUND:
        begin
          Status := CST_ERR_NOTBOUND;
        end;

        TCP_CLOSED:
        begin
          TCB.State := TCP_LISTEN;
          goto L_TCP_LISTEN;
        end;

      {--------------------------------------------------------------}
        TCP_LISTEN:
      L_TCP_LISTEN:
        begin
          TCB.SND.MSS := 536; { Default }

          TCP_Passive := True;

          TCP_Accept.Backlog.MaxCount := ABacklog;

          { !@# pripadne oseknout cekajici pozadavky }
          Status := CST_SUCCESS;
        end;

      {--------------------------------------------------------------}
      else
        Status := CST_ERR_ISCONN;
      end;

    end;

    MiniportListen := Status;

  end;


  {-------------------------------
  { TCoTCP.MiniportSendBuffer
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportSendBuffer( ABuffer: Pointer; ABuffSize: Word;
    AFlags: Word; AAddress: PCoAddress;
    AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
  begin

    {!@# co s adresou ?}

    case TCB.State of

    {--------------------------------------------------------------}
      TCP_NOTBOUND,
      TCP_CLOSED,
      TCP_LISTEN:
      begin
        Status := CST_ERR_NOTBOUND;
      end;

    {--------------------------------------------------------------}
      TCP_SYN_SENT,
      TCP_SYN_RECEIVED:
      begin
        { Spojeni jeste neni navazano }

        if AFlags and COF_TCP_COPY = 0 then
        begin
          Status := TcpTxQInsert( AHandle, ABuffer, ABuffSize );
        end
        else
          Status := TcpTxQInsert( nil, ABuffer, ABuffSize );


        if Status = CST_SUCCESS then
        begin

          Inc( TCB.SND.WRI, ABuffSize );

          if AFlags and COF_TCP_PUSH <> 0 then
          begin
            {!@# spustit casovac }
            {!@# kdy se vlastne odeslou tyto data? az v established?
                 co kdyz neprijde potvrzeni do established..??}

            TCB.SND.PSH := True;
            TCB.SND.PSS := TCB.SND.WRI;
          end;

          if AFlags and COF_TCP_COPY = 0 then
          begin
            Status := CST_PENDING;
            UpperNextRequest( AHandle, RQ_SEND_CONCURENT );
          end;
        end;

      end;

    {--------------------------------------------------------------}
      TCP_ESTABLISHED,
      TCP_CLOSE_WAIT:
      begin

        if AFlags and COF_TCP_COPY = 0 then
        begin
          Status := TcpTxQInsert( AHandle, ABuffer, ABuffSize );
        end
        else
          Status := TcpTxQInsert( nil, ABuffer, ABuffSize );


        if Status = CST_SUCCESS then
        begin

          Inc( TCB.SND.WRI, ABuffSize );

          if AFlags and COF_TCP_PUSH <> 0 then
          begin
            TCB.SND.PSH := True;
            TCB.SND.PSS := TCB.SND.WRI;
          end;

          if AFlags and COF_TCP_COPY = 0 then
          begin
            Status := CST_PENDING;
            UpperNextRequest( AHandle, RQ_SEND_CONCURENT );
          end;

        end;

        { Vysleme nejaka data, pokud to pujde }
        TcpCheckAndSendData;


      end;

    {--------------------------------------------------------------}
      TCP_FIN_WAIT1,
      TCP_FIN_WAIT2,
      TCP_CLOSING,
      TCP_LAST_ACK,
      TCP_TIME_WAIT:
      begin
        Status := CST_TCP_ERR_CONNCLOSING;
      end;

    end;

    MiniportSendBuffer := Status;
  end;

  {-------------------------------
  { TCoTCP.MiniportRecvBuffer
  {---
  { !@#
  {---
  }

  function TCoTCP.MiniportRecvBuffer( ABuffer: Pointer; ABuffSize: Word;
    ARecvLen: PWord; AFlags: Word; AAddress: PCoAddress;
    AHandle: PCoRequest ): TCoStatus;
  var
    Status   : TCoStatus;

    function  __Recv__: TCoStatus;
    var
      User   : PTcpRxUserBlock;
      TempW  : Word;
      CopyPtr  : Pointer;
      CopySize : Word;
      fPush    : Boolean;
    begin
      { Pokud je v prijimaci fronte dost oktetu na to, aby
        zaplnily cely buffer, pak je od tamtad prekopirujeme
        a vratime CST_SUCCESS.}

      if TCP_RxBuffer.UsedBytes >= ABuffSize then
      begin

        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'MiniportRecvBuffer(): copying data from round buffer' );
        {$ENDIF}

        { Buffer zcela zaplnime }

        ARecvLen^ := ABuffSize;

        { Zkopirujeme data z prijimaci fronty do aplikacniho bufferu }

        while ABuffSize > 0 do
        begin
          CopyPtr := TCP_RxBuffer.Dequeue( ABuffSize, CopySize );

          MemCopy( ABuffer, CopyPtr, CopySize );

          Dec( ABuffSize, CopySize );
          Inc( PtrRec(ABuffer).Ofs, CopySize );

          TCB.RCV.BRD := ULONG_ADD( TCB.RCV.BRD, CopySize );
        end;

        __Recv__ := CST_SUCCESS;
      end
      else begin

        { Prekopirujeme do prijimaci fronty vse co se da a pozadavek
          na prijem vlozime do fronty .. }

        TcpRxQInsert( AHandle, ABuffer, ABuffSize );

        __Recv__ := CST_PENDING;

        while TCP_RxBuffer.UsedBytes > 0 do
        begin
          { Prevezmeme jeden blok z prijimaci fronty }
          CopyPtr := TCP_RxBuffer.Dequeue( ABuffSize, CopySize );

          { Prekopirujeme do aplikacniho bufferu }
          { TcpRxQCommit nezavola UpperComplete, protoze nezaplnime
            cely aplikacni buffer.. }

          TCB.RCV.BRD := ULONG_ADD( TCB.RCV.BRD, CopySize );


          if TCB.RCV.PSH and ULONG_GE( TCB.RCV.BRD, TCB.RCV.PSS ) and
             (TCP_RxBuffer.UsedBytes = 0)  then
          begin
            fPush := True;
            TCB.RCV.PSH := False;
          end
          else
            fPush := False;

          User := PTcpRxUserBlock( @CoGetDeviceSlot( AHandle )^.User );
          User^.InMiniportRecv := True;

          __Recv__:= TcpRxQCommit( CopyPtr, CopySize, fPush );

          User^.InMiniportRecv := False;

          {Inc( PtrRec(ABuffer).Ofs, CopySize );}
          Dec( ABuffSize, CopySize );
        end;

      end;

      { Rozsireni okna, pokud je to mozne.. }


      {!@# udelat jinak az bude zvetsovatelne okno}

      TempW := TCP_RxBuffer.Size div 2;
      if TempW > TCB.SND.MSS then TempW := TCB.SND.MSS;

      if TCP_RxBuffer.FreeBytes - TCB.RCV.WND > TempW then
      begin
        {$IFDEF DEBUG_TCP_WND}
        Write( 'Extending RCV.WND from ', TCB.RCV.WND );
        {$ENDIF}

        TempW := TCB.RCV.WND;

        TCB.RCV.WND := TCP_RxBuffer.FreeBytes;
        TCB.RCV.WUP := TCB.RCV.NXT;

        {$IFDEF DEBUG_TCP_WND}
        WriteLn( SID,  ' to ', TCB.RCV.WND, ' bytes' );
        {$ENDIF}

        { Neposlat radeji hned delayed? }
        TcpAckSend;
      end;

    end;


  begin

    case TCB.State of

    {--------------------------------------------------------------}
      TCP_NOTBOUND:
      begin
        Status := CST_ERR_NOTBOUND;
      end;

      TCP_CLOSED:
      begin
        Status := CST_ERR_NOTCONN;
      end;

    {--------------------------------------------------------------}
      TCP_LISTEN,
      TCP_SYN_SENT,
      TCP_SYN_RECEIVED:
      begin
        { Pozadavek na cteni akorat ulozime do seznamu }
        TcpRxQInsert( AHandle, ABuffer, ABuffSize );

        Status := CST_PENDING;
      end;

    {--------------------------------------------------------------}
      TCP_ESTABLISHED,
      TCP_FIN_WAIT1,
      TCP_FIN_WAIT2:
      begin

        Status := __Recv__;

      end;

    {--------------------------------------------------------------}
      TCP_CLOSE_WAIT:
      begin
        if TCP_RxBuffer.UsedBytes > 0 then
        begin
          { V prijimaci fronte jsou jeste nejake nevyzvednuta data }

          Status := __Recv__;

        end
        else { Prijimaci fronta je prazdna }
          Status := CST_TCP_ERR_CONNCLOSING;
      end;

    {--------------------------------------------------------------}
      TCP_CLOSING,
      TCP_LAST_ACK,
      TCP_TIME_WAIT:
      begin
        Status := CST_TCP_ERR_CONNCLOSING;
      end;

    else
      RunError( 255 );

    end;

    MiniportRecvBuffer := Status;
  end;



  {-------------------------------
  { TCoTcp.MiniportIoctl
  {---
  { !@#
  {---
  }

  function TCoTcp.MiniportIoctl( AClassId: Word; AFlags: Word; ACode: Word;
    ABuffer: Pointer; ABuffSize: Word; AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
    User   : PTcpMuxUserBlock;
  begin

    if AClassId = CO_ClassId then
    begin
      case ACode of

        IOCTL_TCP_WAIT_ESTABLISHED:
        begin

          case TCB.State of

            TCP_NOTBOUND:
            begin
              Status := CST_ERR_NOTBOUND;
            end;

          else {!@# poresit nejak i ostatni stavy }

            if TCP_OpenHandle = nil then
            begin
              TCP_OpenHandle := AHandle;
              Status := CST_PENDING;
            end
            else
              Status := CST_SUCCESS; { !@# radeji vracet nejakou chybu.. }
          end;

        end;

      else
        Status := CST_ERR_INVOPT;
      end;

      MiniportIoctl := Status;
    end
    else begin{ inherited metoda vola miniportioctl nizsich vrstev }

      Status := LowerIoctl( AClassId, AFlags, ACode, ABuffer,
                     ABuffSize, AHandle );

      if Status = CST_PENDING then
      begin
        User := @TTcpUserBlock( CoGetDeviceSlot( AHandle )^.User );
        User^.ReqType := TCP_REQ_UPPER;
        TCP_ReqList.InsertTail( @User^.QLink, AHandle );
        UpperNextRequest( AHandle, RQ_SEND_CONCURENT );
      end;

      MiniportIoctl := Status;

    end;
  end;





  function  TCoTCP.TcpSetRemoteAddr( AAddress: PTcpAddress ): TCoStatus;
  var
    Selector : TTcpMuxSelector;
  begin
    if not TCP_ChildSocket then
    begin
      TCP_RemoteAddr := AAddress^;

      Selector.SrcAddr := AAddress^.Address;
      Selector.SrcPort := AAddress^.Port;
      Selector.DstPort := TCP_LocalAddr.Port;

      TcpSetRemoteAddr :=
        LowerChangeInReceiveList( 0 {SubId}, @Selector, SizeOf( Selector ) );
    end
    else
      TcpSetRemoteAddr := CST_SUCCESS;
  end;


  function TCoTCP.TcpResetRemoteAddr: TCoStatus;
  var
    Selector : TTcpMuxSelector;
    Status   : TCoStatus;
  begin
    {$ifdef DEBUG_TCP}
      WriteLn( SID,  'TcpResetRemoteAddr()' );
    {$endif}

    if not TCP_ChildSocket then
    begin
      Selector.SrcAddr := 0;
      Selector.SrcPort := 0;
      Selector.DstPort := TCP_LocalAddr.Port;

      Status :=  LowerChangeInReceiveList( 0 {SubId}, @Selector, SizeOf( Selector ) );

      if Status <> CST_SUCCESS then
      begin
        LowerRemoveFromReceiveList( 0 );
        TCP_Registered := False;
      end;
    end
    else begin
      Status := LowerRemoveFromReceiveList( 0 );
    end;

    TcpResetRemoteAddr := Status;
  end;


  procedure TCoTCP.TcpReceiveSegment( APacket: PCoPacket );
  label
    L_ESTABLISHED_5,
    L_ESTABLISHED_6,
    L_FIN_WAIT2;
  var
    SEG     : TTcpSegment;
    SrcAddr : TTcpAddress;

    AckOK   : Boolean;
    OK      : Boolean;

    Mark1   : Longint;
    Mark2   : Longint;

    TempW   : Word;

    RightEdgeExtended : Boolean;

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

    procedure  HandleTcpOptions( Header : PTcpHeader );
    type

      PTcpOption = ^TTcpOption;
      TTcpOption = record
        Kind   : Byte;
        Length : Byte;
        case Integer of
          TCP_OPT_MSS:  (MSS :Word);

      end;

    var
      Opt      : PTcpOption;
      OptSize  : Integer;

    begin
      Opt := PTcpOption(Header);
      Inc( PtrRec(Opt).Ofs, SizeOf( TTcpHeader ) );

      OptSize := (Header^.DataOfs shr 4) * 4 - SizeOf( TTcpHeader );

      while OptSize > 0 do
      begin

        case Opt^.Kind of

          TCP_OPT_EOL: { End of Option List }
          begin
            Break;
          end;

          TCP_OPT_NOP: { No Operation }
          begin
            Dec( OptSize, 1 );
            Inc( PtrRec( Opt ).Ofs, 1 );
          end;

          TCP_OPT_MSS: { Maximum Segment Size }
          begin
            if (Opt^.Length <> 4) or (OptSize < 4) then
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'HandleTcpOptions() OPT_MSS, invalid length' );
              {$ENDIF}
            end;

            if Swap( Opt^.MSS ) < 128 then
            begin
              { Pokud je inzerovane MSS mensi nez 64 bajtu ... tak
                na nej kaslem.. }
            end
            else
              if Swap( Opt^.MSS ) > CO_DeviceState.MTU - MAX_TCP_HEADER_SIZE then
              begin
                TCB.SND.MSS :=  CO_DeviceState.MTU - MAX_TCP_HEADER_SIZE;
              end
              else begin
                TCB.SND.MSS := Swap( Opt^.MSS );
              end;

            Dec( OptSize, 4 );
            Inc( PtrRec( Opt ).Ofs, 4 );
          end;

        else
          { Neznamy option }

          Dec( OptSize, Opt^.Length );
          Inc( PtrRec( Opt ).Ofs, Opt^.Length );
        end;

      end;

    end;


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

    procedure  DoOpenCompleted( Status : TCoStatus );
    begin

      if TCP_OpenHandle <> nil then
      begin
        { Aktivni spojeni }

        if Status <> CST_SUCCESS then
        begin

          if TCP_ChildSocket then
          begin
            if LowerRemoveFromReceiveList( 0 ) <> CST_SUCCESS then
            begin
              TCP_Registered := False;
              RunError( 255 );
            end;
          end
          else begin
            TcpResetRemoteAddr;
            { !@# pokud tato funkce vrati <> CST_SUCCESS, pak
              se nekdo zaregistroval na nasem lokalnim portu,
              nezbyde nic jineho nez provest unbind a bind na jinem portu..}
          end;

        end;

        UpperComplete( TCP_OpenHandle, Status );
        TCP_OpenHandle := nil;
      end
      else begin
        { Pasivni spojeni }

        if TCP_Accept.Handle <> nil then
        begin
          { Tento soket prejde mel prejit do spojeni.. }

          case Status of

            CST_SUCCESS:
            begin
              TCP_Accept.DevicePtr^  := nil;

              if TCP_Accept.AddressPtr <> nil then
              begin
                CoCopyAddress( TCP_Accept.AddressPtr, @TCP_Accept.Address );
              end;

              UpperComplete( TCP_Accept.Handle, CST_SUCCESS );

              TCP_Accept.Handle := nil;
            end;

          else
            { Nastala nejaka chyba }

            { Hruby zpusoben uvolnime vznikajici zasuvku }

            {!@# nema tady byt LowerRemoveFromReceiveList( 0 ) ?? }

            TcpResetRemoteAddr;
            { !@# pokud tato funkce vrati <> CST_SUCCESS, pak
              se nekdo zaregistroval na nasem lokalnim portu,
              nezbyde nic jineho nez provest unbind a bind na jinem portu..}

            TCP_Accept.DevicePtr^ := nil;

            if TCP_Accept.AddressPtr <> nil then
            begin
              TCP_Accept.AddressPtr^.Size := 0;
            end;

            { Nejaka chyba }

            UpperComplete( TCP_Accept.Handle, Status );

            TCP_Accept.Handle := nil;
          end;

        end;

      end;

    end;

    function CanAcceptSynSegment: Boolean;
    var
      Dev : PCoDevice;
    begin
      Dev := __GetLowerDevice;
      if Dev <> nil then
      begin
        CanAcceptSynSegment :=
          Dev^.CO_UpperDevicesCount <
          Dev^.CO_DeviceParams.MaxUpperDevices - 4;
      end
      else
        CanAcceptSynSegment := False;

      Dev^.Release;
    end;

  begin
    CoCopyAddress( @SrcAddr, @APacket^.Address );

    { APacket^.Header ukazuje na hlavicku TCP segmentu }

    with PTcpHeader(APacket^.Header)^ do
    begin
      Seg.SEQ := SwapL(SeqNumber);  { Cislo prvniho oktetu segmentu }
      Seg.ACK := SwapL(AckNumber);  { Potrzeni                      }
      Seg.LEN := APacket^.DataSize; { Delka segmentu                }
      Seg.WND := Swap(Window);      { Velikost okna                 }
     {Seg.UP  := Swap(UrgPtr);      { Urgentni ukazatel             }
     {Seg.PRC :=                    { Priorita???                   }
      Seg.CTL := Control;           { Ridici bity                   }
    end;

    { Pokud TCP hlavicka nema standardni delku zkontrolujeme
      volitelnou cast a zpracujeme vsechny options  }
    if PTcpHeader(APacket^.Header)^.DataOfs <>
         (SizeOf( TTcpHeader ) div 4) shl 4 then
    begin
      HandleTcpOptions( APacket^.Header );
    end;

    case TCB.State of

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

      TCP_CLOSED:
      begin
        { Kanal je uzavren }

        if SEG.CTL and TCP_CTRL_RST = 0 then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_CLOSED: segment with RST arrived' );
          {$ENDIF}

          { Prisel segment, ktery nema nastavey RTS priznak }

          if SEG.CTL and TCP_CTRL_ACK = 0 then
          begin
            { Posleme <SEQ=0><ACK=SEG.SEQ+SEG.LEN><CTL=RST,ACK> }
            TcpSendCtrlSegment( 0, SEG.SEQ + SEG.LEN,
              TCP_CTRL_ACK or TCP_CTRL_RST, @SrcAddr, TCP_PKT_NORMAL )
          end
          else begin
            { Posleme <SEQ=SEG.ACK><CTL=RST> }
            TcpSendCtrlSegment( SEG.ACK, 0, TCP_CTRL_RST, @SrcAddr,
              TCP_PKT_NORMAL );
          end;

          Exit;
        end
        else begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_CLOSED: segment arrived, dropped' );
          {$ENDIF}

          Exit;
        end;

      end;

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

      TCP_LISTEN:
      begin
        {!@# tady by to chtelo... zahodit segment pokud ip datagram je obeznik..
             bohuzel to nevime.}

        { Cekame na navazani spojeni }

        if SEG.CTL and TCP_CTRL_RST <> 0 then
        begin
          { Pokud ma segment nastaven priznak RST - zahodime }
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_LISTEN: segment with RST arrived, dropped' );
          {$ENDIF}
          Exit;
        end;

        if SEG.CTL and TCP_CTRL_ACK <> 0 then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_LISTEN: segment with ACK arrived, resetting connection' );
          {$ENDIF}

           { Prislo potvrzeni (v tomto okamziku je to spatne),
            odesleme RST }

          { Odesleme <SEQ=SEG.ACK><CTL=RST> }

          TcpSendCtrlSegment( SEG.ACK, 0, TCP_CTRL_RST, @SrcAddr,
            TCP_PKT_NORMAL );

          Exit;
        end;

        if SEG.CTL and TCP_CTRL_SYN <> 0 then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_LISTEN: segment with SYN arrived, Port=', SrcAddr.Port );
          {$ENDIF}

          if TCP_Accept.Backlog.MaxCount > 0 then
          begin
            { Mame backlog }

            { Vlozime SYN segment na konec seznamu }

            if CanAcceptSynSegment and
               TCP_Accept.Backlog.InsertTail( APacket ) then
            begin

              if (TCP_Accept.Handle <> nil) and (TCP_Accept.Device = nil) then
              begin
                { Aplikacni vrstva zavolala Accept a ten jeste nebyl vyrizen
                  ani se nevyrizuje.. }
                TcpBacklogAccept;
                {!@# co se statusem..?..asi nic}
              end;
            end
            else begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_LISTEN: backlog is full' );
              {$ENDIF}

              { Backlog je plny, posleme RST segment }

              TcpSendCtrlSegment( 0 {SEQ}, SEG.SEQ + SEG.LEN,
                TCP_CTRL_ACK or TCP_CTRL_RST, @SrcAddr, TCP_PKT_NORMAL );
            end;

            Exit;
          end
          else begin

            { Nemame Backlog .. primo tento soket navaze spojeni }

            { Pokud je TCP_OpenHandle <> nil, pak tento
              soket byl vytvoren nejakym jinym soketem v ramci
              metody Accept.. a aktualne zpracovavany paket byl
              pouze vhozen do fronty v ramci metody TcpAcceptBacklog.. }

            if TCP_OpenHandle = nil then
            begin

              if TCP_Accept.Handle = nil then
              begin
                { Nejsme pripraveni navazat spojeni, protoze
                  v Backlogu neni misto a aplikace nezavolala Accept  }

                {$IFDEF DEBUG_TCP}
                WriteLn( SID,  'TCP_LISTEN: not ready to accept connection' );
                {$ENDIF}

                { Posleme RST segment }

                TcpSendCtrlSegment( 0 {SEQ}, SEG.SEQ + SEG.LEN,
                  TCP_CTRL_ACK or TCP_CTRL_RST, @SrcAddr, TCP_PKT_NORMAL );

                Exit;
              end
              else begin

                if Assigned( TCP_Accept.Filter ) and
                   TCP_Accept.Filter( @APacket^.Address ) then
                begin
                  { Aplikace odmitla spojeni }

                  {$IFDEF DEBUG_TCP}
                  WriteLn( SID,  'TCP_LISTEN: apllication has refused connection' );
                  {$ENDIF}

                  { Posleme RST segment }

                  TcpSendCtrlSegment( 0 {SEQ}, SEG.SEQ + SEG.LEN,
                    TCP_CTRL_ACK or TCP_CTRL_RST, @SrcAddr, TCP_PKT_NORMAL );

                  Exit;
                end;

              end;

            end;

            { Pokracujeme dale..}
          end;

          { Zde by mela byt podle RFC-793 kontrola security/compartment
             --- vynechavame }

          TCB.RCV.WUP := ULONG_INC( SEG.SEQ );
          TCB.RCV.NXT := TCB.RCV.WUP;
          TCB.RCV.BRD := TCB.RCV.WUP;
          TCB.RCV.IRS := SEG.SEQ;


          if SEG.LEN > 0 then
          begin
            { Data segmentu vlozime do prijimaci fronty }
            TcpProcessData( SEG.SEQ, APacket );
          end;

          TCB.SND.ISS := TcpChooseISN( @TCP_LocalAddr, @SrcAddr );

          TCB.RCV.WND := TCP_Settings.MinWindow;

          { Odesleme segment }
          { <SEQ=ISS><ACK=RCV.NXT><CTL=SYN,ACK> }

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_LISTEN: Sending SYN segment' );
          {$ENDIF}

          TcpSendCtrlSegment( TCB.SND.ISS, TCB.RCV.NXT,
                              TCP_CTRL_SYN or TCP_CTRL_ACK or
                              TCP_CTRL_MSS, @SrcAddr, TCP_PKT_NORMAL );


          { Restartujeme RTO casovac }
          TcpRTOTimerRestart;

          TCB.SND.NXT := ULONG_INC( TCB.SND.ISS );
          TCB.SND.WRI := TCB.SND.NXT;
          TCB.SND.UNA := TCB.SND.ISS;

          TCB.State := TCP_SYN_RECEIVED;


          if TcpSetRemoteAddr( @SrcAddr ) <> CST_SUCCESS then
          begin
            { Nemelo by nikdy nastat }
            RunError( 255 );
          end;

          Exit;
        end
        else begin
          { Zahodime segment }
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_LISTEN: segment without SYN arrived, dropped' );
          {$ENDIF}
          Exit;
        end;

      end;

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

      TCP_SYN_SENT:
      begin
        { Zpracovani ACK priznaku }

        if SEG.CTL and TCP_CTRL_ACK <> 0 then
        begin
          { Zkotrolujeme zda prijate potvrzeni je v platnem rozsahu }
          if ULONG_LE( SEG.ACK, TCB.SND.ISS ) or
             ULONG_GT( SEG.ACK, TCB.SND.NXT ) then
          begin
            { Ne neni }

            {$IFDEF DEBUG_TCP}
            WriteLn( SID,  'TCP_SYN_SENT: segment with invalid ACK' );
            {$ENDIF}

            if SEG.CTL and TCP_CTRL_RST = 0 then
            begin
              { Odeslat <SEQ=SEG.ACK><CTL=RST> }

              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_SYN_SENT: Sending RST segment' );
              {$ENDIF}

              TcpSendCtrlSegment( SEG.ACK, 0, TCP_CTRL_RST, @SrcAddr,
                TCP_PKT_NORMAL );
            end;

            Exit;
          end;

        end;

        { Do tohoto mista se dostaneme, jestlize segment neobsahuje ACK
          nebo obsahuje ACK a ten je v poradku..}

        { Zpracovani RST priznaku }

        if SEG.CTL and TCP_CTRL_RST <> 0 then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'TCP_LISTEN: segment without SYN arrived, dropped' );
          {$ENDIF}

          if SEG.CTL and TCP_CTRL_ACK <> 0 then
          begin
            DoOpenCompleted( CST_TCP_ERR_CONNRESET);
            TCB.State := TCP_CLOSED;
          end;
          Exit;
        end;

        { kontrola SECURITY/PRECEDENCE - vynechavame }

        { Zpracovani SYN priznaku }

        if SEG.CTL and TCP_CTRL_SYN <> 0 then
        begin
          TCB.RCV.WUP := ULONG_INC( SEG.SEQ );
          TCB.RCV.NXT := TCB.RCV.WUP;
          TCB.RCV.BRD := TCB.RCV.WUP;
          TCB.RCV.IRS := SEG.SEQ;

          if SEG.CTL and TCP_CTRL_ACK <> 0 then
          begin
            TCB.SND.UNA := SEG.ACK;

            { Vyjmuti segmentu z retransmittion queue, ktere
              jiz byly potvrzeny }

            {!! tohle je nejake divne...vzdyt jsme jeste
                nikomu zadna data poslat nemohli }

            TcpTxQCommit( SEG.ACK );
          end;

          if ULONG_GT( TCB.SND.UNA, TCB.SND.ISS ) then
          begin
            { nas SYN byl potvrzen }

            TCB.SND.WND := SEG.WND;
            TCB.SND.WL1 := SEG.SEQ;
            TCB.SND.WL2 := SEG.ACK;

            { Congestion control, viz. RFC-2581 }
            TCB.SND.CWND    := 2 * TCB.SND.MSS;
            TCB.SND.SSTRESH := SEG.WND;

            {$IFDEF DEBUG_TCP_CWND}
            WriteLn( SID,  'Initial setting: CWND=', TCB.SND.CWND,
                     ' SSTRESH=', TCB.SND.SSTRESH );
            {$ENDIF}

            { Odeslat <SEQ=SND.NXT><ACK=RCV.NXT><CTL=ACK> }
            { Bylo by mozne zahrnout i data cekajici ve fronte }

            TcpAckSend;

            { pokracovat sestym bodem v ESTABLISHED}

            DoOpenCompleted( CST_SUCCESS );

            TCB.State := TCP_ESTABLISHED;

            goto L_ESTABLISHED_6;

          end
          else begin

            { Odeslat <SEQ=ISS><ACK=RCV.NXT><CTL=SYN,ACK> }

            TcpSendCtrlSegment( TCB.SND.ISS, TCB.RCV.NXT,
                                TCP_CTRL_SYN or TCP_CTRL_ACK or
                                TCP_CTRL_MSS, @SrcAddr, TCP_PKT_NORMAL );

            TCB.State := TCP_SYN_RECEIVED;
          end;
        end;

        Exit;

      end;

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

      TCP_SYN_RECEIVED,
      TCP_ESTABLISHED,
      TCP_FIN_WAIT1,
      TCP_FIN_WAIT2,
      TCP_CLOSE_WAIT,
      TCP_CLOSING,
      TCP_LAST_ACK,
      TCP_TIME_WAIT:
      begin
        {---------------------------------}
        { 1. Nejprve kontrola zda segment }
        { ma spravnou delku a seq cislo   }
        {---------------------------------}

        {!@ tady to scitani....!!!!!!!!! pozor na preteceni }

        if SEG.LEN = 0 then
        begin

          if TCB.RCV.WND = 0 then
          begin
            OK := SEG.SEQ = TCB.RCV.NXT;
          end
          else begin

            OK := ULONG_LE( TCB.RCV.NXT, SEG.SEQ ) and
                  ULONG_LT( SEG.SEQ, ULONG_ADD( TCB.RCV.NXT, TCB.RCV.WND ) );
          end;
        end
        else begin

          if TCB.RCV.WND = 0 then
          begin
            { Tento segment bude nejspis Zero Window Probe }
            OK := False;
          end
          else begin

            Mark1 := ULONG_ADD( TCB.RCV.NXT, TCB.RCV.WND );
            Mark2 := ULONG_DEC( ULONG_ADD( SEG.SEQ, SEG.LEN ) );

            OK := ULONG_LE( TCB.RCV.NXT, SEG.SEQ ) and
                  ULONG_LT( SEG.SEQ, Mark1 ) or
                  ULONG_LE( TCB.RCV.NXT, Mark2 ) and
                  ULONG_LT( Mark2, Mark1 );

            { OK kdyz prichozi segment zacina nebo konci uvnitr okna }
          end;
        end;

        if not OK then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  TcpStateToStr( TCB.State ), ': invalid SEQ number or Zero Window Probe' );
          {$ENDIF}

          if SEG.CTL and TCP_CTRL_RST = 0 then
          begin
            { Odeslat <SEQ=SND.NXT><ACK=RCV.NXT><CTL=ACK> }

            {$IFDEF DEBUG_TCP}
            WriteLn( SID,  TcpStateToStr( TCB.State ), ': Sending ACK segment' );
            {$ENDIF}

            TcpSendCtrlSegment( TCB.SND.NXT, TCB.RCV.NXT,
                                TCP_CTRL_ACK, @SrcAddr, TCP_PKT_NORMAL );
          end;

          Exit;
        end;

        {---------------------------------}
        { 2. Testovani RST priznaku       }
        {---------------------------------}

        if SEG.CTL and TCP_CTRL_RST <> 0 then
        begin

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  TcpStateToStr( TCB.State ), ': segment with RST arrived' );
          {$ENDIF}

          case TCB.State of

            TCP_SYN_RECEIVED:
            begin

              if TCP_Passive and (TcpResetRemoteAddr = CST_SUCCESS) then
              begin
                TCB.State := TCP_LISTEN;
              end
              else begin
                { Spojeni bylo protejsi stanici odmitnuto }

                { vyjmout vsechny segmenty z retransmition queue
                  RetransQueueFlush }

                TcpTxQFlush( CST_TCP_ERR_CONNREFUSED );

                DoOpenCompleted( CST_TCP_ERR_CONNREFUSED );

                TCB.State := TCP_CLOSED;
              end;

              Exit;
            end;

            TCP_ESTABLISHED,
            TCP_FIN_WAIT1,
            TCP_FIN_WAIT2,
            TCP_CLOSE_WAIT:
            begin
              { Vsechny probihajici pozadavky se vraci s ERR_CONNRESET }

              TcpTxQFlush( CST_TCP_ERR_CONNRESET );
              TcpRxQFlush( CST_TCP_ERR_CONNRESET );

              UpperComplete( TCP_CloseHandle, CST_TCP_ERR_CONNRESET );

              { odregistrovat port }
              TcpResetRemoteAddr;

              TCB.State := TCP_CLOSED;
              Exit;
            end;


            TCP_CLOSING,
            TCP_LAST_ACK:
            begin
              TcpResetRemoteAddr;

              { Zrusime vsechny ostatni casovace }

              TcpRTOTimerStop;
              TcpNagleTimerStop;
              TcpAckTimerStop;

              UpperComplete( TCP_CloseHandle, CST_SUCCESS );
              TCB.State := TCP_CLOSED;
              Exit;
            end;


            TCP_TIME_WAIT:
            begin
              TcpResetRemoteAddr;

              TCB.State := TCP_CLOSED;
              Exit;
            end;

          end;

        end;

        {---------------------------------}
        { 3. Kontrola security/precedence }
        {---------------------------------}

        {---------------------------------}
        { 4. Zpracovani SYN priznaku      }
        {---------------------------------}

        if SEG.CTL and TCP_CTRL_SYN <> 0 then
        begin

          if TCP_Passive and (TCB.State = TCP_SYN_RECEIVED) then
          begin
            TCB.State := TCP_LISTEN;
            Exit;
          end
          else begin

            { Prijem SYN je v tomto pripade chyba }
            { Posleme segment s RST }

            {!@# zkontrolovat zda muzeme poslat SEG.ACK..?}
            TcpSendCtrlSegment( SEG.ACK, 0, TCP_CTRL_RST, @SrcAddr,
              TCP_PKT_NORMAL );

            TcpTxQFlush( CST_TCP_ERR_CONNRESET );
            TcpRxQFlush( CST_TCP_ERR_CONNRESET );

            {!@# provest jeste LowerCancel vsech pozadavku... }

            {
            !@# flush vsech front}

            if TCB.State = TCP_SYN_RECEIVED then
            begin
              DoOpenCompleted( CST_TCP_ERR_CONNRESET );
            end;

            TCB.State := TCP_CLOSED;
            Exit;
          end;

        end;

        {---------------------------------}
        { 5. Zpracovani ACK priznaku      }
        {---------------------------------}

        if SEG.CTL and TCP_CTRL_ACK = 0 then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  TcpStateToStr( TCB.State ), ': segment without ACK, dropped' );
          {$ENDIF}

          { Segment nema nastaveny ACK bit, zahodime }
          Exit;
        end;


        { ACK priznak je nastaven }

        case TCB.State of

          TCP_SYN_RECEIVED:
          begin
            if ULONG_LE( TCB.SND.UNA, SEG.ACK) and
               ULONG_LE( SEG.ACK, TCB.SND.NXT) then
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_SYN_RECEIVED: connection established' );
              {$ENDIF}

              TCB.State := TCP_ESTABLISHED;

              TCB.SND.WND := SEG.WND;
              TCB.SND.WL1 := SEG.SEQ;
              TCB.SND.WL2 := SEG.ACK;

              { Congestion control, viz. RFC-2581 }
              TCB.SND.CWND    := 2 * TCB.SND.MSS;
              TCB.SND.SSTRESH := SEG.WND;

              {$IFDEF DEBUG_TCP_CWND}
              WriteLn( SID,  'Initial setting: CWND=', TCB.SND.CWND,
                       ' SSTRESH=', TCB.SND.SSTRESH );
              {$ENDIF}


              DoOpenCompleted( CST_SUCCESS );

              goto L_ESTABLISHED_5;
            end
            else begin
              { Odeslat <SEQ=SEG.ACK><CTL=RST> }

              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_SYN_RECEIVED: sending RST segment, invalid ACK' );
              {$ENDIF}

              TcpSendCtrlSegment( SEG.ACK, 0, TCP_CTRL_RST, @SrcAddr,
                TCP_PKT_NORMAL );

              Exit; {!@# asi...????}
            end;

          end;

          TCP_ESTABLISHED,
          TCP_FIN_WAIT1,
          TCP_FIN_WAIT2,
          TCP_CLOSE_WAIT,
          TCP_CLOSING:
        L_ESTABLISHED_5:
          begin
            if ULONG_LE( TCB.SND.UNA, SEG.ACK ) and
               ULONG_LE( SEG.ACK, TCB.SND.NXT ) then
            begin

              if TCB.SND.UNA <> SEG.ACK then
              begin
                { Potvrzeni neceho co jeste nebylo potvrzeno }
                TCB.SND.UNA := SEG.ACK;
                { Nyni muzene odstranit pakety z retransmition queue,
                a potvrdit pozadavky uzivatele }

                TcpTxQCommit( SEG.ACK );

                { Pokud merime RTT, zjistime, zda mereny segment
                  nebyl potvrzen }

                if TCP_RTO.Estimating then
                begin
                  if ULONG_GT( SEG.ACK, TCP_RTO.SendSEQ ) then
                  begin
                    TcpRTOUpdate( CoTimeDistMs( CoGetTime, TCP_RTO.SendTime ) );
                    TCP_RTO.Estimating := False;
                  end;
                end;

                { Restartujeme RTO casovac }
                TcpRTOTimerRestart;

                { Uprava CWND podle (RFC-2281 - Congestion Control) }
                if TCB.SND.CWND < TCB.SND.SSTRESH then
                begin
                  { Pomaly start }
                  TempW := TCB.SND.MSS;

                  { Muzeme inkrementovat, aniz by CWND preteklo ? }
                  if 32767 - TempW >= TCB.SND.CWND then
                  begin
                    Inc( TCB.SND.CWND, TempW );
                  end
                  else
                    TCB.SND.CWND := 32767;

                  {$IFDEF DEBUG_TCP_CWND}
                  WriteLn( SID,  'Slow start: CWND=', TCB.SND.CWND,
                           ' SSTRESH=', TCB.SND.SSTRESH );
                  {$ENDIF}

                end
                else begin
                  { Vyhybani se zahlceni }
                  TempW := LongDiv(LongMul(TCB.SND.MSS, TCB.SND.MSS), TCB.SND.CWND);

                  if TempW = 0 then TempW := 1;

                  { Muzeme inkrementovat, aniz by CWND preteklo ? }
                  if 32767 - TempW >= TCB.SND.CWND then
                  begin
                    Inc( TCB.SND.CWND, TempW );
                  end
                  else
                    TCB.SND.CWND := 32767;

                  {$IFDEF DEBUG_TCP_CWND}
                  WriteLn( SID,  'Cong. avoidance: CWND=', TCB.SND.CWND,
                           ' SSTRESH=', TCB.SND.SSTRESH );
                  {$ENDIF}
                end;

              end
              else begin
                { ACK je duplicitni .. }
                { !@# zde by se dal implementovat algoritmus
                  Fast Recovery podle RFC-2581 }
              end;

              if SEG.ACK = TCB.SND.NXT then
              begin
                { Pokud byla potvrzena vsechna odeslana data, pak
                  zastavime RTO casovac }
                TcpRTOTimerStop;
              end;

              if ULONG_LT( TCB.SND.WL1, SEG.SEQ) or
                 ((TCB.SND.WL1 = SEG.SEQ) and
                 ULONG_LE( TCB.SND.WL2, SEG.ACK)) then
              begin
                { Update vysilaciho okna }
                TCB.SND.WND := SEG.WND;
                TCB.SND.WL1 := SEG.SEQ;
                TCB.SND.WL2 := SEG.ACK;
              end;


              if (SEG.LEN = 0) and
                 (TCB.State in [TCP_ESTABLISHED, TCP_CLOSE_WAIT,
                                TCP_FIN_WAIT1, TCP_CLOSING]) then
              begin
                { 20.2.2003 - data posilame i ve stavu FIN_WAIT1, CLOSING
                  jsou to data, ktera nebyla jeste odeslana kdyz byla
                  asynchronne zavolana metoda MiniportDisconnect.. }

                { Pokud segment neobsahuje zadna data, pokusime se
                  poslat nejaka data uz tady.. ne az pri zpracovani
                  prichozich dat }
                TcpCheckAndSendData;
              end;

            end;

            { Dalsi zpracovani jen v nekterych stavech }

            case TCB.State of

              TCP_FIN_WAIT1:
              begin
                if (SEG.ACK = TCB.SND.NXT) and TCP_FINSent {our_fin_acked} then
                begin
                  {$IFDEF DEBUG_TCP}
                  WriteLn( SID,  'TCP_FIN_WAIT1: our fin acked --> TCP_FIN_WAIT2' );
                  {$ENDIF}

                  { Nas FIN byl potvrzen }
                  TCB.State := TCP_FIN_WAIT2;
                end
               (* else begin odstraneno 20.2.2003
                  TCB.State := TCP_CLOSING;
                  {$IFDEF DEBUG_TCP}
                  WriteLn( SID,  'TCP_FIN_WAIT1: --> TCP_CLOSING' );
                  {$ENDIF}
                 end;*)
              end;

              TCP_FIN_WAIT2:
            L_FIN_WAIT2:
              begin
                {!@# start timewait timer }

                { Zrusime vsechny casovace }

                TcpRTOTimerStop;
                TcpNagleTimerStop;
                TcpAckTimerStop;


                {!@# start timewait timer, vypnout vsechny ostatni casovace..}
                (*if retrans_q_epmty then
                begin
                  { muzeme potvrdit disconnect, unbind }
                  UpperComplete( TCP_CloseHandle, CST_SUCCESS );
                end;*)
              end;

              TCP_CLOSING:
              begin
                if (SEG.ACK = TCB.SND.NXT) and TCP_FINSent {our_fin_acked} then
                begin
                  {$IFDEF DEBUG_TCP}
                  WriteLn( SID,  'TCP_CLOSING: --> TCP_TIME_WAIT' );
                  {$ENDIF}


                  { Nas FIN byl potvrzen }

                  { Spustime Time wait timer }

                  TcpTimeWaitTimerStart;

                  { Zrusime vsechny ostatni casovace }

                  TcpRTOTimerStop;
                  TcpNagleTimerStop;
                  TcpAckTimerStop;

                  UpperComplete( TCP_CloseHandle, CST_SUCCESS );
                  TCB.State := TCP_TIME_WAIT;
                end;
              end;

            end;

          end;

          TCP_LAST_ACK:
          begin
            if SEG.ACK = TCB.SND.NXT {our_fin_acked} then
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_LAST_ACK: --> TCP_CLOSED' );
              {$ENDIF}

              { Nas FIN byl potvrzen }
              UpperComplete( TCP_CloseHandle, CST_SUCCESS );

              TcpResetRemoteAddr;

              TCB.State := TCP_CLOSED;
              Exit;
            end;
          end;

          TCP_TIME_WAIT:
          begin
            { V tomto okamziku muze prijit akorat opakovani FIN segmentu }

            if SEG.CTL and TCP_CTRL_FIN <> 0 then
            begin
              { Potvrdime fin .. }

              TcpSendCtrlSegment( TCB.SND.NXT {SEQ}, TCB.RCV.NXT {ACK},
                                  TCP_CTRL_ACK, @SrcAddr, TCP_PKT_NORMAL );

              { Restartujeme casovac time wait ..}

              TcpTimeWaitTimerStop;
              TcpTimeWaitTimerStart;

            end;
          end;
        end;

        {---------------------------------}
        { 6. Zpracovani URG priznaku      }
        {---------------------------------}

      L_ESTABLISHED_6:

        if SEG.CTL and TCP_CTRL_URG <> 0 then
        begin
          case TCB.State of
            TCP_ESTABLISHED,
            TCP_FIN_WAIT1,
            TCP_FIN_WAIT2:
            begin
              {!@#TCB.RCV.UP := ULONG_MAX( TCB.RCV.UP, SEG.UP );}
              {!@# ... co tady s tim ? }
            end;

            { V ostatnich pripadech URG ignorujeme }
          end;
        end;

        {---------------------------------}
        { 7. Zpracovai dat segmentu       }
        {---------------------------------}

        case TCB.State of

          TCP_ESTABLISHED,
          TCP_FIN_WAIT1,
          TCP_FIN_WAIT2:
          begin
            { Mame jistotu, ze segment (nebo alespon jeho cas
              spada do prijimaciho okna }

            if SEG.LEN > 0 then
            begin

              { Data segmentu vlozime do prijimaci fronty }

              Mark1 := TCB.RCV.NXT;

              TcpProcessData( SEG.SEQ, APacket );

              { TcpProcessData upravila RCV.NXT, pokud bylo potreba  }

              Mark1 := ULONG_SUB( TCB.RCV.NXT, Mark1 );

              { V Mark1 mame pocet oktetu, o ktere bylo posunuto ukazovatko
                RCV.NXT }

              { Upravime RCV.WND tak aby se prava strana okna neposunula doleva }

              Dec( TCB.RCV.WND, Mark1 );

              { SWS algoritmus podle RFC1122 - str.98 }
              { Okno rozsirime az tehdy, kdyz je muzeme rozsirit o MSS nebo
                o polovinu velikosti prijimaciho kruhoveho bufferu }

              {!@# nema tady byt RCV.MSS???}

              {!@# udelat jinak, az bude okno zvetsovatelne }
              TempW := TCP_RxBuffer.Size div 2;
              if TempW > TCB.SND.MSS then TempW := TCB.SND.MSS;

              if TCP_RxBuffer.FreeBytes - TCB.RCV.WND > TempW then
              begin
                {$IFDEF DEBUG_TCP_WND}
                Write( 'Extending RCV.WND from ', TCB.RCV.WND );
                {$ENDIF}
                TCB.RCV.WND := TCP_RxBuffer.FreeBytes;
                TCB.RCV.WUP := TCB.RCV.NXT;

                {$IFDEF DEBUG_TCP_WND}
                WriteLn( SID,  ' to ', TCB.RCV.WND, ' bytes' );
                {$ENDIF}

                RightEdgeExtended := True;
              end
              else
                RightEdgeExtended  := False;


              { Pokud TcpCheckAndSendData odesle data, naplanovani ACKu
                bude zruseno }
              if TCB.State in [TCP_ESTABLISHED, TCP_FIN_WAIT1, TCP_CLOSING] then
              begin
                { 20.2.2003 - data posilame i ve stavu FIN_WAIT1, CLOSING
                  jsou to data, ktera nebyla jeste odeslana kdyz byla
                  asynchronne zavolana metoda MiniportDisconnect.. }


                {!@# TADY JE TO BLBE!!! prvni cast podminky nebude nikdy
                     splnena }

                if {((ULONG_SUB( TCB.RCV.NXT, TCB.RCV.WUP ) > TCB.RCV.MSS) and}
                   RightEdgeExtended or
                   TCP_Ack.QuickMode or (TCP_OFOQueue.Count > 0) then
                begin
                  TcpAckSend;
                end
                else
                  TcpAckSendDelayed;


                { Odesleme nejaka data pokud to pujde a pokusime
                  se s daty odeslat ACK..pokud se to povede
                  delayed ack bude zrusen }
                TcpCheckAndSendData;


              end;

            end;

          end;

          { V ostatnich pripadech data ignorujeme }

        end;

        {---------------------------------}
        { 8. Zpracovani FIN bitu          }
        {---------------------------------}

        if SEG.CTL and TCP_CTRL_FIN <> 0 then
        begin

          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  TcpStateToStr( TCB.State ), ': FIN received' );
          {$ENDIF}


          { Vratime vsechny pozadavky na cteni aplikacni vrstve,
            s tim, ze se spojeni ukoncuje }
          TcpRxQFlush( CST_TCP_ERR_CONNCLOSING );

          { Posuneme ukazovatko RCV.NXT za FIN }
          TCB.RCV.NXT := ULONG_INC( TCB.RCV.NXT );

          { Potvrdime FIN }

          TcpSendCtrlSegment( TCB.SND.NXT {SEQ}, TCB.RCV.NXT {ACK},
                              TCP_CTRL_ACK, @SrcAddr, TCP_PKT_NORMAL );

          case TCB.State of

            TCP_SYN_RECEIVED:
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_SYN_RECEIVED: --> TCP_CLOSING' );
              {$ENDIF}

              DoOpenCompleted( CST_SUCCESS );

              TCB.State := TCP_CLOSING;
            end;

            TCP_ESTABLISHED:
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_ESTABLISHED: --> TCP_CLOSE_WAIT' );
              {$ENDIF}

              TCB.State := TCP_CLOSE_WAIT;
            end;

            TCP_FIN_WAIT1:
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_FIN_WAIT1: --> TCP_CLOSING' );
              {$ENDIF}

              { Podle RFC bychom meli take mohli prejit do stavu
                TCP_TIME_WAIT pokud nas FIN byl potvrzen.. ale
                to uz resi obsluha ACKu (nas FIN v teto situaci tedy
                neni nikdy ACKed }

              TCB.State := TCP_CLOSING;
            end;

            TCP_FIN_WAIT2:
            begin
              {$IFDEF DEBUG_TCP}
              WriteLn( SID,  'TCP_FIN_WAIT2: --> TCP_TIME_WAIT' );
              {$ENDIF}

              TCB.State := TCP_TIME_WAIT;

              { Spustime casovace Time Wait }

              TcpTimeWaitTimerStart;

              { Zrusime vsechny ostatni casovace }

              TcpRTOTimerStop;
              TcpNagleTimerStop;
              TcpAckTimerStop;

              { Potvrdime disconnect }

              UpperComplete( TCP_CloseHandle, CST_SUCCESS );
            end;

          end;

        end;
      end;

    end;
  end;


  {-------------------------------
  { TCoTCP.TcpAckSend
  {---
  { Okamzite odeslani segmentu bez dat s ACK priznakem
  {---
  { Naplanovany Delayed ACK je zrusen
  {
  }

  procedure TCoTCP.TcpAckSend;
  var
    Seq : Longint;
  begin
    {$IFDEF DEBUG_TCP_ACK}
    WriteLn( SID,  'TcpAckSend()' );
    {$ENDIF}

    { Musime odeslat takovy ACK, aby SEQ segmentu bylo v ramci vysilaciho okna...
      tj. opatreni proti nahlemu posunuti praveho okna druhou stranou }

    { Vypocet SEQ hodnoty, kterou posleme }

    Seq := ULONG_ADD( TCB.SND.UNA, TCB.SND.WND );

    if ULONG_GT( Seq, TCB.SND.NXT ) then Seq := TCB.SND.NXT;

    { Odeslani segmentu s ACK }

    TcpSendCtrlSegment( Seq, TCB.RCV.NXT, TCP_CTRL_ACK, @TCP_RemoteAddr,
      TCP_PKT_NORMAL );

    { Zruseni naplanovaneho ACK }

    if TCP_Ack.Scheduled then
    begin
      TCP_Ack.Scheduled := False;
      CoCancelTimer( @TCP_Ack.Timer );
    end;
  end;

  {-------------------------------
  { TCoTCP.TcpAckTimerStop
  {---
  { Zruseni naplanovaneho zpozdeneho ACK
  {---
  { Pokud Delayed ACK neni naplanovan, metoda nedela nic
  {
  }

  procedure TCoTCP.TcpAckTimerStop;
  begin
    if TCP_Ack.Scheduled then
    begin
      {$IFDEF DEBUG_TCP_ACK}
      WriteLn( SID,  'TcpAckTimerStop()' );
      {$ENDIF}

      CoCancelTimer( @TCP_Ack.Timer );

      TCP_Ack.Scheduled := False;
    end;
  end;


  {-------------------------------
  { TCoTCP.TcpAckSendDelayed
  {---
  { Naplanovani zpozdeneho odeslani ACK segmentu
  {---
  { Pokud je Delayed ACK jiz naplanovan, metoda nedela nic
  {
  }

  procedure TCoTCP.TcpAckSendDelayed;
  begin
    {$IFDEF DEBUG_TCP_ACK}
    WriteLn( SID,  'TcpAckSendDelayed()') ;
    {$ENDIF}
    {! Tady by slo mozna pridat toto:
      pokud je casovac jiz naplanovany, ale ma vyprset v dohledne dobe,
      provest volani TcpSendAck ihned a preplanovat casovac...}

    if not TCP_Ack.Scheduled then
    begin
      TCP_Ack.Scheduled := True;
      CoStartTimer( @TCP_Ack.Timer, TCP_Settings.AckDelay, TCP_TIMER_ACK, nil );
    end;
  end;

  {-------------------------------
  { TCoTCP.TcpAckTimerExpired
  {---
  { Obsluha casovace Delayed Ack
  {---
  {
  }

  procedure TCoTCP.TcpAckTimerExpired;
  begin
    {$IFDEF DEBUG_TCP_ACK}
    WriteLn( SID,  'TcpAckTimerExpired()' );
    {$ENDIF}

    TCP_Ack.Scheduled := False; { Musi byt pred TcpAckSend  }

    TcpAckSend;
  end;


  {-------------------------------
  { TCoTCP.TcpCheckAndSendData
  {---
  { Odeslani dat z fronty (od SND.NXT doprava), pokud je to mozne
  {---
  {
  {
  }

  { Tato metoda se vola pokazde kdyz:
      1) prijdou data z aplikacni vrstvy
      2) kdyz prijde nejake potvrzeni od druhe strany
         (prakticky jakykoli segment)
  }

  procedure TCoTCP.TcpCheckAndSendData;
  var
    EffWnd    : Longint;
    UseWnd    : Longint;  { Useable Window                               }
    NotSent   : Longint;  { Pocet oktetu neodeslanych dat ve fronte      }
    MaxToSend : Word;     { Maximalni pocet oktetu, ktere muzeme odeslat }

    fDataSent : Boolean;

    Ctrl      : Word;

  begin

    { Nasledujici algoritmus dle RFC-1122 str.99-100 }

    { Pocet bufferovanych a neodeslanych oktetu }
    NotSent := ULONG_SUB( TCB.SND.WRI, TCB.SND.NXT );

    {$IFDEF DEBUG_TCP_TX}
    WriteLn( SID,  'TcpCheckAndSendData() NotSent=', NotSent );
    {$ENDIF}

    if NotSent <= 0 then Exit;

    { Pouzitelne okno pro vysilani }

    if TCB.SND.WND < TCB.SND.CWND then
      EffWnd := TCB.SND.WND
    else
      EffWnd := TCB.SND.CWND;

    UseWnd := EffWnd - ULONG_SUB( TCB.SND.NXT, TCB.SND.UNA );

    if UseWnd < 0 then UseWnd := 0;

    { Maximalni pocet oktetu, ktery muzeme odeslat }
    if NotSent < UseWnd then
    begin
      MaxToSend := NotSent
    end
    else
      MaxToSend := UseWnd;

    if MaxToSend = 0 then
    begin

      if (TCB.SND.WND = 0) and (TCB.SND.NXT = TCB.SND.UNA) then
      begin
        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'TcpCheckAndSendData() -- schedule zero window probe' );
        {$ENDIF}

        { Naplanujeme Zero Window Probe ...
          pokud vyprsi RTO casovac a velikost okna je nula, pak se
          posle prave jeden oktet  }
        TcpRTOTimerRestart;
      end;

      Exit;
    end;

    fDataSent := False;

    if MaxToSend >= TCB.SND.MSS then
    begin
      {!@# -- pokus}
      { zarovname MaxToSend na nasobek TCB.SND.MSS}
      MaxToSend := MaxToSend - MaxToSend mod TCB.SND.MSS;
      {!@# -- pokus}

      { Posleme data, pokud muzeme odeslat alespon jeden segment o
        maximalni velikosti }

      TcpRTOBeginEstimate( TCB.SND.NXT );

      if TcpTxQTransmit( TCB.SND.NXT, MaxToSend, 0 {Ctrl} ) then
      begin
        { Byl odeslan FIN }
        TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );
      end;

      TCB.SND.NXT := ULONG_ADD( TCB.SND.NXT, MaxToSend );


      fDataSent := True;

    end
    else begin

      if (TCB.SND.NXT = TCB.SND.UNA) or (TCP_Settings.NagleDelay = 0) then
      begin
        { Vsechna predchozi odeslana data byla potvrzena, nebo }
        { je vypnuty casovac pro zpozdene odesilani dat }

        if TCB.SND.PSH and (NotSent <= UseWnd) then
        begin
          TcpRTOBeginEstimate( TCB.SND.NXT );

          { Ve fronte cekaji data s priznakem Pushed a mohou byt
            vyslana vsechna }

          if TcpTxQTransmit( TCB.SND.NXT, NotSent, TCP_CTRL_PSH ) then
          begin
            { Byl odeslan FIN }
            TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );
          end;


          TCB.SND.NXT := ULONG_ADD( TCB.SND.NXT, NotSent );

          fDataSent := True;

        end
        else begin

          if (MaxToSend >= EffWnd div 2) or
             (TCP_Settings.NagleDelay = 0) then
          begin
            { Vsechna predchozi data byla potvrzena a my muzeme
              zaplnit alespon polovinu vysilaciho okna }

            TcpRTOBeginEstimate( TCB.SND.NXT );

            { Pro pripady, kdy je okno mensi nez MSS }


            if TcpTxQTransmit( TCB.SND.NXT, MaxToSend, 0 {Ctrl} ) then
            begin
              { Byl odeslan FIN }
              TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );
            end;

            TCB.SND.NXT := ULONG_ADD( TCB.SND.NXT, MaxToSend );

            fDataSent := True;

          end
          else
            TcpNagleTimerStart;

        end

      end
      else
        TcpNagleTimerStart;

    end;


    if fDataSent then
    begin
      { Naplanujeme RTO Timer }
      TcpRTOTimerRestart;

      { Pokud byl naplanovany ACK, tak jej zrusime }
      TcpAckTimerStop;
    end;

    if TCB.SND.PSH and ULONG_GE( TCB.SND.NXT, TCB.SND.PSS ) then
    begin
      { Pokud jsme vyslali data s PSH priznakem, pak priznak zrusime }
      TCB.SND.PSH := False;
    end;

  end;

  {-------------------------------
  { TCoTCP.TcpNagleTimerStart
  {---
  { Naplanovani casovace zpozdeneho odesilani segmentu s daty
  {---
  {
  }

  procedure TCoTCP.TcpNagleTimerStart;
  begin
    if not TCP_Nagle.Scheduled then
    begin
      {$IFDEF DEBUG_TCP_NAGLE}
      WriteLn( SID, 'TcpStartNagleTimer()' );
      {$ENDIF}
      CoStartTimer( @TCP_Nagle.Timer, TCP_Settings.NagleDelay, TCP_TIMER_NAGLE, nil );
      TCP_Nagle.Scheduled := True;
    end
  end;

  {-------------------------------
  { TCoTCP.TcpNagleTimerStop
  {---
  { Zastaveni casovace zpozdeneho odesilani segmentu s daty
  {---
  {
  }

  procedure TCoTcp.TcpNagleTimerStop;
  begin
    if TCP_Nagle.Scheduled then
    begin
      {$IFDEF DEBUG_TCP_NAGLE}
      WriteLn( SID, 'TcpStartNagleTimer()' );
      {$ENDIF}
      CoCancelTimer( @TCP_Nagle.Timer );
      TCP_Nagle.Scheduled := False;
    end;
  end;


  {-------------------------------
  { TCoTCP.TcpNagleTimerExpired
  {---
  { Obsluha casovace zpozdeneho odesilani segmentu s daty
  {---
  {
  }

  procedure TCoTCP.TcpNagleTimerExpired;
  var
    EffWnd    : Longint;
    UseWnd    : Longint;  { Useable Window                               }
    NotSent   : Longint;  { Pocet oktetu neodeslanych dat ve fronte      }
    MaxToSend : Word;     { Maximalni pocet oktetu, ktere muzeme odeslat }
  begin
    {$IFDEF DEBUG_TCP_NAGLE}
    WriteLn( SID,  'TcpNagleTimerExpired()' );
    {$ENDIF}

    TCP_Nagle.Scheduled := False;

    { Nasledujici algoritmus dle RFC-1122 str.99-100 }

    { Pocet bufferovanych a neodeslanych oktetu }
    NotSent := ULONG_SUB( TCB.SND.WRI, TCB.SND.NXT );

    if NotSent = 0 then Exit;

    { Pouzitelne okno pro vysilani }
    if TCB.SND.WND < TCB.SND.CWND then
      EffWnd := TCB.SND.WND
    else
      EffWnd := TCB.SND.CWND;

    UseWnd := EffWnd - ULONG_SUB( TCB.SND.NXT, TCB.SND.UNA );

    if UseWnd < 0 then UseWnd := 0;

    { Maximalni pocet oktetu, ktery muzeme odeslat }
    if NotSent < UseWnd then
    begin
      MaxToSend := NotSent
    end
    else
      MaxToSend := UseWnd;

    {!@# --- kdy data posleme, kdyz ted vyskocime.. ?}

    if MaxToSend = 0 then
    begin

      if (TCB.SND.WND = 0) and (TCB.SND.NXT = TCB.SND.UNA) then
      begin
        {$IFDEF DEBUG_TCP}
        WriteLn( SID,  'TcpNagleTimerExpired() -- schedule zero window probe' );
        {$ENDIF}

        { Naplanujeme Zero Window Probe ...
          pokud vyprsi RTO casovac a velikost okna je nula, pak se
          posle prave jeden oktet  }
        TcpRTOTimerRestart;
      end;

      Exit;
    end;

    TcpRTOBeginEstimate( TCB.SND.NXT );

    { Odeslani dat }

    if TcpTxQTransmit( TCB.SND.NXT, MaxToSend, TCP_CTRL_PSH ) then
    begin
      { Byl odeslan FIN }
      TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );
    end;

    { Naplanujeme RTO casovac }
    TcpRTOTimerRestart;

    { Posuneme ukazovatko odeslanych dat }
    TCB.SND.NXT := ULONG_ADD( TCB.SND.NXT, MaxToSend );

    if TCB.SND.PSH and ULONG_GE( TCB.SND.NXT, TCB.SND.PSS ) then
    begin
      { Pokud jsme vyslali data s PSH priznakem, pak priznak zrusime }
      TCB.SND.PSH := False;
    end;

  end;


  {-------------------------------
  { TCoTCP.TcpRTOInit
  {---
  { Inicializace RTO (Retransittion) casovace
  {---
  { Metoda se vola !@#nekdy pri otvirani spojeni
  }


  procedure TCoTCP.TcpRTOInit;
  begin
    { Podle RFC-2988 str. 3 }

    TCP_RTO.Scheduled := False;
    TCP_RTO.RTO := 3 * 1000;
    TCP_RTO.Updated  := False;
    TCP_RTO.Retry := 0;
  end;

  {-------------------------------
  { TCoTCP.TcpRTOStop
  {---
  { Zastaveni RTO casovace
  {---
  { Metoda se vola v okamziku, kdy jsou potvrzeny vsechny odeslane
  { segmenty
  }

  procedure TCoTCP.TcpRTOTimerStop;
  begin
    {$IFDEF DEBUG_TCP_RTO}
    WriteLn( SID,  'TcpRTOStop()' );
    {$ENDIF}
    if TCP_RTO.Scheduled then
    begin
      CoCancelTimer( @TCP_RTO.Timer );
      TCP_RTO.Scheduled := False;
    end;
  end;

  {-------------------------------
  { TCoTCP.TcpRTORestart
  {---
  { Naplanovani RTO casovace.
  {---
  { Pokud je casovac jiz naplanovan, metoda nedela nic
  { 1) Metoda se vola v okamziku kdy je odeslan segment obsahujici data
  {  (i retransmitted segmenty)
  { 2) Pokud jsou potvrzena nejaka data, ktera jeste nebyla potvrzena
  {    (ale nebyla potvrzena vsechna odeslana data)
  }

  procedure TCoTCP.TcpRTOTimerRestart;
  begin
    if not TCP_RTO.Scheduled then
    begin
      {$IFDEF DEBUG_TCP_RTO}
      WriteLn( SID,  'TcpRTORestart()' );
      {$ENDIF}

      TCP_RTO.Retry := 0;
      TCP_RTO.Scheduled := True;
      CoStartTimer( @TCP_RTO.Timer, TCP_RTO.RTO, TCP_TIMER_RETRANSMIT, nil );
    end
  end;


  {-------------------------------
  { TCoTCP.TcpRTOUpdate
  {---
  { Nastaveni hodnot RTO, SRTT a RTTVAR podle naposledy namerene
  { hodnoty RTT (Round Trip Time)
  {---
  { ARTT je namereny cas (Round Trip Time) v ms
  }

  procedure TCoTCP.TcpRTOUpdate( ARTT: TCoTime );
  begin
    { Podle RFC-2988 str. 3 }

    if not TCP_RTO.Updated then
    begin
      { Prvni mereni }

      with TCP_RTO do
      begin
        SRTT    := ARTT;
        RTTVAR  := ARTT div 2;

        if 4 * RTTVAR > 3 then
        begin
          RTO := SRTT + 4 * RTTVAR;
        end
        else
          RTO := SRTT + 3;

        Updated := True;
      end;

    end
    else begin
      { Kazde dalsi merenive }

      with TCP_RTO do
      begin
        RTTVAR := (3 * RTTVAR) div 4 + (SRTT - ARTT) div 4;
        SRTT   := (7 * SRTT) div 8 + ARTT div 8;
        RTO    := SRTT + 4 * RTTVAR;
      end;

    end;

    { RTO by se melo pohybovat v jistych mezich }


    if TCP_RTO.RTO < TCP_MIN_RTO then
    begin
      TCP_RTO.RTO := TCP_MIN_RTO;
    end
    else
      if TCP_RTO.RTO > TCP_MAX_RTO then
      begin
        TCP_RTO.RTO := TCP_MAX_RTO;
      end;

    {$IFDEF DEBUG_TCP_RTO}
    WriteLn( SID,  'TcpRTOUpdate() RTO=', TCP_RTO.RTO,
                          ' SRTT=', TCP_RTO.SRTT,
                        ' RTTVAR=', TCP_RTO.RTTVAR,
                           ' RTT=', ARTT );
    {$ENDIF}

  end;

  {-------------------------------
  { TCoTCP.TcpRTOBeginEstimate
  {---
  {
  {---
  }

  procedure TCoTcp.TcpRTOBeginEstimate( ASeq: Longint );
  begin
    { Mereni RTT }
    if not TCP_RTO.Estimating then
    begin
      TCP_RTO.Estimating := True;
      TCP_RTO.SendSEQ    := ASeq;
      TCP_RTO.SendTime   := CoGetTime;

      { Po prijeti potvrzeni v prijimacim automatu bude upravena
        vypoctena hodnota RTT z rozdilu casu a upravena hodnota RTO }
    end;
  end;


  {-------------------------------
  { TCoTCP.TcpRTOExpired
  {---
  { Obsluha RTO casovace
  {---
  { Metoda se vola v MiniportTimer v okamziku, kdy vyprsi casovat
  { TCP_TIMER_RETRANSMIT
  }

  procedure TCoTCP.TcpRTOTimerExpired;
  var
    Size : Longint;
  begin

    {$IFDEF DEBUG_TCP_RTO}
    WriteLn( SID,  'TcpRTOTimerExpired() SND.UNA=', TCB.SND.UNA, ' SND.NXT=', TCB.SND.NXT );
    {$ENDIF}

    { Pokud se segment opakuje vicekrat nez je zadano, pak
      natvrdo ukoncime spojeni.. }

    case TCB.State of

      TCP_SYN_SENT,
      TCP_SYN_RECEIVED:
      begin
        { Navazovani spojeni }

        if TCP_RTO.Retry >= TCP_Settings.RTSynLimit then
        begin
          TcpError( CST_TCP_ERR_NORESPONSE );
          Exit;
        end;
      end;

    else

      if TCP_RTO.Retry >= TCP_Settings.RTLimit then
      begin
        TcpError( CST_TCP_ERR_NORESPONSE );
        Exit;
      end;

    end;

    Inc( TCP_RTO.Retry );


    case TCB.State of

      TCP_SYN_RECEIVED:
      begin
        TcpSendCtrlSegment( TCB.SND.ISS, TCB.RCV.NXT,
                            TCP_CTRL_SYN or TCP_CTRL_ACK or
                            TCP_CTRL_MSS, @TCP_RemoteAddr, TCP_PKT_NORMAL );
      end;

      TCP_SYN_SENT:
      begin
        TcpSendCtrlSegment( TCB.SND.ISS {SEQ}, 0 {ACK}, TCP_CTRL_SYN or
                            TCP_CTRL_MSS,
                            @TCP_RemoteAddr, TCP_PKT_NORMAL );
      end;


    else

      { RFC2581 - Congestion Control }

      { SSTRESH = Max( FlighSize div 2, 2 * SMSS ) }

      {!@# je vhodne zmensovat CWND pri zero window probe?}

      TCB.SND.SSTRESH := ULONG_SUB( TCB.SND.NXT, TCB.SND.UNA ) div 2;

      if TCB.SND.SSTRESH < 2 * TCB.SND.MSS then
      begin
        TCB.SND.SSTRESH := 2 * TCB.SND.MSS;
      end;

      TCB.SND.CWND := TCB.SND.MSS;

      {$IFDEF DEBUG_TCP_CWND}
      WriteLn( SID,  'Retransmit: CWND=', TCB.SND.CWND,
               ' SSTRESH=', TCB.SND.SSTRESH );
      {$ENDIF}

      { Posleme jeden segment ze zacatku fronty
        (z jeji retransmittion casti) }

      {!@# a co push flag??}

      Size := ULONG_SUB( TCB.SND.NXT, TCB.SND.UNA );

      if Size > TCB.SND.MSS then Size := TCB.SND.MSS;

      { !@# Mozna:
        kdyz SND.UNA = SND.ISS pak nastavit Ctrl na TCP_CTRL_SYN
        kyyz DisonncectPending, pak nastavit Ctrl na TCP_CTRL_FIN
        kdyz je nastaven SYN a FIN a nejsou data, poslat
        jen TcpSendCtrlSegment..
      }

      if Size > 0 then
      begin

        if (Size = 1) and TCP_ClosePending then
        begin
          { Size je 1 -- FIN priznak }

          { Ukoncujeme spojeni a neni co odeslat.. opakujeme FIN }
          TcpSendCtrlSegment( ULONG_DEC( TCB.SND.NXT ) {SEQ}, TCB.RCV.NXT {ACK},
             TCP_CTRL_FIN or TCP_CTRL_ACK {Ctrl}, @TCP_RemoteAddr,
             TCP_PKT_NORMAL );

          TCP_FINSent := True;
        end
        else begin
          TcpTxQTransmit( TCB.SND.UNA, Size, 0 { Ctrl } );

        end;

        { Pri opakovani segmentu musime vypnout odhad RTT,
          viz. RFC-2988 }

        TCP_RTO.Estimating := False;
      end
      else begin

        { Zero Window Probe .. }

        if ULONG_LT( TCB.SND.NXT, TCB.SND.WRI ) then
        begin
          { Odesleme jeden bajt na zkousku nuloveho okna }

          if TcpTxQTransmit( TCB.SND.NXT, 1{Size}, 0 { Ctrl } ) then
          begin
            { Byl odeslan FIN }
            TCB.SND.NXT := ULONG_INC( TCB.SND.NXT );
          end;

          TCB.SND.NXT := ULONG_ADD( TCB.SND.NXT, 1 );
        end
        else begin
          TCP_RTO.Scheduled := False;
          Exit; { Neni co odeslat... }
        end;

      end;

    end;

    { nastavit znovu casovac }

    TCP_RTO.RTO := TCP_RTO.RTO * 2;

    if TCP_RTO.RTO > TCP_MAX_RTO then TCP_RTO.RTO := TCP_MAX_RTO;

    CoStartTimer( @TCP_RTO.Timer, TCP_RTO.RTO,
                  TCP_TIMER_RETRANSMIT, nil );

  end;

  {-------------------------------
  { TCoTCP.TcpTimeWaitTimerStart
  {---
  { !@#
  {---
  }

  procedure TCoTcp.TcpTimeWaitTimerStart;
  begin
    if not TCP_TimeWait.Scheduled then
    begin
      TCP_TimeWait.Scheduled := True;
      CoStartTimer( @TCP_TimeWait.Timer, TCP_Settings.TimeWaitDelay,
        TCP_TIMER_TIMEWAIT, nil );
    end;
  end;

  {-------------------------------
  { TCoTCP.TcpTimeWaitTimerStop
  {---
  { !@#
  {---
  }

  procedure TCoTcp.TcpTimeWaitTimerStop;
  begin
    if TCP_TimeWait.Scheduled then
    begin
      TCP_TimeWait.Scheduled := False;
      CoCancelTimer( @TCP_TimeWait.Timer );
    end;
  end;

  {-------------------------------
  { TCoTCP.TcpTimeWaitTimerExpired
  {---
  { !@#
  {---
  }

  procedure TCoTCP.TcpTimeWaitTimerExpired;
  begin
    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'TcpTimeWaitTimerExpired()' );
    {$ENDIF}

    TcpResetRemoteAddr;

    TCB.State := TCP_CLOSED;
  end;

  {-------------------------------
  { TCoTCP.MiniportTimer
  {---
  { !@#
  {---
  }

  procedure TCoTCP.MiniportTimer( ATimer: PCoTimer; ACtxWord: Word;
    ACtxPtr: Pointer );
  var
    Size : Longint;
  begin

    case ACtxWord of

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

      (*TCP_TIMER_USER:
      begin
        { !@# }
        { asi zadny takovy timeout nebude }
      end;*)

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

      TCP_TIMER_RETRANSMIT:
      begin
        TcpRTOTimerExpired;
      end;

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

      TCP_TIMER_ACK: { Delay ACK Timer }
      begin
        TcpAckTimerExpired;
      end;

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

      TCP_TIMER_NAGLE: { Zpozdene odesilani }
      begin
        TcpNagleTimerExpired;
      end;

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

      TCP_TIMER_TIMEWAIT: { Time Wait Timer }
      begin
        TcpTimeWaitTimerExpired;
      end;

    else
      RunError( 255 );
    end;
  end;

  {-------------------------------
  { TCoTcp.ProtocolReceiveFilter
  {---
  { !@#
  {---
  {
  }

  { async funkce }
  function TCoTcp.ProtocolReceiveFilter( APacket: PCoPacket ): Boolean;
  begin
    case TCB.State of

      TCP_NOTBOUND,
      TCP_CLOSED:
      begin
        ProtocolReceiveFilter := False;
      end;

    else
      ProtocolReceiveFilter := True;
    end;

  end;


  {-------------------------------
  { TCoUdp.ProtocolReceive
  {---
  { !@#
  {---
  {
  }

  procedure TCoTcp.ProtocolReceive( APacket: PCoPacket );
  var
    IpAddress : TIpAddress;
    TcpHdr    : PTcpHeader;
  begin

    case TCB.State of

      TCP_NOTBOUND,
      TCP_CLOSED:
      begin
        { nic }
      end;

    else
      TcpReceiveSegment( APacket );
    end;

  end;



  {-------------------------------
  { TCoTCP.ProtocolBindComplete
  {---
  { !@#
  {---
  }

  function  TCoTCP.ProtocolBindComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  var
    Slot : PCoRequestSlot;
    User : PTcpUserBlock;
  begin
    { Dokonceni operace MiniportBind,
      resp. spusteni jeji druhe casti }

    Slot := CoGetDeviceSlot( AHandle );
    User := PTcpUserBlock( @Slot^.User );

    TCP_ReqList.Remove( @User^.QLink );

    if Status = CST_SUCCESS then
    begin
      with TCoBindParams(Slot^.Params) do
      begin
        Status := TcpBind_1( Flags, AHandle );
      end;

      if Status <> CST_PENDING then
      begin
        UpperComplete( AHandle, Status );
      end;
      { Pokud je astatus CST_PENDING bude obsluha dokoncena
        v ProtocolIoctlComplete.. }
    end
    else
      UpperComplete( AHandle, Status );

    ProtocolBindComplete := True;
  end;

  {-------------------------------
  { TCoTCP.ProtocolBindComplete
  {---
  { Dokonceni MiniportUnbind
  {---
  {
  }


  function  TCoTcp.ProtocolUnbindComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  begin
    { TCP negeneruje unbind, vzdy jej posila aplikacni vrstva }

    if AHandle = TCP_UnbindHandle then
    begin
      UpperComplete( AHandle, Status );
      TCP_UnbindHandle := nil;
    end
    else
      RunError( 255 );

    ProtocolUnbindComplete := True;
  end;

(*
  {-------------------------------
  { TCoTCP.ProtocolConnectComplete
  {---
  { !@#
  {---
  }

  function  TCoTCP.ProtocolConnectComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  begin
  end;

  {-------------------------------
  { TCoTCP.ProtocolDisconnectComplete
  {---
  { !@#
  {---
  }


  function  TCoTCP.ProtocolDisconnectComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  begin
  end;
*)

  {-------------------------------
  { TCoTCP.ProtocolIoctlComplete
  {---
  { !@#
  {---
  }

  function  TCoTCP.ProtocolIoctlComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  var
    Slot : PCoRequestSlot;
    User : PTcpUserBlock;
  begin
    { Pokud je to nas IOCTL z Bind pak zavolat TcpBind_2... nebo tak nejak }

    { Vyjmene request z fronty }
    Slot := CoGetDeviceSlot( AHandle );
    User := PTcpUserBlock( @Slot^.User );

    TCP_ReqList.Remove( @User^.QLink );

    { Podle typu, ktery jsme si do requestu ulozili, rozhodneme co dal..}
    case User^.ReqType of

    {-----------------}
      TCP_REQ_BIND:
      begin
        { Je to nas vlastni request vygenerovany v IpBind_1 }
        if Status = CST_SUCCESS then
        begin
          TCP_LocalAddr.Address := TCP_LocalAddrMask.Address;

          with TCoBindParams(Slot^.Params) do
          begin
            Status := TcpBind_2( Flags );
          end;
        end;

        UpperComplete( AHandle, Status );
      end;

    {-----------------}
      TCP_REQ_UPPER:
      begin
        { Je ro request z vyssi vrstvy.. }
        UpperComplete( AHandle, Status );
      end;

    else
      RunError( 255 );
    end;

    ProtocolIoctlComplete := True;
  end;

  {-------------------------------
  { TCoTcp.ProtocolGetOptionComplete
  {---
  { !@#
  {---
  {
  }

  function TCoTcp.ProtocolGetOptionComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  begin
    if AHandle = TCP_CtrlHandle then
    begin
      TCP_CtrlHandle := nil;
      UpperComplete( AHandle, Status );
    end
    else
      RunError( 255 );
  end;


  {-------------------------------
  { TCoTcp.ProtocolSetOptionComplete
  {---
  { !@#
  {---
  {
  }

  function TCoTcp.ProtocolSetOptionComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  begin
    if AHandle = TCP_CtrlHandle then
    begin
      TCP_CtrlHandle := nil;
      UpperComplete( AHandle, Status );
    end
    else
      RunError( 255 );
  end;


  {-------------------------------
  { TCoTCP.ProtocolSendComplete
  {---
  { !@#
  {---
  }

  function  TCoTCP.ProtocolSendComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  label
    L_Remove;
  var
    User      : PTcpSentUserBlock;
    IpDevAddr : TIpDevAddress;
  begin
    { Nezapomenout vymazat AHandle z TCP_SentList .. }

    User := PTcpSentUserBlock( @CoGetDeviceSlot( AHandle )^.User );

    case Status of

      CST_SUCCESS:  { Segment byl uspesne odeslan.. }
    L_Remove:
      begin
        { Vyjmeme pozadavek ze seznamu }
        TCP_SentList.Remove( @User^.QLink );

        { Uvolnime strukturu paketu }
        CoReleasePacket( User^.Packet );

        { Vysledek nikam nepredavame, pozadavek
          vygenerovala tato vrstva }

        if Status <> CST_SUCCESS then
        begin
          {$IFDEF DEBUG_TCP}
          WriteLn( SID,  'ProtocolSendComplete() Status=', Status );
          {$ENDIF}

        end;

        case User^.Context of

          TCP_PKT_NORMAL: { nic };


          TCP_PKT_UNBIND:
          begin
            with TCoUnbindParams(
              CoGetDeviceSlot( TCP_UnbindHandle )^.Params ) do
            begin
              Status := TcpUnbind_1( Flags , TCP_UnbindHandle );
            end;

            if Status <> CST_PENDING then
            begin
              UpperComplete( TCP_UnbindHandle, Status );
              TCP_UnbindHandle := nil;
            end;

            { Jinak bude unbind dokoncen v ProtocolUnbindComplete }
          end;

        end;

        { Uvolnime strukturu pozadavku }
        CoFreeRequest( AHandle );


        if Status <> CST_SUCCESS then
        begin
          { Pokud nelze nic odvysilat ..tak uzavreme spojeni }
          TcpError( Status );
        end;

      end;

    else

      while User^.RetryCount >= 0 do
      begin

        if User^.RetryCount = 0 then
        begin
          {$ifdef DEBUG_TCP}
          WriteLn( SID,  'TCP: Mutliple Send Error' );
          {$endif}
        end
        else
          goto L_Remove;

        {$ifdef DEBUG_TCP}
        WriteLn( SID,  'TCP: Send Retry ', User^.RetryCount );
        {$endif}

        Dec( User^.RetryCount );

        { Znovu odesleme segment }

        IpDevAddr.Size     := SizeOf( TIpDevAddress );
        IpDevAddr.Node     := User^.Address;
        IpDevAddr.Protocol := IP_PROTO_TCP;

        Status := LowerSendPacketTo( User^.Packet, 0, @IpDevAddr, AHandle );

        case Status of
          CST_PENDING:  Break;
          CST_SUCCESS:  goto L_Remove;
        end;

      end;

    end;

  end;


  {-------------------------------
  { TCoTCP.TcpSetOptString
  {---
  { !@#
  {---
  }

  function TCoTcp.TcpSetOptString( AParams: PString ): TCoStatus;
  var
    Tok   : TCoToken;
    Idx   : Byte;

  const

    ID_LPORT      = 1;
    ID_RPORT      = 3;
    ID_RADDR      = 4;
    ID_DACK       = 5;
    ID_NAGLE      = 6;
    ID_TIMEWAIT   = 7;
    ID_RTLIMIT    = 8;
    ID_RTSYNLIMIT = 9;
    ID_MINWND     = 10;
    ID_MAXWND     = 11;

    Table : array[1..10] of TCoIdentItem =
      ( (ParamName: 'LPORT'      ; ParamId : ID_LPORT),
        (ParamName: 'RPORT'      ; ParamId : ID_RPORT),
        (ParamName: 'RADDR'      ; ParamId : ID_RADDR),
        (ParamName: 'DACK'       ; ParamId : ID_DACK),
        (ParamName: 'NAGLE'      ; ParamId : ID_NAGLE),
        (ParamName: 'TIMEWAIT'   ; ParamId : ID_TIMEWAIT),
        (ParamName: 'RTLIMIT'    ; ParamId : ID_RTLIMIT),
        (ParamName: 'RTSYNLIMIT' ; ParamId : ID_RTSYNLIMIT),
        (ParamName: 'MINWND'     ; ParamId : ID_MINWND),
        (ParamName: 'MAXWND'     ; ParamId : ID_MAXWND)
      );
  var

    Option : Word;
    Value  : TCoToken;
    Status : TCoStatus;

  begin

    Status := CST_SUCCESS;

    Idx := 1;

    repeat

      Status := CoParseParamString( AParams^, Idx, Table, Option, Value );

      if Status = CST_SUCCESS then
      begin

        case Option of

        {-----------------------}
          ID_LPORT:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 1) and (Value.VNumber <= 65535) then
              begin
                TCP_DefLocalAddr.Port := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_RPORT:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 1) and (Value.VNumber <= 65535) then
              begin
                TCP_DefRemoteAddr.Port := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_RADDR:
          begin
            if Value.TokType = tokString then
            begin
              Status := StrToIpAddr( Value.VString, TCP_DefRemoteAddr.Address );
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_DACK:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 0) and (Value.VNumber <= 500{ms}) then
              begin
                TCP_Settings.AckDelay := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_NAGLE:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 0) and (Value.VNumber <= 1000{ms}) then
              begin
                TCP_Settings.NagleDelay := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_TIMEWAIT:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 0) and (Value.VNumber <= 240{s}) then
              begin
                TCP_Settings.TimeWaitDelay := Value.VNumber * 1000;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_RTLIMIT:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 3{5}) and (Value.VNumber <= 32{ms}) then
              begin
                TCP_Settings.RTLimit := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_RTSYNLIMIT:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 1) and (Value.VNumber <= 32{ms}) then
              begin
                TCP_Settings.RTSynLimit := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;


        {-----------------------}
          ID_MINWND:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 1024) and (Value.VNumber <= 32768) then
              begin
                TCP_Settings.MinWindow := Value.VNumber;
                TCP_Settings.MaxWindow := Value.VNumber; {!@#}
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        {-----------------------}
          ID_MAXWND:
          begin
            if Value.TokType = tokNumber then
            begin
              if (Value.VNumber >= 1024) and (Value.VNumber <= 32768) then
              begin
                TCP_Settings.MinWindow := Value.VNumber; {!@#}
                TCP_Settings.MaxWindow := Value.VNumber;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_INVALID;
          end;

        else
          Break;
        end;

      end;

    until Status <> CST_SUCCESS;

    TcpSetOptString := Status;

  end;


  {-------------------------------
  { TCoTCP.TcpGetOptString
  {---
  { !@#
  {---
  }

  function TCoTcp.TcpGetOptString( ABuffer: PString;
    ABuffSize: Word ): TCoStatus;
  var
    S     : String;

  begin

    if ABuffer <> nil then
    begin

      S :=      'LPORT='      + WordStrDec( TCP_DefLocalAddr.Port, 0 );
      S := S + ' RPORT='      + WordStrDec( TCP_DefRemoteAddr.Port, 0 );
      S := S + ' RADDR="'     + IpAddrToStr( TCP_DefRemoteAddr.Address ) + '"';
      S := S + ' DACK='       + LongintStrDec( TCP_Settings.AckDelay, 0 );
      S := S + ' NAGLE='      + LongintStrDec( TCP_Settings.NagleDelay, 0 );
      S := S + ' TIMEWAIT='   + WordStrDec( TCP_Settings.TimeWaitDelay div 1000, 0 );
      S := S + ' RTLIMIT='    + WordStrDec( TCP_Settings.RTLimit, 0 );
      S := S + ' RTSYNLIMIT=' + WordStrDec( TCP_Settings.RTSynLimit, 0 );
      S := S + ' MINWND='     + WordStrDec( TCP_Settings.MinWindow, 0 );
      S := S + ' MAXWND='     + WordStrDec( TCP_Settings.MaxWindow, 0 );

      if (Length( S ) <= ABuffSize) then
      begin
        ABuffSize := Length( S );
        TcpGetOptString := CST_SUCCESS;
      end
      else
        TcpGetOptString := CST_ERR_BUFFSIZE;

      ABuffer^ := Copy( S, 1, ABuffSize );

    end
    else
      TcpGetOptString := CST_ERR_INVALID;

  end;



  {-------------------------------
  { TCoTcp.MiniportSetOption
  {---
  { !@#
  {---
  }


  function TCoTCP.MiniportSetOption( ALevel: Word; AOption: Word;
    ABuffer: Pointer; ABuffSize: Word; AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;
  var
    Status   : TCoStatus;
    TempW    : Word;
    TempTime : TCoTime;
  begin

    if ALevel = CO_ClassId then
    begin
      case AOption of

      {-----------------------}
        COPT_STRING:
        begin
          Status := TcpSetOptString( PString(ABuffer) );
        end;

      {-----------------------}
        COPT_TCP_LPORT:
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            TempW := PWord(ABuffer)^;

            if IsValidTcpPort( TempW ) then
            begin
              Tcp_DefLocalAddr.Port := TempW;
              Status := CST_SUCCESS;
            end
            else
              Status := CST_ERR_INVRANGE;

          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_RADDR:
        begin
          if ABuffSize <> SizeOf( TTcpAddress ) then
          begin
            TempW := PWord(ABuffer)^;

            if IsValidTcpAddress( PTcpAddress(ABuffer) ) then
            begin
              TCP_DefRemoteAddr := PTcpAddress(ABuffer)^;
            end
            else
              Status := CST_ERR_INVRANGE;

          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_DACK:     { Delay ack time [ms] }
        begin
          if ABuffSize <> SizeOf( TCoTime ) then
          begin
            TempTime := TCoTime(ABuffer^);
            if (TempTime >= 0) and (TempTime <= 500) then
            begin
              TCP_Settings.AckDelay := TempTime;
            end
            else
              Status := CST_ERR_INVRANGE;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_NAGLE:    { Nagle time [ms] , 0=off }
        begin
          if ABuffSize <> SizeOf( TCoTime ) then
          begin
            TempTime := TCoTime(ABuffer^);
            if (TempTime >= 0) and (TempTime <= 1000) then
            begin
              TCP_Settings.NagleDelay := TempTime;
            end
            else
              Status := CST_ERR_INVRANGE;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_TIMEWAIT: { Cekani v timewait [s], 0=off }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            TempTime := TCoTime(ABuffer^);
            if (TempTime >= 0) and (TempTime <=  240) then
            begin
              TCP_Settings.TimeWaitDelay := TempTime * 1000;
            end
            else
              Status := CST_ERR_INVRANGE;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_RTLIMIT:  { Maximalni pocet opakovani }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            TempW := PWord(ABuffer)^;
            if (TempW >= 3) and (TempW <= 32) then
            begin
              TCP_Settings.RTLimit := TempW;
            end
            else
              Status := CST_ERR_INVRANGE;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_RTSYNLIMIT:  { Maximalni pocet opakovani SYN segmentu }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            TempW := PWord(ABuffer)^;
            if (TempW >= 1) and (TempW <= 32) then
            begin
              TCP_Settings.RTSynLimit := TempW;
            end
            else
              Status := CST_ERR_INVRANGE;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;


      {-----------------------}
        COPT_TCP_MINWND:   { Minimalni velikost okna          }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            if TCB.State = TCP_NOTBOUND then
            begin
              TempW := PWord(ABuffer)^;
              if (TempW >= 1024) and (TempW <= 32768) then
              begin
                TCP_Settings.MinWindow := TempW;
                TCP_Settings.MaxWindow := TempW; {!@#}
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_ISBOUND;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_MAXWND:   { Maximalni velikost okna          }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            if TCB.State = TCP_NOTBOUND then
            begin
              TempW := PWord(ABuffer)^;
              if (TempW >= 1024) and (TempW <= 32768) then
              begin
                TCP_Settings.MinWindow := TempW; {!@#}
                TCP_Settings.MaxWindow := TempW;
              end
              else
                Status := CST_ERR_INVRANGE;
            end
            else
              Status := CST_ERR_ISBOUND;
          end
          else
            Status := CST_ERR_BUFFSIZE;

        end;

      else
        Status := CST_ERR_INVOPT;
      end;
    end
    else begin
      Status := inherited LowerSetOption( ALevel, AOption, ABuffer,
                  ABuffSize, AFlags, AHandle );

      if Status = CST_PENDING then
      begin
        TCP_CtrlHandle := AHandle;
      end;
    end;

    MiniportSetOption := Status;
  end;


  {-------------------------------
  { TCoTcp.MiniportGetOption
  {---
  { !@#
  {---
  }

  function TCoTcp.MiniportGetOption( ALevel: Word; AOption: Word;
    ABuffer: Pointer; ABuffSize: Word; AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
  begin

    if ALevel = CO_ClassId then
    begin

      Status := CST_SUCCESS;

      case AOption of

        COPT_STRING      : Status := TcpGetOptString(
                             PString(ABuffer), ABuffSize );

      {-----------------------}
        COPT_TCP_LPORT:
        begin
          if ABuffSize >= SizeOf( Word ) then
          begin
            PWord(ABuffer)^ := TCP_DefLocalAddr.Port;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;


      {-----------------------}
        COPT_TCP_RADDR:
        begin
          if ABuffSize >= SizeOf( TTcpAddress ) then
          begin
            PTcpAddress(ABuffer)^ := TCP_DefRemoteAddr;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_DACK:     { Delay ack time [ms] }
        begin
          if ABuffSize <> SizeOf( TCoTime ) then
          begin
            TCoTime(ABuffer^) := TCP_Settings.AckDelay;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_NAGLE:    { Nagle time [ms] , 0=off }
        begin
          if ABuffSize <> SizeOf( TCoTime ) then
          begin
            TCoTime(ABuffer^) := TCP_Settings.NagleDelay;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_TIMEWAIT: { Cekani v timewait [s], 0=off }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            Word(ABuffer^) := TCP_Settings.TimeWaitDelay div 1000;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_RTLIMIT:  { Maximalni pocet opakovani }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            Word(ABuffer^) := TCP_Settings.RTLimit;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_RTSYNLIMIT:  { Maximalni pocet opakovani }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            Word(ABuffer^) := TCP_Settings.RTSynLimit;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_MINWND:   { Minimalni velikost okna          }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            Word(ABuffer^) := TCP_Settings.MinWindow;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;

      {-----------------------}
        COPT_TCP_MAXWND:   { Maximalni velikost okna          }
        begin
          if ABuffSize <> SizeOf( Word ) then
          begin
            Word(ABuffer^) := TCP_Settings.MaxWindow;
          end
          else
            Status := CST_ERR_BUFFSIZE;
        end;


      else
        Status := CST_ERR_INVOPT;
      end;

    end
    else begin
      Status := inherited LowerGetOption( ALevel, AOption, ABuffer,
                  ABuffSize, AFlags, AHandle );

      if Status = CST_PENDING then
      begin
        TCP_CtrlHandle := AHandle;
      end;
    end;


    MiniportGetOption := Status;
  end;


  {=======================================================================}
  { TTcpMuxDeviceList                                                    }
  {=======================================================================}

  {-------------------------------
  { TTcpMuxDeviceList.Init
  {---
  { Inicializace seznamu TCP soketu nad zarizenim TCPMUX
  {---
  }

  constructor TTcpMuxDeviceList.Init( ATableSize: Integer );
  var
    BuffSize : Word;
  begin
    inherited Init;

    BuffSize := ATableSize * SizeOf( PTcpMuxDeviceListItem );

    GetMem( Table, BuffSize );

    if Table = nil then Fail;
    TableSize := ATableSize;

    FillChar( Table^, BuffSize, 0 );
  end;

  {-------------------------------
  { TTcpProtoDeviceList.Done
  {---
  { Uvolneni vsech zarizeni ze seznamu, uvolneni pameti
  {---
  }

  destructor TTcpMuxDeviceList.Done;
  var
    I    : Integer;
    P    : PTcpMuxDeviceListItem;
    Temp : PTcpMuxDeviceListItem;
  begin

    if Table <> nil then
    begin
      for I := 0 to TableSize - 1 do
      begin
        P := Table^[ I ];
        while P <> nil do
        begin
          Temp := P;
          P := P^.Next;
          Temp^.Device^.Release;
          Dispose( Temp );
        end;
      end;

      FreeMem( Table, TableSize * SizeOf( PTcpMuxDeviceListItem ) );
    end;

    inherited Done;
  end;

  {-------------------------------
  { TTcpMuxDeviceList.AddDevice
  {---
  { Pridani zarizeni do seznamu TCP soketu nad vrstvou TCPMUX
  {---
  }

  function TTcpMuxDeviceList.AddDevice( ADevice: PCoDevice;
    ASubId: Integer; Param: Pointer; ParamSize: Word ): TCoStatus;
  var
    HashVal : Word;
    Port    : Word;
    NewItem : PTcpMuxDeviceListItem;
    P       : PTcpMuxDeviceListItem;
    Prev    : PTcpMuxDeviceListItem;
    I       : Integer;
  begin

    if (ParamSize <> SizeOf( TTcpMuxSelector )) or
       (ADevice = nil) or (Param = nil) then
    begin
      AddDevice := CST_ERR_INVALID;
      Exit;
    end;

    {$ifdef DEBUG_TCP_PROTOREG}
    WriteLn( 'MuxList: AddDevice ',
      'Device=', PtrRec(ADevice).Seg, ' SubId=', ASubId,
      ' DstPort=', PTcpMuxSelector( Param )^.DstPort,
      ' SrcAddr=', IpAddrToStr( PTcpMuxSelector( Param )^.SrcAddr ),
      ' SrcPort=', PTcpMuxSelector( Param )^.SrcPort );

    {$endif}

    Port    := PTcpMuxSelector( Param )^.DstPort;
    HashVal := Port mod TableSize;

    { Vytvorime novou polozku }
    New( NewItem );
    NewItem^.Device   := ADevice;
    NewItem^.Selector := PTcpMuxSelector( Param )^;

    PUSHFCLI;

    { Nejdrive zkontrolujeme, zda v seznamu jiz neni zarizeni ADevice }
    { Musime projet kompletne celou tabulku }

    for I := 0 to TableSize - 1 do
    begin
      P := Table^[ I ];

      while (P <> nil) and (P^.Device <> ADevice) do
      begin
        P := P^.Next;
      end;

      if P <> nil then Break;
    end;

    if P <> nil then
    begin
      { Zarizeni ADevice je jiz v seznamu zaregistrovano }
      AddDevice := CST_ERR_DUPLICATE;
      POPF;
      Dispose( NewItem );
      Exit;
    end;

    { Zatim vse ok }

    P := Table^[ HashVal ];

    if (PTcpMuxSelector( Param )^.SrcPort <> 0) or
       (PTcpMuxSelector( Param )^.SrcAddr <> 0) then
    begin

      {$ifdef DEBUG_TCP_PROTOREG}
      WriteLn( 'MuxList: AddDevice : full specified socket' );
      {$endif}

      { Plne specifikovany soket }

      Prev := nil;

      while (P <> nil) and (P^.Selector.DstPort <> Port) do
      begin
        Prev := P;
        P := P^.Next;
      end;

      { Zkontrolujeme zda v seznamu jiz neni zaregistrovana
        zasuvka se stejnymi parametry }

      while (P <> nil) and (P^.Selector.DstPort = Port) do
      begin
        if MemCmp( @P^.Selector, Param, SizeOf( TTcpMuxSelector )) then
        begin
          { Duplicita }
          POPF;
          Dispose( NewItem );
          AddDevice := CST_ERR_PROTOREG;
          Exit;
        end;

        P    := P^.Next;
      end;

      { Vlozime polozku do seznamu }

      if Prev = nil then
      begin
        NewItem^.Next := Table^[HashVal];
        Table^[ HashVal ] := NewItem;
      end
      else begin
        NewItem^.Next := Prev^.Next;
        Prev^.Next := NewItem;
      end;

      ADevice^.AddRef;
      POPF;
      AddDevice := CST_SUCCESS;
    end
    else begin

      { Castecne specifikovany soket }

      {$ifdef DEBUG_TCP_PROTOREG}
      WriteLn( 'MuxList: AddDevice : partial socket' );
      {$endif}

      while (P <> nil) and (P^.Selector.DstPort <> Port) do
      begin
        P := P^.Next;
      end;

      Prev := nil;

      while (P <> nil) and (P^.Selector.DstPort = Port) do
      begin
        Prev := P;
        P := P^.Next;
      end;

      if (Prev = nil) or (Prev^.Selector.SrcPort <> 0) then
      begin
        if Prev = nil then
        begin
          NewItem^.Next := Table^[HashVal];
          Table^[ HashVal ] := NewItem;
        end
        else begin
          NewItem^.Next := Prev^.Next;
          Prev^.Next := NewItem;
        end;

        ADevice^.AddRef;
        POPF;
        AddDevice := CST_SUCCESS;
      end
      else begin
        { Protokol je jiz zaregistrovan jinym zarizenim }
        POPF;
        AddDevice := CST_ERR_PROTOREG;
        Dispose( NewItem );
      end;


    end;

  end;


  {-------------------------------
  { TTcpMuxDeviceList.ChangeDeviceParam
  {---
  { Pridani zarizeni do seznamu TCP soketu nad vrstvou TCPMUX
  {---
  }

  function TTcpMuxDeviceList.ChangeDeviceParam( ADevice: PCoDevice;
    ASubId: Integer; Param: Pointer; ParamSize: Word ): TCoStatus;
  var
    Status  : TCoStatus;
  begin

    if (ParamSize <> SizeOf( TTcpMuxSelector )) or (Param = nil) or
       (ADevice = nil) then
    begin
      ChangeDeviceParam := CST_ERR_INVALID;
      Exit;
    end;

    {$ifdef DEBUG_TCP_PROTOREG}
    WriteLn( 'MuxList: ChangeParam ',
      'Device=', PtrRec(ADevice).Seg, ' SubId=', ASubId,
      ' DstPort=', PTcpMuxSelector( Param )^.DstPort,
      ' SrcAddr=', IpAddrToStr( PTcpMuxSelector( Param )^.SrcAddr ),
      ' SrcPort=', PTcpMuxSelector( Param )^.SrcPort );

    {$endif}


    PUSHFCLI;

    Status := RemoveDevice( ADevice, ASubId );

    if Status = CST_SUCCESS then
    begin
      Status := AddDevice( ADevice, ASubId, Param, ParamSize );
    end;

    POPF;

    ChangeDeviceParam := Status;

  end;

  {-------------------------------
  { TTcpMuxDeviceList.RemoveDevice
  {---
  { Vyjmuti zarizeni ze seznamu TCP soketu nad vrstvou TCPMUX
  {---
  }

  function TTcpMuxDeviceList.RemoveDevice( ADevice: PCoDevice;
    ASubId: Integer ): TCoStatus;
  var
    I    : Integer;
    P    : PTcpMuxDeviceListItem;
    Prev : PTcpMuxDeviceListItem;
  begin

    if ADevice = nil then
    begin
      RemoveDevice := CST_ERR_INVALID;
      Exit;
    end;

    {$ifdef DEBUG_TCP_PROTOREG}
    WriteLn( 'MuxList: RemoveDevice ',
      'Device=', PtrRec(ADevice).Seg, ' SubId=', ASubId );
    {$endif}


    { Hledame polozku ktera odpovida zarizeni ADevice s ASubId }

    PUSHFCLI;

    I := 0;
    while I < TableSize do
    begin
      P    := Table^[ I ];
      Prev := nil;

      while (P <> nil) and (P^.Device <> ADevice) do
      begin
        Prev := P;
        P := P^.Next;
      end;

      if P <> nil then
      begin

        if Prev <> nil then
        begin
          Prev^.Next := P^.Next;
        end
        else begin
          Table^[ I ] := P^.Next;
        end;

        POPF;

        P^.Device^.Release;
        Dispose( P );

        RemoveDevice := CST_SUCCESS;

        Exit;

      end;

      Inc( I );
    end;

    POPF;

    RemoveDevice := CST_ERR_NOTFOUND;
  end;

  {-------------------------------
  { TTcpMuxDeviceList.DispatchPacket
  {---
  { !@#
  {---
  }

  function TTcpMuxDeviceList.DispatchPacket(
    APacket: PCoPacket ): TCoStatus;
  var
    P      : PTcpMuxDeviceListItem;

    Sel    : TTcpMuxSelector;

    Device : PCoDevice;
  begin

    with PTcpHeader( APacket^.Header )^ do
    begin
      Sel.DstPort := Swap( DestPort );
      Sel.SrcPort := Swap( SourcePort );
    end;

    Sel.SrcAddr := PTcpAddress( @APacket^.Address )^.Address;

    PUSHFCLI;

    P := Table^[ Sel.DstPort mod TableSize ];

    while (P <> nil) and (P^.Selector.DstPort <> Sel.DstPort) do
    begin
      P := P^.Next;
    end;

    while (P <> nil) and (P^.Selector.DstPort = Sel.DstPort) do
    begin

      if ((P^.Selector.SrcAddr = Sel.SrcAddr) and
          (P^.Selector.SrcPort = Sel.SrcPort)) or
         ((P^.Selector.SrcAddr = 0) and (P^.Selector.SrcPort = 0)) then
      begin
        Device := P^.Device;

        if Device^.ProtocolReceiveFilter( APacket ) then
        begin

          if Device <> nil then
          begin
            if Device^.CO_ReceiveQ.InsertTail( APacket ) then
            begin
              DispatchPacket := CST_SUCCESS
            end
            else
              DispatchPacket := CST_ERR_QUEUEFULL;
          end;
        end
        else
          DispatchPacket := CST_ERR_DROPPED;

        POPF;
        Exit;
      end;

      P := P^.Next;
    end;

    DispatchPacket := CST_ERR_DROPPED;
    POPF;
  end;

  {-------------------------------
  { TTcpMuxDeviceList.DispatchSignal
  {---
  { !@#
  {---
  }

  function  TTcpMuxDeviceList.DispatchSignal(
    ASignal: PCoSignal ): TCoStatus;
  var
    P      : PTcpMuxDeviceListItem;
    IpHdr  : PIpHeader;
    TcpHdr : PTcpHeader;
    Sel    : TTcpMuxSelector;
  begin
    { Umime predavat dal pouze signaly od IP vrstvy souvisejici
      s prijatymi ICMP zpravami }

    DispatchSignal := CST_ERR_DROPPED;

    case ASignal^.ClassId of

      DEV_CLASS_IPV4:
      begin

        case ASignal^.SignalType of

          SIG_IPV4_ICMP:
          begin
            {!@# tady to trosku zacesat..}

            IpHdr := @PIPv4IcmpSignal( ASignal )^.IcmpMsg;

            Inc( PtrRec( IpHdr ).Ofs, 8 );

            TcpHdr := PTcpHeader(IpHdr);

            Inc( PtrRec( TcpHdr ).Ofs, (IpHdr^.VerIHL and 15) * 4 );

            { Je to opravdu obracene ! }
            Sel.DstPort := Swap( TcpHdr^.SourcePort );
            Sel.SrcPort := Swap( TcpHdr^.DestPort );
            Sel.SrcAddr := SwapL( IpHdr^.Dest );

            PUSHFCLI;
            P := Table^[ Sel.SrcPort mod TableSize ];

            while (P <> nil) and (P^.Selector.DstPort <> Sel.SrcPort) do
            begin
              P := P^.Next;
            end;

            while (P <> nil) and (P^.Selector.DstPort = Sel.SrcPort) do
            begin

              if ((P^.Selector.SrcAddr = Sel.SrcAddr) and
                  (P^.Selector.SrcPort = Sel.SrcPort)) or
                 ((P^.Selector.SrcAddr = 0) and (P^.Selector.SrcPort = 0)) then
              begin
                P^.Device^.CO_SignalQ.Enqueue( ASignal );
                DispatchSignal := CST_SUCCESS;
                Break;
              end;
            end;

            POPF;
          end;

        end;
      end;
    end;
  end;

  {-------------------------------
  { TCoTcp.MiniportCancel
  {---
  { !@#
  {---
  {
  }

  procedure TCoTcp.MiniportCancel( ACancelAll: Boolean );


    procedure CancelRxRequests;
    var
      Link     : PCoDeviceRequestQueueLink;
      User     : PTcpRxUserBlock absolute Link;
      Slot     : PCoRequestSlot;
      NextLink : PCoDeviceRequestQueueLink;
    begin

      Link := TCP_RxQ.Head;

      if not ACancelAll then
      begin

        while Link <> nil do
        begin
          if CoShouldCancel( Link^.Request ) then
          begin
            Break;
            { Rozpojime frontu }
            if Link^.Prev <> nil then Link^.Prev^.Next := nil;
          end;
          Link := Link^.Next;
        end;

      end;

      while Link <> nil do
      begin
        Slot := CoGetDeviceSlot( Link^.Request );

        { Ulozime pocet prekopirovanyc bajtu }
        with TCoRecvBufferParams( Slot^.Params ) do
        begin
          { RecvLen je promenna predana funkci CoRecvBuffer(From) }
          RecvLen^ := User^.Written;
        end;

        NextLink := Link^.Next;

        Dec( TCP_RxQSize, User^.BuffSize );

        if User^.Written > 0 then
        begin
          { Predame pozadavek aplikacni vrstve }
          UpperComplete( Link^.Request, CST_SUCCESS );
        end
        else
          UpperComplete( Link^.Request, CST_ERR_ABORTED );

        Link := NextLink;
      end;

    end;

    procedure CancelAcceptRequest;
    begin
      if (TCP_Accept.Handle <> nil) and
         (ACancelAll or CoShouldCancel( TCP_Accept.Handle )) then
      begin

        { Hrubym zpusoben uvolnime vznikajici zasuvku }

        if TCP_Accept.Device <> nil then
        begin
          TCP_Accept.Device^.CoDetachDevice;
          TCP_Accept.Device^.Release;
          TCP_Accept.Device := nil;

          {!@# tady bychom asi meli poslat RST segment... }
        end;

        TCP_Accept.DevicePtr^ := nil;

        if TCP_Accept.AddressPtr <> nil then
        begin
          TCP_Accept.AddressPtr^.Size := 0;
        end;

        { Nejaka chyba }

        UpperComplete( TCP_Accept.Handle, CST_ERR_ABORTED );

        TCP_Accept.Handle := nil;
        TCP_Accept.Device := nil;

      end;
    end;

  begin
    {$IFDEF DEBUG_TCP}
    WriteLn( SID,  'Tcp: MiniportCancel' );
    {$ENDIF}

(*  if ACancelAll or CoShouldCancel( TCP_CloseHandle ) then
    begin
      { ... }
      { Pokud je provadeno ukoncovani, poslat rst segment a necekat na odpoved }
    end;

    if ACancelAll or CoShouldCancel( TCP_OpenHandle ) then
    begin
      { ... }
      { Pokud je provadeno navazovani, poslat rst segment a necekat an odpoved }
    end;

    if ACancelAll or CoShouldCancel( TCP_UnbindHandle ) then
    begin
      { ... }
      { Ukoncit vysilani reset segmentu... }
    end;

*)
    CancelRxRequests;

    CancelAcceptRequest;


    if (TCP_CtrlHandle <> nil) and (ACancelAll or
         CoShouldCancel( TCP_CtrlHandle ))  then
    begin
      LowerCancelIO( TCP_CtrlHandle, 0 );
    end;
 

    { !@# TxQ.. }

    { U zapisu ... mohu zrusit jen pokud jeste bajty nebyly odeslany do site... }
  end;



  function  TCoTcp.MiniportStatusToStr( AStatus: TCoStatus;
    var AResult: TCoErrString ): Boolean;
  begin
    case AStatus of
      CST_TCP_ERR_CONNCLOSING : AResult := 'CONNCLOSING';
      CST_TCP_ERR_CONNREFUSED : AResult := 'CONNREFUSED';
      CST_TCP_ERR_CONNRESET   : AResult := 'CONNRESET';
      CST_TCP_ERR_NORESPONSE  : AResult := 'NORESPONSE';
      CST_TCP_ERR_PORTENGAGED : AResult := 'PORTENGAGED';
    else
      MiniportStatusToStr := False;
      Exit;
    end;

    MiniportStatusToStr := True;
  end;



  {=======================================================================}
  { TCoTcpMux                                                             }
  {=======================================================================}

  {-------------------------------
  { TCoTcpMux.MiniportInit
  {---
  { !@#
  {---
  {
  }

  function TCoTcpMux.MiniportInit( var ADevParams: TCoDeviceParameters ):
             Boolean;
  begin

    with ADevParams do
    begin
      { Delka prijimaci fronty pro aplikace, tj. pocet paketu, ktere
        muze tato vrstvy predat aplikaci, aniz by si je vyzvedla
        funkci CoRecvBuffer }
      AppRecvQueueLength       := 0;

      { Maximalni pocet vyssich zarizeni, uplatni se jen tehdy pokud
        seznam CO_RecvDeviceList ma fixni pocet polozek }
      MaxUpperDevices    := 32;
    end;

    CO_ClassId := DEV_CLASS_TCPMUX;

    TCPMUX_ReqList.Initialize;

    CO_RecvDeviceList := New( PTcpMuxDeviceList, Init( 7 ) );

    MiniportInit := CO_RecvDeviceList <> nil;
  end;

  {-------------------------------
  { TCoTcpMux.MiniportDone
  {---
  { !@#
  {---
  {
  }

  procedure TCoTcpMux.MiniportDone;
  begin
    { zatim nic }
  end;

  {-------------------------------
  { TCoTcpMux.MiniportSendPacket
  {---
  { Odeslani paketu
  {---
  {
  }

  function TCoTcpMux.MiniportSendPacket( APacket: PCoPacket; AFlags: Word;
    AAddress: PCoAddress; AHandle: PCoRequest ): TCoStatus;
  var
    Status     : TCoStatus;
    User       : PTcpMuxUserBlock;
  begin
    {$IFDEF DEBUG_TCPMUX}
    WriteLn( SID,  'TcpMux: MiniportSendPacket' );
    {$ENDIF}
    Status := LowerSendPacketTo( APacket, AFlags, AAddress, AHandle );

    if Status = CST_PENDING then
    begin
      User := @TTcpMuxUserBlock( CoGetDeviceSlot( AHandle )^.User );
      User^.ReqType := TCPMUX_REQ_UPPER;

      TCPMUX_ReqList.InsertTail( @User^.QLink, AHandle );
      UpperNextRequest( AHandle, [RQ_TYPE_SENDPACKET, RQ_TYPE_IOCTL] );
    end;

    MiniportSendPacket := Status;
  end;



  {-------------------------------
  { TCoTcpMux.TcpMuxBind
  {---
  { !@#
  {---
  {
  }

  function TCoTcpMux.TcpMuxBind( AAddress: PCoAddress;
    AFlags: Word ): TCoStatus;
  var
    Status : Word;
    Proto  : Word;
  begin

    if TCPMUX_Bound then
    begin

      if AFlags and COF_QUIET <> 0 then
      begin
        Status := CST_SUCCESS
      end
      else
        Status := CST_ERR_ISBOUND;

    end
    else begin

      if CoIsAddrValid( AAddress ) then
      begin
        { Tato vrstva nepracuje s adresou }
        Status := CST_ERR_INVADDR
      end
      else begin
        { Zaregistrujeme protokol u nizsi vrstvy }

        Proto := IP_PROTO_TCP;
        Status := LowerAddToReceiveList( 0, @Proto, SizeOf( Proto ) );

        if Status = CST_SUCCESS then
        begin
          TCPMUX_Bound := True;
        end;

      end;

    end;

    TcpMuxBind := Status;
  end;


  {-------------------------------
  { TCoTcpMux.MiniportBind
  {---
  { !@#
  {---
  {
  }


  function TCoTcpMux.MiniportBind( AAddress: PCoAddress; AFlags: Word;
    AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
  begin

    if AFlags and COF_PROPAGATE <> 0 then
    begin
      { Automaticky bind nizsi vrstvy }
      Status := LowerBind( nil, COF_PROPAGATE or COF_QUIET, AHandle );

      case Status of
        CST_SUCCESS: Status := TcpMuxBind( AAddress, AFlags );
        CST_PENDING: TCPMUX_TempHandle := AHandle;
      end;

    end
    else begin
      Status := TcpMuxBind( AAddress, AFlags );
    end;

    MiniportBind := Status;
  end;

  {-------------------------------
  { TCoTcpMux.MiniportUnbind
  {---
  { !@#
  {---
  {
  }

  function TCoTcpMux.TcpMuxUnbind( AFlags: Word ): TCoStatus;
  var
    Status: TCoStatus;
  begin
    if not TCPMUX_Bound then
    begin

      if AFlags and COF_QUIET <> 0 then
      begin
        Status := CST_SUCCESS
      end
      else
        Status := CST_ERR_NOTBOUND;

    end
    else begin
      Status := LowerRemoveFromReceiveList( 0 );
      TCPMUX_Bound := False;
    end;

    TcpMuxUnbind := Status;

  end;

  {-------------------------------
  { TCoTcpMux.MiniportUnbind
  {---
  { !@#
  {---
  {
  }

  function TCoTcpMux.MiniportUnbind( AFlags: Word; AHandle: PCoRequest ):
    TCoStatus;
  var
    Status : TCoStatus;
  begin
    Status := TcpMuxUnbind( AFlags );

    if (AFlags and COF_PROPAGATE <> 0) and (Status = CST_SUCCESS) then
    begin
      Status := LowerUnbind(
                  COF_PROPAGATE or COF_QUIET or COF_IFNOTUSED, AHandle );
      if Status = CST_PENDING then TCPMUX_TempHandle := AHandle;
    end;

    MiniportUnbind := Status;
  end;


  {-------------------------------
  { TCoTcpMux.MiniportIoctl
  {---
  { !@#
  {---
  }

  function TCoTcpMux.MiniportIoctl( ALevel: Word; AFlags: Word; ACode: Word;
    ABuffer: Pointer; ABuffSize: Word; AHandle: PCoRequest ): TCoStatus;
  var
    Status : TCoStatus;
    User   : PTcpMuxUserBlock;
  begin

    Status := LowerIoctl( ALevel, AFlags, ACode, ABuffer,
                   ABuffSize, AHandle );

    if Status = CST_PENDING then
    begin
      User := @TTcpMuxUserBlock( CoGetDeviceSlot( AHandle )^.User );
      User^.ReqType := TCPMUX_REQ_UPPER;
      TCPMUX_ReqList.InsertTail( @User^.QLink, AHandle );
      UpperNextRequest( AHandle, [RQ_TYPE_SENDPACKET, RQ_TYPE_IOCTL] );
    end;

    MiniportIoctl := Status;
  end;



  {-------------------------------
  { TCoTcpMux.MiniportCancel
  {---
  { !@#
  {---
  {
  }


  procedure TCoTcpMux.MiniportCancel( ACancelAll: Boolean );
  var
    Request  : PCoRequest;
    Link     : PCoDeviceRequestQueueLink;
    NextLink : PCoDeviceRequestQueueLink;
  begin
    {$IFDEF DEBUG_TCPMUX}
    WriteLn( SID,  'TcpMux: MiniportCancel' );
    {$ENDIF}

    if (TCPMUX_TempHandle <> nil) and (ACancelAll or
         CoShouldCancel( TCPMUX_TempHandle )) then
    begin
      LowerCancelIO( TCPMUX_TempHandle, 0 );
    end;


    Link := TCPMUX_ReqList.Head;

    while Link <> nil do
    begin
      NextLink := Link^.Next;
      Request := Link^.Request;

      if ACancelAll or CoShouldCancel( Request ) then
      begin
        LowerCancelIO( Request, 0 );
      end;

      Link := NextLink;
    end;

  end;

  {-------------------------------
  { TCoTcpMux.ProtocolSendComplete
  {---
  { !@#
  {---
  {
  }

  function  TCoTcpMux.ProtocolSendComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  var
    User : PTcpMuxUserBlock;
  begin
    {$IFDEF DEBUG_TCPMUX}
    WriteLn( SID, 'TcpMux: ProtocolSendComplete' );
    {$ENDIF}

    User := @TTcpMuxUserBlock( CoGetDeviceSlot( AHandle )^.User );

    case User^.ReqType of

      TCPMUX_REQ_UPPER    :
      begin
        TCPMUX_ReqList.Remove( @User^.QLink );
        UpperComplete( AHandle, Status );
        ProtocolSendComplete := True;
      end;

    else
      RunError( 255 );
    end;

    ProtocolSendComplete := True;
  end;

  {-------------------------------
  { TCoTcpMux.ProtocolUnbindComplete
  {---
  { !@#
  {---
  {
  }


  function TCoTcpMux.ProtocolBindComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  var
    Slot : PCoRequestSlot;
  begin
    if TCPMUX_TempHandle = AHandle then
    begin
      TCPMUX_TempHandle := nil;
      if Status = CST_SUCCESS then
      begin
        Slot := CoGetDeviceSlot( AHandle );
        with TCoBindParams(Slot^.Params) do
          UpperComplete( AHandle,  TcpMuxBind( @Address, Flags ) );
      end
      else
        UpperComplete( AHandle, Status );

      ProtocolBindComplete := True;
    end
    else
      ProtocolBindComplete := False;
  end;


  {-------------------------------
  { TCoTcpMux.ProtocolUnbindComplete
  {---
  { !@#
  {---
  {
  }

  function TCoTcpMux.ProtocolUnbindComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  begin
    if TCPMUX_TempHandle = AHandle then
    begin
      TCPMUX_TempHandle := nil;
      UpperComplete( AHandle, Status );
      ProtocolUnbindComplete := True;
    end
    else
      ProtocolUnbindComplete := False;
  end;


  {-------------------------------
  { TCoTcpMux.ProtocolIoctlComplete
  {---
  { !@#
  {---
  {
  }

  function TCoTcpMux.ProtocolIoctlComplete( AHandle: PCoRequest;
    Status: TCoStatus ): Boolean;
  var
    User : PTcpMuxUserBlock;
  begin
    User := @TTcpMuxUserBlock( CoGetDeviceSlot( AHandle )^.User );

    case User^.ReqType of

      TCPMUX_REQ_UPPER:
      begin
        TCPMUX_ReqList.Remove( @User^.QLink );
        UpperComplete( AHandle, Status );
      end;

      TCPMUX_REQ_ICMPMSG:
      begin
        TCPMUX_ReqList.Remove( @User^.QLink );
        CoReleasePacket( User^.Packet );
        CoFreeRequest( AHandle );
      end;

    else
      RunError( 255 );
    end;

  end;


  {-------------------------------
  { TCoTcpMux.ProtocolReceiveFilter
  {---
  { !@#
  {---
  { async funkce
  }

  function TCoTcpMux.ProtocolReceiveFilter( APacket: PCoPacket ): Boolean;
  begin

    with PIpDevAddress(@APacket^.Address)^ do
    begin
      ProtocolReceiveFilter := (Protocol = IP_PROTO_TCP);
    end;

  end;

  {-------------------------------
  { TCoTcpMux.ProtocolReceive
  {---
  { !@#
  {---
  {
  }

  procedure TCoTcpMux.ProtocolReceive( APacket: PCoPacket );
  var
    Req       : PCoRequest;
    User      : PTcpMuxUserBlock;
    Status    : TCoStatus;

    IpAddress  : TIpAddress;
    PseudoHdr  : TPseudoHeader;
    TcpHdr     : PTcpHeader;
    TcpHdrSize : Word;
  begin

    TcpHdr := PTcpHeader( APacket^.DataPtr );

    { Minimalni delka paketu = delka hlavicky + 1 }
    if APacket^.DataSize < SizeOf( TTcpHeader ) then
    begin
      Exit;
    end;

    { Velikost dat }

    TcpHdrSize := (TcpHdr^.DataOfs shr 4) * 4;

    if APacket^.DataSize < TcpHdrSize then
    begin
      Exit;
    end;

    { Vytvoreni pseudohlavicky }
    with PIpHeader( APacket^.Header )^ do
    begin
      PseudoHdr.Source   := Source;
      PseudoHdr.Dest     := Dest;
      PseudoHdr.Unused   := 0;
      PseudoHdr.Protocol := IP_PROTO_TCP;
      PseudoHdr.Length   := Swap( APacket^.DataSize );
    end;

    { Checksum }
    if IpCheckSumEx( @PseudoHdr, SizeOf( PseudoHdr ),
         IpCheckSum( TcpHdr, APacket^.DataSize ) ) <> 0 then
    begin
      Exit;
    end;

    APacket^.Header := APacket^.RemoveHeader( TcpHdrSize );

    IpAddress := PIpDevAddress( @APacket^.Address )^.Node;

    with PTcpAddress( @APacket^.Address )^ do
    begin
      Size    := SizeOf( TTcpAddress );
      Address := IpAddress;
      Port    := Swap( TcpHdr^.SourcePort );
    end;

    if UpperReceivePacket( APacket ) = CST_ERR_DROPPED then
    begin
      { Paket nebyl vrstvou TCP zpracovan..
        posleme ICMP zpravu PORT UNREACHABLE.. }

      Req := CoAllocRequest( hptCtrl );

      if Req <> nil then
      begin

        User := @TTcpMuxUserBlock( CoGetDeviceSlot( Req )^.User );

        User^.ReqType := TCPMUX_REQ_ICMPMSG;
        User^.Packet  := APacket;
        APacket^.AddRef;

        User^.Icmp.Code := ICMPDU_PORT_UNREACHABLE;
        User^.Icmp.Header := APacket^.Header;

        Status := LowerIoctl( DEV_CLASS_IPV4, 0, IOCTL_IPV4_ICMP_DESTUNREACH,
                    @User^.Icmp, SizeOf( TIoctlIcmpDestUnreach ), Req );

        if Status = CST_PENDING then
        begin
          TCPMUX_ReqList.InsertTail( @User^.QLink, Req );
        end
        else begin
          CoReleasePacket( APacket );
          CoFreeRequest( Req );
        end;

      end;

    end;

  end;


begin
  CoRegisterDeviceClass( @TcpMuxClass );
  CoRegisterDeviceClass( @TcpClass );
end.