[VB6] - Multi-User Chat Example (Winsock)

so has this just died or what

so whats going on with this thread

I'm not dead. I stopped programming for awhile.

I still have the code on a backup drive...if I remember correctly, it's basically done, there was just a bug or two that needs to be fixed.

I'll post it when I get around to it. I forgot about it entirely.

was looking forward to seeing your final project. i've used yours and tweeked it to work with some of the programs iwe use in my office.

would be cool to see, you find it?

I have created a chat program, I hope that you guys like it :D

vb Code:

Attribute VB_Name = "modRooms"
Global frmRooms() As New frmRoomChat
Public strRoomsHide() As String
 
Dim roomIndex As Integer
 
Public Function UbRooms() As Long
    On Error GoTo ErrorHandler
    UbRooms = UBound(frmRooms)
    Exit Function
ErrorHandler:
    UbRooms = -1
    Exit Function
End Function
 
Sub HandleUserLeavingRoom(Packet As String)
'"ULV()Uname()Room<<"
If InStr(1, Packet, Chr(2)) > 0 Then
    Dim packetDetails() As String
    Dim UserName As String
    Dim Roomname As String
    packetDetails() = Split(Packet, Chr(2))
    UserName = packetDetails(1)
    Roomname = packetDetails(2)
    If RoomsHide_IsHiding(Roomname) = True Then ShowHiddenRoom Roomname
    WriteMesssage frmRooms(roomIndex).rtbChat, vbNullChar, UserName & " has left the room.", vbMagenta
    RemoveListItem frmRooms(roomIndex).lstRoomUsers, UserName, True
End If
End Sub
 
Sub HandleNewRoomUser(Packet As String)
'"UJN()Uname()Room<<"
If InStr(1, Packet, Chr(2)) > 0 Then
    Dim packetDetails() As String
    Dim UserName As String
    Dim Roomname As String
    packetDetails() = Split(Packet, Chr(2))
    UserName = packetDetails(1)
    Roomname = packetDetails(2)
    If RoomsHide_IsHiding(Roomname) = True Then ShowHiddenRoom Roomname
    WriteMesssage frmRooms(roomIndex).rtbChat, vbNullChar, UserName & " has entered the room.", vbMagenta
    RemoveListItem frmRooms(roomIndex).lstRoomUsers, UserName, True
    frmRooms(roomIndex).lstRoomUsers.AddItem UserName
End If
End Sub
 
Public Sub AddNewRoom()
    ReDim Preserve frmRooms(UbRooms + 1)
End Sub
 
Sub ShowHiddenRoom(Roomname As String)
    Dim x As Integer
    For x = 0 To UbRooms
        If frmRooms(x).Caption = Roomname Then
            frmRooms(x).Show
            Exit Sub
        End If
    Next x
End Sub
 
Public Sub ShowRoom(strRoomName As String)
    Dim u As Integer
    
    u = UbRooms
    If u > -1 Then
        For roomIndex = 0 To u
            If frmRooms(roomIndex).Caption = strRoomName Then
                frmRooms(roomIndex).Show
                Exit For
            ElseIf frmRooms(roomIndex).Caption = "" Then
                frmRooms(roomIndex).Caption = strRoomName
                frmRooms(roomIndex).Show
                AddNewRoom
                Exit For
            End If
        Next roomIndex
    End If
End Sub
 
Public Function RoomsHide_IsHiding(ByRef Roomname As String) As Boolean
    Dim l As Long, u As Long, s As String
    u = RoomsHide_UBound
    s = LCase$(Roomname)
    If u > -1 Then
        For l = 0 To u
            If LCase$(strRoomsHide(l)) = s Then
                RoomsHide_IsHiding = True
                Exit For
            Else
                RoomsHide_IsHiding = False
            End If
        Next l
    End If
End Function
 
Public Function RoomsHide_UBound()
    On Error GoTo ErrorHandler
    RoomsHide_UBound = UBound(strRoomsHide)
    Exit Function
ErrorHandler:
    RoomsHide_UBound = -1
    Exit Function
End Function
 
Public Sub RoomsHide_Add(ByRef Roomname As String)
    Dim u As Long
    u = RoomsHide_UBound + 1
    ReDim Preserve strRoomsHide(0 To u) As String
    strRoomsHide(u) = Roomname
End Sub
 
Sub HandleWrongRoomPassword(Packet As String)
    If InStr(1, Packet, Chr(2)) > 0 Then
        Dim packetDetails() As String
        packetDetails() = Split(Packet, Chr(2))
        MsgBox "The password you used to enter the " & packetDetails(1) & " chat room is wrong. Please retry.", vbExclamation
        WriteLog frmMain.rtbLog, "Access denied to the " & packetDetails(1) & " chat room: Wrong Password.", vbMagenta
    End If
End Sub
 
