Pages

Minggu, 24 Mei 2015

Google Talk XMPP VB.Net

Google Talk XMPP VB.NetBuat 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

0 komentar:

Posting Komentar