web-dev-qa-db-ja.com

VBAを使用したExcelスプレッドシートのパスワードクラッキング

私はExcelシートのパスワードを解読するために使用したコードと同様の vba パスワードクラッカーコードを書いてみましたが、正しく実行しているかどうかはわかりません-このコードを試したときにパスワードの入力を求められましたが、テキスト入力ボックスにパスワードが入力されていません。

私が間違っていることを提案してください。

ありがとう

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
excelvbapassword-recovery
5
codeomnitrix

コードが正しく実行されない理由は、パスワードで保護されたexecelファイルでマクロを実行しようとしているためです。これは許可されていません。これは、パスワードが入力されるまでマクロがExcelブックで実行されないためです。したがって、マクロコードを実行する前にパスワードの入力を求められます。

このSOの記事では、これについても詳しく説明しています： Excel VBA-パスワードを自動的に入力する

編集

2003年

ワークシートではなくワークブックにアクセスしようとしている場合、バージョン2003以前にはさまざまな方法があります。簡単に調べてみると、このblogspot Code Samples エントリには、2003年のブックの保護を解除するための作業バージョンがあるようです。

また、関連する注意事項として、さらに一歩下がってVBAプロジェクトのロックを解除しようとしている場合、この SO記事 は問題に適切に対処しているように見えます。

2007年

クライアントのワークブックを単に「ブルートフォース」で保護解除しようとしている場合、ジェイソンという名前の紳士は 彼のブログでそのようなプロセスの概要を説明しています 。

7
JackOrangeLantern

Excel 2003で作成されたパスワードで保護されたブックに対して、Excel-2013でこのスクリプトを正常に実行しました。

次の手順に従いました。

開発者->マクロの記録（名前を付けてから数回クリックします）

マクロ->作成したマクロを編集用に取得します。

マクロを以下の関数全体に置き換えます。

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
4
rchacko

ブックを開くためにパスワードを使用してブックのロックを解除しようとしているようです。

あなたは絶対にそのためにSendkeysを使うべきではありません。最後の手段としてのみsendkeysを使用する必要があります。

競合を回避するには、コードを別のブックに配置し、sendkeysの代わりに次を使用します。

Workbooks.Open Filename:="C:\passtest.xls", Password:=password

ブックがすでに開いていて、ブックが保護されている場合、またはシートまたはチャートを使用する場合：

[object].Unprotect password

ここで、[オブジェクト]は、保護を解除しようとしているものへの参照です。

Vbaコードのロックを解除しようとしている場合は、JimmyPenaのコメントに従ってください

ここに参照があります アクティブシートのロックを解除するためにあなたと同様のコードを使用している人のために。

2
Daniel

多分いくつかの助けの？

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
1
wittrup