Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Pre Schare
| Uploader: |  jakidomi |
| Datum/Zeit: | 24.08.2009 15:01:07 |
#include once "TSNE_V3.bi"
#include once "explorer.bi"
Type data_Client_Type 'Ein UDT welches die einzelnen Verbindungen und deren Parameter hält
V_InUse as UByte 'Wird verwendet um zu überprüfen ob der Eintrag belegt ist
V_TSNEID as UInteger 'Speicher die TSNEID der Verbindung
V_IPA as String 'Die IP der Verbindung
V_ConTime as Double 'Hier speichern wir die Uhrzeit des verbindungsaufbaus ab
V_Data as String 'Speicher die eingehenden Daten zwischen, (Blocktransfer)
End Type
type server_Type
port as ushort
id as uinteger
inuse as boolean
max_clients as ushort
sdata as string
rdata as string
con as boolean
mutex as any ptr
RV as long
ClientC as ushort
end type
type client_Type
port as ushort
id as uinteger
inuse as boolean
sdata as string
rdata as string
timeout as uinteger
con as boolean
mutex as any ptr
RV as long
ip as string
end type
?"[Init]"
dim shared as server_Type server
dim shared as client_Type client
dim shared as data_client_type sclient()
declare sub server_Disconnected (ByVal V_TSNEID as UInteger)
declare sub server_Connected (ByVal V_TSNEID as UInteger)
declare sub server_NewConnection (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
declare sub server_NewConnectionCanceled (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
declare sub server_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
declare sub server_SendData (byval S_Data as String="")
declare sub client_Disconnected (ByVal V_TSNEID as UInteger)
declare sub client_Connected (ByVal V_TSNEID as UInteger)
declare sub client_NewConnection (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
declare sub client_NewConnectionCanceled (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
declare sub client_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
declare sub client_SendData (byval S_Data as String="")
declare sub run_server()
declare sub run_client()
declare sub stop_server()
declare sub stop_client()
declare sub main()
declare sub main_proc()
declare function exit_event() as boolean
server.inuse=true
server.port=8000
server.max_clients=100
client.inuse=true
client.port=8000
client.timeout=5 'sek
client.ip="127.0.0.1"
dim as any ptr thr
'thr=ThreadCreate(Cast(Any Ptr,@main))
do
sleep 1,1
loop until server.con=true or multikey(&h1)
screen 18,32
do
screenlock
cls
?"Hallo"
?"Es ist: "+time
screenunlock
sleep 1000,1
loop until server.con=false or multikey(&h1)
threadwait(thr)
main
'SUBS
Sub Server_Connected(ByVal V_TSNEID as UInteger) 'Empfänger für das Connect Signal (Verbindung besteht)
MutexLock(server.Mutex)
For X as UInteger = 1 to server.ClientC 'Wir gehen alle Array-Elemente durch
If sClient(X).V_InUse = 1 Then 'Wird das Element verwendetsendviews
If sClient(X).V_TSNEID = V_TSNEID Then 'Ist das Element das gesuchtesendviews
sClient(X).V_ConTime = Timer() 'Wir speichern die aktuelle Uhrzeit ab
consprint "[CLIENT1] Connected >" & X & "<" 'und ausgeben das die client-verbindung vollständig hergestellt wurde
MutexUnLock(server.Mutex) 'Mutex Sperre kann jetz taufgehoben werden, da es sonst zu einem MUTEX Leak kommt wenn wir die Sub direkt verlassen
if server.sdata<>"" then
Dim BV as Integer = TSNE_Data_Send(V_TSNEID, server.sdata)
If BV <> TSNE_Const_NoError Then
Print "[FEHLER] " & TSNE_GetGURUCode(BV) 'Fehler ausgeben
TSNE_Disconnect(V_TSNEID)
exit sub
End If
endif
Exit Sub 'Sub direkt verlassen
End If
End If
Next
MutexUnLock(server.Mutex) 'Mutex Sperren aufheben
consprint "[CLIENT1] [CON] [ERROR] TSNEID Not found in Client-Array" 'Wir haben kein passendes Element gefunden und geben das aus.
End Sub
Sub server_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String) 'Empfänger für neue Daten
Dim CIndex as UInteger 'Eine Variable erstellen welche ein Array-Index speichert
Dim RV as Long 'Die Statusrückgabe variable
MutexLock(server.Mutex) 'Mutex Sperren um auf das Array zugreifen zu können
For X as UInteger = 1 to server.ClientC 'Wir gehen alle Array-Elemente durch
If sClient(X).V_InUse = 1 Then 'Wird das Element verwendetsendviews
If sClient(X).V_TSNEID = V_TSNEID Then 'Ist das Element das gesuchtesendviews
CIndex = X 'Wir speichern das Gefundene Index ab
Exit For 'und vrlassen die For-Schleife
End If
End If
Next
If CIndex = 0 Then 'wurde das Element nicht gefundensendviews
MutexUnLock(server.Mutex) 'Dann Mutex entsperren
consprint "[CLIENT1] [ERROR] TSNEID Not found in Client-Array" 'Wir haben kein passendes Element gefunden und geben das aus.
MutexUnLock(server.Mutex)
Exit Sub 'anschliessend SUB verlassen
End If
Dim TData as String = sClient(CIndex).V_Data & V_Data 'Die eingehenden Daten hängen wir an die bestehenden an und speichern dies in eine Temporäre Variable
dim as string vdata=v_data
sClient(CIndex).V_Data = "" 'Die Bereits vorhandenen Daten werden gelöscht. Sollten noch welche übrig bleiben, beim Parsen können wir diese wieder hinzufügen.
consprint "[CLIENT "+sClient(CIndex).V_IPA+"] DATA >" & CIndex & "< -->"+tdata 'Wir haben Daten erhalten udn geben diesen Zustand aus.
MutexUnLock(server.Mutex) 'Mutex Sperren aufheben
'Neue Daten an die bereits vorhandenen anhängen
server.rdata += V_Data
End Sub
sub server_Disconnected (ByVal V_TSNEID as UInteger)
MutexLock(server.Mutex) 'Mutex Sperren um auf das Array zugreifen zu können
dim cindex as integer
For X as UInteger = 1 to server.ClientC 'Wir gehen alle Array-Elemente durch
If sClient(X).V_InUse = 1 Then 'Wird das Element verwendetsendviews
If sClient(X).V_TSNEID = V_TSNEID Then 'Ist das Element das gesuchtesendviews
cindex=x
sClient(X).V_InUse = 0 'Da dieses Element nun nicht mehr gebraucht wird können wir dieses als 'Nicht in nutzung' markieren
sClient(X).V_Data = "" 'Daten-variable leeren. Verbraucht nur speicher
consprint "[CLIENT] Disconnected >" & X & "<" 'und ausgeben das wir die verbindung beendet haben
sClient(CIndex).V_ConTime=timer
MutexUnLock(server.Mutex) 'Mutex Sperre kann jetz taufgehoben werden, da es sonst zu einem MUTEX Leak kommt wenn wir die Sub direkt verlassen
Exit Sub 'Sub direkt verlassen
End If
End If
Next
MutexUnLock(server.Mutex) 'Mutex Sperren aufheben
end sub
sub server_NewConnection (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
Dim TNewTSNEID as UInteger 'Eine Variable welche die Neue TSNEID beinhaltet
Dim TReturnIPA as String 'Eine Variable welche die IP-Adresse des clienten beinhaltet
Dim CIndex as UInteger 'Eine Variable erstellen welche einen freien Array index speichert
Dim RV as Long 'Die Statusrückgabe variable
MutexLock(server.Mutex) 'Mutex Sperren um auf das Array zugreifen zu können
For X as UInteger = 1 to server.ClientC 'Wir gehen alle Array-Elemente durch
If sClient(X).V_InUse = 0 Then 'Haben wir ein Freies Element gefunden
CIndex = X 'Dann diesen Index abspeichern
Exit For 'Und schleife verlassen
End If
Next
If CIndex = 0 Then 'Haben wir kein freies Feld gefundensendviews
If server.ClientC >= server.max_clients Then 'Haben wir noch platz für einen Client oder wurde schon unser definiertes Maximum erreichsendviews
consprint "[CLIENT1] FULL!!! IPA:" & V_IPA 'Wir zeigen an, das usner Server voll ist. und geben die IPA aus.
RV = TSNE_Create_Accept(V_RequestID, TNewTSNEID, TReturnIPA, 0, 0, 0) 'Da wir kein Platz mehr haben akzeptieren wir pauschal die verbindung ohne Callback-sub's anzugeben (werden sowieso nicht benötigt).
If RV <> TSNE_Const_NoError Then 'Gab es einen Fehler beim 'Accept'consprint
consprint "[CLIENT1] [FEHLER] " & TSNE_GetGURUCode(RV) 'Dann geben wir diesen aus
MutexUnLock(server.Mutex) 'Entsperren das Mutex
Exit Sub 'und verlassen auf direktem wege die sub
End If
RV = TSNE_Data_Send(TNewTSNEID, "Der Server 1 hat keinen Platz mehr für dich Frei!") 'Selbstverständlich informieren wir den Clienten über diesen Zustand (Bei unterschiedlichen Protokollen muss dies angepast werden)
If RV <> TSNE_Const_NoError Then 'Gab es einen Fehler beim 'Send'consprint
consprint "[CLIENT1] [FEHLER] " & TSNE_GetGURUCode(RV) 'Dann geben wir diesen aus jedoch ohne die Sub zu verlassen, da die Verbindung noch bestehen könnte
End If
TSNE_Disconnect(TNewTSNEID) 'Zum schluss beenden wir die Verbindung, da sie sowieso nicht von uns weiter verwaltet wird.
MutexUnLock(server.Mutex) 'Noch das MUTEX entsperren
Exit Sub 'und die Sub auf direktem wege verlassen
End If
server.ClientC += 1 'Ist noch Platz frei erstellen wir ein neues Element
Redim Preserve SClient(server.ClientC) as Data_Client_Type 'Und redimensionieren (mit 'Preserve' für das erhalten der anderen Element-daten) das Array
CIndex = server.ClientC 'Als Freien Index geben wir das neue Element an
End If
RV = TSNE_Create_Accept(V_RequestID, TNewTSNEID, TReturnIPA, @server_Disconnected, @server_Connected, @server_NewData) 'Da wir noch platz haben akzeptieren wir die verbindung mit den Callbacks
If RV <> TSNE_Const_NoError Then 'Gab es einen Fehler beim 'Accept'consprint
consprint "[CLIENT1] [FEHLER] " & TSNE_GetGURUCode(RV) 'Dann geben wir diesen aus
MutexUnLock(server.Mutex) 'Entsperren das Mutex
Exit Sub 'und verlassen auf direktem wege die sub
End If
With SClient(CIndex) 'Kein fehler entsandensendviews dann das freie Element selektieren
.V_InUse = 1 'und markieren es als 'In Nutzung'
.V_TSNEID = TNewTSNEID 'TSNEID der neuen Verbindung speichern
.V_IPA = V_IPA 'Die IPA (IP-Adresse) der neuen Verbindung speichern
.V_ConTime = 0 'Wir sind noch nicht ganz verbunden (Connect-event fehltnoch) darum Zeit auf 0 setzen
.V_Data = "" 'Daten Variable leeren. Könnte durch eine vorherige verbindung noch gefüllt sein
End With
consprint "[CLIENT1] New Connect at server 1>" & CIndex & "< IPA:" & V_IPA 'Anzeigen das Verbindung akzeptiert wurde.
MutexUnLock(server.Mutex) 'Mutex Sperren aufheben
end sub
sub server_NewConnetction_canceled (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
consprint "[CLIENT] Request Blocked IPA:" & V_IPA 'Anzeigen das Verbindungsanfrage Blockiert wurde
end sub
sub server_SendData (byval S_Data as String="")
if s_data<>"" then
Dim BV as Integer = TSNE_Data_Send(server.id, S_Data)
If BV <> TSNE_Const_NoError Then
Print "S [FEHLER] " & TSNE_GetGURUCode(BV) 'Fehler ausgeben
TSNE_Disconnect(server.id)
server.con=false
exit sub
End If
elseif server.sdata<>"" then
Dim BV as Integer = TSNE_Data_Send(server.id, server.SData)
If BV <> TSNE_Const_NoError Then
Print "S [FEHLER] " & TSNE_GetGURUCode(BV) 'Fehler ausgeben
TSNE_Disconnect(server.id)
server.con=false
exit sub
End If
endif
server.con=true
end sub
Sub client_Connected(ByVal V_TSNEID as UInteger) 'Empfänger für das Connect Signal (Verbindung besteht)
if client.sdata<>"" then
Dim BV as Integer = TSNE_Data_Send(V_TSNEID, client.sdata)
If BV <> TSNE_Const_NoError Then
Print "[FEHLER] " & TSNE_GetGURUCode(BV) 'Fehler ausgeben
TSNE_Disconnect(V_TSNEID)
client.con=false
exit sub
End If
endif
client.con=true
End Sub
Sub client_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String) 'Empfänger für neue Daten
'Neue Daten an die bereits vorhandenen anhängen
client.rdata += V_Data
consprint V_DATA
End Sub
sub client_Disconnected (ByVal V_TSNEID as UInteger)
client.con=false
end sub
sub client_NewConnection (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
end sub
sub client_NewConnetction_canceled (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
end sub
sub client_SendData (byval S_Data as String="")
if s_data<>"" then
Dim BV as Integer = TSNE_Data_Send(client.id, S_Data)
If BV <> TSNE_Const_NoError Then
Print "C [FEHLER] " & TSNE_GetGURUCode(BV) 'Fehler ausgeben
TSNE_Disconnect(client.id)
client.con=false
exit sub
End If
elseif client.sdata<>"" then
Dim BV as Integer = TSNE_Data_Send(client.id, client.SData)
If BV <> TSNE_Const_NoError Then
Print "C [FEHLER] " & TSNE_GetGURUCode(BV) 'Fehler ausgeben
TSNE_Disconnect(client.id)
client.con=false
exit sub
End If
endif
client.con=true
end sub
sub run_server()
if server.inuse=true and 0<server.port<60000 and server.max_clients>0 then
beep
server.mutex = MutexCreate() 'Ein neues MUTEX erstellen
Print "[SERVER] Init..." 'Signalisieren das wir den Server jetzt inizialisieren
server.RV = TSNE_Create_Server(server.id, server.port, server.max_clients, @server_NewConnection, @server_NewConnetction_canceled) 'Server erstellen
If server.RV <> TSNE_Const_NoError Then 'Prüfen ob dabei Fehler entstanden sind
Print "[SERVER] [FEHLER] " & TSNE_GetGURUCode(server.RV) 'Irgend ein Fehler trat beim erstellen des Server auf
MutexDestroy(server.Mutex) 'MUTEX zerstören. Wird jetzt nimmer gebraucht
Print "[END]" 'Wir sind fertig
getkey
End 0 'Und beenden das Programm mit dem Returncode: 0
End if
server.RV = TSNE_BW_SetEnable(server.id, TSNE_BW_Mode_Black) 'Wir aktivieren eine IPA-Blockliste des Types: BlackList (Alle IPAs in der Liste werden blockiert)
If server.RV <> TSNE_Const_NoError Then 'Prüfen ob dabei Fehler entstanden sind
Print "[SERVER] [FEHLER] BWL: " & TSNE_GetGURUCode(server.RV) 'Irgend ein Fehler trat beim erstellen des BWL auf
MutexDestroy(server.Mutex) 'MUTEX zerstören. Wird jetzt nimmer gebraucht
Print "[END]" 'Wir sind fertig
End 0 'Und beenden das Programm mit dem Returncode: 0
End If
Print "[SERVER]("+str(server.id)+") at "+str(server.port)+" OK!" 'Wenn nicht, dann ausgaben das alle OK war
consprint "Server run"
server.con=true
endif
end sub
sub run_client()
if client.inuse and 0<client.port<60000 and 0<client.timeout<360 and client.ip<>"" then
client.rv=TSNE_Create_Client(Client.id, client.ip,client.port, @client_Disconnected, @client_Connected, @client_NewData, 60)
If client.rv <> TSNE_Const_NoError Then
Print "[FEHLER] " & TSNE_GetGURUCode(client.rv) 'Fehler ausgeben
TSNE_Disconnect(client.id)
client.con=false
exit sub
End If
client_sendData "Hello server"+nl+"Conection:Keep-alive"
consprint "Client run"
endif
end sub
sub stop_server()
dim as integer x,tid
For X = 1 to server.ClientC 'Alle clienten im UDT durchgehen
If sClient(X).V_InUse = 1 Then 'Wird das Element verwendetsendviews
TID = sClient(X).V_TSNEID 'Wir hohlen die TSNEID der Verbindung udn speichern sie zwischen
MutexUnLock(server.Mutex) 'Da wir jetzt die CLientverbindung trennen wird auch das Disconnect event aufgerufen. Darum Müssen wir das MUTEX entsperren
TSNE_Disconnect(TID) 'Verbindung trennen
MutexLock(server.Mutex) 'MUTEX wieder sperren um nächstes element zu prüfen
End IF
Next
consprint str(x-1)+" Clients Kicked"
server.RV = TSNE_Disconnect(server.id) 'Server-Socket beenden
If server.RV <> TSNE_Const_NoError Then consprint "[SERVER 1] [FEHLER] " & TSNE_GetGURUCode(server.RV) 'Wenn ein Fehler entstand, dann geben wir diesen aus
consprint "[SERVER 1] Wait disconnected..." 'Ausgeben das wir trotzdem auf den Disconnect warten
TSNE_WaitClose(server.id) 'Wir warten auf das ende der serververbindung
sleep 50,1
consprint "[SERVER 1] Disconnected!" 'Server wurde beendet
MutexDestroy(server.Mutex) 'MUTEX zerstören. Wird jetzt nimmer gebraucht
consprint "Server stoped"
server.con=false
end sub
sub stop_client()
TSNE_Disconnect(client.id)
consprint "Client stoped"
end sub
sub main_proc()
shell "cls"
consprint "Hallo"
consprint "Es ist: "+time
consprint str(server.con)
end sub
function exit_event() as boolean
if multikey(&h1) then
return true
elseif ascinkey=255107 then
return true
else
return false
endif
end function
sub main()
run_server
run_client
sleep 200,1
client_sendData "Test"
do
Main_proc
sleep 1,1
loop until exit_event=true
cls
stop_server
stop_client
sleep 3000,1
end sub