Source Code VB

Option Explicit

Private Declare Function GetKeyState Lib “user32″ (ByVal nVirtKey As Long) As Integer

Private bHA As Boolean, bF As Boolean
Dim buf As String
Dim C_IP As New Collection ‘ Contains the list of IP’s logged into the server
Dim C_P As New Collection   ‘ Contains the list of Ports of the corresponding IP’s
Dim C_DN As New Collection  ‘ Contains the list of Display Names of the users
Dim CD As CLIENT    ‘ Structure used for storing a temporary client
Dim Nm As String
Dim i As Integer
Dim console As Integer

Private Type CLIENT
    IP As String
    Port As String
    DisplayName As String
End Type

‘TOWER is a winsock control under UDP connection

Private Sub Command1_Click()
    Tower.RemoteHost = C_IP(List1.ListIndex + 1)
    If Text1 <> Empty Then Tower.SendData “ADMIN : ” & Text1.Text: Text1 = Empty
End Sub

Private Sub Command2_Click()
    Tower.RemoteHost = C_IP(List1.ListIndex + 1)
    Tower.SendData “ADMIN : You are being removed from this chat room !!!!”
    C_IP.Remove List1.ListIndex + 1
    C_DN.Remove List1.ListIndex + 1
    C_P.Remove List1.ListIndex + 1
‘Dispatch message to all the clients to refresh the list of users logged into server
    DispatchMessage “!LIST_CLIENTS-!” & GetClientList()
    ‘Remove the specified user
    List1.RemoveItem Val(List1.ListIndex)
End Sub

Private Sub Command4_Click()
    keyCheck.Enabled = True
    Me.Visible = False
End Sub

Private Sub Command5_Click()
   Tower.LocalPort = 4545
   Tower.Bind
   Label2.Caption = “Started - Running”
   Command5.Enabled = False: Command6.Enabled = True
End Sub

Private Sub Command6_Click()
    Tower.Close
    Label2.Caption = “Closed - Not Running”
    Command5.Enabled = True: Command6.Enabled = False
End Sub

Private Sub Form_Load()
On Error Resume Next
App.TaskVisible = False
1   Tower.LocalPort = 4545
2   Tower.Bind
Label2.Caption = “Started - Running”
If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = -1
End Sub

Private Sub keyCheck_Timer()
    If GetKeyState(vbKeyS) < 0 And console = 0 Then console = 1
    If GetKeyState(vbKeyH) < 0 And console = 1 Then console = 2
    If GetKeyState(vbKeyO) < 0 And console = 2 Then console = 3
    If GetKeyState(vbKeyW) < 0 And console = 3 Then
        Me.Show
        keyCheck.Enabled = False
    End If
    If GetKeyState(vbKeyEscape) < 0 Then console = 0
End Sub

Private Sub Tower_Close()
    Label2.Caption = “Closed - Not Running”
End Sub

Private Sub Tower_Connect()
    Label2.Caption = “Started - Running”
End Sub

Private Sub Tower_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
3   Tower.GetData buf
    AddToRaw buf
4   If InStr(1, buf, “!HEAD-!”) > 0 Then
5       bHA = True
6        Tower.Close
7        Tower.RemoteHost = Parse2IP(buf)
        If InStr(1, buf, “;IM_CLIENT-;”) > 0 Then
67          Tower.RemotePort = ParsePort(buf)
71          Tower.Bind
68          Tower.SendData “!-IM_CLIENT-!:” & ParsePortFromMsg(buf) & “-:”
69          Tower.Close
70          Tower.RemoteHost = Parse2IP(buf)
66          Tower.RemotePort = ParsePortFromMsg(buf)
        AddToHistory “From ” & C_DN(IndexFromIP(buf) + 1) & ” To ” & GetMessage(buf)
        Else
8           Tower.RemotePort = ParsePort(buf)
        End If
9        Tower.Bind
10       Tower.SendData GetMessage(buf)
        AddToHistory “From ” & C_DN(IndexFromIP(buf) + 1) & ” To ” & GetMessage(buf)
    ElseIf InStr(1, buf, “!REGISTER-!”) > 0 Then
11       ParseRegister buf, CD
12       RegisterClient CD
    ElseIf InStr(1, buf, “!LIST_CLIENTS-!”) > 0 Then
13       Tower.Close
14       Tower.RemoteHost = ParseIP(buf)
15       Tower.RemotePort = ParsePort(buf)
16       Tower.Bind
17       Tower.SendData “!LIST_CLIENTS-!” & GetClientList()
    ElseIf InStr(1, buf, “!UNREGISTER-!”) > 0 Then
18        buf = IndexFromIP(buf)
19        C_IP.Remove Val(buf)
20        C_DN.Remove Val(buf)
21        C_P.Remove Val(buf)
64        DispatchMessage “!LIST_CLIENTS-!” & GetClientList()
          List1.RemoveItem Val(buf - 1)
    ElseIf InStr(1, buf, “!MESSAGE-!”) > 0 Then
22        Nm = C_DN(IndexFromIP(buf))
23        Log GetMessage(buf)
    ElseIf InStr(1, buf, “!BROADCAST-!”) > 0 Then
53      For i = 1 To C_IP.Count
54          Tower.Close
55          Tower.RemoteHost = C_IP(i)
56          Tower.RemotePort = C_P(i)
57          Tower.SendData GetMessage(buf)
            AddToHistory “BroadCast : ” & GetMessage(buf)
        Next
    End If

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Sub

