unasockets.pas

Voice Commnucation Components for Delphi

    end;
    //
  end;
end;

// --  --
function getWSAObject(): unaWSA;
begin
  result := g_unaWSA;
end;

// --  --
function lookupHost(const host: string): int;
var
  ip: string;
begin
  result := lookupHost(host, ip);
end;

// --  --
function lookupHost(const host: string; defValue: unsigned): unsigned;
var
  ip: string;
begin
  if (0 = lookupHost(host, ip)) then
    result := str2ipH(ip)
  else
    result := defValue;
end;

// --  --
function lookupHost(const host: string; out ip: string; list: unaStringList): int;
var
  addr: unsigned;
  phost: pHostEnt;
  ok: bool;
  ar: pInt32;
begin
  ip := '';
  //
  if (length(trim(host)) >= 0) then begin
    //
    result := 0;
    //
    if (nil <> g_unaWSA) then
      ok := g_unaWSA.f_gate.enter(5000{$IFDEF DEBUG}, g_unaWSA._classID{$ENDIF})
    else
      ok := true;
    //
    if (ok) then begin
      try
	//
	addr := unsigned(inet_addr(pChar(host)));
	//
	if ((addr = unsigned(INADDR_NONE)) or (addr = unsigned(INADDR_ANY))) then begin
	  //
	  // try to resolve the name
	  phost := gethostbyname(pChar(host));
	  //
	  if (phost = nil) then
	    result := WSAGetLastError()
	  else begin
	    //
	    move(phost.h_addr^[0], addr, 4);
	    //
	    if (nil <> list) then begin
	      //
	      ar := pointer(phost.h_addr_list);
	      while (0 <> ar^) do begin
		//
		list.add(inet_ntoa(in_addr(pInt32(ar^)^)));
		//
		inc(ar);
	      end;
	    end;
	  end;
	end;
	//
	if (0 = result) then
	  // return IP address
	  ip := inet_ntoa(in_addr(addr));
	//
      finally
	//
	if (nil <> g_unaWSA) then
	  g_unaWSA.f_gate.Leave();
      end;
      //
    end;
  end
  else
    result := -1;
end;

// -- --
function getHostInfo(ip: uint): string;
var
  he: pHOSTENT;
begin
  ip := uint(htonl(int(ip)));
  he := gethostbyaddr(@ip, sizeOf(ip), AF_INET);
  //
  if (nil = he) then
    result := ipN2str(ip)
  else begin
    //
    result := he.h_name;
  end;
end;


// -- --
function listAddresses(const host: string; list: unaStringList): int; overload;
var
  ip: string;
begin
  list.clear();
  //
  result := lookupHost(host, ip, list);
end;

// -- --
function lookupPort(const port: string): int;
var
  port_info: protoent;
begin
  result := lookupPort(port, port_info);
end;

// -- --
function lookupPort(const port: string; out port_info: protoent): int;
var
  iport: int;
  pport: pProtoEnt;
begin
  if (0 < length(port)) then begin
    //
    result := 0;
    iport  := str2IntInt(port, -1);
    //
    if ((iport < 0) or (iport > $ffff)) then
      // try to resolve as name
      pport := getprotobyname(pChar(port))
    else
      // try to convert an int
      pport := getprotobynumber(iport);
    //
    if (pport = nil) then begin
      //
      result := WSAGetLastError();
      if (result = WSANO_DATA) and (iport >= 0) and (iport <= $ffff) then begin
        //
	port_info.p_name  := nil;
	port_info.p_aliases := nil;
	port_info.p_proto := smallint(iport);
	result := 0;
      end;
    end
    else
      port_info := pport^;
    //
  end
  else
    result := -1;
end;

// --  --
function ipH2str(ip: unsigned): string;
var
  inAddr: WinSock.in_addr;
begin
  inAddr.s_addr := htonl(int(ip));
  result := inet_ntoa(inAddr);
end;

// --  --
function ipN2str(ip: unsigned): string;
var
  inAddr: WinSock.in_addr;
begin
  inAddr.s_addr := int(ip);
  result := inet_ntoa(inAddr);
end;

// --  --
function str2ipH(const ip: string): unsigned;
begin
  result := unsigned(ntohl(inet_addr(pChar(ip))));
end;

// --  --
function str2ipN(const ip: string): unsigned;
begin
  result := unsigned(inet_addr(pChar(ip)));
end;


{ unaWSA }

// --  --
constructor unaWSA.create(active: bool; version: unsigned);
begin
  inherited create();
  //
  f_status := WSASYSNOTREADY;
  //
  f_gate := unaInProcessGate.create({$IFDEF DEBUG}_classID + '(f_gate)'{$ENDIF});
  //
  if (active) then
    startup(version);
end;

// --  --
destructor unaWSA.destroy();
begin
  if (isActive()) then
    shutdown();
  //
  freeAndNil(f_gate);
  //
  inherited;
end;

// --  --
function unaWSA.getStatus(): int;
begin
  result := f_status;
end;

// --  --
function unaWSA.isActive(): bool;
begin
  result := (f_status = 0);
end;

// --  --
function unaWSA.shutdown(): int;
begin
  result := WSACleanup();
end;

// --  --
function unaWSA.startup(version: unsigned): int;
begin
  f_status := WSAStartup(version, f_data);
  //
  result := f_status;
end;



{ unaSocket }

