unasockets.pas

Voice Commnucation Components for Delphi

destructor unaSocket.destroy();
begin
  close();
  //
  inherited;
end;

// --  --
function unaSocket.getBindToPort(): string;
begin

end;

// --  --
function unaSocket.getBufSize(index: Integer): unsigned;
begin
  case (index) of

    0: result := getOptInt(SO_SNDBUF);
    1: result := getOptInt(SO_RCVBUF);

    else
      result := 0;
  end;
end;

// --  --
class function unaSocket.getGeneralMTU(): unsigned;
begin
{
Below is a list of Default MTU size for different media.

   Network                  MTU(Bytes)
   -----------------------------------
   16 Mbit/Sec Token Ring    17914
   4 Mbits/Sec Token Ring     4464
   FDDI                       4352
   Ethernet                   1500
   IEEE 802.3/802.2           1492
   X.25                        576
}
  if (nil <> g_unaWSA) then
    result := word(g_unaWSA.f_data.iMaxUdpDg)
  else
    result := 0;
end;

// --  --
function unaSocket.getIsActive(): bool;
begin
  result := (isConnected() or isListening());
end;

// --  --
function unaSocket.getMTU(): uint;
begin
  result := word(uint(getOptInt(SO_MAX_MSG_SIZE)));
end;

// --  --
function unaSocket.getOptBool(opt: int): bool;
var
  c: Windows.BOOL;
  len: int;
begin
  if (not check_error()) then begin
    //
    len := sizeOf(c);
    if (0 = checkError(getsockopt(f_socket, SOL_SOCKET, opt, @c, len), true {$IFDEF DEBUG}, self._classID + '.getOptBool()'{$ENDIF})) then
      result := ((len > 0) and c)
    else
      result := false;
  end
  else
    result := false;
end;

// --  --
function unaSocket.getOptInt(opt: int): int;
var
  len: int;
begin
  if (INVALID_SOCKET <> f_socket) then begin
    //
    len := sizeof(result);
    checkError(getsockopt(f_socket, SOL_SOCKET, opt, @result, len), true {$IFDEF DEBUG}, self._classID + '.getOptInt()'{$ENDIF});
    if (len < sizeof(result)) then
      result := -2;
  end
  else
    result := -1;
end;

// --  --
function unaSocket.getPendingDataSize(noCheckState: bool): unsigned;
var
  len: int;
begin
  if (noCheckState or okToRead()) then
    //
    if (0 <> ioctl(FIONREAD, len)) then
      result := 0
    else
      result := len
  else
    result := 0;
end;

// --  --
function unaSocket.getPort(): string;
begin
  if (f_port.p_name = nil) then
    result := Int2Str(f_port.p_proto)
  else
    result := f_port.p_name;
end;

// --  --
function unaSocket.getPortInt(): word;
begin
  result := word(f_port.p_proto);
end;

// --  --
function unaSocket.getSockAddr(var addr: sockaddr_in): int;
var
  ip: string;
begin
  addr.sin_family := f_socketAddressFamily;
  if ('' = host) then begin
    //
    addr.sin_addr.s_addr := inet_addr(pChar(f_bindToIp));
    if (int(INADDR_NONE) = int(addr.sin_addr.s_addr)) then
      addr.sin_addr.s_addr := INADDR_ANY;
    //
    result := 0;
  end
  else begin
    //
    result := lookupHost(host, ip);
    if (0 = result) then
      addr.sin_addr.s_addr := inet_addr(pChar(ip));
    //
  end;
  //
  if (0 = result) then
    addr.sin_port := htons(getPortInt());
end;

// --  --
function unaSocket.getSocket(forceCreate: bool): tSocket;
begin
  if (forceCreate) then
    socket();
  //
  result := f_socket;
end;

// --  --
function unaSocket.ioctl(command: unsigned; var param: int): int;
begin
  result := checkError(WinSock.ioctlsocket(f_socket, command, param), true {$IFDEF DEBUG}, self._classID + '.ioctl()'{$ENDIF});
end;

