vb6 tcp客户端/服务器winsock我从客户端到服务器的连接有问题

Question

我从客户端到服务器的连接有问题。当来自同一IP的4个以上的人尝试连接到服务器时，客户端开始闪烁，您必须从任务管理器中结束该过程。而且还可以设置每个设备有多少个客户端。 这是一个名为Xiaspora的2d mmorpg游戏。该游戏将不会用来赚钱，只是为了与我的朋友和他们的朋友一起娱乐。

客户端winsock

Dim Reconnect As Boolean
Sub Connect()
  Dim serveraddress As String
  Dim serverport As String
  If Start.Client.State = 0 Then
    ReadInfoText serveraddress, serverport
    Start.Client.Connect serveraddress, serverport
  End If
End Sub
Sub Disconnect()
  Start.ConnectTestTimer.Enabled = False
  AddPrivChatText 3, "Disconnected... Attempting to Reconnect"
  If Reconnect = True Then
    Start.Client.Close
    Start.Client.Connect
  Else
    CloseProgram
  End If
End Sub
Sub SendMessage(Message As String)
  If Start.Client.State = 7 Then
    Start.Client.SendData Message & Chr(13)
  End If
End Sub
Sub SendChatMessage(Message As String)
  Dim check As Integer
  Dim checkmessage As String
  If Len(Message) = 0 Then Exit Sub
  If Mid(Message, 1, 4) = ":g::" Then
    SendMessage "4," & Message
    Exit Sub
  End If
  If Mid(Message, 1, 4) = ":G::" Then
    SendMessage "4," & Message
    Exit Sub
  End If
  checkmessage = Mid(Message, 1, 30)
  Do
    check = check + 1
    If Mid(checkmessage, check, 2) = "::" Then Exit Do
  Loop Until check = Len(checkmessage)
  If check = Len(checkmessage) Then
    SendMessage "4," & Message
  Else
    SendMessage "5," & Mid(Message, 1, check - 1) & "," & Mid(Message,         check + 2)
  End If
End Sub
Sub SetReloginTrue()
  Reconnect = True
End Sub
Sub SetReloginFalse()
  Reconnect = False
End Sub
Function Relogin() As Boolean
  Relogin = Reconnect
End Function

Option Explicit

Dim intWCount As Integer    'Number of winsocks in the array
Dim PacketCheck(3200) As Integer
Sub AddServerLogText(Message As String)
  'WriteSub "Winsock-addserverlogtext" & Message
  If Len(Main.ServerLogText.Text) > 15000 Then
    Main.ServerLogText.Text = Date & " " & Time & " " & Message & vbCrLf & Mid(Main.ServerLogText.Text, 1, 14000)
  Else
    Main.ServerLogText.Text = Date & " " & Time & " " & Message & vbCrLf & Main.ServerLogText.Text
  End If
End Sub
Sub StartServer()
  Dim ThePort As String
  ReadInfoText ThePort
  Main.Server(0).LocalPort = ThePort
  Main.Server(0).Listen
  AddServerLogText "Server Now Running on Port " & ThePort
End Sub

Sub CloseCon(Index As Integer)
  On Error Resume Next
  If Index = 0 Then Exit Sub
  LogOutProcedure Index
  WriteSub "Winsock-closecon"
  Main.Server(Index).Close
  Unload Main.EngageTimer(Index)
  AddServerLogText Index & ": Closed"
  PacketCheck(Index) = 0
End Sub

Sub ConnectionRequestCon(ByVal requestID As Long)
  On Error Resume Next
  Dim check As Integer
  Dim LoggedOn As Integer
  Dim NewIndex As Integer
  Dim RandomCheck As Integer
  NewIndex = GetFreeIndex
  LogOutProcedure NewIndex
  RandomizeConLandLaunch NewIndex
  Load Main.Server(NewIndex)
  Load Main.EngageTimer(NewIndex)
  Main.Server(NewIndex).Accept requestID
  AddServerLogText NewIndex & ": Connected [" & Main.Server(NewIndex).RemoteHostIP & "]"
  RandomCheck = RandomNumber(1000, 30000)
  SetConAuthNumber NewIndex, RandomCheck
  Main.Server(NewIndex).SendData "1,Welcome To Xiaspora - " & TotalLogedInUsers & " Users Online" & Chr(13) & "34," & RandomCheck & Chr(13)
  DoEvents
  Do
    check = check + 1
    If Main.Server(check).State = 7 And Main.Server(check).RemoteHostIP = Main.Server(NewIndex).RemoteHostIP Then LoggedOn = LoggedOn + 1
  Loop Until check = Main.Server.Count
  If LoggedOn >= 6 Then CloseCon NewIndex
