彰化一整天的論壇

 找回密碼
 立即註冊
查看: 850|回復: 1

如何破解Excel VBA 程式碼保護

[複製鏈接]
發表於 2016-6-14 21:57:49 | 顯示全部樓層 |閱讀模式
32bit
  1. Option Explicit

  2. Private Const PAGE_EXECUTE_READWRITE = &H40

  3. Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
  4.         (Destination As Long, Source As Long, ByVal Length As Long)

  5. Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
  6.         ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

  7. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

  8. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
  9.         ByVal lpProcName As String) As Long

  10. Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
  11.         ByVal pTemplateName As Long, ByVal hWndParent As Long, _
  12.         ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

  13. Dim HookBytes(0 To 5) As Byte
  14. Dim OriginBytes(0 To 5) As Byte
  15. Dim pFunc As Long
  16. Dim Flag As Boolean

  17. Private Function GetPtr(ByVal Value As Long) As Long
  18.     GetPtr = Value
  19. End Function

  20. Public Sub RecoverBytes()
  21.     If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
  22. End Sub

  23. Public Function Hook() As Boolean
  24.     Dim TmpBytes(0 To 5) As Byte
  25.     Dim p As Long
  26.     Dim OriginProtect As Long

  27.     Hook = False

  28.     pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


  29.     If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

  30.         MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
  31.         If TmpBytes(0) <> &H68 Then

  32.             MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

  33.             p = GetPtr(AddressOf MyDialogBoxParam)

  34.             HookBytes(0) = &H68
  35.             MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
  36.             HookBytes(5) = &HC3

  37.             MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
  38.             Flag = True
  39.             Hook = True
  40.         End If
  41.     End If
  42. End Function

  43. Private Function MyDialogBoxParam(ByVal hInstance As Long, _
  44.         ByVal pTemplateName As Long, ByVal hWndParent As Long, _
  45.         ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
  46.     If pTemplateName = 4070 Then
  47.         MyDialogBoxParam = 1
  48.     Else
  49.         RecoverBytes
  50.         MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
  51.                            hWndParent, lpDialogFunc, dwInitParam)
  52.         Hook
  53.     End If
  54. End Function
複製代碼
  1. Sub unprotected()
  2.     If Hook Then
  3.         MsgBox "VBA Project is unprotected!", vbInformation, "*****"
  4.     End If
  5. End Sub
複製代碼
資料來源: http://stackoverflow.com/questio ... n-excel-vba-project
回復

使用道具 舉報

 樓主| 發表於 2016-6-14 21:58:53 | 顯示全部樓層
64位元
  1. Option Explicit

  2. Private Const PAGE_EXECUTE_READWRITE = &H40

  3. Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
  4. (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)

  5. Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _
  6. ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr

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

  8. Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _
  9. ByVal lpProcName As String) As LongPtr

  10. Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _
  11. ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
  12. ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

  13. Dim HookBytes(0 To 5) As Byte
  14. Dim OriginBytes(0 To 5) As Byte
  15. Dim pFunc As LongPtr
  16. Dim Flag As Boolean

  17. Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
  18.     GetPtr = Value
  19. End Function

  20. Public Sub RecoverBytes()
  21.     If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
  22. End Sub

  23. Public Function Hook() As Boolean
  24.     Dim TmpBytes(0 To 5) As Byte
  25.     Dim p As LongPtr
  26.     Dim OriginProtect As LongPtr

  27.     Hook = False

  28.     pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


  29.     If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

  30.         MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
  31.         If TmpBytes(0) <> &H68 Then

  32.             MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

  33.             p = GetPtr(AddressOf MyDialogBoxParam)

  34.             HookBytes(0) = &H68
  35.             MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
  36.             HookBytes(5) = &HC3

  37.             MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
  38.             Flag = True
  39.             Hook = True
  40.         End If
  41.     End If
  42. End Function

  43. Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
  44. ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
  45. ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

  46.     If pTemplateName = 4070 Then
  47.         MyDialogBoxParam = 1
  48.     Else
  49.         RecoverBytes
  50.         MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
  51.                    hWndParent, lpDialogFunc, dwInitParam)
  52.         Hook
  53.     End If
  54. End Function
複製代碼

  1. Sub unprotected()
  2.     If Hook Then
  3.         MsgBox "VBA Project is unprotected!", vbInformation, "*****"
  4.     End If
  5. End Sub
複製代碼


資料來源: http://stackoverflow.com/questio ... t/31005696#31005696
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-7-23 05:48 , Processed in 0.028366 second(s), 9 queries , Apc On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表