// --  --
function unaSocket.isConnected(timeout: unsigned): bool;
begin
  result := not check_error(timeout) and okToWrite(timeout);
end;

// --  --
function unaSocket.isListening(): bool;
begin
  if (SOCK_DGRAM = f_socketType) then
    result := false	// UDP sockets simply binds to local port
  else
    result := getOptBool(SO_ACCEPTCONN);
end;

// --  --
function unaSocket.listen(backlog: int): int;
begin
  if (isListening()) then
    result := 0
  else begin
    //
    result := bind(nil);
    //
    if (0 = result) then
      result := checkError(WinSock.listen(f_socket, backlog), true {$IFDEF DEBUG}, self._classID + '.listen()'{$ENDIF});
  end;
end;

// --  --
function unaSocket.oktoRead(timeout: unsigned; noCheckState: bool): bool;
begin
  result := (noCheckState or check_read(timeout));
end;

// --  --
function unaSocket.oktoWrite(timeout: unsigned; noCheckState: bool): bool;
begin
  result := (noCheckState or check_write(timeout));
end;

// --  --
function unaSocket.read(const buf: pointer; var size: unsigned; timeout: unsigned; noCheck: bool): int;
var
  e: int;
begin
  if (noCheck or (isActive and waitForData(timeout, true))) then begin
    //
    e := recv(f_socket, buf^, size, 0);
    if (e = SOCKET_ERROR) then
      result := checkError(e, true {$IFDEF DEBUG}, self._classID + '.read()'{$ENDIF})
    else begin
      //
      size := e;
      result := 0;
    end;
  end
  else
    result := -1;
  //
  if (WSAECONNRESET = result) then
    close();
end;

// --  --
function unaSocket.readString(noCheck: bool): string;
var
  len: unsigned;
begin
  result := '';
  len := getPendingDataSize();
  //
  if (len > 0) then begin
    //
    SetLength(result, len);
    if (read(@result[1], len, 100, noCheck) = 0) then
      SetLength(result, len)
    else
      result := '';
    //
  end;
end;

// --  --
function unaSocket.select(r, w, e: pbool; timeout: unsigned): int;

  // --  --
  function fdset(v: pbool; fds: pfdset): pfdset;
  begin
    if (v <> nil) then begin
      //
      FD_ZERO(fds^);
      FD_SET(f_socket, fds^);
      //
      result := fds;
    end
    else
      result := nil;
  end;

var
  fds_r: tfdset;
  fds_w: tfdset;
  fds_e: tfdset;
  //
  fds_rptr: pfdset;
  fds_wptr: pfdset;
  fds_eptr: pfdset;
  //
  tv: tTimeval;
  timeptr: pTimeval;
begin
  if (INVALID_SOCKET = f_socket) then
    socket();
  //
  if (nil <> r) then
    fds_rptr := fdset(r, @fds_r)
  else
    fds_rptr := nil;
  //
  if (nil <> w) then
    fds_wptr := fdset(w, @fds_w)
  else
    fds_wptr := nil;
  //
  if (nil <> e) then
    fds_eptr := fdset(e, @fds_e)
  else
    fds_eptr := nil;
  //
  if (timeout <> INFINITE) then begin
    //
    if (1 > timeout) then begin
      //
      tv.tv_sec  := 0;
      tv.tv_usec := 0;
    end
    else begin
      //
      tv.tv_sec  :=   timeout shr 10;					// ~ timeout div 1000
      tv.tv_usec := ((timeout - unsigned(tv.tv_sec) shl 10) shl 10);	// ~ (timeout mod 1000) * 1000;
      //
      if (999999 < tv.tv_usec) then
	tv.tv_usec := 999999;
    end;
    //
    timeptr := @tv;
  end
  else
    timeptr := nil;
  //
  result := WinSock.select(1, fds_rptr, fds_wptr, fds_eptr, timeptr);
  //
  if (1 = result) then begin
    //
    if (r <> nil) then r^ := FD_ISSET(f_socket, fds_r);
    if (w <> nil) then w^ := FD_ISSET(f_socket, fds_w);
    if (e <> nil) then e^ := FD_ISSET(f_socket, fds_e);
  end
  else begin
    //
    if (0 = result) then // timeout?
    else
      result := checkError(result, true {$IFDEF DEBUG}, self._classID + '.select()'{$ENDIF});
    //
  end;    
