unasockets.pas

Voice Commnucation Components for Delphi

	  Windows.Sleep(50);
	  dec(delta, 50);
	end
	else
	  break;
      end;
  end;}
end;



{ unaTcpSocket }

// --  --
constructor unaTcpSocket.create();
begin
  inherited;
  //
  f_socketAddressfamily := AF_INET;
  f_socketProtocol := IPPROTO_TCP;
  f_socketType := SOCK_STREAM;
end;



{ unaUdpSocket }

// --  --
constructor unaUdpSocket.create();
begin
  inherited;
  //
  f_socketAddressfamily := AF_INET;
  f_socketProtocol := IPPROTO_UDP;
  f_socketType := SOCK_DGRAM;
end;

// --  --
function unaUdpSocket.recvfrom(out from: sockaddr_in; var data: string; noCheck: bool; flags: unsigned; timeout: unsigned): int;
var
  len: unsigned;
  sizeFrom: int;
begin
  if (noCheck or oktoRead(timeout)) then begin
    //
    data := '';
    len := getMTU();
    if (0 < len) then begin
      //
      setLength(data, len);
      sizeFrom := sizeof(from);
      //
      result := WinSock.recvfrom(f_socket, data[1], len, flags, from, sizeFrom);
      if (SOCKET_ERROR = result) then begin
	//
	result := checkError(result, true {$IFDEF DEBUG}, self._classID + '.recvfrom()'{$ENDIF});
	data := '';
      end
      else
	setLength(data, result);
      //
    end
    else
      result := -1;
  end
  else
    result := -2;
end;

// --  --
function unaUdpSocket.recvfrom(out from: sockaddr_in; data: pointer; noCheck: bool; flags: unsigned; timeout: unsigned): int;
var
  sizeFrom: int;
begin
  if (noCheck or oktoRead(timeout)) then begin
    //
    sizeFrom := sizeof(from);
    result := WinSock.recvfrom(f_socket, data^, getMTU(), flags, from, sizeFrom);
  end
  else
    result := -2;
end;

// --  --
function unaUdpSocket.sendto(var addr: sockaddr_in; const data: string; flags: unsigned; timeout: unsigned): unsigned;
begin
  if (0 < length(data)) then
    result := sendto(addr, @data[1], length(data), flags, timeout)
  else
    result := 0;
end;

// --  --
function unaUdpSocket.sendto(var addr: sockaddr_in; data: pointer; size, flags: unsigned; timeout: unsigned; noCheck: bool): unsigned;
var
  err: int;
  offset: unsigned;
  subsize: unsigned;
begin
  if (noCheck or oktoWrite(timeout)) then begin
    //
    result := 0;
    offset := 0;
    while (offset < size) do begin
      //
      subsize := min(getMTU(), size - offset);
      if (0 < subsize) then begin
	//
	err := WinSock.sendto(f_socket, pArray(data)[offset], subsize, flags, addr, sizeof(addr));
	if (SOCKET_ERROR <> err) then begin
	  //
	  inc(offset, err)
	end
	else begin
	  //
	  result := checkError(err, true {$IFDEF DEBUG}, self._classID + '.sendto()'{$ENDIF});
	  break;
	end;
      end;
    end;
    //
    if ((0 = result) and (offset < size)) then
      result := WSAETIMEDOUT;
  end
  else
    result := WSAEACCES;	// select() fails
  //  
end;

// --  --
function unaUdpSocket.sendto(var addr: sockaddr_in; data: pointer; size: unsigned; noCheck: bool; flags: unsigned): unsigned;
begin
  result := sendto(addr, data, size, flags, 10, noCheck);
end;

// --  --
function unaUdpSocket.sendto(var addr: sockaddr_in; const data: string; noCheck: bool; flags: unsigned): unsigned;
begin
  if (0 < length(data)) then
    result := sendto(addr, @data[1], length(data), flags, 0, noCheck)
  else
    result := 0;
end;



{ unaMulticastSocket }

// --  --
function unaMulticastSocket.closeSocket(): int;
begin
  f_isReadySender := false;
  f_isReadyReceiver := false;
  //
  result := inherited closeSocket();
end;

// --  --
function unaMulticastSocket.isReady(sender: bool): bool;
begin
  result := choice(sender, f_isReadySender, f_isReadyReceiver);
end;

// --  --
function unaMulticastSocket.recGroupDrop(const groupAddr: string): int;
var
  drop: string;
  mr: ip_mreq;
