Module NetworkData - Strings und Daten über 64kb

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Module NetworkData - Strings und Daten über 64kb

Beitrag von mk-soft »

Modul zum senden und empfangen von String, Daten und Textlisten über 64kB.

Zur Identifizierung der Daten kann ein DataID übermittel werden. Der Empfang der Daten erfolgt über ein Callback-Funktion.
Dabei erhält man ein Dataset mit den empfangenden Daten.
Liefert die Callback-Funktion ungleich "Null" zurück, wird das empfangende Dataset gelöscht.
Procedure NewData(SEvent, ConnectionID, *NewData.NetworkData::udtDataset)
Zum Senden gibt es folgende Funktionen:
- SendInteger(...) : Zum Beispiel zur Rückgabe eines Ergebnisses (Result).
- SendString(...) : Einzelnen String senden.
- SendData(...) : Rohdaten (Memory).
- SendList(...) : Senden einer Liste von Type String (NewList Text.s()). Zum Beispiel das Ergebnis eines Datenbankabruf.
Neu
- SendFile(...) : Senden von Dateien

Update
- Geändert: LockSend optimiert für Senden von Daten über Threads
- Geändert: Internal Dataset

Update v1.14
- Diverse Anpassungen
- Hinzufügt Sendfile

Update v1.15
- Hingefügt: SetAESData(...). Daten verschlüsselt senden.
- Hingefügt: SetUserData(...) und GetUserData(...) für jede Connection.

Update v1.24

Hinweis UserData!
Der Zugriff auf die UserData der ist nur innerhalb von der NewDataCallback möglich, da jeder Server oder Client seine eigene Umgebung hat (Threaded).
Wenn ein *Pointer auf eigene Daten verwendet werden, kann (muss) man diesen bei den Event #PB_NetworkEvent_Disconnect wieder freigeben.

Modul_NetworkData.pb

Code: Alles auswählen

;-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
[/size]
Zuletzt geändert von mk-soft am 28.02.2019 21:31, insgesamt 5-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von mk-soft »

Server

Code: Alles auswählen

;-TOP
; NetworkData Server Example v1.24

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuExit
EndEnumeration

Enumeration ; Gadgets
  #List
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

; Global Variable
Global exit

IncludeFile "Modul_NetworkData.pb"

Global *RawData = AllocateMemory(300000)
RandomSeed(123)
RandomData(*RawData, 300000)
PokeQ(*RawData + 4, 0)

Global *AESData24 = AllocateMemory(24)
RandomSeed(100)
RandomData(*AESData24, 24)

; NewData Callback
Procedure NewData(SEvent, ConnectionID, *NewData.NetworkData::udtDataset)
  
  UseModule NetworkData
  
  Protected ip.s, result.s, count
  
  If SEvent = #PB_NetworkEvent_Connect
    ip = IPString(GetClientIP(ConnectionID))
    Logging("Callback: Client connected: IP " + ip)
    SetUserData(ConnectionID, Date())
    ProcedureReturn 0
  ElseIf SEvent = #PB_NetworkEvent_Disconnect
    Logging("Callback: Client disconnected ID " + Hex(ConnectionID))
    Logging("Callback: Client connected time: " + Str(Date() - GetUserData(ConnectionID)))
    
    ProcedureReturn 0
  EndIf
  
  With *NewData
    ip = IPString(GetClientIP(ConnectionID))
    Logging("Callback: New data from ID " + Hex(ConnectionID) + " (" + ip + "): DataID " + Str(\DataID))
    Select \Type
      Case #NetInteger
        result = "Connection Time = " + FormatDate("%HH:%II:%SS", \UserData) + "  / Integer = " + Str(\Integer)
        
      Case #NetString
        result = "Size of String = " + Str(Len(\String))
      Case #NetData
        If CompareMemory(\Data, *RawData, MemorySize(\Data))
          result = "RawData Ok; Size of RawData = " + Str(MemorySize(\Data))
        Else
          result = "RawData Error"
        EndIf
        
      Case #NetList
        result = "Count of List = " + Str(ListSize(\Text()))
        count = 0
        ForEach \Text()
          count + Len(\Text())
          Logging("Callback List: " + Left(\Text(), 60))
        Next
        result = "Count of List = " + Str(ListSize(\Text())) + " Chars = " + count
        
      Case #NetFile
        If \String
          result = GetPathPart(\Filename) + \String
          RenameFile(\Filename, result)
        EndIf
        result = "File: " + result
        
    EndSelect
    SendString(ConnectionID, \DataID, result)
    If \Type = #NetData
      ProcedureReturn #NetResultFreeData
    Else
      ProcedureReturn #NetResult
    EndIf  
  EndWith
  
  UnuseModule NetworkData

