穷举破解EXCEL、WORD文档密码

(*.doc)*.xls;*.doc
20      Label      Name=Label1， Caption=破解进度：
21      Label      Name=Label3，Caption=从：
22      Label      Name=Label5，Caption=到：

⑶ 为以上对象编写下列代码
为了便于理解，程序中增加了适当的注释。
Option Explicit
Private Sub CmdBrowse_Click()
    Dialog.ShowOpen 'show the dialog
    Combo1.Text = Dialog.FileName   'set the Filename text box to the selected file
    Combo1.Refresh
End Sub

Private Sub CmdQuit_Click()
    End
End Sub

Private Sub CmdStartCrack_Click()
    Static blnProcessing As Boolean
    Dim wd As New Word.Application, xls As New Excel.Application
    Dim OpenReturn
    Dim strpath, pass, StrTemp, all_char(100) As String
    Dim J, K, Password_Start_Long, Password_End_Long, ArrayLen As Integer
    Dim I, Temp As Long
    ArrayLen = 0    '数组初始化
    If ChkDigital.Value = 1 Then
        For J = ArrayLen To ArrayLen + 9
            all_char(J) = Chr(Asc("0") + J - ArrayLen)
        Next J
        ArrayLen = ArrayLen + 10
    End If
    If ChkLowercase.Value = 1 Then
        For J = ArrayLen To ArrayLen + 25
            all_char(J) = Chr(Asc("a") + J - ArrayLen)
        Next J
        ArrayLen = ArrayLen + 26
    End If
    If ChkUppercase.Value = 1 Then
        For J = ArrayLen To ArrayLen + 25
            all_char(J) = Chr(Asc("A") + J - ArrayLen)
        Next J
        ArrayLen = ArrayLen + 26
    End If
    If ChkSpace.Value = 1 Then
        all_char(ArrayLen) = " "
        ArrayLen = ArrayLen + 1
    End If
    If ChkBracket.Value = 1 Then
        all_char(ArrayLen) = "("
        all_char(ArrayLen+1) = ")"
        all_char(ArrayLen+2) = "{"
        all_char(ArrayLen+3) = "}"
        all_char(ArrayLen+4) = "["
        all_char(ArrayLen+5) = "]"
        ArrayLen = ArrayLen + 6
    End If
    If ChkOthers.Value = 1 Then
        For J = ArrayLen To ArrayLen + 6    '33 to 39
            all_char(J) = Chr(33 + J - ArrayLen)
        Next
      ArrayLen = ArrayLen + 7
        For J = ArrayLen To ArrayLen + 5    '42 to 47
            all_char(J) = Chr(42 + J - ArrayLen)
        Next J
        ArrayLen = ArrayLen + 6
        For J = ArrayLen To ArrayLen + 6    '58 to 64
            all_char(J) = Chr(58 + J - ArrayLen)
        Next J
        ArrayLen = ArrayLen + 7
        all_char(ArrayLen) = Chr(92)
        ArrayLen = ArrayLen + 1
        For J = ArrayLen To ArrayLen + 2    '94 to 96
            all_char(J) = Chr(94 + J - ArrayLen)
        Next J
        ArrayLen = ArrayLen + 3
        all_char(ArrayLen) = Chr(124)
        all_char(ArrayLen+1) = Chr(126)
        ArrayLen = ArrayLen + 2
    End If
    If ArrayLen = 0 Then
        MsgBox "错误：没有选择'密码使用的字符'", , "请选择密码使用的字符范围..."
        Exit Sub
    End If
    If blnProcessing Then
        If MsgBox("真的要中断解密过程吗？", vbYesNo, "用户中断任务") = vbYes Then blnProcessing = False
    Else
        CmdStartCrack.Caption = "中断破解"
        blnProcessing = True
        strpath = Combo1.Text
        If strpath = "" Then
            MsgBox "错误：没有选择'需要解密的文件'", , "请选择需要解密的文件..."
            Exit Sub
        End If
        strpath = Trim(strpath)
        Password_Start_Long = Val(txtPasswordStartLong.Text)
        Password_End_Long = Val(txtPasswordEndLong.Text)
        If Password_Start_Long > Password_End_Long Then
            Password_Start_Long = Val(txtPasswordEndLong.Text)
            Password_End_Long = Val(txtPasswordStartLong.Text)
        End If
        Label1.Caption = "破解进度："
        Label1.Refresh
        On Error Resume Next
        If UCase(Right(strpath, 3)) = "XLS" Then
            For K = Password_Start_Long To Password_End_Long    '破解excel开始
                For I = 0 To ArrayLen ^ K - 1
                    pass = ""
                    Temp = I
                    For J = 1 To K - 1
                        Temp = Temp / ArrayLe
                        pass = all_char(Temp Mod ArrayLen) + pass
                    Next J
                    pass = pass + all_char(I Mod ArrayLen)
                    Set OpenReturn = xls.Workbooks.Open(FileName:=strpath, Password:=pass)
                    Text1.Text = pass    '显示破解进度
                    Text1.Refresh
                    If Err.Number <> 0 Then  '如果解密成功,打开文档,显示密码,退出过程
                        Err.Clear
                    Else
                        Label1.Caption = "文档密码："
                        Text1.Text = pass
                        Me.Refresh
                        xls.Visible = True
                        CmdStartCrack.MousePointer = 0
                        CmdStartCrack.Caption = "开始破解"
                        blnProcessing = False
                        Set xls = Nothing
                        Exit Sub
                    End If
                    DoEvents
                    If Not blnProcessing Then Exit For
                Next I
                If Not blnProcessing Then Exit For
            Next K
            xls.Quit
            Set xls = Nothing
        Else
            For K = Password_Start_Long To Password_End_Long  '破解word开始
                For I = 0 To ArrayLen ^ K - 1
                    pass = ""
                    Temp = I
                    For J = 1 To K -
                      Temp = Temp / ArrayLen
                        pass = all_char(Temp Mod ArrayLen) + pass
                    Next J
                    pass = pass + all_char(I Mod ArrayLen)
                    OpenReturn = wd.Documents.Open(FileName:=strpath, passworddocument:=pass)
                    Text1.Text = pass  '显示破解进度
                    Te

上一页  [1] [2] [3]  下一页