Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
IM- Server. FINAL.
| Uploader: |  raph ael |
| Datum/Zeit: | 17.03.2008 19:36:07 |
'- iIIM Server -
'Autor: Raphael R.
'visit http://raphaelr.piranho.de
/'
Aufbau des IIMP (Insane Instant Messaging Protocol)
----------------------------------------------------
i:0|1 Invisible
a:0|1 Away
s:status Anderen Status setzen
m:message Nachricht setzen
l:code:who Überprüft, ob der ID- Code von who code ist. 1 oder 0.
y:code Eigenen Code setzen.
p:what:who Nachricht what an who senden
n:what:who Notice what an who senden
f:what:who Info what an who senden
d:0|1 DnD ein/aus
r:who Daten zu who anzeigen
j:name Nickname setzen. Geht genau 1x.
r:who gibt zurück:
1:name
2:status
3:message
4:away
Ein Doppelpunkt(:) muss escaped werden mit "\:".
Ein Backslash(\) muss escaped werden mit "\\".
\: muss escaped werden mit "\\\:".
:\ muss escaped werden mit "\:\\".
Nachrichten, Notices und Infos:
Nachrichten sind halt Gespräche zwischen 2 Personen. Notices sind eigentlich das
selbe, aber der Client kann unterschiedlich darauf reagieren und bei Notices z.B.
kein neues Fenster öffnen.
Infos sind Nachrichten an den Client. Es gibt keinen Speziellen Standard dafür. Nur
der Client muss die Info verstehen.
Jedes andere Kommando, welches nicht oben gelistet wurde, wird vom Server mit einer
"err"- Info zurückgewiesen!
Der Client bekommt übrigens so was:
von:kommando:param1:param2
Also im Fall einer Info sowas:
von:i:hallo welt
Gilt auch für r:
von:1:name
usw.
'/
#Include "inc/tsne.bi"
'____________________________________________________________________________________________________
'DECLAREs, TYPEs und #DEFINEs
#Define repeatError(cid) redirect(0, cid, "i:err")
Type user
nick As String
code As String
status As String
invisible As Byte
away As Byte
dnd As Byte
message As String
cid As UInteger
nickset As Byte
End Type
#Define NL Chr(13) & Chr(10)
'#Define LOG_INPUT
'#Define LOG_OUTPUT
'Server
Declare Sub sendMessageServerside(conid As UInteger, what As String)
Declare Sub TSNE_Disconnected (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_Connected (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
Declare Sub TSNE_NewConnection (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
Declare Sub TSNE_NewConnectionBlack (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
'Kern
Declare Sub parse(what As String, from As UInteger)
Declare Sub redirect(fromWho As UInteger, toWho As UInteger, what As String)
Declare Function getArrayIndex(conid As UInteger) As UInteger
Declare Function split(what As String, param As Byte) As String
Declare Function grep OverLoad (uname As String, from As UInteger) As UInteger 'Nickname > ConnectionID
Declare Function grep (conid As UInteger, from As UInteger) As String 'ConnectionID > Nickname
'____________________________________________________________________________________________________
'Hauptprogramm
ReDim Shared eusers(1 To 2) As user
Dim Shared gfrom As UInteger
Function split(what As String, param As Byte) As String
'Danke an Ytwinky für diese Funktion
Dim As String trenner = ":"
Dim As String params()
Var Vorige=1, Gefunden=0, LenTren=Len(Trenner), Index=0, s=""
If Len(what) + LenTren = 0 Then
repeatError(gfrom)
EndIf
Do While InStr(Vorige, what, trenner)
Gefunden = InStr(Vorige, what, trenner)
ReDim Preserve params(index)
s = Mid(what, Vorige, Gefunden - Vorige)
If s <> "" Then
params(Index) = s
Index += 1
End If
Vorige = Gefunden + LenTren
Loop
ReDim Preserve params(Index)
If Index Then
params(Index) = Mid(what, Vorige, Gefunden - Vorige)
Else
params(Index) = what
EndIf
Return params(param + 1)
End Function
Sub parse(what As String, from As UInteger)
gfrom = from
Select Case LCase(Left(what, 1))
Case "i" 'Invisible
eusers(getArrayIndex(from)).invisible = Val(split(what, 0))
Case "a" 'Away
eusers(getArrayIndex(from)).away = Val(split(what,0))
Case "s" 'Status
eusers(getArrayIndex(from)).status = split(what, 0)
Case "m" 'Statusnachricht
eusers(getArrayIndex(from)).message = split(what, 0)
Case "l" 'Identifizieren
Dim ycode As String, yAsStr As String
Dim As UInteger yuser
ycode = split(what, 0)
yAsStr = split(what, 1)
yuser = grep(yAsStr, from)
If InStr(eusers(getArrayIndex(yuser)).code, ycode) <> 0 Then
redirect(from, from, "1")
Else
redirect(from, from, "0")
EndIf
Case "y" 'Code setzen
eusers(getArrayIndex(from)).code = split(what, 0)
Case "p" 'Nachricht
redirect(from, grep(split(what, 1), from), what)
Case "n" 'Notice
redirect(from, grep(split(what, 1), from), what)
Case "f" 'Info
redirect(from, grep(split(what, 1), from), what)
Case "d" 'DnD
eusers(getArrayIndex(from)).dnd = Val(split(what, 0))
Case "r" 'User- Info
Dim As UInteger whoi
Dim As String whom
whom = split(what, 0)
whoi = grep(whom, from)
redirect(0, from, "1:" & eusers(getArrayIndex(whoi)).nick)
redirect(0, from, "2:" & eusers(getArrayIndex(whoi)).status)
redirect(0, from, "3:" & eusers(getArrayIndex(whoi)).message)
redirect(0, from, "4:" & Trim(Str(eusers(getArrayIndex(whoi)).away)))
Case "j" 'Nicknamen setzen
If eusers(getArrayIndex(from)).nickset = 1 Then
redirect(0, from, "i:You can only set your nick once! Gay!")
Else
eusers(getArrayIndex(from)).nick = split(what, 0)
eusers(getArrayIndex(from)).nickset = 1
End If
Case Else
repeatError(from)
End Select
End Sub
Sub redirect(from As UInteger, towho As UInteger, what As String)
If from = 0 Then
sendMessageServerside(towho, "server:" & what)
Else
sendMessageServerside(towho, grep(from, from) & ":" & what)
End If
End Sub
Function grep (uname As String, from As UInteger) As UInteger 'Nickname > ConnectionID
Dim i As Integer, part As Integer
For i = LBound(eusers) To UBound(eusers)
part = i
If eusers(part).nick = uname Then Return eusers(part).cid
Next
sendMessageServerside(gfrom, "server:i:nouser " & uname)
Return 0
End Function
Function grep(conid As UInteger, from As UInteger) As String 'ConnectionID > Nickname
If conid > UBound(eusers) Or conid < LBound(eusers) Then
sendMessageServerside(gfrom, "server:i:nocid " & Trim(Str(conid)))
Return "server"
End If
Return eusers(getArrayIndex(conid)).nick
End Function
function getArrayIndex(conid As UInteger) As UInteger
Dim i As Integer
For i = LBound(eusers) To UBound(eusers)
If eusers(i).cid = conid Then Return i
Next
End Function
'____________________________________________________________________________________________________
'Server + Hauptprogramm
Dim G_Server As UInteger
Const G_UseBlackList As UInteger = 1
Color 14
Print " iIIM Server "
Print " Autor: Raphael R."
Color 15
Print
Print " [Initialisierung] ..."
TSNE_BlackList_Use_Global(1)
Dim BV As Long
BV = TSNE_Create_Server(G_Server, 14, 8, @TSNE_NewConnection, @TSNE_NewConnectionBlack)
If BV = 0 Then
TSNE_BlackList_Use(G_Server, 1)
Print " [Initialisierung] OK"
Print " [Server] Warten auf Verbindungen..."
Do : Loop Until InKey = Chr(27)
Print " [Server] Verbindungen trennen..."
TSNE_Disconnect(G_Server)
TSNE_WaitClose(G_Server)
Print " [Server] USV"
Else
Print " [Fehler] " & TSNE_GetGURUCode(BV)
EndIf
Color 7
End
Sub TSNE_Disconnected(ByVal V_TSNEID as UInteger)
Print "< [Leave]: CID = " & Trim(Str(V_TSNEID))
eusers(getArrayIndex(V_TSNEID)).cid = 0
Print "< [Delete] Verbindung entfernt"
End Sub
Sub TSNE_Connected(ByVal V_TSNEID as UInteger)
Print " > [Add]: CID = " & Trim(Str(V_TSNEID))
'User- Array aktualisieren
Dim i As UInteger
Dim done As UInteger = 0
For i = LBound(eusers) To UBound(eusers)
If eusers(i).cid = 0 Then
done = i
EndIf
Next i
If done = 0 Then
ReDim Preserve eusers(LBound(eusers) To UBound(eusers) + 1)
done = UBound(eusers)
EndIf
With eusers(done)
.cid = V_TSNEID
.nick = ""
.code = ""
.status = ""
.invisible = 0
.away = 0
.dnd = 0
.message = ""
.nickset = 0
End With
Print " > [Add] Fertig"
End Sub
Sub TSNE_NewConnection(ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
Dim newCID As UInteger
Dim newIP As String
Print " > [Neu]: WID = " & Trim(Str(V_TSNEID)) & "; RID = " & Trim(Str(V_RequestID)) & "; IP = " & V_IPA
TSNE_Create_Accept(V_RequestID, newCID, newIP, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData)
Print " > [Neu] Fertig"
End Sub
Sub TSNE_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
Print ">> [Input]: CID = " & Trim(Str(V_TSNEID)) & "; Text = " & V_Data
parse(V_Data, V_TSNEID)
End Sub
Sub TSNE_NewConnectionBlack(ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
Print " [Blacklist]: CID = " & Trim(Str(V_TSNEID)) & "; IP = " & Trim(Str(V_IPA))
End Sub
Sub sendMessageServerside(conid As UInteger, what As String)
Print "<< [Output]: CID = " & Trim(Str(conid)) & "; Text = " & what
TSNE_Data_Send(conid, what)
End Sub