Habe mir ein Module geschrieben womit ich Daten und String senden und empfangen kann
ohne das ich noch überprüfen muss ob alle Daten vollständige angekommen sind.
Ausserdem kann man Daten und Strings asynchron senden und diese können auch über 64kB groß sein.
Beschreibung im Module und ein Beispiel für ein Mini-Chat Programm
Update v1.09
- Bugfix ReceiveBuffer
Update v1.10
- Added TcpCheckClientData(...)
- Added TcpGetClientList(...)
- Fix Syntax #TcpSendSynchron und #TcpSendAsynchron
Update v1.12r3
- Daten ClientData und SendData trennt
- Zeiten angepasst
Update v1.13r2
- TcpSetSendDataCallback für asynchrones senden hinzugefügt
- * Neu Konstanten für SendDataCallback
- * Header erweitert
- #TCP_DebugLevelBusy hinzugefügt
- #TCP_BlockDelay auf 20ms gesetzt
- Beschreibung überarbeitet
- Code zusammengefasst (Release 2)
Update v1.14
- Bugfix Speicherlecks Send Asynchron
Update v1.15r2
- Added TcpGetReceiveData
- Change Debug output
Update v1.16
- Maximale Blockgröße geändert. Max 65535 - 24 (HeaderSize). Voreinstellung 8 * 1452 - 24
- Struktur angepasst
Update v1.17
- Optimiert Stop SendThread
Update v1.18r2
- Bugfix MacOS SendNetworkData (PB Bug?)
Update v1.19
- Add Macro Bugfix macOS SendNetworkData
Code: Alles auswählen
;-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
; ***************************************************************************************