شکستن کلمه رمز فایل در اکسل

شاید برای کاربران محترم اتفاق افتاده باشد که کلمه رمزی که بر روی فایل اکسل خود قرارداده اید را فراموش نموده باشید، ما در این پست تمام تلاشمان را خواهیم نمود تا بتوانیم این مشکل را برای شما مرتفع سازیم و می توانید با استفاده از این روش که نیازی به ویرایش HEX ندارد. برای هر پرونده ای در اکسل اعم از .xls ،.xlsm ،.xlam ... کلمه رمز آنرا شکسته و از بین ببرید.

این عملیات بر روی نگارش های Excel 2007، Excel 2010، Excel 2013 - 32 bit version، Excel 2016 - 32 bit version فعال و قابل اجرا است.

مراحل ابتدایی کار بقرار زیر می باشد :

VBE برای ایجاد یک کادر محاوره ای به منظور دریافت کلمه رمز عبور را فراخوانی می کند.
اگر کاربر گذرواژه را درست و صحیح وارد کرده و روی تأیید نماید، این عملکرد عدد 1 را باز میگرداند، اگر کاربر گذرواژه اشتباه را وارد کرده و یا روی لغو عملیات کلیک کند، این عملکرد 0 است.
پس از بسته شدن کادر محاوره ای ، VBE مقدار برگشتی عملکرد سیستم را بررسی می کند
اگر این مقدار 1 باشد ، VBE "فکر می کند" رمز عبور مناسب است ، از این رو پروژه قفل شده VBA باز می شود.
کد زیر حافظه عملکرد اصلی را برای نمایش گفتگوی رمز عبور با عملکردی تعریف شده توسط کاربر جایگزین می کند که هنگام فراخوانی همیشه 1 را برمی گرداند.

لطفاً ابتدا از فایلهای خود نسخه پشتیبان تهیه کنید!

1 - فایل و پرونده های حاوی پروژه های قفل شده VBA خود را باز کنید
2 - یک فایل xlsm جدید ایجاد کنید و این کد را در Module1 ذخیره کنید

Code Credited WEBiNUX Group
Option Explicit
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" Destination As Long, 
        Source As Long, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, ByVal dwSize As Long, 
        ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, 
        ByVal pTemplateName As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean
Private Function GetPtr(ByVal Value As Long) As Long
    GetPtr = Value
End Function
Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub
Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long
    Hook = False
    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
    If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then
            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
            p = GetPtr(AddressOf MyDialogBoxParam)
            HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3
            MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, ByVal pTemplateName As Long, 
        ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

3 - کد زیر را در پائین کد بالا در Module1 قرار دهید و آن را اجرا کنید :

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

4 - به پروژه های VBA خود بازگردید و از آن لذت ببرید.