Module NetworkTCP - Send and Receive Data over 64kB

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

This is my current module to send and receive data over TCP.
Description in the module.

Update v1.17
- Optimize Stop SendThread

Update v1.18r2
- Bugfix MacOS SendNetworData (PB Bug?)

Update v1.19
- Add Macro Bugfix macOS SendNetworkData

Update v1.20.1
- Bugfix TcpSendString Format

Update v1.20.2
- Optimize Send data buffer overflow

Update v1.21.1
- Change Header to enable BlockSize over 64KB

Update v1.21.3
- Check socket before send data

Update v1.21.4
- Rename structures
- Changed query data complete
- Changed default data block size

NetworkFunctions.pb

Code: Select all

;-TOP

; Comment : Module NetworkTCP
; Author  : mk-soft
; Version : v1.21.4
; Create  : 18.02.2019
; Update  : 16.07.2023
; OS      : All
; Link    : https://www.purebasic.fr/english/viewtopic.php?f=12&t=73882

; ***************************************************************************************
;
;-Deutsch:
; 
; Um die Daten oder den String über Netzwerk zu versenden wird am Anfang ein Header eingefügt.
; In diesen wird eine fortlaufende TransactionID, die ProtocolID und die DataLen in Bytes eingetragen.
; Somit weiss man wie viele Bytes aus dem Empfangsbuffer gelesen werden muss,
; um die gesamten Daten oder den String zu erhalten.
; 
; Mit der ProtocolID kann zum Beispiel verschiedene Daten und Strings über die gleiche Verbindung senden. 
; Dazu trägt man beim senden eine eigene ProtocolID ein und fragt nach dem Empfang die ProtocolID ab
; bevor man die Daten oder Strings übernimmt.
; 
; PB OpenNetworkServer(...)
; 
; NetworkEvents:
; 
; - #PB_NetworkEvent_Connect:
; 
;   * TcpNewClientData(...) aufrufen um für den Client Daten bereit zu stellen
;     Die ServerID ist nur erforderlich wenn mehrere Server oder Client in Programm verwendet werden.
; 
; - #PB_NetworkEvent_Data:
; 
;   * TcpReceiveData(...) aufrufen um die Daten anzuholen
;     Der Rückgabewert gibt den Status des Abholen der Daten an
;     - #TcpReceiveBusy : Daten noch nicht vollständig
;     - #TcpReceiveDone : Daten vollständig
;     - #TcpReceiveEmpty : Nur Header gesendet. Keine Daten gesendet
;     - #TcpReceiveCancel : Daten senden vom Sender abgebrochen. Daten gelöscht
;     - #TcpReceiveError : Fehler
;       - Fehler 1 : Fehler Größe Header
;       - Fehler 2 : Fehler Checksumme Header
;       - Fehler 3 : Fehler Speicher anfordern. Out Of Memory
;       - Fehler 4 : Fehler ReceiveNetworkData
;       - Fehler 5 : Fehler Datenübernahme
;     - #TcpReceiveErrorClientData : Es wurder keine Client Daten angelegt. Aufruf TcpNewClientData!
; 
; - #PB_NetworkEvent_Disconnect:
; 
;   * TcpFreeClientData(...) aufrufen um den Speicher für den Client freizugeben
; 
; - #PB_NetworkEvent_None:
; 
;   * TcpCheckClientData(...) z.B. alle 5 Sekunden aufrufen (Nur Server)
;     Mit TcpCheckClientData(...) wird der Datenempfang auf verlorende Clients überprüft
;     und bei Timeout (#TCP_Timeout) die Verbindung getrennt und die Resoursen freigegeben.
;     Es kann auch eine eigene Überwachungzeit in Millisekunden angegeben werden.
;     Um die Verbindung zu halten muss dann aber der Client immerhalb dieser Zeit Daten senden. 
; 
;  - Server beenden:
; 
;     * CloseNetworkServer(ServerID) und TcpFreeClientData(0, ServerID) aufrufen.
;       Es werden alle verbliebende Client Daten freigegeben
; 
; 
; PB OpenNetworkConnection(...)
; 
; - Einmalig TcpNewClientData(...) aufrufen und beim benden der Verbindung TcpFeeClientData(...) aufrufen.
; 
; 
; Tcp-Receive Funktionen
; 
; - TcpGetData(...)
;   * Mit TcpGetData erhält man ein Zeiger auf die empfangenden Daten. 
;     Dieser muss nach Verwendung selber mit FreeMemory freigegeben werden.
; 
; - TcpGetString(...)
;   * Mit TcpGetString erhält man dem empfangenden String. 
;     Der Speicher wird automatisch freigeben.
; 
; - TcpGetTransactionID(...)
;   * Abfrage der TransactionID. 
; 
; - TcpGetProtocolID(...)
;   * Abfrage der ProtocolID. 
; 
; - TcpGetDataLen(...)
;   * Abfrage der DataLen 
; 
; - TcpGetReceiveError(...)
;   * Abfrage des Fehlercodes
; 
; - TcpGetClientList(...)
;   * Mit TcpGetClientList erhält man die Anzahl und eine ConnectionID Liste der verbunden Clients.
;     ! Nur Server
; 
; - TcpGetReceiveData(ConnectionID, *pData.sReceiveData)
;   * Mit TcpGetReceiveData erhält man die empfangenden Daten als Struktur. 
;     Den Zeiger auf Data in der Struktur muss nach Verwendung selber mit FreeMemory freigegeben werden.
; 
; Tcp-Send Funktionen
; 
; - TcpSendData(...) und TcpSendString(...)
; 
;   * Beim senden der Daten kann eine eigene TransactionID umd ProtocolID angeben werden. Der Rückgabewert liefert 
;     bei erfolg die eigene TransactionID oder eine eindeutige laufende Nummer zurück.
; 
;   * Die Daten könne Asynchron gesendet werden. Dazu werden die Daten kopiert und in einem Stapel eingetragen.
;     Somit kann der gleiche Speicher oder String sofort wieder verwendet werden.
;     Zum Senden der Daten wird im Hintergrund für jeden Client ein Thread gestartet der die Daten versendet.
;     Dieser Thread wird erst mit TcpFreeClientData(...) beendet.
; 
; - TcpGetSendDataSize(...)
;   * Abfrage der Anzahl von laufenden Sendeaufträgen
; 
; - TcpGetSendError(...)
;   * Abfrage ob beim asyncronen senden ein Fehler aufgetretten ist
; 
; - TcpSetSendDataCallback(ConnectionID, *Callback)
;   * Für asynchrones senden von Daten kann ein Callback gesetzt werden.
;     - Syntax: SendDataCallback(Status, TransactionID, DataOffset, DataLen)
;     
;     Im Status #TcpSendDataBusy kann auch das senden der Daten abgebrochen werden.
;     Diese wird auch zum Empfanger gesendet, damit dieser seinen Empfangsbuffer freigeben kann.
; 
;-English:
; 
; To send the data or the string via network a header is inserted at the beginning.
; In this header a consecutive TransactionID, the ProtocolID and the DataLen are entered in bytes.
; Thus one knows how many bytes must be Read from the receive buffer,
; to get all the data or the string.
; 
; For example, the ProtocolID can be used to send different data and strings over the same connection. 
; To do this, you enter your own ProtocolID when you send and query the ProtocolID after reception.
; before taking over the data or strings.
; 
; PB OpenNetworkServer(...)
; 
; NetworkEvents:
; 
; - #PB_NetworkEvent_Connect:
; 
;   * Call TcpNewClientData(...) to provide data for the client.
;     The ServerID is only required if several servers or clients are used in the program.
; 
; - #PB_NetworkEvent_Data:
; 
;   * Call TcpReceiveData(...) to retrieve the data.
;     The Return value indicates the status of the retrieval of the data.
;     - #TcpReceiveBusy : Data not yet complete
;     - #TcpReceiveDone : Data complete
;     - #TcpReceiveEmpty : Only header sent. No data sent
;     - #TcpReceiveCancel : Send data aborted by sender. Data deleted
;     - #TcpReceiveError : Error
;       - Error 1 : Error size header
;       - Error 2 : Checksum header error
;       - Error 3 : Request memory error. Out Of Memory
;       - Error 4 : Error ReceiveNetworkData
;       - Error 5 : Data transfer error
;     - #TcpReceiveErrorClientData : No client data has been created. Call TcpNewClientData!
; 
; - #PB_NetworkEvent_Disconnect:
; 
;   * Call TcpFreeClientData(...) to free the memory for the client.
; 
; - #PB_NetworkEvent_None:
; 
;   * TcpCheckClientData(...) e.g. call every 5 seconds (Server only)
;     With TcpCheckClientData(...) the data reception is checked for lost clients.
;     and with timeout (#TCP_Timeout) the connection is disconnected and the resources are released.
;     You can also specify your own monitoring time in milliseconds.
;     In order to keep the connection, the client must always send data during this time. 
; 
;  - End server:
; 
;    * Call CloseNetworkServer(ServerID) and TcpFreeClientData(0, ServerID)
;      All remaining client data is released.
;       
; 
; PB OpenNetworkConnection(...)
; 
; - Call TcpNewClientData(...) once And call TcpFeeClientData(...) when terminating the connection.
;   
; 
; Tcp-Receive Functions
; 
; - TcpGetData(...)
;   * With TcpGetData you get a pointer to the receiving data. 
;     This pointer must be released after use with FreeMemory.
; 
; - TcpGetString(...)
;   * With TcpGetString you get the receiving string. 
;     The memory will be released automatically.
; 
; - TcpGetTransactionID(...)
;   * Query the TransactionID. 
; 
; - TcpGetProtocolID(...)
;   * Query of the ProtocolID. 
; 
; - TcpGetDataLen(...)
;   * Query of the DataLen 
; 
; - TcpGetReceiveError(...)
;   * Query of the error code
; 
; - TcpGetClientList(...)
;   * With TcpGetClientList you get the number and a ConnectionID list of the connected clients.
;     ! Server only
; 
; - TcpGetReceiveData(ConnectionID, *pData.sReceiveData)
;   * With TcpGetReceiveData you get the receiving data as a structure. 
;     The pointer to data in the Structure must be released with FreeMemory after use.
; 
; Tcp-Send Functions
; 
; - TcpSendData(...) and TcpSendString(...)
; 
;   * When sending the data, a separate TransactionID and ProtocolID can be specified. The return value returns 
;     If successful, it returns its own TransactionID or a unique sequential number.
; 
;   * The data can be sent asynchronously. To do this, the data is copied and entered in a stack.
;     This means that the same memory or string can be used again immediately.
;     To send the data, a thread is started in the background for each client to send the data.
;     This thread is only terminated with TcpFreeClientData(...).
; 
; - TcpGetSendDataSize(...)
;   * Query of the number of running send jobs
; 
; - TcpGetSendError(...)
;   * Query whether an error occurred when sending asyncrones
; 
; - TcpSetSendDataCallback(ConnectionID, *Callback)
;   * A callback can be set for asynchronous sending of data.
;     - Syntax: SendDataCallback(Status, TransactionID, DataOffset, DataLen)
;     
;     In the status #TcpSendDataBusy the sending of data can also be aborted.
;     This is also sent to the receiver so that it can release its receive buffer.
; 
; Translated With www.DeepL.com/Translator
; 
; ***************************************************************************************

;-- Module Public

DeclareModule NetworkTCP
  
  #TcpFreeAll = 0
  
  #TcpReceiveBusy = 0
  #TcpReceiveDone = 1
  #TcpReceiveEmpty = 2
  #TcpReceiveCancel = 3
  #TcpReceiveError = 4
  #TcpReceiveErrorClientData = 5
  
  #TcpSendBusy = 0
  #TcpSendDone = 1
  #TcpSendCancel = 2
  #TcpSendError = 3
  
  #TcpSendSynchron = 0
  #TcpSendAsynchron = 1
  
  ;--- Structure Receive
  Structure sReceiveData
    ConnectionID.i
    TransactionID.i
    ProtocolID.i
    DataLen.i
    *Data
  EndStructure
  
  Declare TcpNewClientData(ConnectionID, ServerID = 0)
  Declare TcpFreeClientData(ConnectionID, ServerID = 0)
  Declare TcpCheckClientData(ServerID, List ClosedConnectionID(), LifeTime = 0)
  
  Declare TcpGetClientList(ServerID, List ListConnectionID())
  Declare TcpGetUserData(ConnectionID)
  Declare TcpSetUserData(ConnectionID, UserData)
  
  Declare TcpReceiveData(ConnectionID)
  Declare TcpGetData(ConnectionID)
  Declare.s TcpGetString(ConnectionID, Format = #PB_UTF8)
  Declare TcpGetTransactionID(ConnectionID)
  Declare TcpGetProtocolID(ConnectionID)
  Declare TcpGetDataLen(ConnectionID)
  Declare TcpGetReceiveError(ConnectionID)
  
  Declare TcpGetReceiveData(ConnectionID, *pData.sReceiveData)
  
  Declare TcpSendData(ConnectionID, *Memory, MemorySize, Flags = 0, TransactionID = 0, ProtocolID = 0)
  Declare TcpSendString(ConnectionID, Text.s, Format = #PB_UTF8, Flags = 0, TransactionID = 0, ProtocolID = 0)
  Declare TcpGetSendDataSize(ConnectionID)
  Declare TcpGetSendError(ConnectionID)
  Declare TcpSetSendDataCallback(ConnectionID, *Callback)
  
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    
    #NSActivityIdleDisplaySleepDisabled             = 1 << 40
    #NSActivityIdleSystemSleepDisabled              = 1 << 20
    #NSActivitySuddenTerminationDisabled            = (1 << 14)
    #NSActivityAutomaticTerminationDisabled         = (1 << 15)
    #NSActivityUserInitiated                        = ($00FFFFFF | #NSActivityIdleSystemSleepDisabled)
    #NSActivityUserInitiatedAllowingIdleSystemSleep = (#NSActivityUserInitiated & ~#NSActivityIdleSystemSleepDisabled)
    #NSActivityBackground                           = $000000FF
    #NSActivityLatencyCritical                      = $FF00000000
    
    Declare BeginWork(Option.q, Reason.s= "MyReason")
    Declare EndWork(Activity)
    
  CompilerEndIf
  
EndDeclareModule

;-- Module Private

Module NetworkTCP
  
  EnableExplicit
  
  ; ***************************************************************************************
  
  CompilerIf #PB_Compiler_Version < 550
    Procedure Ascii(Text.s)
      Protected *mem = AllocateMemory(StringByteLength(Text, #PB_Ascii) + 1)
      If *mem
        PokeS(*mem, Text, -1, #PB_Ascii)
      EndIf
      ProcedureReturn *mem
    EndProcedure
    Procedure UTF8(Text.s)
      Protected *mem = AllocateMemory(StringByteLength(Text, #PB_UTF8) + 1)
      If *mem
        PokeS(*mem, Text, -1, #PB_UTF8)
      EndIf
      ProcedureReturn *mem
    EndProcedure
  CompilerEndIf
  
  ; ***************************************************************************************
  
  ;--- Constants
  #TCP_Debuglevel = 2
  #TCP_DebuglevelBusy = 3
  
  ; Daten Blockgröße ohne Header. Blocksize - 28 (HeaderSize)
  ;#TCP_BlockSize = $10000 - 28  ; 64kb
  #TCP_BlockSize = $20000 - 28  ; 128kb
  
  #TCP_BlockDelay = 20          ; Pause zwischen zwei Blöcken
  #TCP_Timeout = 10000          ; Timeout in Millsekunden
  
  DebugLevel #TCP_DebuglevelBusy
  
  ;--- Prototype
  
  Prototype protoTcpDataCallback(Status, TransactionID, DataOffset, DataLen)
  
  ;--- Structure Common
  
  Structure udtNetworkHeader
    TransactionID.l
    ProtocolID.l
    DataLen.l
    DataOffset.l
    State.w
    Cancel.w
    Size.l
    CRC.l
  EndStructure
  
  Structure udtNetworkBuffer
    Header.udtNetworkHeader
    DataBlock.b[#TCP_BlockSize]
  EndStructure
  
  ;--- Structure Send Data
  Structure udtSendHeaderAndData
    Header.udtNetworkHeader
    *Data
  EndStructure
  
  Structure udtSendData
    ConnectionID.i
    ThreadID.i
    Signal.i
    Cancel.i
    Error.i
    *Callback.protoTcpDataCallback
    List Buffer.udtSendHeaderAndData()
  EndStructure
  
  ;--- Structure Receive Data
  Structure udtReceiveData
    TransactionID.i
    ProtocolID.i
    DataLen.i
    DataCount.i
    Cancel.i
    *Data
  EndStructure
  
  Structure udtClientData
    ServerID.i
    ConnectionID.i
    UserData.i
    ; Receive Header
    ActTime.i
    ActSize.i
    ActOffset.i
    ActData.i
    ActError.i
    ReceiveData.udtReceiveData      ; Vollständige Empfangsdaten an Anwender
    ReceiveBuffer.udtNetworkBuffer  ; Netzwerk Empfangsbuffer Header und Data
    Map Buffer.udtReceiveData()     ; Laufende Empfangsdaten über TransactionID
  EndStructure
  
  ;--- Globals
  
  Global MutexTransactionID = CreateMutex()
  Global MutexClientData = CreateMutex()
  Global MutexSendData = CreateMutex()
  Global MutexSend = CreateMutex()
  
  Global NewMap ClientData.udtClientData()
  Global NewMap SendData.udtSendData()
  
  Threaded SendBuffer.udtNetworkBuffer
  
  ;--- Declare Common
  
  Declare _SendNetworkData(ClientID, *MemoryBuffer, Length)
  
  Declare _TransactionID()
  
  Declare _GetClientData(ConnectionID)
  Declare _GetReceiveData(ConnectionID)
  Declare _GetSendData(ConnectionID)
  
  Declare _CreateSendDataThread(ConnectionID)
  Declare _StopSendDataThread(ConnectionID)
  Declare _AddSendData(ConnectionID, TransactionID, ProtocolID, DataLen, *pData)
  Declare _ThreadSendData(*Data.udtSendData)
  
  ;--- MacOS NapStop
  
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    ; Author : Danilo
    ; Date   : 25.03.2014
    ; Link   : https://www.purebasic.fr/english/viewtopic.php?f=19&t=58828
    ; Info   : NSActivityOptions is a 64bit typedef - use it with quads (.q) !!!
    
    Procedure BeginWork(Option.q, Reason.s= "MyReason")
      Protected NSProcessInfo = CocoaMessage(0,0,"NSProcessInfo processInfo")
      If NSProcessInfo
        ProcedureReturn CocoaMessage(0, NSProcessInfo, "beginActivityWithOptions:@", @Option, "reason:$", @Reason)
      EndIf
    EndProcedure
    
    Procedure EndWork(Activity)
      Protected NSProcessInfo = CocoaMessage(0, 0, "NSProcessInfo processInfo")
      If NSProcessInfo
        CocoaMessage(0, NSProcessInfo, "endActivity:", Activity)
      EndIf
    EndProcedure
  CompilerEndIf
  
  ;--- Functions Common
  
  Procedure TcpNewClientData(ConnectionID, ServerID = 0)
    Protected r1
    With ClientData()
      LockMutex(MutexClientData)
      If Not FindMapElement(ClientData(), Hex(ConnectionID))
        If AddMapElement(ClientData(), Hex(ConnectionID))
          \ServerID = ServerID
          \ConnectionID = ConnectionID
          Debug "[" + Hex(\ConnectionID) + "] ClientData: New Client " + MapSize(ClientData()), #TCP_Debuglevel
          r1 = ClientData()
        Else
          r1 = 0
        EndIf
      Else
        r1 = 0
      EndIf
      UnlockMutex(MutexClientData)
      ProcedureReturn r1
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure TcpFreeClientData(ConnectionID, ServerID = 0)
    Protected time
    With ClientData()
      LockMutex(MutexClientData)
      If ConnectionID ; Einzelne Client Daten freigeben
        If FindMapElement(ClientData(), Hex(ConnectionID))
          ; Free SendData
          _StopSendDataThread(ConnectionID)
          ; Free ReceiveData
          ForEach \Buffer()
            If \Buffer()\Data
              FreeMemory(\Buffer()\Data)
            EndIf
            ClearMap(\Buffer())
          Next
          Debug "[" + Hex(\ConnectionID) + "] ClientData: Free Client", #TCP_Debuglevel
          DeleteMapElement(ClientData())
        EndIf
      Else
        ForEach ClientData()
          If \ServerID = ServerID
            ; Free SendData
            _StopSendDataThread(\ConnectionID)
            ; Free ReceiveData
            ForEach \Buffer()
              If \Buffer()\Data
                FreeMemory(\Buffer()\Data)
              EndIf
              ClearMap(\buffer())
            Next
            Debug "[" + Hex(\ConnectionID) + "] ClientData: Free Client", #TCP_Debuglevel
            DeleteMapElement(ClientData())
          EndIf
        Next
      EndIf
      UnlockMutex(MutexClientData)
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure TcpCheckClientData(ServerID, List ClosedConnectionID(), LifeTime = 0)
    Protected TimeNow, TimeDiff, TimeThread
    
    With ClientData()
      LockMutex(MutexClientData)
      ClearList(ClosedConnectionID())
      TimeNow = ElapsedMilliseconds()
      ForEach ClientData()
        If \ServerID = ServerID
          TimeDiff = TimeNow - \ActTime
          If (MapSize(\Buffer()) And TimeDiff >= #TCP_Timeout) Or (LifeTime > 0 And TimeDiff >= LifeTime)
            ; Bei Timeout Verbindung trennen und in Liste aufnehmen
            AddElement(ClosedConnectionID())
            ClosedConnectionID() = \ConnectionID
            ; Free SendData
            _StopSendDataThread(\ConnectionID)
            ; Free ReceiveData
            ForEach \Buffer()
              If \Buffer()\Data
                FreeMemory(\Buffer()\Data)
              EndIf
              ClearMap(\buffer())
            Next
            Debug "[" + Hex(\ConnectionID) + "] ClientData: Kill Client", #TCP_Debuglevel
            CloseNetworkConnection(\ConnectionID)
            DeleteMapElement(ClientData())
          EndIf
        EndIf
      Next
      UnlockMutex(MutexClientData)
      ProcedureReturn ListSize(ClosedConnectionID())
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure TcpGetClientList(ServerID, List ListConnectionID())
    
    With ClientData()
      LockMutex(MutexClientData)
      ClearList(ListConnectionID())
      ForEach ClientData()
        If \ServerID = ServerID
          AddElement(ListConnectionID())
          ListConnectionID() = \ConnectionID
        EndIf
      Next
      UnlockMutex(MutexClientData)
      ProcedureReturn ListSize(ListConnectionID())
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure TcpGetUserData(ConnectionID)
    Protected r1
    LockMutex(MutexClientData)
    If FindMapElement(ClientData(), Hex(ConnectionID))
      r1 = ClientData()\UserData
    EndIf
    UnlockMutex(MutexClientData)
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure TcpSetUserData(ConnectionID, UserData)
    Protected r1
    LockMutex(MutexClientData)
    If FindMapElement(ClientData(), Hex(ConnectionID))
      r1 = ClientData()\UserData
      ClientData()\UserData = UserData
    EndIf
    UnlockMutex(MutexClientData)
    ProcedureReturn r1
  EndProcedure
  
  ;--- Functions Receive
  
  Procedure _CopyReceiveData(*ClientData.udtClientData) 
    Protected receive_datalen, receive_offset, receive_size, receive_cancel, memory_size
    
    Protected ConnectionID = *ClientData\ConnectionID
    Protected *ReceiveBuffer.udtNetworkBuffer = *ClientData\ReceiveBuffer
    Protected *ReceiveData.udtReceiveData
    
    With *ReceiveData
      ; Daten über TransactionID auswählen oder anlegen
      *ReceiveData = FindMapElement(*ClientData\Buffer(), Hex(*ReceiveBuffer\Header\TransactionID))
      ; Daten erstellen
      If Not *ReceiveData
        *ReceiveData = AddMapElement(*ClientData\Buffer(), Hex(*ReceiveBuffer\Header\TransactionID))
        If Not *ReceiveData
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - New TransactionID (" + \TransactionID + ") - Out Of Memory", #TCP_Debuglevel
          FillMemory(*ClientData\ReceiveData, SizeOf(udtReceiveData), 0)
          *ClientData\ActError = 3
          ProcedureReturn #TcpReceiveError
        EndIf
        ; Daten aus Header übernehmen
        \TransactionID = *ReceiveBuffer\Header\TransactionID
        \ProtocolID = *ReceiveBuffer\Header\ProtocolID
        \DataLen = *ReceiveBuffer\Header\DataLen
        \Cancel = *ReceiveBuffer\Header\Cancel
        If *ReceiveBuffer\Header\DataLen
          \Data = AllocateMemory(\DataLen)
          If \Data = 0
            Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - Data TransactionID (" + \TransactionID + ") - Out Of Memory", #TCP_Debuglevel
            \DataLen = 0
            CopyMemory(*ReceiveData, *ClientData\ReceiveData, SizeOf(udtReceiveData))
            DeleteMapElement(*ClientData\Buffer())
            *ClientData\ActError = 3
            ProcedureReturn #TcpReceiveError
          EndIf
        EndIf
        Debug "[" + Hex(ConnectionID) + "] ReceiveData: New TransactionID (" + \TransactionID + ")", #TCP_Debuglevel
      EndIf   
      ; Daten auswerten
      receive_datalen = *ReceiveBuffer\Header\DataLen
      receive_size = *ReceiveBuffer\Header\Size - SizeOf(udtNetworkHeader)
      receive_offset = *ReceiveBuffer\Header\DataOffset
      receive_cancel = *ReceiveBuffer\Header\Cancel
      ; Abfrage auf Abruch
      If receive_cancel
        If \Data
          FreeMemory(\Data)
          \Data = 0
          \DataLen = 0
        EndIf
        Debug "[" + Hex(ConnectionID) + "] ReceiveData: Cancel - Data TransactionID (" + \TransactionID + ")", #TCP_Debuglevel
        CopyMemory(*ReceiveData, *ClientData\ReceiveData, SizeOf(udtReceiveData))
        DeleteMapElement(*ClientData\Buffer())
        ProcedureReturn #TcpReceiveCancel
      EndIf
      ; Daten übernehmen wenn vorhanden
      If receive_datalen
        If \Data
          memory_size = MemorySize(\Data)
        EndIf
        If receive_offset + receive_size > memory_size
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - Data TransactionID (" + \TransactionID + ") - Invalid Memory Size", #TCP_Debuglevel
          If \Data
            FreeMemory(\Data)
            \Data = 0
            \DataLen = 0
          EndIf
          CopyMemory(*ReceiveData, *ClientData\ReceiveData, SizeOf(udtReceiveData))
          DeleteMapElement(*ClientData\Buffer())
          *ClientData\ActError = 5
          ProcedureReturn #TcpReceiveError
        EndIf
        If receive_datalen <> memory_size
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - Data TransactionID (" + \TransactionID + ") - Invalid Data Len", #TCP_Debuglevel
          If \Data
            FreeMemory(\Data)
            \Data = 0
            \DataLen = 0
          EndIf
          CopyMemory(*ReceiveData, *ClientData\ReceiveData, SizeOf(udtReceiveData))
          DeleteMapElement(*ClientData\Buffer())
          *ClientData\ActError = 5
          ProcedureReturn #TcpReceiveError
        EndIf
        CopyMemory(*ReceiveBuffer + SizeOf(udtNetworkHeader), \Data + receive_offset, receive_size)
        \DataCount + receive_size
        If \DataCount >= receive_datalen
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Done (" + \TransactionID + ") Data (" + \DataCount + "/" + \DataLen +")", #TCP_Debuglevel
          CopyMemory(*ReceiveData, *ClientData\ReceiveData, SizeOf(udtReceiveData))
          DeleteMapElement(*ClientData\Buffer())
          ProcedureReturn #TcpReceiveDone
        Else
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Busy (" + \TransactionID + ") Data (" + \DataCount + "/" + \DataLen + ")", #TCP_DebuglevelBusy
          ProcedureReturn #TcpReceiveBusy
        EndIf
      Else
        Debug "[" + Hex(ConnectionID) + "] ReceiveData: Done (" + \TransactionID + ") Data (Empty)", #TCP_Debuglevel
        CopyMemory(*ReceiveData, *ClientData\ReceiveData, SizeOf(udtReceiveData))
        DeleteMapElement(*ClientData\Buffer())
        ProcedureReturn #TcpReceiveEmpty
      EndIf  
    EndWith
    
  EndProcedure
  
  ; ----
  
  Procedure TcpReceiveData(ConnectionID)
    Protected *ClientData.udtClientData, *ReceiveData.udtReceiveData, cnt, crc, receive_size, r1, len
    Protected *ReceiveBuffer.udtNetworkBuffer
    
    *ClientData = _GetClientData(ConnectionID)
    If Not *ClientData
      Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - No ClientData", #TCP_Debuglevel
      ProcedureReturn #TcpReceiveErrorClientData
    EndIf
    
    *ReceiveBuffer = *ClientData\ReceiveBuffer
    
    With *ClientData
      \ActTime = ElapsedMilliseconds()
      If Not \ActData
        ; *** Header Info lesen ***
        cnt = ReceiveNetworkData(ConnectionID, *ReceiveBuffer + \ActOffset, SizeOf(udtNetworkHeader) - \ActOffset)
        ; Header Size überprüfen
        If cnt < 0
          \ActSize = 0
          \ActOffset = 0
          \ActData = #False
          \ActError = 4 ; ReceiveNetworkData
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - ReceiveNetworkData", #TCP_Debuglevel
          ProcedureReturn #TcpReceiveError
        EndIf
        \ActOffset + cnt
        If \ActOffset < SizeOf(udtNetworkHeader)
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Busy Header (" + \ActOffset + "/" + SizeOf(udtNetworkHeader) + ")", #TCP_DebuglevelBusy
          ProcedureReturn #TcpReceiveBusy
        EndIf
        ; Header Info auswerten
        crc = *ReceiveBuffer\Header\TransactionID ! *ReceiveBuffer\Header\ProtocolID ! *ReceiveBuffer\Header\DataLen ! *ReceiveBuffer\Header\DataOffset ! *ReceiveBuffer\Header\State ! *ReceiveBuffer\Header\Cancel ! *ReceiveBuffer\Header\Size
        If crc <> *ReceiveBuffer\Header\CRC
          \ActSize = 0
          \ActOffset = 0
          \ActData = #False
          \ActError = 2 ; Header checksum
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - Header Checksum", #TCP_Debuglevel
          ProcedureReturn #TcpReceiveError
        EndIf
        \ActSize = *ReceiveBuffer\Header\Size
        If \ActSize > SizeOf(udtNetworkHeader)
          \ActData = #True
          ProcedureReturn #TcpReceiveBusy
        ElseIf \ActSize = SizeOf(udtNetworkHeader)
          ; Header vollständig
          \ActSize = 0
          \ActOffset = 0
          \ActData = #False
          \ActError = 0
          ProcedureReturn _CopyReceiveData(*ClientData)
        EndIf
      Else
        ; *** Daten nach Header lesen ***
        cnt = ReceiveNetworkData(ConnectionID, *ReceiveBuffer + \ActOffset, \ActSize - \ActOffset)
        ; Daten Size überprüfen
        If cnt < 0
          \ActSize = 0
          \ActOffset = 0
          \ActData = #False
          \ActError = 4 ; ReceiveNetworkData
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - ReceiveNetworkData", #TCP_Debuglevel
          ProcedureReturn #TcpReceiveError
        EndIf
        \ActOffset + cnt
        If \ActOffset < \ActSize
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Busy (" + \ReceiveBuffer\Header\TransactionID + ") Buffer (" + \ActOffset + "/" + \ActSize + ")", #TCP_DebuglevelBusy
          ProcedureReturn #TcpReceiveBusy
        Else
          ; Header + Data vollständig
          \ActSize = 0
          \ActOffset = 0
          \ActData = #False
          \ActError = 0
          ProcedureReturn _CopyReceiveData(*ClientData)
        EndIf
      EndIf 
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure TcpGetReceiveData(ConnectionID, *pData.sReceiveData)
    Protected *ReceiveData.udtReceiveData
    *ReceiveData = _GetReceiveData(ConnectionID)
    If *ReceiveData
      *pData\ConnectionID = ConnectionID
      *pData\TransactionID = *ReceiveData\TransactionID
      *pData\ProtocolID = *ReceiveData\ProtocolID
      *pData\DataLen = *ReceiveData\DataLen
      *pData\Data = *ReceiveData\Data
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpGetData(ConnectionID)
    Protected *ReceiveData.udtReceiveData
    Protected r1
    *ReceiveData = _GetReceiveData(ConnectionID)
    If *ReceiveData
      r1 = *ReceiveData\Data
      ProcedureReturn r1
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure.s TcpGetString(ConnectionID, Format = #PB_UTF8)
    Protected *ReceiveData.udtReceiveData
    Protected r1.s
    *ReceiveData = _GetReceiveData(ConnectionID)
    If *ReceiveData
      If *ReceiveData\Data
        r1 = PeekS(*ReceiveData\Data, -1, Format)
        FreeMemory(*ReceiveData\Data)
        *ReceiveData\Data = 0
        ProcedureReturn r1
      EndIf
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpGetTransactionID(ConnectionID)
    Protected *ReceiveData.udtReceiveData
    *ReceiveData = _GetReceiveData(ConnectionID)
    If *ReceiveData
      ProcedureReturn *ReceiveData\TransactionID
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpGetProtocolID(ConnectionID)
    Protected *ReceiveData.udtReceiveData
    *ReceiveData = _GetReceiveData(ConnectionID)
    If *ReceiveData
      ProcedureReturn *ReceiveData\ProtocolID
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpGetDataLen(ConnectionID)
    Protected *ReceiveData.udtReceiveData
    *ReceiveData = _GetReceiveData(ConnectionID)
    If *ReceiveData
      ProcedureReturn *ReceiveData\DataLen
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpGetReceiveError(ConnectionID)
    Protected *ClientData.udtClientData
    *ClientData = _GetClientData(ConnectionID)
    If *ClientData
      ProcedureReturn *ClientData\ActError
    EndIf
  EndProcedure
  
  ;--- Functions Send
  
  Procedure TcpSendData(ConnectionID, *Memory, MemorySize, Flags = 0, TransactionID = 0, ProtocolID = 0)
    Protected send_len, send_pos, send_size, size, len, cnt, size_block
    
    If Not TransactionID
      TransactionID = _TransactionID()
    EndIf
    
    If Flags = #TcpSendAsynchron
      ProcedureReturn _AddSendData(ConnectionID, TransactionID, ProtocolID, MemorySize, *Memory)
    EndIf
    
    send_len = MemorySize
    send_pos = 0
    
    ; Loop Send
    Repeat
      send_size = send_len - send_pos
      If send_size > #TCP_BlockSize
        send_size = #TCP_BlockSize
      EndIf
      ; Daten kopieren - Wenn vorhanden
      If *Memory
        CopyMemory(*Memory + send_pos, SendBuffer + SizeOf(udtNetworkHeader), send_size)
      EndIf
      ; Daten Offset und Header CRC eintragen
      SendBuffer\Header\TransactionID = TransactionID
      SendBuffer\Header\ProtocolID = ProtocolID
      SendBuffer\Header\DataLen = send_len
      SendBuffer\Header\DataOffset = send_pos
      SendBuffer\Header\State = 0
      SendBuffer\Header\Cancel = 0
      SendBuffer\Header\Size = send_size + SizeOf(udtNetworkHeader)
      SendBuffer\Header\CRC = SendBuffer\Header\TransactionID ! SendBuffer\Header\ProtocolID ! SendBuffer\Header\DataLen ! SendBuffer\Header\DataOffset ! SendBuffer\Header\State ! SendBuffer\Header\Cancel ! SendBuffer\Header\Size
      size = send_size + SizeOf(udtNetworkHeader)
      len = 0
      LockMutex(MutexSend)
      Repeat
        size_block = size - len
        If ConnectionID(ConnectionID)
          cnt = _SendNetworkData(ConnectionID, SendBuffer + len, size_block)
          len + cnt
          If cnt >= 0 And cnt < size_block
            Delay(10)
          EndIf
        Else
          cnt = -1
        EndIf
      Until len = size Or cnt < 0
      UnlockMutex(MutexSend)
      If cnt < 0
        Debug "[" + Hex(ConnectionID) + "] SendData: Error SendNetworkData", #TCP_Debuglevel
        TransactionID = 0
        Break
      EndIf
      send_pos + send_size
      If send_pos >= send_len
        Debug "[" + Hex(ConnectionID) + "] SendData: Done (" + TransactionID + ") Data (" + send_pos + "/" + send_len + ")", #TCP_Debuglevel
        Break
      Else
        Debug "[" + Hex(ConnectionID) + "] SendData: Busy (" + TransactionID + ") Data (" + send_pos + "/" + send_len + ")", #TCP_DebuglevelBusy
        Delay(#TCP_BlockDelay)
      EndIf
    ForEver
    
    ProcedureReturn TransactionID
    
  EndProcedure
  
  ; ----
  
  Procedure TcpSendString(ConnectionID, Text.s, Format = #PB_UTF8, Flags = 0, TransactionID = 0, ProtocolID = 0)
    Protected r1, *Memory, send_len, send_pos, send_size, size, len, cnt, size_block
    
    If Not TransactionID
      TransactionID = _TransactionID()
    EndIf
    
    Select Format
      Case #PB_UTF8, #Null
        *Memory = UTF8(Text)
        If *Memory = 0
          Debug "[" + Hex(ConnectionID) + "] SendString: Error Out Of Memory", #TCP_Debuglevel
          ProcedureReturn 0
        EndIf
        send_len = MemorySize(*Memory)
        
      Case #PB_Ascii
        *Memory = Ascii(Text)
        If *Memory = 0
          Debug "[" + Hex(ConnectionID) + "] SendString: Error Out Of Memory", #TCP_Debuglevel
          ProcedureReturn 0
        EndIf
        send_len = MemorySize(*Memory)
        
      Case #PB_Unicode
        *Memory = @text
        send_len = StringByteLength(Text) + 2
        
    EndSelect
    
    If Flags = #TcpSendAsynchron
      r1 = _AddSendData(ConnectionID, TransactionID, ProtocolID, send_len, *Memory)
      If Format <> #PB_Unicode
        FreeMemory(*Memory)
      EndIf
      ProcedureReturn r1
    EndIf
    
    send_pos = 0
    
    ; Loop Send
    Repeat
      send_size = send_len - send_pos
      If send_size > #TCP_BlockSize
        send_size = #TCP_BlockSize
      EndIf
      ; Daten kopieren - Wenn vorhanden
      If *Memory
        CopyMemory(*Memory + send_pos, SendBuffer + SizeOf(udtNetworkHeader), send_size)
      EndIf
      ; Daten Offset und Header CRC eintragen
      SendBuffer\Header\TransactionID = TransactionID
      SendBuffer\Header\ProtocolID = ProtocolID
      SendBuffer\Header\DataLen = send_len
      SendBuffer\Header\DataOffset = send_pos
      SendBuffer\Header\State = 0
      SendBuffer\Header\Cancel = 0
      SendBuffer\Header\Size = send_size + SizeOf(udtNetworkHeader)
      SendBuffer\Header\CRC = SendBuffer\Header\TransactionID ! SendBuffer\Header\ProtocolID ! SendBuffer\Header\DataLen ! SendBuffer\Header\DataOffset ! SendBuffer\Header\State ! SendBuffer\Header\Cancel ! SendBuffer\Header\Size
      size = send_size + SizeOf(udtNetworkHeader)
      len = 0
      LockMutex(MutexSend)
      Repeat
        size_block = size - len
        If ConnectionID(ConnectionID)
          cnt = _SendNetworkData(ConnectionID, SendBuffer + len, size_block)
          len + cnt
          If cnt >= 0 And cnt < size_block
            Delay(10)
          EndIf
        Else
          cnt = -1
        EndIf
      Until len = size Or cnt < 0
      UnlockMutex(MutexSend)
      If cnt < 0
        Debug "[" + Hex(ConnectionID) + "] SendString: Error SendNetworkData", #TCP_Debuglevel
        TransactionID = 0
        Break
      EndIf
      send_pos + send_size
      If send_pos >= send_len
        Debug "[" + Hex(ConnectionID) + "] SendString: Done (" + TransactionID + ") Data (" + send_pos + "/" + send_len + ")", #TCP_Debuglevel
        Break
      Else
        Debug "[" + Hex(ConnectionID) + "] SendString: Busy ("  + TransactionID + ") Data (" + send_pos + "/" + send_len + ")", #TCP_DebuglevelBusy
        Delay(#TCP_BlockDelay)
      EndIf
    ForEver
    
    If Format <> #PB_Unicode
      FreeMemory(*Memory)
    EndIf
    
    ProcedureReturn TransactionID
    
  EndProcedure
  
  ; ----
  
  Procedure TcpGetSendDataSize(ConnectionID)
    Protected *SendData.udtSendData
    *SendData = _GetSendData(ConnectionID)
    If *SendData
      ProcedureReturn ListSize(*SendData\Buffer())
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpGetSendError(ConnectionID)
    Protected *SendData.udtSendData
    *SendData = _GetSendData(ConnectionID)
    If *SendData
      ProcedureReturn *SendData\Error
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure TcpSetSendDataCallback(ConnectionID, *Callback)
    Protected r1, *SendData.udtSendData
    With *SendData
      LockMutex(MutexSendData)
      *SendData = FindMapElement(SendData(), Hex(ConnectionID))
      If Not *SendData
        *SendData = _CreateSendDataThread(ConnectionID)
        If Not *SendData
          UnlockMutex(MutexSendData)
          ProcedureReturn #False
        EndIf
      EndIf
      \Callback = *Callback
      UnlockMutex(MutexSendData)
      ProcedureReturn #True
    EndWith
  EndProcedure
  
  ;-- Functions Internal
  
  #SOL_SOCKET = $FFFF
  #SO_ERROR = $1007
  
  Procedure _GetSocketLastError(Socket)
    Protected r1
    Protected error_code
    Protected error_code_size = SizeOf(error_code)
    
    r1 = getsockopt_(Socket, #SOL_SOCKET, #SO_ERROR, @error_code, @error_code_size)
    If r1 <= 0
      r1 = error_code
    EndIf
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure _SendNetworkData(ClientID, *MemoryBuffer, Length)
    Protected r1
    Protected error_code
    Protected error_code_size = SizeOf(error_code)
    
    r1 = getsockopt_(ConnectionID(ClientID), #SOL_SOCKET, #SO_ERROR, @error_code, @error_code_size)
    If r1 <= 0
      r1 = error_code
    EndIf
    
    If r1
      ProcedureReturn -1
    Else
      ProcedureReturn SendNetworkData(ClientID, *MemoryBuffer, Length)
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure _TransactionID()
    Static TransactionLFD
    Protected TransactionID
    
    LockMutex(MutexTransactionID)
    TransactionLFD + 1
    If TransactionLFD <= 0
      TransactionLFD = 1
    EndIf
    TransactionID = TransactionLFD
    UnlockMutex(MutexTransactionID)
    ProcedureReturn TransactionID
  EndProcedure
  
  ; ----
  
  Procedure _GetClientData(ConnectionID)
    Protected r1
    LockMutex(MutexClientData)
    If FindMapElement(ClientData(), Hex(ConnectionID))
      r1 = @ClientData()
    Else
      r1 = 0
    EndIf
    UnlockMutex(MutexClientData)
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure _GetReceiveData(ConnectionID)
    Protected r1
    With ClientData()
      LockMutex(MutexClientData)
      If FindMapElement(ClientData(), Hex(ConnectionID))
        r1 = \ReceiveData
      Else
        r1 = 0
      EndIf
      UnlockMutex(MutexClientData)
      ProcedureReturn r1
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure _GetSendData(ConnectionID)
    Protected r1
    LockMutex(MutexSendData)
    If FindMapElement(SendData(), Hex(ConnectionID))
      r1 = SendData()
    Else
      r1 = 0
    EndIf
    UnlockMutex(MutexSendData)
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure _FreeSendData(ConnectionID)
    Protected *SendData.udtSendData
    LockMutex(MutexSendData)
    *SendData = FindMapElement(SendData(), Hex(ConnectionID))
    If *SendData
      ForEach *SendData\Buffer()
        If *SendData\Buffer()\Data
          FreeMemory(*SendData\Buffer()\Data)
        EndIf
      Next
      DeleteMapElement(SendData())
    EndIf
    UnlockMutex(MutexSendData)
  EndProcedure
  
  ; ----
  
  Procedure _StopSendDataThread(ConnectionID)
    Protected *SendData.udtSendData
    LockMutex(MutexSendData)
    *SendData = FindMapElement(SendData(), Hex(ConnectionID))
    UnlockMutex(MutexSendData)
    If *SendData
      *SendData\Cancel = #True
      SignalSemaphore(*SendData\Signal)
      If WaitThread(*SendData\ThreadID, 1000) = 0
        KillThread(*SendData\ThreadID)
        _FreeSendData(ConnectionID)
      EndIf
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure _CreateSendDataThread(ConnectionID) ; LockMutex extern
    Protected r1, *SendData.udtSendData
    With *SendData
      *SendData = AddMapElement(SendData(), Hex(ConnectionID))
      If Not *SendData
        Debug "[" + Hex(ConnectionID) + "] SendData: Error Init Thread - Out Of Memory", #TCP_Debuglevel
        ProcedureReturn 0
      EndIf
      \ConnectionID = ConnectionID
      \Cancel = #False
      \Signal = CreateSemaphore()
      If Not \Signal
        Debug "[" + Hex(ConnectionID) + "] SendData: Error Init Thread - CreateSemaphore", #TCP_Debuglevel
        DeleteMapElement(SendData())
        ProcedureReturn 0
      EndIf
      \ThreadID = CreateThread(@_ThreadSendData(), *SendData)
      If Not \ThreadID
        Debug "[" + Hex(ConnectionID) + "] SendData: Error Init Thread - CreateSemaphore", #TCP_Debuglevel
        FreeSemaphore(\Signal)
        DeleteMapElement(SendData())
        ProcedureReturn 0
      EndIf
      ProcedureReturn *SendData
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure _AddSendData(ConnectionID, TransactionID, ProtocolID, DataLen, *Data)
    Protected r1, *SendData.udtSendData
    With *SendData
      LockMutex(MutexSendData)
      *SendData = FindMapElement(SendData(), Hex(ConnectionID))
      If Not *SendData
        *SendData = _CreateSendDataThread(ConnectionID)
        If Not *SendData
          UnlockMutex(MutexSendData)
          ProcedureReturn 0
        EndIf
      EndIf
      LastElement(\Buffer())
      AddElement(\Buffer())
      \Buffer()\Header\TransactionID = TransactionID
      \Buffer()\Header\ProtocolID = ProtocolID
      \Buffer()\Header\DataLen = DataLen * Bool(*data)
      If DataLen And *Data
        \Buffer()\Data = AllocateMemory(DataLen)
        If \Buffer()\Data = 0
          Debug "[" + Hex(\ConnectionID) + "] SendData: Error - Out Of Memory", #TCP_Debuglevel
          \Error = 3
          DeleteElement(\Buffer())
          UnlockMutex(MutexSendData)
          ProcedureReturn 0
        EndIf
        CopyMemory(*Data, \Buffer()\Data, DataLen)
      EndIf
      Debug "[" + Hex(ConnectionID) + "] SendData: New Asynchron Data (" + TransactionID + ")", #TCP_Debuglevel
      SignalSemaphore(\Signal)
      UnlockMutex(MutexSendData)
      ProcedureReturn TransactionID
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure _ThreadSendData(*Data.udtSendData)
    Protected *Buffer.udtSendHeaderAndData
    Protected send_id, send_pid, send_len, send_pos, send_size, send_state, send_cancel, size, len, cnt, size_block, *memory
    
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      Protected Activity = BeginWork(#NSActivityLatencyCritical | #NSActivityUserInitiated, Hex(*Data))
    CompilerEndIf
    
    With *Data
      Debug "[" + Hex(\ConnectionID) + "] SendData: Thread Start", #TCP_Debuglevel
      Repeat
        WaitSemaphore(\Signal)
        If \Cancel
          Break
        EndIf
        LockMutex(MutexSendData)
        *Buffer = FirstElement(\Buffer())
        UnlockMutex(MutexSendData)
        If *Buffer
          send_id = *Buffer\Header\TransactionID
          send_pid = *Buffer\Header\ProtocolID
          send_len = *Buffer\Header\DataLen
          send_pos = 0
          send_state = 0
          send_cancel = 0
          *memory = *Buffer\Data
          ; Loop Send
          While Not \Cancel
            send_size = send_len - send_pos
            If send_size > #TCP_BlockSize
              send_size = #TCP_BlockSize
            EndIf
            size = send_size + SizeOf(udtNetworkHeader)
            ; Header Daten und CRC eintragen
            SendBuffer\Header\TransactionID = send_id
            SendBuffer\Header\ProtocolID = send_pid
            SendBuffer\Header\DataLen = send_len
            SendBuffer\Header\DataOffset = send_pos
            SendBuffer\Header\State = 0
            SendBuffer\Header\Cancel = send_cancel
            SendBuffer\Header\Size = size
            SendBuffer\Header\CRC = send_id ! send_pid ! send_len ! send_pos ! send_state ! send_cancel ! size
            ; Daten kopieren - Wenn vorhanden
            If *memory
              CopyMemory(*memory + send_pos, SendBuffer + SizeOf(udtNetworkHeader), send_size)
            EndIf
            ; Start senden
            len = 0
            LockMutex(MutexSend)
            Repeat
              size_block = size - len
              If ConnectionID(\ConnectionID)
                cnt = _SendNetworkData(\ConnectionID, SendBuffer + len, size_block)
                len + cnt
                If cnt >= 0 And cnt < size_block
                  Delay(10)
                EndIf
              Else
                cnt = -1
              EndIf
            Until len = size Or cnt < 0
            UnlockMutex(MutexSend)
            If cnt < 0
              Debug "[" + Hex(\ConnectionID) + "] SendData: Error SendNetworkData", #TCP_Debuglevel
              If \Callback
                \Callback(#TcpSendError, send_id, send_pos, send_len)
              EndIf
              \Cancel = #True
              Break
            EndIf
            send_pos + send_size
            If send_cancel
              Debug "[" + Hex(\ConnectionID) + "] SendData: Cancel (" + send_id + ") Data (" + send_pos + "/" + send_len + ")", #TCP_Debuglevel
              If \Callback
                \Callback(#TcpSendCancel, send_id, send_pos, send_len)
              EndIf
              Delay(#TCP_BlockDelay)
              Break
            ElseIf send_pos >= send_len
              Debug "[" + Hex(\ConnectionID) + "] SendData: Done (" + send_id + ") Data (" + send_pos + "/" + send_len + ")", #TCP_Debuglevel
              If \Callback
                \Callback(#TcpSendDone, send_id, send_pos, send_len)
              EndIf
              Delay(#TCP_BlockDelay)
              Break
            Else
              Debug "[" + Hex(\ConnectionID) + "] SendData: Busy (" + send_id + ") Data (" + send_pos + "/" + send_len + ")", #TCP_DebuglevelBusy
              If \Callback
                If \Callback(#TcpSendBusy, send_id, send_pos, send_len)
                  send_cancel = #True
                EndIf
              EndIf
              Delay(#TCP_BlockDelay)
            EndIf
          Wend
          If *memory
            FreeMemory(*memory)
          EndIf
          LockMutex(MutexSendData)
          ChangeCurrentElement(\Buffer(), *Buffer)
          DeleteElement(\Buffer())
          UnlockMutex(MutexSendData)
        EndIf
      Until \Cancel
      
      Debug "[" + Hex(\ConnectionID) + "] SendData: Thread Stop", #TCP_Debuglevel
      
      _FreeSendData(\ConnectionID)
      
    EndWith
    
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      EndWork(Activity)
    CompilerEndIf
    
  EndProcedure
  
  ; ----
  
  ;-- Module End
  
EndModule
Last edited by mk-soft on Sun Jul 16, 2023 4:09 pm, edited 15 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Test-Server

Code: Select all

;-TOP Test - Server v1.20

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_UTF8, #TcpSendAsynchron, ndr\TransactionID, #ProtocolString)
                    Next
                  Else
                    ForEach ListConnectionID()
                      TcpSendString(ListConnectionID(), "Text: " + Text, #PB_UTF8, #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_UTF8, #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_UTF8, #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
    
    ; Server beenden, Daten bereinigen und Thread verlassen
    CloseNetworkServer(\ServerID)
    ; Alle Client Daten freigeben
    TcpFreeClientData(0, \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]
Last edited by mk-soft on Mon May 04, 2020 1:28 pm, edited 4 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Test-Client-1

Code: Select all

;- TOP Test - client v1.20

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, 10000)
                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
    CloseNetworkConnection(\ConnectionID)
    TcpFreeClientData(\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)
  
  With *MyClientData
    If \ConnectionID = 0
      ProcedureReturn 0
    EndIf
    Logging("Network: Close Network Connection: ID " + Hex(\ConnectionID))
    \ExitClient = 1
    If WaitThread(\ThreadID, 10000) = 0
      Logging("Network: KillThread: ID " + Hex(\ThreadID))
      KillThread(\ThreadID)
      CloseNetworkConnection(\ConnectionID)
      \ThreadID = 0
      \ConnectionID = 0
      \ExitClient = 0
    EndIf
  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_UTF8, #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
  
  Delay(100)
  
EndProcedure

InitNetwork()
Main()
[/size]
Last edited by mk-soft on Mon May 04, 2020 1:31 pm, edited 3 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Test-Client-2

Code: Select all

;-TOP Test - Client 2

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 udtClientData
  *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(*ClientData.udtClientData)
  Protected Event, count, Text.s, Size, time1, time2
  Static Error
  
  With *ClientData
    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 > 500
            time1 = ElapsedMilliseconds()
            If TcpGetSendDataSize(\ConnectionID) < 5
              Size = Random(10000, 2000)
              If Random(1)
                TcpSendData(\ConnectionID, *Random1, Size, #TcpSendASynchron, 0, #ProtocolRandom1)
              Else
                TcpSendData(\ConnectionID, *Random2, Size, #TcpSendAsynchron, 0, #ProtocolRandom2)
              EndIf
            EndIf
          EndIf
          
      EndSelect
    Until \ExitClient
    
    ; Exit Thread
    CloseNetworkConnection(\ConnectionID)
    TcpFreeClientData(\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 InitClient(*ClientData.udtClientData, IP.s, Port, Timeout = 0)
  Protected ConnectionID
  
  With *ClientData
    If \ConnectionID
      ProcedureReturn \ConnectionID
    EndIf
    ConnectionID = OpenNetworkConnection(IP, Port, #PB_Network_TCP, Timeout)
    If ConnectionID
      \ConnectionID = ConnectionID
      \ThreadID = CreateThread(@ThreadClient(), *ClientData)
      Logging("Network: Init Client: ID " + Hex(ConnectionID))
      StatusBarText(0, 0, "Connect")
      SetActiveGadget(1)
    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(*ClientData.udtClientData)
  Protected timeout
  
  With *ClientData
    If \ConnectionID = 0
      ProcedureReturn 0
    EndIf
    Logging("Network: Close Network Connection: ID " + \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 " + \ConnectionID)
          Break
        EndIf
      EndIf
      Delay(100)
    ForEver
  EndWith
EndProcedure

; -----------------------------------------------------------------------------

;-Main

Global ExitApplication
Global ClientData.udtClientData
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-2",#PB_Window_SystemMenu)
    CreateStatusBar(0, WindowID(#WinMain))
    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(ClientData, Host, Port)
              
            Case #MenuItem_Disconnect
              CloseClient(ClientData)
              
            Case #MenuItem_Send
              If GetActiveGadget() = 1 And ClientData\ConnectionID
                text = GetGadgetText(1)
                If 1; text > ""
                  TcpSendString(ClientData\ConnectionID, text, #PB_UTF8, #TcpSendSynchron,0, #ProtocolString)
                  SetGadgetText(1, "")
                EndIf
              EndIf
              
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #WinMain
              CloseClient(ClientData)
              ExitApplication = #True
          EndSelect
        Case #My_Event_Logging
          Logging(FreeString(EventData()))
        Case #My_Event_Statusbar
          StatusBarText(EventGadget(), EventType(), FreeString(EventData()))
      EndSelect
      
    Until ExitApplication And ClientData\ExitClient = 0
  EndIf
  
EndProcedure


InitNetwork()
Main()
[/size]
Last edited by mk-soft on Mon May 04, 2020 1:33 pm, edited 2 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
blueb
Addict
Addict
Posts: 1041
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by blueb »

mk-soft:

Would love to try, but when you copied from the German forum to here the files became corrupted.

:?

EDIT: Sorry it looks like Google translate (on my end) thought it was a German file and auto-translated (corrupted) the files.

Perhaps this will happen to others... so I'll leave this post here.
- It was too lonely at the top.

System : PB 6.10 Beta 9 (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Update v1.18
- Bugfix MacOS SendNetworkData (PB Bug?)

I spent hours looking for a bug in SendNetworkData on MacOS.

If the recipient no longer exists when sending the data, the program crashes from time to time. Normally you should get -1 as result like with Windows.

Solution:
Before sending, check the connection with GetClientPort. If the connection doesn't exist anymore, zero comes back.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Update v1.19
- Add Macro Bugfix macOS SendNetworkData

Code: Select all

; ***************************************************************************************
; Bugfix MacOS SendNetworkData over Threads. mk-soft, 27.10.2019, Version 1.01

Procedure FixSendNetworkData(ClientID, MemoryBufer, Length)
  If GetClientPort(ClientID)
    ProcedureReturn SendNetworkData(ClientID, MemoryBufer, Length)
  Else
    ProcedureReturn -1
  EndIf
EndProcedure

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  Macro SendNetworkData(ClientID, MemoryBufer, Length)
    FixSendNetworkData(ClientID, MemoryBufer, Length)
  EndMacro
CompilerEndIf

; ***************************************************************************************
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
kinglestat
Enthusiast
Enthusiast
Posts: 732
Joined: Fri Jul 14, 2006 8:53 pm
Location: Malta
Contact:

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by kinglestat »

Thanks for this. I quite like how its done
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net
Joris
Addict
Addict
Posts: 885
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by Joris »

Thanks for this big job.
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Update v1.20
- Bugfix TcpSendString Format

Ops ...
I forgot to convert the string format before sending. Format UTF8 is now default :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by Kwai chang caine »

Apparently that works here
Thanks a lot for sharing this useful module 8)
ImageThe happiness is a road...
Not a destination
User avatar
leonhardt
Enthusiast
Enthusiast
Posts: 220
Joined: Wed Dec 23, 2009 3:26 pm

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by leonhardt »

Thanks for the update,socket Master, :lol: , howerver, I must update my little tcp class as well ,which based on your module.Nice work! :mrgreen:
poor English...

PureBasic & Delphi & VBA
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Update
- Change Header to enable BlockSize over 64KB

To avoid overloading the OS network buffer and blocking multiple processing of multiple client requests, do not set the BlockSize too large. (smaller than 256KB)
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by mk-soft »

Update v1.21.2
- Check socket before send data
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
RichAlgeni
Addict
Addict
Posts: 914
Joined: Wed Sep 22, 2010 1:50 am
Location: Bradenton, FL

Re: Module NetworkTCP - Send and Receive Data over 64kB

Post by RichAlgeni »

One thing I would love, and have asked for as an enhancement, is a PureBasic intrinsic that would return the amount of data in the network receive buffer. We can get this in Windows, but I am unaware of how to do so in other platforms.

Code: Select all

Procedure CheckReceiveLength(socketNumber.l)

    Define length.l
    Define result.l
    Define socketHandle.i

    socketHandle = ConnectionID(socketNumber)
    result       = ioctlsocket_(socketHandle, #FIONREAD, @length)

    If result <> 0
        ProcedureReturn -1; socket error
    EndIf

    ProcedureReturn length
EndProcedure
Post Reply