Das Beispiel mit den VarServer war nicht MultiUser tauglich.
Habe den Code mal überarbeitet. Schickt auch an alle User ein Nachricht wenn der Server beendet wird.
Das Beispiel soll als Vorlage dienen
Für jeden angemeldeten User wird ein Object angelegt und der Pointer in einer LinkedList gespeichert. Meldet sich der User ab (Trennen) wird das Object gelöscht und aus der LinkedList entfernt. Kommt ein SEvent wird mit Foreach ... Next alle Ojecte durchgegangen bis die richtige ClientID gefunden wurde.
VarServer.pb
Code: Alles auswählen
;-TOP
; Kommentar : Variablen Server
; Version : v2.01
; Author : Michael Kastner
; Datei : VarServer2.pb
; Erstellt : 10.06.2006
; Geändert :
; -------------------------------------------------------------------
Global Exit = 0
Global LastMessage.s
; -------------------------------------------------------------------
IncludeFile "VarServerInterface.pb"
; -------------------------------------------------------------------
; -------------------------------------------------------------------
If InitNetwork() = 0
MessageRequester("FEHLER", "InitNetwork nicht erfolgreich!")
End
EndIf
; -------------------------------------------------------------------
Procedure ThreadVarServer(id)
port = 7000
If CreateNetworkServer(0, port) = 0
MessageRequester("FEHLER","CreateNetworkServer Port: " + Str(port))
Exit = 2
ProcedureReturn 0
EndIf
StatusBarText(0, 0, "Server läuft ")
*buffer = AllocateMemory($8000)
While Exit = 0
SEvent = NetworkServerEvent()
If SEvent
ClientID = EventClient()
Select SEvent
Case #PB_NetworkEvent_Connect
; Alten User entfernen. Sollte nicht passieren
ForEach *User()
If *User()\Connect(ClientID)
FreeMemory(*User())
DeleteElement(*User())
Break
EndIf
Next
; User hinzufügen
AddElement(*User())
*User() = New_User(ClientID)
StatusBarText(0, 0, "Usercount: " + Str(CountList(*User())))
Case #PB_NetworkEvent_Data
; Daten empfangen
ForEach *User()
If *User()\ReceiveData(ClientID)
Break
EndIf
Next
Case #PB_NetworkEvent_File
; File empfangen
ForEach *User()
If *User()\ReceiveFile(ClientID)
Break
EndIf
Next
Case #PB_NetworkEvent_Disconnect
; User entfernen
ForEach *User()
If *User()\Disconnect(ClientID)
FreeMemory(*User())
DeleteElement(*User())
Break
EndIf
Next
StatusBarText(0, 0, "Usercount: " + Str(CountList(*User())))
EndSelect
Else
Delay(10)
EndIf
Wend
; Shutdown an alle Senden
ForEach *User()
*User()\Shutdown()
Next
CloseNetworkServer(0)
FreeMemory(*buffer)
Exit = 2
EndProcedure
; -------------------------------------------------------------------
; -------------------------------------------------------------------
Procedure LoadVariablen()
Protected temp.s, var.s, value.s
If ReadFile(0, "Daten.dat")
While Not Eof(0)
temp = ReadString(0)
var = StringField(temp, 1, #TAB$)
value = StringField(temp, 2, #TAB$)
If var <> ""
AddElement(db())
db()\var = var
db()\value = value
EndIf
Wend
CloseFile(0)
EndIf
EndProcedure
; -------------------------------------------------------------------
Procedure SaveVariablen()
Protected temp.s, var.s, value.s
If CreateFile(0, "Daten.dat")
ForEach db()
temp = db()\var + #TAB$ + db()\value
WriteStringN(0, temp)
Next
CloseFile(0)
EndIf
EndProcedure
; -------------------------------------------------------------------
If OpenWindow(0, 20, 20, 300, 40, "Variablen Server v2.01", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
CreateStatusBar(0, WindowID(0))
StatusBarText(0, 0, "Load Variablen")
LoadVariablen()
StatusBarText(0, 0, "Start Server")
hThread = CreateThread(@ThreadVarServer(), 1)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Exit = 1
EndSelect
Until Exit = 2
StatusBarText(0, 0, "Save Variablen")
SaveVariablen()
EndIf
End
VarServerInterface.pb
Code: Alles auswählen
;-TOP
; Kommentar : Variablen Server
; Version : v2.01
; Author : Michael Kastner
; Datei : VarServer2Interface.pb
; Erstellt : 10.06.2006
; Geändert :
; -------------------------------------------------------------------
;- Structure
Structure udtManager
*VTable
ClientID.l
ClientIP.l
ClientPort.l
ClientSocket.l
timeConnect.l
timeUpdate.l
inData.s
outData.s
inFile.s
outFile.s
EndStructure
Structure udtVariablen
Var.s
Value.s
EndStructure
; -------------------------------------------------------------------
;- Manager Interface
Interface Manager
Connect(a)
Disconnect(a)
ReceiveData(a)
ReceiveFile(a)
Shutdown()
SendDaten()
Info(a.s)
EndInterface
; -------------------------------------------------------------------
Global NewList db.udtVariablen()
Global NewList *User.Manager()
; -------------------------------------------------------------------
Procedure.l iConnect(*this.udtManager, ClientID)
If ClientID = *this\ClientID
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
; -------------------------------------------------------------------
Procedure.l iDisconnect(*this.udtManager, ClientID)
If ClientID <> *this\ClientID
ProcedureReturn 0
EndIf
ProcedureReturn 1
EndProcedure
; -------------------------------------------------------------------
Procedure.l iReceiveData(*this.udtManager, ClientID)
Protected *buffer
Protected len.l
If ClientID <> *this\ClientID
ProcedureReturn 0
EndIf
*buffer = AllocateMemory($4000)
Repeat
len = ReceiveNetworkData(ClientID,*buffer, $4000)
*this\inData + PeekS(*buffer)
Until len <> $4000
*this\timeUpdate = Date()
; Datenende auswerten
If Right(*this\inData, 2) = #CRLF$
*self.Manager = *this
*self\SendDaten()
*this\inData = ""
EndIf
FreeMemory(*buffer)
ProcedureReturn 1
EndProcedure
; -------------------------------------------------------------------
Procedure.l iReceiveFile(*this.udtManager, ClientID)
Protected *buffer
Protected len.l
If id <> *this\ClientID
ProcedureReturn 0
EndIf
*this\timeUpdate = Date()
; Datei Speichern
ReceiveNetworkFile(ClientID, *this\inFile)
ProcedureReturn 1
EndProcedure
; -------------------------------------------------------------------
Procedure iShutdown(*this.udtManager)
Protected temp.s
temp = "Shutdown VarServer" + #CRLF$
SendNetworkString(*this\ClientID, temp)
Delay(10)
CloseNetworkConnection(*this\ClientID)
EndProcedure
; -------------------------------------------------------------------
Procedure iSendDaten(*this.udtManager)
Protected buffer.s, cmd.s, temp.s, var.s, value.s
buffer = Left(*this\inData, Len(*this\inData) - 2)
cmd = StringField(buffer, 1, " ")
cmd = UCase(cmd)
temp = Right(buffer, Len(buffer) - Len(cmd) - 1)
var = StringField(temp, 1, "=")
var = UCase(var)
var = Trim(var)
value = StringField(temp, 2, "=")
Select cmd
Case "NEW"
ForEach db()
If db()\Var = var
temp = "FEHLER: Variable existiert bereits" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 0
EndIf
Next
AddElement(db())
db()\Var = var
db()\Value = value
temp = "OK:" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
Case "GET"
ForEach db()
If db()\Var = var
temp = "OK:" + db()\Value + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
EndIf
Next
temp = "FEHLER: Variable nicht gefunden" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 0
Case "PUT"
ForEach db()
If db()\Var = var
db()\Value = value
temp = "OK:" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
EndIf
Next
temp = "FEHLER: Variable nicht gefunden" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 0
Case "DEL"
ForEach db()
If db()\Var = var
DeleteElement(db())
temp = "OK:" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
EndIf
Next
temp = "FEHLER: Variable nicht gefunden" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 0
Case "LIST"
If var = ""
ForEach db()
temp = db()\Var + "=" + db()\Value + #CRLF$
SendNetworkString(*this\ClientID, temp)
Next
temp = "OK:" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
Else
len = Len(var)
ForEach db()
If Left(db()\var, len) = var
temp = db()\Var + "=" + db()\Value + #CRLF$
SendNetworkString(*this\ClientID, temp)
EndIf
Next
temp = "OK:" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
EndIf
Case "SEARCH"
If var <> ""
ForEach db()
If FindString(UCase(db()\value), var, 1)
temp = db()\Var + "=" + db()\Value + #CRLF$
SendNetworkString(*this\ClientID, temp)
EndIf
Next
EndIf
temp = "OK:" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 1
Default
temp = "FEHLER: Command unbekannt" + #CRLF$
SendNetworkString(*this\ClientID, temp)
ProcedureReturn 0
EndSelect
EndProcedure
; -------------------------------------------------------------------
Procedure iInfo(*this.udtManager, Text.s)
Protected temp.s
temp = text + #TAB$
temp + "IP " + IPString(*this\ClientIP) + #TAB$
temp + "Port " + Str(*this\ClientPort) +#TAB$
temp + "Connected " + FormatDate("%tt.%mm.%yyyy %hh:%ii:%ss", *this\timeConnect)
Debug temp
EndProcedure
; -------------------------------------------------------------------
Procedure.l New_User(ClientID)
Protected *v.udtManager
*v = AllocateMemory(SizeOf(udtManager))
*v\VTable = ?vtManager
*v\ClientID = ClientID
*v\ClientIP = GetClientIP(ClientID)
*v\ClientPort = GetClientPort(ClientID)
*v\ClientSocket = ConnectionID(ClientID)
*v\timeConnect = Date()
*v\inData = ""
*v\outData = ""
*v\inFile = "DUMMY.DAT"
*v\outFile = ""
ProcedureReturn *v
EndProcedure
; -------------------------------------------------------------------
; -------------------------------------------------------------------
;- DataSection Manager Interface
DataSection
vtManager:
Data.l @iConnect()
Data.l @iDisconnect()
Data.l @iReceiveData()
Data.l @iReceiveFile()
Data.l @iShutdown()
Data.l @iSendDaten()
Data.l @iInfo()
EndDataSection
FF
