Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
privat ^^
| Uploader: |  max06 |
| Datum/Zeit: | 10.07.2007 18:46:27 |
Includes:
#ifdef __FB_WIN32__
#include once "win/winsock2.bi"
#else
#include once "crt/netdb.bi"
#include once "crt/sys/socket.bi"
#include once "crt/netinet/in.bi"
#include once "crt/arpa/inet.bi"
#include once "crt/unistd.bi"
#endif
Defines:
#define newline chr(13) + chr(10)
Declares:
Declare Function SubStr(byVal Liste As String, byVal Trenner As String, byVal Stelle As Long) As String
Declare Function Replace(byVal Text As String, byVal Suche As String, byVal ErsetzeMit As String) As String
Declare Function RecvText() As String
Declare Function resolveHost ( Byref hostname As String ) As Integer
Declare Sub Listener()
Declare Sub Reconnect()
Declare Sub SendText(sendbuffer As String)
Declare Sub DoInit()
Declare Sub DoShutdown()
Declare Sub tscalls(func As String, recieved As String)
Declare Sub playerlist()
Variables:
Dim Shared socket As socket
Dim Shared nick As String
Dim Shared pass As String
Dim Shared host As String
Dim Shared s As String
Dim Shared saccess As Integer
Dim Shared ip As Integer
Dim Shared sa As sockaddr_in
Dim Shared Message As String
Dim Shared As String var1, taste
#define newline chr(13) + chr(10)
Dim Shared As Integer server_selected = 0
Dim Shared As String playertable(1 To 16, 0 To 100)
SubsAndFunctions:
Sub Listener()
Do
s = ""
Do
s += recvText()
Loop Until Instr(s, newline)
saccess = 1
Do
Sleep 5
Loop Until saccess = 0
Loop Until Inkey = Chr(255) + "k"
End Sub
Sub tscalls(func As String, recieved As string)
Select Case func
Case "server_select"
If server_selected = 0 Then
If InStr(S, "[TS]") Then
Print "<login>"
SendText("slogin root changed"+NEWLINE)
Print "<server select>"
SendText("sel " + recieved + NEWLINE)
server_selected = 1
Sleep 50
End If
End If
Case "playerlist"
playerlist
End Select
End Sub
Sub playerlist()
Dim As Integer x, y
x=0
y=0
Print "<playerlist>"
saccess = 0
SendText("pl"+NEWLINE)
Sleep 50
Print "<Daten abholen>"
y=0:x=0
For y = 0 To 100
playertable(x, 0)=substr(s, ";", x)
If InStr(s, "OK") Then
Print "<schleife verlassen>"
y=100
Print "<Daten ausgeben>"
For y=0 To 100
For x=1 To 16
If playertable(1, y)<>"" Then
Print playertable(x, y),
EndIf
Next x
Next y
' For x = 1 To 16 Step 1
' sleep 50
' s=replace(S, chr(9), ";")
' playertable(x, y)=substr(s, ";", y)
' Sleep 50
' Next x
End if
Next y
Print "<fertig>"
Sleep 50
End Sub
Sub ReConnect()
If socket <> 0 Then
closesocket( socket )
End If
ip = resolveHost( host )
If( ip = 0 ) Then
Print "resolveHost(): invalid address"
End 1
End If
socket = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )
If( socket = 0 ) Then
Print "openSocket(): Something went wrong"
End 1
End If
sa.sin_port = htons( 51234 )
sa.sin_family = AF_INET
sa.sin_addr.S_addr = ip
If ( connect( socket, cast( PSOCKADDR, @sa ), Len( sa )) = SOCKET_ERROR ) Then
Print "connect(): Something went wrong"
closesocket( socket )
End 1
End If
End Sub
Sub SendText(sendbuffer As String)
If( send( socket, sendBuffer, Len( sendBuffer ), 0 ) = SOCKET_ERROR ) Then
Print "send(): Something went wrong"
closesocket( socket )
End 1
End If
End Sub
Function RecvText() As String
Dim recvbuffer As Zstring * 2
Dim bytes As Integer
bytes = recv( socket, recvBuffer, 1, 0 )
recvbuffer[bytes] = 0
Return RecvBuffer
End Function
Sub doInit
#ifdef __FB_WIN32__
'' init winsock
Dim wsaData As WSAData
If( WSAStartup( MAKEWORD( 1, 1 ), @wsaData ) <> 0 ) Then
Print "Error: WSAStartup failed"
End 1
End If
#Endif
End Sub
Sub doShutdown
#ifdef __FB_WIN32__
'' quit winsock
WSACleanup
#Endif
End Sub
Function resolveHost ( Byref hostname As String ) As Integer
Dim ia As in_addr
Dim hostentry As hostent Ptr
'' check if it's an ip address
ia.S_addr = inet_addr( hostname )
If ( ia.S_addr = INADDR_NONE ) Then
'' if not, assume it's a name, resolve it
hostentry = gethostbyname( hostname )
If ( hostentry = 0 ) Then
Exit Function
End If
Function = *cast( Integer Ptr, *hostentry->h_addr_list )
Else
'' just return the address
Function = ia.S_addr
End If
End Function
Function SubStr(byVal Liste As String, byVal Trenner As String, byVal Stelle As Long) As String
Dim As Long Aktuell=0, Ooops, ltr=Len(Trenner), Vorige=1, Gefunden
If Stelle=0 Or Liste="" Or Trenner="" Or Instr(Liste, Trenner)=0 Then Return ""
Do
Ooops=Gefunden
Gefunden=Instr(Gefunden+1, Liste, Trenner)
Aktuell-=Gefunden<>0
If Aktuell=Stelle-1 Then Vorige=Gefunden+ltr
If Aktuell=Stelle Then Exit Do
Loop Until Gefunden=0
If Stelle>Aktuell Then Return Mid(Liste, IIF(Stelle-Aktuell>1, Len(Liste)+1, Ooops+ltr)) &Chr(0)
Return Mid(Liste, Vorige, Gefunden-Vorige)
End Function
Function Replace(byVal Text As String, byVal Suche As String, byVal ErsetzeMit As String) As String
Dim s As String=Text, i As Long
While Instr(s, Suche)
i=Instr(s, Suche)
s=Left(s, i-1) &ErsetzeMit &Mid(s, i+Len(Suche))
Wend
Return s
End Function