It is currently Sun Nov 17, 2019 7:18 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 7 posts ] 
Author Message
 Post subject: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sat Oct 26, 2019 12:03 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
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

NetworkFunctions.pb
Code:
;-TOP

; Comment : Module NetworkTCP
; Author  : mk-soft
; Version : v1.19
; Create  : 18.02.2019
; Update  : 27.10.2019
; OS      : All

; ***************************************************************************************
;
;-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
;
; ***************************************************************************************

; ***************************************************************************************
; 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

; ***************************************************************************************

;-- 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_Unicode)
  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_Unicode, 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
 
  ; ***************************************************************************************
  ; 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
 
  ; ***************************************************************************************

  ;--- Constants
  #TCP_Debuglevel = 2
  #TCP_DebuglevelBusy = 3
 
  ;#TCP_BlockSize = 65535 - 24  ; Daten Blockgröße ohne Header. Max 65535 - 24 (HeaderSize)
  #TCP_BlockSize = 8 * 1452 - 24
  #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 udtNetHeader
    TransactionID.l
    ProtocolID.l
    DataLen.l
    DataOffset.l
    Cancel.w
    Size.u
    CRC.l
  EndStructure
 
  Structure udtNetBuffer
    Header.udtNetHeader
    Block.b[#TCP_BlockSize]
  EndStructure
 
  ;--- Structure Send Data
  Structure udtSendHeaderAndData
    Header.udtNetHeader
    *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
    HeaderTime.i
    HeaderSize.i
    HeaderOffset.i
    HeaderData.i
    HeaderError.i
    ReceiveData.udtReceiveData
    ReceiveBuffer.udtNetBuffer
    Map Buffer.udtReceiveData()
  EndStructure
 
  ;--- Globals
 
  Global MutexTransactionID = CreateMutex()
  Global MutexClientData = CreateMutex()
  Global MutexSendData = CreateMutex()
  Global MutexSend = CreateMutex()
 
  Global NewMap ClientData.udtClientData()
  Global NewMap SendData.udtSendData()
 
  Threaded SendBuffer.udtNetBuffer
 
  ;--- Declare Common
 
  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 - \HeaderTime
          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 _CopyHeaderData(*ClientData.udtClientData)
    Protected receive_len, receive_offset, receive_size, receive_cancel, memory_size
   
    Protected ConnectionID = *ClientData\ConnectionID
    Protected *ReceiveBuffer.udtNetBuffer = *ClientData\ReceiveBuffer
    Protected *ReceiveData.udtReceiveData
   
    With *ReceiveData
      ; Daten über TransactionID auswählen
      *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(*ReceiveData, SizeOf(udtReceiveData), 0)
          *ClientData\HeaderError = 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\HeaderError = 3
            ProcedureReturn #TcpReceiveError
          EndIf
        EndIf
        Debug "[" + Hex(ConnectionID) + "] ReceiveData: New TransactionID (" + \TransactionID + ")", #TCP_Debuglevel
      EndIf   
      ; Daten auswerten
      receive_len = *ReceiveBuffer\Header\DataLen
      receive_size = *ReceiveBuffer\Header\Size - SizeOf(udtNetHeader)
      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
      If receive_len
        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\HeaderError = 5
          ProcedureReturn #TcpReceiveError
        EndIf
        If receive_len <> 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\HeaderError = 5
          ProcedureReturn #TcpReceiveError
        EndIf
        CopyMemory(*ReceiveBuffer + SizeOf(udtNetHeader), \Data + receive_offset, receive_size)
        \DataCount + receive_size
        ;If \DataCount >= receive_len
        If receive_offset + receive_size >= receive_len
          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
    Protected *ReceiveBuffer.udtNetBuffer
   
    *ClientData = _GetClientData(ConnectionID)
    If Not *ClientData
      Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - No ClientData", #TCP_Debuglevel
      ProcedureReturn #TcpReceiveErrorClientData
    EndIf
   
    *ReceiveBuffer = *ClientData\ReceiveBuffer
   
    With *ClientData
      \HeaderTime = ElapsedMilliseconds()
      If Not \HeaderData
        ; Header Info lesen
        cnt = ReceiveNetworkData(ConnectionID, *ReceiveBuffer + \HeaderOffset, SizeOf(udtNetHeader) - \HeaderOffset)
        ; Header Size überprüfen
        If cnt < 0
          \HeaderSize = 0
          \HeaderOffset = 0
          \HeaderData = #False
          \HeaderError = 4 ; ReceiveNetworkData
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - ReceiveNetworkData", #TCP_Debuglevel
          ProcedureReturn #TcpReceiveError
        EndIf
        \HeaderOffset + cnt
        If \HeaderOffset < SizeOf(udtNetHeader)
          Debug "[" + Hex(ConnectionID) + "] ReceiveData: Busy Header (" + \HeaderOffset + "/" + SizeOf(udtNetHeader) + ")", #TCP_DebuglevelBusy
          ProcedureReturn #TcpReceiveBusy
        Else
          crc = *ReceiveBuffer\Header\TransactionID ! *ReceiveBuffer\Header\ProtocolID ! *ReceiveBuffer\Header\DataLen ! *ReceiveBuffer\Header\DataOffset ! *ReceiveBuffer\Header\Cancel ! *ReceiveBuffer\Header\Size
          If crc <> *ReceiveBuffer\Header\CRC
            \HeaderSize = 0
            \HeaderOffset = 0
            \HeaderData = #False
            \HeaderError = 2 ; Header checksum
            Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - Header Checksum", #TCP_Debuglevel
            ProcedureReturn #TcpReceiveError
          EndIf
          \HeaderSize = *ReceiveBuffer\Header\Size
          If \HeaderSize > SizeOf(udtNetHeader)
            \HeaderData = #True
            ProcedureReturn #TcpReceiveBusy
          ElseIf \HeaderSize = SizeOf(udtNetHeader)
            \HeaderSize = 0
            \HeaderOffset = 0
            \HeaderData = #False
            \HeaderError = 0
            ProcedureReturn _CopyHeaderData(*ClientData)
          EndIf
        EndIf
       
      Else
        ; Header Daten lesen wenn vorhanden
        If \HeaderData
          cnt = ReceiveNetworkData(ConnectionID, *ReceiveBuffer + \HeaderOffset, \HeaderSize - \HeaderOffset)
         
          ; Header Size überprüfen
          If cnt < 0
            \HeaderSize = 0
            \HeaderOffset = 0
            \HeaderData = #False
            \HeaderError = 4 ; ReceiveNetworkData
            Debug "[" + Hex(ConnectionID) + "] ReceiveData: Error - ReceiveNetworkData", #TCP_Debuglevel
            ProcedureReturn #TcpReceiveError
          EndIf
          \HeaderOffset + cnt
          If \HeaderOffset < \HeaderSize
            Debug "[" + Hex(ConnectionID) + "] ReceiveData: Busy HeaderData (" + \HeaderOffset + "/" + \HeaderSize + ")", #TCP_DebuglevelBusy
            ProcedureReturn #TcpReceiveBusy
          Else
            ; Header vollständig
            \HeaderSize = 0
            \HeaderOffset = 0
            \HeaderData = #False
            \HeaderError = 0
            ProcedureReturn _CopyHeaderData(*ClientData)
          EndIf
        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_Unicode)
    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\HeaderError
    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
   
    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(udtNetHeader), 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\Size = send_size + SizeOf(udtNetHeader)
      SendBuffer\Header\CRC = SendBuffer\Header\TransactionID ! SendBuffer\Header\ProtocolID ! SendBuffer\Header\DataLen ! SendBuffer\Header\DataOffset ! SendBuffer\Header\Size
      size = send_size + SizeOf(udtNetHeader)
      len = 0
      LockMutex(MutexSend)
      Repeat
        cnt = SendNetworkData(ConnectionID, SendBuffer + len, size - len)
        len + cnt
      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_Unicode, Flags = 0, TransactionID = 0, ProtocolID = 0)
    Protected *Memory, send_len, send_pos, send_size, size, len, cnt
   
    If Not TransactionID
      TransactionID = _TransactionID()
    EndIf
   
    send_len = StringByteLength(Text)
   
    If Format = #PB_Unicode
      send_len + 2
    Else
      send_len + 1
    EndIf
   
    If Flags = #TcpSendAsynchron
      ProcedureReturn _AddSendData(ConnectionID, TransactionID, ProtocolID, send_len, @Text)
    EndIf
   
    send_pos = 0
    *Memory = @Text
   
    ; 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(udtNetHeader), 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\Size = send_size + SizeOf(udtNetHeader)
      SendBuffer\Header\CRC = SendBuffer\Header\TransactionID ! SendBuffer\Header\ProtocolID ! SendBuffer\Header\DataLen ! SendBuffer\Header\DataOffset ! SendBuffer\Header\Size
      size = send_size + SizeOf(udtNetHeader)
      len = 0
      LockMutex(MutexSend)
      Repeat
        cnt = SendNetworkData(ConnectionID, SendBuffer + len, size - len)
        len + cnt
      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 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
 
  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, send_id, send_pid, send_len, send_pos, send_size, send_cancel, size, len, cnt, *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_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(udtNetHeader)
            ; 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\Cancel = send_cancel
            SendBuffer\Header\Size = size
            SendBuffer\Header\CRC = send_id ! send_pid ! send_len ! send_pos ! send_cancel ! size
            ; Daten kopieren - Wenn vorhanden
            If *memory
              CopyMemory(*memory + send_pos, SendBuffer + SizeOf(udtNetHeader), send_size)
            EndIf
            ; Start senden
            len = 0
            LockMutex(MutexSend)
            Repeat
              cnt = SendNetworkData(\ConnectionID, SendBuffer + len, size - len)
              len + cnt
            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

