Module NetworkData - Send strings and data over 64kb
Posted: Sun Jul 03, 2016 12:46 pm
Module for transmitting string and raw data via network over 64kb datasize.
Receipt of data is carried out in the thread and passed to a callback function.
The callback function must have the following structure:
For sending the data, there are SendString(...) and SendData(...)
This can be communicated with to identify a DataID.
Update v1.10
- Added SendFile(...) - File size limit at 2GB
- Added SetDataFolder(...) for received files
- Update Examples
Update v1.11
- Change Network-Header for datasize over 2GB
- SendFile(...) can now send files over 2GB
- Update Client Example (SendFile with Threads)
Update v1.12
- Change temporary filename
Update v1.15
- Added: SetAESData (...). Send data encrypted.
- Added: SetUserData (...) and GetUserData (...) for each Connection.
Note UserData!
Access to the UserData is only possible within the NewDataCallback since each server or client has its own environment (threaded).
If a *pointer is used on your own data, you may have to release it again at event #PB_NetworkEvent_Disconnect.
Update v1.18
- Added some Mutex
- Optimize code
Update v1.21
- Fixed SendList: Now ClearList on exists DataSet
- Optimize: Protocol header and data block are now also encrypted
- Clean up code
Update v1.23
- Fixed MacOS - App Nap: Process go not longer to sleep. Thank to Danilo and Wilbert
- DataSet now intern a pointer to structure. We can free dataset later with new function FreeDataSet(...)
- Added: FreeDataSet(...)
- Remove: CopyDatSet(...)
- Added new constants for result of Callback
-- #NetResultHold ; Hold DataID and DataSet
-- #NetResultFree ; Free DataID and DataSet
-- #NetResultFreeWithoutDataSet ; Free DataID without DataSet
Modul_NetworkData
[/size]
Receipt of data is carried out in the thread and passed to a callback function.
The callback function must have the following structure:
If the callback function returns non-zero, the received data will be deleted.NewData(SEvent, ConnectionID, *NewData.NetworkData::udtDataset)
For sending the data, there are SendString(...) and SendData(...)
This can be communicated with to identify a DataID.
Update v1.10
- Added SendFile(...) - File size limit at 2GB
- Added SetDataFolder(...) for received files
- Update Examples
Update v1.11
- Change Network-Header for datasize over 2GB
- SendFile(...) can now send files over 2GB
- Update Client Example (SendFile with Threads)
Update v1.12
- Change temporary filename
Update v1.15
- Added: SetAESData (...). Send data encrypted.
- Added: SetUserData (...) and GetUserData (...) for each Connection.
Note UserData!
Access to the UserData is only possible within the NewDataCallback since each server or client has its own environment (threaded).
If a *pointer is used on your own data, you may have to release it again at event #PB_NetworkEvent_Disconnect.
Update v1.18
- Added some Mutex
- Optimize code
Update v1.21
- Fixed SendList: Now ClearList on exists DataSet
- Optimize: Protocol header and data block are now also encrypted
- Clean up code
Update v1.23
- Fixed MacOS - App Nap: Process go not longer to sleep. Thank to Danilo and Wilbert
- DataSet now intern a pointer to structure. We can free dataset later with new function FreeDataSet(...)
- Added: FreeDataSet(...)
- Remove: CopyDatSet(...)
- Added new constants for result of Callback
-- #NetResultHold ; Hold DataID and DataSet
-- #NetResultFree ; Free DataID and DataSet
-- #NetResultFreeWithoutDataSet ; Free DataID without DataSet
Modul_NetworkData
Code: Select all
;-TOP
; Comment: NetworkData
; Author : mk-soft
; Version: v1.24
; Created: 03.07.2016
; Updated: 28.08.2018
; Link En: http://www.purebasic.fr/english/viewtopic.php?f=12&t=66075
; Link De:
; Descriptions:
;
; Receipt of data is carried out in the thread and passed to a callback function.
; The callback function must have the following Structure:
;
; Syntax For New-Data-Callback
; - NewDataCB(SEvent, ConnectionID, *NewData.udtDataSet)
;
; If the callback function returns non-zero, the received data will be deleted.
;
; For sending the data, there are SendString(...), SendData(...), SendList(...) and SendFile(...)
; The data is assigned using the identifier DataID
;
; Syntax for Send
; - Send...(ConnectionID, DataID, ...)
; ***************************************************************************************
;- Begin Declare Module
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compileroption Threadsafe!"
CompilerEndIf
DeclareModule NetworkData
Enumeration 1 ; Type of data
#NetInteger
#NetString
#NetData
#NetList
#NetFile
EndEnumeration
Enumeration
#NetResult ; Hold DataID and DataSet
#NetResultFreeData ; Free DataID and DataSet
#NetResultFreeDataWithoutDataSet ; Free DataID without DataSet
EndEnumeration
; -----------------------------------------------------------------------------------
Structure udtAny
StructureUnion
bVal.b[0]
cVal.c[0]
wVal.w[0]
uVal.u[0]
iVal.i[0]
lVal.l[0]
qVal.q[0]
fVal.f[0]
dVal.d[0]
EndStructureUnion
EndStructure
Structure udtDataSet
; Header
ConnectionID.i
DataID.i
Type.i
; User data
UserData.i
Integer.i
String.s
Filename.s
*Data.udtAny
List Text.s()
EndStructure
; -----------------------------------------------------------------------------------
Declare BindLogging(EventCustomValue, ListviewGadget)
Declare UnBindLogging(EventCustomValue, ListviewGadget)
Declare Logging(Info.s)
Declare InitServer(Port, *NewDataCallback = 0, BindedIP.s = "")
Declare CloseServer(ServerID)
Declare InitClient(IP.s, Port, *NewDataCallback = 0, Timeout = 0)
Declare CloseClient(ConnectionID)
Declare SetServerNewDataCB(ServerID, *NewDataCallback)
Declare SetClientNewDataCB(ConnectionID, *NewDataCallback)
Declare SendInteger(ConnectionID, DataID, Value.i)
Declare SendString(ConnectionID, DataID, String.s)
Declare SendData(ConnectionID, DataID, *Data.udtAny, SizeOfData)
Declare SendList(ConnectionID, DataID, List Text.s())
Declare SendFile(ConnectionID, DataID, Filename.s)
Declare FreeDataSet(*Data.udtDataSet)
Declare SetAESData(*AESDataKey, Bits=192)
Declare SetUserData(ConnectionID, UserData)
Declare GetUserData(ConnectionID)
Declare SetDataFolder(Folder.s)
; -----------------------------------------------------------------------------------
EndDeclareModule
;- Begin Module
Module NetworkData
EnableExplicit
; Level 0 : Standard
; Level 1 : File transfer
; Level 2 : Received datablocks
;-DebugLevel
DebugLevel 0
Global ProtocolID.l = $FFEE2017
Global *AESData, *AESVector, AESBits
; -----------------------------------------------------------------------------------
Prototype ProtoNewDataCB(SEvent, ConnectionID, *NewData.udtDataSet)
; -----------------------------------------------------------------------------------
#BlockSizeData = 1024 ; Size of data without header
#BlockSizeSend = 2048 ; Size of send data
#BlockSizeReceive = 4096 ; Size of receive data
Structure udtServerList
ServerID.i
ThreadID.i
ExitServer.i
NewDataCB.ProtoNewDataCB
EndStructure
Structure udtClientList
ConnectionID.i
ThreadID.i
ExitClient.i
NewDataCB.ProtoNewDataCB
EndStructure
Structure udtDataPacket
; Datablock validation
OffsetString.q ; Offset of next string data
OffsetData.q ; Offset of next raw data
OffsetList.q ; Offset of next string data (List)
OffsetFile.q ; Offset of next file data
FilePB.i ; File ID (#PB_any)
*DataSet.udtDataSet ; Receive dataset
EndStructure
Structure udtDataBlock
ProtocolID.l ; Protocol Ident; For check of valid datablock
Datalen.l ; Len of datablock
DataID.l ; User data ident
State.w ; State of datablock; 1 First datablock, 2 Last datablock
Type.w ; Type of data
Size.q ; Size of complete data
Offset.q ; Offset of data
Count.l ; Bytecount of data
pData.udtAny ; Data
EndStructure
Structure udtSendBuffer
StructureUnion
Send.udtDataBlock
Buffer.b[#BlockSizeSend]
EndStructureUnion
EndStructure
Structure udtReceiveBuffer
Buffer.b[#BlockSizeReceive]
EndStructure
Structure udtDataConnection
Map DataPacket.udtDataPacket()
ConnectionID.i ; Connection Ident
UserData.i ; Userdata of connection
DataOffset.i ; Offset of receive datablock
Datalen.i ; Size of receive datablock
StructureUnion
Receive.udtDataBlock ; Complete receive datablock struct
Buffer.b[#BlockSizeReceive] ; Complete reeicve datablock buffer
EndStructureUnion
EndStructure
; -----------------------------------------------------------------------------------
Global LoggingEvent
Global LoggingGadget
Global LockServer
Global LockClient
Global LockSend
Global LockReceive
Global LockAES
;Global NewMap DataConnection.udtDataConnection() ; Change only for debugging with one server
Threaded NewMap DataConnection.udtDataConnection()
Threaded ReceiveBuffer.udtReceiveBuffer
Threaded SendBuffer.udtSendBuffer
Threaded SendBufferAES.udtSendBuffer
; -----------------------------------------------------------------------------------
Global NewMap ServerList.udtServerList()
Global NewMap ClientList.udtClientList()
; -----------------------------------------------------------------------------------
Global DataFolder.s
; -----------------------------------------------------------------------------------
Procedure InitModule()
InitNetwork()
LockServer = CreateMutex()
LockClient = CreateMutex()
LockSend = CreateMutex()
LockReceive = CreateMutex()
LockAES = CreateMutex()
DataFolder.s = GetTemporaryDirectory()
EndProcedure : InitModule()
; -----------------------------------------------------------------------------------
Declare ThreadServer(*this.udtServerList)
Declare ThreadClient(*this.udtClientList)
; -----------------------------------------------------------------------------------
Procedure Logging(Info.s)
Protected text.s, *mem
If LoggingEvent
text = FormatDate("[%YYYY-%MM-%DD %HH:%II:%SS] ", Date()) + Info
*mem = AllocateMemory(StringByteLength(text) + SizeOf(character))
PokeS(*mem, text)
PostEvent(LoggingEvent, 0, LoggingGadget, 0, *mem)
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure AddLoggingItem()
Protected gadget, count, *mem
gadget = EventGadget()
*mem = EventData()
If *mem
If IsGadget(gadget)
AddGadgetItem(gadget, -1, PeekS(*mem))
count = CountGadgetItems(gadget)
If count > 1000
RemoveGadgetItem(gadget, 0)
count - 1
EndIf
count - 1
SetGadgetState(gadget, count)
SetGadgetState(gadget, -1)
EndIf
FreeMemory(*mem)
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure BindLogging(EventCustomValue, ListViewGadget)
BindEvent(EventCustomValue, @AddLoggingItem(), 0, ListviewGadget)
LoggingEvent = EventCustomValue
LoggingGadget = ListviewGadget
EndProcedure
; -----------------------------------------------------------------------------------
Procedure UnbindLogging(EventCustomValue, ListviewGadget)
UnbindEvent(EventCustomValue, @AddLoggingItem(), 0, ListviewGadget)
LoggingEvent = 0
LoggingGadget = 0
EndProcedure
; -----------------------------------------------------------------------------------
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) !!!
#NSActivityIdleDisplaySleepDisabled = 1 << 40
#NSActivityIdleSystemSleepDisabled = 1 << 20
#NSActivitySuddenTerminationDisabled = (1 << 14)
#NSActivityAutomaticTerminationDisabled = (1 << 15)
#NSActivityUserInitiated = ($00FFFFFF | #NSActivityIdleSystemSleepDisabled)
#NSActivityUserInitiatedAllowingIdleSystemSleep = (#NSActivityUserInitiated & ~#NSActivityIdleSystemSleepDisabled)
#NSActivityBackground = $000000FF
#NSActivityLatencyCritical = $FF00000000
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
; -----------------------------------------------------------------------------------
Procedure InitServer(Port, *NewDataCallback = 0, BindedIP.s = "")
Protected ServerID, keyServerID.s
ServerID = CreateNetworkServer(#PB_Any, Port, #PB_Network_TCP, BindedIP)
If ServerID
keyServerID = Hex(ServerID)
AddMapElement(ServerList(), keyServerID)
ServerList()\ServerID = ServerID
ServerList()\NewDataCB = *NewDataCallback
ServerList()\ThreadID = CreateThread(@ThreadServer(), @ServerList())
Logging("Network: Init Server: ID " + Hex(ServerID))
Else
Logging("Network: Error Init Network Server")
EndIf
ProcedureReturn ServerID
EndProcedure
; -----------------------------------------------------------------------------------
Procedure CloseServer(ServerID)
Protected keyServerID.s, count
keyServerID = Hex(ServerID)
If FindMapElement(ServerList(), keyServerID)
Logging("Network: Close Network Server: ID " + keyServerID)
CloseNetworkServer(ServerID)
ServerList()\ExitServer = 1
Repeat
If ServerList()\ExitServer = 0
Break
Else
count + 1
If count >= 10
KillThread(ServerList()\ThreadID)
Logging("Network: Error - Kill Network Server: ID " + keyServerID)
Break
EndIf
EndIf
Delay(100)
ForEver
DeleteMapElement(ServerList(), keyServerID)
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure InitClient(IP.s, Port, *NewDataCallback = 0, Timeout = 0)
Protected ConnectionID, keyConnectionID.s
ConnectionID = OpenNetworkConnection(IP, Port, #PB_Network_TCP, Timeout)
If ConnectionID
keyConnectionID = Hex(ConnectionID)
AddMapElement(ClientList(), keyConnectionID)
ClientList()\ConnectionID = ConnectionID
ClientList()\NewDataCB = *NewDataCallback
ClientList()\ThreadID = CreateThread(@ThreadClient(), @ClientList())
Logging("Network: Init Network Connection: ID " + Hex(ConnectionID))
Else
Logging("Network: Error Init Network Connection")
EndIf
ProcedureReturn ConnectionID
EndProcedure
; -----------------------------------------------------------------------------------
Procedure CloseClient(ConnectionID)
Protected keyConnectionID.s, count
keyConnectionID = Hex(ConnectionID)
If FindMapElement(ClientList(), keyConnectionID)
Logging("Network: Close Network Client: ID " + keyConnectionID)
CloseNetworkConnection(ConnectionID)
ClientList()\ExitClient = 1
Repeat
If ClientList()\ExitClient = 0
Break
Else
count + 1
If count >= 10
KillThread(ClientList()\ThreadID)
Logging("Network: Error - Kill Network Client: ID " + keyConnectionID)
Break
EndIf
EndIf
Delay(100)
ForEver
DeleteMapElement(ClientList(), keyConnectionID)
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SetServerNewDataCB(ServerID, *NewDataCallback)
Protected keyServerID.s
keyServerID = Hex(ServerID)
If FindMapElement(ServerList(), keyServerID)
ServerList()\NewDataCB = *NewDataCallback
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SetClientNewDataCB(ConnectionID, *NewDataCallback)
Protected keyConnectionID.s
keyConnectionID = Hex(ConnectionID)
If FindMapElement(ClientList(), keyConnectionID)
ClientList()\NewDataCB = *NewDataCallback
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure InitDataPacket(Map DataPacket.udtDataPacket(), Type, Size)
Protected result, *DataSet.udtDataSet
With DataPacket()
*DataSet = \DataSet
Select type
Case #NetInteger
*DataSet\Integer = 0
ProcedureReturn #True
Case #NetString
*DataSet\String = Space(Size / SizeOf(character))
\OffsetString = 0
ProcedureReturn #True
Case #NetData
If *DataSet\Data
FreeMemory(*DataSet\Data)
EndIf
*DataSet\Data = AllocateMemory(Size)
\OffsetData = 0
If *DataSet\Data
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
Case #NetList
ClearList(*DataSet\Text())
AddElement(*DataSet\Text())
\OffsetList = 0
ProcedureReturn #True
Case #NetFile
\OffsetFile = 0
*DataSet\Filename = DataFolder + *DataSet\ConnectionID + "-" + *DataSet\DataID + "-" + Date() + ".download"
\FilePB = CreateFile(#PB_Any, *DataSet\Filename)
If \FilePB
Debug ("Network; Level 1; ConnectionID " + *DataSet\ConnectionID + "; DataID " + *DataSet\DataID + "; New File: " + *DataSet\Filename), 1
ProcedureReturn #True
Else
Logging("Network: Error - CreateFile: " + \DataSet\Filename)
ProcedureReturn #False
EndIf
Default
ProcedureReturn #False
EndSelect
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure FreeDataPacket(Map DataPacket.udtDataPacket())
With DataPacket()
If \DataSet\Data
FreeMemory(\DataSet\Data)
EndIf
If \FilePB
If IsFile(\FilePB)
CloseFile(\FilePB)
If FileSize(\DataSet\Filename) >= 0
DeleteFile(\DataSet\Filename)
EndIf
EndIf
EndIf
ClearList(\DataSet\Text())
\DataSet\String = #Null$
FreeStructure(\DataSet)
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Structure udtArray
a.a[0]
EndStructure
Procedure AESDecoderMemory(*Input, *Output, Count, *AESData, AESBits, *AESVector, Mode = #PB_Cipher_CBC)
If count >= 16
If *Output = *Input
Protected *Buffer = AllocateMemory(count)
CopyMemory(*Input , *Buffer, count)
AESDecoder(*Buffer, *Output , count, *AESData, AESBits, *AESVector, Mode)
FreeMemory(*Buffer)
Else
AESDecoder(*Input, *Output , count, *AESData, AESBits, *AESVector, Mode)
EndIf
Else
Protected i, c, *in.udtArray, *out.udtArray, *aes.udtArray
c = count - 1
*in = *Input
*out = *Output
*aes = *AESData
For i = 0 To c
*out\a[i] = *in\a[i] ! *aes\a[i]
Next
EndIf
EndProcedure
; ---
Procedure AESEncoderMemory(*Input, *Output, Count, *AESData, AESBits, *AESVector, Mode = #PB_Cipher_CBC)
If count >= 16
If *Output = *Input
Protected *Buffer = AllocateMemory(count)
CopyMemory(*Input , *Buffer, count)
AESEncoder(*Buffer, *Output , count, *AESData, AESBits, *AESVector, Mode)
FreeMemory(*Buffer)
Else
AESEncoder(*Input, *Output , count, *AESData, AESBits, *AESVector, Mode)
EndIf
Else
Protected i, c, *in.udtArray, *out.udtArray, *aes.udtArray
c = count - 1
*in = *Input
*out = *Output
*aes = *AESData
For i = 0 To c
*out\a[i] = *in\a[i] ! *aes\a[i]
Next
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SendInteger(ConnectionID, DataID, Value.i)
Protected count
With SendBuffer\Send
\ProtocolID = ProtocolID
\DataID = DataID
\State = 3
\Type = #NetInteger
\Size = SizeOf(quad)
\Offset = 0
\Count = SizeOf(quad)
\pData\qVal[0] = Value ; Send allway as quad
\Datalen = SizeOf(udtDataBlock) + SizeOf(quad)
LockMutex(LockSend)
If *AESData
AESEncoderMemory(SendBuffer, SendBufferAES, SizeOf(udtDataBlock), *AESData, AESBits, *AESVector)
AESEncoderMemory(SendBuffer\Send\pData, SendBufferAES\Send\pData, SizeOf(quad), *AESData, AESBits, @SendBuffer\Send\Size)
count = SendNetworkData(ConnectionID, SendBufferAES, \Datalen)
Else
count = SendNetworkData(ConnectionID, SendBuffer, \Datalen)
EndIf
UnlockMutex(LockSend)
If count <> \Datalen
Logging("Network: Error SendInteger: DataID " + Str(\DataID))
ProcedureReturn 0
EndIf
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SendString(ConnectionID, DataID, String.s)
Protected count.i, size.q, index.q, len.i, *data
*data = @String
With SendBuffer\Send
size = StringByteLength(String) + SizeOf(character)
index = 0
\ProtocolID = ProtocolID
\DataID = DataID
\State = 1
\Type = #NetString
\Size = size
\Offset = 0
\Count = 0
Repeat
If index + #BlockSizeData > size
len = size - index
Else
len = #BlockSizeData
EndIf
CopyMemory(*data, \pData, len)
*data + len
index + len
If index >= size
\State + 2
EndIf
\Count = len
\Datalen = SizeOf(udtDataBlock) + len
LockMutex(LockSend)
If *AESData
AESEncoderMemory(SendBuffer, SendBufferAES, SizeOf(udtDataBlock), *AESData, AESBits, *AESVector)
AESEncoderMemory(SendBuffer\Send\pData, SendBufferAES\Send\pData, len, *AESData, AESBits, @SendBuffer\Send\Size)
count = SendNetworkData(ConnectionID, SendBufferAES, \Datalen)
Else
count = SendNetworkData(ConnectionID, SendBuffer, \Datalen)
EndIf
UnlockMutex(LockSend)
If count <> \Datalen
Logging("Network: Error SendString: DataID " + Str(\DataID))
ProcedureReturn 0
EndIf
\Offset + len
\State = 0
Until index >= size
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SendData(ConnectionID, DataID, *Data, SizeOfData)
Protected count.i, size.q, index.q, len.i
With SendBuffer\Send
size = SizeOfData
index = 0
len = 0
\ProtocolID = ProtocolID
\DataID = DataID
\State = 1
\Type = #NetData
\Size = size
\Offset = 0
\Count = 0
Repeat
If index + #BlockSizeData > size
len = size - index
Else
len = #BlockSizeData
EndIf
CopyMemory(*Data, \pData, len)
*Data + len
index + len
If index >= size
\State + 2
EndIf
\Count = len
\Datalen = SizeOf(udtDataBlock) + len
LockMutex(LockSend)
If *AESData
AESEncoderMemory(SendBuffer, SendBufferAES, SizeOf(udtDataBlock), *AESData, AESBits, *AESVector)
AESEncoderMemory(SendBuffer\Send\pData, SendBufferAES\Send\pData, len, *AESData, AESBits, @SendBuffer\Send\Size)
count = SendNetworkData(ConnectionID, SendBufferAES, \Datalen)
Else
count = SendNetworkData(ConnectionID, SendBuffer, \Datalen)
EndIf
UnlockMutex(LockSend)
If count <> \Datalen
Logging("Network: Error SendString: DataID " + Str(\DataID))
ProcedureReturn 0
EndIf
\Offset + len
\State = 0
Until index >= size
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SendListPart(ConnectionID, DataID, String.s, First, Last)
Protected count.i, size.q, index.q, len.i, *data
*data = @String
With SendBuffer\Send
size = StringByteLength(String) + SizeOf(character)
index = 0
len = 0
\ProtocolID = ProtocolID
\DataID = DataID
\Type = #NetList
\Size = size
\Offset = 0
\Count = 0
If first
\State = 1
Else
\State = 4
EndIf
Repeat
If index + #BlockSizeData > size
len = size - index
Else
len = #BlockSizeData
EndIf
CopyMemory(*data, \pData, len)
*data + len
index + len
If index >= size And Last
\State + 2
EndIf
\Count = len
\Datalen = SizeOf(udtDataBlock) + len
LockMutex(LockSend)
If *AESData
AESEncoderMemory(SendBuffer, SendBufferAES, SizeOf(udtDataBlock), *AESData, AESBits, *AESVector)
AESEncoderMemory(SendBuffer\Send\pData, SendBufferAES\Send\pData, len, *AESData, AESBits, @SendBuffer\Send\Size)
count = SendNetworkData(ConnectionID, SendBufferAES, \Datalen)
Else
count = SendNetworkData(ConnectionID, SendBuffer, \Datalen)
EndIf
UnlockMutex(LockSend)
If count <> \Datalen
Logging("Network: Error SendList: DataID " + Str(\DataID))
ProcedureReturn 0
EndIf
\Offset + len
\State = 0
Until index >= size
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SendList(ConnectionID, DataID, List Text.s())
Protected result.i, size.i, index.i, first.i, last.i
size = ListSize(Text())
index = 0
first = #True
last = #False
ForEach Text()
index + 1
If index >= size
last = #True
EndIf
result = SendListPart(ConnectionID, DataID, Text(), first, last)
If Not result
Break
EndIf
If first
first = #False
EndIf
Next
ProcedureReturn result
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SendFile(ConnectionID, DataID, Filename.s)
Protected count.i, len.q, size.q, index.q, ofs.i, filePB.i
size = FileSize(Filename)
If size <= 0
ProcedureReturn 0
EndIf
filePB = ReadFile(#PB_Any, Filename)
If Not filePB
ProcedureReturn 0
EndIf
With SendBuffer\Send
index = 0
len = 0
\ProtocolID = ProtocolID
\DataID = DataID
\State = 1
\Type = #NetFile
\Size = size
\Offset = 0
\Count = 0
Repeat
len = ReadData(filePB, \pData, #BlockSizeData)
index + len
If index >= size
\State + 2
EndIf
\Count = len
\Datalen = SizeOf(udtDataBlock) + len
LockMutex(LockSend)
If *AESData
AESEncoderMemory(SendBuffer, SendBufferAES, SizeOf(udtDataBlock), *AESData, AESBits, *AESVector)
AESEncoderMemory(SendBuffer\Send\pData, SendBufferAES\Send\pData, len, *AESData, AESBits, @SendBuffer\Send\Size)
count = SendNetworkData(ConnectionID, SendBufferAES, \Datalen)
;NetworkEncoder(SendBuffer)
Else
count = SendNetworkData(ConnectionID, SendBuffer, \Datalen)
EndIf
UnlockMutex(LockSend)
If count <> \Datalen
Logging("Network: Error SendFile: DataID " + Str(\DataID))
ProcedureReturn 0
EndIf
\Offset + len
\State = 0
len = 0
Until index >= size
CloseFile(filePB)
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure FreeDataSet(*DataSet.udtDataSet)
With *DataSet
; ConnectionID, DataID not cleared
If \Data
FreeMemory(\Data)
EndIf
\String = #Null$
ClearList(\Text())
EndWith
FreeStructure(*DataSet)
EndProcedure
; -----------------------------------------------------------------------------------
Procedure ReceiveData(ConnectionID, *NewDataCB.ProtoNewDataCB)
Protected result, count.i, size.q, error.i, keyConnectionID.s, keyData.s, *data.udtAny, *DataSet.udtDataSet
; Set or create DataConnection
keyConnectionID = Hex(ConnectionID)
If Not FindMapElement(DataConnection(), keyConnectionID)
AddMapElement(DataConnection(), keyConnectionID)
DataConnection()\ConnectionID = ConnectionID
DataConnection()\DataOffset = 0
DataConnection()\Datalen = 0
EndIf
error = #False
Repeat
With DataConnection()
; Read block header
If \DataOffset < SizeOf(udtDataBlock)
LockMutex(LockReceive)
count = ReceiveNetworkData(ConnectionID, ReceiveBuffer, SizeOf(udtDataBlock) - \DataOffset)
UnlockMutex(LockReceive)
If count <= 0
Logging("Network: Error - ReceiveNetworkData: ConnectionID " + keyConnectionID)
Break
EndIf
CopyMemory(ReceiveBuffer, \Receive + \DataOffset, count)
\DataOffset + count
If \DataOffset < SizeOf(udtDataBlock)
Break
Else
; AES Header Decoder
If *AESData
LockMutex(LockAES)
AESDecoderMemory(\Receive, \Receive, SizeOf(udtDataBlock), *AESData, AESBits, *AESVector)
UnlockMutex(LockAES)
EndIf
; Check header
If \Receive\ProtocolID <> ProtocolID
Logging("Network: Error - ProtocolID: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
If \Receive\Datalen > #BlockSizeData + SizeOf(udtDataBlock)
Logging("Network: Error - Datalen: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
If \Receive\Count > #BlockSizeData
Logging("Network: Error - Blocksize: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
\Datalen = \Receive\Datalen
EndIf
Break
Else ; Read block data
If \Receive\Count > 0
LockMutex(LockReceive)
count = ReceiveNetworkData(ConnectionID, ReceiveBuffer, \Datalen - \DataOffset)
UnlockMutex(LockReceive)
If count <= 0
Logging("Network: Error - ReceiveNetworkData : ConnectionID " + keyConnectionID)
Break
EndIf
CopyMemory(ReceiveBuffer, \Receive + \DataOffset, count)
\DataOffset + count
If \DataOffset < \Datalen
Break
EndIf
EndIf
\DataOffset = 0
\Datalen = 0
EndIf
EndWith
; Check Data
With DataConnection()\Receive
; Set or Create DataPacket over DataID
keyData = Hex(\DataID)
If Not FindMapElement(DataConnection()\DataPacket(), keyData)
If (\State & 1) <> 1
Logging("Network: Error - Missing first block: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
If Not AddMapElement(DataConnection()\DataPacket(), keyData)
Logging("Network: Error - Out of memory: ConnectionID " + keyConnectionID)
error = #True
Break
Else
DataConnection()\DataPacket()\DataSet = AllocateStructure(udtDataSet)
If Not DataConnection()\DataPacket()\DataSet
Logging("Network: Error - Out of memory: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
EndIf
EndIf
; AES Data Decoder
If *AESData
LockMutex(LockAES)
AESDecoderMemory(\pData, \pData, \Count, *AESData, AESBits, @\Size)
UnlockMutex(LockAES)
EndIf
*DataSet = DataConnection()\DataPacket()\DataSet
; Check first data block
If \State & 1
*DataSet\ConnectionID = ConnectionID
*DataSet\UserData = DataConnection()\UserData
*DataSet\DataID = \DataID
*DataSet\Type = \Type
If Not InitDataPacket(DataConnection()\DataPacket(), \Type, \Size)
Logging("Network: Error - Init datapacket: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
EndIf
; Debuglevel 2
Debug ("Network; Level 2; ConnectionID " + keyConnectionID + "; DataID " + \DataID + "; Type " + \Type + "; State " + \State + "; Offset " + \Offset + "; Count " + \Count) , 2
Select \Type
Case #NetInteger
*DataSet\Integer = \pData\iVal[0]
Case #NetString
; Check valid index
If \Offset <> DataConnection()\DataPacket()\OffsetString
Logging("Network: Error - Invalid offset of string: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
*data = PeekI(*DataSet + OffsetOf(udtDataSet\String))
CopyMemory(\pData, *data + \Offset, \Count)
DataConnection()\DataPacket()\OffsetString + \Count
Case #NetData
; Check valid index
If \Offset <> DataConnection()\DataPacket()\OffsetData
Logging("Network: Error - Invalid offset of data: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
*data = *DataSet\Data
; Check valid size
size = \Offset + \Count
If size > MemorySize(*data)
Logging("Network: Error - Invalid datasize of data: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
CopyMemory(\pData, *data + \Offset, \Count)
DataConnection()\DataPacket()\OffsetData + \Count
Case #NetList
; Check valid index
If \State & 4
AddElement(*DataSet\Text())
DataConnection()\DataPacket()\OffsetList = 0
EndIf
If \Offset <> DataConnection()\DataPacket()\OffsetList
Logging("Network: Error - Invalid offset of list: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
*DataSet\Text() + PeekS(\pData, \Count)
DataConnection()\DataPacket()\OffsetList + \Count
Case #NetFile
; Check valid file index
If \Offset <> DataConnection()\DataPacket()\OffsetFile
Logging("Network: Error - Invalid offset of file: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
*data = DataConnection()\DataPacket()\FilePB
; Check valid file
If Not IsFile(*data)
Logging("Network: Error - Invalid file: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
size = \Offset + \Count
If \Offset <> Loc(*data)
Logging("Network: Error - Invalid loc of file: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
If WriteData(*data, \pData, \Count) <> \Count
Logging("Network: Error - Write data of file: ConnectionID " + keyConnectionID)
error = #True
Break
EndIf
DataConnection()\DataPacket()\Offsetfile + \Count
If \State & 2
If IsFile(*data)
CloseFile(*data)
DataConnection()\DataPacket()\FilePB = 0
EndIf
EndIf
Default
Logging("Network: Error - Invalid datatype: ConnectionID " + keyConnectionID)
error = #True
Break
EndSelect
; Check last data block
If \State & 2
If *NewDataCB
result = *NewDataCB(#PB_NetworkEvent_Data, ConnectionID, *DataSet)
If result = #NetResultFreeData
FreeDataSet(*DataSet)
DeleteMapElement(DataConnection()\DataPacket())
ElseIf result = #NetResultFreeDataWithoutDataSet
DeleteMapElement(DataConnection()\DataPacket())
EndIf
EndIf
EndIf
EndWith
Until #True
; On error delete connection and data
If error
CloseNetworkConnection(ConnectionID)
If *NewDataCB
*NewDataCB(#PB_NetworkEvent_Disconnect, ConnectionID, 0)
EndIf
If FindMapElement(DataConnection(), keyConnectionID)
ForEach DataConnection()\DataPacket()
FreeDataPacket(DataConnection()\DataPacket())
Next
DeleteMapElement(DataConnection(), keyConnectionID)
EndIf
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure ThreadServer(*this.udtServerList)
Protected Event, ConnectionID, keyConnectionID.s, count
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Protected StopNap = BeginWork(#NSActivityUserInitiated ! #NSActivityLatencyCritical, Hex(*this))
CompilerEndIf
With *this
Repeat
LockMutex(LockServer)
Event = NetworkServerEvent(\ServerID)
If Event
ConnectionID = EventClient()
EndIf
UnlockMutex(LockServer)
Select Event
Case #PB_NetworkEvent_Connect
; Create DataConnection
keyConnectionID = Hex(ConnectionID)
If FindMapElement(DataConnection(), keyConnectionID)
ForEach DataConnection()\DataPacket()
FreeDataPacket(DataConnection()\DataPacket())
Next
DeleteMapElement(DataConnection(), keyConnectionID)
Else
AddMapElement(DataConnection(), keyConnectionID)
DataConnection()\ConnectionID = ConnectionID
Logging("Network: Client connected: ID " + keyConnectionID)
EndIf
If \NewDataCB
\NewDataCB(#PB_NetworkEvent_Connect, ConnectionID, 0)
EndIf
Case #PB_NetworkEvent_Data
ReceiveData(ConnectionID,\NewDataCB)
Case #PB_NetworkEvent_Disconnect
; Destroy DataConnection
keyConnectionID = Hex(ConnectionID)
Logging("Network: Client disconnected: ID " + keyConnectionID)
If \NewDataCB
\NewDataCB(#PB_NetworkEvent_Disconnect, ConnectionID, 0)
EndIf
If FindMapElement(DataConnection(), keyConnectionID)
ForEach DataConnection()\DataPacket()
FreeDataPacket(DataConnection()\DataPacket())
Next
DeleteMapElement(DataConnection(), keyConnectionID)
EndIf
Default
Delay(20)
EndSelect
Until \ExitServer
; Clear all DataConnection. We can delete all the data, because each server have their own DataConnection. DataConnection is threaded
ForEach DataConnection()
If \NewDataCB
\NewDataCB(#PB_NetworkEvent_Disconnect, DataConnection()\ConnectionID, 0)
EndIf
ForEach DataConnection()\DataPacket()
FreeDataPacket(DataConnection()\DataPacket())
Next
ClearMap(DataConnection()\DataPacket())
Next
ClearMap(DataConnection())
; Exit Thread
\ExitServer = 0
EndWith
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
EndWork(StopNap)
CompilerEndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure ThreadClient(*this.udtClientList)
Protected Event, keyConnectionID.s
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Protected StopNap = BeginWork(#NSActivityUserInitiated ! #NSActivityLatencyCritical, Hex(*this))
CompilerEndIf
With *this
; Create DataConnection
keyConnectionID = Hex(\ConnectionID)
If Not FindMapElement(DataConnection(), keyConnectionID)
AddMapElement(DataConnection(), keyConnectionID)
DataConnection()\ConnectionID = \ConnectionID
EndIf
Repeat
LockMutex(LockClient)
Event = NetworkClientEvent(\ConnectionID)
UnlockMutex(LockClient)
Select Event
Case #PB_NetworkEvent_Data
ReceiveData(\ConnectionID, \NewDataCB)
Case #PB_NetworkEvent_Disconnect
If \NewDataCB
\NewDataCB(#PB_NetworkEvent_Disconnect, \ConnectionID, 0)
EndIf
Break
Default
Delay(20)
EndSelect
Until \ExitClient
; Destroy DataConnection
If FindMapElement(DataConnection(), keyConnectionID)
ForEach DataConnection()\DataPacket()
FreeDataPacket(DataConnection()\DataPacket())
Next
DeleteMapElement(DataConnection(), keyConnectionID)
EndIf
; Exit Thread
\ExitClient = 0
EndWith
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
EndWork(StopNap)
CompilerEndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SetAESData(*AESDataKey, Bits=192)
*AESData = *AESDataKey
AESBits = Bits
If *AESVector
FreeMemory(*AESVector)
EndIf
*AESVector = AllocateMemory(16)
RandomSeed(ProtocolID)
RandomData(*AESVector, 16)
EndProcedure
; -----------------------------------------------------------------------------------
; Connection Userdata
Procedure SetUserData(ConnectionID, UserData) ; Result old userdata
Protected keyConnectionID.s, old_userdata
keyConnectionID = Hex(ConnectionID)
If FindMapElement(DataConnection(), keyConnectionID)
old_userdata = DataConnection()\UserData
DataConnection()\UserData = UserData
EndIf
ProcedureReturn old_userdata
EndProcedure
; -----------------------------------------------------------------------------------
Procedure GetUserData(ConnectionID) ; Result userdata
Protected keyConnectionID.s, userdata
keyConnectionID = Hex(ConnectionID)
If FindMapElement(DataConnection(), keyConnectionID)
userdata = DataConnection()\UserData
EndIf
ProcedureReturn userdata
EndProcedure
; -----------------------------------------------------------------------------------
Procedure SetDataFolder(Folder.s)
If FileSize(Folder) = -2
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
If Right(Folder, 1) <> "\"
DataFolder = Folder + "\"
Else
DataFolder = Folder
EndIf
CompilerElse
If Right(Folder, 1) <> "/"
DataFolder = Folder + "/"
Else
DataFolder = Folder
EndIf
CompilerEndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
DebugLevel 0
EndModule
;- End Module
