问题
I tried writing a vba password cracker code similar to the code I used to crack Excel sheet's password But I am not sure if I am doing correctly or not - when i tried this code it prompted me for password but no password was entered to the text input box.
Please suggest what I am doing wrong.
Thanks
Sub testmacro()
Dim password
Dim a, b, c, d, e, f, g, h, i, j, k, l
SendKeys "^r"
SendKeys "{PGUP}"
For a = 65 To 66
For b = 65 To 66
For c = 65 To 66
For d = 65 To 66
For e = 65 To 66
For f = 65 To 66
For g = 65 To 66
For h = 65 To 66
For i = 65 To 66
For j = 0 To 255
password = Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j)
SendKeys "{Enter}", True
MsgBox password
SendKeys password, True
SendKeys "{Enter}", True
On Error GoTo 200
MsgBox password
GoTo 300
200 password = ""
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
300 MsgBox "exited"
End Sub
回答1:
The reason your code is not executing properly is because you are attempting to execute a macro on a password protected execel file, which is not permitted. This is due to the fact that macros will not execute on an excel workbook until the password is entered - thus the prompt for a password before you can execute your macro code.
This SO article explains this as well, with greater detail: Excel VBA - Automatically Input Password
EDIT
For 2003
If you are trying to access the workbook, not the worksheet, there are a variety of ways in versions 2003 and earlier. After a quick perusual, this blogspot Code Samples entry appears to have a working version for unprotecting a 2003 workbook.
Also, on a related note, if you are stepping back even further and trying to unlock a VBA project, this SO article appears to adequately address the issue.
For 2007
If you are simply trying to "brute force" unprotect a client's workbook, a gentleman named Jason has outlined such a process in his blog.
回答2:
I successfully executed this script in Excel-2013 on a password protected workbook created in Excel 2003.
Followed the following steps:
Developer --> Record Macro (give a name, then do some clicks)
Macros --> take the macro you created for edit.
Replace the Macro with the whole function below:
Sub PasswordBreaker()
'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
回答3:
It looks like you're trying to unlock a workbook with a password to open it?
You absolutely should not be using Sendkeys for that. You should only ever use sendkeys as a last resort.
To avoid conflicts, put your code in another workbook and instead of the sendkeys use:
Workbooks.Open Filename:="C:\passtest.xls", Password:=password
If the workbook is already open and the workbook is protected or a sheet or chart use:
[object].Unprotect password
Wherew [object] is a reference to what you are trying to unprotect.
If you are trying to unlock the vba code, follow the comment by JimmyPena
Here's a reference for someone using similar code to yours for unlocking the active sheet.
回答4:
Maybe of some help?
Option Explicit
Const PWDMaxLength = 9
Const MaxTimeInSeconds = 600 ' 10 Minutes
Const PWDWindowName = "Password"
Const TargetFile = "D:\Dropbox\Excel stuff\crack\test.xls"
Const LowerCase = "abcdefghijklmnopqrstuvwxyzæøå"
Const UpperCase = "ABCDEFGHIJKLMNOPQRSTUVWXYZÆØÅ"
Const SpesChars = "+-*@#%=?!_;./"
Const Digits = "0123456789"
Dim CrackAttempt As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub BFOpen()
On Error Resume Next
Application.DisplayAlerts = False
Workbooks.Open Filename:=TargetFile
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Sub BFCrack()
'On Error Resume Next
Dim lSta, lCur As Long, test, str, PWD As String
lSta = GetTickCount()
PWD = LowerCase & UpperCase & SpesChars & Digits
CrackAttempt = 1
test = InputBox("Insert test string for brutforce if wanted" & vbCrLf & "not more than 5 characters...", "input")
SendKeys "%{TAB}", 100
Do While str <> test Or FindWindow(vbNullString, PWDWindowName) And (Len(str) < PWDMaxLength <> 0 And (lCur / 1000) < MaxTimeInSeconds)
lCur = (GetTickCount() - lSta)
If lCur Mod 250 = 0 Then Application.StatusBar = str & " " & CrackAttempt & " " & lCur
str = GBFS(PWD, CrackAttempt)
If test = "" Then SendKeys str & "{ENTER}", 1000
CrackAttempt = CrackAttempt + 1
Loop
Application.StatusBar = False
If str <> "" Then MsgBox str & " found in " & CStr((GetTickCount() - lSta) / 1000) & " seconds after " & CrackAttempt & " attempts", vbOKOnly + vbInformation, "Result"
On Error GoTo 0
End Sub
Function GBFS(ByVal inp As String, ByVal att As Long) As String
Dim Base, cal As Integer, rmi, res As Long
Base = Len(inp)
If Base < 2 Then Exit Function
rmi = att
Do While rmi > 0
res = Int(rmi / Base)
cal = rmi - (res * Base)
If cal = 0 Then
cal = Base
res = res - 1
End If
GBFS = Mid(inp, cal, 1) & GBFS
rmi = res
Loop
End Function
来源：https://stackoverflow.com/questions/11649064/excel-spreadsheet-password-cracking-using-vba