unasockets.pas

Voice Commnucation Components for Delphi

{$EXTERNALSYM IP_MULTICAST_LOOP }
{$EXTERNALSYM IP_ADD_MEMBERSHIP }
{$EXTERNALSYM IP_DROP_MEMBERSHIP }
//
{$EXTERNALSYM IP_DEFAULT_MULTICAST_TTL }
{$EXTERNALSYM IP_DEFAULT_MULTICAST_LOOP }
{$EXTERNALSYM IP_MAX_MEMBERSHIPS }

  IP_MULTICAST_IF	= 9;  //* set/get - IP multicast interface */
  IP_MULTICAST_TTL	= 10; //* set/get - IP multicast TTL */
  IP_MULTICAST_LOOP	= 11; //* set/get - IP multicast loopback */
  IP_ADD_MEMBERSHIP	= 12; //* set     - add IP group membership */
  IP_DROP_MEMBERSHIP	= 13; //* set     - drop IP group membership */
  //
  IP_DEFAULT_MULTICAST_TTL	= 1;
  IP_DEFAULT_MULTICAST_LOOP	= 1;
  IP_MAX_MEMBERSHIPS		= 20;

type
  //
  // -- ip_mreq --
  //
  ip_mreq = packed record
    //
    imr_multiaddr: in_addr; //* multicast group to join */
    imr_interface: in_addr; //* interface to join on */
  end;


  //
  // -- unaMulticastSocket --
  //
  unaMulticastSocket = class(unaUdpSocket)
  private
    f_loopDisableForce: bool;
    f_isReadySender: bool;
    f_isReadyReceiver: bool;
    //
    f_senderAddr: sockaddr_in;	// cache for faster sending
    //
    f_recLastGroup: string;
    f_recGroupCount: int;
    //
  protected
    function closeSocket(): int; override;
  public
    {DP:METHOD
      Creates a mulicast sender with specified parameters.
      If noBind is false (default) it also binds a socket to interface specified
      in bindToIP property (or to default interface if bindToIP is '0.0.0.0').
      Returns 0 for success, or socket-specific error code otherwise.
    }
    function senderCreate(ttl: DWORD = IP_DEFAULT_MULTICAST_TTL; enableLoop: DWORD = 0; noBind: bool = true): int;
    {DP:METHOD
      Sends a multicast packet to a grop specified by host and port properties.
      Returns 0 for success, or socket-specific error code otherwise.
    }
    function senderSend(data: pointer; len: int; noCheck: bool = false): int; overload;
    function senderSend(const data: string; noCheck: bool = false): int; overload;
    //
    {DP:METHOD
      Joins the specified group.
      Also binds a socket to port and interface specified by port and bindToIP property
      (or default interface is bindToIp = '0.0.0.0').
      Use recvfrom() to receive multicast packets from a group(s).
      Returns 0 for success, or socket-specific error code otherwise.
    }
    function recGroupJoin(const groupAddr: string): int;
    {DP:METHOD
      Leaves the specified group (or a group it joined in a previous successfull call to recGroupJoin() if groupAddr = '').
      Returns 0 for success, or socket-specific error code otherwise.
    }
    function recGroupDrop(const groupAddr: string = ''): int;
    //
    function isReady(sender: bool = true): bool;
  end;



  //
  // -- unaSocksConnection --
  //
  unaSocksThread = class;

  {DP:CLASS
    This is base class for connection between two sockets.
  }
  unaSocksConnection = class(unaObject)
  private
    f_thread: unaSocksThread;
    f_threadSocket: unaSocket;
    f_addr: sockaddr_in;
    f_connId: unsigned;
    f_beforeDestroy: bool;
    //
    f_gate: unaInProcessGate;
    f_lpStamp: int64;
    //
    function getAddr(): PSockAddrIn;
    procedure resetTimeout();
    function getTimeout(): unsigned;
  protected
    function acquire(timeout: unsigned): bool;
  public
    constructor create(thread: unaSocksThread; connId: unsigned; socket: unaSocket; addr: pSockAddrIn = nil);
    procedure BeforeDestruction(); override;
    //
    {DP:METHOD
      Sends data to remote socket.
      <BR />Returns 0 if data was sent successfully, or specific WSA error otherwise.
    }
    function send(data: pointer; size: unsigned; noCheck: bool = false): unsigned;
    {DP:METHOD
      Returns true if there are some chances data could be sent right now..
    }
    function okToWrite(timeout: unsigned = 100; noCheckState: bool = false): bool;
    {DP:METHOD
      Compares given address with address of local socket.
      <BR />Returns true if given address belongs to local socket.
    }
    function compareAddr(const addr: sockaddr_in): bool;
    //
    procedure release();
    //
    {DP:METHOD
      Returns local socket class instance.
    }
    property socket: unaSocket read f_threadSocket;
    {DP:METHOD
      Returns pointer to sockaddr_in structure filled by local socket.
    }
    property paddr: PSockAddrIn read getAddr;
    {DP:METHOD
      id of this connection.
    }
    property connId: unsigned read f_connId;
  end;


  //
  // -- unaSocketsConnections --
  //

  unaSocketsConnections = class(unaIdList)
  protected
    function getId(item: pointer): int64; override;
  public
    function get_connection(connId: unsigned; timeout: unsigned = 2000): unaSocksConnection;
  end;


  //
  // -- unaSocksThread --
  //

  unaSocks = class;

  {DP:CLASS
    This thread is used to handle server or client connections.
  }
  unaSocksThread = class(unaThread)
  private
    f_socketError: integer;
    f_isServer: bool;
    f_id: unsigned;
    f_lastConnectionId: unsigned;
    f_initDone: unaEvent;
    f_udpConnectionTimeout: unsigned;
    f_backlog: int;
    //
    f_socks: unaSocks;
    f_unaSocket: unaSocket;
    f_connections: unaSocketsConnections;
    //
    f_psThread: unaThread;
    //
    function getConnectionByAddr(const addr: sockaddr_in; needAcquire: bool): unaSocksConnection;
    procedure onConnectionRemove(connId: unsigned);
    function checkSocketError(isMainSocket: bool; errorCode: integer; addr: PSockAddrIn = nil): bool;
  protected
    function execute(globalIndex: unsigned): int; override;
  public
    constructor create(socks: unaSocks; socket: unaSocket; isServer: bool; id: unsigned);
    procedure BeforeDestruction(); override;
    destructor Destroy(); override;
    {DP:METHOD
      Returns sockets connection for specified connection id.
    }
    function getConnection(connId: unsigned; timeout: unsigned = 2000): unaSocksConnection;
    //
    //property connections: unaSocketsConnections read f_connections;
    property socket: unaSocket read f_unaSocket;
    property socketError: integer read f_socketError;
    property isServer: bool read f_isServer;
  end;


  //
  // -- unaSocketsThreads --
  //

  unaSocksThreads = class(unaIdList)
  protected
    function getId(item: pointer): int64; override;
  public
  end;


  //
  // -- unaSocks --
  //

  unaSocksOnEventEvent = procedure(sender: tObject; event: unaSocketEvent; id, connId: unsigned; data: pointer; size: unsigned) of object;

  {DP:CLASS
    This class is used to create server and client sockets and manage the connections.
  }
  unaSocks = class(unaObject)
  private
    f_master: bool;
    f_threadPoolSize: unsigned;
    f_timeout: unsigned;
    f_lastID: unsigned;
    //
    f_gate: unaInProcessGate;
    f_threads: unaSocksThreads;
    f_onEvent: unaSocksOnEventEvent;
    //
    function createSocket(protocol: int): unaSocket;
    function getThread(index: unsigned): unaSocksThread;
    function getThreadFromPool(allowGrowUp: bool = true): unaSocksThread;
  protected
    {DP:METHOD
      This method is called every time new event occur. even parameter specifies the type of event:
      <UL>
	<LI>unaseServerListen - [server] server starts listening</LI>
	<LI>unaseServerConnect - [server] new client has been connected to server</LI>
	<LI>unaseServerData - [server] data is available from one of the clients</LI>
	<LI>unaseServerDisconnect - [server] client has been disconnected from server</LI>
	<LI>unaseServerStop - [server] server stops listening</LI>
	//
	<LI>unaseClientConnect - [client] connection to server has been established</LI>
	<LI>unaseClientData - [client] new data is available from server</LI>
	<LI>unaseClientDisconnect - [client] client has been disconnected from server</LI>
	//
	<LI>unaseThreadStartupError - [thread] some error occurred when starting the server or client connection</LI>
      </UL>
      <BR />id specified the thread id for which the even occur.
      <BR />connId specifies the connection id for this thread for which the even occur.
      <BR />data and size specifies data block available from client or server.
    }
    procedure event(event: unaSocketEvent; id, connId: unsigned; data: pointer = nil; size: unsigned = 0); virtual;
  public
    constructor create();
    destructor Destroy(); override;
    //
    function enter(timeout: unsigned = Windows.INFINITE): bool;
    procedure leave();
    {DP:METHOD
      Sets new parameters for this class.
      <BR />threadPoolSize specifies the number of threads in the pool to be created.
    }
    procedure setParams(timeout: unsigned; threadPoolSize: unsigned);
    {DP:METHOD
      Creates new client socket. Returns thread id which will handle connections for this socket or 0 if some error occur.
    }
    function createConnection(const host, port: string; out connId: unsigned; protocol: int = IPPROTO_TCP; activate: bool = true; const bindToIP: string = '0.0.0.0'; const bindToPort: string = '0'): unsigned;
    {DP:METHOD
      Creates new server socket. Returns thread id which will handle connections for this socket or 0 if some error occur.
    }
    function createServer(const port: string; protocol: int = IPPROTO_TCP; activate: bool = true; backlog: int = SOMAXCONN; udpConnectionTimeout: unsigned = c_defUdpConnTimeout; const bindToIP: string = '0.0.0.0'): unsigned; overload;
    {DP:METHOD
      Creates new server socket. Returns thread id which will handle connections for this socket or 0 if some error occur.
    }
    function createServer(port: word; protocol: int = IPPROTO_TCP; activate: bool = true; backlog: int = SOMAXCONN; udpConnectionTimeout: unsigned = c_defUdpConnTimeout; const bindToIP: string = '0.0.0.0'): unsigned; overload;
    {DP:METHOD
    }
    function activate(id: unsigned): bool;
    {DP:METHOD
    }
    function isActive(id: unsigned): bool;
    {DP:METHOD
      Sends data to specified connection. Specify the connection id, starting from 1.
      <BR />Returns 0 if data was sent successfully, or specific WSA error otherwise.
    }
    function sendData(id: unsigned; data: pointer; size: unsigned; connId: unsigned; noCheck: bool = false; timeout: unsigned = 1000): unsigned;
    {DP:METHOD
      Returns true if TCP/IP is more or less sure data can be sent now
    }
    function okToWrite(id, connId: unsigned; timeout: unsigned = 100; noCheckState: bool = false): bool;
    {DP:METHOD
      Returns specified connection. Specify the connection id, starting from 1.
      <BR>WARNING! After returned connection is no longer needed - call its release() method.
    }
    function getConnection(id: unsigned; connId: unsigned; timeout: unsigned = 2000; needAcquire: bool = true): unaSocksConnection;
    {DP:METHOD
      Closes and removes specified connection. Specify the connection id, starting from 1.
      If thread has no more connections, closes it as well.
    }
    function removeConnection(id: unsigned; connId: unsigned): bool;
    {DP:METHOD
      Returns IP:Port of remote connection.
    }
    function getRemoteHostInfo(socksId, connId: unsigned; out ip, port: string): bool;
    function getRemoteHostInfoEx(socksId, connId: unsigned; out ip, port: string; out proto: int): bool;
    {DP:METHOD
      Closes and removes all connection for specified thread. Also stops the thread and makes it available for new connections.
    }
    function closeThread(id: unsigned): bool;
    {DP:METHOD
    }
    function getThreadByID(id: unsigned; timeout: unsigned = 2000): unaSocksThread;
    {DP:METHOD
    }
    function getSocketError(id: unsigned; needLock: bool = true): int;
    {DP:METHOD
      Closes and removes all client or server (or both) connections.
    }
    procedure clear(clearServers: bool = false; clearClients: bool = false);
    {DP:METHOD
      This event is fired every time new event occur. Refer to event() method for more information.
    }
    property onEvent: unaSocksOnEventEvent read f_onEvent write f_onEvent;
  end;


