Results 1 to 6 of 6
  1. #1
    Star Lounger
    Join Date
    Apr 2002
    Posts
    67
    Thanks
    0
    Thanked 0 Times in 0 Posts

    PassWord Loop (2000)

    This is more curiosity than anything else, I am trying to discover a password protecting a worksheet in a work book, with a dictionary attack. , but im having a wee bit of problem working out my loop,

    basically i want my loop to start of with one letter going through everything in the strlet array , then attempt two letters comparing each letter to a next letter, then 3, then 4 and so on up to 10 letters

    any pointers


    Sub PasswordCrackBruteForce()
    Dim strLet(61) As String
    Dim StrPass(10) As String
    Dim IntCnt(10) As Integer
    Dim IntLet As Integer
    Dim blnCrack As Boolean

    On Error GoTo errtrap:

    strLet(0) = ""
    strLet(1) = "A"
    strLet(2) = "B"
    strLet(3) = "C"
    strLet(4) = "D"
    strLet(5) = "E"
    strLet(6) = "F"
    strLet(7) = "G"
    strLet(8) = "H"
    strLet(9) = "I"
    strLet(10) = "J"
    strLet(11) = "K"
    strLet(12) = "L"
    strLet(13) = "M"
    strLet(14) = "N"
    strLet(15) = "O"
    strLet(16) = "P"
    strLet(17) = "Q"
    strLet(18) = "R"
    strLet(19) = "S"
    strLet(20) = "T"
    strLet(21) = "U"
    strLet(22) = "V"
    strLet(23) = "W"
    strLet(24) = "X"
    strLet(25) = "Y"
    strLet(26) = "Z"
    strLet(27) = "a"
    strLet(28) = "b"
    strLet(29) = "c"
    strLet(30) = "d"
    strLet(31) = "e"
    strLet(32) = "f"
    strLet(33) = "g"
    strLet(34) = "h"
    strLet(25) = "i"
    strLet(36) = "j"
    strLet(37) = "k"
    strLet(38) = "l"
    strLet(39) = "m"
    strLet(40) = "n"
    strLet(41) = "o"
    strLet(42) = "p"
    strLet(43) = "q"
    strLet(44) = "s"
    strLet(45) = "t"
    strLet(46) = "u"
    strLet(47) = "v"
    strLet(48) = "w"
    strLet(49) = "x"
    strLet(50) = "y"
    strLet(51) = "Z"
    strLet(52) = "0"
    strLet(53) = "1"
    strLet(54) = "2"
    strLet(55) = "3"
    strLet(56) = "4"
    strLet(57) = "5"
    strLet(58) = "6"
    strLet(59) = "7"
    strLet(60) = "8"
    strLet(61) = "9"

    IntCnt = 1


    Do While blnCrack = False

    StrPass(1) = IntCnt(1)
    StrPass(2) = IntCnt(2)
    StrPass(3) = IntCnt(3)
    StrPass(4) = IntCnt(4)
    StrPass(5) = IntCnt(5)
    StrPass(6) = IntCnt(6)
    StrPass(7) = IntCnt(7)
    StrPass(8) = IntCnt(8)
    StrPass(9) = IntCnt(9)
    StrPass(10) = IntCnt(10)






    Sheet1.Unprotect password:=StrPass
    Sheet1.Range("A1").Value = "BOB"

    If Sheet1.Range("A1").Value = "BOB" Then
    MsgBox "SUCCESS"
    blnCrack = True

    End If




    Loop


    errtrap:

    If Err.Number = 1004 Then
    Resume Next

    End If



    End Sub

  2. #2
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: PassWord Loop (2000)

    If you are trying to unprotect a worksheet, then there is a much faster way Here .

    If you want your method to work, then try this:

    <pre>Public Sub GetPass()
    Dim strLet(61) As String, strPass As String
    Dim I1 As Integer, I2 As Integer, I3 As Integer, I4 As Integer, I5 As Integer
    Dim I6 As Integer, I7 As Integer, I8 As Integer, I9 As Integer, I10 As Integer
    strLet(0) = ""
    strLet(1) = "A"
    strLet(2) = "B"
    strLet(3) = "C"
    strLet(4) = "D"
    strLet(5) = "E"
    strLet(6) = "F"
    strLet(7) = "G"
    strLet(8) = "H"
    strLet(9) = "I"
    strLet(10) = "J"
    strLet(11) = "K"
    strLet(12) = "L"
    strLet(13) = "M"
    strLet(14) = "N"
    strLet(15) = "O"
    strLet(16) = "P"
    strLet(17) = "Q"
    strLet(18) = "R"
    strLet(19) = "S"
    strLet(20) = "T"
    strLet(21) = "U"
    strLet(22) = "V"
    strLet(23) = "W"
    strLet(24) = "X"
    strLet(25) = "Y"
    strLet(26) = "Z"
    strLet(27) = "a"
    strLet(28) = "b"
    strLet(29) = "c"
    strLet(30) = "d"
    strLet(31) = "e"
    strLet(32) = "f"
    strLet(33) = "g"
    strLet(34) = "h"
    strLet(25) = "i"
    strLet(36) = "j"
    strLet(37) = "k"
    strLet(38) = "l"
    strLet(39) = "m"
    strLet(40) = "n"
    strLet(41) = "o"
    strLet(42) = "p"
    strLet(43) = "q"
    strLet(44) = "s"
    strLet(45) = "t"
    strLet(46) = "u"
    strLet(47) = "v"
    strLet(48) = "w"
    strLet(49) = "x"
    strLet(50) = "y"
    strLet(51) = "Z"
    strLet(52) = "0"
    strLet(53) = "1"
    strLet(54) = "2"
    strLet(55) = "3"
    strLet(56) = "4"
    strLet(57) = "5"
    strLet(58) = "6"
    strLet(59) = "7"
    strLet(60) = "8"
    strLet(61) = "9"
    On Error Resume Next
    For I10 = 0 To 61
    For I9 = 0 To 61
    For I8 = 0 To 61
    For I7 = 0 To 61
    For I6 = 0 To 61
    For I5 = 0 To 61
    For I4 = 0 To 61
    For I3 = 0 To 61
    For I2 = 0 To 61
    For I1 = 1 To 61
    strPass = strLet(I10) & strLet(I9) & _
    strLet(I8) & strLet(I7) & strLet(I6) & _
    strLet(I5) & strLet(I4) & strLet(I3) & _
    strLet(I2) & strLet(I1)
    Application.StatusBar = strPass
    Sheet1.Unprotect password:=strPass
    Sheet1.Range("A1").Value = "BOB"
    If Sheet1.Range("A1").Value = "BOB" Then
    On Error GoTo 0
    Exit Sub
    End If
    Next I1
    Next I2
    Next I3
    Next I4
    Next I5
    Next I6
    Next I7
    Next I8
    Next I9
    Next I10
    End Sub
    </pre>

    Legare Coleman

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: PassWord Loop (2000)

    I would NOT recommend running this unless you have plenty of time to kill.

    There are 7.25 x 10^17 permutations. If excel can do 1,000,000 password checks in a second (an I do NOT think that is possible) it will take 2,300 YEARS for the program to complete.

    Steve

  4. #4
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: PassWord Loop (2000)

    Time flies when you're having fun. Just think of all the information you'll have after 2,300 years!
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  5. #5
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Weert, Limburg, Netherlands
    Posts
    4,812
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: PassWord Loop (2000)

    By far the fastest method is this one:

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

    Which just proves how terribly bad MS's protection scheme is.
    Jan Karel Pieterse
    Microsoft Excel MVP, WMVP
    www.jkp-ads.com
    Professional Office Developers Association

  6. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts

    Re: PassWord Loop (2000)

    Hi Jan,

    While the method you cited may well be the fastest way of removing password protection, the link in Legare's post is probably the fasted way of finding a password. Although the password returned by that method isn't necessarily the one used to protect the worksheet (being just a string of As and Bs), a devious person could still use it to unprotect the worksheet, change it, then re-protect it with a password that is functionaly the same as the original one (ie the original password would still work).

    Cheers
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •