@Dadido3, ich habe es mit Linux und Windows in allen Variationen getestet. Der Fehler war immer der gleiche.
Einige Erklärungen was ich gemachte habe im Code unter Case "Message"
Sollte es programmtechnisch FALSCH sein was ich gemacht habe, wäre über jede Hilfe Dankbar.
Noch einmal zur Erklärung.
Ich lasse über diesen Code einen Doppelkopf-Server laufen.
Alles was mit Doppelkopf zu tun hat, Spieler, Karten, alles, managet die Procedure Checknachricht.
Insofern ist es egal, ob dieser Server für einen Chat gemacht ist.
Relevant ist, dass Daten zuverlässeig vom Client zum Server und zurück kommen.
Ich kann manchmal mit 30 Spielern 1 Std spielen, aber die Regel ist, dass der Server nach wenigen Minuten einfach nicht mehr erreichbar ist und einfach nichts mehr macht.
In einer Leelaufschleife scheint er nicht zu sein, denn die CPU-Last ist bei rund 0-1 %
Code: Alles auswählen
Procedure WebSocket_Event(*Server, *Client, Event, *Event_Frame.WebSocket_Server::Event_Frame)
Protected Chat_Message.Chat_Message
Protected Chat_Username_Change.Chat_Username_Change
Protected Chat_Userlist.Chat_Userlist
Protected JSON_ID.i
Protected JSON2_ID.i
LockMutex(Mutex)
Select Event
Case WebSocket_Server::#Event_Connect
PrintN(" #### Client connected: " + *Client)
AddElement(Client())
Client()\WebSocket_Client = *Client
JSON2_ID = CreateJSON(#PB_Any)
If JSON2_ID
Chat_Userlist\Type = "Userlist"
ForEach Client()
AddElement(Chat_Userlist\UserName())
Chat_Userlist\UserName() = Client()\Username
Next
InsertJSONStructure(JSONValue(JSON2_ID), Chat_Userlist, Chat_Userlist)
WebSocket_Server::Frame_Text_Send(*Server, *Client, ComposeJSON(JSON2_ID))
FreeJSON(JSON2_ID)
EndIf
Case WebSocket_Server::#Event_Disconnect
PrintN(" #### Client disconnected: " + *Client)
ForEach Client()
If Client()\WebSocket_Client = *Client
DeleteElement(Client())
Break
EndIf
Next
JSON2_ID = CreateJSON(#PB_Any)
If JSON2_ID
Chat_Userlist\Type = "Userlist"
ForEach Client()
AddElement(Chat_Userlist\UserName())
Chat_Userlist\UserName() = Client()\Username
Next
InsertJSONStructure(JSONValue(JSON2_ID), Chat_Userlist, Chat_Userlist)
ForEach Client()
WebSocket_Server::Frame_Text_Send(*Server, Client()\WebSocket_Client, ComposeJSON(JSON2_ID))
Next
FreeJSON(JSON2_ID)
EndIf
Case WebSocket_Server::#Event_Frame
Select *Event_Frame\Opcode
Case WebSocket_Server::#Opcode_Ping
PrintN(" #### Ping from *Client " + *Client)
Case WebSocket_Server::#Opcode_Text
JSON_ID = CatchJSON(#PB_Any, *Event_Frame\Payload, *Event_Frame\Payload_Size)
If JSON_ID
Select GetJSONString(GetJSONMember(JSONValue(JSON_ID), "Type"))
Case "Message"
ExtractJSONStructure(JSONValue(JSON_ID), Chat_Message, Chat_Message)
PrintN(Chat_Message\Author + ": " + Chat_Message\Message)
Debug PeekS(*Event_Frame\Payload, *Event_Frame\Payload_Size, #PB_UTF8)
;Ich kann verste das mit dem JSON nicht, deshalb nenutze ich es nicht
;Relevant ist mich mich "Chat_Message"
;Hier baue ich meine eigene Procedure ein:
;In dieser Procedure wird alles geregelt, was ich benötige
CheckNachricht(*client,Chat_Message)
;Aus "Checknachricht() heraus sende ich auch an die einzelnen Clients.
;Da die Procedure WebSocket_Event() am anfang ein LockMutex(Mutex) benutzt,
;gehe ich davon aus, dass alles was ich innerhalb Checknachricht mache auch geschützt ist.
;Ich benutze innerhalb Checknachricht() KEIN LockMutex(Mutex) - UnLockMutex(Mutex)
Case "Username_Change"
ExtractJSONStructure(JSONValue(JSON_ID), Chat_Username_Change, Chat_Username_Change)
ForEach Client()
If Client()\WebSocket_Client = *Client
Client()\Username = Chat_Username_Change\Username
Break
EndIf
Next
JSON2_ID = CreateJSON(#PB_Any)
If JSON2_ID
Chat_Userlist\Type = "Userlist"
ForEach Client()
AddElement(Chat_Userlist\UserName())
Chat_Userlist\UserName() = Client()\Username
Next
InsertJSONStructure(JSONValue(JSON2_ID), Chat_Userlist, Chat_Userlist)
ForEach Client()
WebSocket_Server::Frame_Text_Send(*Server, Client()\WebSocket_Client, ComposeJSON(JSON2_ID))
Next
FreeJSON(JSON2_ID)
EndIf
EndSelect
FreeJSON(JSON_ID)
EndIf
EndSelect
EndSelect
UnlockMutex(Mutex)
EndProcedure
Edith:
Ich benutze testweise gerade diesen Code:
Code: Alles auswählen
Procedure WebSocket_Server(*Server.ServerStructure)
Protected.i SEvent, ClientID, handshake, i, ClientIP, GadgetItem, ReceivedBytes
Protected *Buffer
Protected Header$, Key$, Accept$, Body$
Protected Byte.a
Protected.i Fin, Opcode, Masked, Payload, Ptr, n, Pos1, Pos2
Protected Dim MaskKey.a(3)
Protected j,k
Protected.s s
Debug "Server"
*Buffer = AllocateMemory(10240)
If *Buffer
Repeat
SEvent = NetworkServerEvent()
If SEvent
ClientID = EventClient()
ClientIP = GetClientIP(ClientID)
Select SEvent
Case #PB_NetworkEvent_Connect
AddMapElement(*Server\Client(), Str(ClientID))
;StatusBarText(0, 1, "Clients: " + Str(MapSize(*Server\Client())), #PB_StatusBar_Center)
;DisableGadget(#TransmitButton, #False)
;DisableGadget(#DisconnectButton, #False)
;AddGadgetItem(#TransmitCombo, -1, Str(ClientID))
;AddGadgetItem(#TransmitCombo, -1, IPString(ClientIP) + " - " + Str(ClientID))
;GadgetItem = CountGadgetItems(#TransmitCombo) - 1
;SetGadgetItemData(#TransmitCombo, GadgetItem, ClientID)
;SetGadgetState(#TransmitCombo, GadgetItem)
Debug "A new client has connected !"
Case #PB_NetworkEvent_Data
FillMemory(*Buffer, 10000)
ReceivedBytes = ReceiveNetworkData(ClientID, *Buffer, 1000)
Debug "Recv: " + Str(ReceivedBytes)
If Not *Server\Client(Str(ClientID))\Handshake
Header$ = PeekS(*Buffer, ReceivedBytes, #PB_UTF8)
Pos1 = FindString(Header$, "Sec-WebSocket-Key: ")
If Pos1
Pos1 + 19
Pos2 = FindString(Header$, #CRLF$, Pos1)
If Pos2
Key$ = Trim(Mid(Header$, Pos1, Pos2 - Pos1))
Accept$ = SecWebsocketAccept(Key$)
EndIf
EndIf
Header$ = "HTTP/1.1 101 Switching Protocols" + #CRLF$
Header$ + "Upgrade: WebSocket"+ #CRLF$
Header$ + "Connection: Upgrade"+ #CRLF$
Header$ + "Sec-WebSocket-Accept: " + Accept$ + #CRLF$
Header$ + #CRLF$
SendNetworkString(ClientID, Header$)
*Server\Client(Str(ClientID))\Handshake = #True
Else
Ptr = 0
Byte = PeekA(*Buffer + Ptr)
If Byte & %10000000
Fin = #True
Else
Fin = #False
EndIf
Opcode = Byte & %00001111
Ptr = 1
Debug "Fin:" + Str(Fin)
Debug "Opcode: " + Str(Opcode)
Byte = PeekA(*Buffer + Ptr)
Masked = Byte >> 7
Payload = Byte & $7F
Ptr + 1
If Payload = 126
Payload = PeekA(*Buffer + Ptr) << 8
Ptr + 1
Payload | PeekA(*Buffer + Ptr)
Ptr + 1
ElseIf Payload = 127
Payload = 0
n = 7
For i = Ptr To Ptr + 7
Payload | PeekA(*Buffer + i) << (8 * n)
n - 1
Next i
Ptr + 8
EndIf
Debug "Masked: " + Str(Masked)
Debug "Payload: " + Str(Payload)
If Masked
n = 0
For i = Ptr To Ptr + 3
MaskKey(n) = PeekA(*Buffer + i)
Debug "MaskKey " + Str(n + 1) + ": " + RSet(Hex(MaskKey(n)), 2, "0")
n + 1
Next i
Ptr + 4
EndIf
Select Opcode
Case #TextFrame
If Masked
n = 0
For i = Ptr To Ptr + Payload - 1
PokeA(*Buffer + i, PeekA(*Buffer + i) ! MaskKey(n % 4))
n + 1
Next i
EndIf
Body$ = PeekS(*Buffer + Ptr, Payload, #PB_UTF8)
;AddGadgetItem(#ReceiveEdit, -1, IPString(ClientIP) + "-" + Str(ClientID) + ": " + Body$)
Debug "Text vom client: "+body$
checknachricht(ClientID,Body$)
Case #ConnectionCloseFrame
WebSocket_ClientDisconnect(ClientID, *Server)
Case #PingFrame
Byte = PeekA(*Buffer) & %11110000
PokeA(*Buffer, Byte | #PongFrame)
SendNetworkData(ClientID, *Buffer, ReceivedBytes)
Default
Debug "Opcode not implemented yet!"
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
WebSocket_ClientDisconnect(ClientID, *Server)
EndSelect
Else
Delay(10)
EndIf
ForEver
FreeMemory(*Buffer)
EndIf
EndProcedure
Ich habe diesen Code ohne Thread hinbekommen.
Funktioniert tadellos, zumindest ohne Abstürze oder Hänger - allerdings kommen nicht immer alle Nachrichten an.
Das war im ersten Code erheblich besser.
__________________________________________________
Quote-Tags>Code-Tags
28.02.2018
RSBasic