UDP Local Network Short Text Sending (All OS)

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

After a request here now the cleaned version to send short string between programs over UDP.

The strings are sent with STX and ETX to ensure that the string is complete. The string is passed to the program via PostEvent. For this the string must be fetched with the function FreeString, so that the memory is released.

The resources are automatically cleaned up after 5 minutes so that it does not lead to a memory leak.

Each program gets its own port. e.g. Port 2001, 2002, etc.

Update v1.02
- Added InitUdpServer(...)
- Added SendStringEx(...) for sending string over LAN
- Added ClearConnection() for release all SendString resources (Threaded)

Update v1.03
- Small Bugfix: Clear Client Map

Update v1.04
- Small optimizations

Update v1.05
- Bugfix PeekS

Update v1.07
- New Function SendTo for Server / Server Communication

File UdpServer.pb

Code: Select all

;-TOP

; Comment : UDP Local Network Short Text Sending
; Author  : mk-soft
; Version : v1.07.0
; Link    : https://www.purebasic.fr/english/viewtopic.php?t=74200

CompilerIf #PB_Compiler_Thread = 0
  CompilerError "Use Compileroption Threadsafe!"
CompilerEndIf

EnableExplicit

; *************************************************
; Comment : Network SendTo for UDP Server (All OS)
; Author  : mk-soft
; Version : v1.01.1
; Create  : 30.12.2022
; Update  : 
; Link    : https://www.purebasic.fr/english/viewtopic.php?t=80367

; Description
;   Socket = ServerID(Server)

