CHAT for QB64

[MasterGy]

I would like to meet in a QB64 3D world one day. On a beach...or anywhere

I started learning this TCP/IP thing. It worked and I was very happy. That's when I realized that if the clients don't send coordinates, but text, then we actually get a chat program.

The engine is running. I rented a server and we can talk to each other through it!
Try it !

Code: (Select All)

Randomize Timer



'profile data -----------------------------------------------------------------------------------------

my_name$ = "user" 'your nickname
my_info$ = "i am ...." 'short introduction
my_color&& = _RGB32(55 + 200 * Rnd, 55 + 200 * Rnd, 55 + 200 * Rnd, 255) 'your color
'----------------------------------------------------------------------------------------------------------

Const fc$ = "sudlikam"

connect_ip$ = "95.138.193.62"
connect_port$ = "60000"
mess_c = 20


my_name$ = my_name$ + "_" + LTrim$(Str$(Int(100 * Rnd(1))))

bg&& = _RGB32(30, 10, 10): _Title "client - " + my_name$
max_client = 100: Dim c$(max_client - 1, 9), active(max_client - 1), cpic(max_client - 1, 1), mess$(mess_c - 1), v(max_client - 1, 1)
monx = 1000: mony = 550: mon = _NewImage(monx, mony, 32): Screen mon

'connection
Dim Shared connection&, dat$, mess$
Do: _Limit 10: If InKey$ = Chr$(27) Then System
    connection& = _OpenClient("TCP/IP:" + connect_port$ + ":" + connect_ip$)
    If connection& = 0 Then Print "no connection"
Loop Until connection&



send "0nam" + my_name$: send "1inf" + my_info$
send "4col" + Right$("00" + Hex$(_Red(my_color&&)), 2) + Right$("00" + Hex$(_Green(my_color&&)), 2) + Right$("00" + Hex$(_Blue(my_color&&)), 2) + Right$("00" + Hex$(_Alpha(my_color&&)), 2)


Do: _Limit 20

    If Abs(Timer - sign_timer) > 2 Then send "sign": sign_timer = Timer

    Do
        s$ = get2$
        If Len(s$) Then
            Select Case Mid$(s$, 5, 4)
                Case "5pos", "0nam", "1inf", "3msg", "4col"
                    c$(Val(Left$(s$, 4)), Val(Mid$(s$, 5, 1))) = Mid$(s$, 9)
                Case "addc": active(Val(Left$(s$, 4))) = 1: Sound 2000, .2
                Case "delc": active(Val(Left$(s$, 4))) = 0
                    If cpic(Val(Left$(s$, 4)), 1) Then _FreeImage cpic(Val(Left$(s$, 4)), 0)
                    cpic(Val(Left$(s$, 4)), 1) = 0
                Case "cmsg": mess$(cm) = Mid$(s$, 9): cm = (cm + 1) Mod mess_c
                Case "srok": srok = Timer
            End Select
        End If
    Loop While Len(s$)





    'show header
    While _MouseInput: Wend


    Color my_color&&: Print my_name$; "- client   ",
    If Abs(srok - Timer) > 5 Then
        Color _RGB32(255, 0, 0): Print "Server no answer"
    Else
        Color _RGB32(0, 255, 0): Print "Server is OK ! "
    End If

    Color _RGB32(150, 150, 150): Print String$(monx / 8 - 1, "-"): Print "connected : ";

    startx = 14 * 8: starty = 2 * 16: show_info = -1
    For c = 0 To max_client - 1: If active(c) = 0 Then _Continue
        If c$(c, 4) = "" Then
            Color _RGB32(150, 150, 150)
        Else
            For t = 0 To 3: co(t) = Val("&h" + Mid$(c$(c, 4), t * 2 + 1, 2)): Next t
            Color _RGB32(0, 0, 0), _RGB32(co(0), co(1), co(2), co(3))
        End If
        If Len(c$(c, 0)) * 8 + startx > monx - 10 Then startx = 0: starty = starty + 16
        _PrintString (startx, starty), c$(c, 0)
        If _MouseX > startx And _MouseX < startx + Len(c$(c, 0)) * 8 And _MouseY > starty And _MouseY < starty + 16 Then show_info = c
        startx = startx + (Len(c$(c, 0)) + 2) * 8
    Next c

    If show_info <> -1 Then
        Color _RGB32(100, 100, 100), _RGB32(255, 255, 255): startx = _MouseX
        If startx + Len(c$(show_info, 1)) * 8 > monx - 10 Then startx = monx - 10 - Len(c$(show_info, 1)) * 8
        _PrintString (startx, _MouseY + 16), c$(show_info, 1)
    End If


    Color , bg&&

    'show message my type
    Color my_color&&: If Int(Timer * 10) And 1 Then cr$ = "_" Else cr$ = " "
    Locate mony / 16 - 2, 1: Print mess$; cr$;

    'show messages
    For t = 0 To mess_c - 1
        y = mony / 16 - 2 - mess_c: Locate y + t, 1: s$ = mess$((cm + t) Mod mess_c)
        Color _RGBA32(Val("&h" + Mid$(s$, 1, 2)), Val("&h" + Mid$(s$, 3, 2)), Val("&h" + Mid$(s$, 5, 2)), Val("&h" + Mid$(s$, 7, 2)))
    Print Mid$(s$, 19): Next t

    _Display: Color , _RGB32(0, 0, 0): Cls


    Line (0, mony - (mess_c + 4) * 16)-(monx, mony), bg&&, BF

    'type message
    k$ = InKey$
    If Len(k$) Then
        a = Asc(k$)
        If a = 27 Then System
        If a = 13 And Len(mess$) Then send "3msg" + mess$: mess$ = ""
        If a = 8 Then mess$ = Left$(mess$, Len(mess$) - 1)
        felt = (a > 31 And a < 91) Or (a > 96 And a < 123)
        If felt Then mess$ = mess$ + k$
    End If

Loop


err1: hiba = 1: Resume Next

Sub send (s$): s2$ = s$ + fc$: Put connection&, , s2$: End Sub
Function get2$
    If Len(dat$) = 0 Then Get connection&, , st$: dat$ = dat$ + st$
    If Len(dat$) = 0 Then Exit Function
    ok = -1: For t = 1 To Len(dat$)
        If Mid$(dat$, t, Len(fc$)) = fc$ Then ok = t: Exit For
    Next t
    If ok = -1 Then Exit Function
    get2$ = Left$(dat$, ok - 1): dat$ = Mid$(dat$, ok + Len(fc$))
End Function