Module NetworkFunctions - TCP Daten senden und empfangen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
NeoChris
Beiträge: 205
Registriert: 21.11.2013 21:17
Wohnort: Schweiz
Kontaktdaten:

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von NeoChris »

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?
Derren
Beiträge: 557
Registriert: 23.07.2011 02:08

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von Derren »

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

Code: Alles auswählen

H4abcdH3xy
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

Code: Alles auswählen

zH9abcdefg
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>"
Signatur und so
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von mk-soft »

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.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6999
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von STARGÅTE »

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.
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.
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
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von mk-soft »

Threadsafe eingeschaltet?

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
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6999
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von STARGÅTE »

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:

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
und

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
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von mk-soft »

Werde ich mal testen...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von mk-soft »

Module wieder freigeben

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
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von mk-soft »

Test Server und Client v1.16
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()
[/size]

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()
[/size]
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
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkFunctions - TCP Daten senden und empfangen

Beitrag von mk-soft »

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

:wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten