frmgetpass.frm

本程序只用于个人EXCEL密码遗忘时

             For s = 1 To Max
                    '===============
                    Num = Num + 1
                 
                     
                   If stopFlag = True Then
                       
                        Set vbExcel = Nothing
                        MsgBox "用户中断!!"
                        Exit Function
                    End If
                    PassWord = strChar(i) + strChar(j) + strChar(k) + strChar(l) + strChar(m) + strChar(n) + strChar(o) + strChar(p) + strChar(q) + strChar(r) + strChar(s)
                    Label1.Caption = "探测次数:" & Str(Num) & "     密码:" & PassWord
                    DoEvents
                    OK = OpenExcel(Filename, PassWord)
                    If OK = True Then
                       E_11 = True
                       
                        Exit Function
                    End If
                    '===============
                    Next s
                    Next r
                    Next q
                    Next p
                    Next o
                    Next n
                    Next m
                    Next l
                    Next k
                    Next j
               Next i
End Function
Private Function E_12() As Boolean
             E_12 = False
              Dim i As Long
              Dim j As Long
              Dim k As Long
              Dim l As Long
              Dim m As Long
              Dim n As Long
              Dim o As Long
              Dim p As Long
              Dim q As Long
              Dim r As Long
              Dim s As Long
              Dim t As Long
              For i = 1 To Max
             For j = 1 To Max
             For k = 1 To Max
             For l = 1 To Max
             For m = 1 To Max
             For n = 1 To Max
             For o = 1 To Max
             For p = 1 To Max
             For q = 1 To Max
             For r = 1 To Max
             For s = 1 To Max
             For t = 1 To Max
                    '===============
                    Num = Num + 1
                 
                     
                   If stopFlag = True Then
                       
                        Set vbExcel = Nothing
                        MsgBox "用户中断!!"
                        Exit Function
                    End If
                    PassWord = strChar(i) + strChar(j) + strChar(k) + strChar(l) + strChar(m) + strChar(n) + strChar(o) + strChar(p) + strChar(q) + strChar(r) + strChar(s) + strChar(t)
                     Label1.Caption = "探测次数:" & Str(Num) & "     密码:" & PassWord
                    DoEvents
                    OK = OpenExcel(Filename, PassWord)
                    If OK = True Then
                       E_12 = True
                       
                        Exit Function
                    End If
                    '===============
                    Next t
                    Next s
                    Next r
                    Next q
                    Next p
                    Next o
                    Next n
                    Next m
                    Next l
                    Next k
                    Next j
               Next i
End Function
Private Function OpenExcel(ByVal Filename As String, ByVal PassWord As String) As Boolean
        OpenExcel = False
        With vbExcel
          .Visible = False
        On Error GoTo 0
        On Error Resume Next
          .Workbooks.Open Filename, , True, , PassWord
          
          If Err.Number = 1004 Then
                 Err.Clear
                 OpenExcel = False
                Else
              
                  OpenExcel = True
       End If
  End With
End Function

Private Sub cmdClose_Click()
        Unload Me
        Set frmGetpass = Nothing
        
End Sub