begin
  if (f_isReadyReceiver) then begin
    //
    if ('' = groupAddr) then
      drop := f_recLastGroup
    else
      drop := groupAddr;
    //
    if ('' <> drop) then begin
      //
      mr.imr_multiaddr.s_addr := inet_addr(pChar(drop));
      if ((0 < mr.imr_multiaddr.s_addr) and (int(INADDR_NONE) <> int(mr.imr_multiaddr.s_addr))) then begin
	//
	mr.imr_interface.s_addr := inet_addr(pChar(bindToIP));
	if (int(INADDR_NONE) = int(mr.imr_interface.s_addr)) then
	  mr.imr_interface.s_addr := INADDR_ANY;
	//
	result := checkError(setsockopt(f_socket, IPPROTO_IP, IP_DROP_MEMBERSHIP, @mr, sizeOf(mr)));
	//
	if (0 = result) then begin
	  //
	  f_recLastGroup := '';
	  dec(f_recGroupCount);
	  //
	  f_isReadyReceiver := (0 < f_recGroupCount);
	  //
	  if (not f_isReadyReceiver) then
	    close();
	  //
	end;
      end
      else
	result := WSAEADDRNOTAVAIL;
      //
    end
    else
      result := WSAEADDRNOTAVAIL;
    //
  end
  else
    result := 0;	// no socket, no drop
end;

// --  --
function unaMulticastSocket.recGroupJoin(const groupAddr: string): int;
var
  mr: ip_mreq;
begin
  if (not f_isReadyReceiver) then
    result := checkError(bind())
  else
    result := 0;	// OK since we has already joined some group
  //
  if (0 = result) then begin
    //
    mr.imr_multiaddr.s_addr := inet_addr(pChar(groupAddr));
    if ((0 < mr.imr_multiaddr.s_addr) and (int(INADDR_NONE) <> int(mr.imr_multiaddr.s_addr))) then begin
      //
      mr.imr_interface.s_addr := inet_addr(pChar(bindToIP));
      if (int(INADDR_NONE) = int(mr.imr_interface.s_addr)) then
	mr.imr_interface.s_addr := INADDR_ANY;
      //
      result := checkError(setsockopt(f_socket, IPPROTO_IP, IP_ADD_MEMBERSHIP, @mr, sizeOf(mr)));
      //
      if (0 = result) then begin
	//
	f_recLastGroup := groupAddr;
	inc(f_recGroupCount);
	//
	f_isReadyReceiver := true;
      end;
    end
    else
      result := WSAEADDRNOTAVAIL;
  end;
  //
  if ((0 <> result) and not f_isReadyReceiver) then
    close();	// close the socket we had bound but not used
end;

// --  --
function unaMulticastSocket.senderCreate(ttl, enableLoop: DWORD; noBind: bool): int;
var
  ip: DWORD;
  lp: Windows.BOOL;