{DP:METHOD
  Lookups host name.
  <BR />Host name could be in integer ("194.44.186.254") or alpha ("www.microsoft.com") format or "" for local machine.
  <BR />Returns 0 if successful or specific WSA error otherwise.
}
function lookupHost(const host: string): int; overload;

{DP:METHOD
  Lookups host name. If the "list" parameter is not nil, it also lists all addresses assigned to a host.
  <BR />Host name could be in integer ("194.44.186.254") or alpha ("www.microsoft.com") format or "" for local machine..
  <BR />Returns 0 if successful or specific WSA error otherwise.
  <BR />Also fills the given ip string with string representation of IP address of the host (if resolved).
}
function lookupHost(const host: string; out ip: string; list: unaStringList = nil): int; overload;

{DP:METHOD
  Lookups host name.
  <BR />Host name could be in integer ("194.44.186.254") or alpha ("www.microsoft.com") format or "" for local machine..
  <BR />If lookup fails, it uses the default parameter value as the IP address of the host.
  <BR />Returns IP address of the host or default parameter value if lookup fails.
}
function lookupHost(const host: string; defValue: unsigned): unsigned; overload;

{DP:METHOD
  Lookups host info.
  <BR />Returns the FQDN of the host (if any).
}
function getHostInfo(ip: uint): string;

