Private blnarray() As Boolean
Private Sub Command1_Click()
If Socket.Count <> 1 Then
For i = i To Socket.Count - 1
Socket(i).Close
Next i
Else
status = "Server Stopped!"
End If
End Sub
Private Sub Command2_Click()
If Socket.Count <> 1 Then
For i = 1 To Socket.Count - 1
If blnarray(i) = False Then 'Checks if the socket at index "i" is available
Socket(i).Close
Exit Sub
End If
Next i
End If
Unload All
End Sub
Private Sub Form_Load()
ReDim blnarray(0)
Socket(0).LocalPort = "22101"
Socket(0).Listen
blnarray(0) = True
End Sub
Private Sub Form_Terminate()
Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
Close
End Sub
Private Sub Socket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'Check if any free sockets
If Socket.Count <> 1 Then
For i = 1 To Socket.Count - 1
If blnarray(i) = False Then 'Checks if the socket at index "i" is available
Socket(i).Accept requestID 'Accepted connection to old but available socket
Exit Sub
End If
Next i
End If
'Only runs if no open sockets
'Increase size of blnArray
ReDim Preserve blnarray(Socket.UBound + 1)
'Load new Winsock1
Load Socket(Socket.UBound + 1)
'Accept Connection to newly created socket
Socket(Socket.UBound).Accept requestID
'Updates the Array at requested position to true stating socket is in use at theis index
blnarray(Socket.UBound) = True
'Do not worry your new Winsock1 control automatically is given an open port by the Windows OS
End Sub
Private Sub Socket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
status = "Receiving Data!"
ReDim dat(5)
Dim dat_a As String
Call Socket(Index).GetData(dat_a, vbString)
dat = Split(dat_a, ",")
status = "Data Received!"
If inarray("chat", dat) = True Then
Dim dat1 As String
dat1 = "chat," + dat(3) + "," + dat(2) + "," + dat(4)
If Socket.Count <> 1 Then
For i = 1 To Socket.Count - 1
If blnarray(i) = False Then
Socket(i).SendData (dat1)
Exit Sub
End If
Next i
End If
Else
Socket(Index).SendData "Error! You are not using the game client to access this server and port. Your IP has been logged and sent to our anti hacking group!"
'Dim dat1 As String
'dat1 = "chat," + dat(3) + "," + dat(2) + "," + dat(4)
'Socket(Index).SendData dat1
End If
End Sub
Private Sub Socket_SendComplete(Index As Integer)
status = "Pending New Connection. . ."
Socket(Index).Close
End Sub
Private Sub Socket_SendProgress(Index As Integer, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
status = "Sending Data!"
End Sub
Public Function inarray(expression As String, a As Variant) As Boolean
Dim fval As Boolean
x = 4
If x <> 1 Then
For i = 1 To x = -1
If a(i) = expression Then
inarray = True
End If
Next i
End If
End Function