+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: a little TCP/IP network in LocalHost (/showthread.php?tid=3101)
a little TCP/IP network in LocalHost - TempodiBasic - 10-06-2024
Hi QB64 friends...
here it follows a my new TCP/IP experience creating a little network with 3 clients and 1 host server.
The same pocedure is for a network behind the home LAN.... you must use Host on a server PC connected to outside via TCP/IP and a pc for each Client program connected via TCP/IP to outside line.... the only difference is the URL used for creating connections!
Here the codes for Host and LClient1, Lclient2 and Lclient3 in the same PC
Host
Code: (Select All)
Rem Project to simulate a server with multiple clients TCP/IP
Rem the first program is the server side of the network
Screen _NewImage(800, 640, 32)
Cls , _RGBA32(250, 100, 200, 255)
_ScreenMove 10, 10
_PrintString (10, 200), "testing if SERVER is already ON"
Dim Server As Long
Server = _OpenClient("TCP/IP:7319:localhost")
If Server Then Msg$ = "Server Host already ON" Else Msg$ = "Server Host OFF, activating Server Host..."
_PrintString (10, 230), Msg$ + Space$(6)
If Server = 0 Then
Server = _OpenHost("TCP/IP:7319 ")
If Server = 0 Then Msg$ = "Failed to activate server Host. Host is OFF" Else Msg$ = " Activated Server Host. Host is ON"
_PrintString (10, 300), Msg$
End If
Rem here Host runs Client apps
Shell _DontWait "LClient1.exe"
Shell _DontWait "LClient2.exe"
Shell _DontWait "LClient3.exe"
Rem here Host searches connections with clients and if activated it reads data
Dim Cli(1 To 3) As Long, n As Integer, Comd As String
Do
n = n + 1
If n = 4 Then n = 1
If Cli(n) = 0 Then Cli(n) = _OpenConnection(Server) ' Is cli(n) connected?
Comd = "" ' it deletes previous command read by client
If Cli(n) <> 0 Then
If Not EOF(Cli(n)) Then Get #Cli(n), , Comd ' has Cli(n) sent data?
End If
' data executor
Select Case Comd
Case " ":
_PrintString (10, 100), "Client" + Str$(n) + " quits" + Space$(6)
Close
' it quits
Case "c", "C":
Cls , _RGBA32((Rnd * (255)) + 1, (Rnd * (255)) + 1, (Rnd * (255)) + 1, 255)
_PrintString (10, 100), "Client" + Str$(n) + " changes color" + Space$(6)
' it changes color
Case "s", "S":
Play "cdc"
_PrintString (10, 100), "Client" + Str$(n) + " makes sound" + Space$(6)
' it sounds some notes
End Select
_PrintString (10, 300), " Press space key to quit" + Space$(16)
Loop Until InKey$ = " " Or Comd = " " ' press space to quit
Close
End
Lclient1
Code: (Select All)
Rem Project to simulate a server with multiple clients TCP/IP
Rem the second program is the first client side of the network
Screen _NewImage(800, 640, 32)
Cls , _RGBA32(128, 200, 200, 255)
_ScreenMove 400, 100
_PrintString (10, 200), "testing if CLIENT is already ON"
Dim Server As Long
Server = _OpenClient("TCP/IP:7319:localhost")
If Server Then Msg$ = "Client is ON" Else Msg$ = "Cannot activate Client..."
_PrintString (10, 230), Msg$
If Server = 0 Then
Server = _OpenClient("TCP/IP:7319:localhost") ' it tries a second time the connection with Host
If Server = 0 Then Msg$ = "Failed to activate server Client. Client is OFF" Else Msg$ = " Activated Server Client. Client is ON"
_PrintString (10, 300), Msg$
If Server = 0 Then End
End If
Rem here Client waits user input and sends this to Host
Dim Comd As String
Do
_Delay 1
Cls , _RGBA32(128, 200, 200, 255)
_PrintString (10, 100), "Client is ON, press c/C to change color, s/S to sound notes and space key to quit"
Comd = "" ' it deletes previous command read by client
Comd = InKey$
If Comd <> "" Then Put #Server, , Comd ' has Cli(n) sent data?
' data executor
Select Case Comd
Case " ":
_PrintString (10, 200), " > Quitting command sent"
' it quits
Case "c", "C":
_PrintString (10, 200), " > Changing color command sent" ' it changes color
Case "s", "S":
_PrintString (10, 200), " > Playing sound command sent" ' it sounds some notes
End Select
Loop Until InKey$ = " " Or Comd = " " ' press space to quit
Close
End
Lclient2
Code: (Select All)
Rem Project to simulate a server with multiple clients TCP/IP
Rem the second program is the first client side of the network
Screen _NewImage(800, 640, 32)
Cls , _RGBA32(33, 72, 200, 255)
_ScreenMove 600, 100
_PrintString (10, 200), "testing if CLIENT is already ON"
Dim Server As Long
Server = _OpenClient("TCP/IP:7319:localhost")
If Server Then Msg$ = "Client is ON" Else Msg$ = "Cannot activate Client..."
_PrintString (10, 230), Msg$
If Server = 0 Then
Server = _OpenClient("TCP/IP:7319:localhost") ' it tries a second time the connection with Host
If Server = 0 Then Msg$ = "Failed to activate server Client. Client is OFF" Else Msg$ = " Activated Server Client. Client is ON"
_PrintString (10, 300), Msg$
If Server = 0 Then End
End If
Rem here Client waits user input and sends this to Host
Dim Comd As String
Do
_Delay 1
Cls , _RGBA32(33, 72, 200, 255) ' typo error _RGBA32(128, 200, 200, 255)
_PrintString (10, 100), "Client is ON, press c/C to change color, s/S to sound notes and space key to quit"
Comd = "" ' it deletes previous command read by client
Comd = InKey$
If Comd <> "" Then Put #Server, , Comd ' has Cli(n) sent data?
' data executor
Select Case Comd
Case " ":
_PrintString (10, 200), " > Quitting command sent"
' it quits
Case "c", "C":
_PrintString (10, 200), " > Changing color command sent" ' it changes color
Case "s", "S":
_PrintString (10, 200), " > Playing sound command sent" ' it sounds some notes
End Select
Loop Until InKey$ = " " Or Comd = " " ' press space to quit
Close
End
Lclient3
Code: (Select All)
Rem Project to simulate a server with multiple clients TCP/IP
Rem the second program is the first client side of the network
Screen _NewImage(800, 640, 32)
Cls , _RGBA32(128, 200, 67, 255)
_ScreenMove 1200, 200
_PrintString (10, 200), "testing if CLIENT is already ON"
Dim Server As Long
Server = _OpenClient("TCP/IP:7319:localhost")
If Server Then Msg$ = "Client is ON" Else Msg$ = "Cannot activate Client..."
_PrintString (10, 230), Msg$
If Server = 0 Then
Server = _OpenClient("TCP/IP:7319:localhost") ' it tries a second time the connection with Host
If Server = 0 Then Msg$ = "Failed to activate server Client. Client is OFF" Else Msg$ = " Activated Server Client. Client is ON"
_PrintString (10, 300), Msg$
If Server = 0 Then End
End If
Rem here Client waits user input and sends this to Host
Dim Comd As String
Do
_Delay 1
Cls , _RGBA32(128, 200, 67, 255) ' typo error _RGBA32(128, 200, 200, 255)
_PrintString (10, 100), "Client is ON, press c/C to change color, s/S to sound notes and space key to quit"
Comd = "" ' it deletes previous command read by client
Comd = InKey$
If Comd <> "" Then Put #Server, , Comd ' has Cli(n) sent data?
' data executor
Select Case Comd
Case " ":
_PrintString (10, 200), " > Quitting command sent"
' it quits
Case "c", "C":
_PrintString (10, 200), " > Changing color command sent" ' it changes color
Case "s", "S":
_PrintString (10, 200), " > Playing sound command sent" ' it sounds some notes
End Select
Loop Until InKey$ = " " Or Comd = " " ' press space to quit
Close
End
Well save files with its own name, compile them with F11 (only EXE) and at the end run Host with double click on it.
Play press c/C or s/S and jumping from a client to another...
pressing space bar key the client active and the host stop running.
I have left the END instruction to let see what happens in the different applications windows... but the best is to close all applications. No such more code just few lines to get this result.
RE: a little TCP/IP network in LocalHost - TempodiBasic - 10-08-2024
Thanks to Pete for recognizing my typo error for backgroung refresh.
RE: a little TCP/IP network in LocalHost - Keybone - 11-29-2024
![[Image: Screenshot-from-2024-11-28-22-03-34.png]](https://i.ibb.co/7pdLmTm/Screenshot-from-2024-11-28-22-03-34.png)
I like it very much. here is a screenshot of what i have so far.
RE: a little TCP/IP network in LocalHost - Keybone - 11-29-2024
here is my modified code:
Code: (Select All)
Rem Host
Randomize Timer
Rem Project to simulate a server with multiple clients TCP/IP
Rem the first program is the server side of the network
Dim bgColor As _Unsigned Long
bgColor = _RGBA32(254, 0, 255, 255)
Screen _NewImage(480, 240, 32) 'Sets screenmode
Cls , bgColor
_ScreenMove (_DesktopWidth / 2) - (_Width / 2), (_DesktopHeight / 2) - (_Height / 2)
_PrintString (10, 100), "Searching for host..."
Dim Server As Long
Server = _OpenClient("TCP/IP:65535:localhost")
If Server Then
_PrintString (10, 130), "Host found. Press any key to exit."
Sleep
System
Else
_PrintString (10, 130), "Host not found. Initialization beginning."
Server = _OpenHost("TCP/IP:65535")
If Not Server Then
_PrintString (10, 200), "Host initialization failed."
Else
_PrintString (10, 200), " Host initialization successful."
End If
End If
Rem Initiate client here (optional)
Rem here Host searches connections with clients and if activated it reads data
Dim Client(0 To 65534) As Long, ID As _Unsigned Integer, Instruction As String
ID = 1
Do
ID = Int(Rnd * 65535)
If ID = 65535 Then ID = 0
If Client(ID) = 0 Then Client(ID) = _OpenConnection(Server) ' Is cli(ID) connected?
Instruction = "" ' it deletes previous command read by client
If Client(ID) <> 0 Then
If Not EOF(Client(ID)) Then Get #Client(ID), , Instruction ' has Client(ID) sent data?
End If
' data executor
Select Case Instruction
Case "x"
Cls , bgColor
_PrintString (10, 100), "Client" + Str$(ID) + " quits"
Case "c"
bgColor = _RGBA32((Rnd * (255)) + 1, (Rnd * (255)) + 1, (Rnd * (255)) + 1, 255)
Cls , bgColor
_PrintString (10, 100), "Client" + Str$(ID) + " changes background color"
' it changes color
Case "s"
Play "cdc"
Cls , bgColor
_PrintString (10, 100), "Client" + Str$(ID) + " makes noise"
End Select
_PrintString (10, 200), " Press q to quit"
Loop Until InKey$ = "q"
Close
SystemCode: (Select All)
Rem Client
Dim bgColor As _Unsigned Long
bgColor = _RGBA32(128, 200, 67, 255)
Screen _NewImage(400, 320, 32)
Cls , bgColor
_ScreenMove (_DesktopWidth / 2) - (_Width / 2), (_DesktopHeight / 2) - (_Height / 2)
_PrintString (10, 100), "Connecting to Host..."
Dim Server As Long
Server = _OpenClient("TCP/IP:65535:localhost")
If Server Then
_PrintString (10, 130), "Connected."
Else
_PrintString (10, 130), "Connection failed. Retrying..."
Server = _OpenClient("TCP/IP:65535:localhost") 'Try one more time
If Not Server Then
_PrintString (10, 260), "Connection failed."
Sleep
System
Else
_PrintString (10, 260), " Connected."
End If
End If
_Title Str$(Server)
Rem Client waits for input and transmits to Host
Dim Instruction As String
Do
_Delay 1
Cls , bgColor
_PrintString (10, 100), "Client is connected to host."
_PrintString (10, 130), "Press c to change host background color"
_PrintString (10, 160), "Press s to make noise "
_PrintString (10, 190), "Press x to quit"
Instruction = InKey$
Instruction = LTrim$(RTrim$(LCase$(Instruction)))
If Len(Instruction) Then Put #Server, , Instruction ' If new instruction, then send to Host
Select Case Instruction
Case "x":
Cls , bgColor
_PrintString (10, 100), "Disconnecting from Host..."
Sleep 1
_PrintString (10, 130), "Terminating Client..."
Sleep 1
_PrintString (10, 160), "Bye!"
Sleep 1
System
Case "c"
_PrintString (10, 230), "Changing color on Host..."
Case "s"
_PrintString (10, 230), "Playing sound on Host..."
End Select
Loop Until Instruction = "x"
Close
SystemRE: a little TCP/IP network in LocalHost - TempodiBasic - 12-01-2024
I like your mod
![[Image: image.png]](https://i.ibb.co/1zzWHhK/image.png)
here a starter to get more client than one
Code: (Select All)
Shell _DontWait "host by keybone.exe"
For a = 1 To 6
Sleep 1
Shell _DontWait "client by keybone.exe"
Next
SystemPS: I have saved your code as Host by Keybone and Client by Keybone.
RE: a little TCP/IP network in LocalHost - Keybone - 12-03-2024
Thanks man. I plan on working more on it. I had a lot of fun.
I liked how you did the original client/server it was easy to learn and understand.
As i fix it up more and add more features ill post it on here.