Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Code: Alles auswählen
H4abcdH3xy
Code: Alles auswählen
zH9abcdefgNein, 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.
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
ForEverCode: 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
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 . .
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()
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()
