Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
TSNE_V3.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 15.12.2011 06:21:36 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts TSNE V2 / V3, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
Warnung: Es steht bereits eine neuere Version des Quelltexts zur Verfügung. Die hier vorliegende alte Version könnte Fehler enthalten, die in der neuen Version vielleicht ausgebessert wurden.
'##############################################################################################################
'##############################################################################################################
' TSNE_V3 - TCP Socket Networking [Eventing] Version: 3.5_20111215 (0.18.5 -> 0.20.0 [08-10-2008])
'##############################################################################################################
'##############################################################################################################
' (c) 2009-.... By.: /_\ DeltaLab's Germany - Experimental Computing
' Autor: Martin Wiemann
' IRC: IRC://MLN.ath.cx/#mln
'##############################################################################################################
' Free for NON-comercial use! For comercial usage send me a mail -> Admin[at]MLN.ath.cx or IRC and u become a free usage
'##############################################################################################################
#IFNDEF _TSNE_
#DEFINE _TSNE_
'>...
'##############################################################################################################
#define EMFILE 24
#define ENFILE 23
#define ENOMEM 12
#IF DEFINED(TSNE_ERRNO)
declare function errno cdecl alias "__errno_location" () as integer ptr ptr
#ENDIF
#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__)
#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
Const IP_SUCCESS = 0
Const IP_DEST_NET_UNREACHABLE = 1102
Const IP_DEST_HOST_UNREACHABLE = 1103
Const IP_DEST_PROT_UNREACHABLE = 1104
Const IP_DEST_PORT_UNREACHABLE = 1105
Const IP_REQ_TIMED_OUT = 11010
Const IP_TTL_EXPIRED_TRANSIT = 11013
Type IP_Option_Information
Ttl as UByte
Tos as UByte
Flags as UByte
OptionsSize as UByte
OptionsData as UByte Ptr
End type
Type ICMP_Echo_Reply
Adress as in_addr
Status as UInteger
RoundTripTime as UInteger
DataSize as UShort
Reserved as UShort
Data as Any Ptr
Options as IP_Option_Information
End Type
#IF DEFINED(TSNE_PINGICMP)
Declare Function IcmpCreateFile Lib "icmp.dll" () As Integer
Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Integer) As Integer
Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Integer, ByVal DestinationAddress As in_addr, ByVal RequestData As String, ByVal RequestSize As Short, ByVal RequestOptions As Integer, ReplyBuffer As ICMP_Echo_Reply Ptr, ByVal ReplySize As Integer, ByVal TimeOut As Integer) As Integer
#ENDIF
Private Sub TSNE_INT_StartWinsock() CONSTRUCTOR 102
Dim xwsa as WSADATA
WSAStartup(MAKEWORD(2, 0), @xwsa)
End Sub
Private Sub TSNE_INT_EndWinsock() DESTRUCTOR 102
WSAcleanup()
End Sub
#ELSE
#error "Unsupported platform"
#ENDIF
#INCLUDE once "crt/sys/time.bi"
#INCLUDE once "crt/fcntl.bi"
#Include once "vbcompat.bi"
#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
icd_id as UShort
icd_seq as UShort
ih_pptr as UByte
ih_gwaddr as in_addr
ih_void as UInteger
ipm_void as UShort
ipm_nextmtu as UShort
irt_num_addrs as UByte
irt_wpa as UByte
irt_lifetime as UShort
#Define icmp_pptr ih_pptr
#Define icmp_gwadr ih_gwadr
#Define icmp_id icd_id
#Define icmp_seq icd_seq
#Define icmp_void ih_void
#Define icmp_pmvoid ipm_void
#Define icmp_nextmtu ipm_nextmtu
#Define icmp_num_addrs irt_num_addrs
#Define icmp_wpa irt_wpa
#Define icmp_lifetiem irt_lifetime
End Type
#ENDIF
'##############################################################################################################
'|#DEFINE _TSNE_DODEBUG_
'##############################################################################################################
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
Dim Shared TSNE_INT_StackSize as UInteger = 512000
#IF Defined(TSNE_ConstStackSizeOverride)
TSNE_INT_StackSize = TSNE_ConstStackSizeOverride
#ENDIF
'--------------------------------------------------------------------------------------------------------------
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 Const TSNE_Const_UnstableState as Integer = -23
Private Const TSNE_Const_InternalError as Integer = -99
'--------------------------------------------------------------------------------------------------------------
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_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_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
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, ByVal V_WaitThreadRunning as UByte = 1) 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, ByVal V_WaitThreadRunning as UByte = 1) 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, ByVal V_WaitThreadRunning as UByte = 1) 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 Function TSNE_Ping (ByVal V_IPA as String, ByRef R_Runtime as Double, ByVal V_TimeoutSecs as UByte = 10, ByVal V_ForceRAWPing as UByte = 0, ByVal V_FileIOMutex as Any Ptr = 0) as Integer
Declare Sub TSNE_WaitClose (ByRef V_TSNEID as UInteger)
Declare Function TSNE_WaitConnected (ByRef V_TSNEID as UInteger, V_TimeOut as UInteger = 60) as Integer
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
'##############################################################################################################
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 101
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 101
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 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 DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= Lock-K"
#ENDIF
TPtr = TSNE_INT_D
Do Until TPtr = 0
TNPtr = TPtr->V_Next
If TPtr->T_ThreadOn = 3 Then
TID = TPtr->V_TSNEID
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= ThreadON 3"
#ENDIF
TPtr->T_ThreadOn = 4
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= ThreadON 4"
#ENDIF
TThPtr = TPtr->T_Thread
TEvent = TPtr->V_Event
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Unlock"
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Wait..."
#ENDIF
ThreadWait(TThPtr)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Wait-K"
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Call-Dis..."
#ENDIF
If TEvent.TSNE_Disconnected <> 0 Then TEvent.TSNE_Disconnected(TID)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Call-Dis-K"
#ENDIF
TSNE_INT_Del(TPtr)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TID) & "]=[TSNE]=[TMA]= Lock-K"
#ENDIF
End If
TPtr = TNPtr
Loop
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= M-Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex_Master)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= M-Lock-K"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= M-Unlock"
#ENDIF
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= Unlock"
#ENDIF
Sleep 1000, 1
Loop
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[TSNE]=[TMA]= END SUB"
#ENDIF
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 UByte = 10, ByVal V_ForceRAWPing as UByte = 0, ByVal V_FileIOMutex as Any Ptr = 0) 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 XFN as Integer
#IF DEFINED(__FB_LINUX__)
If V_ForceRAWPing = 0 Then
If Dir("/bin/ping", -1) <> "" Then
If V_FileIOMutex <> 0 Then MutexLock(V_FileIOMutex)
XFN = FreeFile
If Open Pipe ("/bin/ping -t " & Str(V_TimeoutSecs) & " -c 1 -qU " & V_IPA for Input as XFN) = 0 Then
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
Dim T as String
Dim TL as String
Do Until EOF(XFN)
Line Input #XFN, TL
If Trim(TL) <> "" Then T = TL
Loop
Close #XFN
XFN = InStr(1, T, "=")
If XFN = 0 Then Return TSNE_Const_InternalError
T = Trim(Mid(T, XFN + 1))
XFN = InStr(1, T, "/")
If XFN = 0 Then Return TSNE_Const_InternalError
R_Runtime = Val(Trim(Left(T, XFN - 1))) / 1000
Return TSNE_Const_NoError
End If
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
End If
End If
#ELSEIF DEFINED(__FB_WIN32__)
If V_ForceRAWPing = 0 Then
#IF DEFINED(TSNE_PINGICMP)
Dim TBuff as ICMP_Echo_Reply Ptr = CAllocate(SizeOf(ICMP_Echo_Reply) + 4)
XFN = IcmpCreateFile()
If IcmpSendEcho(XFN, TADDRIN, "PING", 4, 0, TBuff, SizeOf(TBuff), (V_TimeoutSecs * 1000)) >= 1 Then
IcmpCloseHandle(XFN)
With *TBuff
Select Case .Status
Case IP_SUCCESS
R_Runtime = .RoundTripTime / 1000
DeAllocate(TBuff)
Return TSNE_Const_NoError
Case IP_DEST_NET_UNREACHABLE, IP_DEST_HOST_UNREACHABLE, IP_DEST_PROT_UNREACHABLE, IP_DEST_PORT_UNREACHABLE, IP_REQ_TIMED_OUT, IP_TTL_EXPIRED_TRANSIT
DeAllocate(TBuff)
Return TSNE_Const_CantConnectToRemote
Case Else: DeAllocate(TBuff): Return TSNE_Const_InternalError
End Select
End With
Else
#ENDIF
DeAllocate(TBuff)
If V_FileIOMutex <> 0 Then MutexLock(V_FileIOMutex)
XFN = FreeFile
If Open Pipe ("ping -w " & Str(V_TimeoutSecs) & " -n 1 " & V_IPA for Input as XFN) = 0 Then
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
Dim T as String
Dim TL as String
Do Until EOF(XFN)
Line Input #XFN, TL
If Trim(TL) <> "" Then T = TL
Loop
Close #XFN
XFN = InStr(1, T, "=")
If XFN = 0 Then Return TSNE_Const_InternalError
T = Trim(Mid(T, XFN + 1))
XFN = InStr(1, T, "ms")
If XFN = 0 Then Return TSNE_Const_InternalError
R_Runtime = Val(Trim(Left(T, XFN - 1))) / 1000
Return TSNE_Const_NoError
End If
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
#IF DEFINED(TSNE_PINGICMP)
End If
#ENDIF
End If
#ENDIF
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
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
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
If fcntl(TSock, F_SETFL, XFlag) = -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
With TICMP
.icmp_type = ICMP_ECHO
.icmp_code = 0
.icmp_seq = 1
.icmp_id = 0
End With
Dim TUBP as UByte Ptr = Cast(UByte Ptr, @TICMP)
Dim TSum as UInteger
For X as UInteger = 0 To SizeOf(ICMP) -1
TSum += *(TUBP + X)
Next
TSum = (TSum shr 16) + (TSum and &HFFFF)
TSum += (TSum shr 16)
TSum = &HFFFF - TSum
TICMP.icmp_cksum = TSum
Dim TBuffer as ZString * TSNE_INT_BufferSize
Dim TLenB as Integer
Dim TFDSet as fd_Set
Dim TTLen as UInteger = SizeOf(TADDR)
Dim TTV AS TimeVal
With TTV
.tv_sec = CUInt(V_TimeoutSecs)
.tv_usec = 0
End With
fd_set_(TSock, @TFDSet)
Dim TRTT as Double = Timer()
RV = sendto(TSock, Cast(UByte Ptr, @TICMP), SizeOf(ICMP), 0, Cast(SOCKADDR Ptr, @TADDR), SizeOf(SOCKADDR_IN))
If RV <> SizeOf(ICMP) Then close_(TSock): Return TSNE_Const_ErrorSendingData
Do
RV = select_(TSock + 1, @TFDSet, 0, 0, @TTV)
If RV <> 1 Then close_(TSock): Return TSNE_Const_CantConnectToRemote
If TSock = INVALID_SOCKET Then close_(TSock): Return TSNE_Const_InternalError
TLenB = recvfrom(TSock, StrPtr(TBuffer), TSNE_INT_BufferSize, 0, Cast(SOCKADDR Ptr, @TADDR), @TTLen)
If TLenB <= 0 Then close_(TSock): Return TSNE_Const_InternalError
If TLenB >= 2 Then
If (((TBuffer[0] and &B11110000) shr 4) = &H4) and (TBuffer[1] = &H00) Then
Dim TIHL as UInteger = (TBuffer[0] and &B00001111) * 4
If TIHL >= 16 Then
If TBuffer[TIHL + 0] = ICMP_ECHOREPLY Then
Dim TSN as UShort = (TBuffer[TIHL + 6] shl 8) or TBuffer[TIHL + 7]
If TSN = 256 Then
close_(TSock)
R_Runtime = Timer() - TRTT
Return TSNE_Const_NoError
End If
End If
End If
End If
End If
Loop
Return TSNE_Const_CantConnectToRemote
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(V_TSNEID) & "]=[TSNE]=[DIS]= Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(V_TSNEID) & "]=[TSNE]=[DIS]= Lock-K"
#ENDIF
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_UnstableState
Dim TSock as Socket = TPtr->V_Socket
TPtr->V_Socket = INVALID_SOCKET
TPtr->T_ThreadOn = 3
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(V_TSNEID) & "]=[TSNE]=[DIS]= Unlock"
#ENDIF
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
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
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
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
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, ByVal V_WaitThreadRunning as UByte = 1) as Integer
R_TSNEID = 0
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
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_port = htons(V_Port)
.sin_addr = TADDRIN
End With
Dim TSock as Socket = opensocket(PF_INET, SOCK_STREAM, 0)
If TSock = INVALID_SOCKET Then
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
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 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 BV as Integer = connect(TSock, CPtr(SOCKADDR Ptr, @TADDR), SizeOf(SOCKADDR))
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
If connect(TSock, CPtr(SOCKADDR PTR, @TADDR), SizeOf(SOCKADDR)) = 0 Then Exit Do
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
#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)
If V_WaitThreadRunning = 1 Then
Dim TTot as Double = Timer() + V_TimeoutSecs
Do
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(R_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_InternalError
If TTot < Timer() Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_InternalError
If TSD->T_ThreadOn = 2 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
MutexUnLock(TSNE_INT_Mutex)
Sleep 1, 1
Loop
End If
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, ByVal V_WaitThreadRunning as UByte = 1) 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)
If V_WaitThreadRunning = 1 Then
Dim TTot as Double = Timer() + 60
Do
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(R_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_InternalError
If TTot < Timer() Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_InternalError
If TSD->T_ThreadOn = 2 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
MutexUnLock(TSNE_INT_Mutex)
Sleep 1, 1
Loop
End If
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, ByVal V_WaitThreadRunning as UByte = 1) 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
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
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)
If V_WaitThreadRunning = 1 Then
Dim TTot as Double = Timer() + 60
Do
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(R_TSNEID)
If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_InternalError
If TTot < Timer() Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_InternalError
If TSD->T_ThreadOn = 2 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
MutexUnLock(TSNE_INT_Mutex)
Sleep 1, 1
Loop
End If
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
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
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
Dim TTState as UInteger = TSD->T_ThreadOn
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
If TTState <> 2 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_UnstableState
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_WaitConnected(ByRef V_TSNEID as UInteger, V_TimeOut as UInteger = 60) as Integer
Dim TSD as TSNE_Socket Ptr
Dim TTot as Double = Timer() + V_TimeOut
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 TTot < Timer() Then Exit Do
If TSD->T_ThreadOn = 2 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_NoError
MutexUnLock(TSNE_INT_Mutex)
Sleep 10, 1
Loop
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_CantConnectToRemote
End Function
'--------------------------------------------------------------------------------------------------------------
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(Cast(UInteger, V_TSNEID)) & "]=[TSNE]=[EVT]= Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(Cast(UInteger, V_TSNEID)) & "]=[TSNE]=[EVT]= Lock-K"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Unlocked"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Event"
#ENDIF
If TSock = INVALID_SOCKET Then Exit Do
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Lock-K"
#ENDIF
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD = 0 Then MutexUnLock(TSNE_INT_Mutex): Exit Do
TSD->T_DataIn += TLenB
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Unlock"
#ENDIF
T = Mid(T, 1, Len(T) - 1)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Call... (" & Str(Len(T)) & ")"
#ENDIF
If TEvent.TSNE_NewData <> 0 Then TEvent.TSNE_NewData(TTSNEID, T)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-C]= Dat Call-K"
#ENDIF
End If
Loop
Else
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= Unlocked"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= ACP..."
#ENDIF
TNSock = accept(TSock, 0, 0)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= ACP:" & Str(TNSock)
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= BWL Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= BWL Lock-K"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]=[TCP-S]= BWL Unlock"
#ENDIF
End If
Loop
End If
Case Else: MutexUnLock(TSNE_INT_Mutex)
End Select
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit Lock"
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit Lock-K"
#ENDIF
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 DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit ThreadON 3"
#ENDIF
End If
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print "=[" & Str(TTSNEID) & "]=[TSNE]=[EVT]= Exit Unlocked"
#ENDIF
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 TSNE_Const_UnstableState: Return "Unstable Thread-State!"
Case TSNE_Const_InternalError: Return "Internal Error! Please contact support/programmer!"
Case Else: Return "Unknown GURU-Code [" & Str(V_GURUID) & "]"
End Select
End Function
'##############################################################################################################
'...<
#ENDIF