{DP:METHOD
  List all addresses assigned to a host.
  <BR />Host name could be in integer ("194.44.186.254") or alpha ("www.microsoft.com") format or "" for local machine.
  <BR />Returns 0 if successful or specific WSA error otherwise.
}
function listAddresses(const host: string; list: unaStringList): int;

{DP:METHOD
  Lookups port number.
  <BR />Port name could be in integer ("110") or string ("POP3") format.
  <BR />Returns 0 if successful, -1 if port is "" or specific WSA error otherwise.
}
function lookupPort(const port: string): int; overload;

{DP:METHOD
  Lookups port number.
  <BR />Port name could be in integer ("110") or string ("POP3") format.
  <BR />Returns 0 if successful, -1 if port is "" or specific WSA error otherwise.
  <BR />Also fills given port_info parameter.
}
function lookupPort(const port: string; out port_info: protoent): int; overload;

{DP:METHOD
  Startups the Windows sockets by creating unaWsa class instance.
}
function startup(version: unsigned = $0101): int;

{DP:METHOD
  Shutdowns the Windows sockets by deleting the unaWsa class instance created in startup() routine.
}
function shutdown(): int;

{DP:METHOD
  Returns unaWSA class instance created by a call to startup(), or by unaSocks class.
}
function getWSAObject(): unaWSA;

