office交流網(wǎng)--QQ交流群號(hào)及微信交流群

Access培訓(xùn)群:792054000         Excel免費(fèi)交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

微信交流群(請(qǐng)用微信掃碼)

        

VBA密碼破解代碼-支持xls,xla,xlt等格式

2020-01-01 08:00:00
網(wǎng)絡(luò)摘録
轉(zhuǎn)貼
6835
VBA密碼破解代碼-支持xls,xla,xlt等格式
測(cè)試使用過(guò),有效

Private Sub CommandButton1_Click()
  VBA_Decryption
End Sub


Sub VBA_Decryption() '你要解保護(hù)的Excel文件路徑
    On Error Resume Next
    '穫?cè)∫饷芪募奈募?br />     Filename = Application.GetOpenFilename("Excel文件(*.xls & *.xla & *.xlt),*.xls;*.xla;*.xlt", , "VBA破解密碼")
    '未選擇文件時(shí)提示信息,選擇後備份文件
    If Dir(Filename) = "" Then
        MsgBox "沒(méi)找到相關(guān)文件,清重新設(shè)置。"
        Exit Sub
    Else
        FileCopy Filename, Filename & ".bak" '備份文件。
    End If
    
    Dim GetData As String * 5
    Open Filename For Binary As #1
    Dim CMGs As Long
    Dim DPBo As Long
    
    For i = 1 To LOF(1)
        Get #1, i, GetData
        If GetData = "CMG=""" Then CMGs = i
        If GetData = "[Host" Then DPBo = i - 2: Exit For
    Next
    
    If CMGs = 0 Then
        MsgBox "請(qǐng)先對(duì)VBA編碼設(shè)置一箇保護(hù)密碼...", 32, "提示"
        Exit Sub
    End If
    
    Dim St As String * 2
    Dim s20 As String * 1
    '取得一箇0D0A十六進(jìn)製字串
    Get #1, CMGs - 2, St
    '取得一箇20十六製字串
    Get #1, DPBo + 16, s20
    '替換加密部份機(jī)碼
    For i = CMGs To DPBo Step 2
        Put #1, i, St
    Next
    '加入不配對(duì)符號(hào)
    If (DPBo - CMGs) Mod 2 <> 0 Then
        Put #1, DPBo + 1, s20
    End If
    MsgBox "文件解密成功......", 32, "提示"
    Close #1
End Sub

分享
文章分類(lèi)
聯(lián)繫我們
聯(lián)繫人: 王先生
Email: 18449932@qq.com
QQ: 18449932
微博: officecn01
移動(dòng)訪問(wèn)