EndProcedure

Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#List, x, y, dx, dy)
  
EndProcedure

Procedure Status()
  StatusBarText(#Status, 0, FormatDate("%HH:%II:%SS", Date()))
EndProcedure

; Main
Procedure Main()
  
  
  Protected event, style, dx, dy
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 640
  dy = 480
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Server", style)
    
    ; Menu
    CreateMenu(#Menu, WindowID(#Main))
    MenuTitle("Common")
    MenuItem(#MenuExit, "E&xit")
    ; Gadgets
    ListViewGadget(#List, 0, 0, dx, dy)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    AddWindowTimer(#Main, 1, 1000)
    
    UpdateWindow()
    
    NetworkData::BindLogging(#PB_Event_FirstCustomValue, #List)
    ServerID1 = NetworkData::InitServer(6037, @NewData())
    ;ServerID2 = NetworkData::InitServer(6038, @NewData())
    ;ServerID3 = NetworkData::InitServer(6039, @NewData())
    
    NetworkData::SetAESData(*AESData24)
    
    NetworkData::SetDataFolder(GetHomeDirectory())
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
              CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                NetworkData::CloseServer(ServerID1)
                NetworkData::CloseServer(ServerID2)
                NetworkData::CloseServer(ServerID3)
                Delay(500)
                exit = #True
                
              CompilerEndIf
              
            Case #MenuExit
              NetworkData::CloseServer(ServerID1)
              NetworkData::CloseServer(ServerID2)
              NetworkData::CloseServer(ServerID3)
              Delay(500)
              exit = #True
              
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
              
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              UpdateWindow()
              
          EndSelect
          
        Case #PB_Event_Timer
          StatusBarText(#Status, 0, FormatDate("%HH:%II:%SS" , Date()))
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              NetworkData::CloseServer(ServerID1)
              NetworkData::CloseServer(ServerID2)
              NetworkData::CloseServer(ServerID3)
              Delay(500)
              exit = #True
              
          EndSelect
          
      EndSelect
      
    Until exit
    
  EndIf
  
EndProcedure : Main()

End
Client

Code: Alles auswählen

;-TOP
; NetworkData Client Example v1.11

IncludeFile "Modul_NetworkData.pb"

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuSend1
  #MenuSend2
  #MenuSend3
  #MenuSend4
  #MenuExit
EndEnumeration

Enumeration ; Gadgets
  #List
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

Procedure.s Chars(Lenght, Char.s)
  Protected result.s
  result = Space(Lenght)
  ReplaceString(result, " ", Char, #PB_String_InPlace)
  ProcedureReturn result
EndProcedure

; Global Variable
Global exit

Global text.s
Global *RawData.NetworkData::udtAny
Global NewList Text.s()

Global *RawData = AllocateMemory(300000)
RandomSeed(123)
RandomData(*RawData, 300000)
PokeQ(*RawData + 4, 0)

Global *AESData24 = AllocateMemory(24)
RandomSeed(100)
RandomData(*AESData24, 24)

; Functions

Procedure NewData(SEvent, ConnectionID, *NewData.NetworkData::udtDataset)
  
  UseModule NetworkData
  
  If SEvent = #PB_NetworkEvent_Disconnect
    Logging("Callback: Server disconnected: ID " + Hex(ConnectionID))
    exit = 1
    ProcedureReturn 0
  EndIf
  
  With *NewData
    Logging("Callback: New data from ConnectionID " + Hex(ConnectionID) + ": DataID " + Str(\DataID))
    Select \Type
      Case #NetInteger
        Logging("Callback Integr: " + Str(\Integer))
        
      Case #NetString
        Logging("Callback String: " + \String)
        
      Case #NetData
        Debug "Data"
         
    EndSelect
    
  EndWith
  
  ProcedureReturn #NetResultFreeData
  
  UnuseModule NetworkData

EndProcedure

Structure udtData
  ConnectionID.i
  Filename.s
EndStructure

Procedure thSendFile(*thData.udtData)
  Static DataID = 500
  DataID + 1
  If DataID >= 600
    DataID = 501
  EndIf
  With *thData
    NetworkData::SendString(\ConnectionID, DataID, GetFilePart(\filename))
    NetworkData::SendFile(\ConnectionID, DataID, \filename)
  EndWith
EndProcedure

Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#List, x, y, dx, dy)
  
EndProcedure

; Main
Procedure Main()
  
  Protected event, style, ConnectionID, timer, filename.s, SendFileData.udtData, size
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 600
  dy = 400
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Client", style)
    
    ; Menu
    CreateMenu(#Menu, WindowID(#Main))
    MenuTitle("Common")
    MenuItem(#MenuSend1, "Send Text")
    MenuItem(#MenuSend2, "Send Data")
    MenuItem(#MenuSend3, "Send List")
    MenuItem(#MenuSend4, "Send File")
    MenuBar()
    MenuItem(#MenuExit, "E&xit")
    ; Gadgets
    ListViewGadget(#List, 0, 0, dx, dy)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    UpdateWindow()
    
    NetworkData::BindLogging(#PB_Event_FirstCustomValue, #List)
    ConnectionID = NetworkData::InitClient("127.0.0.1", 6037, @NewData())
    ;ConnectionID = NetworkData::InitClient("MICHAELS-MINI", 6037, @NewData())
    ;ConnectionID = NetworkData::InitClient("192.168.170.25", 6037, @NewData())
    If Not ConnectionID
      Debug "Server not Found"
      End
    EndIf
    
    NetworkData::SetAESData(*AESData24)
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent(10)
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
              CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                NetworkData::CloseClient(ConnectionID)
                exit = #True
                
              CompilerEndIf
              
            Case #MenuExit
              NetworkData::CloseClient(ConnectionID)
              exit = #True
              
            Case #MenuSend1
              NetworkData::Logging("Main: Send DataID 101")
              text = "String: " + " (" + Chars(Random(50, 1), "x") + ")"
              NetworkData::SendString(ConnectionID, 101, text)
              NetworkData::SendInteger(ConnectionID, 101, Len(text))
              
            Case #MenuSend2
              size = Random(300000, 100000)
              NetworkData::Logging("Main: Send DataID 102")
              NetworkData::SendData(ConnectionID, 102, *RawData, size)
              NetworkData::SendInteger(ConnectionID, 102, size)
              
            Case #MenuSend3
              NetworkData::Logging("Main: Send DataID 103")
              ClearList(Text())
              AddElement(Text())
              Text() = ""
              count =  Random(100, 10)
              For i = 1 To count
                AddElement(Text())
                Text() = "Text: Nummer " + Str(i) + " (" + Chars(Random(10000), "x") + ")"
              Next
              NetworkData::SendList(ConnectionID, 103, Text())
              NetworkData::SendInteger(ConnectionID, 103, ListSize(Text()))
              
            Case #MenuSend4
              filename = OpenFileRequester("Send File", "", "", 0)
              If Bool(filename)
                NetworkData::Logging("Main: Send DataID Files")
                SendFileData\ConnectionID = ConnectionID
                SendFileData\Filename = filename
                CreateThread(@thSendFile(), SendFileData)
              EndIf
              
          EndSelect
          
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              UpdateWindow()
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              NetworkData::CloseClient(ConnectionID)
              exit = #True
          EndSelect
          
      EndSelect
      
    Until exit
    
  EndIf
  
EndProcedure : Main()
Zuletzt geändert von mk-soft am 28.02.2019 21:35, insgesamt 3-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von mk-soft »

Update v1.07
- Geändert: LockSend optimiert für Senden von Daten über Threads
- Geändert: Internal Dataset

Beispiel von Daten Senden über Threads (Leistungstest)

Code: Alles auswählen

;-TOP
; NetworkData Client Example Threaded Send v1.07

IncludeFile "Modul_NetworkData.pb"

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuSend1
  #MenuSend2
  #MenuSend3
  #MenuExit
EndEnumeration

Enumeration ; Gadgets
  #List
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

Procedure.s Chars(Lenght, Char.s)
  Protected result.s
  result = Space(Lenght)
  ReplaceString(result, " ", Char, #PB_String_InPlace)
  ProcedureReturn result
EndProcedure

; Global Variable
Global exit

Global text.s
Global NewList Text.s()

; Functions

Procedure NewData(SEvent, ConnectionID, *NewData.NetworkData::udtDataset)
  
  UseModule NetworkData
  
  If SEvent = #PB_NetworkEvent_Disconnect
    Logging("Callback: Server disconnected: ID " + Str(ConnectionID))
    exit = 1
    ProcedureReturn 0
  EndIf
  
  With *NewData
    Logging("Callback: New data from ConnectionID " + Str(ConnectionID) + ": DataID " + Str(\DataID))
    Select \Type
      Case #NetInteger
        Logging("Callback: Result = " + Str(\Integer))
        
      Case #NetString
        Logging("Callback: Result = " + \String)
        
      Case #NetData
        Debug "Data"
         
    EndSelect
    
  EndWith
  
  ProcedureReturn 0
  
  UnuseModule NetworkData

EndProcedure

Procedure thSendString(ConnectionID)
  
  UseModule NetworkData
  
  Protected count, len, text.s
  
  For count = 1 To 100
    Delay(300)
    len = Random(100000, 1000)
    text = "Data " + Chars(len, "x")
    SendString(ConnectionID, 201, text)
  Next
  UnuseModule NetworkData
  
EndProcedure

Procedure thSendData(ConnectionID)
  
  UseModule NetworkData
  
  Protected count, len, text.s
  Protected *data
  
  *data = AllocateMemory(100000)
  For count = 1 To 100
    Delay(200)
    len = Random(100000, 1000)
    SendData(ConnectionID, 202, *data, len)
  Next
  UnuseModule NetworkData
  
EndProcedure



Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#List, x, y, dx, dy)
  
EndProcedure

; Main
Procedure Main()
  
  Protected event, style, ConnectionID, timer, th1, th2
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 600
  dy = 400
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Client", style)
    
    ; Enable Fullscreen
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      Protected NewCollectionBehaviour
      NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
      CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
    CompilerEndIf
    
    ; Menu
    CreateMenu(#Menu, WindowID(#Main))
    MenuTitle("Common")
    MenuItem(#MenuSend1, "Send Text")
    MenuItem(#MenuSend2, "Send Data")
    MenuItem(#MenuSend3, "Send List")
    MenuBar()
    MenuItem(#MenuExit, "E&xit")
    ; Gadgets
    ListViewGadget(#List, 0, 0, dx, dy)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    UpdateWindow()
    
    NetworkData::BindLogging(#PB_Event_FirstCustomValue, #List)
    ConnectionID = NetworkData::InitClient("127.0.0.1", 6037, @NewData())
    ;ConnectionID = NetworkData::InitClient("Michaels-Mac", 6037, @NewData())
    If Not ConnectionID
      Debug "Server not Found"
      End
    EndIf
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent(10)
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
              CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                NetworkData::CloseClient(ConnectionID)
                exit = #True
                
              CompilerEndIf
              
            Case #MenuExit
              NetworkData::CloseClient(ConnectionID)
              exit = #True
              
            Case #MenuSend1
              If Not IsThread(th1)
                th1 = CreateThread(@thSendString(), ConnectionID)
              EndIf
              
            Case #MenuSend2
              If Not IsThread(th2)
                th2 = CreateThread(@thSendData(), ConnectionID)
              EndIf
              
            Case #MenuSend3
              ClearList(Text())
              count =  10 ;Random(10, 1)
              For i = 1 To count
                AddElement(Text())
                Text() = "Text: Nummer " + Str(i) + " (" + Chars(Random(100000), "x") + ")"
              Next
              NetworkData::SendList(ConnectionID, 203, Text())
              
          EndSelect
          
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              UpdateWindow()
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              NetworkData::CloseClient(ConnectionID)
              exit = #True
          EndSelect
          
      EndSelect
      
    Until exit
    
  EndIf
  
EndProcedure : Main()

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

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von mk-soft »

Update v1.10
- SendFile(...) hinzugefügt

link: http://www.purebasic.fr/english/viewtop ... 12&t=66075
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von Sicro »

Ist es Absicht, dass du kein paralleles Senden per Threads zu unterschiedlichen Clients unterstützt?
Bei meinem Modul habe ich diesbezüglich noch keine Probleme festgestellt.

Obwohl sich unsere Codes sehr ähneln, nehme ich dein Modul auch ins CodeArchiv auf.
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von mk-soft »

Es gibt bei mir auch keine Probleme Daten über Threads zu Senden. Dazu müssen nur die Daten an eine Thread übergeben werden und in diesen dann die Daten gesendet werden.
Werde mal die Funktionen zum asynchronen Senden von Daten erweitern. Vielleicht mit optimalen Parameter (Wait=#True)
:wink:

P.S. Im Client Beispiel sende ich die Datei aus einem Thread heraus.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von Sicro »

mk-soft hat geschrieben:Es gibt bei mir auch keine Probleme Daten über Threads zu Senden.
Ja, das ist mir klar, sonst wäre dein Mutex ja nutzlos.
mk-soft hat geschrieben:Werde mal die Funktionen zum asynchronen Senden von Daten erweitern.
Genau das meinte ich. Ich dachte, du hast es aus irgendwelchen Gründen nicht unterstützt.
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module NetworkData - Strings und Daten über 64kb

Beitrag von mk-soft »

Update v1.15
- Hingefügt: SetAESData(...). Daten verschlüsselt senden.
- Hingefügt: SetUserData(...) und GetUserData(...) für jede Connection.

Hinweis UserData!
Der Zugriff auf die UserData der ist nur innerhalb von der NewDataCallback möglich, da jeder Server oder Client seine eigene Umgebung hat (Threaded).
Wenn ein *Pointer auf eigene Daten verwendet werden, kann (muss) man diesen bei den Event #PB_NetworkEvent_Disconnect wieder freigeben.

Wo für UserData?
In dieser kann man zum Beispiel hinterlegen ob für die Verbindung eine Anmeldung durchgeführt wurde.
:wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten