Подбор пароля

[MIT]

Вот появилась идея. Она заключается в том, чтобы методом перебора восстановить пароль к зашифрованной базе данных.
Есть массив байт, после расшифровки которого оттуда можно извлечь строку "passwordok". Кто может помочь?

p.s.
База данных моя, алгоритм шифрования тоже мой, программа нужна для себя чисто в учебных целях.

[RayShade]

База данных моя, алгоритм шифрования тоже мой, программа нужна для себя чисто в учебных целях.

....чтобы потом уже подобрать пароль не к своей базе....

[MIT]

Ну не знаю. Но пока только к своей

[MIT]

Да, кстати, есть дешефрующая функция , возвращающая из массива строку
Выглядит это так
dim a as new clsC,text as string,i as long

Код: Выделить всё

for i = 1 to ...
pass =
text = a.decrypt(byref textarray() as byte,pass as string)
if text = "passwordok" then ...
next i


[yaklit]

подобрать пароль методом перебора можно если он короткий, и состоит из одной группы букв (А-Я). Иначе дешифровка может занимать неделю в зависимости от длины пароля. А уж если пароль содержит что нить типа chr(2) то тогда вообще....

[MIT]

yaklit
До этого я догадался, хотя подбор 10 символьного пароля ZIP занимает 5 часов.

Кто может подсказать структуру строения циклов по переборке паролей?

[MIT]

Кстати в пароле могут быть только печатные ASCII символы, т.е. chr(2) исключен

[alibek]

yaklit, если не прекратишь флудить, отправишься в баню на пару недель.

[lister]

alibek, по-моему флудит автор вопроса и не пользуется кнопкой "правка"

А вообще, где-то готовый аналогичный софт есть. Забыл, как называется. Может и не стоит голову ломать

[zan]

MIT, вот тебе необходимо кнопкой «правка» (удалить) пользоваться.
По вопросу – если база твоя, алгоритм шифрования тоже твой, то непонятно что тебе мешает написать «дешифратор»? Берем шифрованный пароль, в цикле генерируем пароль, шифруем тем же алгоритмом, сравниваем результаты, если не подходит, идем в начало цикла, иначе выходим из цикла и показываем сгенерированный пароль.

[MIT]

zan
Усли почитать мои посты повнимательней, то можно заметить, что мне нужен именно алгоритм подбора пароля, все остальное я уже сделалlister
это не флуд, просто на некоторых форумах сообщения объединяются, если их подряд написал один автор в течении часа, так что это не ко мне.

"готовый аналогичный софт есть"
а поподробнее?

[alibek]

это не флуд, просто на некоторых форумах сообщения объединяются, если их подряд написал один автор в течении часа, так что это не ко мне.

В данном форуме это делается не автоматически, а самим пользователем, что прямо указано в правилах, которые ты должен был прочесть и с которыми согласился. Так что это к тебе.

[GSerg]

MIT, а здесь вот так. И вежливые рекомендации авторам использовать кнопку даются только первые несколько раз. Потом - закрытия, удаления и баны...

[Andrey Fedorov]

А уж если пароль содержит что нить типа chr(2) то тогда вообще....

А если байтики еще и перемешаны? Сколько перебирать будем?

[AntonGV]

Может это и не в тему, но я пользуюсь Passware Kit Enterprise v7.1.1411

Passware Kit recovers all kinds of passwords for the world's most popular office application files, including Excel, Word, WinZip, WinRar, Windows XP/2000/NT, Access, Outlook, Quicken, WordPerfect, VBA, 1-2-3, ACT!, Paradox, Organizer, Schedule, WordPro and more.

[MIT]

Andrey Fedorov
Алгоритм шифрования и расшифровки мой
Мне нужна только функция последовательного подбора пароля (которая выдает например "aaa" > "aab" > ... > "aaz" > .. > "qwe" > ... > "zzz") и все.

[yaklit]

это код для трех символов.

Код: Выделить всё

Open "C:\log.txt" For Output As #1
a = "aaa"
For b = 0 To 25
For n = 0 To 25
For i = 0 To 25
Mid(a, 3, 1) = Chr(Asc("a") + i)
Mid(a, 2, 1) = Chr(Asc("a") + n)
Mid(a, 1, 1) = Chr(Asc("a") + b)
Print #1, a
DoEvents
Next
Next
Next
Close

а потом смотри C:\log.txt
только это очень много времени занимает

[MIT]

Спасибо, но я сам кое чего написал

Код: Выделить всё

Dim tlen As Long, text_a() As Byte, j As Long, k As Long, l As Long, char As Byte, go As Byte
Dim t As String
Dim ML As Long, SS As String

Public Property Get maxlen() As Long
    maxlen = ML
End Property
Public Property Let maxlen(ByVal max_len As Long)
    ML = max_len
End Property

Public Property Get startstring() As String
    startstring = SS
End Property
Public Property Let startstring(start_string As String)
    SS = start_string
End Property

Public Function GetNextString() As String
text_a = StrConv(SS, vbFromUnicode)
tlen = Len(SS)
If tlen <= maxlen Then
    For j = tlen To 1 Step -1
        go = go + 1
        char = text_a(tlen - j)
        If char < 255 Then
            go = 54
            char = char + 1
            text_a(tlen - j) = char
            GoTo go1
        Else
            text_a(tlen - j) = 0
            go = 0
        End If
        If go = 1 Then GoTo go1
    Next
End If
For l = 1 To Len(SS)
    If Mid(SS, l, 1) = "я" Then k = k + 1
