a little TCP/IP network in LocalHost

[TempodiBasic]

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.

[TempodiBasic]

Thanks to Pete for recognizing my typo error for backgroung refresh.

[Keybone]

I like it very much. here is a screenshot of what i have so far.

[Keybone]

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

System

Code: (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

System

[TempodiBasic]

I like your mod



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

System

PS: I have saved your code as Host by Keybone and Client by Keybone.

[Keybone]

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.