Private Sub cmdOpen_Click()
      Timer1.Interval = 0
      If Trim(txtFileName.Text) = "" Then
             MsgBox "必须输入文件名称", vbCritical
             txtFileName.SetFocus
             Exit Sub
      End If
      Dim OKOK As Boolean
      
       Set vbExcel = CreateObject("Excel.application")
       stopFlag = False
       Num = 0
       Filename = Trim(txtFileName.Text)
        OKOK = FileExist(Filename)
        If OKOK = False Then
              MsgBox "无此文件" + vbCrLf + Filename, vbCritical, "错误"
              txtFileName.SetFocus
              SendKeys "{HOME}+{END}"
              Exit Sub
        End If
       OKOK = False
       cmdClose.Enabled = False
       cmdStop.Enabled = True
       cmdOpen.Enabled = False
       PIC1.Visible = False
    
       If DictFirst = True And stopFlag = False Then
              lblInfo.Caption = "正在尝试密码字典... ..."
              OKOK = Dict()
              If OKOK = True Then GoTo theEnd
       End If
      
  
  
  
       
 If StartNum = 1 Then GoTo 1
 If StartNum = 2 Then GoTo 2
 If StartNum = 3 Then GoTo 3
 If StartNum = 4 Then GoTo 4
 If StartNum = 5 Then GoTo 5
 If StartNum = 6 Then GoTo 6
 If StartNum = 7 Then GoTo 7
 If StartNum = 8 Then GoTo 8
 If StartNum = 9 Then GoTo 7
 If StartNum = 10 Then GoTo 10
  If StartNum = 11 Then GoTo 11
 If StartNum = 12 Then GoTo 12
         
1:
       If stopFlag = False Then
            lblInfo.Caption = "正在尝试 1 位密码... ..."
            OKOK = E_1()
            If OKOK = True Then GoTo theEnd
       End If
2:
         If stopFlag = False Then
            lblInfo.Caption = "正在尝试 2 位密码... ..."
            OKOK = E_2()
            If OKOK = True Then GoTo theEnd
       End If
3:
        If stopFlag = False Then
                lblInfo.Caption = "正在尝试 3 位密码... ..."
                OKOK = E_3()
                If OKOK = True Then GoTo theEnd
        End If
4:
            If stopFlag = False Then
               lblInfo.Caption = "正在尝试 4 位密码... ..."
                OKOK = E_4()
                If OKOK = True Then GoTo theEnd
        End If
5:
        If stopFlag = False Then
            lblInfo.Caption = "正在尝试 5 位密码... ..."
                OKOK = E_5()
                If OKOK = True Then GoTo theEnd
        End If
6:
         If stopFlag = False Then
                lblInfo.Caption = "正在尝试 6 位密码... ..."
                OKOK = E_6()
                If OKOK = True Then GoTo theEnd
    End If
7:
          If stopFlag = False Then
                lblInfo.Caption = "正在尝试 7 位密码... ..."
                OKOK = E_7()
                If OKOK = True Then GoTo theEnd
     End If
8:
           If stopFlag = False Then
                    lblInfo.Caption = "正在尝试 8 位密码... ..."
                    OKOK = E_8()
                    If OKOK = True Then GoTo theEnd
      End If
9:
        If stopFlag = False Then
                     lblInfo.Caption = "正在尝试 9 位密码... ..."
                    OKOK = E_9()
                    If OKOK = True Then GoTo theEnd
       End If
10:
       If stopFlag = False Then
                lblInfo.Caption = "正在尝试 10 位密码... ..."
                    OKOK = E_10()
                    If OKOK = True Then GoTo theEnd
       End If
11:
       If stopFlag = False Then
       lblInfo.Caption = "正在尝试 11 位密码... ..."
                    OKOK = E_11()
                    If OKOK = True Then GoTo theEnd
       End If
12:
        If stopFlag = False Then
                    lblInfo.Caption = "正在尝试 12 位密码... ..."
                    OKOK = E_12()
                    If OKOK = True Then GoTo theEnd
       End If

       If OKOK = False Then
            lblInfo.Caption = "很抱歉,没有找到密码"
             MsgBox "很抱歉,没有找到密码 ", vbCritical, "失败"
        End If
        PIC1.Visible = True
        cmdClose.Enabled = True
       Exit Sub
theEnd:
   
       lblInfo.Caption = "找到密码!!!"
       MsgBox "密码是: " + PassWord, vbInformation, "找到密码!!"
       cmdClose.Enabled = True
       vbExcel.Visible = True
       PIC1.Visible = True
       cmdOpen.Enabled = True
       Set vbExcel = Nothing
        
End Sub

