Zum Senden und Empfangen werden die String über einen Header mit der Länge des String gesendet und empfangen.
Der Client ist auf Localhost (127.0.0.1) voreingestellt. Man kann aber den Server auch auf eine andere Maschine starten und den Host (IP) im client anpassen.
Für Erweiterung des Beispiel und der Beschreibung bin ich offen. Ist erst mal ein Anfang
Update v1.01
- Bugfix
Server
Code: Alles auswählen
;-TOP
; Version v1.01
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compileroption Threadsafe!"
CompilerEndIf
EnableExplicit
Enumeration Windows
#WinMain
EndEnumeration
Enumeration #PB_Event_FirstCustomValue
#My_Event_Logging
EndEnumeration
; -----------------------------------------------------------------------------
Structure udtClientData
ConnectionID.i
Date.i
Text.s
EndStructure
Structure udtServerData
*ThreadID
*ServerID
ExitServer.i
Map Client.udtClientData()
EndStructure
; -----------------------------------------------------------------------------
Structure udtAny
StructureUnion
aVal.a[0]
bVal.b[0]
cVal.c[0]
wVal.w[0]
uVal.u[0]
iVal.i[0]
lVal.l[0]
qVal.q[0]
fVal.f[0]
dVal.d[0]
EndStructureUnion
EndStructure
Structure udtNetString
len.l
pData.udtAny
EndStructure
; -----------------------------------------------------------------------------
; Bei Linux und MacOS kann man Gadgets nicht aus Threads ändern. Daher werden die Texte über PostEvent zur Liste gesendet.
Procedure AllocateString(Text.s)
Protected *mem.String
*mem = AllocateStructure(String)
*mem\s = Text
ProcedureReturn *mem
EndProcedure
Procedure.s FreeString(*Text.String)
Protected result.s
If *Text
result = *text\s ;PeekS(*Text)
FreeStructure(*Text)
EndIf
ProcedureReturn result
EndProcedure
; Logging aus Threads
Procedure thLogging(Text.s)
PostEvent(#My_Event_Logging, 0, 0, 0, AllocateString(Text))
EndProcedure
; Logging aus Mainscope
Procedure Logging(Text.s)
Protected rows
AddGadgetItem(0, -1, Text)
rows = CountGadgetItems(0)
SetGadgetState(0, rows - 1)
SetGadgetState(0, -1)
EndProcedure
; -----------------------------------------------------------------------------
; Um ein String über Netzwerk zu versenden wird am Anfang die Länge in Bytes von den String eingetragen.
; Somit weiss man wie viele Bytes aus dem Empfangsbuffer gelesen werden muss um den gesamten String zu erhalten
Procedure NetSendString(ConnectionID, Text.s)
Protected *Buffer.udtNetString, len, cnt
len = StringByteLength(Text)
If len > 65536 - SizeOf(Long)
ProcedureReturn 0; Daten zu lang
EndIf
*Buffer = AllocateMemory(len + SizeOf(Long))
*Buffer\len = Len
CopyMemory(@Text, *Buffer\pData, len)
len + SizeOf(Long)
cnt = SendNetworkData(ConnectionID, *Buffer, len)
FreeMemory(*Buffer)
ProcedureReturn cnt
EndProcedure
; -----------------------------------------------------------------------------
Procedure.s NetReceiveString(ConnectionID, *Error.Integer = 0)
Protected len, cnt, size, timeout, error, *Buffer, NetStringLen, *NetString, result.s
; Stringlänge aus Empfangsbuffer lesen
len = ReceiveNetworkData(ConnectionID, @NetStringLen, 4)
If NetStringLen
*NetString = AllocateMemory(NetStringLen + SizeOf(Character))
Else
ProcedureReturn ""
EndIf
*Buffer = AllocateMemory(65536)
size = 65536
If size > NetStringLen
size = NetStringLen
EndIf
; String aus Empfangsbuffer lesen bis dieser vollständig ist
Repeat
len = ReceiveNetworkData(ConnectionID, *Buffer, size)
If len > 0
CopyMemory(*Buffer, *NetString + cnt, len)
cnt + len
If size > (NetStringLen - cnt)
size = (NetStringLen - cnt)
EndIf
timeout = 0
Else
Delay(10)
timeout + 10 ; Millisecond
If timeout >= 5000
error = #True ; Communication error
Break
EndIf
EndIf
Until cnt >= NetStringLen
result = PeekS(*NetString)
If *Error
*Error\i = error
EndIf
FreeMemory(*Buffer)
FreeMemory(*NetString)
ProcedureReturn result
EndProcedure
; -----------------------------------------------------------------------------
; Dies ist der Server-Dienst der die Daten im Hintergrund verarbeitet
Procedure ThreadServer(*ServerData.udtServerData)
Protected Event, ConnectionID, keyConnectionID.s, count, Text.s
With *ServerData
Repeat
Event = NetworkServerEvent(\ServerID)
If Event
ConnectionID = EventClient()
keyConnectionID = Hex(ConnectionID)
EndIf
Select Event
Case #PB_NetworkEvent_Connect
; Daten für neuen Client anlegen
If FindMapElement(\Client(), keyConnectionID)
DeleteMapElement(\Client(), keyConnectionID) ; Sollte nicht passieren
EndIf
AddMapElement(\Client(), keyConnectionID)
\Client()\ConnectionID = ConnectionID
\Client()\Date = Date()
thLogging("Network: Client connected: ID " + keyConnectionID)
Case #PB_NetworkEvent_Data
; String aus Empfangbuffer lesen
Text = NetReceiveString(ConnectionID)
If FindMapElement(\Client(), keyConnectionID)
\Client()\Date = Date()
\Client()\Text = Text
EndIf
; An alle anderen Clients senden
ForEach \Client()
If \Client()\ConnectionID <> ConnectionID
NetSendString(\Client()\ConnectionID, "Empfang: " + Text)
EndIf
Next
; Bestätigung senden
count = MapSize(\Client()) - 1
NetSendString(ConnectionID, "Senden ("+ count + "): " + Text)
Case #PB_NetworkEvent_Disconnect
; Daten von Client entfernen
thLogging("Network: Client disconnected: ID " + keyConnectionID)
If FindMapElement(\Client(), keyConnectionID)
DeleteMapElement(\Client(), keyConnectionID)
EndIf
Default
Delay(10)
EndSelect
Until \ExitServer
; Server Shutdown Text an alle Clients senden
ForEach \Client()
NetSendString(\Client()\ConnectionID, "Server Shutdown")
Next
; Server beenden, Daten bereinigen und Thread verlassen
CloseNetworkServer(\ServerID)
\ThreadID = 0
\ServerID = 0
\ExitServer = 0
ClearMap(\Client())
EndWith
EndProcedure
; -----------------------------------------------------------------------------
; Hier wird der Server angelegt und beim erfolg der Thread gestartet der die Server-Dienste ausführt
Procedure InitServer(*ServerData.udtServerData, Port, BindedIP.s = "")
Protected ServerID
With *ServerData
ServerID = CreateNetworkServer(#PB_Any, Port, #PB_Network_TCP, BindedIP)
If ServerID
\ServerID = ServerID
\ThreadID = CreateThread(@ThreadServer(), *ServerData)
Logging("Network: Init Server: ID " + Hex(ServerID))
Else
Logging("Network: Error Init Network Server")
EndIf
ProcedureReturn ServerID
EndWith
EndProcedure
; -----------------------------------------------------------------------------
; Hier wird das Beenden des Servers angestossen
; Sollte diese nicht erfolgreich sein, wird der Server und der Thread zwangsweise geschlossen
Procedure CloseServer(*ServerData.udtServerData)
Protected timeout
With *ServerData
If \ServerID = 0
ProcedureReturn 0
EndIf
Logging("Network: Close Network Server: ID " + \ServerID)
\ExitServer = 1
Repeat
If \ExitServer = 0
Break
Else
timeout + 100
If timeout > 10000
CloseNetworkServer(\ServerID)
KillThread(\ThreadID)
\ThreadID = 0
\ServerID = 0
\ExitServer = 0
ClearMap(\Client())
Logging("Network: Error - Kill Network Server: ID " + \ServerID)
Break
EndIf
EndIf
Delay(100)
ForEver
EndWith
EndProcedure
; -----------------------------------------------------------------------------
Global ExitApplication
Global ServerData.udtServerData
Procedure Main()
Protected Event, rows
If OpenWindow(#WinMain, #PB_Ignore, #PB_Ignore, 600, 400, "MiniChat-Server",#PB_Window_SystemMenu)
CreateStatusBar(0, WindowID(#WinMain))
AddStatusBarField(100)
AddStatusBarField(#PB_Ignore)
ListViewGadget(0, 0, 0, WindowWidth(0), WindowHeight(0) - StatusBarHeight(0))
; Init Server
InitServer(ServerData, 6037)
; LOOP
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
Select EventWindow()
Case #WinMain
CloseServer(ServerData)
ExitApplication = #True
EndSelect
Case #My_Event_Logging
Logging(FreeString(EventData()))
EndSelect
Until ExitApplication And ServerData\ExitServer = 0
EndIf
EndProcedure
InitNetwork()
Main()