; ***************************************************************************************

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Sun Oct 27, 2019 1:07 pm, edited 6 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sat Oct 26, 2019 12:04 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Test-Server
Code:
;-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
   
    ; 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()

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Sun Oct 27, 2019 1:08 pm, edited 3 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sat Oct 26, 2019 12:04 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Test-Client-1
Code:
;-
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
    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_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
 
  Delay(100)
 
EndProcedure


InitNetwork()
Main()

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Sun Oct 27, 2019 1:09 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sat Oct 26, 2019 12:07 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Test-Client-2
Code:
;-TOP

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(200000)

RandomSeed(1000)
RandomData(*Random1, 200000)
RandomSeed(2000)
RandomData(*Random2, 200000)

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_Unicode, #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()

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Sun Oct 27, 2019 1:12 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sat Oct 26, 2019 12:52 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Apr 26, 2003 2:15 pm
Posts: 834
Location: Cuernavaca, Mexico
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.

Current Machine: Win 10 Pro 64-bit, Dual Xeon E5-2670, 64 gigs ram, Geforce GTX 1660 Ti w/6 gigs ram


Top
 Profile  
Reply with quote  
 Post subject: Re: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sun Oct 27, 2019 1:59 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
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 / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module NetworkTCP - Send and Receive Data over 64kB
PostPosted: Sun Oct 27, 2019 9:31 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Update v1.19
- Add Macro Bugfix macOS SendNetworkData

Code:
; ***************************************************************************************
; 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 / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 7 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 11 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye