Private Sub Cmd_Send_Click()
On Error GoTo Ex
Dim iVal As Long
If Len(Txt_Ser_Msg) > 0 Then
For iVal = 1 To Win_Server.UBound
Win_Server(iVal).SendData "Server : " + Trim(Txt_Ser_Msg.Text)
Next iVal
Txt_Show_Msg = Txt_Show_Msg + vbCrLf + "Server : " + Trim(Txt_Ser_Msg.Text)
Txt_Ser_Msg.Text = ""
End If
Exit Sub
Ex:
MsgBox "No more client available..."
End Sub
Private Sub Command1_Click()
If Lst_Usr.ListIndex <> -1 Then Win_Server_Close CInt(Mid$(Lst_Usr.List_
(Lst_Usr.ListIndex), 6, 2))
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Command1.Caption = "&Disconnect"
Command2.Caption = "&Exit"
Win_Server(0).LocalPort = 1002
Win_Server(0).Listen
'frmClient.Show
End Sub
Private Sub Txt_Ser_Msg_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call Txt_Ser_Msg_Validate(True)
End If
End Sub
Private Sub Txt_Ser_Msg_Validate(Cancel As Boolean)
Call Cmd_Send_Click
End Sub
Private Sub Win_Server_Close(Index As Integer)
Dim iVal As Long
For iVal = 1 To Win_Server.UBound
If Win_Server(iVal).State = sckConnected Then
Win_Server(iVal).SendData Win_Server(Index).RemoteHostIP_
+ " DISCONNECTED" + vbCrLf
DoEvents
End If
Next iVal
Win_Server(Index).Close
For iVal = 0 To Lst_Usr.ListCount - 1
If InStr(1, Lst_Usr.List(iVal), "User " + Format$(Index, "00"))_
<> 0 Then
Lst_Usr.RemoveItem iVal
Exit For
End If
Next iVal
If Index = Win_Server.UBound Then
Unload Win_Server(Index)
End If
End Sub
Private Sub Win_Server_ConnectionRequest(Index As Integer, ByVal requestID_
As Long)
Dim iVal As Long
Dim TotalConnect As Long
Dim Acceptor As Long
Acceptor = 0
TotalConnect = 1
For iVal = 1 To Win_Server.UBound
Select Case Win_Server(iVal).State
Case sckConnected
TotalConnect = TotalConnect + 1
Case sckClosed
Acceptor = iVal
End Select
Next iVal
If Acceptor = 0 Then Acceptor = Win_Server.Count
If Acceptor > Win_Server.UBound Then Load Win_Server(Acceptor)
With Win_Server(Acceptor)
.Accept requestID
Lst_Usr.AddItem "User " + Format$(Acceptor, "00") + " - "_
+ .RemoteHostIP
.SendData "Server hosted on " + _
Win_Server(0).LocalIP + vbCrLf + "Total sessions connected: "_
+ CStr(TotalConnect) + vbCrLf + vbCrLf
DoEvents
End With
'ANNOUNCE THE NEW CONNECTION TO EVERYONE
For iVal = 1 To Win_Server.UBound
If Win_Server(iVal).State = sckConnected And iVal <> Acceptor Then
Win_Server(iVal).SendData "From SERVER: " + Win_Server(Acceptor)._
RemoteHostIP + " has joined session." + vbCrLf
DoEvents
End If
Next iVal
' Check if the control's State is closed. If not,
' close the connection before accepting the new
' connection.
'If Win_Server(Index).State <> sckClosed Then _
'Win_Server(Index).Close
' Accept the request with the requestID
' parameter.
'Win_Server(Index).Accept requestID
End Sub
Private Sub Win_Server_DataArrival(Index As Integer, ByVal bytesTotal_
As Long)
' Declare a variable for the incoming data.
' Invoke the GetData method and set the Text
' property of a TextBox named txtOutput to
' the data.
Dim strData As String
Dim iVal As Long
Win_Server(Index).GetData strData, vbString
Win_Server(Index).Tag = Win_Server(0).Tag + strData
If InStr(1, Win_Server(Index).Tag, vbCr) Then
Win_Server(Index).SendData vbCrLf
DoEvents
'SEND THE BUFFER TO EVERYONE
For iVal = 1 To Win_Server.UBound
If Win_Server(iVal).State = sckConnected And iVal <> Index Then
Win_Server(iVal).SendData "From " + Win_Server(Index)._
RemoteHostIP + ": " + Win_Server(Index).Tag
DoEvents
End If
Next iVal
Win_Server(Index).Tag = ""
Else
'ECHO THE TEXT BACK TO THE LOCAL TERMINAL
Win_Server(Index).SendData strData
End If
' Win_Server.GetData strData
Txt_Show_Msg.Text = Txt_Show_Msg.Text + vbCrLf + strData
End Sub
Comments