by messofflame (1 Submission)
Category: Internet/HTML
Compatability: VB.NET
Difficulty: Unknown Difficulty
Originally Published: Sun 4th December 2011
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Chat code
VBcoders
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]
