Speed up password cracker in Excel ?

A

Aalt

Hello,

I have made a password cracker for Excel, which gives the password to
unprotect a sheet. It works up to a 12 position password by trying all the
options. The problem is that it take too much time.

Does anybody know how to speed up this macro ?

Greetings,
Aalt
=======================================================
Option Explicit
Public win_a As String
Public win_b As String
Public passo As String
Public Const A_MAX As Integer = 110
Public Const B_MAX As Integer = 36

Sub SH_openen()
'=Dimensioning
Dim tel_01 As Integer
Dim tel_02 As Integer
Dim tel_03 As Integer
Dim tel_04 As Integer
Dim tel_05 As Integer
Dim tel_06 As Integer
Dim tel_07 As Integer
Dim tel_08 As Integer
Dim tel_09 As Integer
Dim tel_10 As Integer
Dim tel_11 As Integer
Dim tel_12 As Integer
Dim ZZ(1 To 110) As String
Dim file_name As String
Dim sheet_name As String
'= Configuration
win_a = ActiveWorkbook.Name
Worksheets("SH_Open").Range("C7").ClearContents
file_name = Worksheets("SH_Open").Range("C5").Value
sheet_name = Worksheets("SH_Open").Range("C6").Value
Worksheets("SH_Open").Range("C9").Value = Now()
ZZ(1) = "a"
ZZ(2) = "b"
ZZ(3) = "c"
ZZ(4) = "d"
ZZ(5) = "e"
ZZ(6) = "f"
ZZ(7) = "g"
ZZ(8) = "h"
ZZ(9) = "i"
ZZ(10) = "j"
ZZ(11) = "k"
ZZ(12) = "l"
ZZ(13) = "m"
ZZ(14) = "n"
ZZ(15) = "o"
ZZ(16) = "p"
ZZ(17) = "q"
ZZ(18) = "r"
ZZ(19) = "s"
ZZ(20) = "t"
ZZ(21) = "u"
ZZ(22) = "v"
ZZ(23) = "w"
ZZ(24) = "x"
ZZ(25) = "y"
ZZ(26) = "z"
ZZ(27) = "A"
ZZ(28) = "B"
ZZ(29) = "C"
ZZ(30) = "D"
ZZ(31) = "E"
ZZ(32) = "F"
ZZ(33) = "G"
ZZ(34) = "H"
ZZ(35) = "I"
ZZ(36) = "J"
ZZ(37) = "K"
ZZ(38) = "L"
ZZ(39) = "M"
ZZ(40) = "N"
ZZ(41) = "O"
ZZ(42) = "P"
ZZ(43) = "Q"
ZZ(44) = "R"
ZZ(45) = "S"
ZZ(46) = "T"
ZZ(47) = "U"
ZZ(48) = "V"
ZZ(49) = "W"
ZZ(50) = "X"
ZZ(51) = "Y"
ZZ(52) = "Z"
ZZ(53) = "0"
ZZ(54) = "1"
ZZ(55) = "2"
ZZ(56) = "3"
ZZ(57) = "4"
ZZ(58) = "5"
ZZ(59) = "6"
ZZ(60) = "7"
ZZ(61) = "8"
ZZ(62) = "9"
ZZ(63) = "'"
ZZ(64) = "-"
ZZ(65) = "!"
ZZ(66) = """"
ZZ(67) = "#"
ZZ(68) = "$"
ZZ(69) = "%"
ZZ(70) = "&"
ZZ(71) = "("
ZZ(72) = ")"
ZZ(73) = "*"
ZZ(74) = ","
ZZ(75) = "."
ZZ(76) = ":"
ZZ(77) = ";"
ZZ(78) = "?"
ZZ(79) = "@"
ZZ(80) = "["
ZZ(81) = "\"
ZZ(82) = "]"
ZZ(83) = "^"
ZZ(84) = "_"
ZZ(85) = "`"
ZZ(86) = "{"
ZZ(87) = "|"
ZZ(88) = "}"
ZZ(89) = "~"
ZZ(90) = "¦"
ZZ(91) = "¨"
ZZ(92) = "´"
ZZ(93) = "¸"
ZZ(94) = "+"
ZZ(95) = "<"
ZZ(96) = "="
ZZ(97) = ">"
ZZ(98) = "±"
ZZ(99) = "«"
ZZ(100) = "»"
ZZ(101) = "¢"
ZZ(102) = "£"
ZZ(103) = "§"
ZZ(104) = "µ"
ZZ(105) = "¼"
ZZ(106) = "½"
ZZ(107) = "¾"
ZZ(108) = "¹"
ZZ(109) = "²"
ZZ(110) = "³"
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
win_a = ActiveWorkbook.Name
Workbooks.Open Filename:=file_name
'Actie bij 1 positie
For tel_01 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_01
'Actie bij 2 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_02
Next tel_01
'Actie bij 3 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_03
Next tel_02
Next tel_01
'Actie bij 4 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 5 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04) & ZZ(tel_05)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 6 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 7 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
& ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 8 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) &
ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) & ZZ(tel_08)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 9 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) &
ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) & ZZ(tel_08)
& ZZ(tel_09)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 10 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
& ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) &
ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 11 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
For tel_11 = 1 To A_MAX
If Range("A1").Value = "Aalt"
Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) &
ZZ(tel_02) & ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
& ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10) & ZZ(tel_11)
Sheets(sheet_name).Unprotect
password:=passo
Application.StatusBar =
passo
Range("A1").Value = "Aalt"
End If
Next tel_11
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 12 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
For tel_11 = 1 To A_MAX
For tel_12 = 1 To A_MAX
If Range("A1").Value =
"Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) &
ZZ(tel_02) & ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
& ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10) & ZZ(tel_11) & ZZ(tel_12)
Application.StatusBar =
passo

Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value =
"Aalt"
End If
Next tel_12
Next tel_11
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Afronden
Application.Calculation = xlCalculationAutomatic
Calculate
Worksheets("SH_Open").Range("C10").Value = Now()
End Sub

Private Sub endings()
Application.Calculation = xlCalculationAutomatic
Calculate
win_b = ActiveWorkbook.Name
Workbooks(win_b).Close SaveChanges:=False
Windows(win_a).Activate
Worksheets("SH_Open").Range("C7").Value = passo
Worksheets("SH_Open").Range("C10").Value = Now()
End Sub
 
B

Bob Phillips

Aalt,

Brute force will always take a long time, unless you strike it lucky early
on.

If you have forgotten the password, this link http://tinyurl.com/jsjc will
take you to a recent post on the McCormick,/.McGimpsey/Harker password
cracker

--

HTH

Bob Phillips

Aalt said:
Hello,

I have made a password cracker for Excel, which gives the password to
unprotect a sheet. It works up to a 12 position password by trying all the
options. The problem is that it take too much time.

Does anybody know how to speed up this macro ?

Greetings,
Aalt
=======================================================
Option Explicit
Public win_a As String
Public win_b As String
Public passo As String
Public Const A_MAX As Integer = 110
Public Const B_MAX As Integer = 36

Sub SH_openen()
'=Dimensioning
Dim tel_01 As Integer
Dim tel_02 As Integer
Dim tel_03 As Integer
Dim tel_04 As Integer
Dim tel_05 As Integer
Dim tel_06 As Integer
Dim tel_07 As Integer
Dim tel_08 As Integer
Dim tel_09 As Integer
Dim tel_10 As Integer
Dim tel_11 As Integer
Dim tel_12 As Integer
Dim ZZ(1 To 110) As String
Dim file_name As String
Dim sheet_name As String
'= Configuration
win_a = ActiveWorkbook.Name
Worksheets("SH_Open").Range("C7").ClearContents
file_name = Worksheets("SH_Open").Range("C5").Value
sheet_name = Worksheets("SH_Open").Range("C6").Value
Worksheets("SH_Open").Range("C9").Value = Now()
ZZ(1) = "a"
ZZ(2) = "b"
ZZ(3) = "c"
ZZ(4) = "d"
ZZ(5) = "e"
ZZ(6) = "f"
ZZ(7) = "g"
ZZ(8) = "h"
ZZ(9) = "i"
ZZ(10) = "j"
ZZ(11) = "k"
ZZ(12) = "l"
ZZ(13) = "m"
ZZ(14) = "n"
ZZ(15) = "o"
ZZ(16) = "p"
ZZ(17) = "q"
ZZ(18) = "r"
ZZ(19) = "s"
ZZ(20) = "t"
ZZ(21) = "u"
ZZ(22) = "v"
ZZ(23) = "w"
ZZ(24) = "x"
ZZ(25) = "y"
ZZ(26) = "z"
ZZ(27) = "A"
ZZ(28) = "B"
ZZ(29) = "C"
ZZ(30) = "D"
ZZ(31) = "E"
ZZ(32) = "F"
ZZ(33) = "G"
ZZ(34) = "H"
ZZ(35) = "I"
ZZ(36) = "J"
ZZ(37) = "K"
ZZ(38) = "L"
ZZ(39) = "M"
ZZ(40) = "N"
ZZ(41) = "O"
ZZ(42) = "P"
ZZ(43) = "Q"
ZZ(44) = "R"
ZZ(45) = "S"
ZZ(46) = "T"
ZZ(47) = "U"
ZZ(48) = "V"
ZZ(49) = "W"
ZZ(50) = "X"
ZZ(51) = "Y"
ZZ(52) = "Z"
ZZ(53) = "0"
ZZ(54) = "1"
ZZ(55) = "2"
ZZ(56) = "3"
ZZ(57) = "4"
ZZ(58) = "5"
ZZ(59) = "6"
ZZ(60) = "7"
ZZ(61) = "8"
ZZ(62) = "9"
ZZ(63) = "'"
ZZ(64) = "-"
ZZ(65) = "!"
ZZ(66) = """"
ZZ(67) = "#"
ZZ(68) = "$"
ZZ(69) = "%"
ZZ(70) = "&"
ZZ(71) = "("
ZZ(72) = ")"
ZZ(73) = "*"
ZZ(74) = ","
ZZ(75) = "."
ZZ(76) = ":"
ZZ(77) = ";"
ZZ(78) = "?"
ZZ(79) = "@"
ZZ(80) = "["
ZZ(81) = "\"
ZZ(82) = "]"
ZZ(83) = "^"
ZZ(84) = "_"
ZZ(85) = "`"
ZZ(86) = "{"
ZZ(87) = "|"
ZZ(88) = "}"
ZZ(89) = "~"
ZZ(90) = "¦"
ZZ(91) = "¨"
ZZ(92) = "´"
ZZ(93) = "¸"
ZZ(94) = "+"
ZZ(95) = "<"
ZZ(96) = "="
ZZ(97) = ">"
ZZ(98) = "±"
ZZ(99) = "«"
ZZ(100) = "»"
ZZ(101) = "¢"
ZZ(102) = "£"
ZZ(103) = "§"
ZZ(104) = "µ"
ZZ(105) = "¼"
ZZ(106) = "½"
ZZ(107) = "¾"
ZZ(108) = "¹"
ZZ(109) = "²"
ZZ(110) = "³"
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
win_a = ActiveWorkbook.Name
Workbooks.Open Filename:=file_name
'Actie bij 1 positie
For tel_01 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_01
'Actie bij 2 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_02
Next tel_01
'Actie bij 3 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_03
Next tel_02
Next tel_01
'Actie bij 4 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 5 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04) & ZZ(tel_05)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 6 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 7 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
& ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 8 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) &
ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) & ZZ(tel_08)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 9 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) &
ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) & ZZ(tel_08)
& ZZ(tel_09)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 10 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
& ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) &
ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 11 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
For tel_11 = 1 To A_MAX
If Range("A1").Value = "Aalt"
Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) &
ZZ(tel_02) & ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
& ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10) & ZZ(tel_11)
Sheets(sheet_name).Unprotect
password:=passo
Application.StatusBar =
passo
Range("A1").Value = "Aalt"
End If
Next tel_11
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 12 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
For tel_11 = 1 To A_MAX
For tel_12 = 1 To A_MAX
If Range("A1").Value =
"Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) &
ZZ(tel_02) & ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
& ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10) & ZZ(tel_11) & ZZ(tel_12)
Application.StatusBar =
passo

Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value =
"Aalt"
End If
Next tel_12
Next tel_11
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Afronden
Application.Calculation = xlCalculationAutomatic
Calculate
Worksheets("SH_Open").Range("C10").Value = Now()
End Sub

