Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
PNE :: include/pne/pne.mod.server.bi
| Uploader: |  PMedia |
| Datum/Zeit: | 05.12.2007 15:07:49 |
Type server
listenerSocket As Socket
slots(0 To 63) As Socket
writb(0 To 63) As String
readb(0 To 63) As String
reabm(0 To 63) As Any Ptr
wribm(0 To 63) As Any Ptr
Port As Ushort
MaxConnCnt As Uinteger
lastError As Uinteger
started:1 As Ubyte
mode As Ubyte
ahand_exit:1 As Ubyte
aread_exit:1 As Ubyte
awrit_exit:1 As Ubyte
async_handlr As Any Ptr
async_reader As Any Ptr
async_writer As Any Ptr
datainbuffer:1 As Ubyte
onNewClient As Sub(slotid As Uinteger)
onClientLost As Sub(slotid As Uinteger)
onReceive As Sub(slotid As Uinteger, message As String)
onError As Sub()
Declare Sub startServer(Port As Ushort, MaxConnCnt As Uinteger)
Declare Sub stopServer()
Declare Sub bindEvent( Event As Uinteger, Adress As Any Ptr)
Declare Sub Answer(slot As Uinteger, message As String)
Declare Function GetLastError(LangCode As String) As String
Declare Function SlotIPs(SlotID As Uinteger) As String
Declare Constructor
Declare Destructor
End Type
'===============================================================================
Declare Sub AsyncServerEventhandler(cdata As server Ptr)
Declare Sub AsyncServerWriter(cdata As server Ptr)
Declare Sub AsyncServerReader(cdata As server Ptr)
'-------------------------------------------------------------------------------
Sub AsyncServerEventhandler(cdata As server Ptr)
Dim I As Integer
Dim PreviousError As Integer
Do
sleep 10
If (PreviousError <> cdata->lastError) then
previousError = cdata->lastError
If (cdata->onError <> 0) then
cdata->onError()
end if
end if
Loop Until cdata->aread_exit = 1
End Sub
Sub AsyncServerWriter(cdata As server Ptr)
Dim I As Integer
Do
Sleep 10
If (cdata->started = 1) Then
for I = Lbound(cdata->slots) To Lbound(cdata->slots)
Mutexlock cdata->wribm(i)
If (Len(cdata->writb(i)) <> 0) Then
If (cdata->mode = mode_tcp) Then
If (send( cdata->slots(i), cdata->writb(i), Len( cdata->writb(i) ), 0 ) = SOCKET_ERROR) Then
cdata->lasterror = WRITE_FAILED
Else
cdata->writb(i) = ""
End If
End If
End If
Mutexunlock cdata->wribm(i)
next
End If
Loop Until cdata->awrit_exit = 1
End Sub
Sub AsyncServerReader(cdata As server Ptr)
Dim I As Integer
Do
sleep 10
Loop Until cdata->aread_exit = 1
End Sub
'===============================================================================
Constructor server ()
Dim i As Integer
For i = Lbound(this.slots) To Lbound(this.slots)
this.wribm(i) = Mutexcreate
this.reabm(i) = Mutexcreate
Next
this.async_handlr = Threadcreate(cast(Any Ptr, @AsyncServerEventhandler), @this)
this.async_reader = Threadcreate(cast(Any Ptr, @AsyncServerWriter), @this)
this.async_writer = Threadcreate(cast(Any Ptr, @AsyncServerReader), @this)
End Constructor
Destructor server()
Dim i As Integer
If (this.started = 1) Then
this.stopserver()
End If
this.ahand_exit=1
this.aread_exit=1
this.awrit_exit=1
Threadwait(this.async_handlr)
Threadwait(this.async_reader)
Threadwait(this.async_writer)
For i = Lbound(this.slots) To Lbound(this.slots)
Mutexdestroy this.wribm(i)
Mutexdestroy this.reabm(i)
Next
End Destructor
Sub server.startServer(Port As Ushort, MaxConnCnt As Uinteger)
Dim SockIn As SOCKADDR_IN
Dim rV As Uinteger
If (this.started = 0) Then
If (this.mode = mode_tcp) Then
this.listenerSocket = opensocket(AF_INET,SOCK_STREAM,IPPROTO_IP)
If this.listenerSocket = INVALID_SOCKET Then
this.lastError = OPENSOCKET_FAILED
Else
this.port = port
sockIn.sin_family = AF_INET
sockIn.sin_port = htons(this.Port)
sockIn.sin_addr.s_addr = INADDR_ANY
rV = bind(this.listenerSocket, Cptr(SOCKADDR Ptr, @sockIn), Sizeof(SOCKADDR_IN))
If (rV = SOCKET_ERROR) Then
this.lastError = BIND_FAILED
Else
rV = listen(this.listenersocket, 10)
If (rV = SOCKET_ERROR ) Then
this.lastError = CREATE_LISTENER_FAILED
Else
this.started = 1
End If
End If
End If
End If
Else
this.lastError = CONNECT_ALREADYCONNECTED
End If
End Sub
Sub server.stopServer()
Dim i As Integer
closesocket(this.listenerSocket)
For i = Lbound(this.slots) To Ubound(this.slots)
closesocket(this.slots(i))
Next i
End Sub
Sub server.bindEvent( Event As Uinteger, Adress As Any Ptr)
Select Case Event
Case e_onNewClient
this.onNewClient = Adress
Case e_onClientLost
this.onClientLost = Adress
Case e_onReceive
this.onReceive = Adress
Case e_onError
this.onError = Adress
Case e_onConnect
this.lastError = NON_MATCHING_EVENTCODE
Case e_onDisconnect
this.lastError = NON_MATCHING_EVENTCODE
Case Else
this.lasterror = UNKOWN_EVENTCODE
End Select
End Sub
Function Server.SlotIPs(SlotId As Uinteger) As String
Dim addr As SOCKADDR_IN
Dim sz As Uinteger = 16
If (this.slots(slotid) <> 0) Then
If getpeername (this.slots(slotid), cast(sockaddr Ptr, @addr), @sz) = 0 Then
Return *inet_ntoa(addr.sin_addr)
Else
this.lastError = SOCKET_CLOSED
Return "0.0.0.0"
End If
Else
this.lastError = SOCKET_CLOSED
Return "0.0.0.0"
End If
End Function
Function server.GetLastError( LangCode As String = "EN" ) As String
Select Case LangCode
Case Else
Select Case this.lasterror
Case NO_ERR
Return "No Error"
Case CONNECT_HOSTNOTFOUND
Return "Failed to establish connection: Host not found"
Case CONNECT_FAILED
Return "Connection failed"
Case CONNECT_ALREADYCONNECTED
Return "Could not create new connection: you're already connected"
Case OPENSOCKET_FAILED
Return "OpenSocket() failed. Please check your local system librarys and socket support"
Case READ_FAILED
Return "recv() failed"
Case RESOLVE_HOSTNOTFOUND
Return "Could not resolve host"
Case WRITE_FAILED
Return "Could not write data to destination"
Case UNKOWN_EVENTCODE
Return "BindEvent() failed: unkown eventcode."
Case NON_MATCHING_EVENTCODE
Return "You're using an eventcode that doesn't work with this class."
Case UNKOWN_MODE
Return "You're using an unkown transfer-mode."
Case BIND_FAILED
Return "Bind() failed"
Case Else
Return "Unkown Error"
End Select
End Select
End Function