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
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