Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
IM (fehlerhaft)
| Uploader: |  raph ael |
| Datum/Zeit: | 16.03.2008 21:15:31 |
#Include "iiim.bi"
#Include "inc/tsne.bi"
ReDim Shared eusers(1 To 2) As user
function split(what As String, param As Byte) As String
Dim params(0 To 1) As String
Dim As Integer posd, pos2
Dim As String final
posd = InStr(what, ":")
pos2 = InStr(posd + 1, what, ":")
params(0) = Mid(what, posd + 1, pos2 - 3)
params(1) = Mid(what, pos2 + 1, Len(what) - pos2)
Return params(param)
End Function
Sub parse(what As String, from As UInteger)
Select Case LCase(Left(what, 1))
Case "i" 'Invisible
eusers(getArrayIndex(from)).invisible = 1
Case "a" 'Away
eusers(getArrayIndex(from)).away = 1
Case "s" 'Status
eusers(getArrayIndex(from)).status = split(what, 0)
Case "m" 'Statusnachricht
eusers(getArrayIndex(from)).message = split(what, 0)
Case "l" 'Identifizieren
eusers(getArrayIndex(from)).code = split(what, 0)
Case "p" 'Nachricht
redirect(from, grep(split(what, 1)), what)
Case "n" 'Notice
redirect(from, grep(split(what, 1)), what)
Case "f" 'Info
redirect(from, grep(split(what, 1)), what)
Case "d" 'DnD
eusers(getArrayIndex(from)).dnd = Val(split(what, 0))
Case "r" 'User- Info
Dim As UInteger who
who = split(what, 0)
redirect(from, who, "1:" + eusers(getArrayIndex(from)).nick)
redirect(from, who, "2:" + eusers(getArrayIndex(from)).status)
redirect(from, who, "3:" + eusers(getArrayIndex(from)).message)
redirect(from, who, "4:" + Trim(Str(eusers(getArrayIndex(from)).away)))
redirect(from, who, "5:" + eusers(getArrayIndex(from)).code)
Case "j" 'Nicknamen setzen
If eusers(getArrayIndex(from)).nick <> "" Then
redirect(0, from, "i:You can only set your nick once! Gay!")
Else
eusers(getArrayIndex(from)).nick = split(what, 0)
End If
Case Else
repeatError(from)
End Select
End Sub
Sub redirect(from As UInteger, towho As UInteger, what As String)
sendMessageServerside(towho, grep(from) + ":" + what)
End Sub
Function grep (uname As String, from As UInteger) As UInteger 'Nickname > ConnectionID
Dim i As Integer
For i = LBound(eusers) To UBound(eusers)
If eusers(i).nick = uname Then Return i
Next
sendMessageServerside(from, "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(from, "server:i:nocid " + Trim(Str(conid)))
Return "server"
End If
Return eusers(getArrayIndex(conid)).nick
End Function
Sub getArrayIndex(conid As UInteger)
Dim i As Integer
For i = LBound(eusers) To UBound(eusers)
If eusers(i).cid = conid Then Return i
Next
End Sub
Dim Shared server_server As UInteger
Dim Shared server_handle As Long
Const G_UseBlackList As UInteger = 0
Sub initServer Constructor
Color 14
Print "insane Instant Messager Server"
Print " - vist http://iim.server.in - "
Print "ESCAPE zum Beenden druecken"
Color 15
Print
Print " [Server] Initialisierung..."
server_handle = TSNE_Create_Server(G_Server, 73, 15, @TSNE_NewConnection, @TSNE_NewConnectionC)
If Not server_handle Then
Print " [Server] Server bereit."
Print "<> [Server] Warten auf Verbindungen..."
While InKey <> Chr(27) : Wend
Print " [Server] ESCAPE"
Print " [Server] Suicid..."
Dim i As Integer
For i = LBound(eusers) To UBound(eusers)
If eusers(i).cid <> 0 Then
sendMessageServerside(i, "server:i:USV-Unsere Server verrecken!")
EndIf
Next
Print " [Server] Seil wird angebracht..."
TSNE_Disconnect(server_server)
Print " [Server ...legt den Kopf in die Schlinge...]"
TSNE_WaitClose(server_server)
Print " [Server springt!]
End
Else
Print " [Fehler] " & TSNE_GetGURUCode(server_handle)
End
EndIf
End Sub
Sub TSNE_Disconnected(ByVal V_TSNEID as UInteger)
Print "< [Leave]: " + Trim(Str(V_TSNEID))
eusers(getArrayIndex(V_TSNEID)).cid = 0
End Sub
Sub TSNE_Connected(ByVal V_TSNEID as UInteger)
Print " > [Join]: " + Trim(Str(V_TSNEID))
Dim i As Integer
Dim alreadyDone As Byte = 0
For i = LBound(eusers) To UBound(eusers)
If eusers(i).cid = 0 Then
eusers(i).nick = ""
eusers(i).code = ""
eusers(i).status = "Online"
eusers(i).invisible = 0
eusers(i).away = 0
eusers(i).dnd = 0
eusers(i).message = "Hey I am online!"
eusers(i).cid = V_TSNEID
alreadyDone = 1
EndIf
Next
If Not alreadyDone Then
ReDim Preserve eusers(LBound(eusers) To UBound(eusers) + 1)
With UBound(eusers)
.nick = ""
.code = ""
.status = "Online"
.invisible = 0
.away = 0
.dnd = 0
.message = "Hey I am online!"
.cid = V_TSNEID
End With
EndIf
End Sub
Sub TSNE_NewConnection(ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
Dim As UInteger newCid
Dim As String ipMit4Punkten
Print " > [New]: CID = " & Trim(Str(V_TSNEID)) & "; RID = " & Trim(Str(V_RequestID)) & "; IP = " & V_IPA
TSNE_Create_Accept(V_RequestID, newCid, ipMit4Punkten, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData)
End Sub
Sub TSNE_NewConnectionC(ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
Print "WTF?"
End Sub
Sub TSNE_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
#Ifdef LOG_INPUT
Print " > [Input] " + V_Data
#EndIf
parse(V_Data, V_TSNEID)
End Sub
Sub sendMessageServerside(conid As UInteger, what As String)
TSNE_Data_Send(conid, what & NL)
End Sub