{**********************************************************************}
{*                  Trumpet TCPDRV ABI Interface Unit                 *}
{*                 -----------------------------------                *}
{*                      Written by Priidu Paomets                     *}
{*  (e-mail: priidu@pld.ttu.ee   web: http://www.pld.ttu.ee/~priidu)  *}
{*--------------------------------------------------------------------*}
{* This file can be freely used in any application, although it would *}
{* be nice to get a notification by e-mail. I do not keep myself      *}
{* responsible for any errors that might lead to some kind of damage. *}
{* Use at your own risk!                                              *}
{*--------------------------------------------------------------------*}
{*     Special thanks to Jeff Patterson <aa093@fan.nb.ca> for his     *}
{*                       numerous contributions                       *}
{**********************************************************************}

{$G+}
{.$DEFINE NewInt08} {<-- Remove the leading dot to defined the conditional}

unit TrumpTCP;

interface

const
  StandardBufSize    = 1500; { Set this to meet your needs }

  tcpMaxConnections  = 10; { Set this to comply with the actual needs }

  { Flags }
  tcpfNormal         = $00;
  tcpfListener       = $01;
  tcpfAbortSession   = $02;
  tcpfAsynchronous   = $80;

  { Error codes }
  tcpOK              = 0;
  tcpBadCall         = 1;
  tcpCritical        = 2;
  tcpNoHandles       = 3;
  tcpBadHandle       = 4;
  tcpTimeout         = 5;
  tcpBadSession      = 6;
  tcpNotAttached     = 7; {?? Is it this constant? }
  tcpAlreadyAttached = 8; {?? Is it this constant? }
  tcpBufferOverflow  = 9; { Local to this unit }

  { Timeout constants }
  toNonBlocking      = 0;
  toInfinite         = $FFFF;

const { Service Port Numbers }
  ECHO_PORT          : Word =    7; { UDP & TCP }
  DISCARD_PORT       : Word =    9; { UDP & TCP } {sink null}
  SYSTAT_PORT        : Word =   11; { TCP }       {users}
  QUOTD_PORT         : Word =   17; { TCP }       {quote}
  FTP_PORT           : Word =   21;
  TELNET_PORT        : Word =   23;
  SMTP_PORT          : Word =   25;
  NAMESERVER_PORT    : Word =   42; { TCP }
  DOMAIN_PORT        : Word =   53; { UDP & TCP } {nameserver}
  FINGER_PORT        : Word =   79;
  LINK_PORT          : Word =   87; { TCP }       {ttylink}
  POP3_PORT          : Word =  110; { TCP }       {postoffice}
  AUTH_PORT          : Word =  113; { TCP }       {authentication}
  NNTP_PORT          : Word =  119; { TCP }

 {Other common ports}
  TERM_PORT          : Word = 5000; { TCP }       {default for KA9Q term server}

 {Useful Unix Specifics}
  NETWALL_PORT       : Word =  533; { UDP }       {-for emergency broadcasts}

const
  TCPState : array [0..12] of String[12] = ('ERROR',
    'LISTEN', 'SYN-SENT', 'SYN-RECV', 'ESTABLISHED',
    'FIN-WAIT1', 'FIN-WAIT2', 'CLOSE-WAIT', 'CLOSING',
    'LAST-ACK', 'TIME-WAIT', 'CLOSED', 'TOO_HIGH'
  );

type
  TSocket = Word;

  TIPAddr = record
    case Longint of
      0: (S_Addr: Longint);
      1: (S_W1, S_W2: Word);
      2: (S_B1, S_B2, S_B3, S_B4: Byte);
  end;

  TTCPDriverInfo = record
    MyIP       : TIPAddr;
    NetMask    : TIPAddr;
    Gateway    : TIPAddr;
    DNSServer  : TIPAddr;
    TimeServer : TIPAddr;
    MTU        : Word;
    Def_TTL    : Byte;
    Def_TOS    : Byte;
    Unknown    : array [0..1] of Byte;
    TCP_MSS    : Word;
    TCP_RWIN   : Word;
    Debug      : Word;
    Domain     : String[255]; { Maybe OK - if str[0] is not part of msg }
  end;

  TSessionInfo = record
    IPSrc      : TIPAddr;
    PortSrc    : Word;
    IPDst      : TIPAddr;
    PortDst    : Word;
    IPProt     : Byte;
    Active     : Boolean;
  end;

  TTCPStatusRec = record
    State      : Byte;
    BytesReady : Word;
    BytesGoing : Word;
    IPProt     : Byte;
    Active     : Boolean;
    IPSrc      : TIPAddr;
    PortSrc    : Word;
    IPDst      : TIPAddr;
    PortDst    : Word;
  end;

  TBufferRec = record
    Buffer     : array [0..StandardBufSize] of Byte;
    Length     : Word;
  end;

  TTCPDataRec = record
    ReadCRLF   : Boolean; { On TCP_Recv only }
    Urgent     : Boolean; { On TCP_Recv only }
  end;

  TTCPSessionRec = record
    Handle     : TSocket;
    LocalPort  : Word;
    Status     : TTCPStatusRec; {State, BytesReady, BytesGoing, IPProt,
                                 IPSrc, PortSrc, IPDst, PortDst, Active }
    Result     : Byte;
    TCPSrc     : Word;
    TCPDst     : Word;
    IPDst      : TIPAddr;
    DAT        : TTCPDataRec; { ReadCRLF, Urgent }
    BytesRead  : Word;
    BytesSent  : Word;
    Buffer     : TBufferRec; { BufPtr, BufSize }
  end;

  TDefaultTRec = record
    TTL        : Byte;
    TOS        : Byte;
    ID         : Word;
    Timeout    : Word;
  end;

  TUDPSessionRec = record
    Handle     : TSocket;
    LocalPort  : Word;
    UDPSrc     : Word;
    UDPDst     : Word;
    Status     : TTCPStatusRec;
    IPDest     : TIPAddr;
    Result     : Byte;
    BytesRecv  : Word;
    BytesSent  : Word;
    Buffer     : TBufferRec;
    PktsAvail  : Word;
    NextSize   : Word;
    PktInfo    : TDefaultTRec;
  end;

  TIPSessionRec = record
    Handle     : TSocket;
    Protocol   : Byte;
    IPDest     : TIPAddr;
    Result     : Byte;
    Status     : TTCPStatusRec;
    BytesRecv  : Word;
    BytesSent  : Word;
    Buffer     : TBufferRec;
    PktsAvail  : Word;
    NextSize   : Word;
    PktInfo    : TDefaultTRec;
  end;

  TMyBuffer = array [1..4096] of byte;

const
  DrvError     : Byte = 0;
  TCPError     : Byte = 0;
  UDPError     : Byte = 0;
  IPError      : Byte = 0;
  EvError      : Byte = 0;
  DriverPresent: Boolean = False; { Set by unit's initialization code }
  TCP_Int      : Byte = 0;
  DrvTimeouts  : Boolean = False;
  DrvAsyncIO   : Boolean = False;
  Initing      : Boolean = False;

var
  SaveExitProc  : Pointer;
  DriverInfo    : TTCPDriverInfo;
  InQueuePkts   : Word;
  OutQueuePkts  : Word;
  SessionHandles: array [0..tcpMaxConnections] of TSocket;
  SessionTrack  : array [0..tcpMaxConnections] of TTCPSessionRec;
  CurrentHandle : Word;
  CurSession    : TTCPSessionRec;

{$IFDEF NewInt08}
{$F+}
var
  OldTimer     : procedure;
{$F-}
{$ENDIF}

{ Driver Hooks }

function Driver_Init: Boolean;
function Driver_Unload: Boolean;
procedure Driver_IO; far;
function Driver_CriticalFlag(var FlagAddr: Pointer): Boolean;
function Driver_CopyInfo(var Buf; BufSize: Word): Word;

{ TCP Hooks }

function TCP_Open(var SessionInfo: TTCPSessionRec; SrcPort: Word; DstPort: Word;
  DstIP: TIPAddr; Timeout: Word; Flags: Byte): Boolean;
function TCP_Close(var SessionInfo: TTCPSessionRec; Timeout: Word; Flags: Byte): Boolean;
function TCP_Recv(var SessionInfo: TTCPSessionRec; Timeout: Word; Flags: Byte): Boolean;
function TCP_Send(var SessionInfo: TTCPSessionRec; Timeout: Word; Flags: Byte): Boolean;
function TCP_Status(var SessionInfo: TTCPSessionRec;  Flags: Byte): Boolean;

{ UDP Hooks }

function UDP_Open(var Sock: TSocket; var SrcPort: Word; DstPort: Word;
  var DstIP: TIPAddr; Flags: Byte): Boolean;
function UDP_Close(Sock: TSocket; Flags: Byte): Boolean;
function UDP_Recv(Sock: TSocket; var Buf; BufSize: Word; Timeout: Word;
  Flags: Byte; var BytesRead: Word; var TTL, TOS: Byte;
  var ID: Word): Boolean;
function UDP_Send(Sock: TSocket; var Buf; BufSize: Word; Flags: Byte;
  TTL, TOS: Byte; ID: Word; var BytesSent: Word): Boolean;
function UDP_Status(Sock: TSocket; Flags: Byte; var PacketsAvail, NextSize: Word;
  var SrcIP, DstIP: TIPAddr; var IPProt: Byte; var Active: Boolean): Boolean;

{ IP Hooks }

function IP_Open(var Sock: TSocket; Protocol: Byte; var DstIP: TIPAddr;
  Flags: Byte): Boolean;
function IP_Close(Sock: TSocket): Boolean;
function IP_Recv(Sock: TSocket; var Buf; BufSize: Word; Timeout: Word;
  Flags: Byte; var BytesRead: Word; var TTL, TOS: Byte; var ID: Word): Boolean;
function IP_Send(Sock: TSocket; var Buf; BufSize: Word; Flags: Byte;
  TTL, TOS: Byte; ID: Word; var BytesSent: Word): Boolean;
function IP_Status(Flags: Byte; var PacketsAvail, NextSize: Word;
  var SrcIP, DstIP: TIPAddr; var IPProt: Byte; var Active: Boolean): Boolean;

{ Event Hooks }

function Event_AttachGlobal(Address: Pointer): Boolean;
function Event_DetachGlobal(Address: Pointer): Boolean;
function Event_AttachLocal(Sock: TSocket; Address: Pointer): Boolean;
function Event_DetachLocal(Sock: TSocket; Address: Pointer): Boolean;

{ Utility routines }

function  AddBuffer(var S: TBufferRec; ToAdd: String; Opts: Byte): Boolean;
function  DNSResolve(A: String; var IP: TIPAddr; Opts: Integer): Boolean;
function  IPtoA(IP: TIPAddr): String;
function  AtoIP(A: String; var IP: TIPAddr): Boolean;
function  TrumpetError(Code: Byte): String;

implementation
uses
  Dos;

type
  TWordRec = record
    Lo, Hi: Byte;
  end;

{ Driver Hooks }

procedure TCPCall(var R: Registers); far;
begin
  if DriverPresent or Initing then
    Intr(TCP_Int, R);
end;

function Driver_Init: Boolean;
var
  R    : Registers;
  Info : ^TTCPDriverInfo;
  I, J : Byte;
  A      : String;
  IntPtr : Pointer;
begin
  Initing := True;
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $00;
  R.AL := $FF;
  if TCP_Int <> 0 then { Driver interrupt has been set by user manually }
  begin
    A := '';
    GetIntVec(TCP_Int, IntPtr);
    for J := 0 to 15 do
      A := A + Chr(Mem[Seg(IntPtr^):Ofs(IntPtr^)+J]);
    if Copy(A, 4, 8) = 'TCP_DRVR' then
    begin
      TCPCall(R);
      if (R.AL = 0) then
      begin
        DrvTimeouts := (R.DH and $01) = $01;
        DrvAsyncIO := (R.DH and $02) = $02;
        Info := Ptr(R.ES, R.DI);
        Move(Info^, DriverInfo, SizeOf(TTCPDriverInfo));
        DriverPresent := True;
      end;
    end;
  end
  else { Scan for a driver in the $60 .. $FF range }
  begin
    for I := $60 to $FF do
    begin
      A := '';
      GetIntVec(I, IntPtr);
      for J := 0 to 15 do
        A := A + Chr(Mem[Seg(IntPtr^):Ofs(IntPtr^)+J]);
      if Copy(A, 4, 8) = 'TCP_DRVR' then
      begin
        TCP_Int := I;
        TCPCall (R);
        if (R.AL = 0) then
        begin
          DrvTimeouts := (R.DH and $01) = $01;
          DrvAsyncIO := (R.DH and $02) = $02;
          Info := Ptr (R.ES, R.DI);
          Move(Info^, DriverInfo, SizeOf(TTCPDriverInfo));
          DriverPresent := True;
          Break;
        end;
      end;
    end;
  end;
  Initing := False;
  Driver_Init := DriverPresent;
end;

function Driver_Unload: Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $01;
  TCPCall(R);
  DrvError := R.DL;
  DriverPresent := R.DL = 0;
  Driver_Unload := DriverPresent;
end;

procedure Driver_IO;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $02;
  TCPCall (R);
  InQueuePkts := R.AX;
  OutQueuePkts := R.CX;
  DrvError := R.DL;
end;

function Driver_CriticalFlag(var FlagAddr: Pointer): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $03;
  TCPCall(R);
  FlagAddr := Ptr (R.ES, R.DI);
  DrvError := R.DL;
  Driver_CriticalFlag := R.DL = 0;
end;

function Driver_CopyInfo(var Buf; BufSize: Word): Word;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $04;
  R.CX := BufSize;
  R.ES := Seg(Buf);
  R.DI := Ofs(Buf);
  TCPCall(R);
  Driver_CopyInfo := R.CX;
end;

{----- TCP Hooks --------------------------------------}

function TCP_Open(var SessionInfo: TTCPSessionRec; SrcPort: Word; DstPort: Word;
  DstIP: TIPAddr; Timeout: Word; Flags: Byte): Boolean;
var
  R: Registers;
  InfPtr: ^TSessionInfo;
begin
  FillChar(R, SizeOf(Registers), 0);
  FillChar(SessionInfo, SizeOf(TTCPSessionRec), 0);

  SessionInfo.TCPSrc := SrcPort;
  SessionInfo.TCPDst := DstPort;
  SessionInfo.IPDst := DstIP;

  R.AH := $10;
  R.AL := Flags;   { 0=Normal, 1=Listener, 128=Async }
  R.BX := SrcPort;
  R.CX := DstPort;
  R.DX := Timeout;
  R.DI := DstIP.S_B1 + (DstIP.S_B2 SHL 8);
  R.SI := DstIP.S_B3 + (DstIP.S_B4 SHL 8);
  TCPCall(R);
  TCPError := R.DL;       { NoHandles, TimedOut, InvalidSession }
  TCP_Open := R.DL = 0;
  if R.DL = 0 then
  begin
    SessionInfo.Handle := R.BX;
    SessionInfo.LocalPort := R.AX;
    CurrentHandle := R.BX;
    {Status}
    SessionInfo.Result := R.DL;

    { Now we get information about the Handle we just opened }
    FillChar(R, SizeOf(Registers), 0);
    R.AH := $14;
    R.AL := Flags;
    R.BX := SessionInfo.Handle;
    TCPCall(R);
    TCPError := R.DL;      { BadHandle }
    SessionInfo.Result := R.DL;
    if R.DL = 0 then
    begin
      SessionInfo.Status.State := R.DH;
      SessionInfo.Status.BytesReady := R.AX;
      SessionInfo.Status.BytesGoing := R.CX;
      InfPtr := Ptr(R.ES, R.DI);

      SessionInfo.Status.IPSrc := InfPtr^.IPSrc;
      SessionInfo.Status.PortSrc := InfPtr^.PortSrc;
      SessionInfo.Status.PortDst := InfPtr^.PortDst;
      SessionInfo.Status.IPDst := InfPtr^.IPDst;
      SessionInfo.Status.IPProt := InfPtr^.IPProt;
      SessionInfo.Status.Active := InfPtr^.Active;
    end;
  end
  else
    SessionInfo.Handle := $FFFF;
  TCPError := R.DL;       { NoHandles, TimedOut, InvalidSession }
end;

function TCP_Close(var SessionInfo: TTCPSessionRec; Timeout: Word; Flags: Byte): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $11;
  R.AL := Flags;   { 0=Normal, 1=Listener, 128=Async }
  R.BX := SessionInfo.Handle;
  R.DX := Timeout;
  TCPCall(R);
  TCPError := R.DL;         { BadHandle, TimedOut, InvalidSession }
  SessionInfo.Result := R.DL;
  TCP_Close := R.DL = 0;
end;

function TCP_Recv(var SessionInfo: TTCPSessionRec; Timeout: Word; Flags: Byte): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $12;
  R.AL := Flags; { 0=Normal (wait till buffer full, 1=Get as much as possible and return,
                   2=Read to  (don't include), 128=Async }
  R.BX := SessionInfo.Handle;
  R.CX := SizeOf(SessionInfo.Buffer.Buffer);
  R.DX := Timeout;
  R.ES := Seg(SessionInfo.Buffer.Buffer);
  R.DI := Ofs(SessionInfo.Buffer.Buffer);
  TCPCall(R);
  TCPError := R.DL;       { BadHandle, TimedOut, InvalidSession }
  TCP_Recv := R.DL = 0;
  SessionInfo.Result := R.DL;
  SessionInfo.BytesRead := R.AX;
  SessionInfo.Buffer.Length := R.AX;
  SessionInfo.DAT.ReadCRLF := (R.DH and $02) = $02;
  SessionInfo.DAT.Urgent := (R.DH and $08) = $08;
  TCP_Status(SessionInfo, 0);
end;

function TCP_Send(var SessionInfo: TTCPSessionRec; Timeout: Word; Flags: Byte): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $13;
  R.AL := Flags; { 0=Normal (wait till buffer delivered, 1=Put as much as possible and return,
                   2=Append  to data, 4=Push (wait till data ACKed),
                   8=Urgent data, 128=Async }
  R.BX := SessionInfo.Handle;
  R.CX := SessionInfo.Buffer.Length;
  R.DX := Timeout;
  R.ES := Seg(SessionInfo.Buffer.Buffer);
  R.DI := Ofs(SessionInfo.Buffer.Buffer);
  TCPCall(R);
  TCPError := R.DL;     { BadHandle, TimedOut, InvalidSession }
  SessionInfo.Result := R.DL;
  TCP_Send := R.DL = 0;
  SessionInfo.BytesSent := R.AX;
  TCP_Status(SessionInfo, 0);
end;

function TCP_Status(var SessionInfo: TTCPSessionRec; Flags: Byte): Boolean;
var
  R     : Registers;
  InfPtr: ^TSessionInfo;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $14;
  R.AL := Flags;
  R.BX := SessionInfo.Handle;
  TCPCall(R);
  TCPError := R.DL;      { BadHandle }
  TCP_Status := R.DL = 0;
  if R.DL = 0 then
  begin
    SessionInfo.Status.State := R.DH;
    SessionInfo.Status.BytesReady := R.AX;
    SessionInfo.Status.BytesGoing := R.CX;
    InfPtr := Ptr(R.ES, R.DI);
    SessionInfo.Status.IPSrc := InfPtr^.IPSrc;
    SessionInfo.Status.PortSrc := InfPtr^.PortSrc;
    SessionInfo.Status.IPDst := InfPtr^.IPDst;
    SessionInfo.Status.PortDst := InfPtr^.PortDst;
    SessionInfo.Status.IPProt := InfPtr^.IPProt;
    SessionInfo.Status.Active := InfPtr^.Active;
  end;
end;

{----- UDP Hooks --------------------------------------}

function UDP_Open(var Sock: TSocket; var SrcPort: Word; DstPort: Word;
  var DstIP: TIPAddr; Flags: Byte): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $20;
  R.AL := Flags;
  R.BX := SrcPort;
  R.CX := DstPort;
  R.SI := Seg(DstIP);
  R.DI := Ofs(DstIP);
  TCPCall(R);
  UDPError := R.DL;      { NoHandles }
  UDP_Open := R.DL = 0;
  if R.DL = 0 then
  begin
    SrcPort := R.AX;
    Sock := R.BX;
  end
  else
    Sock := $FFFF;
end;

function UDP_Close(Sock: TSocket; Flags: Byte): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $21;
  R.AL := Flags;
  R.BX := Sock;
  TCPCall(R);
  UDPError := R.DL;      { BadHandle }
  UDP_Close := R.DL = 0;
end;

function UDP_Recv(Sock: TSocket; var Buf; BufSize: Word; Timeout: Word;
  Flags: Byte; var BytesRead: Word; var TTL, TOS: Byte;
  var ID: Word): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $22;
  R.AL := Flags;
  R.BX := Sock;
  R.CX := BufSize;
  R.DX := Timeout;
  R.ES := Seg(Buf);
  R.DI := Ofs(Buf);
  TCPCall(R);
  UDPError := R.DL;     { BadHandle, TimedOut }
  UDP_Recv := R.DL = 0;
  if R.DL = 0 then
  begin
    BytesRead := R.AX;
    TTL := Lo(R.BP);
    TOS := Hi(R.BP);
    ID := R.SI;
  end
  else
  begin
    BytesRead := 0;
    TTL := 0;
    TOS := 0;
    ID := 0;
  end;
end;

function UDP_Send(Sock: TSocket; var Buf; BufSize: Word; Flags: Byte;
  TTL, TOS: Byte; ID: Word; var BytesSent: Word): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $23;
  R.AL := Flags;
  R.BX := Sock;
  R.CX := BufSize;
  R.ES := Seg(Buf);
  R.DI := Ofs(Buf);
  TWordRec(R.BP).Lo := TTL;
  TWordRec(R.BP).Hi := TOS;
  R.SI := ID;
  TCPCall(R);
  UDPError := R.DL; { BadHandle }
  UDP_Send := R.DL = 0;
  if R.DL = 0 then
    BytesSent := R.AX
  else
    BytesSent := 0;
end;

function UDP_Status(Sock: TSocket; Flags: Byte; var PacketsAvail, NextSize: Word;
  var SrcIP, DstIP: TIPAddr; var IPProt: Byte; var Active: Boolean): Boolean;
var
  R: Registers;
  InfPtr: ^TSessionInfo;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $24;
  R.AL := Flags;
  R.BX := Sock;
  TCPCall(R);
  UDPError := R.DL;  { BadHandle }
  UDP_Status := R.DL = 0;
  if R.DL = 0 then
  begin
    PacketsAvail := R.AX;
    NextSize := R.CX;
    InfPtr := Ptr(R.ES, R.DI);
    with InfPtr^ do
    begin
      SrcIP := IPSrc;
      DstIP := IPDst;
      IPProt := IPProt;
      {Active := (Active = 0);}
    end;
  end;
end;

{----- IP Hooks --------------------------------------}

function IP_Open(var Sock: TSocket; Protocol: Byte; var DstIP: TIPAddr;
  Flags: Byte): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $30;
  R.AL := Flags;
  R.BL := Protocol;
  R.SI := Seg(DstIP);
  R.DI := Ofs(DstIP);
  TCPCall(R);
  IPError := R.DL;  { NoHandles }
  IP_open := R.DL = 0;
  if R.DL = 0 then
    Sock := R.AX
  else
    Sock := $FFFF;
end;

function IP_Close(Sock: TSocket): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $31;
  R.BX := Sock;
  TCPCall(R);
  IPError := R.DL;     { BadHandle }
  IP_Close := R.DL = 0;
end;

function IP_Recv(Sock: TSocket; var Buf; BufSize: Word; Timeout: Word;
  Flags: Byte; var BytesRead: Word; var TTL, TOS: Byte; var ID: Word): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $32;
  R.AL := Flags;
  R.BX := Sock;
  R.CX := BufSize;
  R.DX := Timeout;
  R.ES := Seg(Buf);
  R.DI := Ofs(Buf);
  TCPCall(R);
  IPError := R.DL;  { BadHandle, TimedOut }
  IP_Recv := R.DL = 0;
  if R.DL = 0 then
  begin
    BytesRead := R.AX;
    TTL := Lo(R.BP);
    TOS := Hi(R.BP);
    ID := R.SI;
  end
  else
  begin
    BytesRead := 0;
    TTL := 0;
    TOS := 0;
    ID := 0;
  end;
end;

function IP_Send(Sock: TSocket; var Buf; BufSize: Word; Flags: Byte;
  TTL, TOS: Byte; ID: Word; var BytesSent: Word): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $33;
  R.AL := Flags;
  R.BX := Sock;
  R.CX := BufSize;
  R.ES := Seg(Buf);
  R.DI := Ofs(Buf);
  TWordRec(R.BP).Lo := TTL;
  TWordRec(R.BP).Hi := TOS;
  R.SI := ID;
  TCPCall(R);
  IPError := R.DL;  { BadHandle }
  IP_Send := R.DL = 0;
  if R.DL = 0 then
    BytesSent := R.AX
  else
    BytesSent := 0;
end;

function IP_Status(Flags: Byte; var PacketsAvail, NextSize: Word;
  var SrcIP, DstIP: TIPAddr; var IPProt: Byte; var Active: Boolean): Boolean;
var
  R: Registers;
  InfPtr: ^TSessionInfo;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AH := $34;
  R.AL := Flags;
  TCPCall(R);
  IPError := R.DL;  { BadHandle }
  IP_Status := R.DL = 0;
  if R.DL = 0 then
  begin
    PacketsAvail := R.AX;
    NextSize := R.CX;
    InfPtr := Ptr(R.ES, R.DI);
    with InfPtr^ do
    begin
      SrcIP := IPSrc;
      DstIP := IPDst;
      IPProt := IPProt;
      {Active := (Active = 0);}
    end;
  end
  else
  begin
    PacketsAvail := 0;
    NextSize := 0;
  end;
end;

{----- Event Handlers --------------------------------------}

function Event_AttachGlobal(Address: Pointer): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AX := $4000;
  R.ES := Seg(Address);
  R.DI := Ofs(Address);
  TCPCall(R);
  EvError := R.DL;  { Already attached }
  Event_AttachGlobal := R.DL = 0;
end;

function Event_DetachGlobal(Address: Pointer): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AX := $4100;
  R.ES := Seg(Address);
  R.DI := Ofs(Address);
  TCPCall(R);
  EvError := R.DL;  { Not attached }
  Event_DetachGlobal := R.DL = 0;
end;

function Event_AttachLocal(Sock: TSocket; Address: Pointer): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AX := $4200;
  R.BX := Sock;
  R.ES := Seg(Address);
  R.DI := Ofs(Address);
  TCPCall(R);
  EvError := R.DL;  { BadHandle, Already attached }
  Event_AttachLocal := R.DL = 0;
end;

function Event_DetachLocal(Sock: TSocket; Address: Pointer): Boolean;
var
  R: Registers;
begin
  FillChar(R, SizeOf(Registers), 0);
  R.AX := $4300;
  R.BX := Sock;
  R.ES := Seg(Address);
  R.DI := Ofs(Address);
  TCPCall(R);
  EvError := R.DL;  { BadHandle, NotAttached }
  Event_DetachLocal := R.DL = 0;
end;

{ Utility routines }

function AddBuffer(var S: TBufferRec; ToAdd: String; Opts: Byte): Boolean;
var
  I: Integer;
begin
  AddBuffer := False;
  if (Opts and 1)=0 then
    S.Length:=0;
  if (Length(ToAdd) + S.Length > SizeOf(S.Buffer)) then
  begin
    DrvError := tcpBufferOverflow;
    Exit;
  end;

  Move(ToAdd[1], S.Buffer[S.Length], Ord(ToAdd[0]));
  S.Length := S.Length + Ord (ToAdd[0]);
  if S.Length > 1 then
    Dec(S.Length);
  AddBuffer := True;
end;

function  DNSResolve(A: String; var IP: TIPAddr; Opts: Integer): Boolean;
begin
  DNSResolve := False;
  { This needs UDP functions to run }
end;

function  IntStr(Int: Integer): String;
var
  S: String;
begin
  Str (Int, S);
  IntStr := S;
end;

function IsBlank(Str: String): boolean;
var
  I: Byte;
begin
  IsBlank := true;
  for I := 1 to Length(Str) do
    if not (Str[I] in [' ', #9]) then
    begin
      IsBlank := false;
      Exit;
    end;
end;

function  KeyAt(Delim: Char; Str: String; At: Byte): String;
var
  TempStr: String;
  TempPos: Integer;
  ACount : Byte;
begin
  TempPos := Pos(Delim, Str);
  TempStr := Str;
  ACount := 0;
  if TempPos <> 0 then
  begin
    while (not IsBlank(TempStr)) do
    begin
      Inc(ACount);
      TempPos := Pos(Delim, TempStr);
      if TempPos = 0 then
      begin
        if ACount = At then
          KeyAt := TempStr
        else
          TempStr := '';
      end
      else
        if ACount = At then
        begin
          KeyAt := Copy(TempStr, 1, TempPos - 1);
          Break;
        end
        else
          TempStr := Copy(TempStr, TempPos + 1, Length(TempStr));
    end;
    if IsBlank(TempStr) and (ACount < At) then
      KeyAt := '';
  end
  else
    if not IsBlank(Str) then
      KeyAt := Copy(Str, 1, Length(Str))
    else
      KeyAt := '';
end;

function  KeyCount(Delim: Char; Str: String): Byte;
var
  TempStr: String;
  TempPos: Integer;
  ACount : Byte;
begin
  TempPos := Pos(Delim, Str);
  TempStr := Str;
  ACount := 0;
  if TempPos <> 0 then
  begin
    while (not IsBlank(TempStr)) do
    begin
      Inc(ACount);
      TempPos := Pos(Delim, TempStr);
      if TempPos = 0 then
        TempStr := ''
      else
        TempStr := Copy(TempStr, TempPos + 1, Length(TempStr));
    end;
    KeyCount := ACount;
  end
  else
    if not IsBlank(Str) then
      KeyCount := 1;
end;

function  NumKeyAt(Delim: Char; Str: String; At: Byte): Longint;
var
  Num: Longint;
  Bug: Integer;
  S  : String;
begin
  S := KeyAt(Delim, Str, At);
  Val (S, Num, Bug);
  if (S = '') or (Bug <> 0) then
    NumKeyAt := 0
  else
    NumKeyAt := Num;
end;

function IPtoA(IP: TIPAddr): String;
begin
  IPtoA := IntStr(IP.S_B1) + '.' + IntStr(IP.S_B2) + '.' +
           IntStr(IP.S_B3) + '.' + IntStr(IP.S_B4);
end;

function AtoIP(A: String; var IP: TIPAddr): Boolean;
var
  APos,
  Bug: Byte;
begin
  AtoIP := False;
  FillChar(IP, SizeOf (TIPAddr), 0);
  if KeyCount('.', A) = 0 then
    Exit;
  IP.S_B1 := NumKeyAt('.', A, 1);
  if KeyCount('.', A) = 1 then
    Exit;
  IP.S_B2 := NumKeyAt('.', A, 2);
  if KeyCount('.', A) = 2 then
    Exit;
  IP.S_B3 := NumKeyAt('.', A, 3);
  if KeyCount('.', A) = 3 then
    Exit;
  IP.S_B4 := NumKeyAt('.', A, 4);
  AtoIP := True;
end;

function  TrumpetError(Code: Byte): String;
begin
  case Code of
    tcpOK: TrumpetError := 'OK';
    tcpBadCall: TrumpetError := 'tcpBadCall';
    tcpCritical: TrumpetError := 'tcpCritical';
    tcpNoHandles: TrumpetError := 'tcpNoHandles';
    tcpBadHandle: TrumpetError := 'tcpBadHandle';
    tcpTimeout: TrumpetError := 'tcpTimeout';
    tcpBadSession: TrumpetError := 'tcpBadSession';
    tcpNotAttached: TrumpetError := 'tcpNotAttached';
    tcpAlreadyAttached: TrumpetError := 'tcpAlreadyAttached';
    tcpBufferOverflow: TrumpetError := 'tcpBufferOverflow';
  else
    TrumpetError := '[Unknown (' + IntStr (Code) + ')]';
  end;
end;

{$IFDEF NewInt08}
{$F+}
var
  LI          : Longint;

const
  Inside      : Boolean = False;
  ClockInt    : Byte = $08;
  Smooth      : Boolean = True;

procedure NewTimer(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);
interrupt;
begin
  if Inside = True then
  begin
    if Smooth then
    asm
      pushf
      call OldTimer;
      sti
    end;
    asm iret end;
  end;
  Inside := True;
  Driver_IO;
  asm
    pushf
    call OldTimer;
    sti
  end;
  Inside := False;
end;

procedure NewExitProc; far;
var
  SaveExitProc: Pointer;
begin
 { ExitProc := @SaveExitProc;}
  SetIntVec(ClockInt, @OldTimer);
  SaveExitProc:=ExitProc;
end;
{$F-}
{$ENDIF}

begin
  if Driver_Init then
  begin
   {$IFDEF NewInt08}
    SaveExitProc := ExitProc;
    ExitProc := @NewExitProc;
    GetIntVec(ClockInt, @OldTimer);
    SetIntVec(ClockInt, Addr(NewTimer));
   {$ENDIF}
  end;
end.