• Home
 · 
• Internet/HTML
 · 
• Chat code

Chat code

Chat code

Rate Chat code

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Imports System.Text
Imports System.Net
Public Class Form1
    Dim sr As IO.StringReader
    Dim users As String = Nothing
    Dim refresh1 As String = Nothing
    Dim formNo As String = Nothing
    Dim poruka As String = Nothing
    Dim br As String = Nothing
    


    Public Sub findForm1()

        If Trim(Mid(My.Forms.Private1.Text, My.Forms.Private1.Text.Length - 2)) = formNo Then
            My.Forms.Private1.RichTextBox1.Text = My.Forms.Private1.RichTextBox1.Text & poruka + vbCrLf

        ElseIf Trim(Mid(My.Forms.Private2.Text, My.Forms.Private2.Text.Length - 2)) = formNo Then
            My.Forms.Private2.RichTextBox1.Text = My.Forms.Private2.RichTextBox1.Text & poruka + vbCrLf

        Else
            If My.Forms.Private1.Visible = False Then
                Dim name As String
                For i As Integer = 1 To poruka.Length
                    If Mid(poruka, i, 2) = ": " Then
                        Exit For
                    End If
                    name = name & Mid(poruka, i, 1)
                Next
                My.Forms.Private1.Show()
                My.Forms.Private1.Text = Trim(name) & "   " & br
                My.Forms.Private1.RichTextBox1.Text = My.Forms.Private1.RichTextBox1.Text & poruka + vbCrLf
            Else
                Dim name As String
                For i As Integer = 1 To poruka.Length
                    If Mid(poruka, i, 2) = ": " Then
                        Exit For
                    End If
                    name = name & Mid(poruka, i, 1)
                Next
                My.Forms.Private2.Show()
                My.Forms.Private2.Text = Trim(name) & "   " & br
                My.Forms.Private2.RichTextBox1.Text = My.Forms.Private2.RichTextBox1.Text & poruka + vbCrLf
            End If
        End If

        formNo = Nothing
        poruka = Nothing

    End Sub
    Public Sub addUsers()
        sr = New IO.StringReader(users)
        Do Until sr.Peek < 0
            ListBox1.Items.Add(sr.ReadLine)
        Loop
        users = Nothing
    End Sub
    Public Sub refUsers()
        ListBox1.Items.Clear()
        sr = New IO.StringReader(refresh1)
        Do Until sr.Peek < 0
            ListBox1.Items.Add(sr.ReadLine)

        Loop
        refresh1 = Nothing
    End Sub
#Region "Client Code"
    Private Client As socketClient

    Private Sub clientLogMessage(ByVal Message As String)
        Delegates.RichTextBoxes.appendText(Me, rtbClient, vbCrLf & Message)
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        Try
            If Client.isConnected Then
                Client.Send("@code1842@" & txtClientName.Text)
                clientLogMessage("Odlogirani ste!")
                txtClientSend.Text = ""
            End If
        Catch ex As Exception

        End Try
        Try
            Client.Disconnect()
        Catch ex As Exception

        End Try
    End Sub

    Private Sub btnClientConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClientConnect.Click
        If InStr(txtClientName.Text, "@code1843@") > 0 Then
            MsgBox("Nickname nesmije sadržavati niz '@code1843@' !")
        ElseIf InStr(txtClientName.Text, " ") > 0 Then
            MsgBox("Nickname nesmije sadržavati razmak !")
        Else
            Client = New socketClient()

            AddHandler Client.Connected, AddressOf handleClientConnected
            AddHandler Client.ConnectionError, AddressOf handleClientConnectionError
            AddHandler Client.Disconnected, AddressOf handleClientDisconnected
            AddHandler Client.DisconnectError, AddressOf handleClientDisconnectError
            AddHandler Client.IncomingData, AddressOf handleClientIncomingData
            AddHandler Client.IncomingDataError, AddressOf handleClientIncomingDataError
            AddHandler Client.SendDataError, AddressOf handleClientSendDataError

            Client.Connect(txtClientIP.Text, txtClientPort.Text)

            '#################################### information about new user ###########################
            If Client.isConnected Then
                Client.Send("@code1843@" & txtClientName.Text)
                clientLogMessage(txtClientName.Text)
                txtClientSend.Text = ""

                txtClientIP.Enabled = False
                txtClientName.Enabled = False
                txtClientPort.Enabled = False
            End If
            '###########################################################################################
        End If
    End Sub
    '************************************************************
    'Primary Socket Functionality
    '************************************************************
    Private Sub handleClientConnected()
        clientLogMessage("Connected!")
    End Sub

    Private Sub handleClientDisconnected()
        clientLogMessage("Disconnected!")
    End Sub

    Private Sub handleClientIncomingData(ByRef Data As String)
        If InStr(Data, "@code1841@") > 0 And Data.Length > 0 Then
            Data$ = Replace(Data$, "@code1841@", "")
            users = Data
        ElseIf InStr(Data, "@code1840@") > 0 And Data.Length > 0 Then
            Data$ = Replace(Data$, "@code1840@", "")
            refresh1 = Data
        ElseIf InStr(Data, "@code1847@") > 0 And Data.Length > 0 Then
            Data$ = Replace(Data$, "@code1847@", "")
            formNo = Trim(Mid(Data, Data.Length - 2))
            poruka = Mid(Data, 1, Data.Length - 2)
            br = Trim(Mid(Data, Data.Length - 2))
        Else
            If Data.Length > 0 Then
                clientLogMessage(Data)
            End If
        End If
    End Sub


    '************************************************************
    'Functional Error Reporting (Below)
    '************************************************************
    Private Sub handleClientConnectionError(ByVal Message As String)
        clientLogMessage(Message)
    End Sub

    Private Sub handleClientDisconnectError(ByVal Message As String)
        clientLogMessage(Message)
    End Sub

    Private Sub handleClientIncomingDataError(ByVal Message As String)
        clientLogMessage(Message)
    End Sub

    Private Sub handleClientSendDataError(ByVal Message As String)
        clientLogMessage(Message)
    End Sub
