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

    آیا راهی برای شکستن کلمه رمز عبور در یک پروژه Excel VBA وجود دارد؟ در این پست به آن می پردازیم.

    شاید برای کاربران محترم اتفاق افتاده باشد که کلمه رمزی که بر روی فایل اکسل خود قرارداده اید را فراموش نموده باشید، ما در این پست تمام تلاشمان را خواهیم نمود تا بتوانیم این مشکل را برای شما مرتفع سازیم و می توانید با استفاده از این روش که نیازی به ویرایش 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 خود بازگردید و از آن لذت ببرید.

    نظرات ارسال شده ارسال نظر جدید
    برای تبادل نظر، می بایست در سایت وارد شوید

    ورود به سایت
تماس گفتگو سبد خرید بالا