// --  --
function checkError(value: int; fatal: bool = true {$IFDEF DEBUG}; const caller: string = ''{$ENDIF}): int;
begin
  if (SOCKET_ERROR = value) then begin
    //
    result := WSAGetLastError();
    //
    if (fatal) then
      assert(assertLog('* socket error in ' + {$IFDEF DEBUG}caller{$ELSE}'()'{$ENDIF} + ': ' + int2Str(result)));
  end
  else
    result := value;
end;

// --  --
function unaSocket.accept(out socket: tSocket; timeout: unsigned): unaSocket;
var
  addr: sockaddr_in;
  len : unsigned;
begin
  result := nil;
  len := sizeof(addr);
  //
  if (check_read(timeout)) then begin
    //
    socket := winSock.accept(f_socket, @addr, @len);
    //
    if (socket <> INVALID_SOCKET) then begin
      //
      result := unaSocket.create();
      result.f_socket := socket;
      result.f_socketAddressFamily := addr.sin_family;
      result.f_socketProtocol := socketProtocol;
      result.f_socketType := socketType;
      //
      lookupHost(inet_ntoa(addr.sin_addr), result.f_host);
      lookupPort(int2str(ntohs(addr.sin_port)), result.f_port);
    end
    else
      socket := checkError(SOCKET_ERROR, true {$IFDEF DEBUG}, self._classID + '.accept()'{$ENDIF});
    //  
  end
  else
    socket := WSAETIMEDOUT;
end;

// --  --
function unaSocket.bind(addr: pSockAddrIn): int;
var
  laddr: sockaddr_in;
begin
  result := socket();
  //
  if (0 = result) then begin
    //
    if (addr <> nil) then
      laddr := addr^
    else begin
      //
      laddr.sin_family := AF_INET;
      if (0 = word(f_bindToPort.p_proto)) then
	laddr.sin_port := htons(getPortInt())
      else
	laddr.sin_port := htons(word(f_bindToPort.p_proto));
      //
      laddr.sin_addr.s_addr := inet_addr(pChar(f_bindToIp));
      if (int(INADDR_NONE) = int(laddr.sin_addr.s_addr)) then
	laddr.sin_addr.s_addr := INADDR_ANY;
      //
    end;
    //
    result := checkError(WinSock.bind(f_socket, laddr, sizeof(laddr)), true {$IFDEF DEBUG}, self._classID + '.bind()'{$ENDIF});
  end;
end;

// --  --
function unaSocket.bindSocketToPort(port: int): int;
var
  laddr: sockaddr_in;
begin
  laddr.sin_family := AF_INET;
  if (0 > port) then begin
    //
    if (0 = word(f_bindToPort.p_proto)) then
      laddr.sin_port := 0	// use first availabe port
    else
      laddr.sin_port := htons(word(f_bindToPort.p_proto));
  end
  else
    laddr.sin_port := htons(word(port));
  //
  laddr.sin_addr.s_addr := inet_addr(pChar(f_bindToIp));
  if (int(INADDR_NONE) = int(laddr.sin_addr.s_addr)) then
    laddr.sin_addr.s_addr := INADDR_ANY;
  //
  result := bind(@laddr);
end;

// --  --
function unaSocket.check_error(timeout: unsigned): bool;
var
  e: bool;
  r: int;
begin
  if (INVALID_SOCKET = f_socket) then begin
    //
    result := true
  end
  else begin
    //
    r := select(nil, nil, @e, timeout);
    //
    if (r = 1) then
      result := e
    else
      result := (r <> 0);
  end;
end;

// --  --
function unaSocket.check_read(timeout: unsigned): bool;
var
  r: bool;
begin
  if (1 = select(@r, nil, nil, timeout)) then
    result := r
  else
    result := false;
end;

// --  --
function unaSocket.check_write(timeout: unsigned): bool;
var
  w: bool;
begin
  if (1 = select(nil, @w, nil, timeout)) then
    result := w
  else
    result := false;
end;

// --  --
function unaSocket.close(graceful: bool): int;
begin
  if (not isListening() and graceful) then
    result := shutdown(SD_BOTH)
  else
    result := 0;
  //
  if (0 = result) then
    result := closeSocket();
end;

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

// --  --
function unaSocket.connect(addr: pSockAddrIn): int;
var
  laddr: sockaddr_in;
begin
  if (isActive) then begin
    //
    result := 0;
  end
  else begin
    //
    result := socket();
    if (0 = result) then begin
      //
      if (nil = addr) then begin
	//
	result := getSockAddr(laddr)
      end
      else begin
	//
	f_port.p_proto := ntohs(addr.sin_port);
	f_host := inet_ntoa(addr.sin_addr);
	//
	laddr := addr^;
	result := 0;
      end;
      //
      if (0 = result) then begin
	//
	bindSocketToPort();	// bind the socket to first available (or specified with bindToPort) port before connecting
	//
	// even if explicit bind fail, connect will bind the socket to first availbale port number 
	result := checkError(WinSock.connect(f_socket, laddr, sizeof(laddr)), true {$IFDEF DEBUG}, self._classID + '.connect()'{$ENDIF});
      end;	
      //	
    end;
  end;
end;

// --  --
constructor unaSocket.create();
begin
  inherited ;
  //
  f_socket := INVALID_SOCKET;
  //
  f_bindToIP := '0.0.0.0';
end;

// --  --