{$IFDEF OS2}
{$Delphi+}
{$ENDIF}

Unit
  kSockets;

{$I+}

Interface

Uses
  SysUtils,
  kSockDef,
  tMisc,
{$IFDEF WIN32}
  Windows,
  os2comp,
{$ELSE}
  Dos,
  Os2Def,
  Os2Base,
{$ENDIF}
  kSockFun;

Type

  TSocket = Class
    Protected
      fDescriptor: tSockDesc;
      fBlocking: Boolean;
      fReadBuf: String;
      Procedure SetBlocking (Blocking: Boolean);
      Function GetDataAvailable: Boolean;
      Constructor CreateHot (Descriptor: tSockDesc; Const Peername: tSockAddr);

    Public
      Error : Byte;
      ConnectedTo : tSockAddr;
      BoundTo : TSockAddr;

      Constructor Create (Family, bType, Protocol: SmallWord);
      Destructor Destroy; Override;

      Procedure Connect (Const SockAddr: tSockAddr);
      Procedure Bind (Family: SmallWord; InetAddr: ULong; Port: SmallWord);
      Procedure Close;
      Procedure Cancel;
      Procedure Listen(BackLog: ULong);
      Procedure BlockRead(Var Buffer; BufLen: ULong; Var BytesRead: ULong);
      Procedure BlockWrite(const Buffer; BufLen: ULong);
      Procedure Transact(const WriteBuffer; WriteBufLen: ULong; Var ReadBuffer; ReadBufLen: ULong; Var BytesRead: ULong);
      Procedure SendStrLn(s: String);

      Function isConnected: Boolean;
      Function isBound: Boolean;
      Function Accept: tSocket;
      Function RecvStrLn (Var s: String): Boolean;
      Function TransactStrLn (StIn: String; Var StOut: String): Boolean;
      Function BoundToAddrStr: String;
      Function ConnectedToAddrStr: String;
      Function BoundToSockStr: String;
      Function ConnectedToSockStr: String;
      Function GetLocalHost: String;

      Property Blocking: Boolean READ fBlocking WRITE SetBlocking;
      Property Descriptor: tSockDesc READ fDescriptor;
      Property DataAvailable: Boolean Read GetDataAvailable;

      Class Function GetHostByAddr (Const InetAddr: tIn_Addr): String;
      Class Function GetHostByName (Const Hostname: String): LongInt;
      Class Function htons (Input: SmallInt): SmallInt;
      Class Function htonl (Input: LongInt): LongInt;
      Class Function ntohs (Input: SmallInt): SmallInt;
      Class Function ntohl (Input: LongInt): LongInt;
      Class Function InetAddrStr (Const InetAddr: TIn_Addr): String;
      Class Function GetServPortByName (Name, Proto: String): SmallInt;
  End;

Implementation

Class Function tSocket. GetHostByAddr (Const InetAddr: TIn_Addr): String;
Begin
  Result := SockGetHostNameByAddr (@InetAddr)
End;

Function tSocket. GetLocalHost: String;
Var
  sAddr: tSockAddr;
  rc: Longint;

Begin
  rc := SockGetSockAddr (fDescriptor, sAddr);
  If rc = -1 Then Error := 10 Else
  Begin
    Error := 0;
    Result := GetHostByAddr (sAddr. Sin_Addr);
  End;
End;

Function tSocket.BoundToAddrStr: String;
Begin
  Result := InetAddrStr(BoundTo.Sin_Addr);
End;

Function tSocket.ConnectedToAddrStr: String;
Begin
  Result := InetAddrStr(ConnectedTo.Sin_Addr);
End;

Function tSocket.BoundToSockStr: String;
Begin
  Result := BoundToAddrStr + ':' + Long2Str(htons(BoundTo.Sin_Port));
End;

Function tSocket.ConnectedToSockStr: String;
Begin
  Result := ConnectedToAddrSTr + ':' + Long2Str (htons (ConnectedTo. Sin_Port));
End;

