Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
TSNE_V3_IPV6.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 27.02.2011 12:16:17 |
'##############################################################################################################
'##############################################################################################################
' TSNE_V3 - TCP Socket Networking [Eventing] Version: 3.5X-2011.02.27 (0.18.5 -> SVN:0.21.0 [11-07-2008])
' == E X P E R I M E N T A L - IP_V6 Version ==
'##############################################################################################################
'##############################################################################################################
' 2009 By.: /_\ DeltaLab's Germany - Experimental Computing
' Autor: Martin Wiemann
'##############################################################################################################
#IFNDEF _TSNE_
#DEFINE _TSNE_
'>...
'##############################################################################################################
#define EMFILE 24
#define ENFILE 23
#define ENOMEM 12
declare function errno cdecl alias "__errno_location" () as integer ptr ptr
Enum rt_scope_t
RT_SCOPE_UNIVERSE = 0
RT_SCOPE_SITE = 200
RT_SCOPE_LINK = 253
RT_SCOPE_HOST = 254
RT_SCOPE_NOWHERE = 255
End Enum
#IF DEFINED(__FB_LINUX__)
#INCLUDE once "crt/stdlib.bi"
#INCLUDE once "crt/unistd.bi"
#INCLUDE once "crt/netdb.bi"
#INCLUDE once "crt/sys/types.bi"
#INCLUDE once "crt/sys/socket.bi"
#INCLUDE once "crt/sys/select.bi"
#INCLUDE once "crt/netinet/in.bi"
#INCLUDE once "crt/arpa/inet.bi"
#DEFINE IOCPARM_MASK &h7f
#DEFINE IOC_IN &h80000000
#DEFINE _IOW(x,y,t) (IOC_IN or ((t and IOCPARM_MASK) shl 16) or ((x) shl 8) or (y))
#DEFINE FIONBIO _IOW(asc("f"), 126, sizeof(UInteger))
#DEFINE h_addr h_addr_list[0]
#DEFINE CloseSocket_(_a_) close_(_a_)
#DEFINE INVALID_SOCKET (Cast(Socket, -1))
#DEFINE TSNE_MSG_NOSIGNAL &h4000
#DEFINE EINPROGRESS 36
#ELSEIF DEFINED(__FB_WIN32__)
#error "Temporaly Unsupported platform! This version of TSNE is LINUX ONLY!!!"
#DEFINE WIN_INCLUDEALL
#INCLUDE once "windows.bi"
#INCLUDE once "win\winsock.bi"
#DEFINE close_(_a_) closesocket(_a_)
#DEFINE memcpy(x__, y__, z__) movememory(x__, y__, z__)
#DEFINE TSNE_MSG_NOSIGNAL &h0
#DEFINE EINPROGRESS WSAEINPROGRESS
Private Sub TSNE_INT_StartWinsock() CONSTRUCTOR
Dim xwsa as WSADATA
WSAStartup(MAKEWORD(2, 0), @xwsa)
End Sub
Private Sub TSNE_INT_EndWinsock() DESTRUCTOR
WSAcleanup()
End Sub
#ELSE
#error "Unsupported platform"
#ENDIF
#INCLUDE once "crt/sys/time.bi"
#INCLUDE once "crt/fcntl.bi"
#Include once "vbcompat.bi"
#DEFINE IPV6_ADDR_MC_SCOPE(a) ((a).in6_u.u6_addr32(1) and &H0F)
#DEFINE __IPV6_ADDR_SCOPE_INVALID -1
#DEFINE IPV6_ADDR_SCOPE_NODELOCAL &H01
#DEFINE IPV6_ADDR_SCOPE_LINKLOCAL &H02
#DEFINE IPV6_ADDR_SCOPE_SITELOCAL &H05
#DEFINE IPV6_ADDR_SCOPE_ORGLOCAL &H08
#DEFINE IPV6_ADDR_SCOPE_GLOBAL &H0E
#DEFINE IPV6_ADDR_SCOPE_TYPE(scope) ((scope) shl 16)
Enum addr_scope_Enum
IPV6_ADDR_ANY = &H0000
IPV6_ADDR_UNICAST = &H0001
IPV6_ADDR_MULTICAST = &H0002
IPV6_ADDR_LOOPBACK = &H0010
IPV6_ADDR_LINKLOCAL = &H0020
IPV6_ADDR_SITELOCAL = &H0040
IPV6_ADDR_COMPATv4 = &H0080
IPV6_ADDR_MAPPED = &H1000
IPV6_ADDR_RESERVED = &H2000
End Enum
Type if_inet6_Type
V_Addr as in6_addr
V_InterfaceIndex as UInteger
V_PrefixLen as UInteger
V_Scope as addr_scope_Enum
V_InterfaceFlags as UInteger
V_DeviceName as String
End Type
#define icmp
#IFNDEF icmp
Type icmphdr
type as UByte
code as UByte
cksum as UShort
icd_id as UShort
icd_seq as UShort
ih_gateway as UInteger
unused as UInteger
mtu as UInteger
End Type
#define ICMP_ECHOREPLY 0
#define ICMP_DEST_UNREACH 3
#define ICMP_SOURCE_QUENCH 4
#define ICMP_REDIRECT 5
#define ICMP_ECHO 8
#define ICMP_TIME_EXCEEDED 11
#define ICMP_PARAMETERPROB 12
#define ICMP_TIMESTAMP 13
#define ICMP_TIMESTAMPREPLY 14
#define ICMP_INFO_REQUEST 15
#define ICMP_INFO_REPLY 16
#define ICMP_ADDRESS 17
#define ICMP_ADDRESSREPLY 18
#define NR_ICMP_TYPES 18
#define ICMP_NET_UNREACH 0
#define ICMP_HOST_UNREACH 1
#define ICMP_PROT_UNREACH 2
#define ICMP_PORT_UNREACH 3
#define ICMP_FRAG_NEEDED 4
#define ICMP_SR_FAILED 5
#define ICMP_NET_UNKNOWN 6
#define ICMP_HOST_UNKNOWN 7
#define ICMP_HOST_ISOLATED 8
#define ICMP_NET_ANO 9
#define ICMP_HOST_ANO 10
#define ICMP_NET_UNR_TOS 11
#define ICMP_HOST_UNR_TOS 12
#define ICMP_PKT_FILTERED 13
#define ICMP_PREC_VIOLATION 14
#define ICMP_PREC_CUTOFF 15
#define NR_ICMP_UNREACH 15
#define ICMP_REDIR_NET 0
#define ICMP_REDIR_HOST 1
#define ICMP_REDIR_NETTOS 2
#define ICMP_REDIR_HOSTTOS 3
#define ICMP_EXC_TTL 0
#define ICMP_EXC_FRAGTIME 1
Type icmp
icmp_type as UByte
icmp_code as UByte
icmp_cksum as UShort
ih_pptr as UByte
ih_gwaddr as in_addr
Type ih_idseq
icd_id as UShort
icd_seq as UShort
End Type
ih_void as UInteger
Type ih_pmtu
ipm_void as UShort
ipm_nextmtu as UShort
End Type
Type ih_rtradv
irt_num_addrs as UByte
irt_wpa as UByte
irt_lifetime as UShort
End Type
End Type
#ENDIF
'##############################################################################################################
Dim Shared TSNE_INT_Debug as UByte = 0
'##############################################################################################################
Dim Shared TSNE_INT_Thread_Master_Ptr as Any PTR
Dim Shared TSNE_INT_Thread_Master_Close as UByte
Dim Shared TSNE_INT_Mutex_Master as Any PTR
'##############################################################################################################
Private Const TSNE_INT_BufferSize as UInteger = 7936
Private Const TSNE_INT_StackSize as UInteger = 512000
'--------------------------------------------------------------------------------------------------------------
Private Const TSNE_Const_UnknowError as Integer = 0
Private Const TSNE_Const_NoError as Integer = -1
Private Const TSNE_Const_UnknowEventID as Integer = -2
Private Const TSNE_Const_NoSocketFound as Integer = -3
Private Const TSNE_Const_CantCreateSocket as Integer = -4
Private Const TSNE_Const_CantBindSocket as Integer = -5
Private Const TSNE_Const_CantSetListening as Integer = -6
Private Const TSNE_Const_SocketAlreadyInit as Integer = -7
Private Const TSNE_Const_MaxSimConReqOutOfRange as Integer = -8
Private Const TSNE_Const_PortOutOfRange as Integer = -9
Private Const TSNE_Const_CantResolveIPfromHost as Integer = -10
Private Const TSNE_Const_CantConnectToRemote as Integer = -11
Private Const TSNE_Const_TSNEIDnotFound as Integer = -12
Private Const TSNE_Const_MissingEventPTR as Integer = -13
Private Const TSNE_Const_IPAalreadyInList as Integer = -14
Private Const TSNE_Const_IPAnotInList as Integer = -15
Private Const TSNE_Const_ReturnErrorInCallback as Integer = -16
Private Const TSNE_Const_IPAnotFound as Integer = -17
Private Const TSNE_Const_ErrorSendingData as Integer = -18
Private Const TSNE_Const_UnknowGURUcode as Integer = -19
Private Const TSNE_Const_TSNENoServer as Integer = -20
Private Const TSNE_Const_NoIPV6 as Integer = -21
Private Const TSNE_Const_CantCreateSocketLimit as Integer = -22
'--------------------------------------------------------------------------------------------------------------
Private Enum TSNE_BW_Mode_Enum
TSNE_BW_Mode_None = 0
TSNE_BW_Mode_Black = 1
TSNE_BW_Mode_White = 2
End Enum
'##############################################################################################################
Private Enum TSNE_Event
TSNE_E_Disconnect = 0
TSNE_E_Connect = 1
TSNE_E_NewConnection = 2
TSNE_E_NewData = 3
End Enum
'--------------------------------------------------------------------------------------------------------------
Private Type TSNE_Event_Type
TSNE_Disconnected as Sub (ByVal V_TSNEID as UInteger)
TSNE_Connected as Sub (ByVal V_TSNEID as UInteger)
TSNE_NewConnection as Sub (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
TSNE_NewConnectionCanceled as Sub (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
TSNE_NewData as Sub (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
TSNE_NewDataUDP as Sub (ByVal V_TSNEID as UInteger, ByVal V_IPA as String, ByRef V_Data as String)
End Type
'##############################################################################################################
Private Type TSNE_INT_DNSIPA_Type
V_Next as TSNE_INT_DNSIPA_Type Ptr
V_Prev as TSNE_INT_DNSIPA_Type Ptr
V_HostIPA as String
V_InAddr as in_addr
V_InAddr6 as in6_addr
V_TimeOut as Double
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared TSNE_INT_DNSIPAD as TSNE_INT_DNSIPA_Type Ptr
Dim Shared TSNE_INT_DNSIPAL as TSNE_INT_DNSIPA_Type Ptr
Dim Shared TSNE_INT_DNSIPA_Mutex as Any Ptr
'##############################################################################################################
Private Type TSNE_BWL_Type
V_Next as TSNE_BWL_Type Ptr
V_Prev as TSNE_BWL_Type Ptr
V_IPA as String
V_LockTill as Double
End Type
'--------------------------------------------------------------------------------------------------------------
Private Enum TSNE_Protocol
TSNE_P_TCP = 0
TSNE_P_UDP = 1
End Enum
'##############################################################################################################
Private Type TSNE_Socket
V_Next as TSNE_Socket Ptr
V_Prev as TSNE_Socket Ptr
V_TSNEID as UInteger
V_Event as TSNE_Event_Type
V_Socket as Socket
V_Prot as TSNE_Protocol
V_IsServer as UByte
V_IPA as String
V_Port as UShort
V_USP as SOCKADDR_IN
T_DataIn as ULongInt
T_DataOut as ULongInt
T_ThreadOn as Integer
T_Thread as Any Ptr
V_BWL_UseType as UByte
V_BWL_IPAD as TSNE_BWL_Type Ptr
V_BWL_IPAL as TSNE_BWL_Type Ptr
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared TSNE_INT_D as TSNE_Socket Ptr
Dim Shared TSNE_INT_L as TSNE_Socket Ptr
Dim Shared TSNE_INT_C as UInteger
Dim Shared TSNE_INT_CC as UInteger
Dim Shared TSNE_INT_Mutex as Any Ptr
'##############################################################################################################
Declare Sub TSNE_INT_Thread_Master ()
Declare Sub TSNE_INT_Thread_Event (V_TSNEID as Any Ptr)
'##############################################################################################################
Declare Function TSNE_GetGURUCode (ByRef V_GURUID as Integer) as String
Declare Function TSNE_Stats (ByRef V_TSNEID as UInteger, ByRef R_RX as ULongInt, ByRef R_TX as ULongInt) as Integer
Declare Function TSNE_Disconnect (ByRef V_TSNEID as UInteger) as Integer
Declare Function TSNE_Create_Server (ByRef R_TSNEID as UInteger, ByRef V_Port as UShort, ByRef V_MaxSimConReq as UShort = 10, ByVal V_Event_NewConPTR as Any Ptr, ByVal V_Event_NewConCancelPTR as Any Ptr = 0, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
Declare Function TSNE_Create_Client (ByRef R_TSNEID as UInteger, ByVal V_IPA as String, ByVal V_Port as UShort, ByVal V_Event_DisconPTR as Any Ptr = 0, ByVal V_Event_ConPTR as Any Ptr = 0, ByVal V_Event_NewDataPTR as Any Ptr, ByVal V_TimeoutSecs as UInteger = 60, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
Declare Function TSNE_Create_Accept (ByVal V_RequestID as Socket, ByRef R_TSNEID as UInteger, ByRef R_IPA as String = "", ByVal V_Event_DisconPTR as Any Ptr = 0, ByVal V_Event_ConPTR as Any Ptr = 0, ByVal V_Event_NewDataPTR as Any Ptr, ByRef R_RemoteShownServerIPA as String = "", ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
Declare Function TSNE_Create_UDP_RX (ByRef R_TSNEID as UInteger, ByVal V_Port as UShort, ByVal V_Event_NewDataUDPPTR as Any Ptr, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
Declare Function TSNE_Create_UDP_TX (ByRef R_TSNEID as UInteger, ByVal V_DoBroadcast as UByte = 0) as Integer
Declare Function TSNE_Data_Send (ByRef V_TSNEID as UInteger, ByRef V_Data as String, ByRef R_BytesSend as UInteger = 0, ByVal V_IPA as String = "", ByVal V_Port as UShort = 0) as Integer
Declare Sub TSNE_WaitClose (ByRef V_TSNEID as UInteger)
Declare Function TSNE_IsClosed (ByRef V_TSNEID as UInteger) as UByte
Declare Function TSNE_BW_SetEnable (ByVal V_Server_TSNEID as UInteger, V_Type as TSNE_BW_Mode_Enum) as Integer
Declare Function TSNE_BW_GetEnable (ByVal V_Server_TSNEID as UInteger, R_Type as TSNE_BW_Mode_Enum) as Integer
Declare Function TSNE_BW_Clear (ByVal V_Server_TSNEID as UInteger) as Integer
Declare Function TSNE_BW_Add (ByVal V_Server_TSNEID as UInteger, V_IPA as String, V_BlockTimeSeconds as UInteger = 3600) as Integer
Declare Function TSNE_BW_Del (ByVal V_Server_TSNEID as UInteger, V_IPA as String) as Integer
Declare Function TSNE_BW_List (ByVal V_Server_TSNEID as UInteger, ByRef R_IPA_List as TSNE_BWL_Type Ptr) as Integer
'##############################################################################################################
'##############################################################################################################
'### EXPERIMENTAL IP_V6 Implementation
'##############################################################################################################
'##############################################################################################################
' begin of experimental
'##############################################################################################################
'##############################################################################################################
Function ipv6_addr_scope2type(V_Scope as UInteger) as UInteger
Select Case V_Scope
Case IPV6_ADDR_SCOPE_NODELOCAL: Return (IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_NODELOCAL) or IPV6_ADDR_LOOPBACK)
Case IPV6_ADDR_SCOPE_LINKLOCAL: Return (IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_LINKLOCAL) or IPV6_ADDR_LINKLOCAL)
Case IPV6_ADDR_SCOPE_SITELOCAL: Return (IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_SITELOCAL) or IPV6_ADDR_SITELOCAL)
End Select
Return IPV6_ADDR_SCOPE_TYPE(V_Scope)
End Function
'##############################################################################################################
Function ipv6_addr_type(addr as in6_addr) as Integer
Dim st as UInteger = addr.in6_u.u6_addr32(0)
if ((st and htonl(&HE0000000)) <> htonl(&H00000000)) and ((st and htonl(&HE0000000)) <> htonl(&HE0000000)) Then Return (IPV6_ADDR_UNICAST or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_GLOBAL))
if ((st and htonl(&HFF000000)) = htonl(&HFF000000)) Then Return (IPV6_ADDR_MULTICAST or ipv6_addr_scope2type(IPV6_ADDR_MC_SCOPE(addr)))
if ((st and htonl(&HFFC00000)) = htonl(&HFE800000)) Then Return (IPV6_ADDR_LINKLOCAL or IPV6_ADDR_UNICAST or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_LINKLOCAL))
if ((st and htonl(&HFFC00000)) = htonl(&HFEC00000)) Then Return (IPV6_ADDR_SITELOCAL or IPV6_ADDR_UNICAST or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_SITELOCAL))
if ((st and htonl(&HFE000000)) = htonl(&HFC000000)) Then Return (IPV6_ADDR_UNICAST or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_GLOBAL))
if ((addr.in6_u.u6_addr32(0) or addr.in6_u.u6_addr32(1)) = 0) Then
if (addr.in6_u.u6_addr32(2) = 0) Then
if (addr.in6_u.u6_addr32(3) = 0) Then return IPV6_ADDR_ANY
if (addr.in6_u.u6_addr32(3) = htonl(&H00000001)) Then Return (IPV6_ADDR_LOOPBACK or IPV6_ADDR_UNICAST or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_LINKLOCAL))
return (IPV6_ADDR_COMPATv4 or IPV6_ADDR_UNICAST or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_GLOBAL))
End If
if (addr.in6_u.u6_addr32(2) = htonl(&H0000ffff)) Then Return (IPV6_ADDR_MAPPED or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_GLOBAL))
End If
Return (IPV6_ADDR_RESERVED or IPV6_ADDR_SCOPE_TYPE(IPV6_ADDR_SCOPE_GLOBAL))
End Function
'##############################################################################################################
Function ipv6_getscope(V_Addr as in6_addr, V_DeviceName as String = "") as Integer
#IF DEFINED(__FB_LINUX__)
MutexLock(TSNE_INT_Mutex)
Dim XFN as Integer = FreeFile
If Open pipe("cat /proc/net/if_inet6" for Input as #XFN) <> 0 Then MutexUnLock(TSNE_INT_Mutex): Return 0
MutexUnLock(TSNE_INT_Mutex)
Dim T as String
Dim DD() as String
Dim DC as UInteger
Do Until EOF(XFN)
Line Input #XFN, T
If T <> "" Then
DC += 1
Redim Preserve DD(DC) as String
DD(DC) = T
End If
Loop
Close #XFN
Dim XPos as UInteger
Dim TIFIT as if_inet6_Type
Dim TIFITC as if_inet6_Type
Dim TIFID() as if_inet6_Type
Dim TIFIC as UInteger
Dim T1 as String
For X as UInteger = 1 to DC
T = DD(X)
TIFIT = TIFITC
With TIFIT
XPos = InStr(1, T, " ")
If XPos > 0 Then
T1 = Left(T, XPos - 1)
T = Mid(T, XPos + 1)
For Y as UInteger = 0 To 3
.V_Addr.in6_u.u6_addr32(Y) = htonl(CUInt("&H" & Mid(T1, 1 + Y * 8, 8)))
Next
XPos = InStr(1, T, " ")
If XPos > 0 Then
.V_InterfaceIndex = CUInt("&H" & Left(T, XPos - 1))
T = Mid(T, XPos + 1)
XPos = InStr(1, T, " ")
If XPos > 0 Then
.V_PrefixLen = CUInt("&H" & Left(T, XPos - 1))
T = Mid(T, XPos + 1)
XPos = InStr(1, T, " ")
If XPos > 0 Then
.V_Scope = CUInt(Left(T, XPos - 1))
T = Mid(T, XPos + 1)
XPos = InStr(1, T, " ")
If XPos > 0 Then
.V_InterfaceFlags = CUInt(Left(T, XPos - 1))
.V_DeviceName = Trim(LCase(Mid(T, XPos + 1)))
TIFIC += 1
Redim Preserve TIFID(TIFIC) as if_inet6_Type
TIFID(TIFIC) = TIFIT
End If
End If
End If
End If
End If
End With
Next
If V_DeviceName <> "" Then
For X as UInteger = 1 to TIFIC
If LCase(V_DeviceName) = TIFID(X).V_DeviceName Then Print "[F:DEV]";: Return TIFID(X).V_InterfaceIndex
Next
For X as UInteger = 1 to TIFIC
With TIFID(X)
If V_Addr.in6_u.u6_addr32(0) = .V_Addr.in6_u.u6_addr32(0) Then Print "[F:ADR]";: Return TIFID(X).V_InterfaceIndex
End With
Next
Else
For X as UInteger = 1 to TIFIC
With TIFID(X)
If V_Addr.in6_u.u6_addr32(0) = .V_Addr.in6_u.u6_addr32(0) Then Print "[F:ADR]";: Return TIFID(X).V_InterfaceIndex
End With
Next
End If
Print "[F:NOT]";
#ELSEIF DEFINED(__FB_WIN32__)
#ENDIF
End Function
'##############################################################################################################
' end of experimental
'##############################################################################################################
'### EXPERIMENTAL IP_V6 Implementation
'##############################################################################################################
'##############################################################################################################
'##############################################################################################################
Private Function TSNE_INT_BW_GetPtr(ByRef V_TSNE as TSNE_Socket Ptr, ByRef V_IPA as String) as TSNE_BWL_Type Ptr
If V_TSNE = 0 Then Return 0
Dim TPtr as TSNE_BWL_Type Ptr = V_TSNE->V_BWL_IPAD
Do Until TPtr = 0
If TPtr->V_IPA = V_IPA Then
' If TPtr->V_LockTill
Return TPtr
End If
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'---------------------------------------------------------------------------------------------------------------
Private Sub TSNE_INT_BW_Clear(ByRef V_TSNE as TSNE_Socket Ptr)
If V_TSNE = 0 Then Exit Sub
Dim TPtr as TSNE_BWL_Type Ptr = V_TSNE->V_BWL_IPAD
Dim TNPtr as TSNE_BWL_Type Ptr
Do Until TPtr = 0
TNPtr = TPtr->V_Next
DeAllocate(TPtr)
TPtr = TNPtr
Loop
End Sub
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_BW_Del(ByRef V_TSNE as TSNE_Socket Ptr, ByRef V_IPA as String) as UByte
If V_TSNE = 0 Then Return 0
Dim TPtr as TSNE_BWL_Type Ptr = TSNE_INT_BW_GetPtr(V_TSNE, V_IPA)
If TPtr = 0 Then Return 0
If V_TSNE->V_BWL_IPAD = TPtr Then V_TSNE->V_BWL_IPAD = TPtr->V_Next
If V_TSNE->V_BWL_IPAL = TPtr Then V_TSNE->V_BWL_IPAL = TPtr->V_Prev
If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = TPtr->V_Next
If TPtr->V_Next <> 0 Then TPtr->V_Next->V_Prev = TPtr->V_Prev
DeAllocate(TPtr)
Return 1
End Function
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_BW_Add(ByRef V_TSNE as TSNE_Socket Ptr, ByRef V_IPA as String, ByVal V_BlockTimeSeconds as UInteger = 3600) as UByte
If V_TSNE = 0 Then Return 0
If TSNE_INT_BW_GetPtr(V_TSNE, V_IPA) <> 0 Then Return 0
If V_TSNE->V_BWL_IPAL <> 0 Then
V_TSNE->V_BWL_IPAL->V_Next = CAllocate(SizeOf(TSNE_BWL_Type))
V_TSNE->V_BWL_IPAL->V_Next->V_PreV = V_TSNE->V_BWL_IPAL
V_TSNE->V_BWL_IPAL = V_TSNE->V_BWL_IPAL->V_Next
Else
V_TSNE->V_BWL_IPAL = CAllocate(SizeOf(TSNE_BWL_Type))
V_TSNE->V_BWL_IPAD = V_TSNE->V_BWL_IPAL
End If
V_TSNE->V_BWL_IPAL->V_IPA = V_IPA
V_TSNE->V_BWL_IPAL->V_LockTill = Now() + V_BlockTimeSeconds
Return 1
End Function
'##############################################################################################################
Private Function TSNE_INT_GetPtr(ByRef V_TSNEID as UInteger) as TSNE_Socket Ptr
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_D
Do Until TPtr = 0
If TPtr->V_TSNEID = V_TSNEID Then Return TPtr
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_Del(ByRef V_TSNE as TSNE_Socket Ptr) as UByte
MutexLock(TSNE_INT_Mutex)
If V_TSNE = 0 Then MutexUnLock(TSNE_INT_Mutex): Return 0
If TSNE_INT_D = V_TSNE Then TSNE_INT_D = V_TSNE->V_Next
If TSNE_INT_L = V_TSNE Then TSNE_INT_L = V_TSNE->V_Prev
If V_TSNE->V_Prev <> 0 Then V_TSNE->V_Prev->V_Next = V_TSNE->V_Next
If V_TSNE->V_Next <> 0 Then V_TSNE->V_Next->V_Prev = V_TSNE->V_Prev
TSNE_INT_BW_Clear(V_TSNE)
DeAllocate(V_TSNE)
V_TSNE = 0
MutexUnLock(TSNE_INT_Mutex)
Return 1
End Function
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_Add() as TSNE_Socket Ptr
MutexLock(TSNE_INT_Mutex)
TSNE_INT_CC += 1
If TSNE_INT_CC = 0 Then TSNE_INT_CC += 1
Do Until TSNE_INT_GetPtr(TSNE_INT_CC) = 0
TSNE_INT_CC += 1
If TSNE_INT_CC = 0 Then TSNE_INT_CC += 1
Loop
If TSNE_INT_L <> 0 Then
TSNE_INT_L->V_Next = CAllocate(SizeOf(TSNE_Socket))
TSNE_INT_L->V_Next->V_PreV = TSNE_INT_L
TSNE_INT_L = TSNE_INT_L->V_Next
Else
TSNE_INT_L = CAllocate(SizeOf(TSNE_Socket))
TSNE_INT_D = TSNE_INT_L
End If
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_L
TPtr->V_TSNEID = TSNE_INT_CC
MutexUnLock(TSNE_INT_Mutex)
Return TPtr
End Function
'##############################################################################################################
Private Sub TSNE_INT_Init() CONSTRUCTOR
TSNE_INT_Mutex = MutexCreate
TSNE_INT_Mutex_Master = MutexCreate
TSNE_INT_DNSIPA_Mutex = MutexCreate
MutexLock(TSNE_INT_Mutex_Master)
TSNE_INT_Thread_Master_Ptr = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Master), , TSNE_INT_StackSize)
MutexLock(TSNE_INT_Mutex_Master)
MutexUnLock(TSNE_INT_Mutex_Master)
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Sub TSNE_INT_Term() DESTRUCTOR
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_D
Dim TNPtr as TSNE_Socket Ptr
Dim XTID as UInteger
Do until TPtr = 0
TNPtr = TPtr->V_Next
If TPtr->T_Thread <> 0 Then
XTID = TPtr->V_TSNEID
MutexUnLock(TSNE_INT_Mutex)
TSNE_Disconnect(XTID)
MutexLock(TSNE_INT_Mutex)
End If
TPtr = TNPtr
Loop
MutexUnLock(TSNE_INT_Mutex)
MutexLock(TSNE_INT_Mutex_Master)
TSNE_INT_Thread_Master_Close = 1
MutexUnLock(TSNE_INT_Mutex_Master)
ThreadWait(TSNE_INT_Thread_Master_Ptr)
MutexLock(TSNE_INT_DNSIPA_Mutex)
Dim TDNSPtr as TSNE_INT_DNSIPA_Type Ptr = TSNE_INT_DNSIPAD
Dim NDNSPtr as TSNE_INT_DNSIPA_Type Ptr
Do Until TDNSPtr = 0
NDNSPtr = TDNSPtr->V_Next
DeAllocate(TDNSPtr)
TDNSPtr = NDNSPtr
Loop
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
MutexDestroy(TSNE_INT_DNSIPA_Mutex): TSNE_INT_DNSIPA_Mutex = 0
MutexDestroy(TSNE_INT_Mutex_Master): TSNE_INT_Mutex_Master = 0
MutexDestroy(TSNE_INT_Mutex): TSNE_INT_Mutex = 0
End Sub
'##############################################################################################################
Private Function TSNE_INT_GetHostEnd(ByRef V_HostIPA as String, ByRef R_InAddr as in_addr) as Integer
MutexLock(TSNE_INT_DNSIPA_Mutex)
Dim TDNSPtr as TSNE_INT_DNSIPA_Type Ptr = TSNE_INT_DNSIPAD
Dim NDNSPtr as TSNE_INT_DNSIPA_Type Ptr
Do Until TDNSPtr = 0
If TDNSPtr->V_TimeOut <= Timer() Then
If TDNSPtr->V_Prev <> 0 Then TDNSPtr->V_Prev->V_Next = TDNSPtr->V_Next
If TDNSPtr->V_Next <> 0 Then TDNSPtr->V_Next->V_Prev = TDNSPtr->V_Prev
If TSNE_INT_DNSIPAD = TDNSPtr Then TSNE_INT_DNSIPAD = TDNSPtr->V_Next
If TSNE_INT_DNSIPAL = TDNSPtr Then TSNE_INT_DNSIPAL = TDNSPtr->V_Prev
NDNSPtr = TDNSPtr->V_Next
DeAllocate(TDNSPtr)
TDNSPtr = NDNSPtr
Else: TDNSPtr = TDNSPtr->V_Next
End If
Loop
TDNSPtr = TSNE_INT_DNSIPAD
Do Until TDNSPtr = 0
If TDNSPtr->V_HostIPA = V_HostIPA Then
R_InAddr = TDNSPtr->V_InAddr
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_NoError
End If
TDNSPtr = TDNSPtr->V_Next
Loop
Dim TADDRIN as in_addr
TADDRIN.s_addr = inet_addr(StrPtr(V_HostIPA))
If (TADDRIN.s_addr = -1) Then
Dim XHost as hostent Ptr = gethostbyname(StrPtr(V_HostIPA))
If XHost = 0 Then
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_CantResolveIPfromHost
End If
TADDRIN = *Cast(in_addr Ptr, XHost->h_addr_list[0])
If TADDRIN.s_addr = INADDR_NONE Then MutexUnLock(TSNE_INT_DNSIPA_Mutex): Return TSNE_Const_CantResolveIPfromHost
End If
If TSNE_INT_DNSIPAL <> 0 Then
TSNE_INT_DNSIPAL->V_Next = CAllocate(SizeOf(TSNE_INT_DNSIPA_Type))
TSNE_INT_DNSIPAL->V_Next->V_Prev = TSNE_INT_DNSIPAL
TSNE_INT_DNSIPAL = TSNE_INT_DNSIPAL->V_Next
Else
TSNE_INT_DNSIPAL = CAllocate(SizeOf(TSNE_INT_DNSIPA_Type))
TSNE_INT_DNSIPAD = TSNE_INT_DNSIPAL
End If
TSNE_INT_DNSIPAL->V_HostIPA = V_HostIPA
TSNE_INT_DNSIPAL->V_InAddr = TADDRIN
TSNE_INT_DNSIPAL->V_TimeOut = Timer() + 60
R_InAddr = TADDRIN
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Function TSNE_INT_GetHostEndV6(ByRef V_HostIPA as String, ByRef R_InAddr6 as in6_addr) as Integer
MutexLock(TSNE_INT_DNSIPA_Mutex)
Dim TDNSPtr as TSNE_INT_DNSIPA_Type Ptr = TSNE_INT_DNSIPAD
Dim NDNSPtr as TSNE_INT_DNSIPA_Type Ptr
Do Until TDNSPtr = 0
If TDNSPtr->V_TimeOut <= Timer() Then
If TDNSPtr->V_Prev <> 0 Then TDNSPtr->V_Prev->V_Next = TDNSPtr->V_Next
If TDNSPtr->V_Next <> 0 Then TDNSPtr->V_Next->V_Prev = TDNSPtr->V_Prev
If TSNE_INT_DNSIPAD = TDNSPtr Then TSNE_INT_DNSIPAD = TDNSPtr->V_Next
If TSNE_INT_DNSIPAL = TDNSPtr Then TSNE_INT_DNSIPAL = TDNSPtr->V_Prev
NDNSPtr = TDNSPtr->V_Next
DeAllocate(TDNSPtr)
TDNSPtr = NDNSPtr
Else: TDNSPtr = TDNSPtr->V_Next
End If
Loop
TDNSPtr = TSNE_INT_DNSIPAD
Do Until TDNSPtr = 0
If TDNSPtr->V_HostIPA = V_HostIPA Then
R_InAddr6 = TDNSPtr->V_InAddr6
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_NoError
End If
TDNSPtr = TDNSPtr->V_Next
Loop
Dim TADDRIN6 as in6_addr
Dim RV as Integer
RV = inet_pton(AF_INET6, StrPtr(V_HostIPA), @TADDRIN6)
If (RV = -1) or (RV = 0) Then
Dim XHost as hostent Ptr = gethostbyname2(StrPtr(V_HostIPA), AF_INET6)
If XHost = 0 Then
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_CantResolveIPfromHost
End If
TADDRIN6 = *Cast(in6_addr Ptr, XHost->h_addr_list[0])
' If TADDRIN6.s_addr = INADDR_NONE Then MutexUnLock(TSNE_INT_DNSIPA_Mutex): Return TSNE_Const_CantResolveIPfromHost
End If
If TSNE_INT_DNSIPAL <> 0 Then
TSNE_INT_DNSIPAL->V_Next = CAllocate(SizeOf(TSNE_INT_DNSIPA_Type))
TSNE_INT_DNSIPAL->V_Next->V_Prev = TSNE_INT_DNSIPAL
TSNE_INT_DNSIPAL = TSNE_INT_DNSIPAL->V_Next
Else
TSNE_INT_DNSIPAL = CAllocate(SizeOf(TSNE_INT_DNSIPA_Type))
TSNE_INT_DNSIPAD = TSNE_INT_DNSIPAL
End If
TSNE_INT_DNSIPAL->V_HostIPA = V_HostIPA
TSNE_INT_DNSIPAL->V_InAddr6 = TADDRIN6
TSNE_INT_DNSIPAL->V_TimeOut = Timer() + 60
R_InAddr6 = TADDRIN6
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Sub TSNE_INT_Thread_Master()
MutexUnLock(TSNE_INT_Mutex_Master)
Dim TPtr as TSNE_Socket Ptr
Dim TNPtr as TSNE_Socket Ptr
Dim TThPtr as Any Ptr
Dim TID as UInteger
Dim TEvent as TSNE_Event_Type
Do
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= Lock..."
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= Lock-K"
TPtr = TSNE_INT_D
Do Until TPtr = 0
TNPtr = TPtr->V_Next
If TPtr->T_ThreadOn = 3 Then
TID = TPtr->V_TSNEID
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= ThreadON 3"
TPtr->T_ThreadOn = 4
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= ThreadON 4"
TThPtr = TPtr->T_Thread
TEvent = TPtr->V_Event
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Unlock"
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Wait..."
ThreadWait(TThPtr)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Wait-K"
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Call-Dis..."
If TEvent.TSNE_Disconnected <> 0 Then TEvent.TSNE_Disconnected(TID)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Call-Dis-K"
TSNE_INT_Del(TPtr)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Lock..."
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Lock-K"
End If
TPtr = TNPtr
Loop
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= M-Lock..."
MutexLock(TSNE_INT_Mutex_Master)
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= M-Lock-K"
If TSNE_INT_Thread_Master_Close = 1 Then If TSNE_INT_D = 0 Then MutexUnLock(TSNE_INT_Mutex): MutexUnLock(TSNE_INT_Mutex_Master): Exit Do
MutexUnLock(TSNE_INT_Mutex_Master)
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= M-Unlock"
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= Unlock"
Sleep 1000, 1
Loop
If TSNE_INT_Debug = 1 Then Print "=[TSNE]=[TMA]= END SUB"
End Sub
'##############################################################################################################
Private Function TSNE_Stats(ByRef V_TSNEID as UInteger, ByRef R_RX as ULongInt, ByRef R_TX as ULongInt) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TPtr = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
R_RX = TPtr->T_DataIn
R_TX = TPtr->T_DataOut
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Function TSNE_Ping(ByVal V_IPA as String, ByRef R_Runtime as Double, ByVal V_TimeoutSecs as UInteger = 60) as Integer
If V_IPA = "" Then Return TSNE_Const_IPAnotFound
If InStr(1, V_IPA, ":") > 0 Then Return TSNE_Const_NoIPV6
Dim TADDRIN as in_addr
Dim RV as Integer = TSNE_INT_GetHostEnd(V_IPA, TADDRIN)
If RV <> TSNE_Const_NoError Then Return RV
Dim TADDR as SOCKADDR_IN
With TADDR
.sin_family = AF_INET
.sin_addr = TADDRIN
End With
Dim TSock as Socket = opensocket(PF_INET, SOCK_RAW, IPPROTO_ICMP)
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
#IF DEFINED(__FB_LINUX__)
Dim XFlag as Integer = fcntl(TSock, F_GETFL, 0)
If XFlag = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
If fcntl(TSock, F_SETFL, XFlag or O_NONBLOCK) = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
#ELSEIF DEFINED(__FB_WIN32__)
Dim XFlag as Integer = ioctlsocket(TSock, FIONBIO, Cast(Any Ptr, 1))
#ENDIF
'Dim TICMP as ICMP
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Function TSNE_Disconnect(ByRef V_TSNEID as UInteger) as Integer
'if V_TSNEID = 1 then
' Dim X as uinteger ptr
' Print *X
'End If
If TSNE_INT_Debug = 1 Then Print "=[" & Str(V_TSNEID) & "]=[TSNE]=[DIS]= Lock..."
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(V_TSNEID) & "]=[TSNE]=[DIS]= Lock-K"
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TPtr = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TPtr->V_Socket = INVALID_SOCKET Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoSocketFound
If TPtr->T_ThreadOn <> 2 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
Dim TSock as Socket = TPtr->V_Socket
TPtr->V_Socket = INVALID_SOCKET
TPtr->T_ThreadOn = 3
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(V_TSNEID) & "]=[TSNE]=[DIS]= Unlock"
close_(TSock)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_Create_Server(ByRef R_TSNEID as UInteger, ByRef V_Port as UShort, ByRef V_MaxSimConReq as UShort = 10, ByVal V_Event_NewConPTR as Any Ptr, ByVal V_Event_NewConCancelPTR as Any Ptr = 0, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
R_TSNEID = 0
If (V_MaxSimConReq <= 0) or (V_MaxSimConReq > 4096) Then Return TSNE_Const_MaxSimConReqOutOfRange
If (V_Port < 0) or (V_Port > 65535) Then Return TSNE_Const_PortOutOfRange
If V_Event_NewConPTR = 0 Then Return TSNE_Const_MissingEventPTR
Dim TSock as Socket = opensocket(AF_INET, SOCK_STREAM, IPPROTO_IP)
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
Dim TTADDR as SOCKADDR_IN
With TTADDR
.sin_family = AF_INET
.sin_port = htons(V_Port)
.sin_addr.s_addr = INADDR_ANY
End With
#IF DEFINED(TSNE_DEF_REUSER)
Dim XV as Integer = 1
#IF DEFINED(__FB_LINUX__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, @XV, SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ELSEIF DEFINED(__FB_WIN32__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, Cast(ZString Ptr, @XV), SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ENDIF
#ENDIF
Dim BV as Integer = bind(TSock, CPtr(SOCKADDR Ptr, @TTADDR), SizeOf(SOCKADDR_IN))
If BV = SOCKET_ERROR Then close_(TSock): Return TSNE_Const_CantBindSocket
BV = listen(TSock, V_MaxSimConReq)
If BV = SOCKET_ERROR Then Return TSNE_Const_CantSetListening
Dim TSD as TSNE_Socket Ptr = TSNE_INT_Add()
MutexLock(TSNE_INT_Mutex)
TSD->V_Socket = TSock
TSD->V_IPA = ""
TSD->V_Port = V_Port
TSD->V_Prot = TSNE_P_TCP
TSD->V_IsServer = 1
TSD->T_ThreadOn = 1
TSD->V_Event.TSNE_NewConnection = V_Event_NewConPTR
TSD->V_Event.TSNE_NewConnectionCanceled = V_Event_NewConCancelPTR
R_TSNEID = TSD->V_TSNEID
TSD->T_Thread = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Event), cast(Any Ptr, R_TSNEID), V_StackSizeOverride)
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_Create_ServerWithBindIPA(ByRef R_TSNEID as UInteger, ByRef V_Port as UShort, ByRef V_IPA as String, ByRef V_MaxSimConReq as UShort = 10, ByVal V_Event_NewConPTR as Any Ptr, ByVal V_Event_NewConCancelPTR as Any Ptr = 0, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
R_TSNEID = 0
If (V_MaxSimConReq <= 0) or (V_MaxSimConReq > 4096) Then Return TSNE_Const_MaxSimConReqOutOfRange
If (V_Port < 0) or (V_Port > 65535) Then Return TSNE_Const_PortOutOfRange
If V_IPA = "" Then Return TSNE_Const_IPAnotFound
If InStr(1, V_IPA, ":") > 0 Then Return TSNE_Const_NoIPV6
If V_Event_NewConPTR = 0 Then Return TSNE_Const_MissingEventPTR
Dim TADDRIN as in_addr
Dim RV as Integer = TSNE_INT_GetHostEnd(V_IPA, TADDRIN)
If RV <> TSNE_Const_NoError Then Return RV
Dim TSock as Socket = opensocket(AF_INET, SOCK_STREAM, IPPROTO_IP)
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
Dim TTADDR as SOCKADDR_IN
With TTADDR
.sin_family = AF_INET
.sin_port = htons(V_Port)
.sin_addr = TADDRIN
End With
#IF DEFINED(TSNE_DEF_REUSER)
Dim XV as Integer = 1
#IF DEFINED(__FB_LINUX__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, @XV, SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ELSEIF DEFINED(__FB_WIN32__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, Cast(ZString Ptr, @XV), SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ENDIF
#ENDIF
Dim BV as Integer = bind(TSock, CPtr(SOCKADDR Ptr, @TTADDR), SizeOf(SOCKADDR_IN))
If BV = SOCKET_ERROR Then close_(TSock): Return TSNE_Const_CantBindSocket
BV = listen(TSock, V_MaxSimConReq)
If BV = SOCKET_ERROR Then Return TSNE_Const_CantSetListening
Dim TSD as TSNE_Socket Ptr = TSNE_INT_Add()
MutexLock(TSNE_INT_Mutex)
TSD->V_Socket = TSock
TSD->V_IPA = V_IPA
TSD->V_Port = V_Port
TSD->V_Prot = TSNE_P_TCP
TSD->V_IsServer = 1
TSD->T_ThreadOn = 1
TSD->V_Event.TSNE_NewConnection = V_Event_NewConPTR
TSD->V_Event.TSNE_NewConnectionCanceled = V_Event_NewConCancelPTR
R_TSNEID = TSD->V_TSNEID
TSD->T_Thread = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Event), cast(Any Ptr, R_TSNEID), V_StackSizeOverride)
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_Create_Client(ByRef R_TSNEID as UInteger, ByVal V_IPA as String, ByVal V_Port as UShort, ByVal V_Event_DisconPTR as Any Ptr = 0, ByVal V_Event_ConPTR as Any Ptr = 0, ByVal V_Event_NewDataPTR as Any Ptr, ByVal V_TimeoutSecs as UInteger = 60, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
Dim TIPA as String = V_IPA
R_TSNEID = 0
If (V_Port < 0) or (V_Port > 65535) Then Return TSNE_Const_PortOutOfRange
If V_IPA = "" Then Return TSNE_Const_IPAnotFound
Dim TIPV6 as UByte = IIf(InStr(1, V_IPA, ":") > 0, 1, 0)
Dim TDevName as String
Dim XPos as UInteger
Dim TADDRIN as in_addr
Dim TADDRIN6 as in6_addr
Dim RV as Integer
If TIPV6 = 0 Then
RV = TSNE_INT_GetHostEnd(V_IPA, TADDRIN)
Else
XPos = InStr(1, TIPA, "%")
If XPos > 0 Then
TDevName = Mid(TIPA, XPos + 1)
TIPA = Left(TIPA, XPos - 1)
End If
RV = TSNE_INT_GetHostEndV6(TIPA, TADDRIN6)
End If
If RV <> TSNE_Const_NoError Then Return RV
Dim TADDR as SOCKADDR_IN
Dim TADDR6 as SOCKADDR_IN6
Dim TSock as Socket
If TIPV6 = 0 Then
With TADDR
.sin_family = AF_INET
.sin_port = htons(V_Port)
.sin_addr = TADDRIN
End With
TSock = opensocket(PF_INET, SOCK_STREAM, 0)
Else
With TADDR6
.sin6_family = AF_INET6
.sin6_port = htons(V_Port)
.sin6_addr = TADDRIN6
.sin6_scope_id = ipv6_getscope(TADDRIN6, TDevName) '2 'RT_SCOPE_UNIVERSE
' Print "Scope:"; .sin6_scope_id
End With
TSock = opensocket(PF_INET6, SOCK_STREAM, 0)
End If
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
Dim XFlag as Integer
If TIPV6 = 0 Then
#IF DEFINED(TSNE_DEF_REUSER)
Dim XV as Integer = 1
#IF DEFINED(__FB_LINUX__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, @XV, SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ELSEIF DEFINED(__FB_WIN32__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, Cast(ZString Ptr, @XV), SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ENDIF
#ENDIF
#IF DEFINED(__FB_LINUX__)
XFlag = fcntl(TSock, F_GETFL, 0)
If XFlag = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
If fcntl(TSock, F_SETFL, XFlag or O_NONBLOCK) = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
#ELSEIF DEFINED(__FB_WIN32__)
Dim XFlag as Integer = ioctlsocket(TSock, FIONBIO, Cast(Any Ptr, 1))
#ENDIF
end if
Dim BV as Integer
'Print "IPV6:"; TIPV6
If TIPV6 = 0 Then
BV = connect(TSock, Cast(SOCKADDR Ptr, @TADDR), SizeOf(SOCKADDR))
Else: BV = connect(TSock, Cast(SOCKADDR Ptr, @TADDR6), SizeOf(sockaddr_storage))
End If
'Print "BV:"; BV
If BV <> 0 Then
Dim TTV as timeval
Dim TFDSet as fd_Set
Dim TFDSetW as fd_Set
With TTV
.tv_sec = 1
.tv_usec = 0
End With
#IF DEFINED(__FB_LINUX__)
Dim XTot as Double = Timer + V_TimeoutSecs
Do
' Print "Try:" & Str(Timer())
If TIPV6 = 0 Then
If connect(TSock, Cast(SOCKADDR PTR, @TADDR), SizeOf(SOCKADDR)) = 0 Then Exit Do
Else: If connect(TSock, Cast(SOCKADDR PTR, @TADDR6), SizeOf(sockaddr_storage)) = 0 Then Exit Do
End If
If XTot < Timer Then close_(TSock): Return TSNE_Const_CantConnectToRemote
If TSock = INVALID_SOCKET Then Return TSNE_Const_CantConnectToRemote
With TTV
.tv_sec = 0
.tv_usec = 1000
End With
select_ 0, 0, 0, 0, @TTV
Loop
#ELSEIF DEFINED(__FB_WIN32__)
FD_SET_(TSock, @TFDSet)
With TTV
.tv_sec = V_TimeoutSecs
.tv_usec = 0
End With
FD_ZERO(@TFDSet)
If select_(TSock + 1, 0, @TFDSet, 0, @TTV) = (INVALID_SOCKET or 0) Then Return TSNE_Const_CantConnectToRemote
If Not (FD_ISSET(TSock, @TFDSet)) Then close_(TSock): Return TSNE_Const_CantConnectToRemote
If TSock = INVALID_SOCKET Then Return TSNE_Const_CantConnectToRemote
#ENDIF
End If
'Print "LEx"
#IF DEFINED(__FB_LINUX__)
fcntl(TSock, F_SETFL, XFlag)
#ELSEIF DEFINED(__FB_WIN32__)
XFlag = ioctlsocket(TSock, FIONBIO, Cast(UInteger, 0))
#ENDIF
Dim TSD as TSNE_Socket Ptr = TSNE_INT_Add()
MutexLock(TSNE_INT_Mutex)
TSD->V_Socket = TSock
TSD->V_IPA = V_IPA
TSD->V_Port = V_Port
TSD->V_Prot = TSNE_P_TCP
TSD->V_IsServer = 0
TSD->T_ThreadOn = 1
TSD->V_Event.TSNE_Disconnected = V_Event_DisconPTR
TSD->V_Event.TSNE_Connected = V_Event_ConPTR
TSD->V_Event.TSNE_NewData = V_Event_NewDataPTR
R_TSNEID = TSD->V_TSNEID
TSD->T_Thread = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Event), cast(Any Ptr, R_TSNEID), V_StackSizeOverride)
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_Create_Accept(ByVal V_RequestID as Socket, ByRef R_TSNEID as UInteger, ByRef R_IPA as String = "", ByVal V_Event_DisconPTR as Any Ptr = 0, ByVal V_Event_ConPTR as Any Ptr = 0, ByVal V_Event_NewDataPTR as Any Ptr, ByRef R_RemoteShownServerIPA as String = "", ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
Dim TADDR as SOCKADDR_IN
Dim XSize as Integer = 16
Dim OADDR as SOCKADDR_IN
If getsockname(V_RequestID, Cast(sockaddr PTR, @OADDR), @XSize) = 0 Then R_RemoteShownServerIPA = *inet_ntoa(OADDR.sin_addr)
If getpeername(V_RequestID, Cast(sockaddr PTR, @TADDR), @XSize) = 0 Then R_IPA = *inet_ntoa(TADDR.sin_addr)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_Add()
MutexLock(TSNE_INT_Mutex)
TSD->V_Socket = V_RequestID
TSD->V_Prot = TSNE_P_TCP
TSD->V_IPA = R_IPA
TSD->T_ThreadOn = 1
TSD->V_Event.TSNE_Disconnected = V_Event_DisconPTR
TSD->V_Event.TSNE_Connected = V_Event_ConPTR
TSD->V_Event.TSNE_NewData = V_Event_NewDataPTR
R_TSNEID = TSD->V_TSNEID
TSD->T_Thread = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Event), cast(Any Ptr, R_TSNEID), V_StackSizeOverride)
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_Create_UDP_RX(ByRef R_TSNEID as UInteger, ByVal V_Port as UShort, ByVal V_Event_NewDataUDPPTR as Any Ptr, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize) as Integer
R_TSNEID = 0
If (V_Port < 0) or (V_Port > 65535) Then Return TSNE_Const_PortOutOfRange
If V_Event_NewDataUDPPTR = 0 Then Return TSNE_Const_MissingEventPTR
Dim TSock as Socket = opensocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
#IF DEFINED(TSNE_DEF_REUSER)
Dim XV as Integer = 1
#IF DEFINED(__FB_LINUX__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, @XV, SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ELSEIF DEFINED(__FB_WIN32__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, Cast(ZString Ptr, @XV), SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ENDIF
#ENDIF
Dim TTADDR as SOCKADDR_IN
With TTADDR
.sin_family = AF_INET
.sin_port = htons(V_Port)
.sin_addr.s_addr = INADDR_ANY
End With
Dim BV as Integer = bind(TSock, CPtr(SOCKADDR Ptr, @TTADDR), SizeOf(SOCKADDR_IN))
If BV = SOCKET_ERROR Then close_(TSock): Return TSNE_Const_CantBindSocket
Dim TSD as TSNE_Socket Ptr = TSNE_INT_Add()
MutexLock(TSNE_INT_Mutex)
TSD->V_Socket = TSock
TSD->V_IPA = ""
TSD->V_USP = TTADDR
TSD->V_Port = V_Port
TSD->V_Prot = TSNE_P_UDP
TSD->V_IsServer = 1
TSD->T_ThreadOn = 1
TSD->V_Event.TSNE_NewDataUDP = V_Event_NewDataUDPPTR
R_TSNEID = TSD->V_TSNEID
TSD->T_Thread = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Event), cast(Any Ptr, R_TSNEID), V_StackSizeOverride)
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_Create_UDP_TX(ByRef R_TSNEID as UInteger, ByVal V_DoBroadcast as UByte = 0) as Integer
R_TSNEID = 0
Dim TSock as Socket = opensocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
#IF DEFINED(TSNE_DEF_REUSER)
Dim XV as Integer = 1
#IF DEFINED(__FB_LINUX__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, @XV, SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ELSEIF DEFINED(__FB_WIN32__)
If setsockopt(TSock, SOL_SOCKET, SO_REUSEADDR, Cast(ZString Ptr, @XV), SizeOf(Integer)) = -1 then close_(TSock): Return TSNE_Const_CantBindSocket
#ENDIF
#ENDIF
If V_DoBroadcast = 1 Then
Dim TBD as Integer = 1
#IF DEFINED(__FB_LINUX__)
If setsockopt(TSock, SOL_SOCKET, SO_BROADCAST, @TBD, sizeof(TBD)) = -1 Then close_(TSock): Return TSNE_Const_CantCreateSocket
#ELSEIF DEFINED(__FB_WIN32__)
If setsockopt(TSock, SOL_SOCKET, SO_BROADCAST, Cast(ZString Ptr, @TBD), sizeof(TBD)) = -1 Then close_(TSock): Return TSNE_Const_CantCreateSocket
#ENDIF
End If
Dim TSD as TSNE_Socket Ptr = TSNE_INT_Add()
MutexLock(TSNE_INT_Mutex)
TSD->V_Socket = TSock
TSD->V_IPA = ""
TSD->V_Port = 0
TSD->V_Prot = TSNE_P_UDP
TSD->V_IsServer = 1
TSD->T_ThreadOn = 2
R_TSNEID = TSD->V_TSNEID
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Function TSNE_Data_Send(ByRef V_TSNEID as UInteger, ByRef V_Data as String, ByRef R_BytesSend as UInteger = 0, ByVal V_IPA as String = "", ByVal V_Port as UShort = 0) as Integer
R_BytesSend = 0
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_Socket = INVALID_SOCKET Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
Dim TSock as Socket = TSD->V_Socket
Dim TProt as TSNE_Protocol = TSD->V_Prot
MutexUnLock(TSNE_INT_Mutex)
Dim XTemp as String = V_Data
Dim XLen as UInteger = Len(XTemp)
Dim BV as Integer
Select Case TProt
Case TSNE_P_UDP
If V_IPA = "" Then Return TSNE_Const_IPAnotFound
If (V_Port < 0) or (V_Port > 65535) Then Return TSNE_Const_PortOutOfRange
Dim TTADDR as SOCKADDR_IN
With TTADDR
.sin_family = AF_INET
.sin_port = htons(V_Port)
If V_IPA <> "0" Then
Dim XHost as hostent Ptr
If InStr(1, V_IPA, ":") > 0 Then Return TSNE_Const_NoIPV6
Dim TADDRIN as in_addr
Dim RV as Integer = TSNE_INT_GetHostEnd(V_IPA, TADDRIN)
If RV <> TSNE_Const_NoError Then Return RV
.sin_addr = TADDRIN
Else: .sin_addr.s_addr = INADDR_BROADCAST
End If
End With
Do Until R_BytesSend = XLen
BV = sendto(TSock, StrPtr(XTemp) + R_BytesSend, XLen - R_BytesSend, TSNE_MSG_NOSIGNAL, Cast(SOCKADDR Ptr, @TTADDR), SizeOf(SOCKADDR_IN))
If BV > 0 Then
R_BytesSend += BV
ElseIf BV = 0 Then
Else: Exit Do
End If
Loop
Case TSNE_P_TCP
Do Until R_BytesSend = XLen
BV = send(TSock, StrPtr(XTemp) + R_BytesSend, XLen - R_BytesSend, TSNE_MSG_NOSIGNAL)
If BV > 0 Then
R_BytesSend += BV
ElseIf BV = 0 Then
Else: Exit Do
End If
Loop
End Select
MutexLock(TSNE_INT_Mutex)
TSD->T_DataOut += R_BytesSend
MutexUnLock(TSNE_INT_Mutex)
If R_BytesSend <> XLen Then Return TSNE_Const_ErrorSendingData
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Sub TSNE_WaitClose(ByRef V_TSNEID as UInteger)
Dim TSD as TSNE_Socket Ptr
MutexLock(TSNE_INT_Mutex)
MutexunLock(TSNE_INT_Mutex)
Do
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(V_TSNEID)
If TSD = 0 Then Exit Do
If TSD->T_ThreadOn = 0 Then Exit Do
MutexUnLock(TSNE_INT_Mutex)
Sleep 10, 1
Loop
MutexUnLock(TSNE_INT_Mutex)
End Sub
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_IsClosed(ByRef V_TSNEID as UInteger) as UByte
Dim TSD as TSNE_Socket Ptr
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(V_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return 1
If TSD->T_ThreadOn = 0 Then MutexUnLock(TSNE_INT_Mutex): Return 1
MutexUnLock(TSNE_INT_Mutex)
Return 0
End Function
'##############################################################################################################
Private Sub TSNE_INT_Thread_Event(V_TSNEID as Any Ptr)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(Cast(UInteger, V_TSNEID)) & "]=[TSNE]=[EVT]= Lock..."
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(Cast(UInteger, V_TSNEID)) & "]=[TSNE]=[EVT]= Lock-K"
Dim TTSNEID as UInteger = Cast(UInteger, V_TSNEID)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(TTSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Sub
Dim TSock as Socket = TSD->V_Socket
Dim TEvent as TSNE_Event_Type = TSD->V_Event
Dim TTV AS TimeVal
With TTV
.tv_sec = 0
.tv_usec = 0
End With
Dim TFDSet as fd_Set
Dim TLenB as Integer
Dim TBuffer as ZString * TSNE_INT_BufferSize
Dim TIPA as String
Dim T as String
Dim TADDR as SOCKADDR_IN
Dim XSize as Integer = SizeOf(sockaddr_in)
If TSD->T_ThreadOn = 1 Then
TSD->T_ThreadOn = 2
Dim TProt as TSNE_Protocol = TSD->V_Prot
Select Case TProt
Case TSNE_P_UDP
Dim TTADDRC as SOCKADDR_IN
Dim TTLen as UInteger = SizeOf(TADDR)
MutexUnLock(TSNE_INT_Mutex)
Do
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Do
TSock = TSD->V_Socket: If TSock = INVALID_SOCKET Then MutexUnLock(TSNE_INT_Mutex): Exit Do
MutexUnLock(TSNE_INT_Mutex)
fd_set_(TSock, @TFDSet)
If TSock = INVALID_SOCKET Then Exit Do
With TTV
.tv_sec = 1
.tv_usec = 0
End With
' If select_(TSock + 1, @TFDSet, 0, 0, @TTV) = -1 Then Exit Do
select_(TSock + 1, @TFDSet, 0, 0, @TTV)
If (FD_ISSET(TSock, @TFDSet)) <> 0 Then
If TSock = INVALID_SOCKET Then Exit Do
TADDR = TTADDRC
TLenB = recvfrom(TSock, StrPtr(TBuffer), TSNE_INT_BufferSize, 0, Cast(SOCKADDR Ptr, @TADDR), @TTLen)
If TLenB <= 0 Then Exit Do
TBuffer[TLenB] = 0
T = Space(TLenB + 1)
MemCpy(StrPtr(T), StrPtr(TBuffer), TLenB)
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Do
TSD->T_DataIn += TLenB
MutexUnLock(TSNE_INT_Mutex)
T = Mid(T, 1, Len(T) - 1)
TIPA = *inet_ntoa(TADDR.sin_addr)
If TEvent.TSNE_NewDataUDP <> 0 Then TEvent.TSNE_NewDataUDP(TTSNEID, TIPA, T)
End If
Loop
Case TSNE_P_TCP
If TSD->V_IsServer <> 1 Then
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Unlocked"
If TEvent.TSNE_Connected <> 0 Then TEvent.TSNE_Connected(TTSNEID)
Do
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Do
TSock = TSD->V_Socket: If TSock = INVALID_SOCKET Then MutexUnLock(TSNE_INT_Mutex): Exit Do
MutexUnLock(TSNE_INT_Mutex)
fd_set_(TSock, @TFDSet)
If TSock = INVALID_SOCKET Then Exit Do
With TTV
.tv_sec = 1
.tv_usec = 0
End With
' If select_(TSock + 1, @TFDSet, 0, 0, @TTV) = -1 Then Exit Do
select_(TSock + 1, @TFDSet, 0, 0, @TTV)
If (FD_ISSET(TSock, @TFDSet)) <> 0 Then
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Event"
If TSock = INVALID_SOCKET Then Exit Do
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat"
TLenB = recv(TSock, StrPtr(TBuffer), TSNE_INT_BufferSize, 0)
If TLenB <= 0 Then Exit Do
TBuffer[TLenB] = 0
T = Space(TLenB + 1)
MemCpy(StrPtr(T), StrPtr(TBuffer), TLenB)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Lock..."
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Lock-K"
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Do
TSD->T_DataIn += TLenB
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Unlock"
T = Mid(T, 1, Len(T) - 1)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Call... (" & Str(Len(T)) & ")"
If TEvent.TSNE_NewData <> 0 Then TEvent.TSNE_NewData(TTSNEID, T)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Call-K"
End If
Loop
Else
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= Unlocked"
Dim TNSock as Socket
Dim Y as UInteger
Dim XOK as Integer
Dim XFX as UInteger
Dim XV as Integer = 1
Do
XFX += 1
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Do
TSock = TSD->V_Socket: If TSock = INVALID_SOCKET Then MutexUnLock(TSNE_INT_Mutex): Exit Do
MutexUnLock(TSNE_INT_Mutex)
fd_set_(TSock, @TFDSet)
With TTV
.tv_sec = 1
.tv_usec = 0
End With
' If selectsocket(TSock + 1, @TFDSet, 0, 0, @TTV) = SOCKET_ERROR Then
selectsocket(TSock + 1, @TFDSet, 0, 0, @TTV)
If (FD_ISSET(TSock, @TFDSet)) Then
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= ACP..."
TNSock = accept(TSock, 0, 0)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= ACP:" & Str(TNSock)
IF TNSock = INVALID_SOCKET Then Exit Do
#IF DEFINED(TSNE_DEF_REUSER)
#IF DEFINED(__FB_LINUX__)
setsockopt(TNSock, SOL_SOCKET, SO_REUSEADDR, @XV, SizeOf(Integer))
#ELSEIF DEFINED(__FB_WIN32__)
setsockopt(TNSock, SOL_SOCKET, SO_REUSEADDR, Cast(ZString Ptr, @XV), SizeOf(Integer))
#ENDIF
#ENDIF
TIPA = ""
If getpeername(TNSock, Cast(sockaddr Ptr, @TADDR), @XSize) = 0 Then TIPA = *inet_ntoa(TADDR.sin_addr)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= BWL Lock..."
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= BWL Lock-K"
Select Case TSD->V_BWL_UseType
Case 1
If TSNE_INT_BW_GetPtr(TSD, TIPA) = 0 Then
MutexUnLock(TSNE_INT_Mutex): If TEvent.TSNE_NewConnection <> 0 Then TEvent.TSNE_NewConnection(TTSNEID, TNSock, TIPA)
Else: MutexUnLock(TSNE_INT_Mutex): close_(TNSock): If TEvent.TSNE_NewConnectionCanceled <> 0 Then TEvent.TSNE_NewConnectionCanceled(TTSNEID, TIPA)
End If
Case 2
If TSNE_INT_BW_GetPtr(TSD, TIPA) = 0 Then
MutexUnLock(TSNE_INT_Mutex): close_(TNSock): If TEvent.TSNE_NewConnectionCanceled <> 0 Then TEvent.TSNE_NewConnectionCanceled(TTSNEID, TIPA)
Else: MutexUnLock(TSNE_INT_Mutex): If TEvent.TSNE_NewConnection <> 0 Then TEvent.TSNE_NewConnection(TTSNEID, TNSock, TIPA)
End If
Case Else: MutexUnLock(TSNE_INT_Mutex): If TEvent.TSNE_NewConnection <> 0 Then TEvent.TSNE_NewConnection(TTSNEID, TNSock, TIPA)
End Select
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= BWL Unlock"
End If
Loop
End If
Case Else: MutexUnLock(TSNE_INT_Mutex)
End Select
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit Lock"
MutexLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit Lock-K"
End If
TSD = TSNE_INT_GetPtr(TTSNEID)
If TSD <> 0 Then
TSock = TSD->V_Socket
If TSock <> INVALID_SOCKET Then
TSD->V_Socket = INVALID_SOCKET
close_(TSock)
End If
TSD->T_ThreadOn = 3
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit ThreadON 3"
End If
MutexUnLock(TSNE_INT_Mutex)
If TSNE_INT_Debug = 1 Then Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit Unlocked"
End Sub
'##############################################################################################################
Private Function TSNE_BW_SetEnable(ByVal V_Server_TSNEID as UInteger, V_Type as TSNE_BW_Mode_Enum) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_Server_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_IsServer <> 1 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNENoServer
TSD->V_BWL_UseType = V_Type
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_BW_GetEnable(ByVal V_Server_TSNEID as UInteger, R_Type as TSNE_BW_Mode_Enum) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_Server_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_IsServer <> 1 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNENoServer
R_Type = TSD->V_BWL_UseType
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_BW_Clear(ByVal V_Server_TSNEID as UInteger) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_Server_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_IsServer <> 1 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNENoServer
TSNE_INT_BW_Clear(TSD)
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_BW_Add(ByVal V_Server_TSNEID as UInteger, V_IPA as String, V_BlockTimeSeconds as UInteger = 3600) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_Server_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_IsServer <> 1 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNENoServer
If TSNE_INT_BW_Add(TSD, V_IPA, Now() + V_BlockTimeSeconds) = 1 Then
MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
Else: MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_IPAalreadyInList
End if
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_BW_Del(ByVal V_Server_TSNEID as UInteger, V_IPA as String) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_Server_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_IsServer <> 1 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNENoServer
If TSNE_INT_BW_Del(TSD, V_IPA) = 1 Then
MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
Else: MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_IPAnotInList
End if
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_BW_List(ByVal V_Server_TSNEID as UInteger, ByRef R_IPA_List as TSNE_BWL_Type Ptr) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TSD as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_Server_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
If TSD->V_IsServer <> 1 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNENoServer
Dim TPtr as TSNE_BWL_Type Ptr = TSD->V_BWL_IPAD
Dim TNPtrL as TSNE_BWL_Type Ptr
Do Until TPtr = 0
If TNPtrL <> 0 Then
TNPtrL->V_Next = CAllocate(SizeOf(TSNE_Socket))
TNPtrL->V_Next->V_PreV = TNPtrL
TNPtrL = TNPtrL->V_Next
Else
TNPtrL = CAllocate(SizeOf(TSNE_Socket))
R_IPA_List = TNPtrL
End If
TNPtrL->V_IPA = TPtr->V_IPA
TNPtrL->V_LockTill = TPtr->V_LockTill
TPtr = TPtr->V_Next
Loop
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Function TSNE_GetGURUCode(ByRef V_GURUID as Integer) as String
Select Case V_GURUID
Case TSNE_Const_UnknowError: Return "Unknown error."
Case TSNE_Const_NoError: Return "No error."
Case TSNE_Const_UnknowEventID: Return "Unknown EventID."
Case TSNE_Const_NoSocketFound: Return "No Socket found in 'V_SOCKET'."
Case TSNE_Const_CantCreateSocket: Return "Can't create socket."
Case TSNE_Const_CantBindSocket: Return "Can't bind port on socket."
Case TSNE_Const_CantSetListening: Return "Can't set socket into listening-mode."
Case TSNE_Const_SocketAlreadyInit: Return "Socket is already initalized."
Case TSNE_Const_MaxSimConReqOutOfRange: Return "'V_MaxSimConReq' is out of range."
Case TSNE_Const_PortOutOfRange: Return "Port out of range."
Case TSNE_Const_CantResolveIPfromHost: Return "Can't resolve IPA from host."
Case TSNE_Const_CantConnectToRemote: Return "Can't connect to remote computer [Timeout?]."
Case TSNE_Const_TSNEIDnotFound: Return "TSNE-ID not found."
Case TSNE_Const_MissingEventPTR: Return "Missing pointer of 'V_Event...'."
Case TSNE_Const_IPAalreadyInList: Return "IPA already in list."
Case TSNE_Const_IPAnotInList: Return "IPA is not in list."
Case TSNE_Const_ReturnErrorInCallback: Return "Return error in callback."
Case TSNE_Const_IPAnotFound: Return "IPA not found."
Case TSNE_Const_ErrorSendingData: Return "Error while sending data. Not sure all data transmitted. Maybe connection lost or disconnected."
Case TSNE_Const_TSNENoServer: Return "TSNEID is not a server."
Case TSNE_Const_NoIPV6: Return "No IPV6 supportet!"
Case TSNE_Const_CantCreateSocketLimit: Return "Can't create socket. No more file descriptors available for this process or the system."
Case Else: Return "Unknown GURU-Code [" & Str(V_GURUID) & "]"
End Select
End Function
'##############################################################################################################
'...<
#ENDIF