Google Talk XMPP VB.Net

Google Talk XMPP VB.Net. Buat sobat yang pengin mendapatkan project yang telah admin buat silahkan kunjungi link berikut ini google talk vb.net. Sekian dari admin, tolong bantu untuk share ke teman-teman yang lain, siapa tau akan bermanfaat juga buat mereka, dan pastinya sobat akan mendapatkan pahala juga, aamiin... :)

Google talk in VB.Net

Imports agsXMPP

Imports agsXMPP.protocol.client

Public Class Form1

    Dim objXmpp As New XmppClientConnection

    Dim Jid As Jid

    Dim Receiver As String

    Dim _wait As Boolean

    Private WithEvents TmrContact As New Timer

    Private Sub BtnLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnLogin.Click

        BtnLogin.Enabled = False

        Application.DoEvents()

        If Not LCase(txtJid.Text).Contains("@gmail.com") Then txtJid.Text &= "@gmail.com"

        Jid = New Jid(txtJid.Text)

        With objXmpp

            .Server = "gmail.com" 'Jid.Server

            .ConnectServer = "talk.google.com"

            .Username = Jid.User

            .Password = txtPassword.Text

            '.Resource = String.Empty

            '.Priority = CInt(numPriority.Value)

            '.Port = Integer.Parse(txtPort.Text)

            .AutoResolveConnectServer = True

            .UseStartTLS = True

            'If (chkRegister.Checked) Then

            '    .RegisterAccount = True

            'Else

            '    .RegisterAccount = False

            'End If

            .Open()

            AddHandler .OnAuthError, AddressOf OnAuthError

            AddHandler .OnLogin, AddressOf OnLogin

            AddHandler .OnPresence, AddressOf OnPresence

            AddHandler .OnMessage, AddressOf MsgReceived

            AddHandler .OnClose, AddressOf OnClose

            AddHandler .OnError, AddressOf OnError

        End With

    End Sub

    Private Sub OnAuthError(ByVal sender As Object, ByVal e As agsXMPP.Xml.Dom.Element)

        Control.CheckForIllegalCrossThreadCalls = False

        LblStatus.Text = "OnAuthError"

        LblStatus.ForeColor = Color.Red

    End Sub

    ' Is raised when login and authentication is finished 

    Private Sub OnLogin(ByVal sender As Object)

        Control.CheckForIllegalCrossThreadCalls = False

        _wait = False

        LblStatus.Text = "Logged In"

        LblStatus.ForeColor = Color.Green

        With TmrContact

            .Interval = 1000

            .Start()

        End With

    End Sub

    'get contacts

    Private Sub OnPresence(ByVal sender As Object, ByVal pres As Presence)

        Control.CheckForIllegalCrossThreadCalls = False

        'If LBContacts.Items.Count = 0 Then

        LBContacts.Items.Add(pres.From.User & "@" & pres.From.Server)

        '    Return

        'End If

    End Sub

    Private Sub ShowMsg(ByVal Text As String)

        Control.CheckForIllegalCrossThreadCalls = False

        TxtMsgIn.Text = TxtMsgIn.Text.Insert(0, Text & vbCrLf & vbCrLf)

    End Sub

    Private Sub MsgReceived(ByVal sender As Object, ByVal msg As Message)

        Dim arrUser() As String

        arrUser = msg.From.ToString.Split("/")

        Receiver = arrUser(0)

        If msg.Body = "" Then Return

        ShowMsg(Receiver & " <" & Now & "> :" & vbCrLf & msg.Body)

        Me.Focus()

        ''======================

        ''BUAT AUTO REPLY

        'Dim chatMessage() As String

        'chatMessage = msg.From.ToString.Split("/")

        'jid = New Jid(chatMessage(0))

        'Dim autoReply As Message

        'autoReply = New Message(jid, MessageType.chat, txtMsgOut.Text & " : http://gtalkautoreply.codeplex.com/")

        'objXmpp.Send(autoReply)

        ''======================

    End Sub

    Private Sub OnClose(ByVal sender As Object)

        Control.CheckForIllegalCrossThreadCalls = False

        LblStatus.Text = "Logout"

        LblStatus.ForeColor = Color.Red

    End Sub

    Private Sub OnError(ByVal sender As Object, ByVal ex As Exception)

        Control.CheckForIllegalCrossThreadCalls = False

        LblStatus.Text = "OnError"

        LblStatus.ForeColor = Color.Red

    End Sub

    Private Sub TmrContact_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TmrContact.Tick

        TmrContact.Stop()

        AddHandler objXmpp.OnPresence, AddressOf OnPresence

        TmrContact.Start()

    End Sub

    Private Sub BtnLogout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnLogout.Click

        objXmpp.Close()

        LBContacts.Items.Clear()

        TxtMsgIn.Clear()

        TxtTo.Clear()

        TxtMsgOut.Clear()

        BtnLogin.Enabled = True

    End Sub

    Private Sub BtnSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnSend.Click

        Try

            objXmpp.Send(New Message(New Jid(TxtTo.Text), MessageType.chat, TxtMsgOut.Text))

            ShowMsg(txtJid.Text & " <" & Now & "> :" & vbCrLf & TxtMsgOut.Text)

        Catch ex As Exception

            MsgBox(ex.Message, MsgBoxStyle.Critical, Text)

        End Try

    End Sub

    Private Sub LBContacts_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles LBContacts.DoubleClick

        TxtTo.Text = LBContacts.SelectedItem

        TxtMsgOut.Focus()

    End Sub

End Class