Next l
If k = Len(SS) Then SS = SS & Chr(1)

go1:
SS = StrConv(text_a, vbUnicode)
GetNextString = SS
End Function


Выдает примерно 1500 комбинаций в секунду (при использовании шифрования), но не может увеличивать длинну строки. Может кто подправит?

[yaklit]

а в файл пробовал

[MIT]

yaklit
Это ты кому и о чем?

________________________________________________
Вот, немного доделал свой класс

Код: Выделить всё

Option Explicit
Private Letter() As String

Dim tlen As Long, text_a() As Byte, j As Long, k As Long, l As Long, char As Byte, go As Byte
Dim t As String, o As Long, h As Long
Dim ML As Long, SS As String
Dim nextlevel As Byte, lenss As Long

Public Property Get maxlen() As Long
    maxlen = ML
End Property
Public Property Let maxlen(ByVal max_len As Long)
    ML = max_len
End Property

Public Property Get startstring() As String
    startstring = SS
End Property
Public Property Let startstring(start_string As String)
    SS = start_string
End Property

Public Function GetNextString() As String
If nextlevel = 1 Then
    For lenss = 1 To Len(SS) + 1
        If nextlevel = 1 Then SS = "": nextlevel = 0
        SS = SS & mChr(0)
    Next lenss
    GoTo go2
End If
Call ToArray(SS, text_a)
tlen = Len(SS)
If tlen <= maxlen Then
    For j = tlen To 1 Step -1
        go = go + 1
        char = text_a(tlen - j)
        If char < GetL - 1 Then
            go = 54
            char = char + 1
            text_a(tlen - j) = char
            GoTo go1
        Else
            text_a(tlen - j) = 0
            go = 0
        End If
        If go = 1 Then GoTo go1
    Next
End If
go1:
SS = ToString(text_a)
go2:
GetNextString = SS

For l = 1 To Len(SS)
    If Mid(SS, l, 1) = mChr(GetL - 1) Then k = k + 1
Next l
If k = Len(SS) Then nextlevel = 1
k = 0
End Function

Private Sub ToArray(Text As String, ByRef arr() As Byte)
ReDim arr(Len(Text) - 1)
For o = 0 To Len(Text) - 1
    For h = 0 To GetL - 1
        If Mid(Text, o + 1, 1) = Letter(h) Then arr(o) = h: GoTo go1
    Next h
go1:
Next o
End Sub

Private Function ToString(arr() As Byte) As String
For o = 0 To UBound(arr)
    ToString = ToString & Letter(arr(o))
Next o
End Function

Public Sub SetDict(Letters As String)
Dim i As Long, char As String
ReDim Letter(0)
For i = 1 To Len(Letters)
    char = Mid(Letters, i, 1)
    If char & Mid(Letters, i + 1, 1) <> vbCrLf Then
        If Letter(0) <> "" Then ReDim Preserve Letter(UBound(Letter) + 1)
        Letter(UBound(Letter)) = char
    Else
        i = i + 1
    End If
Next i
End Sub

Public Function GetL() As Long
    GetL = UBound(Letter) + 1
End Function

Public Function GetSL() As String
    GetSL = Letter(0)
End Function

Public Function mChr(index As Integer) As String
    mChr = Letter(index)
End Function



[|( () ( T |/| |(]

Вот тоже:

Private Sub Form_Load()
Me.Show
Dim L As Byte
Dim b() As Byte
Dim a As String
L = 3
ReDim b(L)
For i = 1 To L
a = a + Chr(0)
Next
For k = 1 To 26 ^ L
For i = 1 To L
If b(i) > 25 And i < L Then b(i + 1) = b(i + 1) + 1: b(i) = 0
Mid(a, i, 1) = Chr(Asc("a") + b(i))
Next
b(1) = b(1) + 1
List1.AddItem a
DoEvents
Next
End Sub


конечно поскромнее твоего, но работает, и довольно быстро. А что бы менять длину - просто всё это в цикал и меняешь L.

[MIT]

Подправил свой класс, см. выше

|( () ( T |/| |(
Действительно неплохо, и скорость высокая. Один минус - перебирает только маленькие англ. буквы, но это уже мелочи...

Измерил скорость - 5000-7000 комбинаций в секунду, неплохо.

[|( () ( T |/| |(]

MIT
Посторался максимально оптимезировать:

Код: Выделить всё

Dim p As Long
Private Sub Form_Load()
Me.Show
Dim L, b(), min_l, max_l As Byte
Dim a As String
min_l = 1: max_l = 4
For L = min_l To max_l
  ReDim b(L): a = ""
  For i = 1 To L
   a = a + Chr(0)
  Next
  For k = 1 To 26 ^ L
   For i = 1 To L
    If b(i) > 25 Then b(i + 1) = b(i + 1) + 1: b(i) = 0: DoEvents
    Mid(a, i, 1) = Chr(97 + b(i))
   Next
   b(1) = b(1) + 1
   p = p + 1
   Label1 = a
  Next
Next
End Sub

Private Sub Timer1_Timer()
Me.Caption = p
p = 0
End Sub


Если откомпилировать с галочкой на "Remove Array Bounds Checks", то скорость 75000, а если убрать строчку "Label1 = a", то >400000

[MIT]

|( () ( T |/| |(
Вот это внатуре КРУУУТО!!!!

[Efiop]

MIT, вот глянь 2-а метода, делал для себя, такая тема тоже интересовала.