SHARE
TWEET

DewClarke_Excel Bypass

DewClarke May 16th, 2016 316 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub DewClarke_CrackPass()
  2.         Dim w1 As Worksheet, w2 As Worksheet
  3.         Dim i As Integer, j As Integer, k As Integer, l As Integer
  4.         Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
  5.         Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
  6.         Dim PWord1 As String
  7.         Dim ShTag As Boolean, WinTag As Boolean
  8.        
  9.         Application.ScreenUpdating = False
  10.         With ActiveWorkbook
  11.             WinTag = .ProtectStructure Or .ProtectWindows
  12.         End With
  13.         ShTag = False
  14.         For Each w1 In Worksheets
  15.                 ShTag = ShTag Or w1.ProtectContents
  16.         Next w1
  17.         If Not ShTag And Not WinTag Then
  18.             MsgBox MSGNOPWORDS1, vbInformation, Header
  19.             Exit Sub
  20.         End If
  21.         MsgBox MSGTAKETIME, vbInformation, Header
  22.         If Not WinTag Then
  23.             MsgBox MSGNOPWORDS2, vbInformation, Header
  24.         Else
  25.           On Error Resume Next
  26.           Do      'dummy do loop
  27.             For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
  28.             For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
  29.             For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
  30.             For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
  31.             With ActiveWorkbook
  32.               .Unprotect Chr(i) & Chr(j) & Chr(k) & _
  33.                  Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
  34.                  Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  35.               If .ProtectStructure = False And _
  36.               .ProtectWindows = False Then
  37.                   PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
  38.                     Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
  39.                     Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  40.                   MsgBox Application.Substitute(MSGPWORDFOUND1, _
  41.                         "$$", PWord1), vbInformation, Header
  42.                   Exit Do  'Bypass all for...nexts
  43.               End If
  44.             End With
  45.             Next: Next: Next: Next: Next: Next
  46.             Next: Next: Next: Next: Next: Next
  47.           Loop Until True
  48.           On Error GoTo 0
  49.         End If
  50.         If WinTag And Not ShTag Then
  51.           MsgBox MSGONLYONE, vbInformation, Header
  52.           Exit Sub
  53.         End If
  54.         On Error Resume Next
  55.         For Each w1 In Worksheets
  56.           'Attempt clearance with PWord1
  57.           w1.Unprotect PWord1
  58.         Next w1
  59.         On Error GoTo 0
  60.         ShTag = False
  61.         For Each w1 In Worksheets
  62.           'Checks for all clear ShTag triggered to 1 if not.
  63.           ShTag = ShTag Or w1.ProtectContents
  64.         Next w1
  65.         If ShTag Then
  66.             For Each w1 In Worksheets
  67.               With w1
  68.                 If .ProtectContents Then
  69.                   On Error Resume Next
  70.                   Do      'Dummy do loop
  71.                     For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
  72.                     For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
  73.                     For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
  74.                     For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
  75.                     .Unprotect Chr(i) & Chr(j) & Chr(k) & _
  76.                       Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
  77.                       Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  78.                     If Not .ProtectContents Then
  79.                       PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
  80.                         Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
  81.                         Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  82.                       MsgBox Application.Substitute(MSGPWORDFOUND2, _
  83.                             "$$", PWord1), vbInformation, Header
  84.                       'leverage finding Pword by trying on other sheets
  85.                       For Each w2 In Worksheets
  86.                         w2.Unprotect PWord1
  87.                       Next w2
  88.                       Exit Do  'Bypass all for...nexts
  89.                     End If
  90.                     Next: Next: Next: Next: Next: Next
  91.                     Next: Next: Next: Next: Next: Next
  92.                   Loop Until True
  93.                   On Error GoTo 0
  94.                 End If
  95.               End With
  96.             Next w1
  97.         End If
  98.         MsgBox ALLCLEAR & AUTHORS & Version & REPBACK, vbInformation, Header
  99.     End Sub
RAW Paste Data
Top