Private Sub cmdStop_Click()
        cmdStop.Enabled = False
        cmdClose.Enabled = True
        PIC1.Visible = True
        stopFlag = True
        cmdOpen.Enabled = True
    
End Sub

Private Sub cmdYes_Click()
       If Not IsNumeric(txtNum.Text) Then
            MsgBox "密码开始位数必须是数字", vbCritical, "错误"
            txtNum.SetFocus
            SendKeys "{HOME}+{END}"
            Exit Sub
        End If
        If Val(txtNum.Text) < 1 Or Val(txtNum.Text) > 12 Then
            MsgBox "密码开始位数必须在 1  ~  12  之间", vbCritical, "错误"
            txtNum.SetFocus
            SendKeys "{HOME}+{END}"
            
        End If
        strCharMax = 0
        StartNum = Val(txtNum.Text)
        cmdOpen.Enabled = True
        If chkDict.Value = 1 Then
              DictFirst = True
              
             Else
              DictFirst = False
        End If
        
        Dim i As Integer
        If chkLow.Value = 1 Then
             For i = 1 To 26
                  strChar(strCharMax + i) = strCharLow(i)
             Next i
             strCharMax = strCharMax + i - 1
        End If
    
        
         If chkNumber.Value = 1 Then
             For i = 1 To 11
                  strChar(strCharMax + i) = strNumber(i)
             Next i
             strCharMax = strCharMax + i - 1
        End If
        If chkUp.Value = 1 Then
             For i = 1 To 26
                  strChar(strCharMax + i) = strCharUp(i)
             Next i
             strCharMax = strCharMax + i - 1
        End If
        If chkOther.Value = 1 Then
             For i = 1 To 24
                  strChar(strCharMax + i) = strCharOther(i)
             Next i
             strCharMax = strCharMax + i - 1
        End If
        If strCharMax = 0 And DictFirst = False Then
              cmdOpen.Enabled = False
            
              MsgBox "必须首先选择密码设置方案", vbCritical, "错误"
             Else
               
               Max = strCharMax
               MsgBox "请按  " + vbCrLf + vbCrLf + " 开始探测 " + vbCrLf + vbCrLf + "按钮", vbInformation, "OK"
               Timer1.Interval = 500
        End If
End Sub

Private Sub Form_Load()
     Dim z As Long
    
        DictFirst = False
        strNumber(1) = "1"
        strNumber(2) = "2"
        strNumber(3) = "3"
        strNumber(4) = "4"
        strNumber(5) = "5"
        strNumber(6) = "6"
        strNumber(7) = "7"
        strNumber(8) = "8"
        strNumber(9) = "9"
        strNumber(10) = "0"
        strNumber(11) = " "
        Dim i As Integer
        For i = 1 To 26
         strCharUp(i) = Chr(65 + i - 1)
        Next i
         
        For i = 1 To 26
         strCharLow(i) = Chr(97 + i - 1)
        Next i
        strCharOther(1) = "!": strCharOther(2) = "@": strCharOther(3) = "#": strCharOther(4) = "*"
        strCharOther(5) = "$": strCharOther(6) = "%": strCharOther(7) = "^": strCharOther(8) = "("
        strCharOther(9) = ")": strCharOther(10) = "-": strCharOther(11) = "_": strCharOther(12) = "="
        strCharOther(13) = "+": strCharOther(14) = "\": strCharOther(15) = "|": strCharOther(16) = "["
        strCharOther(17) = "]": strCharOther(18) = "{": strCharOther(19) = "}": strCharOther(20) = ";"
        strCharOther(21) = "?": strCharOther(22) = "/": strCharOther(23) = "."
        strCharOther(24) = ","
        
End Sub

Private Sub Timer1_Timer()
        If cmdOpen.Caption = "开始探测" Then
            cmdOpen.Caption = "开始   探测"
           Else
             cmdOpen.Caption = "开始探测"
        End If
End Sub