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: | 07.11.2008 08:46:35 |
'#####################################################################################################
'#####################################################################################################
' TSNE_V3 - TCP Socket Networking [Eventing] Version: 3.0 (0.18.5)
'#####################################################################################################
'#####################################################################################################
' 2008 By.: /_\ DeltaLab's - Deutschland
' Autor: Martin Wiemann
'#####################################################################################################
'##############################################################################################################
#include once "crt/errno.bi"
#IF DEFINED(__FB_LINUX__)
#INCLUDE once "crt/stdlib.bi"
#INCLUDE once "crt/unistd.bi"
#INCLUDE once "crt/sys/types.bi"
#INCLUDE once "crt/sys/socket.bi"
#INCLUDE once "crt/netinet/in.bi"
#INCLUDE once "crt/arpa/inet.bi"
#INCLUDE once "crt/netdb.bi"
#include once "crt/sys/select.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
Private Sub StartWinsock() CONSTRUCTOR
Dim xwsa as WSADATA
WSAStartup(MAKEWORD(2, 0), @xwsa)
End Sub
Private Sub EndWinsock DESTRUCTOR
WSAcleanup()
End Sub
#ELSE
#error "Unsupported platform"
#ENDIF
#INCLUDE once "crt/sys/time.bi"
#INCLUDE once "crt/fcntl.bi"
'##############################################################################################################
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 = 20000
'--------------------------------------------------------------------------------------------------------------
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
'--------------------------------------------------------------------------------------------------------------
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)
End Type
'##############################################################################################################
Private Type TSNE_BWL_Type
V_Next as TSNE_BWL_Type Ptr
V_Prev as TSNE_BWL_Type Ptr
V_IPA as String
End Type
'--------------------------------------------------------------------------------------------------------------
'##############################################################################################################
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_IsServer as Integer
V_IPA as String
V_Port as UShort
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) 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, ByVal V_Event_ConPTR as Any Ptr, ByVal V_Event_NewDataPTR as Any Ptr, ByVal V_TimeoutSecs as UInteger = 60) 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, ByVal V_Event_ConPTR as Any Ptr, ByVal V_Event_NewDataPTR as Any Ptr) as Integer
Declare Function TSNE_Data_Send (ByRef V_TSNEID as UInteger, ByRef V_Data as String, ByRef R_BytesSend as UInteger = 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) 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 Return TPtr
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) 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
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
MutexLock(TSNE_INT_Mutex_Master)
TSNE_INT_Thread_Master_Ptr = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Master))
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)
MutexDestroy(TSNE_INT_Mutex_Master)
MutexDestroy(TSNE_INT_Mutex)
End Sub
'##############################################################################################################
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
MutexLock(TSNE_INT_Mutex)
TPtr = TSNE_INT_D
Do Until TPtr = 0
TNPtr = TPtr->V_Next
If TPtr->T_ThreadOn = 3 Then
TPtr->T_ThreadOn = 4
TThPtr = TPtr->T_Thread
TID = TPtr->V_TSNEID
TEvent = TPtr->V_Event
MutexUnLock(TSNE_INT_Mutex)
ThreadWait(TThPtr)
If TEvent.TSNE_Disconnected <> 0 Then TEvent.TSNE_Disconnected(TID)
TSNE_INT_Del(TPtr)
MutexLock(TSNE_INT_Mutex)
End If
TPtr = TNPtr
Loop
MutexLock(TSNE_INT_Mutex_Master)
If TSNE_INT_Thread_Master_Close = 1 Then If TSNE_INT_D = 0 Then MutexUnLock(TSNE_INT_Mutex): MutexUnLock(TSNE_INT_Mutex_Master): Exit Sub
MutexUnLock(TSNE_INT_Mutex_Master)
MutexUnLock(TSNE_INT_Mutex)
Sleep 1, 1
Loop
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_Disconnect(ByRef V_TSNEID as UInteger) 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
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)
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) 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
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 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_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), TSNE_INT_StackSize)
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, ByVal V_Event_ConPTR as Any Ptr, ByVal V_Event_NewDataPTR as Any Ptr, ByVal V_TimeoutSecs as UInteger = 60) 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
Dim XHost as hostent Ptr
Dim TADDRIN as in_addr
TADDRIN.s_addr = inet_addr(StrPtr(V_IPA))
If (TADDRIN.s_addr = -1) Then
XHost = gethostbyname(StrPtr(V_IPA))
If XHost = 0 Then Return TSNE_Const_CantResolveIPfromHost
TADDRIN = *Cast(in_addr Ptr, XHost->h_addr_list[0])
If TADDRIN.s_addr = INADDR_NONE Then Return TSNE_Const_CantResolveIPfromHost
End If
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 Return TSNE_Const_CantCreateSocket
#IF DEFINED(__FB_LINUX__)
Dim XFlag as Integer = fcntl(TSock, F_GETFL, 0)
If XFlag = -1 Then Return TSNE_Const_ReturnErrorInCallback
If fcntl(TSock, F_SETFL, XFlag or O_NONBLOCK) = -1 Then 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 Then Return TSNE_Const_CantConnectToRemote
If Not (FD_ISSET(TSock, @TFDSet)) Then 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_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), TSNE_INT_StackSize)
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, ByVal V_Event_ConPTR as Any Ptr, ByVal V_Event_NewDataPTR as Any Ptr) as Integer
Dim TADDR as SOCKADDR_IN
Dim XSize as Integer = 16
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_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), TSNE_INT_StackSize)
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) 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
MutexUnLock(TSNE_INT_Mutex)
Dim XTemp as String = V_Data
Dim XLen as UInteger = Len(XTemp)
Dim BV as Integer
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
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
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 1, 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 Return 1
If TSD->T_ThreadOn = 0 Then Return 1
MutexUnLock(TSNE_INT_Mutex)
Return 0
End Function
'##############################################################################################################
Private Sub TSNE_INT_Thread_Event(V_TSNEID as Any Ptr)
MutexLock(TSNE_INT_Mutex)
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 T as String
TSD->T_ThreadOn = 2
If TSD->V_IsServer <> 1 Then
MutexUnLock(TSNE_INT_Mutex)
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
If (FD_ISSET(TSock, @TFDSet)) <> 0 Then
If TSock = INVALID_SOCKET Then Exit Do
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)
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)
If TEvent.TSNE_NewData <> 0 Then TEvent.TSNE_NewData(TTSNEID, T)
End If
Loop
Else
MutexUnLock(TSNE_INT_Mutex)
Dim TNSock as Socket
Dim TIPA as String
Dim TADDR as SOCKADDR_IN
Dim XSize as Integer = SizeOf(sockaddr_in)
Dim Y as UInteger
Dim XOK as Integer
Dim XFX as UInteger
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 Exit Do
If (FD_ISSET(TSock, @TFDSet)) Then
TNSock = accept(TSock, 0, 0)
IF TNSock = INVALID_SOCKET Then Exit Do
TIPA = ""
If getpeername (TNSock, Cast(sockaddr Ptr, @TADDR), @XSize) = 0 Then TIPA = *inet_ntoa(TADDR.sin_addr)
MutexLock(TSNE_INT_Mutex)
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
End If
Loop
End If
MutexLock(TSNE_INT_Mutex)
TSD = TSNE_INT_GetPtr(TTSNEID): If TSD <> 0 Then TSD->T_ThreadOn = 3
MutexUnLock(TSNE_INT_Mutex)
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) 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) = 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
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 "Unknow error"
Case TSNE_Const_NoError: Return "No error"
Case TSNE_Const_UnknowEventID: Return "Unknow 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 Else: Return "Unknow GURU-Code"
End Select
End Function