Module NetworkFunctions - TCP Daten senden und empfangen
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Mal angenommen mein Buffer ist mit 1460 Bytes schon belegt und es kommt ein 50 Byte großes Paket an. Dann passen die letzten 10 Bytes nicht mehr rein. Wird das Paket geteilt und die letzten 10 Bytes kommen im neuen Buffer danach? Wie kann ich dafür sorgen dass mein 50 Byte Paket immer vollständig ankommt?
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Genau dafür gibt's ja die Header.
Der gibt an, dass jetzt ein neues Datenpaket beginnt und beinhaltet ggf. auch die Größe des nächsten Pakets.
Sagen wir dein Puffer ist 10 Slots groß und die folgenden Daten liegen darin.
H ist ein Header, 1-9 die Größe und a-z sind die Daten
Dann weißt du da ist ein Datenblock der Länge 4, weil da ein Header "H4" gelesen wird.
Diesen Datenblock liest du aus und verarbeitst ihn.
Außerdem hast du noch ein Datenpaket der Größe 3, wovon aber nur 2 Zeichen im Puffer liegen.
Dann speicherst du das irgendwo ab und lässt die Network-Funktionen den Puffer erneut beschreiben
Jetzt weißt du ja, dass vom Paket der Größe 3 noch genau 1 Zeiche fehlt. Das "z" in diesem Fall. Dass danach wieder ein Header kommt bestätigt, dass du das gesamte Paket hast. Jetzt kannst du dein Paket "xyz" weiter verarbeiten und dich um das nächste Paket kümmern. Hier fehlt wieder etwas, da der Header sagt, es kommen 9 Zeichen, aber im Puffer sind nur 7. usw usw usw.
Dann kannst du natürlich auch eine konstante Datenlänge verwenden (z.B. auffüllen mit 0), oder aber keine kopfgesteuerte Längenangabe, sondern Anfang und Ende, z.B. "<meine Daten><weitere Daten>"
Der gibt an, dass jetzt ein neues Datenpaket beginnt und beinhaltet ggf. auch die Größe des nächsten Pakets.
Sagen wir dein Puffer ist 10 Slots groß und die folgenden Daten liegen darin.
H ist ein Header, 1-9 die Größe und a-z sind die Daten
Code: Alles auswählen
H4abcdH3xy
Diesen Datenblock liest du aus und verarbeitst ihn.
Außerdem hast du noch ein Datenpaket der Größe 3, wovon aber nur 2 Zeichen im Puffer liegen.
Dann speicherst du das irgendwo ab und lässt die Network-Funktionen den Puffer erneut beschreiben
Code: Alles auswählen
zH9abcdefg
Dann kannst du natürlich auch eine konstante Datenlänge verwenden (z.B. auffüllen mit 0), oder aber keine kopfgesteuerte Längenangabe, sondern Anfang und Ende, z.B. "<meine Daten><weitere Daten>"
Signatur und so
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Update v1.06
- Bugfix: Es fehlte noch ein TcpReceiveBusy
@Stargate
Beim mehrfachen Aufruf von SendNetworkData werden die Paket im Hintergrund einzeln versenden
und nicht gesammelt und als ein Gesamtpaket versendet.
Das heißt das wenn man einmal 20 byte sendet und einmal 10 byte sendet werden aus diese auch als zwei Pakete gesendet.
Empfangsseitig muss man aber diese leider selber auseinander Bröseln
da mit ReceiveNetworkData aus einem Zwischenspeicher gelesen wird wo alle empfangen Daten für die Verbindung gesammelt werden.
Kannst ja mal zum Testen die Konstante #TCP_BlockSize = 24 setzen und mit z.B mit Wireshark die TCP Protokolle anschauen. (Filter tcp.port == 6037)
#TCP_BlockSize aber nicht unter 20 Byte setzen. Sonst kommt mein Header nicht mehr vollständig an!!!
P.S.
Auch wenn man drei mal SendNetworkData aufruft werden die Pakete nacheinander gesendet.
Erst wenn der erste Aufruft von SendNetworkData vollständig angekommen ist, wird der nächste Aufruf von SendNetwerkData
verarbeitet. Dafür ist das TCP-Protokoll zuständig da diese einen komplexen Handshake beinhaltet.
- Bugfix: Es fehlte noch ein TcpReceiveBusy
@Stargate
Beim mehrfachen Aufruf von SendNetworkData werden die Paket im Hintergrund einzeln versenden
und nicht gesammelt und als ein Gesamtpaket versendet.
Das heißt das wenn man einmal 20 byte sendet und einmal 10 byte sendet werden aus diese auch als zwei Pakete gesendet.
Empfangsseitig muss man aber diese leider selber auseinander Bröseln
da mit ReceiveNetworkData aus einem Zwischenspeicher gelesen wird wo alle empfangen Daten für die Verbindung gesammelt werden.
Kannst ja mal zum Testen die Konstante #TCP_BlockSize = 24 setzen und mit z.B mit Wireshark die TCP Protokolle anschauen. (Filter tcp.port == 6037)
#TCP_BlockSize aber nicht unter 20 Byte setzen. Sonst kommt mein Header nicht mehr vollständig an!!!
P.S.
Auch wenn man drei mal SendNetworkData aufruft werden die Pakete nacheinander gesendet.
Erst wenn der erste Aufruft von SendNetworkData vollständig angekommen ist, wird der nächste Aufruf von SendNetwerkData
verarbeitet. Dafür ist das TCP-Protokoll zuständig da diese einen komplexen Handshake beinhaltet.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Nein, dem ist leider nicht so. Ich kannst heute schlechter Testen als damals wo ich n 1000er Leitung hatte, aber ich bin mir sehr sicher, dass SendNetworkData() sofort ein Rückgabewert liefert, und nicht auf den Empfang beim Partner wartet.mk-soft hat geschrieben:Erst wenn der erste Aufruft von SendNetworkData vollständig angekommen ist, wird der nächste Aufruf von SendNetwerkData verarbeitet. Dafür ist das TCP-Protokoll zuständig da diese einen komplexen Handshake beinhaltet.
Das weiß ich, weil ich damals ich glaube 10kBit Upload hatte und trotzdem immer sofort die Rückmeldung bekam, obwohl der Upload nie mal so schnell gehen hätte können.
Ich hab einfach mal n Beispiel mit deinem Include programmiert und ich bekommen "je nach Situation" früher oder später (bei mir zB beim 51. Paket) ein
"ReceiveData: Error - Header Size"
Wenn ich dann aber weiter lese, sehe ich in der Speicheranzeige genau, dass zB. noch zwei Bytes vom Header gefehlt hätten und dann mein "Hallo" kommt.
PS: Solltest du aber über "echte" Verbindung testen, nicht localhost oder so.
Code: Alles auswählen
XIncludeFile "NetworkFunctions.pb"
UseModule NetworkTCP
InitNetwork()
CreateNetworkServer(1, 7016)
Global ConnectionID = OpenNetworkConnection("***", 7016)
Debug ConnectionID
Procedure SendThread(Void)
Protected Length.i, Result.i
Repeat
Length = Random(50000, 10000)
Result = TcpSendString(ConnectionID, "Hallo"+Space(Length-5), #PB_Unicode)
Debug "Gesendet = "+Result
ForEver
EndProcedure
CreateThread(@SendThread(), 0)
Define String.s
Repeat
Select NetworkServerEvent(1)
Case #PB_NetworkEvent_Connect
TcpNewClientData(EventClient(), 1)
Case #PB_NetworkEvent_Data
Select TcpReceiveData(EventClient())
Case #TcpReceiveDone
String = TcpGetString(EventClient())
Debug "Empfangen = "+Len(String)+" : "+Left(String,30)
Case #TcpReceiveError
Debug "ERROR !!"
Delay(1000)
*Buffer = AllocateMemory(100)
NetworkServerEvent(1)
ReceiveNetworkData(EventClient(), *Buffer, 100)
ShowMemoryViewer(*Buffer, 100)
CallDebugger
EndSelect
EndSelect
ForEver
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Threadsafe eingeschaltet?
Werde mal sicherheitabfrage im Module einbauen das Threadsafe aktiviert sein muss...
Ihr mal nicht 200000 Byte...
Werde mal sicherheitabfrage im Module einbauen das Threadsafe aktiviert sein muss...
Ihr mal nicht 200000 Byte...
Code: Alles auswählen
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Opetion Threadsafe einschalten!"
CompilerEndIf
XIncludeFile "NetworkFunctions.pb"
UseModule NetworkTCP
InitNetwork()
CreateNetworkServer(1, 7016)
Global ConnectionID = OpenNetworkConnection("127.0.0.1", 7016)
Debug ConnectionID
Procedure SendThread(Void)
Protected Length.i, Result.i
Delay(5000)
Repeat
Length = Random(200000, 10000)
Result = TcpSendString(ConnectionID, "Hallo"+Space(Length-5), #PB_Unicode)
Debug "Gesendet = "+Result
;Delay(10)
ForEver
EndProcedure
CreateThread(@SendThread(), 0)
Define String.s
Repeat
Select NetworkServerEvent(1)
Case #PB_NetworkEvent_Connect
TcpNewClientData(EventClient(), 1)
Case #PB_NetworkEvent_Data
Select TcpReceiveData(EventClient())
Case #TcpReceiveDone
String = TcpGetString(EventClient())
Debug "Empfangen = "+Len(String)+" : "+Left(String,30)
Case #TcpReceiveError
Debug "ERROR !!"
Delay(1000)
*Buffer = AllocateMemory(100)
NetworkServerEvent(1)
ReceiveNetworkData(EventClient(), *Buffer, 100)
ShowMemoryViewer(*Buffer, 100)
CallDebugger
EndSelect
EndSelect
ForEver
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Threadsafe ist an.
>> "Ihr mal nicht 200000 Byte..."
Was meinst du?
Mit Random(200000, 10000) sind die Pakete zu groß und das Problem taucht ja erst dann mit einer höheren Wahrscheinlichkeit auf, wenn viele "mittelgroße" Pakete verschickt werden.
Mach mal auf Random(20000, 10000) und baue die Verbindung über deine öffentliche IP auf, das die Daten auch überhaupt den PC verlassen.
Brauche den (auch dein) Code nur zu starten und bekomme ohne lange zu warten:und
>> "Ihr mal nicht 200000 Byte..."
Was meinst du?
Mit Random(200000, 10000) sind die Pakete zu groß und das Problem taucht ja erst dann mit einer höheren Wahrscheinlichkeit auf, wenn viele "mittelgroße" Pakete verschickt werden.
Mach mal auf Random(20000, 10000) und baue die Verbindung über deine öffentliche IP auf, das die Daten auch überhaupt den PC verlassen.
Brauche den (auch dein) Code nur zu starten und bekomme ohne lange zu warten:
Code: Alles auswählen
[...]
Gesendet = 103
Gesendet = 104
Empfangen = 16263 : Hallo
[1EE1AB0] ReceiveData: Init/Busy (0/12108)
Gesendet = 105
[1EE1AB0] ReceiveData: Done (12108/12108)
Empfangen = 6053 : Hallo
[1EE1AB0] ReceiveData: Init/Busy (0/4444)
[1EE1AB0] ReceiveData: Done (4444/4444)
Empfangen = 2221 : Hallo
[1EE1AB0] ReceiveData: Init/Busy (0/17676)
[1EE1AB0] ReceiveData: Done (17676/17676)
Empfangen = 8837 : Hallo
[1EE1AB0] ReceiveData: Init/Busy (0/31882)
[1EE1AB0] ReceiveData: Busy (9356/31882)
[1EE1AB0] ReceiveData: Busy (23436/31882)
[1EE1AB0] ReceiveData: Done (31882/31882)
Empfangen = 15940 : Hallo
[1EE1AB0] ReceiveData: Error - Header Size
ERROR !!
Gesendet = 106
Gesendet = 107
Gesendet = 108
Gesendet = 109
Gesendet = 110
Gesendet = 111
Code: Alles auswählen
00000000004512F0 00 00 00 00 00 00 70 83 00 00 17 83 00 00 48 00 ......p.....H.
0000000000451300 61 00 6C 00 6C 00 6F 00 20 00 20 00 20 00 20 00 a.l.l.o. . . . .
0000000000451310 20 00 20 00 20 00 20 00 20 00 20 00 20 00 20 00 . . . . . . . .
0000000000451320 20 00 20 00 20 00 20 00 20 00 20 00 20 00 20 00 . . . . . . . .
0000000000451330 20 00 20 00 20 00 20 00 20 00 20 00 20 00 20 00 . . . . . . . .
0000000000451340 20 00 20 00 20 00 20 00 20 00 20 00 20 00 20 00 . . . . . . . .
0000000000451350 20 00 20 00 . .
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Werde ich mal testen...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Module wieder freigeben
Update v1.08
- Bugfix Speicherleck
- Bugfix Header Kontrolle
Ewig ein Speicherleck mit AppCrash gesucht. Schwierig bei Threaded-Variablen!
Update v1.08
- Bugfix Speicherleck
- Bugfix Header Kontrolle
Ewig ein Speicherleck mit AppCrash gesucht. Schwierig bei Threaded-Variablen!
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Test Server und Client v1.16
Server
[/size]
Client
[/size]
Server
Code: Alles auswählen
;-TOP
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compileroption Threadsafe!"
CompilerEndIf
EnableExplicit
IncludeFile "NetworkFunctions.pb"
UseModule NetworkTCP
Enumeration Windows
#WinMain
EndEnumeration
Enumeration #PB_Event_FirstCustomValue
#My_Event_Logging
EndEnumeration
; -----------------------------------------------------------------------------------
Structure udtClientData
ConnectionID.i
Date.i
Login.i
Name.s
Text.s
EndStructure
Structure udtServerData
*ThreadID
*ServerID
ExitServer.i
Map Client.udtClientData()
EndStructure
Global ExitApplication
Global ServerData.udtServerData
Global ServerMutex = CreateMutex()
; -----------------------------------------------------------------------------
;-Testdaten
Global *Random1 = AllocateMemory(200000)
Global *Random2 = AllocateMemory(2000000)
RandomSeed(1000)
RandomData(*Random1, 200000)
RandomSeed(2000)
RandomData(*Random2, 2000000)
;ShowMemoryViewer(*Random1, 64)
Enumeration ProtocolID 1
#ProtocolString
#ProtocolRandom1
#ProtocolRandom2
EndEnumeration
; -----------------------------------------------------------------------------
; 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
Procedure thLogging(Text.s)
PostEvent(#My_Event_Logging, 0, 0, 0, AllocateString(Text))
EndProcedure
Procedure Logging(Text.s)
Protected rows
AddGadgetItem(0, -1, Text)
rows = CountGadgetItems(0)
SetGadgetState(0, rows - 1)
SetGadgetState(0, -1)
EndProcedure
; -----------------------------------------------------------------------------
; Dies ist der Server-Dienst der die Daten im Hintergrund verarbeitet
Procedure ThreadServer(*ServerData.udtServerData)
Protected Event, ConnectionID, keyConnectionID.s, count, Text.s, Name.s, ok, time
Protected NewList ClosedConnectionID()
Protected NewList ListConnectionID()
Protected ndr.sReceiveData
With *ServerData
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Protected StopNap = BeginWork(#NSActivityLatencyCritical | #NSActivityUserInitiated, Hex(*ServerData))
CompilerEndIf
time = ElapsedMilliseconds()
Repeat
LockMutex(ServerMutex)
Event = NetworkServerEvent(\ServerID)
If Event
ConnectionID = EventClient()
keyConnectionID = Hex(ConnectionID)
EndIf
UnlockMutex(ServerMutex)
Select Event
Case #PB_NetworkEvent_Connect
; Daten für Client anlegen
TcpNewClientData(ConnectionID, \ServerID)
thLogging("Network: Client Connected: ID " + keyConnectionID)
Case #PB_NetworkEvent_Data
Select TcpReceiveData(ConnectionID)
Case #TcpReceiveBusy
; Daten noch nicht vollständig
Case #TcpReceiveDone
TcpGetReceiveData(ConnectionID, ndr)
Select ndr\ProtocolID
Case #ProtocolString
Text = TcpGetString(ConnectionID)
TcpGetClientList(\ServerID, ListConnectionID())
If LCase(Text) = "#get"
ForEach ListConnectionID()
TcpSendString(ndr\ConnectionID, "Client ID " + Hex(ListConnectionID()), #PB_Unicode, #TcpSendAsynchron, ndr\TransactionID, #ProtocolString)
Next
Else
ForEach ListConnectionID()
TcpSendString(ListConnectionID(), "Text: " + Text, #PB_Unicode, #TcpSendASynchron, ndr\TransactionID, #ProtocolString)
Next
EndIf
Case #ProtocolRandom1
If CompareMemory(ndr\Data, *Random1, ndr\DataLen)
Text = "Random 1 Ok"
Else
Text = "Random 1 Error"
EndIf
FreeMemory(ndr\Data)
TcpSendString(ndr\ConnectionID, Text, #PB_Unicode, #TcpSendAsynchron, ndr\TransactionID, #ProtocolString)
Case #ProtocolRandom2
If CompareMemory(ndr\Data, *Random2, ndr\DataLen)
Text = "Random 2 Ok"
Else
Text = "Random 2 Error"
EndIf
FreeMemory(ndr\Data)
TcpSendString(ndr\ConnectionID, Text, #PB_Unicode, #TcpSendAsynchron, ndr\TransactionID, #ProtocolString)
EndSelect
Case #TcpReceiveEmpty
; Nur Header empfangen
Case #TcpReceiveCancel
; Abbruch empfangen
thLogging("Network Cancel Data: Client ConnectionID " + keyConnectionID + " TransactionID " + ndr\TransactionID)
Case #TcpReceiveError
; Im Fehlerfall Client entfernen
thLogging("Network Error: Client ConnectionID " + keyConnectionID + " Errorcode " + Str(TcpGetReceiveError(ConnectionID)))
CloseNetworkConnection(ConnectionID)
TcpFreeClientData(ConnectionID, \ServerID)
EndSelect
Case #PB_NetworkEvent_Disconnect
TcpFreeClientData(ConnectionID)
; Daten von Client entfernen
thLogging("Network: Client Disconnected: ID " + keyConnectionID)
Default
; Alle 5 Sekunden nach verlorende Clients suchen und Resoursen freigeben
If ElapsedMilliseconds() - time > 5000 ; ms
time = ElapsedMilliseconds()
TcpCheckClientData(\ServerID, ClosedConnectionID())
ForEach ClosedConnectionID()
thLogging("Network: Client Timeout: ID " + ClosedConnectionID())
Next
EndIf
Delay(10)
EndSelect
Until \ExitServer
Delay(500)
; Alle Client Daten freigeben
TcpFreeClientData(0, \ServerID)
; Server beenden, Daten bereinigen und Thread verlassen
CloseNetworkServer(\ServerID)
\ThreadID = 0
\ServerID = 0
\ExitServer = 0
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
EndWork(StopNap)
CompilerEndIf
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
EnableDebugger
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
; -----------------------------------------------------------------------------
Procedure Main()
Protected Event, rows
If OpenWindow(#WinMain, #PB_Ignore, #PB_Ignore, 600, 400, "Test-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()
Client
Code: Alles auswählen
;-
EnableExplicit
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compileroption Threadsafe!"
CompilerEndIf
EnableExplicit
IncludeFile "NetworkFunctions.pb"
UseModule NetworkTCP
Enumeration Windows
#WinMain
EndEnumeration
Enumeration MenuItems
#MenuItem_Send
#MenuItem_Connect
#MenuItem_Disconnect
EndEnumeration
Enumeration #PB_Event_FirstCustomValue
#My_Event_Logging
#My_Event_Statusbar
EndEnumeration
; -----------------------------------------------------------------------------
Structure udtMyClientData
*ThreadID
*ConnectionID
ExitClient.i
EndStructure
; -----------------------------------------------------------------------------
;-Testdaten
Global *Random1 = AllocateMemory(200000)
Global *Random2 = AllocateMemory(2000000)
RandomSeed(1000)
RandomData(*Random1, 200000)
RandomSeed(2000)
RandomData(*Random2, 2000000)
Enumeration ProtocolID 1
#ProtocolString
#ProtocolRandom1
#ProtocolRandom2
EndEnumeration
; -----------------------------------------------------------------------------
; 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
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
; -----------------------------------------------------------------------------
; Statusbar aus Threads
Procedure thStatusBarText(StatusBar, Field, Text.s)
PostEvent(#My_Event_Statusbar, 0, StatusBar, Field, AllocateString(Text))
EndProcedure
; -----------------------------------------------------------------------------
; Dies ist der Client-Dienst der die Daten im Hintergrund verarbeitet
Procedure ThreadClient(*MyClientData.udtMyClientData)
Protected Event, count, Text.s, Size, time1, time2
Static Error
With *MyClientData
If Not TcpNewClientData(\ConnectionID, 0)
ProcedureReturn 0
EndIf
Repeat
Event = NetworkClientEvent(\ConnectionID)
Select Event
Case #PB_NetworkEvent_Data
If TcpReceiveData(\ConnectionID) = #TcpReceiveDone
Select TcpGetProtocolID(\ConnectionID)
Case #ProtocolString
Text = TcpGetString(\ConnectionID)
thLogging(Text)
If Right(Text,5) = "Error"
Error + 1
thStatusBarText(0, 0, "Error = " + Error)
EndIf
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
; Server hat die Verbindung beendet
\ExitClient = 1
thStatusBarText(0, 0, "Disconnect from Server")
Default
Delay(20)
If ElapsedMilliseconds() - time1 > 5000
time1 = ElapsedMilliseconds()
If TcpGetSendDataSize(\ConnectionID) < 5
If Random(1)
Size = Random(200000, 100000)
TcpSendData(\ConnectionID, *Random1, Size, #TcpSendASynchron, 0, #ProtocolRandom1)
Else
Size = Random(2000000, 100000)
TcpSendData(\ConnectionID, *Random2, Size, #TcpSendAsynchron, 0, #ProtocolRandom2)
EndIf
EndIf
EndIf
EndSelect
Until \ExitClient
; Exit Thread
TcpFreeClientData(\ConnectionID)
CloseNetworkConnection(\ConnectionID)
\ThreadID = 0
\ConnectionID = 0
\ExitClient = 0
EndWith
EndProcedure
; -----------------------------------------------------------------------------
; Hier wird die Verbindung zum Server angelegt und beim erfolg der Thread gestartet der die Client-Dienste ausführt
Procedure SendDataCB(Status, TransactionID, DataOffset, DataLen)
Select Status
Case #TcpSendBusy
thStatusBarText(0, 1, "Send Busy")
thStatusBarText(0, 2, Str(TransactionID))
thStatusBarText(0, 3, Str(DataOffset) + "/" + Str(DataLen))
If DataOffset > 175000
;ProcedureReturn #True
EndIf
Case #TcpSendDone
thStatusBarText(0, 1, "Send Done")
thStatusBarText(0, 2, Str(TransactionID))
thStatusBarText(0, 3, Str(DataOffset) + "/" + Str(DataLen))
Case #TcpSendCancel
thStatusBarText(0, 1, "Send Cancel")
thStatusBarText(0, 2, Str(TransactionID))
thStatusBarText(0, 3, Str(DataOffset) + "/" + Str(DataLen))
Case #TcpSendError
thStatusBarText(0, 1, "Send Error")
thStatusBarText(0, 2, Str(TransactionID))
thStatusBarText(0, 3, Str(DataOffset) + "/" + Str(DataLen))
EndSelect
ProcedureReturn #False
EndProcedure
; -----------------------------------------------------------------------------
Procedure InitClient(*MyClientData.udtMyClientData, IP.s, Port, Timeout = 0)
Protected ConnectionID
With *MyClientData
If \ConnectionID
ProcedureReturn \ConnectionID
EndIf
ConnectionID = OpenNetworkConnection(IP, Port, #PB_Network_TCP, Timeout)
If ConnectionID
\ConnectionID = ConnectionID
\ThreadID = CreateThread(@ThreadClient(), *MyClientData)
If \ThreadID
Logging("Network: Init Client: ID " + Hex(ConnectionID))
StatusBarText(0, 0, "Connect")
TcpSetSendDataCallback(ConnectionID, @SendDataCB())
SetActiveGadget(1)
Else
Logging("Network: Error Init Thread")
EndIf
Else
Logging("Network: Error Init Connection")
StatusBarText(0, 0, "Error")
EndIf
ProcedureReturn ConnectionID
EndWith
EndProcedure
; -----------------------------------------------------------------------------
; Hier wird das Beenden der Verbindung zu Server angestossen
; Sollte diese nicht erfolgreich sein, wird die Verbindung und der Thread zwangsweise geschlossen
Procedure CloseClient(*MyClientData.udtMyClientData)
Protected timeout
With *MyClientData
If \ConnectionID = 0
ProcedureReturn 0
EndIf
Logging("Network: Close Network Connection: ID " + Hex(\ConnectionID))
\ExitClient = 1
Repeat
If \ExitClient = 0
Break
Else
timeout + 100
If timeout > 10000
CloseNetworkConnection(\ConnectionID)
KillThread(\ThreadID)
\ThreadID = 0
\ConnectionID = 0
\ExitClient = 0
Logging("Network: Error - Kill Network Connection: ID " + Hex(\ConnectionID))
Break
EndIf
EndIf
Delay(100)
ForEver
EndWith
EndProcedure
; -----------------------------------------------------------------------------
;- Main
Global ExitApplication
Global MyClientData.udtMyClientData
Global Host.s = "127.0.0.1"
;Global Host.s = "192.168.170.40"
Global Port = 6037
Procedure Main()
Protected Event, rows, text.s
If OpenWindow(#WinMain, #PB_Ignore, #PB_Ignore, 600, 400, "Test-Client",#PB_Window_SystemMenu)
CreateStatusBar(0, WindowID(#WinMain))
AddStatusBarField(160)
AddStatusBarField(100)
AddStatusBarField(100)
AddStatusBarField(#PB_Ignore)
CreateMenu(0, WindowID(#WinMain))
MenuTitle("Network")
MenuItem(#MenuItem_Connect, "Connect")
MenuItem(#MenuItem_Disconnect, "Disconnect")
ListViewGadget(0, 0, 0, WindowWidth(0), WindowHeight(0) - StatusBarHeight(0) - MenuHeight() - 35)
StringGadget(1, 5, GadgetHeight(0) + 5, WindowWidth(0) - 10, 25, "")
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Return, #MenuItem_Send)
; LOOP
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Menu
Select EventMenu()
Case #MenuItem_Connect
InitClient(MyClientData, Host, Port)
Case #MenuItem_Disconnect
CloseClient(MyClientData)
Case #MenuItem_Send
If GetActiveGadget() = 1 And MyClientData\ConnectionID
text = GetGadgetText(1)
If 1; text > ""
TcpSendString(MyClientData\ConnectionID, text, #PB_Unicode, #TcpSendSynchron,0, #ProtocolString)
SetGadgetText(1, "")
EndIf
EndIf
EndSelect
Case #PB_Event_CloseWindow
Select EventWindow()
Case #WinMain
CloseClient(MyClientData)
ExitApplication = #True
EndSelect
Case #My_Event_Logging
Logging(FreeString(EventData()))
Case #My_Event_Statusbar
StatusBarText(EventGadget(), EventType(), FreeString(EventData()))
EndSelect
Until ExitApplication And MyClientData\ExitClient = 0
EndIf
EndProcedure
InitNetwork()
Main()
Zuletzt geändert von mk-soft am 26.10.2019 12:57, insgesamt 7-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Module NetworkFunctions - TCP Daten senden und empfangen
Der größte Bug sitzt zwischen Stuhl und Monitor
Jeder Client braucht sein eigenen ReceiveBuffer. Warum ich das diesmal übersehen habe weis ich nicht...
Update v1.09
- Bugfix ReceiveBuffer
P.S. Testlauf
Läuft jetzt seit mehreren Stunden auf vier Rechner...
- Server: Window 7 Pro
- Clients: 4 * auf Window, 3 * auf Linux, 4 * auf MacOS
Jeder Client braucht sein eigenen ReceiveBuffer. Warum ich das diesmal übersehen habe weis ich nicht...
Update v1.09
- Bugfix ReceiveBuffer
P.S. Testlauf
Läuft jetzt seit mehreren Stunden auf vier Rechner...
- Server: Window 7 Pro
- Clients: 4 * auf Window, 3 * auf Linux, 4 * auf MacOS
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive