Code: Alles auswählen
;
Enumeration
#MainWindow
EndEnumeration
;
Enumeration
#MenuBar_0
EndEnumeration
Enumeration
#Menu_Exit
#MENU_Hilfe
#MENU_Ueber
EndEnumeration
;
Enumeration
#ServerFrame
#ListPlayer
#ConsoleEditorGadged
#CommandGadget
#SendConsole
EndEnumeration
;
Enumeration
#StatusBar_0
EndEnumeration
;- Structures
Structure LVFINDINFO
flags.l
psz.s
lParam.l
pt.point
vkDirection.l
EndStructure
Structure PlayerData
PlayerRace.s
PlayerClass.s
PlayerID.f
PlayerName.s
PlayerX.l
PlayerY.l
PlayerZ.l
PlayerLevel.w
PlayerExp.l
PlayerHealth.w
PlayerPower.w
PlayerSpeed.w
PlayerStr.w
PlayerWis.w
PlayerSta.w
PlayerResHeat.w
PlayerResPoison.w
PlayerResCold.w
PlayerResDivine.w
Index.l
PlayerOnline.l
EndStructure
;- GlobalVars
Global Exit = 0
Global LastMessage.s
;- Lists
Global NewList PlData.PlayerData()
Global NewList PlayerS.PlayerData()
;- Procedures
Declare Send(ClientID,neuText.s)
Declare recieve_all()
Procedure SQL_Login(username.s,password.s,ClientID)
If OpenDatabase(1, "xxx", "xxx", "xxx")
If DatabaseQuery(1,"SELECT * FROM accounts WHERE acc_name LIKE '"+username+"'")
Global COUNTcols = DatabaseColumns(1)
While NextDatabaseRow(1)
Global sql_id.l = GetDatabaseLong (1, 3)
Global acc_name.s = GetDatabaseString(1, 1)
Protected acc_pwd.s = GetDatabaseString(1, 2)
Wend
If username = acc_name And password = acc_pwd
SendNetworkString(ClientID, "Lo1")
Global PlayerList = AddGadgetItem(#ListPlayer,-1,Str(ClientID))
Else
SendNetworkString(ClientID, "Lo2")
CloseDatabase(1)
EndIf
Else
MessageRequester("QUERY","Tabelle nicht gefunden")
CloseDatabase(1)
EndIf
Else
MessageRequester("DB","Datenbank geschlossen")
CloseDatabase(1)
EndIf
EndProcedure
Procedure Open_MainWindow()
If OpenWindow(#MainWindow, 250, 51, 746, 544, "Solania Server v0.2b", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
If CreateMenu(#MenuBar_0, WindowID(#MainWindow))
MenuTitle("File")
MenuItem(#Menu_Exit, "Exit")
MenuTitle("Options")
MenuTitle("Info")
MenuItem(#MENU_Hilfe, "Hilfe")
MenuItem(#MENU_Ueber, "Über")
EndIf
If CreateStatusBar(#StatusBar_0, WindowID(#MainWindow))
EndIf
If CreateGadgetList(WindowID(#MainWindow))
Frame3DGadget(#ServerFrame, 20, 70, 520, 380, "Console")
ListIconGadget(#ListPlayer, 560, 80, 170, 370,"ID",165)
EditorGadget(#ConsoleEditorGadged, 30, 90, 500, 350, #PB_Editor_ReadOnly)
StringGadget(#CommandGadget, 20, 460, 520, 30, "Commands")
ButtonGadget(#SendConsole, 550, 460, 80, 30, "Send Console")
GadgetToolTip(#SendConsole, "Send Command to Console")
EndIf
EndIf
EndProcedure
Procedure Window_Event()
If WindowEvent()
Select WindowEvent()
Case #PB_Event_CloseWindow
FreeMemory(*Buffer)
End
Case #PB_Event_Gadget
EndSelect
Else
Delay(1)
EndIf
EndProcedure
;---------------------------
Procedure MyConnect(ClientID)
AddElement(PlayerS())
PlayerS()\PlayerID = ClientID
PlayerS()\Index = ListIndex(PlayerS())
PlayerS()\PlayerName = "Unbekannt"
PlayerS()\PlayerOnline = 1
EndProcedure
;---------------------------
Procedure MyData(ClientID)
ReceiveNetworkData(ClientID, *Buffer, 3072)
neuText.s = PeekS(*Buffer)
username.s = StringField(neuText.s, 1, ";")
password.s = StringField(neuText.s, 2, ";")
SQL_Login(username.s,password.s,ClientID)
EndProcedure
;---------------------------
Procedure MyFile(ClientID)
EndProcedure
;---------------------------
Procedure MyDisconnect(ClientID)
; Listview Eintrag suchen und löschen
count.l = CountGadgetItems(#ListPlayer) - 1
ID.s = Str(ClientID)
For i = 0 To count
temp.s = GetGadgetItemText(#ListPlayer, i, 0)
If StringField(temp, 2, ";") = ID
RemoveGadgetItem(#ListPlayer, i)
Break
EndIf
Next i
EndProcedure
;---------------------------
Procedure recieve_all()
Protected SEvent.l
Protected ClientID.l
Protected temp.s
*Buffer = AllocateMemory(3072)
SEvent = NetworkServerEvent()
If SEvent
ClientID = EventClient()
Select SEvent
Case 1 ; Connect
MyConnect(ClientID)
CountList = CountList(PlayerS())
AddGadgetItem(#ConsoleEditorGadged,a,"Neuer Client Connectet! " +Str(PlayerS()\PlayerID) +Chr(13))
AddGadgetItem(#ConsoleEditorGadged,a,"PlayerIndex " +Str(PlayerS()\Index) +Chr(13))
AddGadgetItem(#ConsoleEditorGadged,a,"PlayerCountList " +Str(CountList) +Chr(13))
;AddGadgetItem(#ConsoleEditorGadged,a,"ListenID: " +Str(ListCount)+ Chr(10))
Case 2 ; Data
; Richtigen LinkedList Eintrag suchen
ForEach PlayerS()
If PlayerS()\PlayerID = ClientID
MyData(ClientID)
Break
EndIf
Next
Case 3 ; File
SetGadgetText(#ConsoleEditorGadged,"Client " +Str(PlayerS()\PlayerID)+ " versucht Datei zu schicken!"+ Chr(10))
; Richtigen LinkedList Eintrag suchen
ForEach PlayerS()
If PlayerS()\PlayerID = ClientID
MyFile(ClientID)
Break
EndIf
Next
Case 4 ; Disconnect
AddGadgetItem(#ConsoleEditorGadged,a,"Client " +Str(PlayerS()\PlayerID)+ " verlässt den Server"+ Chr(10))
AddGadgetItem(#ConsoleEditorGadged,a,"ListenID_out: " +Str(count)+ Chr(10))
AddGadgetItem(#ConsoleEditorGadged,a,"PlayerName: " +acc_name+ Chr(10))
AddGadgetItem(#ConsoleEditorGadged,a,"PlayerIndex_out: " +Str(PlayerS()\Index)+ Chr(10))
; Richtigen LinkedList Eintrag suchen
ForEach PlayerS()
If PlayerS()\PlayerID = ClientID
MyDisconnect(ClientID)
DeleteElement(PlayerS())
Break
EndIf
Next
CountList = CountList(PlayerS())
If ListCount = 0
AddGadgetItem(#ConsoleEditorGadged,a,"Es ist niemand Online"+ Chr(10))
Else
AddGadgetItem(#ConsoleEditorGadged,a,"Es sind noch "+Str(ListCount_out)+" Player in der Liste"+ Chr(10))
EndIf
EndSelect
EndIf
FreeMemory(*Buffer)
EndProcedure
; Send() Wird in recieve_all() aufgerufen
Procedure Send(ClientID,neuText.s)
SendNetworkString(EventClient(), Str(EventClient())+neuText.s)
;SendNetworkString(EventClient(), Str(EventClient())+";"+Str(pz)+";"+Str(px)+";"+Str(py))
EndProcedure
;- InitNetwork
;
If InitNetwork()
in_db = InitDatabase()
db_examine = ExamineDatabaseDrivers()
db_driver = NextDatabaseDriver()
db_descript$ = DatabaseDriverDescription()
db_driver_name$ = DatabaseDriverName()
If CreateNetworkServer(0,7000)
Open_MainWindow()
Else
MessageRequester("Error","Server konnte nicht gestartet werden!")
EndIf
Else
MessageRequester("Error","Netzwerk konnte nicht initialisiert werden!")
EndIf
;- Hauptschleife
Repeat
Window_Event()
recieve_all()
Delay(1)
ForEver