Constructor tSocket. CreateHot (Descriptor: TSockDesc; Const Peername: TSockAddr);
Begin
  fDescriptor := Descriptor;
  fBlocking := True;
  fReadBuf := '';
  FillChar (BoundTo, SizeOf (BoundTo), 0);
  ConnectedTo := Peername;
End;

Function tSocket. Accept: TSocket;
Var
  Res      : ApiRet;
  NameLen  : ULong;
  PeerName : tSockAddr;

Begin
  NameLen := SizeOf (Peername);
  Res := SockAccept (fDescriptor, @Peername, NameLen);

  If Res = -1 Then Error := 9 Else
  Begin
    Error := 0;
    Result := tSocket. CreateHot (Res, Peername);
  End;
End;

Procedure tSocket.Bind(Family: SmallWord; InetAddr: ULong; Port: SmallWord);
Var
  Res: ApiRet;
  SockAddr: tSockAddr;

Begin
  FillChar (SockAddr, SizeOf (SockAddr), 0);
  SockAddr. Sin_Family := Family;
  SockAddr. Sin_Addr. IPAddr := InetAddr;
  SockAddr. Sin_Port := Port;
  Res := SockBind (fDescriptor, SockAddr);

  If Res=-1 then Error := 8 Else
  Begin
    Error := 0;
    if Port=0 then SockGetSockAddr(fDescriptor, BoundTo) else BoundTo := SockAddr;
  End;
End;

Function tSocket.isBound: Boolean;
Begin
  Result := (BoundTo. Sin_Family <> 0);
End;

Procedure tSocket.Cancel;
Begin
  SockCancel (fDescriptor);
End;

Procedure tSocket. Listen(BackLog: ULong);
Var
  Res: ApiRet;

Begin
  Res := SockListen (fDescriptor, Backlog);
  if Res=-1 Then Error := 7 Else Error := 0;
End;

Procedure tSocket. BlockRead (Var Buffer; BufLen: ULong; Var BytesRead: ULong);
Var
  P        : PChar;
  ReadLen  : LongInt;
  WasEmpty : Boolean;

Begin
  P := @Buffer;
  BytesRead := 0;
  WasEmpty := fReadBuf = '';

  If Not WasEmpty Then
  Begin
    If Length (fReadBuf) > BufLen Then BytesRead := BufLen Else
    Begin
      BytesRead := Length (fReadBuf);
      Dec (BufLen, BytesRead);
      Inc (P, BytesRead);
    End;

    Move (fReadBuf [1], Buffer, BytesRead);
  {$IFDEF WIN32}
    SetLength (fReadBuf, Length (fReadBuf)-BytesRead);
  {$ELSE}
    Dec (fReadBuf [0], BytesRead);
  {$ENDIF}
  End;

  If WasEmpty Or DataAvailable
  Then
    ReadLen := SockRecv (fDescriptor, P, BufLen, 0)
  Else
    ReadLen := 0;

  If ReadLen = -1 Then Error := 6 Else
  Begin
    Error := 0;
    Inc (BytesRead, ReadLen);
  End;
End;

Procedure tSocket.BlockWrite(const Buffer; BufLen: ULong);
Var
  Res: ApiRet;

Begin
  Res := SockSend(fDescriptor, @Buffer, BufLen, 0);
  If Res = -1 then Error := 5 Else Error := 0;
End;

Procedure tSocket. Transact (Const WriteBuffer; WriteBufLen: ULong; Var ReadBuffer; ReadBufLen: ULong; Var BytesRead: ULong);
Begin
  BlockWrite(WriteBuffer, WriteBufLen);
  BlockRead(ReadBuffer, ReadBufLen, BytesRead);
End;

Procedure tSocket.SendStrLn(s: String);
Begin
  s := s + #13#10;
  BlockWrite (s [1], Length (s));
End;

Function tSocket. RecvStrLn (Var s: String): Boolean;
Var
  BytesRead, P : Integer;