Sub HandleJoinedRoom(Packet As String)
    If InStr(1, Packet, Chr(2)) > 0 Then
        Dim packetDetails() As String
        packetDetails() = Split(Packet, Chr(2))
        ShowRoom (packetDetails(1))
        'WriteLog frmMain.rtbLog, NickName & " joined the " & packetDetails(1) & " chat room."
    End If
End Sub
 
Sub AlreadyInRoom(Packet As String)
If InStr(1, Packet, Chr(2)) > 0 Then
    Dim Roomname As String
    Dim packetDetails() As String
    packetDetails() = Split(Packet, Chr(2))
    Roomname = packetDetails(1)
    WriteLog frmMain.rtbLog, "You are already in the " & Roomname & " chat room."
    If RoomsHide_IsHiding(Roomname) = True Then ShowHiddenRoom Roomname
End If
End Sub
 
Public Sub HandleRoomList(Packet As String)
    If InStr(1, Packet, Chr(2)) > 0 Then
    'Room Packet format: "RUM()RumName2-Locked-Creator-0-200-joe>
        frmChatRooms.lstRooms.ListItems.Clear
        Dim strRoomList() As String
        Dim strPacketDetails() As String
        Dim strRoomInfo() As String
        Dim strRoomName As String
        Dim isLocked As Boolean
        Dim usersInside As Integer
        Dim strCreator As String
        Dim intMax As Integer
        Dim strPass As String
        Dim strIcon As String
        Dim i As Integer
        strPacketDetails() = Split(Packet, Chr(2))
        strRoomList() = Split(strPacketDetails(1), vbCrLf)
        For i = 0 To UBound(strRoomList()) - 1
            strRoomInfo() = Split(strRoomList(i), Chr(3))
            strRoomName = strRoomInfo(0)
            isLocked = strRoomInfo(1)
            strCreator = strRoomInfo(2)
            usersInside = strRoomInfo(3)
            intMax = strRoomInfo(4)
            strPass = strRoomInfo(5)
            If isLocked = True Then strIcon = "closed"
            If isLocked = False Then strIcon = "open"
            With frmChatRooms.lstRooms.ListItems.Add(, , strRoomName)
                .SmallIcon = strIcon
                .SubItems(1) = usersInside
                .Tag = intMax & Chr(2) & strPass
                If strCreator = Nickname Then
                    .bold = True
                    .ForeColor = vbBlue
                End If
            End With
        Next i
    End If
End Sub
 
Sub HandleRoomCreatedSuccessfully(Packet As String)
    If InStr(1, Packet, Chr(2)) > 0 Then
        'RCT()roomname()sender()Message<<
        Dim packetDetails() As String
        packetDetails() = Split(Packet, Chr(2))
        MsgBox "The room " & packetDetails(1) & " has been successfully created.", vbInformation
    End If
End Sub
 
Sub SendRoomMessage(Roomname As String, Message As String)
    Dim Packet As String
    Packet = "RCT" & Chr(2) & Roomname & Chr(2) & Message & Chr(4)
    SendData Packet
End Sub
 
Sub ReceiveRoomMessage(Roomname As String, Sender As String, Message As String)
    If Sender = Nickname Then Exit Sub
    If CheckIfUserIsBlocked(Sender) = True Then Exit Sub
    Dim i As Integer
    If RoomsHide_IsHiding(Roomname) = True Then ShowHiddenRoom (Roomname)
    For i = 0 To UbRooms
        If frmRooms(i).Caption = Roomname Then Exit For
    Next i
     WriteMesssage frmRooms(i).rtbChat, Sender, Message
End Sub
 
Sub HandleRoomMessage(Packet As String)
    If InStr(1, Packet, Chr(2)) > 0 Then
        'RCT()roomname()sender()Message<<
        Dim packetDetails() As String
        packetDetails() = Split(Packet, Chr(2))
        ReceiveRoomMessage packetDetails(1), packetDetails(2), packetDetails(3)
    End If
End Sub
 
Sub HandleRoomUserList(Packet As String)
'On Error Resume Next
    '"RUS()RoomName()User1Name>>User2Name>>User3Name<<
    If InStr(1, Packet, Chr(2)) > 0 Then
        Dim packetDetails() As String
        Dim Roomname As String
        Dim roomUsers() As String
        Dim i As Integer
        packetDetails() = Split(Packet, Chr(2))
        Roomname = packetDetails(1)
        roomUsers() = Split(packetDetails(2), vbNewLine)
        For x = 0 To UbRooms
            If frmRooms(x).Caption = Roomname Then Exit For
        Next x
        For i = 0 To UBound(roomUsers())
            If Not roomUsers(i) = "" Then
                RemoveListItem frmRooms(x).lstRoomUsers, roomUsers(i), True
                frmRooms(x).lstRoomUsers.AddItem roomUsers(i)
            End If
        Next i
    End If
End Sub

progress?