end;

// --  --
function unaSocket.send(buf: pointer; size: unsigned; noCheck: bool): int;
begin
  if (noCheck or okToWrite(1)) then begin
    //
    result := WinSock.send(f_socket, buf^, size, 0);
    if (SOCKET_ERROR = result) then begin
      //
      result := checkError(result, true {$IFDEF DEBUG}, self._classID + '.send()'{$ENDIF})
    end
    else begin
      //
      if (unsigned(result) = size) then
	result := 0
      else
	result := -2;
      //	
    end;
  end
  else begin
    //
    result := -1;
    assert(assertLog(self._classID + '.send() - okToWrite() fails.'));
  end;
end;

// --  --
function unaSocket.send(const value: string; noCheck: bool): int;
begin
  result := send(@value[1], Length(value), noCheck);
end;

// --  --
procedure unaSocket.setBindToPort(const value: string);
begin
  lookupPort(value, f_bindToPort);
end;

// --  --
procedure unaSocket.setBufSize(index: Integer; value: unsigned);
begin
  case (index) of

    0: setOptInt(SO_SNDBUF, value);
    1: setOptInt(SO_RCVBUF, value);

  end;
end;

// --  --
procedure unaSocket.setHost(const host: string);
begin
  if (not isActive) then
    f_host := trim(host);
end;

// --  --
function unaSocket.setOptBool(opt: int; value: bool): int;
var
  len: int;
  val: Windows.BOOL;
begin
  if (INVALID_SOCKET <> f_socket) then begin
    //
    val := value;
    len := sizeof(val);
    result := checkError(setsockopt(f_socket, SOL_SOCKET, opt, @val, len), true {$IFDEF DEBUG}, self._classID + '.setOptBool()'{$ENDIF});
  end
  else
    result := -1;
end;

// --  --
function unaSocket.setOptInt(opt, value: int): int;
var
  len: int;
begin
  if (INVALID_SOCKET <> f_socket) then begin
    //
    len := sizeof(value);
    result := checkError(setsockopt(f_socket, SOL_SOCKET, opt, @value, len), true {$IFDEF DEBUG}, self._classID + '.setOptInt()'{$ENDIF});
  end
  else
    result := -1;
end;

// --  --
function unaSocket.setPort(port: word): bool;
begin
  result := setPort(Int2Str(port));
end;

// --  --
function unaSocket.setPort(const port: string): bool;
begin
  if (isActive) then
    result := false
  else
    result := (lookupPort(port, f_port) = 0);
end;

// --  --
function unaSocket.shutdown(how: int): int;
begin
  if (isActive) then
    result := checkError(WinSock.shutdown(f_socket, how), true {$IFDEF DEBUG}, self._classID + '.shutdown()'{$ENDIF})
  else
    result := 0;
end;

// --  --
function unaSocket.socket(): int;
begin
  if (INVALID_SOCKET = f_socket) then
    f_socket := WinSock.socket(f_socketAddressFamily, f_socketType, f_socketProtocol);
  //
  if (INVALID_SOCKET = f_socket) then
    result := checkError(SOCKET_ERROR, true {$IFDEF DEBUG}, self._classID + '.socket()'{$ENDIF})
  else
    result := 0;
end;

// --  --
function unaSocket.waitForData(timeout: unsigned; noCheckState: bool): bool;
//var
  //delta: unsigned;
begin
  //delta := timeout;
  result := okToRead(timeout, noCheckState);
  {while (okToRead(timeout, noCheckState)) do begin
    //
    result := (0 < getPendingDataSize(true));
    if (result) then
      break
    else
      if (Windows.INFINITE <> timeout) then begin
	//
	if (50 < delta) then begin