when 2 users login via client and 1 user logs out , then 2nd user logs out , then login both again it gives this error
server
server
on client disconnect button
client
server
Code:
Private Sub AcceptedSocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'This is a very "meaty" function. Here is where we do the processing
'of incoming data. We check for the request type, and do the appropriate
'thing.
Dim tempString As String
Dim strValue() As String
Dim RequestType As Integer
Dim strCommand() As String
Dim CommandElement As Variant
Dim strdata As String
'I don't know enough about the Winsock control to know if you have to
'do multiple reads for split packets, as you do with the API and with
'UNIX sockets (which are all but identical) but it seems to work as is.
'Probably because we're not sending large enough packets to be split up.
' Receive the data.
AcceptedSocket(Index).GetData tempString, bytesTotal & strdata
'This Split function and the For Each on the resulting array were due
'to delayed sends from the Winsock OCX. When I switched to the API for
'sending data, I don't seem to have the problem of receiving multiple
'commands in a single receive anymore, but I figured it doesn't hurt
'to leave it in just in case.
strCommand = Split(Right(tempString, (Len(tempString) - 1)), "#")
For Each CommandElement In strCommand
' Split the string into (hopefully) two values,
' right and left of the command separator
strValue = Split(CommandElement, COMMAND_SEPARATOR)
' Check to see if we have a data change, such as
' chat room change or user name change, or if we
' have data to send.
RequestType = FindRequestType(strValue(0))
If RequestType = iUSER_CHANGE Then
'We have been notified that a user has changed their user name.
'This only happens after we send an initial message.
Users(str(Index)).OldUserName = Users(str(Index)).UserName
Users(str(Index)).UserName = strValue(1)
NotifyUserNameChange Index
ElseIf RequestType = iCHATROOM_CHANGE Then
'We have been notified that a user has changed chat rooms. We
'will send out a message to all users in both the old room and the
'new room to update their user lists.
Users(str(Index)).OldChatRoom = Users(str(Index)).ChatRoom
Users(str(Index)).ChatRoom = strValue(1)
AdjustUserCount Users(Index).OldChatRoom, Users(Index).ChatRoom 'doogle <<<< error debug line here
NotifyUserChatRoomChange Index
ElseIf RequestType = iINCOMING_MESSAGE Then
'Some user wants to communicate. Imagine the bother. Well, if we
'must, we'll echo his message to everyone in his chat room.
Dim tempStr As String
tempStr = strValue(1)
NotifyUserMessage Index, tempStr
End If
Next CommandElement
End SubCode:
Private Sub AdjustUserCount(strOld As String, strNew As String, Optional boRemove As Boolean = False)
'
' This Subroutine added by doogle
'
Dim ThisRoom As New ChatRoom
Dim strRoomInfo() As String
Dim boOld As Boolean
Dim boOldList As Boolean
Dim boNewList As Boolean
Dim boNew As Boolean
Dim intI As Integer
Dim intJ As Integer
If strOld <> strNew Then 'doogle mod
intI = 1
Do
If ChatRooms(intI).RoomName = strOld Then
Set ThisRoom = ChatRooms(intI)
ThisRoom.RemoveFromUserCount
ChatRooms.Remove strOld
ChatRooms.Add ThisRoom, strOld
intJ = 0
Do
If lstChatRoomList.List(intJ) Like strOld & "(*" Then
strRoomInfo = Split(lstChatRoomList.List(intJ), "(")
strRoomInfo(0) = strRoomInfo(0) & "(" & CStr(ThisRoom.UserCount) & ")"
lstChatRoomList.List(intJ) = strRoomInfo(0)
boOldList = True
Else
intJ = intJ + 1
End If
Loop Until boOldList Or intJ > lstChatRoomList.ListCount
boOld = True
Else
intI = intI + 1
End If
Loop Until intI > ChatRooms.Count Or boOld
End If 'doogle mod
If Not boRemove Then
intI = 1
Do
If ChatRooms(intI).RoomName = strNew Then
Set ThisRoom = ChatRooms(intI)
ThisRoom.AddToUserCount
ChatRooms.Remove strNew
ChatRooms.Add ThisRoom, strNew
intJ = 0
Do
If lstChatRoomList.List(intJ) Like strNew & "(*" Then
strRoomInfo = Split(lstChatRoomList.List(intJ), "(")
strRoomInfo(0) = strRoomInfo(0) & "(" & CStr(ThisRoom.UserCount) & ")"
lstChatRoomList.List(intJ) = strRoomInfo(0)
boNewList = True
Else
intJ = intJ + 1
End If
Loop Until boNewList Or intJ > lstChatRoomList.ListCount
boNew = True
Else
intI = intI + 1
End If
Loop Until intI > ChatRooms.Count Or boNew
End If
Set ThisRoom = Nothing
End Subon client disconnect button
client
Code:
Private Sub cmdDisconnect_Click()
'Closes the connection and performs some GUI cleanup.
boInit = False
ConnSocket.Close
cmbChatRooms.Clear
cmdDisconnect.Enabled = False
cmdConnect.Enabled = True
'Actually close the connection
'Clear the User list box and chat rooms list
lstUsers.Clear
cmbChatRooms.Clear
'Enable editing of the text boxes, disable the disconnect and send
'buttons, and enable the connect button.
Text12.Text = ""
Text1.Text = ""
Text4.Text = ""
Text3.Text = ""
Command6.Enabled = False
Command7.Enabled = False
End Sub