14-08-21, 11:43 AM
السلام عليكم ورحمة الله وبركاته
قمت بتحويل كود من VBA إلى VB.net ولكن ظهر خطأ عند AddressOf
هذا هو الكود كاملاً:
PHP كود :
Imports System.Runtime.InteropServices
Module Module1
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As ULong, Source As ULong, ByVal Length As ULong)
'Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Object, ByVal hpvSource As Object, ByVal cbCopy As Integer)
' Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As ULong,
'ByVal dwSize As ULong, ByVal flNewProtect As ULong, lpflOldProtect As ULong) As ULong
Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, ByRef lpflOldProtect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As ULong
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As ULong,
ByVal lpProcName As String) As ULong
Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As ULong,
ByVal pTemplateName As ULong, ByVal hWndParent As ULong,
ByVal lpDialogFunc As ULong, ByVal dwInitParam As ULong) As Integer
Dim HookBytes(0 To 11) As Byte
Dim OriginBytes(0 To 11) As Byte
Dim pFunc As ULong
Dim Flag As Boolean
Private Function GetPtr(ByVal Value As ULong) As ULong
GetPtr = Value
End Function
Public Sub RecoverBytes()
'If Flag Then MoveMemory(Val(pFunc), Val((OriginBytes(0))), 12)
If Flag Then MoveMemory(pFunc, VarPtr(OriginBytes(0)), 12)
End Sub
'Private Declare Function VarPtr Lib "vb40032.dll" Alias "VarPtr" (lpObject) As Long
Public Function VarPtr(ByVal e As ULong) As ULong
Dim GC As GCHandle = GCHandle.Alloc(e, GCHandleType.Pinned)
Dim GC2 As ULong = GC.AddrOfPinnedObject.ToInt64
GC.Free()
Return GC2
End Function
Public Function Hook() As Boolean
Dim TmpBytes(0 To 11) As Byte
Dim p As ULong, osi As Byte
Dim OriginProtect As ULong
Hook = False
#If Win64 Then
osi = 1
#Else
osi = 0
#End If
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
'MsgBox(pFunc)
'MsgBox(PAGE_EXECUTE_READWRITE)
'MsgBox(OriginProtect)
'MsgBox(VirtualProtect(pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect))
If VirtualProtect(pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
'MoveMemory((TmpBytes(0)), pFunc, osi + 1)
MoveMemory(VarPtr(TmpBytes(0)), pFunc, osi + 1)
If TmpBytes(osi) <> &HB8 Then
'MoveMemory((OriginBytes(0)), pFunc, 12)
MoveMemory(VarPtr(OriginBytes(0)), pFunc, 12)
'p = GetPtr(AddressOf MyDialogBoxParam)
p = GetPtr(AddressOf MyDialogBoxParam)
'p = GetPtr(MyDialogBoxParam(0, 0, 0, 0, 0))
' p = 2385901325076
If osi Then HookBytes(0) = &H48
HookBytes(osi) = &HB8
osi = osi + 1
'MoveMemory((HookBytes(osi)), (p), 4 * osi)
MoveMemory(VarPtr(HookBytes(osi)), VarPtr(p), 4 * osi)
HookBytes(osi + 4 * osi) = &HFF
HookBytes(osi + 4 * osi + 1) = &HE0
'MoveMemory(pFunc, (HookBytes(0)), 12)
MoveMemory(pFunc, VarPtr(HookBytes(0)), 12)
Flag = True
Hook = True
End If
End If
End Function
Private Function MyDialogBoxParam(ByVal hInstance As ULong,
ByVal pTemplateName As ULong, ByVal hWndParent As ULong,
ByVal lpDialogFunc As ULong, ByVal dwInitParam As ULong) As Integer
If pTemplateName = 4070 Then
MyDialogBoxParam = 1
Else
RecoverBytes()
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName,
hWndParent, lpDialogFunc, dwInitParam)
Hook()
End If
End Function
End Module
وهذه صورة الخطأ:
أرجو التكرم بالمساعدة في حل المشكلة
فاعلم أنه لا إله إلا الله