Tuesday, December 13, 2022

ByP4ss VB4Project in Excel

Langsung saja.

1. Pertama Buka file Excel yang terpassword.

2. buat file excel yang baru, jadi ada dua file yang di buka di excel.

3. di menu developper, insert module di file excel yang baru.

4. kemudian module 1 berisikan code seperti berikut

_______________________________________________________________

Option Explicit


Private Const PAGE_EXECUTE_READWRITE = &H40


Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _

(Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)


Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _

ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr


Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr


Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _

ByVal lpProcName As String) As LongPtr


Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _

ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _

ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer


Dim HookBytes(0 To 5) As Byte

Dim OriginBytes(0 To 5) As Byte

Dim pFunc As LongPtr

Dim Flag As Boolean


Private Function GetPtr(ByVal Value As LongPtr) As LongPtr

    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 LongPtr

    Dim OriginProtect As LongPtr


    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 LongPtr, _

ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _

ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer


    If pTemplateName = 4070 Then

        MyDialogBoxParam = 1

    Else

        RecoverBytes

        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _

                   hWndParent, lpDialogFunc, dwInitParam)

        Hook

    End If

End Function


_______________________________________________________________


5. selanjut nya insert module 2 dan tuliskan code seperti berikut

_______________________________________________________________

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


_______________________________________________________________


6. setelah itu di module 2 jalan kan script code / run macro (F5)

7. slesai

semoga bisa berjalan script diatas.

sumber nya dari sini : https://stackoverflow.com/questions/1026483/is-there-a-way-to-crack-the-password-on-an-excel-vba-project


今生缘 (jīn shēng yuán) Affinities of this life | Lyrics Translation

今生缘 (jīn shēng yuán) Affinities of this life | Lyrics Translation 作词/作曲/演唱: 川子 zuò cí/zuò qǔ/yǎn chàng:chuān zǐ Lyricist/Composer/Artist: Ch...