Source Code VB

Option Explicit

Public NickName As String

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

Private Declare Function FindWindow Lib “user32″ Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim buf As String

Private Sub Check1_Click()
On Error GoTo Trap

    BROADCAST = IIf(Check1.Value = vbChecked, True, False)
   
    Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
    Resume Next
End Sub

Private Sub Command1_Click()
On Error GoTo Trap
    If Not BROADCAST Then
        Tower.SendData “!HEAD-!@” & “<” & RTB.Text & “->(” & List1.Text & “-)@” & Tower.RemotePort & “-@%” & NickName & “-%”
        RTB.Text = Empty
    Else
        Tower.SendData “!BROADCAST-!@” & Tower.RemotePort & “-@” & “<” & RTB.Text & “->(” & Combo1.Text & “-)%” & NickName & “-%”
        RTB.Text = Empty
    End If
    Command1.Enabled = False
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub

Private Sub Form_Load()
On Error GoTo Trap
    Dim CD As CLIENT
    Tower.RemoteHost = InputBox(”Enter Server IP”)
GetName:
    NickName = InputBox(”Enter Your Nick Name”)
    If NickName = “ADMIN” Then NickName = Empty: GoTo GetName
    Tower.LocalPort = 4444
    Tower.Bind
    CD.IP = Tower.LocalIP
    CD.Port = Tower.LocalPort
    CD.DisplayName = NickName
    Register CD
    Tower.SendData “!LIST_CLIENTS-!^” & CD.IP & “-^@” & CD.Port & “-@”
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub

Private Sub Register(ByRef pCD As CLIENT)
On Error GoTo Trap
    Dim msg As String
    msg = “!REGISTER-!^” & pCD.IP & “-^@” & pCD.Port & “-@$” & pCD.DisplayName & “-$”
    Tower.SendData msg
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub

Private Function GetMessage(ByRef msg As String) As String
On Error GoTo Trap
    Dim posS As Integer, posE As Integer, DN As String
    posS = InStr(1, buf, “<”): posE = InStr(1, buf, “->”)
    GetMessage = Mid$(buf, posS + 1, posE - posS)
Exit Function
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Function

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Trap
    UnRegister
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub

Private Sub UnRegister()
On Error GoTo Trap
    Tower.SendData “!UNREGISTER-!^” & Tower.LocalIP & “-^”
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub

Private Sub RTB_Change()
    If RTB.Text = Empty Then Command1.Enabled = False Else Command1.Enabled = True
End Sub

Private Sub Tower_DataArrival(ByVal bytesTotal As Long)
On Error GoTo Trap
    buf = Empty
    Tower.GetData buf
    Dim abuf() As String, pos As Integer
    Dim posS As Integer, posE As Integer, DN As String
    If InStr(1, buf, “!LIST_CLIENTS-!”) > 0 Then
        pos = InStr(1, buf, “!-LIST_CLIENTS-!”)
        buf = Mid$(buf, Len(”!-LIST_CLIENTS-!”))
        abuf = Split(buf, “#”)
        List1.Clear
        For pos = 0 To UBound(abuf) - 1
            List1.AddItem abuf(pos)
        Next
    ElseIf InStr(1, buf, “!-IM_CLIENT-!”) > 0 Then
        posS = InStr(1, buf, “:”): posE = InStr(1, buf, “-:”)
        DN = Mid$(buf, posS + 1, posE - posS)
    Else
        AddToHistory buf
    End If
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 & vbNewLine
Exit Sub
Trap:
    If Err.Number > 0 Then MsgBox “Error : ” & Err.Number & ” ” & vbNewLine & Err.Description, vbCritical
   
    Resume Next
End Sub

 

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