Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
PNE.bi - PMedia's Network Engine (Buggy)
| Uploader: |  PMedia |
| Datum/Zeit: | 03.12.2007 21:17:17 |
'' PNE - PMedia's Networking Engine
''
'' Go to http://pmedia.max06.de for other (maybe stupid?) things of him
''
'' in memory of TSN (RIP)
#ifdef __FB_WIN32__
#define supplat
#include "win/winsock.bi"
Sub StartWinsock() Constructor
Dim wsa As WSADATA
WSAStartup(MAKEWORD(2,0),@wsa)
End Sub
Sub EndWinsock Destructor
WSAcleanup()
End Sub
#Define closeSock(sock) closesocket(sock)
#endif
#ifdef __FB_DOS__
#error 0 This Engine is not usable unter DOS!
#endif
#ifndef supplat
#error 0 Unsupported platform. Sorry.
#endif
'' Enums
Enum Events
pneOnConnect
pneOnIncoming
pneOnDisconnect
End Enum
Enum ErrorLevel
none
warnings
critical
all
End Enum
Enum ErrorNr
No_Err
SocketCreateFailed
SocketBindFailed
SocketListenFailed
SelectFailed
NoOnConnectHandler
NoOnDisconnectHandler
NoOnIncomingHandler
TooManyConnections
End Enum
'' Types
Type pneConData
IP As Uinteger
Socket As Socket
End Type
Type pneServer
port As Ushort
ServerSocket As Socket
ServerIn As SOCKADDR_IN
MaxClients As Byte
ClientSockets(127) As pneConData
lastError As Uinteger
onConnect As Sub (ConData As pneConData)
onIncoming As Sub (Message As String, ConData As pneConData)
onDisconnect As Sub (ConData As pneConData)
threadID As Any Ptr
threadTerm As Ubyte
End Type
'' Global Variables
Dim Shared pneErrorLev As Uinteger
'' Subs
Declare Sub pneCreateServer(ServerSocket As pneServer, port As Ushort, maxconn As Integer)
Declare Sub pneDestroyServer(ServerSocket As pneServer)
Declare Sub pneBindEvent(ServerSocket As pneServer, Event As Integer, todo As Any Ptr)
Declare Sub pneErrorLevel(Level As Integer)
Declare Sub pneSendString(conData As pneConData, text As String)
Declare Sub pneEventhandler(ServerSocket As pneServer Ptr)
'' Functions
Declare Function pneGetIP_s(ConData As pneConData) As String
Declare Function pneGetIP_i(ConData As pneConData) As Integer
Declare Function pneDNS2IP(IP As Uinteger) As Integer
'' Sub Code's
Sub pneCreateServer(Byref ServerSocket As pneServer,Byval port As Ushort, Byval maxconn As Integer)
Dim rV As Integer
ServerSocket.ServerSocket = opensocket(AF_INET, SOCK_STREAM, IPPROTO_IP)
If (ServerSocket.ServerSocket = INVALID_SOCKET) Then
ServerSocket.LastError = SocketCreateFailed
Else
ServerSocket.ServerIn.sin_family = AF_INET
ServerSocket.ServerIn.sin_port = htons(port)
ServerSocket.ServerIn.sin_addr.s_addr = INADDR_ANY
rV = bind(ServerSocket.ServerSocket, Cptr(SOCKADDR Ptr, @ServerSocket.ServerIn), Sizeof(SOCKADDR_IN))
If (rv = SOCKET_ERROR ) Then
ServerSocket.LastError = SocketBindFailed
Else
#ifdef SOMAXCONN
If (maxconn > SOMAXCONN) Then
maxconn = SOMAXCONN
End If
#Endif
rV = listen(ServerSocket.ServerSocket, maxconn)
If (rv = SOCKET_ERROR ) Then
ServerSocket.LastError = SocketListenFailed
Else
ServerSocket.MaxClients = MaxConn
ServerSocket.threadID = Threadcreate ( @pneEventhandler, @ServerSocket)
End If
End If
End If
End Sub
Sub pneDestroyServer(Byref ServerSocket As pneServer)
Dim i As Integer
ServerSocket.threadTerm = 1
Threadwait(ServerSocket.threadID)
For i = Lbound(ServerSocket.Clientsockets) To Ubound(ServerSocket.Clientsockets)
If (ServerSocket.Clientsockets(i).socket <> 0) Then
closeSock(ServerSocket.Clientsockets(i).socket)
End If
Next
closeSock(ServerSocket.Serversocket)
End Sub
Sub pneBindEvent(ByRef ServerSocket As pneServer, Byval Event As Integer, Byval todo As Any Ptr)
if (Event=pneOnConnect) then
ServerSocket.onConnect = todo
Elseif (EVent = pneOnIncoming) then
ServerSocket.onIncoming = todo
Elseif (EVent = pneOnDisconnect) then
ServerSocket.onDisconnect = todo
End if
End Sub
Sub pneErrorLevel(Byval Level As Integer)
pneErrorLev = level
End Sub
Sub pneSendString(Byref conData As pneConData, Byref text As String)
send(conData.Socket,Strptr(text),Len(text),0)
End Sub
Sub pneEventhandler(ServerSocket As pneServer Ptr)
Dim TV As TimeVal
Dim fdset As fd_Set
Dim i As Integer
Dim j As Integer
Dim rV As Integer
Dim conData As pneConData
Dim tsockaddr as sockaddr_in
Dim BuffLen As Integer
Dim Buff As ZString * 8192
Dim BuffSize As Integer = 8192
Dim StrBuff As String
TV.tv_sec = 0
TV.tv_usec = 0
Do
j = 0
fdset.fd_array(0)=ServerSocket->ServerSocket
For i = Lbound(ServerSocket->Clientsockets) To Ubound(ServerSocket->Clientsockets)
If (ServerSocket->Clientsockets(i).socket <> 0) Then
fdset.fd_array(i+1) = ServerSocket->Clientsockets(i).socket
j += 1
End If
Next
fdset.fd_count = j + 1
rV=selectsocket(fdset.fd_count+1,@fdset,0,0,@tv)
If rV=SOCKET_ERROR Then
ServerSocket->LastError = SelectFailed
Elseif(FD_ISSET(ServerSocket->ServerSocket, @fdSet)) Then
Print "[DEBUG] New Connection"
If (ServerSocket->onConnect = 0) then
ServerSocket->LastError = NoOnConnectHandler
else
j = -1
For i = ServerSocket->MaxClients To Lbound(ServerSocket->Clientsockets) Step -1
If (ServerSocket->Clientsockets(i).socket = 0) Then
j = i
end if
Next
if (j <> -1) then
conData.socket = accept(ServerSocket->ServerSocket, 0, 0)
getpeername (conData.socket, cast(sockaddr Ptr, @tsockaddr), 16)
conData.ip = *inet_ntoa(tsockaddr.sin_addr)
ServerSocket->Clientsockets(i) = conData
ServerSocket->onConnect(conData)
else
conData.socket = accept(ServerSocket->ServerSocket, 0, 0)
ServerSocket->LastError = TooManyConnections
closeSock(conData.socket)
end if
end if
ElseIf rv = 0 then
Else
Print "[DEBUG] Incoming Data?"
For i = Lbound(ServerSocket->Clientsockets) To Ubound(ServerSocket->Clientsockets)
If (ServerSocket->Clientsockets(i).socket <> 0) Then
BuffLen = recv(ServerSocket->Clientsockets(i).socket, Strptr(Buff), BuffSize, 0)
If BuffLen <= 0 Then
Print "[DEBUG] Disconn"
If (ServerSocket->onDisConnect = 0) then
ServerSocket->LastError = NoOnDisConnectHandler
Else
ServerSocket->onDisConnect(conData)
End If
Else
Print "[DEBUG] Incoming Data!"
Buff[BuffLen] = 0
StrBuff = Buff
ConData = ServerSocket->Clientsockets(i)
ServerSocket->onIncoming(StrBuff, conData)
End If
End If
Next
End If
Sleep 10
Loop Until ServerSocket->ThreadTerm = 1
End Sub
'' Functions Code's
Function pneGetIP_s(Byref ConData As pneConData) As String
Dim As String Temp=Hex(ConData.IP, 8)
Return Str(Val("&h" &Chr(Temp[6], Temp[7]))) &"." _
&Val("&h" &Chr(Temp[4], Temp[5])) &"." _
&Val("&h" &Chr(Temp[2], Temp[3])) &"." _
&Val("&h" &Chr(Temp[0], Temp[1]))
End Function
Function pneGetIP_i(Byref ConData As pneConData) As Integer
Return ConData.IP
End Function