#End Region

    Private Sub btnClientDisconnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClientDisconnect.Click
        Try
            If Client.isConnected Then
                Client.Send("@code1842@" & txtClientName.Text)
                clientLogMessage("Odlogirani ste!")
                txtClientSend.Text = ""
            End If
        Catch ex As Exception

        End Try

        Client.Disconnect()

        Try
            txtClientIP.Enabled = True
            txtClientName.Enabled = True
            txtClientPort.Enabled = True
        Catch ex As Exception

        End Try
        ListBox1.Items.Clear()
    End Sub

    Private Sub txtClientSend_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles txtClientSend.KeyDown
        If e.KeyCode = Keys.Enter Then
            e.Handled = True
            e.SuppressKeyPress = True
            If Client IsNot Nothing Then
                If Client.isConnected Then
                    Client.Send(txtClientName.Text & ":  " & txtClientSend.Text)
                    clientLogMessage(txtClientName.Text & ":  " & txtClientSend.Text)
                    txtClientSend.Text = ""
                End If
            End If
        End If
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        TextBox2.Text = ""
        'Declare new collection
        Dim IpCollection As New Collection

        'Retrieve IP address entries
        'To get a www address 
        Dim i As Integer

        Dim ipE As Net.IPHostEntry = System.Net.Dns.GetHostEntry(TextBox1.Text)
        Dim IpA() As Net.IPAddress = ipE.AddressList

        For i = 0 To IpA.GetUpperBound(0)
            'Add all to list
            IpCollection.Add(IpA(i).ToString)
            Try
                TextBox2.Text = TextBox2.Text & IpCollection(i) + vbCrLf

            Catch ex As Exception

            End Try

        Next
    End Sub

    Private Sub TextBox2_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox2.GotFocus
        If TextBox2.Focused = True Then
            TextBox1.Focus()
        End If
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If users <> Nothing Then
            addUsers()
        End If
        If refresh1 <> Nothing Then
            refUsers()
        End If
        If poruka <> Nothing Then
            findForm1()
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Try
            If Client.isConnected = True And ListBox1.SelectedItem.ToString <> Nothing Then
                If Private1.Visible = False Then
                    Private1.Text = ListBox1.SelectedItem.ToString
                    Private1.Show()
                Else
                    Private2.Text = ListBox1.SelectedItem.ToString
                    Private2.Show()
                End If
            End If
        Catch ex As Exception

        End Try

    End Sub
    Public Sub privatno1(ByVal br As String)

        Client.Send("@code1839@" & txtClientName.Text & ": " & Private1.TextBox1.Text & "   " & br)

        Private1.TextBox1.Text = ""

    End Sub
    Public Sub privatno2(ByVal br As String)

        Client.Send("@code1839@" & txtClientName.Text & ": " & Private2.TextBox1.Text & "   " & br)

        Private2.TextBox1.Text = ""

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        '~~~ Load the image from file
        Dim myImage As New Bitmap("C:\smile\smile.gif")
        Dim myImage2 As New Bitmap("C:\smile\smile2.gif")
        Dim myImage3 As New Bitmap("C:\smile\smile3.gif")
        Dim myImage4 As New Bitmap("C:\smile\smile4.gif")
        Dim myImage5 As New Bitmap("C:\smile\smile5.gif")
        Dim myImage6 As New Bitmap("C:\smile\smile6.gif")
        Dim myImage7 As New Bitmap("C:\smile\smile7.gif")
        Dim myImage8 As New Bitmap("C:\smile\smile8.gif")
        Dim myImage9 As New Bitmap("C:\smile\smile9.gif")
        Dim myImage10 As New Bitmap("C:\smile\smile10.gif")
        Dim myImage11 As New Bitmap("C:\smile\smile11.gif")
        Dim myImage12 As New Bitmap("C:\smile\smile12.gif")
        Dim myImage13 As New Bitmap("C:\smile\smile13.gif")
        Dim myImage14 As New Bitmap("C:\smile\smile14.gif")
        Dim myImage15 As New Bitmap("C:\smile\smile15.gif")
        Dim myImage16 As New Bitmap("C:\smile\smile16.gif")
        Dim myImage17 As New Bitmap("C:\smile\smile17.gif")
        Dim myImage18 As New Bitmap("C:\smile\smile18.gif")
        Dim myImage19 As New Bitmap("C:\smile\smile19.gif")
        Dim myImage20 As New Bitmap("C:\smile\smile20.gif")
        Dim myImage21 As New Bitmap("C:\smile\smile21.gif")

        '~~~ Check if the RichTextBox has a smiley symbol ":)"
        Do While rtbClient.Text.IndexOf(";)") > -1
            rtbClient.Find(";)")     '~~~ if so, find it

            Clipboard.SetImage(myImage) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":)") > -1
            rtbClient.Find(":)")     '~~~ if so, find it

            Clipboard.SetImage(myImage2) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":P") > -1
            rtbClient.Find(":P")     '~~~ if so, find it

            Clipboard.SetImage(myImage3) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("+o(") > -1
            rtbClient.Find("+o(")     '~~~ if so, find it

            Clipboard.SetImage(myImage4) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":-O") > -1
            rtbClient.Find(":-O")     '~~~ if so, find it

            Clipboard.SetImage(myImage5) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(R)") > -1
            rtbClient.Find("(R)")     '~~~ if so, find it

            Clipboard.SetImage(myImage6) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(N)") > -1
            rtbClient.Find("(N)")     '~~~ if so, find it

            Clipboard.SetImage(myImage7) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(Y)") > -1
            rtbClient.Find("(Y)")     '~~~ if so, find it

            Clipboard.SetImage(myImage8) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(L)") > -1
            rtbClient.Find("(L)")     '~~~ if so, find it

            Clipboard.SetImage(myImage9) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":$") > -1
            rtbClient.Find(":$")     '~~~ if so, find it

            Clipboard.SetImage(myImage10) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":'(") > -1
            rtbClient.Find(":'(")     '~~~ if so, find it

            Clipboard.SetImage(myImage11) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":S") > -1
            rtbClient.Find(":S")     '~~~ if so, find it

            Clipboard.SetImage(myImage12) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("|-)") > -1
            rtbClient.Find("|-)")     '~~~ if so, find it

            Clipboard.SetImage(myImage13) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("8-)") > -1
            rtbClient.Find("8-)")     '~~~ if so, find it

            Clipboard.SetImage(myImage14) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("*-)") > -1
            rtbClient.Find("*-)")     '~~~ if so, find it

            Clipboard.SetImage(myImage15) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("^o)") > -1
            rtbClient.Find("^o)")     '~~~ if so, find it

            Clipboard.SetImage(myImage16) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf(":-#") > -1
            rtbClient.Find(":-#")     '~~~ if so, find it

            Clipboard.SetImage(myImage17) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(^)") > -1
            rtbClient.Find("(^)")     '~~~ if so, find it

            Clipboard.SetImage(myImage18) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(})") > -1
            rtbClient.Find("(})")     '~~~ if so, find it

            Clipboard.SetImage(myImage19) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("({)") > -1
            rtbClient.Find("({)")     '~~~ if so, find it

            Clipboard.SetImage(myImage20) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        Do While rtbClient.Text.IndexOf("(8)") > -1
            rtbClient.Find("(8)")     '~~~ if so, find it

            Clipboard.SetImage(myImage21) '~~~ Copy the image to clipboard, and
            rtbClient.Paste()        '~~~ Paste it in the selection
        Loop
        '~~~ Clear the memory
        SendMessage(rtbClient.Handle, WM_VSCROLL, SB_BOTTOM, 0)

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        txtClientName.SaveFile("AccData.ACC")

    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        txtClientName.LoadFile("AccData.ACC")

    End Sub
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Int32, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    Private Const SB_TOP = 6
    Private Const SB_BOTTOM = 7
    Private Const SB_LINEUP = 0
    Private Const SB_LINEDOWN = 1
    Private Const WM_VSCROLL = &H115

End Class
[/HIGHLIGHT]