Private Sub endings()
Application.Calculation = xlCalculationAutomatic
Calculate
win_b = ActiveWorkbook.Name
Workbooks(win_b).Close SaveChanges:=False
Windows(win_a).Activate
Worksheets("SH_Open").Range("C7").Value = passo
Worksheets("SH_Open").Range("C10").Value = Now()
End Sub
Click to expand...
 
L

LowBall

Hi, I use the following code to break worksheet passwords
(picked it up on this newsgroup) it seems to run fairly
fast. What i'm looking for now is a way of cracking
worksheet passwords, could your code be addapted to do
that?

Sub PasswordBreaker()
'Author unknown
'Breaks worksheet password protection.
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j)
& _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) &
_
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
 
A

Aalt

Thanks LowBall and Bob Philips.

I send you my addapted code of cracking a worksheet passwords. In the
meaning of a password which you have to give to open a workbook which is
password protected.
It is not very fast but it works.


Option Explicit
Public win_a As String
Public win_b As String
Public passo As String


Sub WB_openen()
'Dimensioning
Dim tel_01 As Integer
Dim tel_02 As Integer
Dim tel_03 As Integer
Dim tel_04 As Integer
Dim tel_05 As Integer
Dim tel_06 As Integer
Dim tel_07 As Integer
Dim tel_08 As Integer
Dim tel_09 As Integer
Dim tel_10 As Integer
Dim tel_11 As Integer
Dim tel_12 As Integer
Dim ZZ(1 To 110) As String
Dim file_name As String
Dim is_active As String
'Configuration
win_a = ActiveWorkbook.Name
Worksheets("WB_Open").Range("C7").ClearContents
file_name = Worksheets("WB_Open").Range("C5").Value
is_active = Worksheets("WB_Open").Range("C6").Value
Worksheets("WB_Open").Range("C9").Value = Now()
ZZ(1) = "a"
ZZ(2) = "b"
ZZ(3) = "c"
ZZ(4) = "d"
ZZ(5) = "e"
ZZ(6) = "f"
ZZ(7) = "g"
ZZ(8) = "h"
ZZ(9) = "i"
ZZ(10) = "j"
ZZ(11) = "k"
ZZ(12) = "l"
ZZ(13) = "m"
ZZ(14) = "n"
ZZ(15) = "o"
ZZ(16) = "p"
ZZ(17) = "q"
ZZ(18) = "r"
ZZ(19) = "s"
ZZ(20) = "t"
ZZ(21) = "u"
ZZ(22) = "v"
ZZ(23) = "w"
ZZ(24) = "x"
ZZ(25) = "y"
ZZ(26) = "z"
ZZ(27) = "A"
ZZ(28) = "B"
ZZ(29) = "C"
ZZ(30) = "D"
ZZ(31) = "E"
ZZ(32) = "F"
ZZ(33) = "G"
ZZ(34) = "H"
ZZ(35) = "I"
ZZ(36) = "J"
ZZ(37) = "K"
ZZ(38) = "L"
ZZ(39) = "M"
ZZ(40) = "N"
ZZ(41) = "O"
ZZ(42) = "P"
ZZ(43) = "Q"
ZZ(44) = "R"
ZZ(45) = "S"
ZZ(46) = "T"
ZZ(47) = "U"
ZZ(48) = "V"
ZZ(49) = "W"
ZZ(50) = "X"
ZZ(51) = "Y"
ZZ(52) = "Z"
ZZ(53) = "0"
ZZ(54) = "1"
ZZ(55) = "2"
ZZ(56) = "3"
ZZ(57) = "4"
ZZ(58) = "5"
ZZ(59) = "6"
ZZ(60) = "7"
ZZ(61) = "8"
ZZ(62) = "9"
ZZ(63) = "'"
ZZ(64) = "-"
ZZ(65) = "!"
ZZ(66) = """"
ZZ(67) = "#"
ZZ(68) = "$"
ZZ(69) = "%"
ZZ(70) = "&"
ZZ(71) = "("
ZZ(72) = ")"
ZZ(73) = "*"
ZZ(74) = ","
ZZ(75) = "."
ZZ(76) = ":"
ZZ(77) = ";"
ZZ(78) = "?"
ZZ(79) = "@"
ZZ(80) = "["
ZZ(81) = "\"
ZZ(82) = "]"
ZZ(83) = "^"
ZZ(84) = "_"
ZZ(85) = "`"
ZZ(86) = "{"
ZZ(87) = "|"
ZZ(88) = "}"
ZZ(89) = "~"
ZZ(90) = "¦"
ZZ(91) = "¨"
ZZ(92) = "´"
ZZ(93) = "¸"
ZZ(94) = "+"
ZZ(95) = "<"
ZZ(96) = "="
ZZ(97) = ">"
ZZ(98) = "±"
ZZ(99) = "«"
ZZ(100) = "»"
ZZ(101) = "¢"
ZZ(102) = "£"
ZZ(103) = "§"
ZZ(104) = "µ"
ZZ(105) = "¼"
ZZ(106) = "½"
ZZ(107) = "¾"
ZZ(108) = "¹"
ZZ(109) = "²"
ZZ(110) = "³"
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Actie bij 1 positie
For tel_01 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_01
'Actie bij 2 posities
For tel_01 = 1 To 110
For tel_02 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_02
Next tel_01
'Actie bij 3 posities
For tel_01 = 1 To 110
For tel_02 = 1 To 110
For tel_03 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_03
Next tel_02
Next tel_01
'Actie bij 4 posities
For tel_01 = 1 To 110
For tel_02 = 1 To 110
For tel_03 = 1 To 110
For tel_04 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Afronden
Application.Calculation = xlCalculationAutomatic
Calculate
Worksheets("WB_Open").Range("C10").Value = Now()
End Sub

Private Sub endings()
Application.Calculation = xlCalculationAutomatic
Calculate
win_b = ActiveWorkbook.Name
Workbooks(win_b).Close SaveChanges:=False
Windows(win_a).Activate
Worksheets("WB_Open").Range("C7").Value = passo
Worksheets("WB_Open").Range("C10").Value = Now()
End Sub


========================================================
 
J

Jim Carlock

You can convert all your integers to long. Longs in VB are 32-bit
while integers are 16-bit. 32-bit codes runs a little faster when it's
all 32-bit. Not sure if it'll be enough to see but it's worth a try I
guess.

..Net VB makes an integer a 32-bit value, and a long becomes a
64-bit value. But for most current applications I think VBApp
still relies on VB 4/5/6 variable definitions.

--
Jim Carlock
http://www.microcosmotalk.com
Feel free to post back to the newsgroup!


Aalt said:
Thanks LowBall and Bob Philips.

I send you my addapted code of cracking a worksheet passwords. In the
meaning of a password which you have to give to open a workbook which is
password protected.
It is not very fast but it works.


Option Explicit
Public win_a As String
Public win_b As String
Public passo As String


Sub WB_openen()
'Dimensioning
Dim tel_01 As Integer
Dim tel_02 As Integer
Dim tel_03 As Integer
Dim tel_04 As Integer
Dim tel_05 As Integer
Dim tel_06 As Integer
Dim tel_07 As Integer
Dim tel_08 As Integer
Dim tel_09 As Integer
Dim tel_10 As Integer
Dim tel_11 As Integer
Dim tel_12 As Integer
Dim ZZ(1 To 110) As String
Dim file_name As String
Dim is_active As String
'Configuration
win_a = ActiveWorkbook.Name
Worksheets("WB_Open").Range("C7").ClearContents
file_name = Worksheets("WB_Open").Range("C5").Value
is_active = Worksheets("WB_Open").Range("C6").Value
Worksheets("WB_Open").Range("C9").Value = Now()
ZZ(1) = "a"
ZZ(2) = "b"
ZZ(3) = "c"
ZZ(4) = "d"
ZZ(5) = "e"
ZZ(6) = "f"
ZZ(7) = "g"
ZZ(8) = "h"
ZZ(9) = "i"
ZZ(10) = "j"
ZZ(11) = "k"
ZZ(12) = "l"
ZZ(13) = "m"
ZZ(14) = "n"
ZZ(15) = "o"
ZZ(16) = "p"
ZZ(17) = "q"
ZZ(18) = "r"
ZZ(19) = "s"
ZZ(20) = "t"
ZZ(21) = "u"
ZZ(22) = "v"
ZZ(23) = "w"
ZZ(24) = "x"
ZZ(25) = "y"
ZZ(26) = "z"
ZZ(27) = "A"
ZZ(28) = "B"
ZZ(29) = "C"
ZZ(30) = "D"
ZZ(31) = "E"
ZZ(32) = "F"
ZZ(33) = "G"
ZZ(34) = "H"
ZZ(35) = "I"
ZZ(36) = "J"
ZZ(37) = "K"
ZZ(38) = "L"
ZZ(39) = "M"
ZZ(40) = "N"
ZZ(41) = "O"
ZZ(42) = "P"
ZZ(43) = "Q"
ZZ(44) = "R"
ZZ(45) = "S"
ZZ(46) = "T"
ZZ(47) = "U"
ZZ(48) = "V"
ZZ(49) = "W"
ZZ(50) = "X"
ZZ(51) = "Y"
ZZ(52) = "Z"
ZZ(53) = "0"
ZZ(54) = "1"
ZZ(55) = "2"
ZZ(56) = "3"
ZZ(57) = "4"
ZZ(58) = "5"
ZZ(59) = "6"
ZZ(60) = "7"
ZZ(61) = "8"
ZZ(62) = "9"
ZZ(63) = "'"
ZZ(64) = "-"
ZZ(65) = "!"
ZZ(66) = """"
ZZ(67) = "#"
ZZ(68) = "$"
ZZ(69) = "%"
ZZ(70) = "&"
ZZ(71) = "("
ZZ(72) = ")"
ZZ(73) = "*"
ZZ(74) = ","
ZZ(75) = "."
ZZ(76) = ":"
ZZ(77) = ";"
ZZ(78) = "?"
ZZ(79) = "@"
ZZ(80) = "["
ZZ(81) = "\"
ZZ(82) = "]"
ZZ(83) = "^"
ZZ(84) = "_"
ZZ(85) = "`"
ZZ(86) = "{"
ZZ(87) = "|"
ZZ(88) = "}"
ZZ(89) = "~"
ZZ(90) = "¦"
ZZ(91) = "¨"
ZZ(92) = "´"
ZZ(93) = "¸"
ZZ(94) = "+"
ZZ(95) = "<"
ZZ(96) = "="
ZZ(97) = ">"
ZZ(98) = "±"
ZZ(99) = "«"
ZZ(100) = "»"
ZZ(101) = "¢"
ZZ(102) = "£"
ZZ(103) = "§"
ZZ(104) = "µ"
ZZ(105) = "¼"
ZZ(106) = "½"
ZZ(107) = "¾"
ZZ(108) = "¹"
ZZ(109) = "²"
ZZ(110) = "³"
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Actie bij 1 positie
For tel_01 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_01
'Actie bij 2 posities
For tel_01 = 1 To 110
For tel_02 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_02
Next tel_01
'Actie bij 3 posities
For tel_01 = 1 To 110
For tel_02 = 1 To 110
For tel_03 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_03
Next tel_02
Next tel_01
'Actie bij 4 posities
For tel_01 = 1 To 110
For tel_02 = 1 To 110
For tel_03 = 1 To 110
For tel_04 = 1 To 110
If ActiveWorkbook.Name = is_active Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04)
Workbooks.Open Filename:=file_name, password:=passo
End If
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Afronden
Application.Calculation = xlCalculationAutomatic
Calculate
Worksheets("WB_Open").Range("C10").Value = Now()
End Sub