Begin
  If fReadBuf <> '' Then
  Begin
    s := fReadBuf;
    fReadBuf := '';
  End Else
    s := '';

  p := Pos (#13#10, s);

  If p = 0 Then
  Begin
    p := Length (s);
    SetLength (s, 255);
    BlockRead (s [p+1], 255-p-1, ULong (BytesRead));
    SetLength (s, p + BytesRead);
  End;

  p := Pos (#13#10, s);
  Result := (p > 0);

  If Result then
  Begin
    fReadBuf := Copy (s, p+2, 255);
    s := Copy (s, 1, p-1);
  End Else
    fReadBuf:=s;

End;

Function tSocket.TransactStrLn (StIn: String; Var StOut: String): Boolean;
Begin
  SendStrLn(StIn);
  while not DataAvailable do
    DosSleep(10);
  Result:=RecvStrLn(StOut);
End;


Function tSocket.GetDataAvailable: Boolean;
Begin
  Result:=fReadBuf<>'';
  if not Result then
    Result:=(SockSelect(fDescriptor)=1);
End;

Procedure tSocket. Close;
Var
  Res: ApiRet;

Begin
  If fDescriptor <> -1 Then
  Begin
    Res := SockClose (fDescriptor);
    If Res = -1 Then Error := 4 Else
    Begin
      Error := 0;
      Exit;
    End;
  End;

  fDescriptor := -1;
  FillChar(ConnectedTo, SizeOf(ConnectedTo), 0);
End;

constructor tSocket.Create(Family, bType, Protocol: SmallWord);
Begin
  Inherited Create;
  fBlocking := True;
  fReadBuf := '';
  FillChar (ConnectedTo, SizeOf (ConnectedTo), 0);
  FillChar (BoundTo, SizeOf (BoundTo), 0);
  fDescriptor := SockSocket (Family, bType, Protocol);
  If fDescriptor=-1 Then Error := 1 Else Error := 0;
End;

destructor tSocket.Destroy;
Var
  Res: ApiRet;

Begin
  Close;
  Inherited Destroy;
End;

Procedure tSocket. Connect (Const SockAddr: tSockAddr);
Var
  Res: ApiRet;

Begin
  Res := SockConnect (fDescriptor, SockAddr);
  If Res = -1 Then Error := 2 Else
  Begin
    Error := 0;
    ConnectedTo := SockAddr;
    If BoundTo. Sin_family = 0 then SockGetSockAddr (fDescriptor, BoundTo)
  End;
End;

Function tSocket. isConnected: Boolean;
Begin
  Result := ConnectedTo. Sin_Addr. IPAddr <> 0;
End;

Procedure tSocket.SetBlocking(Blocking: Boolean);
Begin
  If fBlocking<>Blocking then
  If SockSetBlockingIo (fDescriptor, Blocking) = -1
  Then Error := 3 Else Error := 0;
End;

Class Function tSocket. GetHostByName (Const Hostname: String): LongInt;
Begin
  Result := SockGetHostAddrByName (Hostname);
End;

Class Function tSocket. htons (Input: SmallInt): SmallInt;
Begin
  Result := SockHtons (Input);
End;

Class Function tSocket.htonl(Input: LongInt): LongInt;
Begin
  Result := SockHtonl(Input);
End;

Class Function tSocket.ntohs(Input: SmallInt): SmallInt;
Begin
  Result := SockNtohs(Input);
End;

Class Function tSocket.ntohl(Input: LongInt): LongInt;
Begin
  Result := SockNtohl(Input);
End;

Class Function tSocket.InetAddrStr(const InetAddr: tIn_Addr): String;
Begin
  Result := Long2Str (InetAddr. ClassA) + '.' +
            Long2Str (InetAddr. ClassB) + '.' +
            Long2Str (InetAddr. ClassC) + '.' +
            Long2Str (InetAddr. ClassD);
End;

Class Function tSocket.GetServPortByName(Name, Proto: String): SmallInt;
Begin
  Result := SockGetServPortByName(Name, Proto);
End;

End.