PureBasic Forums - English

Code: Select all

;-TOP by mk-soft, v1.01.0, 10.02.2025

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  CompilerIf #PB_Compiler_Backend <> #PB_Backend_C
    CompilerError "Linux only with C-Backend!"
  CompilerEndIf
CompilerEndIf

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  Macro GetLastError()
    GetLastError_()
  EndMacro
CompilerElse
  CompilerIf #PB_Compiler_Backend = #PB_Backend_C
    Procedure GetLastError()
      !#include "errno.h"
      !extern int errno;
      Protected r1
      !v_r1=errno;
      ProcedureReturn r1
    EndProcedure
  CompilerElse
    ImportC ""
      errno
    EndImport
    ;!extrn errno;
    Procedure GetLastError()
      Protected r1
      r1 = errno
      ProcedureReturn r1
    EndProcedure
  CompilerEndIf
CompilerEndIf

Procedure.s GetErrorString(ErrorCode)
  Protected r1.s, *buffer, len
  
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM|#FORMAT_MESSAGE_IGNORE_INSERTS, 0, ErrorCode, 0, @*buffer,0,0) 
      If len 
        r1 = PeekS(*buffer)
        LocalFree_(*buffer)
      EndIf
    CompilerDefault
      *buffer = strerror_(ErrorCode)
      r1 = PeekS(*buffer, -1, #PB_UTF8)
  CompilerEndSelect
  ProcedureReturn r1
EndProcedure
;


CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_MacOS
    
    #IPPROTO_IP   = 0
    #IP_TOS       = 3
    #IPPROTO_IPV6 = 41
    #IPV6_TCLASS  = 36
    
    Macro sock_errno()
      GetLastError()
    EndMacro
    
  CompilerCase #PB_OS_Linux
    
    #IPPROTO_IP   = 0
    #IP_TOS       = 1
    #IPPROTO_IPV6 = 41
    #IPV6_TCLASS  = 67
    
    Macro sock_errno()
      GetLastError()
    EndMacro
  CompilerCase #PB_OS_Windows
    
    #IPPROTO_IP   = 0
    #IP_TOS       = 3
    #IPPROTO_IPV6 = 41
    #IPV6_TCLASS  = 39
    
    ImportC ""
      Macro sock_errno()
        WSAGetLastError_()
      EndMacro
    EndImport
CompilerEndSelect

Procedure set_dscp(fd, dscp.a, flag = #PB_Network_IPv4)
  Protected r1
  
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_MacOS
      Protected value.l
      Protected value6.l
    CompilerCase #PB_OS_Linux
      Protected value.l
      Protected value6.l
    CompilerCase #PB_OS_Windows
      Protected value.i
      Protected value6.i
  CompilerEndSelect
  
  If dscp > 63
    ProcedureReturn -1
  EndIf
  
  If flag = #PB_Network_IPv4
    value = dscp << 2
    If setsockopt_(fd, #IPPROTO_IP, #IP_TOS, @value, SizeOf(value))
      ProcedureReturn sock_errno()
    EndIf
  ElseIf flag = #PB_Network_IPv6  
    value6 = dscp << 2
    If setsockopt_(fd, #IPPROTO_IPV6, #IPV6_TCLASS, @value6, SizeOf(value6))
      ProcedureReturn sock_errno()
    EndIf
  EndIf
  ProcedureReturn 0
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
  runServer = 1
  
  If runServer
    *buffer = AllocateMemory(4096)
    server = CreateNetworkServer(1, 9000, #PB_Network_IPv4)
    If server
      Debug "Server running ..."
      r1 = set_dscp(ServerID(1), 46, #PB_Network_IPv4)
      If r1 
        Debug "set dscp: " + GetErrorString(r1)
      Else
        Debug "set dscp: ok"
      EndIf
      
      Repeat
        Select NetworkServerEvent()
          Case #PB_NetworkEvent_Connect
            ;
            
          Case #PB_NetworkEvent_Data
            client = EventClient()
            ReceiveNetworkData(client, *Buffer, 4096)
            recv.s = PeekS(*Buffer, -1, #PB_UTF8)
            Debug "String: " + recv
            SendNetworkString(client, "Ok")
            If recv = "exit"
              CloseNetworkConnection(client)
              Break
            EndIf
          Case #PB_NetworkEvent_Disconnect
            ;
            
          Case #PB_NetworkEvent_None
            Delay(10)
            
        EndSelect
      ForEver
      
      CloseNetworkServer(1)
      
    Else
      Debug "Error to create server. Start as client ..."
    EndIf
    
  Else
    *buffer = AllocateMemory(4096)
    servername.s = "vm-win10pro"
    ;servername.s = "192.168.178.65"
    ConnectionID = OpenNetworkConnection(servername, 9000)
    If ConnectionID
      Debug "Connect to server ..."
      
      r1 = set_dscp(ConnectionID(ConnectionID), 46, #PB_Network_IPv4)
      If r1 
        Debug "set dscp: " + GetErrorString(r1)
      Else
        Debug "set dscp: ok"
      EndIf
      
      Repeat
        Select NetworkClientEvent(ConnectionID)
          Case #PB_NetworkEvent_Data
            len = ReceiveNetworkData(ConnectionID, *Buffer, 4096)
            recv.s = PeekS(*Buffer, len, #PB_UTF8)
            Debug "String: " + recv
            send.s = ""
            
          Case #PB_NetworkEvent_Disconnect
            ;
            Debug "Close connection from server"
            Break
            
          Case #PB_NetworkEvent_None
            Delay(10)
            If send = ""
              send.s = InputRequester("Send", "String:", "")
              If send
                SendNetworkString(ConnectionID, send + #Null$)
              Else
                CloseNetworkConnection(ConnectionID)
                Break
              EndIf
            EndIf
            
        EndSelect
      ForEver
      
    Else
      Debug "Error to connect server"
    EndIf
    
  EndIf

CompilerEndIf

Code: Select all

server = CreateNetworkServer(1, 9000, #PB_Network_TCP | #PB_Network_IPv4)