fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
IM, hoffentlich der letzte

Uploader:	raph ael
Datum/Zeit:	16.03.2008 23:09:20
#Define repeatError(cid) redirect(cid, cid, "err")

#Include "inc/tsne.bi"





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

End Type



#Define NL Chr(13) & Chr(10)

'#Define LOG_INPUT

'#Define LOG_OUTPUT



'Server

Declare Sub initServer

Declare Sub sendMessageServerside(conid As UInteger, what As String)



'Server [TSNE]

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)



'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



'____________________________________________________________________________________________________



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), 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(from, whoi, "1:" + eusers(getArrayIndex(from)).nick)

            redirect(from, whoi, "2:" + eusers(getArrayIndex(from)).status)

            redirect(from, whoi, "3:" + eusers(getArrayIndex(from)).message)

            redirect(from, whoi, "4:" + Trim(Str(eusers(getArrayIndex(from)).away)))

            redirect(from, whoi, "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, 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



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



'____________________________________________________________________________________________________



Dim Shared server_server As UInteger

Dim Shared server_server_server As Long

Const G_UseBlackList As UInteger = 0



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 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_server_server = TSNE_Create_Server(server_server, 73, 15, @TSNE_NewConnection, @TSNE_NewConnectionC)

    If server_server_server = 0 Then

        Print "   [Server] Server bereit."

        Print "<> [Server] Warten auf Verbindungen..."



        While InKey <> Chr(27) : Wend

        Print "   [Server] ESCAPE"

        Print "   [Server] Suicid..."

        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_server_server)

        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)

        eusers(UBound(eusers)).nick = ""

        eusers(UBound(eusers)).code = ""

        eusers(UBound(eusers)).status = "Online"

        eusers(UBound(eusers)).invisible = 0

        eusers(UBound(eusers)).away = 0

        eusers(UBound(eusers)).dnd = 0

        eusers(UBound(eusers)).message = "Hey I am online!"

        eusers(UBound(eusers)).cid = V_TSNEID

    EndIf

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