// --  --
function ipH2str(ip: unsigned): string;
function ipN2str(ip: unsigned): string;
function str2ipH(const ip: string): unsigned;
function str2ipN(const ip: string): unsigned;


// -- IP/HTTP --

type
  tIpQueryCallback = procedure(queryId: unsigned; const query, response, responseData: string) of object;

//
// returns -1 in case of some problem or
// valid queryId (which is an integer greater than 0) if all seems to be OK
function httpQuery(const ip, port, query: string; callback: tIpQueryCallback = nil; timeout: unsigned = 5000): int;
function ipQuery(const ip, port, query: string; proto: int = IPPROTO_TCP; callback: tIpQueryCallback = nil; timeout: unsigned = 5000): int;


implementation


uses
  unaUtils;

var
  g_unaWSA: unaWSA = nil;
  g_unaWSACount: unsigned = 0;
  g_unaWSAGate: unaInProcessGate = nil;
  g_unaWSAGateReady: bool = false;

// --  --
function startup(version: unsigned): int;
begin
  result := -1;
  //
  if (g_unaWSAGateReady) then begin
    //
    if (g_unaWSAGate.enter(1000)) then begin
      //
      try
	if (nil = g_unaWSA) then
	  g_unaWSA := unaWsa.create(true, version);
	//
	inc(g_unaWSACount);
	result := 0;
	//
      finally
	g_unaWSAGate.leave();
      end;
    end;
    //
  end;
end;

// --  --
function shutdown(): int;
begin
  result := -1;
  //
  if (g_unaWSAGateReady) then begin
    //
    if (g_unaWSAGate.enter(1000)) then begin
      //
      try
	if (0 < g_unaWSACount) then
	  dec(g_unaWSACount)
	else
	  assert(false, 'unaSockets.shutdown() - startup/shutdown calls do not match.');
	//
	if (1 > g_unaWSACount) then
	  freeAndNil(g_unaWSA);
	//
	result := 0;
	//
      finally
	g_unaWSAGate.leave();
      end;