Winsock, hvordan får jeg min server til at have flere forbindelse

Jeg har en server, hvorpå folk kan logge ind med et Klient program som opretter en forbindelse.
Hvis 1 er connected til serveren kan andre ikk komme på... Hvordan løser jeg det problem?

her er min server kode:
Dim strVersion As String
Dim strPort As String
Private Sub Form_Load()
    strVersion = 0.2
    strPort = 80
    Text1.Text = "[" & Time & "] " & "Server Application Launched " & strVersion
    Me.Caption = "Server Application " & strVersion
    Winsock.Close
    Winsock.LocalPort = strPort
    Winsock.Listen
    Text1.Text = Text1.Text & vbCrLf & "[" & Time & "] " & "Listening for Clients on port " & strPort
End Sub

Private Sub winsock_ConnectionRequest(ByVal requestID As Long)
    If Winsock.State <> sckClosed Then Winsock.Close
    Winsock.Accept requestID
   
    Me.Caption = "Server [Client Connected]"
    Text1.Text = Text1.Text & vbCrLf & "[" & Time & "] " & "Client Connected from " & Winsock.RemoteHostIP
End Sub
Private Sub winsock_Close()
    Text1.Text = Text1.Text & vbCrLf & "[" & Time & "] " & "Client Disconnected from " & Winsock.RemoteHostIP
    Winsock.Close
    Winsock.LocalPort = strPort
    Winsock.Listen
    Text1.Text = Text1.Text & vbCrLf & "[" & Time & "] " & "Countinue Listening for Clients on port " & strPort
End Sub

Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Dim arrSplit() As String
    Dim strPass As String
    Dim strUser As String
    With Winsock
        .GetData strData, vbString, bytesTotal
    End With
   
    arrSplit = Split(strData, "|")
   
    strUser = arrSplit(0)
    strPass = arrSplit(1)
        Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\data\profiles.mdb")
    Set rs = db.OpenRecordset("tblProfiles")
        rs.MoveFirst
        Do While rs.EOF = False
        If rs!User = strUser And rs!Password = strPass Then
            Winsock.SendData "ACTION001"
            Text1.Text = Text1.Text & vbCrLf & "[" & Time & "] " & "Client Logged in as " & strUser
            Exit Sub
        End If
    rs.MoveNext
    Loop
    Winsock.SendData "ERROR001"
    Text1.Text = Text1.Text & vbCrLf & "[" & Time & "] " & "Invalid login from: " & Winsock.RemoteHostIP
End Sub