End Sub
Function GetFreeIndex() As Integer
  WriteSub "Winsock-getfreeindex"
  On Error Resume Next
  Dim check As Long

  For check = 1 To Main.Server.Count
    If Main.Server(check).State <> 9 Then
      Main.Server(check).Close
      GetFreeIndex = check
      Exit Function
    End If
    If check > Main.Server.Count Then
      GetFreeIndex = Main.Server.Count + 1
      Exit Function
    End If
  Next

  intWCount = intWCount + 1
  GetFreeIndex = intWCount
End Function

Sub GetDataCon(Index As Integer)
  WriteSub "Winsock-getdatacon"
  Dim themax As Integer
  Dim ndata As String
  Dim check As Integer
  Dim curloc As Integer
  Main.Server(Index).GetData ndata
  Dim num As Integer
  num = FreeFile
  Open "lastpack.txt" For Output As num
  Print #num, Date & " " & Time & " " & ndata
  Close num
  themax = MaxPack(ndata)
  Do
    check = check + 1
    PacketCheck(Index) = PacketCheck(Index) + 1
    If PacketCheck(Index) = 50 Then
      CloseCon Index
      Exit Sub
    End If
    If PacketCheck(Index) < 20 Then CheckMode Index, ReadPackS(ndata, curloc)
  Loop Until check >= themax
  If themax > 1 Then PacketCheck(Index) = PacketCheck(Index) - 1
End Sub
Sub PrivMsg(ToCon As Integer, Message As String)
  WriteSub "Winsock-privmsg"
  On Error GoTo FuCK
  If ToCon = 0 Then Exit Sub
  If Main.Server(ToCon).State = 7 Then
    If GetConDebug(ToCon) = True Then AddServerLogText ToCon & ": Snt - " &    Message 'Only During Problems
    If GetConDebugFull(ToCon) = True Then WriteDebugLog ToCon, "Snt - " & Message ' If you have problems
    'AddServerLogText ToCon & ": Snt - " & Message '--Temp Debug Purposes
    Main.Server(ToCon).SendData Message & Chr(13)
    DoEvents
  End If
Exit Sub
FuCK:
  AddServerLogText ToCon & ": Snt - ERROR ERROR ERROR " & Message
  LogOutProcedure ToCon
End Sub
Sub PacketCheckReduce()
  Dim check As Integer
  Do
    check = check + 1
    If PacketCheck(check) > 0 Then PacketCheck(check) = PacketCheck(check) - 2
    If PacketCheck(check) < 0 Then PacketCheck(check) = 0
  Loop Until check >= Main.Server.Count
End Sub

服务器Winsock

Option Explicit

Dim intWCount As Integer    'Number of winsocks in the array
Dim PacketCheck(3200) As Integer
Sub AddServerLogText(Message As String)
  'WriteSub "Winsock-addserverlogtext" & Message
  If Len(Main.ServerLogText.Text) > 15000 Then
    Main.ServerLogText.Text = Date & " " & Time & " " & Message & vbCrLf &     Mid(Main.ServerLogText.Text, 1, 14000)
  Else
    Main.ServerLogText.Text = Date & " " & Time & " " & Message & vbCrLf &         Main.ServerLogText.Text
  End If
End Sub
Sub StartServer()
  Dim ThePort As String
  ReadInfoText ThePort
  Main.Server(0).LocalPort = ThePort
  Main.Server(0).Listen
  AddServerLogText "Server Now Running on Port " & ThePort
End Sub

