方法一(兼容较好):

Option Explicit

Dim HookedLoadLibraryExW(0 To 9) As Long
Dim User32BaseAddress As Long, User32ImageSize As Long

Private Function FilterLoadLibraryExW(ByVal RetAddr As Long) As Long
[/font][font=Comic Sans MS]' You can do whatever you wanna do here - iceboy
[/font][font=Fixedsys]If RetAddr >= User32BaseAddress And RetAddr < User32BaseAddress + User32ImageSize Then Exit Function
FilterLoadLibraryExW = 1
End Function

Public Function TryHookLoadLibraryExW() As Boolean
Dim LoadLibraryExW As Long, Length As Long, Offset As Long

LoadLibraryExW = GetModuleHandleW(StrPtr("kernel32"))
LoadLibraryExW = GetProcAddress(LoadLibraryExW, "LoadLibraryExW")

If CharFromPtr(LoadLibraryExW) = &HE9 Then Exit Function

Do
Length = ade32_disasm(LoadLibraryExW + Offset)
If Length <= 0 Then Exit Function
Offset = Offset + Length
Loop While Offset < 5

If Offset > 11 Then Exit Function

User32BaseAddress = GetModuleHandleW(StrPtr("user32"))
User32ImageSize = DwordFromPtr(User32BaseAddress + &H3C)
User32ImageSize = DwordFromPtr(User32BaseAddress + User32ImageSize + &H50)

HookedLoadLibraryExW(0) = &HE82434FF
HookedLoadLibraryExW(1) = RetLng(AddressOf FilterLoadLibraryExW) - VarPtr(HookedLoadLibraryExW(2))
HookedLoadLibraryExW(2) = &H875C085
HookedLoadLibraryExW(3) = &HCC000CC2
HookedLoadLibraryExW(4) = &HCCCCCCCC

IcyMoveMemory VarPtr(HookedLoadLibraryExW(5)), LoadLibraryExW, Offset
CharToPtr VarPtr(HookedLoadLibraryExW(5)) + Offset, &HE9
DwordToPtr VarPtr(HookedLoadLibraryExW(5)) + Offset + 1, LoadLibraryExW - VarPtr(HookedLoadLibraryExW(5)) - 5

If IcyProtectVirtualMemoryEx(VarPtr(HookedLoadLibraryExW(0)), 44, PAGE_EXECUTE_READWRITE, VarPtr(Length)) < 0 Then Exit Function
If IcyProtectVirtualMemoryEx(LoadLibraryExW, 5, PAGE_EXECUTE_READWRITE, VarPtr(Length)) < 0 Then Exit Function
CharToPtr LoadLibraryExW, &HE9
DwordToPtr LoadLibraryExW + 1, VarPtr(HookedLoadLibraryExW(0)) - (LoadLibraryExW + 5)

TryHookLoadLibraryExW = True
End Function

方法二(通俗易懂):

Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source or="#0000FF">As Long, ByVal length As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Dim NewAddr(7) As Byte
Dim OldAddr(7) As Byte
Dim pBaseAddr As Long

Private Sub HookLoadLibrary()
Dim hMod As Long

hMod = GetModuleHandle("kernel32")
pBaseAddr = GetProcAddress(hMod, "LoadLibraryExW")


CopyMemory VarPtr(NewAddr(1)), AddressOf LoadLibraryExWCallBack, 4 [/font][font=Comic Sans MS]'保存地址


' mov Eax, 我们的地址
' jmp Eax

[/font][font=Fixedsys]NewAddr(0) = &HB8
NewAddr(5) = &HFF
NewAddr(6) = &HE0
NewAddr(7) = &H0

CopyMemory VarPtr(OldAddr(0)), pBaseAddr, 8
WriteProcessMemory -1, ByVal pBaseAddr, NewAddr(0), 8, 0
End Sub

Private Function HookStatus(ByVal IsHook As Boolean) As Boolean
If IsHook Then
If WriteProcessMemory(-1, ByVal pBaseAddr, NewAddr(0), 8, 0) <> 0 Then HookStatus = False
Else
If WriteProcessMemory(-1, ByVal pBaseAddr, OldAddr(0), 8, 0) <> 0 Then HookStatus = False
End If
End Function

Public Function LoadLibraryExWCallBack(ByVal a As Long, ByVal b As Long, ByVal c As Long) As Long
Dim str As String, Ret As Long
Const Neet As String = "kernel32.dll advapi32.dll psapi.dll ntoskrnl.exe ntdll.dll vba6.dll" [/font][font=Comic Sans MS]'据蒜子说,系统本身的 dll 不带路径
[/font][font=Fixedsys]HookStatus False [/font][font=Comic Sans MS]'暂时恢复钩子
[/font][font=Fixedsys]str = String(lstrlen(a) * 2, 0)
CopyMemory StrPtr(str), ByVal a, lstrlen(a) * 2
str = Left$(str, lstrlen(a))
If Mid(str, 2, 1) <> ":" Then
[/font][font=Comic Sans MS]'由于 unicode 的问题,我们这里用 A,A 最终应该会调用 W,所以要恢复钩子
'如果需调用 W ,有个可爱的函数叫做 strptr
[/font][font=Fixedsys]Ret = LoadLibraryEx(str, b, c)
Else
Ret = 0
End If
HookStatus True [/font][font=Comic Sans MS]'再次 hook 该函数
[/font][font=Fixedsys]LoadLibraryExWCallBack = Ret
End Function