CompilerIf Not Defined(AF_INET, #PB_Constant)
  #AF_INET = 2
CompilerEndIf

CompilerIf Not Defined(SOCKADDR_IN, #PB_Structure)
  Structure SOCKADDR_IN
    sin_family.w
    sin_port.w
    sin_addr.l
    sin_zero.b[8]
  EndStructure
CompilerEndIf

Procedure SendNetworkStringTo(Socket, IP.s, Port, Text.s, Format = #PB_UTF8)
  Protected r1, *ip, *sendbuf, lenbuf, RecvAddr.sockaddr_in
  
  Select Format
    Case #PB_Ascii
      *sendbuf = Ascii(Text)
      lenbuf = StringByteLength(Text, #PB_Ascii)
    Case #PB_UTF8
      *sendbuf = UTF8(Text)
      lenbuf = StringByteLength(Text, #PB_UTF8)
    Case #PB_Unicode
      *sendbuf = @Text
      lenbuf = Len(Text)
  EndSelect
  *ip = Ascii(IP)
  RecvAddr\sin_family = #AF_INET
  RecvAddr\sin_port = htons_(port)
  RecvAddr\sin_addr = inet_addr_(*ip)
  r1 = sendto_(socket, *sendbuf, lenbuf, 0, RecvAddr, SizeOf(sockaddr_in))
  If *sendbuf
    FreeMemory(*sendbuf)
  EndIf
  FreeMemory(*ip)
  ProcedureReturn r1
EndProcedure
    
Procedure SendNetworkDataTo(Socket, IP.s, Port, *Buffer, Size)
  Protected r1, *ip, RecvAddr.sockaddr_in
  
  *ip = Ascii(IP)
  RecvAddr\sin_family = #AF_INET
  RecvAddr\sin_port = htons_(port)
  RecvAddr\sin_addr = inet_addr_(*ip)
  r1 = sendto_(socket, *Buffer, Size, 0, RecvAddr, SizeOf(sockaddr_in))
  FreeMemory(*ip)
  ProcedureReturn r1
EndProcedure
    
; *************************************************

;-- MacOS NapStop

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  ; Author : Danilo
  ; Date   : 25.03.2014
  ; Link   : https://www.purebasic.fr/english/viewtopic.php?f=19&t=58828
  ; Info   : NSActivityOptions is a 64bit typedef - use it with quads (.q) !!!
  
  #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

; ----

Enumeration CustomEvent #PB_Event_FirstCustomValue
  #MyEvent_ServerMessage_Connect    ; Only TCP
  #MyEvent_ServerMessage_Data       ; UDP and TCP
  #MyEvent_ServerMessage_Disconnect ; Only TCP
  #MyEvent_ServerMessage_Error
EndEnumeration

Structure udtClient
  Connection.i
  Time.i
  Text.s
EndStructure

Structure udtServer
  *ThreadID
  *ServerID
  *Socket
  Mutex.i
  BindIP.s
  Port.i
  Error.i
  Exit.i
  Map Client.udtClient()
EndStructure

; ----

CompilerIf #PB_Compiler_Version < 600
 InitNetwork()
CompilerEndIf

; ----

Procedure AllocateString(Text.s)
  Protected *mem.String
  *mem = AllocateStructure(String)
  *mem\s = Text
  ProcedureReturn *mem
EndProcedure

Procedure.s FreeString(*Text.String)
  Protected result.s
  If *Text
    result = *text\s
    FreeStructure(*Text)
  EndIf
  ProcedureReturn result
EndProcedure

; ----

Procedure thUdpServer(*ServerData.udtServer)
  Protected client, *buffer, cnt, *text, stx, etx, len, time, lock
  
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    Protected StopNap = BeginWork(#NSActivityLatencyCritical | #NSActivityUserInitiated, Hex(*ServerData))
  CompilerEndIf
  
  
  With *ServerData
    *Buffer = AllocateMemory(2048)
    Repeat
      If Not lock
        LockMutex(\Mutex) : lock = #True
      EndIf
      Select NetworkServerEvent()
        Case #PB_NetworkEvent_Connect ; Only TCP
          PostEvent(#MyEvent_ServerMessage_Connect, 0, 0, 0, EventClient())
          
        Case #PB_NetworkEvent_Data ; TCP and UDP
          client = EventClient()
          If Not FindMapElement(\Client(), Str(client))
            AddMapElement(\Client(), Str(client))
            \Client()\Connection = client
          EndIf
          cnt = ReceiveNetworkData(client, *buffer, 2048)
          If cnt > 0
            \Client()\Text + PeekS(*buffer, cnt, #PB_UTF8 | #PB_ByteLength)
            \Client()\Time = ElapsedMilliseconds()
            stx = FindString(\Client()\Text, #STX$)
            If stx
              etx = FindString(\Client()\Text, #ETX$, stx)
              If etx
                stx + 1
                len = etx - stx
                *text = AllocateString("Port " + GetClientPort(\Client()\Connection) + ": " + Mid(\Client()\Text, stx, len))
                \Client()\Text = Mid(\Client()\Text, etx + 1)
                PostEvent(#MyEvent_ServerMessage_Data, 0, client, 0, *text)
              EndIf
            EndIf
          ElseIf cnt < 0
            \Error = 3
            PostEvent(#MyEvent_ServerMessage_Error, 0, 0, 0, 3)
          EndIf
          
        Case #PB_NetworkEvent_Disconnect ; Only TCP
          PostEvent(#MyEvent_ServerMessage_Disconnect, 0, 0, 0, EventClient())
          
        Case #PB_NetworkEvent_None
          ; Clear resources
          time = ElapsedMilliseconds()
          ForEach \Client()
            If (time - \Client()\Time) >= 300000 ; 5 Minutes
              CloseNetworkConnection(\Client()\Connection)
              DeleteMapElement(\Client())
            EndIf
          Next
          UnlockMutex(\Mutex) : lock = #False
          Delay(10)
          
      EndSelect
      
    Until \Exit
    
    
    If Not lock
      LockMutex(\Mutex)
    EndIf
    
    CloseNetworkServer(\ServerID)
    FreeMemory(*buffer)
    \ServerID = 0
    \Socket = 0
    \Exit = 0
    ClearMap(\Client())
    
    UnlockMutex(\Mutex)
    FreeMutex(\Mutex)
    \Mutex = 0
    
  EndWith
  
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    EndWork(StopNap)
  CompilerEndIf
    
EndProcedure

; ----

Procedure InitUdpServer(*ServerData.udtServer, Port, BindIP.s = "")
  
  With *ServerData
    \BindIP = BindIP
    \Port = Port
    \Error = 0
    \Exit = 0
    \ServerID = CreateNetworkServer(#PB_Any, \Port, #PB_Network_UDP, \BindIP)
    If Not \ServerID
      \Error = 1
      ProcedureReturn 0
    EndIf
    \ThreadID = CreateThread(@thUdpServer(), *ServerData)
    If Not \ThreadID
      CloseNetworkServer(\ServerID)
      \ServerID = 0
      \Error = 2
      ProcedureReturn 0
    EndIf
    \Socket = ServerID(\ServerID)
    \Mutex = CreateMutex()
    ProcedureReturn 1
  EndWith
EndProcedure

; ----

Procedure SendString(*Server.udtServer, Port, Text.s)
  Protected r1, IP
  
  With *Server
    If StringByteLength(Text, #PB_UTF8) > 2046
      ProcedureReturn 0
    EndIf
    LockMutex(\Mutex)
    r1 = SendNetworkStringTo(\Socket, "127.0.0.1", Port, #STX$ + Text + #ETX$)
    UnlockMutex(\Mutex)
  EndWith
  ProcedureReturn r1
EndProcedure

; ----

Procedure SendStringIP(*Server.udtServer, IP.s, Port, Text.s)
  Protected r1
  
  With *Server
    If StringByteLength(Text, #PB_UTF8) > 2046
      ProcedureReturn 0
    EndIf
    LockMutex(\Mutex)
    r1 = SendNetworkStringTo(\Socket, IP, Port, #STX$ + Text + #ETX$)
    UnlockMutex(\Mutex)
  EndWith
  ProcedureReturn r1
EndProcedure
Example v1.07
Start twice programs with different local ports...

Code: Select all

;-Example Window

IncludeFile "UdpServer.pb"

; Constant
Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuSendText
  #MenuSendTextList
  #MenuExitApplication
EndEnumeration

Enumeration ; Gadgets
  #List
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

; Global Variable
Global ExitApplication

Global Server.udtServer

Global LocalPort = 2001
Global RemotePort = 2002

; Functions
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 AddInfo(Text.s)
  Protected cnt
  Text = FormatDate("%HH:%II:%SS / ", Date()) + Text
  AddGadgetItem(#List, -1, Text)
  cnt = CountGadgetItems(#List)
  If cnt > 1000
    RemoveGadgetItem(#List, 0)
    cnt - 1
  EndIf
  SetGadgetState(#List, cnt - 1)
  SetGadgetState(#List, -1)
EndProcedure

; Main
Procedure Main()
  
  Protected event, style, dx, dy, text.s, i
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 800
  dy = 600
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main Server 1", style)
    
    ; Menu
    CreateMenu(#Menu, WindowID(#Main))
    MenuTitle("Ablage")
    MenuItem(#MenuSendText, "Send &Text")
    MenuItem(#MenuSendTextList, "Send Text&list")
    MenuBar()
    MenuItem(#MenuExitApplication, "Be&enden")
    ; Gadgets
    ListViewGadget(#List, 0, 0, dx, dy)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    UpdateWindow()
    
    BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), #Main)
    
    ; Init Server
    If Not InitUdpServer(@Server, LocalPort)
      Debug "Error Init Server"
      End
    EndIf
    
    ; Init Window Timer
    AddWindowTimer(#Main, 1, 5000)
    
    ; 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
                ExitApplication = #True
                
              CompilerEndIf
              
            Case #MenuExitApplication
              ExitApplication = #True
              
            Case #MenuSendText
              text = InputRequester("", "", "")
              If text
                SendStringIP(Server, "127.0.0.1", RemotePort, Text)
              EndIf
              
            Case #MenuSendTextList
              For i = 1 To 200
                SendString(Server, RemotePort, "SendText Number " + Str(i))
              Next
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
              If EventType() = #PB_EventType_LeftDoubleClick
                text = InputRequester("", "", "")
                If text
                  SendString(Server, RemotePort, Text)
                EndIf
              EndIf
              
          EndSelect
          
        Case #PB_Event_Timer
          SendString(Server, RemotePort, "LifeTrigger")
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              ExitApplication = #True
              
          EndSelect
          
        Case #MyEvent_ServerMessage_Connect ; Only TCP
          AddInfo("Connect: " + EventData())
          
        Case #MyEvent_ServerMessage_Data ; UDP and TCP
          AddInfo("Data: " + FreeString(EventData()))
          
        Case #MyEvent_ServerMessage_Disconnect ; Only TCP
          AddInfo("Disconnect: " + EventData())
          
        Case #MyEvent_ServerMessage_Error
          AddInfo("Error: Code" + EventData())
          
      EndSelect
      
    Until ExitApplication
    
    If Server\ThreadID
      Server\Exit = #True
      If WaitThread(Server\ThreadID, 5000) = 0
        KillThread(Server\ThreadID)
      EndIf
    EndIf
    
  EndIf
  
EndProcedure : Main()

End
Last edited by mk-soft on Fri Dec 30, 2022 8:08 pm, edited 9 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

Update Example with send many strings... :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

Update v1.02

Strings can now also be sent to other computers in the network. Use the function SendStringEx(...).
To simplify starting the server the function InitUdpServer(...) has been added.

:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: UDP Local Network Short Text Sending (All OS)

Post by Kwai chang caine »

Hello Mk-Soft :D

Very interesting subject for me, i have see several methods for communicate between exe, but never this :shock:

But i have test your nice code, the second application appears one second and disappears and have this in the debugger
Error Init Server
I'm with W10 X64 / v5.70 LTS X86
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

You have not changed the ports for the second program, or the port is already occupied.

Prog1

Code: Select all

Global LocalPort = 2001
Global RemotePort = 2002
Prog2

Code: Select all

Global LocalPort = 2002
Global RemotePort = 2001
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

Optimisation
If you do not want to use the Map UdpConnection, you can also use optimized SendNetWorkString.

PB-Help: With UDP, PB is created internally only one entry, so you can send with the network functions

1: Init Connection

Code: Select all

sender = OpenNetworkConnection("127.0.0.1", RemotePort, #PB_Network_UDP)
2: Send String

Code: Select all

SendNetworkString(sender, #STX$ + "LifeTrigger" + #ETX$, #PB_UTF8)
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: UDP Local Network Short Text Sending (All OS)

Post by Kwai chang caine »

MkSoft wrote:You have not changed the ports for the second program, or the port is already occupied.
You have right, what a donkey i am :oops:
That's works now perfectly, thanks a lot for this sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

Update v1.04
- Small optimizations

:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: UDP Local Network Short Text Sending (All OS)

Post by Kwai chang caine »

Thanks...works always also well 8)
ImageThe happiness is a road...
Not a destination
infratec
Always Here
Always Here
Posts: 6869
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by infratec »

You are missing a flag

Code: Select all

\Client()\Text + PeekS(*buffer, cnt, #PB_UTF8)
Should be

Code: Select all

\Client()\Text + PeekS(*buffer, cnt, #PB_UTF8|#PB_ByteLength)
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

Update v1.05
- Bugfix PeekS

Thanks Infratec
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
kinglestat
Enthusiast
Enthusiast
Posts: 732
Joined: Fri Jul 14, 2006 8:53 pm
Location: Malta
Contact:

Re: UDP Local Network Short Text Sending (All OS)

Post by kinglestat »

This looks quite nice
Thank you
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net
AZJIO
Addict
Addict
Posts: 1360
Joined: Sun May 14, 2017 1:48 am

Re: UDP Local Network Short Text Sending (All OS)

Post by AZJIO »

mk-soft
If computers are different than whether to change the code. I already tried to transfer from a computer to another computer, I liked it. I want to transmit files. I read that the size of the package is 1500 bytes and the package number must be transmitted to control the correct package gluing.
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: UDP Local Network Short Text Sending (All OS)

Post by mk-soft »

This is only for short data over udp

Show Module NetworkData or Module NetworkTCP
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
skinkairewalker
Enthusiast
Enthusiast
Posts: 635
Joined: Fri Dec 04, 2015 9:26 pm

Re: UDP Local Network Short Text Sending (All OS)

Post by skinkairewalker »

using this client code below, does the udp server isolate each connection?

Code: Select all

Port = 2001

ConnectionID = OpenNetworkConnection("127.0.0.1", Port,#PB_Network_UDP)
If ConnectionID
  OpenConsole("demo udp server")
  Repeat
    SendNetworkString(ConnectionID, #STX$ + "LifeTrigger" + #ETX$, #PB_UTF8)
    Delay(10)
  ForEver
  CloseNetworkConnection(ConnectionID)
Else
  MessageRequester("PureBasic - Client", "Can't find the server (Is it launched ?).", 0)
EndIf
  
End
Post Reply