Sub CloseCon(Index As Integer)
  On Error Resume Next
  If Index = 0 Then Exit Sub
  LogOutProcedure Index
  WriteSub "Winsock-closecon"
  Main.Server(Index).Close
  Unload Main.EngageTimer(Index)
  AddServerLogText Index & ": Closed"
  PacketCheck(Index) = 0
End Sub

Sub ConnectionRequestCon(ByVal requestID As Long)
  On Error Resume Next
  Dim check As Integer
  Dim LoggedOn As Integer
  Dim NewIndex As Integer
  Dim RandomCheck As Integer
  NewIndex = GetFreeIndex
  LogOutProcedure NewIndex
  RandomizeConLandLaunch NewIndex
  Load Main.Server(NewIndex)
  Load Main.EngageTimer(NewIndex)
  Main.Server(NewIndex).Accept requestID
  AddServerLogText NewIndex & ": Connected [" & Main.Server(NewIndex).RemoteHostIP & "]"
  RandomCheck = RandomNumber(1000, 30000)
  SetConAuthNumber NewIndex, RandomCheck
  Main.Server(NewIndex).SendData "1,Welcome To Xiaspora - " &             TotalLogedInUsers & " Users Online" & Chr(13) & "34," & RandomCheck &     Chr(13)
  DoEvents
  Do
    check = check + 1
    If Main.Server(check).State = 7 And Main.Server(check).RemoteHostIP =     Main.Server(NewIndex).RemoteHostIP Then LoggedOn = LoggedOn + 1
  Loop Until check = Main.Server.Count
  If LoggedOn >= 6 Then CloseCon NewIndex
End Sub
Function GetFreeIndex() As Integer
  WriteSub "Winsock-getfreeindex"
  On Error Resume Next
  Dim check As Long

  For check = 1 To Main.Server.Count
    If Main.Server(check).State <> 9 Then
      Main.Server(check).Close
      GetFreeIndex = check
      Exit Function
    End If
    If check > Main.Server.Count Then
      GetFreeIndex = Main.Server.Count + 1
      Exit Function
    End If
  Next
  intWCount = intWCount + 1
  GetFreeIndex = intWCount
End Function

Sub GetDataCon(Index As Integer)
  WriteSub "Winsock-getdatacon"
  Dim themax As Integer
  Dim ndata As String
  Dim check As Integer
  Dim curloc As Integer
  Main.Server(Index).GetData ndata
  Dim num As Integer
  num = FreeFile
  Open "lastpack.txt" For Output As num
  Print #num, Date & " " & Time & " " & ndata
  Close num
  themax = MaxPack(ndata)
  Do
    check = check + 1
    PacketCheck(Index) = PacketCheck(Index) + 1
    If PacketCheck(Index) = 50 Then
      CloseCon Index
      Exit Sub
    End If
    If PacketCheck(Index) < 20 Then CheckMode Index, ReadPackS(ndata,     curloc)
  Loop Until check >= themax
  If themax > 1 Then PacketCheck(Index) = PacketCheck(Index) - 1
End Sub
Sub PrivMsg(ToCon As Integer, Message As String)
  WriteSub "Winsock-privmsg"
  On Error GoTo FuCK
  If ToCon = 0 Then Exit Sub
  If Main.Server(ToCon).State = 7 Then
    If GetConDebug(ToCon) = True Then AddServerLogText ToCon & ": Snt - " &         Message 'Only During Problems
    If GetConDebugFull(ToCon) = True Then WriteDebugLog ToCon, "Snt - " &     Message ' If you have problems
    'AddServerLogText ToCon & ": Snt - " & Message '--Temp Debug Purposes
    Main.Server(ToCon).SendData Message & Chr(13)
    DoEvents
  End If
  Exit Sub
FuCK:
  AddServerLogText ToCon & ": Snt - ERROR ERROR ERROR " & Message
  LogOutProcedure ToCon
End Sub
Sub PacketCheckReduce()
  Dim check As Integer
  Do
    check = check + 1
    If PacketCheck(check) > 0 Then PacketCheck(check) = PacketCheck(check) - 2
    If PacketCheck(check) < 0 Then PacketCheck(check) = 0
  Loop Until check >= Main.Server.Count
End Sub