Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
a little TCP/IP network in LocalHost
#1
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.
Reply
#2
Thanks to Pete for recognizing my typo error for backgroung refresh.
Reply




Users browsing this thread: 2 Guest(s)