Private Sub endings()
Application.Calculation = xlCalculationAutomatic
Calculate
win_b = ActiveWorkbook.Name
Workbooks(win_b).Close SaveChanges:=False
Windows(win_a).Activate
Worksheets("WB_Open").Range("C7").Value = passo
Worksheets("WB_Open").Range("C10").Value = Now()
End Sub


========================================================
LowBall said:
Hi, I use the following code to break worksheet passwords
(picked it up on this newsgroup) it seems to run fairly
fast. What i'm looking for now is a way of cracking
worksheet passwords, could your code be addapted to do
that?

Sub PasswordBreaker()
'Author unknown
'Breaks worksheet password protection.
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j)
& _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) &
_
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
Click to expand...
Click to expand...
 
L

LowBall

Thanks for the code, it was just what i was looking for.

I've tested Jim Carlock's suggestion about converting the
integers to long and it did run faster (about 1.5%)

cheers
 
M

Mark Bigelow

Being new at the password cracking game, I thought I'd try out your
password cracker. I set a password of asdf1234jjkl and then ran the
password cracker (after I'd modified it to work with workbooks). After
about 1 minute it said "One usable password is: AAABBBBABAAs" I
checked, and it did work! Why is that?

TIA,
Mark

---
Mark Bigelow
mjbigelow at hotmail dot com
http://hm.imperialoiltx.com

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
 
B

Bob Phillips

Mark,

Excel's password security is absolute c*!#p, and it was never designed as a
security feature, more of a annoyance to the casual observer. Whatever
characters are actually used, Excel converts that password into another
password using only a subset of letters and numbers, which is the real
underlying password. This is why brute force crackers work easily.

If you look at that password cracker, you can see that this is what it does,
brute force loops through all of those combinations, and tries it. When one
works, it tells you.

This is the Bob McCormick method, as discovered by the man in 2001 I think.
 
K

Kobayashi

Mark,

I'm very new to this so could you please advise how you modified the
code to work with workbooks?

Regards,

Adrian
 
P

Paul P

Aalt,

This is a macro that I use.


Sub SheetPassword()
ActiveSheet.Protect "", , , , True
ActiveSheet.Range("a1").Copy ActiveSheet.Range("a1")
End Sub



It has worked on all types of Worksheet password.

Good Luck

Paulp

:)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

issue running in Excel 2003, not in 97, error 9 subscript out of range 2

Top