WPS2017 电子表格/Excel文件保护密码忘记了？

你的名字 2022-05-31 01:48 255阅读 0赞

# WPS2017 电子表格/Excel文件保护密码忘记了？ #

废话不说，直入正题。

妹妹有一个考勤表格的保护密码忘记了，要发上个月工资了，着急坏了，求助万能的老哥！

隐约记得密码有10来位，不是数字，在着急用的前提下使用工具暴力破解密码完全来不及。

想了一下，Excel文件的保密密码应该是使用弱加密算法直接保存在文件中的，想了两个办法：

1、使用16进制编辑器，查接查看Excel文件本身，看看能不能找到登记密码的位置

2、使用VBA解码

出于程序员的本能，决定先试用VBA的方法。

WPS2017个人版都没VBA功能，首先需要安装VBA支持，我在如下位置下载了VBA安装包：

[VBA7.0.1590ForWPS][]

下载完成后，查了一毒，表示安全。开始安装，安装步骤不再赘述。

安装完成后，用WPS表格打开待解密的Excel文件，通过菜单“开发工具 - 录制新宏”录制一个新宏，直接关闭。

通过菜单“开发工具-宏”打开宏管理器，编辑刚刚录制的新宏，删除全部代码，输入下文中的代码：

Option Explicit
    Public Sub AllInternalPasswords() 
    ' Breaks worksheet and workbook structure passwords. Bob McCormick 
    ' probably originator of base code algorithm modified for coverage 
    ' of workbook structure / windows passwords and for multiple passwords 
    ' 
    ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 
    ' Modified 2003-Apr-04 by JEM: All msgs to constants, and 
    ' eliminate one Exit Sub (Version 1.1.1) 
    ' Reveals hashed passwords NOT original passwords 
    Const DBLSPACE As String = vbNewLine & vbNewLine 
    Const AUTHORS As String = DBLSPACE & vbNewLine & _ 
    "Adapted from Bob McCormick base code by" & _ 
    "Norman Harker and JE McGimpsey" 
    Const HEADER As String = "AllInternalPasswords User Message" 
    Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" 
    Const REPBACK As String = DBLSPACE & "Please report failure " & _ 
    "to the microsoft.public.excel.programming newsgroup." 
    Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ 
    "now be free of all password protection, so make sure you:" & _ 
    DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ 
    DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ 
    DBLSPACE & "Also, remember that the password was " & _ 
    "put there for a reason. Don't stuff up crucial formulas " & _ 
    "or data." & DBLSPACE & "Access and use of some data " & _ 
    "may be an offense. If in doubt, don't." 
    Const MSGNOPWORDS1 As String = "There were no passwords on " & _ 
    "sheets, or workbook structure or windows." & AUTHORS & VERSION 
    Const MSGNOPWORDS2 As String = "There was no protection to " & _ 
    "workbook structure or windows." & DBLSPACE & _ 
    "Proceeding to unprotect sheets." & AUTHORS & VERSION 
    Const MSGTAKETIME As String = "After pressing OK button this " & _ 
    "will take some time." & DBLSPACE & "Amount of time " & _ 
    "depends on how many different passwords, the " & _ 
    "passwords, and your computer's specification." & DBLSPACE & _ 
    "Just be patient! Make me a coffee!" & AUTHORS & VERSION 
    Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ 
    "Structure or Windows Password set." & DBLSPACE & _ 
    "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ 
    "Note it down for potential future use in other workbooks by " & _ 
    "the same person who set this password." & DBLSPACE & _ 
    "Now to check and clear other passwords." & AUTHORS & VERSION 
    Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ 
    "password set." & DBLSPACE & "The password found was: " & _ 
    DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ 
    "future use in other workbooks by same person who " & _ 
    "set this password." & DBLSPACE & "Now to check and clear " & _ 
    "other passwords." & AUTHORS & VERSION 
    Const MSGONLYONE As String = "Only structure / windows " & _ 
    "protected with the password that was just found." & _ 
    ALLCLEAR & AUTHORS & VERSION & REPBACK 
    Dim w1 As Worksheet, w2 As Worksheet 
    Dim i As Integer, j As Integer, k As Integer, l As Integer 
    Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer 
    Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer 
    Dim PWord1 As String 
    Dim ShTag As Boolean, WinTag As Boolean
    Application.ScreenUpdating = False 
    With ActiveWorkbook 
    WinTag = .ProtectStructure Or .ProtectWindows 
    End With 
    ShTag = False 
    For Each w1 In Worksheets 
    ShTag = ShTag Or w1.ProtectContents 
    Next w1 
    If Not ShTag And Not WinTag Then 
    MsgBox MSGNOPWORDS1, vbInformation, HEADER 
    Exit Sub 
    End If 
    MsgBox MSGTAKETIME, vbInformation, HEADER 
    If Not WinTag Then 
    MsgBox MSGNOPWORDS2, vbInformation, HEADER 
    Else 
    On Error Resume Next 
    Do 'dummy do loop 
    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 
    With ActiveWorkbook 
    .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 .ProtectStructure = False And _ 
    .ProtectWindows = False Then 
    PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 
    Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 
    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 
    MsgBox Application.Substitute(MSGPWORDFOUND1, _ 
    "$$", PWord1), vbInformation, HEADER 
    Exit Do 'Bypass all for...nexts 
    End If 
    End With 
    Next: Next: Next: Next: Next: Next 
    Next: Next: Next: Next: Next: Next 
    Loop Until True 
    On Error GoTo 0 
    End If 
    If WinTag And Not ShTag Then 
    MsgBox MSGONLYONE, vbInformation, HEADER 
    Exit Sub 
    End If 
    On Error Resume Next 
    For Each w1 In Worksheets 
    'Attempt clearance with PWord1 
    w1.Unprotect PWord1 
    Next w1 
    On Error GoTo 0 
    ShTag = False 
    For Each w1 In Worksheets 
    'Checks for all clear ShTag triggered to 1 if not. 
    ShTag = ShTag Or w1.ProtectContents 
    Next w1 
    If ShTag Then 
    For Each w1 In Worksheets 
    With w1 
    If .ProtectContents Then 
    On Error Resume Next 
    Do 'Dummy do loop 
    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 
    .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 Not .ProtectContents Then 
    PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ 
    Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ 
    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 
    MsgBox Application.Substitute(MSGPWORDFOUND2, _ 
    "$$", PWord1), vbInformation, HEADER 
    'leverage finding Pword by trying on other sheets 
    For Each w2 In Worksheets 
    w2.Unprotect PWord1 
    Next w2 
    Exit Do 'Bypass all for...nexts 
    End If 
    Next: Next: Next: Next: Next: Next 
    Next: Next: Next: Next: Next: Next 
    Loop Until True 
    On Error GoTo 0 
    End If 
    End With 
    Next w1 
    End If 
    MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 
    End Sub

关闭宏编辑窗口， 通过菜单“开发工具-宏”打开宏管理器并运行AllInternalPasswords

此时会弹出对话框，无视并点确定

![SouthEast][]

弹出第二个对话框，继续无视并点确定

![SouthEast 1][]

神奇的事情发生了，密码出现在第三个对话框中，拿出纸笔抄录一下：

![SouthEast 2][]

密码成功能回，希望能撤销密码保护的朋友，请自行百度。

[VBA7.0.1590ForWPS]: http://vdisk.weibo.com/s/uuR3CI7lMamRX?from=page_100505_profile&wvr=6
[SouthEast]: /images/20220531/f45a0f6c0b9f45c49a09f7b4bbfa83f0.png
[SouthEast 1]: /images/20220531/077bbb80c4154bef8746f56399cd7a11.png
[SouthEast 2]: /images/20220531/88e1ea467185416b90f21539bda25b47.png