Aberf
September 12th, 2001, 04:08 PM
When a user logs in they get the "Connected to server" and Uername has logged into server messages in the output box, then after they hit okay on the msg box that comes up they get the "Connected to server" once more, and the Username has logged into server message twice more. In the server app, when this happens, it shows that they logged in twice, and logged out once, and they are on the seconds line of the list box. This only happens in runtime.
Server:
private Sub wsServer_ConnectionRequest(byval RequestID as Long)
If wsServer.State <> sckClosed then
wsServer.Close
End If
wsServer.Accept RequestID
End Sub
private Sub wsServer_DataArrival(byval bytesTotal as Long)
on error resume next
'receive the message
wsServer.GetData Msg, vbString
'split the message to make sure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'check to see what kind of message it is
If Left$(Msg, 1) = Chr$(10) then
'receive the new user's user name and send for password
UName = mid$(Msg, 2, 5)
Open App.Path & "/Users/list.xfd" for input as #1
count1 = "1"
fin = "start"
Do Until fin = "EOF"
input #1, fin
If UName = fin then
Open App.Path & "/Users/" & UName & ".xff" for input as #2
count1 = "1"
Line input #2, fin
Line input #2, fin
Line input #2, fin
Line input #2, fin
Passwrd = fin
wsServer.SendData Chr$(33) & "CMDPASSWORD" & Chr$(0)
Close #2
DoEvents
else
If fin = "EOF" then
wsServer.SendData Chr$(38) & "WRONGUSERNAME" & Chr$(0)
DoEvents
wsServer.Close
wsServer.Listen
Exit Do
else
count1 = count1 + 1
End If
End If
Loop
Close #1
End If
'client sent password
If Left$(Msg, 1) = Chr$(32) then
PWord = mid$(Msg, 2, 5)
If PWord = Passwrd$ then
wsServer.SendData Chr$(34) & "RIGHTPASSWORD" & Chr$(0)
DoEvents
else
wsServer.SendData Chr$(34) & "WRONGPASSWORD" & Chr$(0)
DoEvents
wsServer.Close
wsServer.Listen
End If
End If
'client commands port
If Left$(Msg, 1) = Chr$(92) then
wsServer.SendData Chr$(23) & txtPort.Text & Chr$(0)
End If
End Sub
private Sub wsUser_Close(Index as Integer)
on error resume next
Dim a as Integer
'tell the other users that that user logged out
for a = 1 to txtMaxUsers.Text
wsUser(a).SendData Chr$(10) & lstChatUsers.List(Index - 1) & Chr$(0)
DoEvents
next a
'write that the user has logged off
txtOutput.Text = txtOutput.Text & lstChatUsers.List(Index - 1) & " has signed out at " & time & "." & vbCrLf
'update the user list
lstChatUsers.List(Index - 1) = "<Listening>"
End Sub
private Sub wsUser_ConnectionRequest(Index as Integer, byval RequestID as Long)
Dim a as Integer
If wsServer.State <> sckClosed then
wsServer.Close
wsServer.Listen
End If
'check to make sure it is connecting to the main socket
If Index = 0 then
'loop through the users to find an open socket
for a = 1 to txtMaxUsers.Text
'found an open socket
If lstChatUsers.List(a - 1) = "<Listening>" then
'accept the user on that socket
If wsUser(a).State <> sckClosed then
wsUser(a).Close
End If
wsUser(a).Accept RequestID
Exit Sub
End If
next a
End If
End Sub
private Sub wsUser_DataArrival(Index as Integer, byval bytesTotal as Long)
on error resume next
'variables
Dim Msg as string
Dim SplitMsg() as string
Dim a as Integer
'receive the message
wsUser(Index).GetData Msg, vbString
'splite the message to make sure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'check to see what kind of message it is
If Left$(Msg, 1) = Chr$(2) then
'if text then send the message to all the users
for a = 1 to txtMaxUsers.Text
wsUser(a).SendData Chr$(8) & mid$(Msg, 2) & Chr$(0)
DoEvents
next a
txtOutput.Text = txtOutput.Text & mid$(Msg, 2) & vbCrLf
End If
If Left$(Msg, 1) = Chr$(10) then
'receive the new user's user name and update the user list
lstChatUsers.List(Index - 1) = mid$(Msg, 2)
'tell the other users that the new user has signed in
for a = 1 to txtMaxUsers.Text
wsUser(a).SendData Chr$(9) & lstChatUsers.List(Index - 1) & Chr$(0)
DoEvents
next a
'write that the new user has signed in
txtOutput.Text = txtOutput.Text & lstChatUsers.List(Index - 1) & " has logged in at " & time & vbCrLf
End If
End Sub
Client:
private Sub wsChat_Connect()
'send the server the user's username
wsChat.SendData Chr$(10) & frmLogin.txtUserName.Text & Chr$(0)
End Sub
private Sub wsChat_DataArrival(byval bytesTotal as Long)
Dim PWord as string
'receive the message
wsChat.GetData Msg, vbString
'split the message to make sure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'check to see what kind of message it is
'password command or right/wrong password msg
If Left$(Msg, 1) = Chr$(33) then
wsChat.SendData Chr$(32) & frmLogin.txtPassword.Text & Chr$(0)
DoEvents
ElseIf Left$(Msg, 1) = Chr$(34) then
If count1 = "1" then
else
PWord = mid$(Msg, 2, 13)
If PWord = "RIGHTPASSWORD" then
wsChat.SendData Chr$(92) & "CMDPORT" & Chr$(0)
MsgBox ("Your password was correct!")
count1 = "1"
ElseIf PWord = "WRONGPASSWORD" then
wsChat.Close
MsgBox ("Access denied: Invalid password")
End
End If
End If
End If
'invalid username msg
If Left$(Msg, 1) = Chr$(38) then
wsChat.Close
MsgBox ("Access denied: Invalid username")
End
End If
'port message
If Left$(Msg, 1) = Chr$(23) then
If wsClient.State <> sckClosed then
wsClient.Close
End If
If count1 = "12" then
else
wsClient.RemoteHost = frmLogin.txtIP.Text
wsClient.RemotePort = mid$(Msg, 2, 4)
wsClient.Connect
wsChat.Close
DoEvents
count1 = "12"
End If
End If
End Sub
private Sub wsClient_Connect()
txtOutput.Text = txtOutput.Text & "Connected to the server" & vbCrLf
wsClient.SendData Chr$(10) & frmLogin.txtUserName.Text & Chr$(0)
DoEvents
End Sub
private Sub wsClient_DataArrival(byval bytesTotal as Long)
'variables
Dim Msg as string
Dim SplitMsg() as string
'receive the message
wsClient.GetData Msg, vbString
'split the message to ensure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'data is a text message
If Left$(Msg, 1) = Chr$(8) then
Msg = Replace(Msg, Chr$(8), "")
txtOutput.Text = txtOutput.Text & Msg & vbCrLf
End If
'data is a login of a new user
If Left$(Msg, 1) = Chr$(9) then
Msg = Replace(Msg, Chr$(9), "")
Msg = Replace(Msg, Chr$(0), "")
txtOutput.Text = txtOutput.Text & Msg & " has logged on!" & vbCrLf
End If
'data is a log off of a user
If Left$(Msg, 1) = Chr$(10) then
Msg = Replace(Msg, Chr$(10), "")
Msg = Replace(Msg, Chr$(0), "")
txtOutput.Text = txtOutput.Text & Msg & " has logged on!" & vbCrLf
End If
End Sub
Server:
private Sub wsServer_ConnectionRequest(byval RequestID as Long)
If wsServer.State <> sckClosed then
wsServer.Close
End If
wsServer.Accept RequestID
End Sub
private Sub wsServer_DataArrival(byval bytesTotal as Long)
on error resume next
'receive the message
wsServer.GetData Msg, vbString
'split the message to make sure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'check to see what kind of message it is
If Left$(Msg, 1) = Chr$(10) then
'receive the new user's user name and send for password
UName = mid$(Msg, 2, 5)
Open App.Path & "/Users/list.xfd" for input as #1
count1 = "1"
fin = "start"
Do Until fin = "EOF"
input #1, fin
If UName = fin then
Open App.Path & "/Users/" & UName & ".xff" for input as #2
count1 = "1"
Line input #2, fin
Line input #2, fin
Line input #2, fin
Line input #2, fin
Passwrd = fin
wsServer.SendData Chr$(33) & "CMDPASSWORD" & Chr$(0)
Close #2
DoEvents
else
If fin = "EOF" then
wsServer.SendData Chr$(38) & "WRONGUSERNAME" & Chr$(0)
DoEvents
wsServer.Close
wsServer.Listen
Exit Do
else
count1 = count1 + 1
End If
End If
Loop
Close #1
End If
'client sent password
If Left$(Msg, 1) = Chr$(32) then
PWord = mid$(Msg, 2, 5)
If PWord = Passwrd$ then
wsServer.SendData Chr$(34) & "RIGHTPASSWORD" & Chr$(0)
DoEvents
else
wsServer.SendData Chr$(34) & "WRONGPASSWORD" & Chr$(0)
DoEvents
wsServer.Close
wsServer.Listen
End If
End If
'client commands port
If Left$(Msg, 1) = Chr$(92) then
wsServer.SendData Chr$(23) & txtPort.Text & Chr$(0)
End If
End Sub
private Sub wsUser_Close(Index as Integer)
on error resume next
Dim a as Integer
'tell the other users that that user logged out
for a = 1 to txtMaxUsers.Text
wsUser(a).SendData Chr$(10) & lstChatUsers.List(Index - 1) & Chr$(0)
DoEvents
next a
'write that the user has logged off
txtOutput.Text = txtOutput.Text & lstChatUsers.List(Index - 1) & " has signed out at " & time & "." & vbCrLf
'update the user list
lstChatUsers.List(Index - 1) = "<Listening>"
End Sub
private Sub wsUser_ConnectionRequest(Index as Integer, byval RequestID as Long)
Dim a as Integer
If wsServer.State <> sckClosed then
wsServer.Close
wsServer.Listen
End If
'check to make sure it is connecting to the main socket
If Index = 0 then
'loop through the users to find an open socket
for a = 1 to txtMaxUsers.Text
'found an open socket
If lstChatUsers.List(a - 1) = "<Listening>" then
'accept the user on that socket
If wsUser(a).State <> sckClosed then
wsUser(a).Close
End If
wsUser(a).Accept RequestID
Exit Sub
End If
next a
End If
End Sub
private Sub wsUser_DataArrival(Index as Integer, byval bytesTotal as Long)
on error resume next
'variables
Dim Msg as string
Dim SplitMsg() as string
Dim a as Integer
'receive the message
wsUser(Index).GetData Msg, vbString
'splite the message to make sure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'check to see what kind of message it is
If Left$(Msg, 1) = Chr$(2) then
'if text then send the message to all the users
for a = 1 to txtMaxUsers.Text
wsUser(a).SendData Chr$(8) & mid$(Msg, 2) & Chr$(0)
DoEvents
next a
txtOutput.Text = txtOutput.Text & mid$(Msg, 2) & vbCrLf
End If
If Left$(Msg, 1) = Chr$(10) then
'receive the new user's user name and update the user list
lstChatUsers.List(Index - 1) = mid$(Msg, 2)
'tell the other users that the new user has signed in
for a = 1 to txtMaxUsers.Text
wsUser(a).SendData Chr$(9) & lstChatUsers.List(Index - 1) & Chr$(0)
DoEvents
next a
'write that the new user has signed in
txtOutput.Text = txtOutput.Text & lstChatUsers.List(Index - 1) & " has logged in at " & time & vbCrLf
End If
End Sub
Client:
private Sub wsChat_Connect()
'send the server the user's username
wsChat.SendData Chr$(10) & frmLogin.txtUserName.Text & Chr$(0)
End Sub
private Sub wsChat_DataArrival(byval bytesTotal as Long)
Dim PWord as string
'receive the message
wsChat.GetData Msg, vbString
'split the message to make sure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'check to see what kind of message it is
'password command or right/wrong password msg
If Left$(Msg, 1) = Chr$(33) then
wsChat.SendData Chr$(32) & frmLogin.txtPassword.Text & Chr$(0)
DoEvents
ElseIf Left$(Msg, 1) = Chr$(34) then
If count1 = "1" then
else
PWord = mid$(Msg, 2, 13)
If PWord = "RIGHTPASSWORD" then
wsChat.SendData Chr$(92) & "CMDPORT" & Chr$(0)
MsgBox ("Your password was correct!")
count1 = "1"
ElseIf PWord = "WRONGPASSWORD" then
wsChat.Close
MsgBox ("Access denied: Invalid password")
End
End If
End If
End If
'invalid username msg
If Left$(Msg, 1) = Chr$(38) then
wsChat.Close
MsgBox ("Access denied: Invalid username")
End
End If
'port message
If Left$(Msg, 1) = Chr$(23) then
If wsClient.State <> sckClosed then
wsClient.Close
End If
If count1 = "12" then
else
wsClient.RemoteHost = frmLogin.txtIP.Text
wsClient.RemotePort = mid$(Msg, 2, 4)
wsClient.Connect
wsChat.Close
DoEvents
count1 = "12"
End If
End If
End Sub
private Sub wsClient_Connect()
txtOutput.Text = txtOutput.Text & "Connected to the server" & vbCrLf
wsClient.SendData Chr$(10) & frmLogin.txtUserName.Text & Chr$(0)
DoEvents
End Sub
private Sub wsClient_DataArrival(byval bytesTotal as Long)
'variables
Dim Msg as string
Dim SplitMsg() as string
'receive the message
wsClient.GetData Msg, vbString
'split the message to ensure no messages will overlap
SplitMsg = Split(Msg, Chr$(0))
'data is a text message
If Left$(Msg, 1) = Chr$(8) then
Msg = Replace(Msg, Chr$(8), "")
txtOutput.Text = txtOutput.Text & Msg & vbCrLf
End If
'data is a login of a new user
If Left$(Msg, 1) = Chr$(9) then
Msg = Replace(Msg, Chr$(9), "")
Msg = Replace(Msg, Chr$(0), "")
txtOutput.Text = txtOutput.Text & Msg & " has logged on!" & vbCrLf
End If
'data is a log off of a user
If Left$(Msg, 1) = Chr$(10) then
Msg = Replace(Msg, Chr$(10), "")
Msg = Replace(Msg, Chr$(0), "")
txtOutput.Text = txtOutput.Text & Msg & " has logged on!" & vbCrLf
End If
End Sub