Option Explicit
Private Sub Command1_Click()
On Error Resume Next
Dim ids() As String
Dim i As Integer
ids = Split(Text1.Text, "#")
List3.Clear
For i = 0 To UBound(ids)
List3.AddItem ids(i)
Label4.Caption = "All IDs : " & List3.ListCount
If Not i = 0 Then Load ws(i)
ws(i).RemoteHost = "o.nimbuzz.com"
ws(i).RemotePort = 5222
ws(i).Close
ws(i).Connect
Me.Caption = i
Next i
End Sub
Private Sub ws_Connect(Index As Integer)
ws(Index).SendData "<?xml version='1.0'?><stream:stream xml:lang='en' version='1.0' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams'>"
ws(Index).SendData "<auth id='sasl' xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='PLAIN'>" + EncodeBase64(StrConv(vbNullChar + List3.List(Index) + vbNullChar + Text2.Text, vbFromUnicode)) + "</auth>"
End Sub
Private Sub ws_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim lvlr As String
ws(Index).GetData lvlr
lvlr = Replace(lvlr, """", "'")
consol.Text = consol.Text + lvlr
DoEvents
If InStr(lvlr, "<success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>") Then
ws(Index).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(Index).SendData "<iq type='set' id='freebuzz'><bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'><resource>lvlr.lvlamal@nimbuzz.com</resource></bind></iq>"
End If
If InStr(lvlr, "<iq id='freebuzz' type='result'><bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'>") <> 0 Then
ws(Index).SendData "<iq to='nimbuzz.com' type='set' id='freebuzz'><session xmlns='urn:ietf:params:xml:ns:xmpp-session'/></iq>"
List1.AddItem (List3.List(Index))
Label2.Caption = "Connected : " & List1.ListCount
End If
If InStr(lvlr, "<failure xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>") <> 0 Then
List2.AddItem (List3.List(Index))
Label3.Caption = "Login Failed : " & List2.ListCount
End If
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 XML = Nothing
End Function
by 