I dont know how you guys did it but for a noob like me i need to bring a whole dictionary of codes and their meanings and how they work. Any ways I Want to know if there is Any Update on this thing cause I want to examine the code a lot to know better of this codes.





And For The chat program I am thinking if you could add their profile pics when on pm.

Hoping For the finished version. Good Luck!

progress now?

even if it is not complete DigiRev, release it :p

Maybe his busy right now or somethings wrong with his computer...

But Dont lose Hope(not the cigarettes) he will release the final version we all are waiting for.
But please release it As soon as possible.

meh..

DigiRev

Please give some news, are you OK?

I've been really busy and had to take a long hiatus from programming all-together.

I'm updating this project (well, actually started from scratch) so it will have a lot of new features (custom chat rooms, users can be in multiple rooms, password-protected rooms, etc.). This will hopefully hold you over until I finally finish the instant messenger, which had a lot of nasty bugs so I had to rewrite most of it. :sick:

Not to sound like I'm bragging, but the instant messenger will probably be the best one released that I'm aware of in VB6, even though there are tons of good ones on www.pscode.com. There are really tons of features...

Anyway, updated project will be posted soon and following, the instant messenger. :thumb:

Here's just a few screen shots of the client... it's going to be a tabbed-based client, and function like FireFox, where each room you're in has its own tab.

There's also file transfers, and other stuff.

Cool! Im intrested in seeing how this comes out!

It's almost done. :D

I had to remove the screenshot of the file transfers window, but it looks & functions like FireFox's download manager. ;)

Also, I might have to wait for webcam features since I need to find mine to be able to test it.

Another feature I'm adding is protocol support, so you can click a link in a web browser like: vbchat://ServerIP:Port and it will automatically launch the program and connect to the server.

Cool!!!
More than I expected.
Never thought of something like thing. I thought it would be simple. Maybe you could add a skin feature/themes wherein you can change skins/themes that you want and also make your own.

Look like a great project
Any updates?

Hi, I've been tracking this thread for some time now..
I'm really looking forward to the new version.. any updates?

It's almost done now. I had to start over some time ago, but I'm still working on the version shown in the screenshots.

I lost interest in this project awhile ago but still getting it done because I promised. ;) Not sure how many updates I'll do to it once this next one is released, but that's why it's open-source, right? ;) It will have a lot of features in it anyway.

Hey this was a great program, I added private messages, banning, kicking and muting within a half hour, its so easy to add more functions and its very user friendly.

Quote:

---

Originally Posted by RoflItsK

Hey this was a great program, I added private messages, banning, kicking and muting within a half hour, its so easy to add more functions and its very user friendly.

---

Thanks. :)

That was the goal: to make it easy to add/modify.

Hopefully this update, while it has a bunch of features and is completely different, will still be easy enough to modify and change stuff.

Quote:

---

Originally Posted by RoflItsK

Hey this was a great program, I added private messages, banning, kicking and muting within a half hour, its so easy to add more functions and its very user friendly.

---

plez upload source code server+ client


thanks

hi guys

someone can developed more mod like :

private messages + buzz
avatar
banned
ignore
smiles
fonts type+ size + color
admin can create rooms
banned words
upload files share




thanks

i think its only work in a single computer not multi...?right? just like in your attachment pictures...and tyr'd it also but it's not working if u prefer to user it on other computer to other computer..sorry but i am not perfectly sure about this..it just my theory and my expirement explanation...

lol..when you connect,you must change the ip address in the corresponding ip address and port of the server who host that thing..ok.? like if the IP ADDRESS of the server is 10.0.0.9 and the server port is 123456 then you must put that IP ADDRESS and server port to the box so that you could connect...just like what i did.

nice!,simple but full of learnings..

DigiRev you forget about this thread again!?

hey... can i ask a multi user chat using vb6 that does not use modules?? i'm working on a chat room that does not use modules... client side and server side... :)

oh jesus... when could this project will be release.?

Hey DigiRev,

You can can upload the project here and we will fix the bugs (those that we can). ;)

progress?

no respond from him ..as he said he is out in programming at the moment,maybe at the moment means 5 years after or forever for simplicity

Digirev?????????????? :wave: Have you forgotten how to program in vb6 ? :)

no progress yet i see

what if I'm using this program behind a router where I'm not allowed to change the router settings to do port forwarding, at university for example.
There must be some way to do it without changing the router settings, after all, you don't need to change your router settings when you use MSN or anything.

you don't have to mess with theprot forwarding with msn because you are not the host. you only have to port forward if someone outside your router is going to be using your chat system.

Great Replies
Here is Messenger Im Working on it
Webcam Support
VB Support
Room
Private IM

http://0k.012.img98.com/out.php/i389243_resaneh4.jpg

But I Just Afraid From 1Thing:(
I Think If Users Grows up to 5000! Server Cant Handle it!
Which Language is Good For Writing Server?
VB6 is Poor For Server?

Why did you hijack a thread that was created 3 years ago to post a screenshot of your program?