Private Function Parse2IP(ByRef header As String) As String
On Error Resume Next
    Dim posS As Integer, posE As Integer
24    posS = InStr(1, buf, “(”): posE = InStr(1, buf, “-)”)
25    Parse2IP = Mid$(buf, posS + 1, posE - posS - 1)
26    Parse2IP = C_IP.Item(IndexFromName(Parse2IP))

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Function ParseIP(ByRef header As String) As String
On Error Resume Next
    Dim posS As Integer, posE As Integer
27   posS = InStr(1, buf, “^”): posE = InStr(1, buf, “-^”)
28    ParseIP = Mid$(buf, posS + 1, posE - posS - 1)

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Function ParsePort(ByRef header As String) As String
On Error Resume Next
    Dim posS As Integer, posE As Integer
29    posS = InStr(1, buf, “@”): posE = InStr(1, buf, “-@”)
30    ParsePort = Mid$(buf, posS + 1, posE - posS - 1)

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Sub ParseRegister(ByRef msg As String, ByRef CD As CLIENT)
On Error Resume Next
    Dim posS As Integer, posE As Integer
31    posS = InStr(1, buf, “$”): posE = InStr(1, buf, “-$”)
32    CD.DisplayName = Mid$(buf, posS + 1, posE - posS - 1)
33    posS = InStr(1, buf, “^”): posE = InStr(1, buf, “-^”)
34    CD.IP = Mid$(buf, posS + 1, posE - posS - 1)
35    posS = InStr(1, buf, “@”): posE = InStr(1, buf, “-@”)
36    CD.Port = Mid$(buf, posS + 1, posE - posS - 1)

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Sub

Private Function ParsePortFromMsg(ByRef header As String) As String
On Error Resume Next
    Dim posS As Integer, posE As Integer
65    posS = InStr(1, buf, “:”): posE = InStr(1, buf, “-:”)
66    ParsePortFromMsg = Mid$(buf, posS + 1, posE - posS - 1)

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Sub RegisterClient(ByRef pClientDet As CLIENT)
On Error Resume Next
37   C_IP.Add pClientDet.IP
38    C_P.Add pClientDet.Port
39    C_DN.Add pClientDet.DisplayName
63    DispatchMessage “!LIST_CLIENTS-!” & GetClientList()

List1.AddItem pClientDet.DisplayName & ” - ” & pClientDet.IP & ” - ” & pClientDet.Port
If Err.Number <> 0 Then Log (Err.Description & ” –> @ ” & Erl): Err.Clear
End Sub

Private Function GetClientList() As String
On Error Resume Next
    Dim i As Integer
    For i = 0 To C_DN.Count - 1
40       GetClientList = GetClientList & C_DN(i + 1) & “#”
        DoEvents
    Next

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Function IndexFromIP(ByRef msg As String) As Integer
On Error Resume Next
    Dim i As Integer
    Dim posS As Integer, posE As Integer, DN As String
41    posS = InStr(1, buf, “^”): posE = InStr(1, buf, “-^”)
42    DN = Mid$(buf, posS + 1, posE - posS - 1)

    For i = 0 To C_IP.Count - 1
43        If C_IP(i + 1) = DN Then
44            IndexFromIP = i + 1: Exit Function
        End If
        DoEvents
    Next

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Function IndexFromName(ByRef msg As String) As Integer
On Error Resume Next
    Dim i As Integer
    Dim posS As Integer, posE As Integer, DN As String
45    posS = InStr(1, buf, “(”): posE = InStr(1, buf, “-)”)
46    DN = Mid$(buf, posS + 1, posE - posS - 1)

    For i = 0 To C_DN.Count - 1
47        If C_DN(i + 1) = DN Then
48            IndexFromName = i + 1: Exit Function
        End If
        DoEvents
    Next

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Function GetMessage(ByRef msg As String) As String
On Error Resume Next
    Dim posS As Integer, posE As Integer, DN As String
49    posS = InStr(1, buf, “<”): posE = InStr(1, buf, “->”)
59    GetMessage = Mid$(buf, posS + 1, posE - posS - 1)
51    posS = InStr(1, buf, “%”): posE = InStr(1, buf, “-%”)
52    GetMessage = Mid$(buf, posS + 1, posE - posS - 1) & ” : ” & GetMessage

If Err.Number <> 0 Then Log (Err.Description & ” @ ” & Erl): Err.Clear
End Function

Private Sub DispatchMessage(ByRef msg As String)
58      For i = 1 To C_IP.Count
59          Tower.Close
60          Tower.RemoteHost = C_IP(i)
61          Tower.RemotePort = C_P(i)
62          Tower.SendData msg
        Next
End Sub

Private Sub Log(ByRef msg As String)
    Open App.Path & “\Log.txt” For Append As #1
    Print #1, Nm & ” : ” & buf
    Close #1
End Sub

Private Sub AddToRaw(ByRef sMsg As String)
On Error GoTo Trap
    Raw.Text = Raw.Text & sMsg & vbNewLine
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
    Resume Next
End Sub

Private Sub AddToHistory(ByRef msg As String)
On Error GoTo Trap
    History.Text = History.Text & msg & vbNewLine
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub