Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
IIM Server v2 [beta][crash]
| Uploader: |  raph ael |
| Datum/Zeit: | 19.07.2008 15:04:19 |
/' *raeusper*
» Beginn Disclaimer «
iimServer v2 - Ein Instant-Messenger-Server
Dieses Programm ist unter der WTFPL lizensiert (siehe http://sam.zoy.org/wtfpl/) und
darf entsprechend ihrer Bedingungen vervielfältigt und/oder
modifiziert werden.
Ich hafte für keinerlei Schäden, die dieses Programm verursachen
kann(aber mit ziemlicher Sicherheit nicht wird)- es wurde in der
Hoffnung entwickelt, nütlich zu sein.
» Ende Disclaimer «
'/
'Versionscheck
#lang "fb"
#ifndef AndAlso
#print WARNUNG: Eventuell inkompatible Versionen!
#print Bitte verwenden sie bitte mindestens
#print FBC 0.20.0 SVN vom 16. Juni 2008!
#define AndAlso and
#define OrElse or
#endif
#include once "tsne-v2.bi"
#define IIMS_V2_VERSION "2.0b"
#define cline(x,y,z) xcline(x,y,z, __FB_ARGC__)
type user_V2
id as uinteger 'TSNE-ID
uname as string 'Benutzername
identify as string 'Sicherheitscode
isAway as byte 'Bin ich weg?
awayMsg as string 'Warum bin ich weg?
isDND as byte 'Will ich nicht gestoert werden?
dndMsg as string 'Warum will ich nicht gestoert werden=
isInvis as byte 'Bin ich unsichtbar?
end type
dim shared iim2_mutex as any ptr, users() as user_V2
iim2_mutex = mutexcreate
declare function xcline(longname as string, shortname as string,_
style as string, argc as integer) as string
declare function split(byref source as string, target() as string,_
delimeter as string) as integer
declare function select_user(id as uinteger) as uinteger
declare function select_name(uname as string) as uinteger
declare function isUser(nick as string) as byte
declare function isDND(nick as string) as byte
declare function verifyPort(port as integer) as string
declare sub iim2_serversend(tsneid as uinteger, what as string)
'Callback- Funktionen
declare sub cbNewAck(id as uinteger, requestID as Socket, ip as string)
declare sub cbNewConC(id as uinteger, ip as string)
declare sub cbConnected(id as uinteger)
declare sub cbDisconnected(id as uinteger)
declare sub cbRecieve(id as uinteger, byref inData as string)
const false = 0
const true = not false
const topline = " >> iimServer v2 by int21h - visit http://iim.net.tc"
color ,15
cls
color 15, 9
print topline + space(80 - len(topline))
view print 2 to 24
color 0,15
dim server as uinteger, check as long
print "Wilkommen!"
print "Server wird gestartet..."
dim shared as byte notifyNew, notifyAway
notifyNew = val(cline("--notify-new", "-nn", "b"))
notifyAway= val(cline("--notify-away","-na", "b"))
if notifyAway = true then
print "Benachrichtigung bei beendeten Verbindungen ein."
end if
if notifyNew = true then
print "Benachrichtigung bei neuen Verbindungen ein."
end if
dim port as ushort, ports as string
ports = cline("--port", "-p", "s")
if ports = "" then
port = 1030
else
port = val(ports)
select case left(verifyPort(port), 1)
case "o"
case "x"
color 12
print "WARNUNG: Der angegebene Port befindet sich im ";
print "registrieten Bereich!"
color 0
case "u"
color 12
print "WARNUNG: Der angegebene Port ist fuer etwas anderes ";
print "gedacht!"
color 0
end select
end if
check = TSNE_Create_Server(server, port,_
10, @cbNewAck, @cbNewConC)
if check = 0 then
print "Server auf Port " + trim(str(port));
print " initialisiert."
print "ESCAPE druecken, um den Server zu beenden."
print "Warten auf eingehende Verbindungen..."
do : loop until inkey = chr(27)
print "Server wird beendet..."
TSNE_Disconnect(server)
TSNE_WaitClose(server)
mutexunlock(iim2_mutex)
mutexdestroy(iim2_mutex)
view print 1 to 24
print "Ok."
end
else
print "Ups. Es tauchte folgender Fehler auf:"
print "> " + TSNE_GetGURUCode(check)
mutexdestroy(iim2_mutex)
view print 1 to 24
sleep
end
end if
function split(byref source as string, target() as string,_
delimeter as string) as integer
var vorige=1, gefunden=0, lentren=len(delimeter), index=0, s=""
if len(source) + lentren = 0 then return -1
erase target
do while instr(vorige, source, delimeter)
gefunden = instr(vorige, source, delimeter)
redim preserve target(index)
s = mid(source, vorige, gefunden - vorige)
if s <> "" then
target(index) = s
index += 1
end if
vorige = gefunden + lentren
loop
redim preserve target(index)
target(index) = mid(source, vorige, gefunden - vorige)
return index
end function
function xcline(longname as string, shortname as string,_
style as string, argc as integer) as string
for i as integer = 0 to argc - 1
if (command(i) = longname) orelse (command(i) = shortname) then
select case style
case "b"
return str(true)
case "s"
return command(i+1)
end select
end if
next i
return ""
end function
sub cbNewConC(id as uinteger, ip as string)
/' Diese Funktion sollte eigentlich nie aufgerufen werden, aber
wer weiss was sich in iimserver v3 tun wird ;]
'/
end sub
sub cbNewAck(id as uinteger, requestID as Socket, ip as string)
dim newid as uinteger, newip as string
if notifyNew then
print "++ Neue Verbindung: " + ip + " (" + trim(str(id)) + ")"
end if
TSNE_Create_Accept(id, newid, newip, @cbDisconnected, @cbConnected,_
@cbRecieve)
end sub
sub cbConnected(id as uinteger)
if notifyNew then
print "!+ Verbindung bereit: " + trim(str(id))
end if
'Wir finden einen Platz fuer ihn:
dim platz as uinteger, status as byte = false
mutexlock(iim2_mutex)
for i as integer = 1 to ubound(users)
if users(i).id = 0 then 'Bingo!
status = true
platz = i
exit for
end if
next i
if status = false then
redim preserve users(lbound(users) to ubound(users) + 1) as user_V2
platz = ubound(users)
end if
with users(platz)
.id = id
.uname = "new user " + trim(str(id))
.identify = ""
.isAway = false
.awayMsg = ""
.isDnd = false
.dndMsg = ""
.isInvis = false
end with
iim2_serversend(id, !"you\3" & users(platz).uname)
mutexunlock(iim2_mutex)
end sub
sub cbDisconnected(id as uinteger)
if notifyAway then
print "-- Verbindung getrennt: " + trim(str(id))
end if
'STIRB!!!
dim opfer as uinteger
mutexlock(iim2_mutex)
dim i as integer
for i = 1 to ubound(users)
if users(i).id = id then
users(i).id = 0
exit for
end if
next i
if i = ubound(users) then
redim preserve users(lbound(users) to ubound(users) - 1) as user_V2
end if
mutexunlock(iim2_mutex)
end sub
function select_user(id as uinteger) as uinteger
dim status as byte = false
mutexlock(iim2_mutex)
for i as integer = lbound(users) to ubound(users)
if users(i).id = id then
status = true
function = i
exit for
end if
next i
if status = false then
function = 0
mutexunlock(iim2_mutex)
exit function
else
mutexunlock(iim2_mutex)
exit function
end if
end function
function select_name(uname as string) as uinteger
dim status as byte = false
mutexlock(iim2_mutex)
for i as integer = lbound(users) to ubound(users)
if users(i).uname = uname then
status = true
function = i
exit for
end if
next i
if status = false then
function = 0
mutexunlock(iim2_mutex)
exit function
else
mutexunlock(iim2_mutex)
exit function
end if
end function
sub cbRecieve(id as uinteger, byref inData as string)
dim uid as uinteger = select_user(id)
dim uname as string = users(uid).uname
dim splitted() as string
split(inData, splitted(), chr(1))
select case splitted(0)
'Sinnloses geschwafel
case "hello"
iim2_serversend(id, "hello too")
case "version"
iim2_serversend(id, !"version\3" & IIMS_V2_VERSION)
'Benutzereinstellungen
case "nick"
if ubound(splitted)>=1 andalso splitted(1)<>"" then
if select_name(splitted(1)) = 0 then 'Gut, der Name existiert
'noch nicht.
mutexlock(iim2_mutex)
users(uid).uname = splitted(1)
iim2_serversend(id, !"you\3" & splitted(1))
mutexunlock(iim2_mutex)
else
iim2_serversend(id, !"conflict\3nick")
end if
else
iim2_serversend(id, !"synerr\3nick")
end if
case "setid"
if ubound(splitted)>=1 andalso splitted(1)<>"" then
mutexlock(iim2_mutex)
users(uid).identify = splitted(1)
mutexunlock(iim2_mutex)
else
iim2_serversend(id, !"synerr\3setid")
end if
case "away"
if ubound(splitted)>=1 andalso splitted(1)<>"" then
if splitted(1) = "1" orelse splitted(1) = "yes" then
mutexlock(iim2_mutex)
users(uid).isAway = true
mutexunlock(iim2_mutex)
elseif splitted(1)="0" orelse splitted(1)="no" then
mutexlock(iim2_mutex)
users(uid).isAway = false
mutexunlock(iim2_mutex)
else
iim2_serversend(id, "synerr\3away")
end if
if ubound(splitted)>=2 andalso splitted(2)<>"" then
mutexlock(iim2_mutex)
users(uid).awayMsg = splitted(2)
mutexunlock(iim2_mutex)
end if
end if
case "dnd"
if ubound(splitted)>=1 andalso splitted(1)<>"" then
if splitted(1) = "1" orelse splitted(1) = "yes" then
mutexlock(iim2_mutex)
users(uid).isDnd = true
mutexunlock(iim2_mutex)
elseif splitted(1)="0" orelse splitted(1)="no" then
mutexlock(iim2_mutex)
users(uid).isDnd = false
mutexunlock(iim2_mutex)
else
iim2_serversend(id, "synerr\3dnd")
end if
if ubound(splitted)>=2 andalso splitted(2)<>"" then
mutexlock(iim2_mutex)
users(uid).dndMsg = splitted(2)
mutexunlock(iim2_mutex)
end if
end if
case "invis"
if ubound(splitted)>=1 andalso splitted(1)<>"" then
if splitted(1) = "1" orelse splitted(1) = "yes" then
mutexlock(iim2_mutex)
users(uid).isInvis = true
mutexunlock(iim2_mutex)
elseif splitted(1)="0" orelse splitted(1)="no" then
mutexlock(iim2_mutex)
users(uid).isInvis = false
mutexunlock(iim2_mutex)
else
iim2_serversend(id, "synerr\3invis")
end if
end if
'Andere User blablabla
case "others"
if ubound(splitted)>=2 andalso splitted(1)<>"" andalso splitted(2)<>"" then
if isUser(splitted(1)) then
dim target as uinteger
target = select_name(splitted(1))
mutexlock(iim2_mutex)
select case splitted(2)
case "away"
dim status as string = "false"
if users(target).isAway = true then status = "true"
iim2_serversend(id, splitted(1) & !"\3away\3" & status)
case "away+"
iim2_serversend(id, splitted(1) & !"\3away+\3" & users(target).awayMsg)
case "dnd"
dim status as string = "false"
if users(target).isDnd = true then status = "true"
iim2_serversend(id, splitted(1) & !"\3dnd\3" & status)
case "dnd+"
iim2_serversend(id, splitted(1) & !"\3dnd+\3" & users(target).awayMsg)
case "check"
if ubound(splitted)>=3 then 'hier brauchen wir nur das
dim identify as string = splitted(3)
dim myname as string
mutexunlock(iim2_mutex)
myname = users(select_user(id)).uname
mutexlock(iim2_mutex)
if users(target).identify = splitted(3) then
iim2_serversend(users(target).id, !"checkinfo\3true\3" & myname)
iim2_serversend(id, !"checkstatus\3true\3" & splitted(2))
else
iim2_serversend(users(target).id, !"checkinfo\3false\3" & myname)
iim2_serversend(id, !"checkstatus\3false\3" & splitted(2))
end if
else
iim2_serversend(id, !"synerr\3others:check")
end if
end select
mutexunlock(iim2_mutex)
else
if not isDND(splitted(1)) then
iim2_serversend(id, !"nouser\3" & splitted(1))
end if
end if
else
iim2_serversend(id, !"synerr\3others")
end if
'versenden von... irgendwas!
case "send"
mutexlock(iim2_mutex)
if ubound(splitted) >= 2 andalso splitted(1) <> "" then
if isUser(splitted(1)) then
dim as string ich, du, was
dim as uinteger duid
ich = users(select_user(id)).uname
mutexunlock(iim2_mutex)
du = splitted(1)
duid = select_name(du)
mutexlock(iim2_mutex)
was = splitted(2)
iim2_serversend(duid, !"got\3" & ich & !"\3" & was)
else
if not isDND(splitted(1)) then
iim2_serversend(id, !"nouser\3" & splitted(1))
end if
end if
else
iim2_serversend(id, !"synerr\3iim2_serversend")
end if
mutexunlock(iim2_mutex)
end select
end sub
sub iim2_serversend(tsneid as uinteger, what as string)
TSNE_Data_Send(tsneid, what)
end sub
function isUser(nick as string) as byte
function = true
dim uid as uinteger
uid = select_name(nick)
if uid = 0 then return false
mutexlock(iim2_mutex)
if users(uid).isInvis = true then function = false
mutexunlock(iim2_mutex)
end function
function isDND(nick as string) as byte
dim uid as uinteger
uid = select_name(nick)
if uid = 0 then return false
mutexlock(iim2_mutex)
if users(uid).isDND = true then function = true
mutexunlock(iim2_mutex)
return false
end function
Function verifyPort(port As Integer) As String
Select Case port
Case 7
Return "uEcho"
Case 13
Return "uDaytime"
Case 20
Return "uFTP-Data"
Case 21
Return "uFTP-Protokoll"
Case 22
Return "uSSH"
Case 23
Return "uTelnet"
Case 25
Return "uSMTP"
Case 43
Return "uWhoIs"
Case 53
Return "uDNS"
Case 67
Return "uBootstrap Server"
Case 68
Return "uBootstrap Client"
Case 80
Return "uHTTP (das weiss aber wirklich jeder)"
Case 110
Return "uPOP3"
Case 119
Return "uNNTP"
Case 123
Return "uNTP"
Case 143
Return "uIMAP"
Case 443
Return "uHTTPS"
Case 445
Return "uMDS (sagen wirs mal so: wenn es Microsoft nicht gaebe, wuerde diese Warnung nicht erscheinen.)"
Case 465
Return "uSMTPS"
Case 989
Return "uFTPS-Data"
Case 990
Return "uFTPS-Protokoll"
Case 992
Return "uTLS"
Case 993
Return "uIMAPS"
Case 995
Return "uIRCS"
Case 995
Return "uPOP3S"
Case 3306
Return "uMySQL"
Case 3389
Return "uRDP"
Case 5060
Return "uSIP"
Case 6667
Return "uIRC"
End Select
If (port > 1024) And (port < 49151) Then
Return "x"
EndIf
Return "o"
End Function