begin
  if (f_isReadySender) then
    close();
  //
  ip := DWORD(inet_addr(pChar(host)));
  if ((0 < ip) and (int(INADDR_NONE) <> int(ip))) then begin
    //
    if ((unsigned(str2ipH('224.0.0.0')) < unsigned(ntohl(ip))) and (unsigned(ntohl(ip)) < unsigned(str2ipH('239.255.255.255')))) then begin
      //
      if (noBind) then
	result := socket()
      else
	result := checkError(bind());	// bind a socket to port/interface
      //
      if (0 = result) then begin
	//
	ip := DWORD(inet_addr(pChar(f_bindToIp)));
	if (int(INADDR_NONE) = int(ip)) then
	  ip := INADDR_ANY;
	//
	if (INADDR_ANY <> ip) then begin
	  //
	  // set the multicast interface
	  // even if this call fails, that in not an fatal error
	  checkError(setsockopt(f_socket, IPPROTO_IP, IP_MULTICAST_IF, @ip, sizeOf(ip)), false);
	end;
	//
	// set the multicast TTL
	result := checkError(setsockopt(f_socket, IPPROTO_IP, IP_MULTICAST_TTL, @ttl, sizeOf(dword)));
	//
	if ((0 = result) and (0 = enableLoop)) then begin
	  //
	  // try disbaling a loop (which is ON by default)
	  lp := false;
	  result := checkError(setsockopt(f_socket, IPPROTO_IP, IP_MULTICAST_LOOP, @lp, sizeOf(lp)), false);
	  //
	  f_loopDisableForce := (0 <> result);
	  //
	  result := 0;	// loop option is not a fatal error
	end;
	//
	if (0 = result) then begin
	  //
	  // prepare an address for sending
	  fillChar(f_senderAddr, sizeOf(f_senderAddr), #0);
	  f_senderAddr.sin_family := AF_INET;
	  f_senderAddr.sin_addr.s_addr := inet_addr(pChar(host));
	  f_senderAddr.sin_port := htons(getPortInt());
	  //
	  f_isReadySender := (0 = result);
	end;
      end;
    end
    else
      result := WSAEADDRNOTAVAIL;
    //
  end
  else
    result := WSAEADDRNOTAVAIL;
  //
  if (0 <> result) then
    close();
end;

// --  --
function unaMulticastSocket.senderSend(data: pointer; len: int; noCheck: bool): int;
begin
  if (f_isReadySender) then
    result := sendto(f_senderAddr, data, len, 0, 1, noCheck)
  else
    result := WSAENOTSOCK;
end;

// --  --
function unaMulticastSocket.senderSend(const data: string; noCheck: bool): int;
begin
  if ('' <> data) then
    result := senderSend(@data[1], length(data), noCheck)
  else
    result := 0;
end;



{ unaSocksConnection }

// --  --
function unaSocksConnection.acquire(timeout: unsigned): bool;
begin
  if (f_beforeDestroy) then
    result := false
  else
    result := f_gate.enter(timeout);
end;

// --  --
procedure unaSocksConnection.beforeDestruction();
begin
  if (f_gate.enter(3000)) then begin
    try
      // make sure no one is using us
      f_beforeDestroy := true;
    finally
      f_gate.leave();
    end;
  end;
  //
  //assert(assertLog(self._classID + '.beforeDestruction() - BEFORE: connection, connId=' + int2str(connId) +  ' is about to be destroyed.'));
  //
  f_thread.onConnectionRemove(f_connId);
  //
  if (f_thread.f_unaSocket <> f_threadSocket) then
    freeAndNil(f_threadSocket);
  //
  inherited;
  //
  //assert(assertLog(self._classID + '.beforeDestruction() - connection, connId=' + int2str(connId) +  ' destroyed.'));
  //
  freeAndNil(f_gate);
end;

// --  --
function unaSocksConnection.compareAddr(const addr: sockaddr_in): bool;
begin
  result := ((addr.sin_port = f_addr.sin_port) and (addr.sin_addr.S_addr = f_addr.sin_addr.S_addr));
end;

// --  --
constructor unaSocksConnection.create(thread: unaSocksThread; connId: unsigned; socket: unaSocket; addr: pSockAddrIn);
begin
  inherited create();
  //
  f_thread := thread;
  f_connId := connId;
  f_threadSocket := socket;
  //
  f_gate := unaInProcessGate.create();
  //
  if (nil <> addr) then
    f_addr := addr^
  else
    socket.getSockAddr(f_addr);
  //
  f_beforeDestroy := false;
  //
  resetTimeout();
end;

// --  --
function unaSocksConnection.getAddr(): PSockAddrIn;
begin
  result := @f_addr;
end;

// --  --
function unaSocksConnection.getTimeout(): unsigned;
begin
  result := timeElapsed32(f_lpStamp);
end;

// --  --
function unaSocksConnection.okToWrite(timeout: unsigned; noCheckState: bool): bool;
begin
  result := f_threadSocket.okToWrite(timeout, noCheckState);
end;

// --  --
procedure unaSocksConnection.release();
begin
  f_gate.leave();
end;

// --  --
procedure unaSocksConnection.resetTimeout();
begin
  f_lpStamp := timeMark();
end;

// --  --
function unaSocksConnection.send(data: pointer; size: unsigned; noCheck: bool): unsigned;
begin
  if ((IPPROTO_UDP = f_threadSocket.f_socketProtocol) and f_thread.f_isServer) then begin
    // UDP SERVER
    {
	WSAEISCONN (10056)
	Socket is already connected.
	A connect request was made on an already-connected socket.
	Some implementations also return this error if sendto is called on
	a connected SOCK_DGRAM socket, although other implementations treat
	this as a legal occurrence.
	//
	That is why we should not send data for connected UDP client sockets using sendto
    }
    {$IFDEF LOG_RAW_DATA_PACKETS }
    logMessage('UNA_SOCKETS: UDP SERVER / about to send new data packet, size=' + int2str(size) + '; CRC32=' + int2str(crc32(data, size), 16));
    {$ENDIF }
    //
    result := unaUdpSocket(f_threadSocket).sendto(f_addr, data, size, true);
  end
  else begin
    //
    {$IFDEF LOG_RAW_DATA_PACKETS }
    logMessage('UNA_SOCKETS: ' + choice(IPPROTO_UDP = f_threadSocket.f_socketProtocol, 'UDP', 'TCP') + ' ' + choice(f_thread.f_isServer, 'SERVER', 'CLIENT') + ' / about to send new data packet, size=' + int2str(size) + '; CRC32=' + int2str(crc32(data, size), 16));
    {$ENDIF }
    //
    result := f_threadSocket.send(data, size, noCheck or (SOCK_DGRAM = f_threadSocket.f_socketType));
  end;  
end;


{ unaSocketsConnections }

// --  --
function unaSocketsConnections.get_connection(connId: unsigned; time