Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
code
| Uploader: |  max06 |
| Datum/Zeit: | 09.07.2007 22:34:57 |
'main.bas
#Include "functions.bi"
Main:
Nick = "root"
Pass = "geheim"
Host = "85.114.130.202"
'Screenres 800, 600, 24
ThreadCreate(@Listener, 0)
DoInit()
ReConnect()
' SendText("JOIN #FREEBASIC.DE"+NEWLINE)
' SendText("PRIVMSG #FREEBASIC.DE :Hallo Welt!" + NEWLINE)
DO
if saccess = 1 then
s = replace(s,Newline, "")
' print S
tscalls("server_select", "8767")
tscalls("playerlist", "")
saccess = 0
End If
sleep 2000
taste=inkey
Loop Until instr(ucase(Message),"QUIT") OR taste = Chr(255) + "k" Or taste=Chr(27)
doshutdown()
'functions.bi
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)
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 passwort"+NEWLINE)
Print "<server select>"
SendText("sel " + recieved + NEWLINE)
server_selected = 1
Sleep 50
End If
End If
Case "playerlist"
Dim As Integer x, y
Print "<playerlist>"
saccess = 0
SendText("pl"+NEWLINE)
Sleep 50
s=replace(S, chr(9), ";")
Print "<Überschrift abholen>"
For x = 1 To 16 Step 1
playertable(x, 0)=substr(s, ";", x)
Next x
Print "<Daten abholen>"
For y = 1 To 100
For x = 1 To 16 Step 1
sleep 50
If InStr(s, "OK") Then
Print "<schleife verlassen>"
Exit For
End if
s=replace(S, chr(9), ";")
playertable(x, y)=substr(s, ";", y)
Next x
Next y
Print "<Daten ausgeben>"
For x=1 To 16
For y=0 To 100
Print playertable(x, y)
Next x
Next y
End Select
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