Option Explicit
Dim pin As Boolean
Private Sub Command1_Click()
ws.Close
ws.RemoteHost = "o.nimbuzz.com"
ws.RemotePort = 5222
ws.Connect
End Sub
Private Sub ws_Connect()
ws.SendData "<stream:stream to='nimbuzz.com' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams' version='1.0'>"
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ehem
Dim arash As String
ws.GetData arash
arash = Replace(arash, """", "'")
DoEvents
If InStr(arash, "<stream:features><starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/><compression xmlns='http://jabber.org/features/compress'><method>zlib</method></compression><mechanisms xmlns='urn:ietf:params:xml:ns:xmpp-sasl'><mechanism>PLAIN</mechanism><mechanism>DIGEST-MD5</mechanism></mechanisms><register xmlns='http://jabber.org/features/iq-register'/></stream:features>") <> 0 Then 'inja migim age server ye code i behemun dad ke in textai ke moshakhas kardim ham tush budan code zir ro send k.o.n be server
Label1.Caption = "conecting..."
Dim aham As String
aham = EncodeBase64(StrConv(vbNullChar + id.Text + vbNullChar + psw.Text, vbFromUnicode))
ws.SendData "<auth id='sasl2' xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='PLAIN'>" + aham + "</auth>"
End If
If InStr(arash, "<success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>") Then
Label1.Caption = " Connected "
ws.SendData "<stream:stream to='nimbuzz.com' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams' version='1.0'><xml version='1.0'></xml>"
ws.SendData "<iq type='set' id='reza'><bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'><resource>" + rec.Text + "</resource></bind></iq>"
End If
If InStr(arash, "<iq id='reza' type='result'><bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'>") <> 0 Then
Label1.Caption = "resource binded"
ws.SendData "<iq to='nimbuzz.com' type='set' id='arash'><session xmlns='urn:ietf:params:xml:ns:xmpp-session'/></iq>"
pin = True
Timer1.Enabled = True
End If
If InStr(arash, "<failure xmlns='urn:ietf:params:xml:ns:xmpp-sasl'><not-authorized/></failure>") <> 0 Then
Label1.Caption = " login failed"
End If
ehem:
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
ws.SendData "<iq to='nimbuzz.com' type='get' id='arash'><ping xmlns='urn:xmpp:ping' /></iq>"
End Sub
Private Function EncodeBase64(ByRef data() As Byte) As String
Dim xml As MSXML2.DOMDocument
Dim node As MSXML2.IXMLDOMElement
Set xml = New MSXML2.DOMDocument
Set node = xml.createElement("b64")
node.dataType = "bin.base64"
node.nodeTypedValue = data
EncodeBase64 = node.Text
Set node = Nothing
Set node = Nothing
End Function
by 
ye nigahi be kole sourcet bendaz bebin bugi chizi nadare ya codi ro ja beja jaye dg naneveshti 
ya inke hamun harfe empratoran vb6 moshkel dare remove kooon va baz install k.o.n 
shayad moshkelet z ine ke projectet ro bayad convert k.o.n.i 
che dalili didi ke ino inja bezari ???
