IS的那一套  其实yykingking早就把原理仍出来了  只不过一直没有人发过代码

引用:

'By 炉子[0GiNr]
'http://0GiNr.com | http://hi.baidu.com/breakinglove_
'转载请注明出处
Option Explicit

Private Declare Function NtReadVirtualMemory _
               
Lib "NTDLL.DLL" (ByVal ProcessHandle As Long, _
                                
ByVal BaseAddress As Long, _
                                
ByVal pBuffer As Long, _
                                
ByVal NumberOfBytesToRead As Long, _
                                
ByRef NumberOfBytesReaded As LongAs Long
Private Declare Function 
NtWriteVirtualMemory _
               
Lib "NTDLL.DLL" (ByVal ProcessHandle As Long, _
                                
ByVal BaseAddress As Long, _
                                
ByVal pBuffer As Long, _
                                
ByVal NumberOfBytesToWrite As Long, _
                                
ByRef NumberOfBytesWritten As LongAs Long
'Private Const pgSharedInfo = &H77D700A0 //can be located now.
Private Const NtGetCurrentProcess = -'//0xFFFFFFFF

Private Type SHAREDINFO
        psi 
As Long                     'tagSERVERINFO
        
aheList As Long                 '_HANDLEENTRY - handle table pointer
        
pDispInfo As Long               'global displayinfo
        
ulSharedDelta As Long           'delta between client and kernel mapping of ...
        '省略
End Type

Private Type HANDLEENTRY
        phead 
As Long           'pointer to the real object
        
pOwner As Long          'pointer to owning entity (pti or ppi)
        
bType As Byte           'type of object
        
bFlags As Byte          'flags - like destroy flag
        
wUniq As Integer        'uniqueness count
End Type

Private Type SERVERINFO 'si
        
wRIPFlags As Integer               'RIPF_ flags
        
wSRVIFlags As Integer              'SRVIF_ flags
        
wRIPPID As Integer                 'PID of process to apply RIP flags to (zero means all)
        
wRIPError As Integer               'Error to break on (zero means all errors are treated equal)
        
cHandleEntries As Long          'count of handle entries in array
End Type

Private Enum HANDLE_TYPE
        TYPE_FREE = 
0                    'must be zero!
        
TYPE_WINDOW = 1                  'in order of use for C code lookups
        
TYPE_MENU = 2
        
TYPE_CURSOR = 3
        
TYPE_SETWINDOWPOS = 4
        
TYPE_HOOK = 5
        
TYPE_CLIPDATA = 6                'clipboard data
        
TYPE_CALLPROC = 7
        
TYPE_ACCELTABLE = 8
        
TYPE_DDEACCESS = 9
        
TYPE_DDECONV = 10
        
TYPE_DDEXACT = 11                'DDE transaction tracking info.
        
TYPE_MONITOR = 12
        
TYPE_KBDLAYOUT = 13              'Keyboard Layout handle (HKL) object.
        
TYPE_KBDFILE = 14                'Keyboard Layout file object.
        
TYPE_WINEVENTHOOK = 15           'WinEvent hook (EVENTHOOK)
        
TYPE_TIMER = 16
        
TYPE_INPUTCONTEXT = 17           'Input Context info structure
        
TYPE_CTYPES = 18                 'Count of TYPEs; Must be LAST + 1
        
TYPE_GENERIC = 255               'used for generic handle validation
End Enum

Public Enum 
HOOK_TYPE
        WH_MSGFILTER = -
1
        
WH_JOURNALRECORD = 0
        
WH_JOURNALPLAYBACK = 1
        
WH_KEYBOARD = 2
        
WH_GETMESSAGE = 3
        
WH_CALLWNDPROC = 4
        
WH_CBT = 5
        
WH_SYSMSGFILTER = 6
        
WH_MOUSE = 7
        
WH_HARDWARE = 8
        
WH_DEBUG = 9
        
WH_SHELL = 10
        
WH_FOREGROUNDIDLE = 11
        
WH_CALLWNDPROCRET = 12
        
WH_KEYBOARD_LL = 13
        
WH_MOUSE_LL = 14
End Enum

Private 
Type HEAD
        hObject 
As Long
        
cLockObj As Long
End 
Type

Private Type THROBJHEAD
        headinfo 
As HEAD
        pti 
As Long 'PTHREADINFO
End Type

Private Type DESKHEAD
        rpdesk 
As Long 'PDESKTOP
        
pSelf As Long 'PBYTE
End Type

Private Type THRDESKHEAD
        ThreadObjHead 
As THROBJHEAD
        DesktopHead 
As DESKHEAD
End Type

Private Type HOOK  'hk
        
tshead As THRDESKHEAD
        phkNext 
As Long
        
iHook As Integer            '// WH_xxx hook type
        
offPfn As Long
        
flags As Integer            '// HF_xxx flags
        
ihmod As Integer
        
ptiHooked As Long           '//PTHREADINFO - Thread hooked.
        
rpdesk As Long              '// Global hook pdesk. Only used when  hook is locked and owner is destroyed
End Type

Private Type W32THREAD
        pEThread 
As Long
        
RefCount As Long
        
ptlW32 As Long
        
pgdiDcattr As Long
        
pgdiBrushAttr As Long
        
pUMPDObjs As Long
        
pUMPDHeap As Long
        
dwEngAcquireCount As Long
        
pSemTable As Long
        
pUMPDObj As Long
End 
Type

Public Type MsgHookInfo
        hHook 
As Long
        
iHookType As HOOK_TYPE
        pEThread 
As Long
        
offPfn As Long
End 
Type

Private pgSharedInfo As Long

Private Declare Function 
GetModuleHandle _
                
Lib "kernel32.dll" Alias "GetModuleHandleA" _
                                   (
ByVal lpModuleName As StringAs Long
Private Declare Function 
GetProcAddress _
                
Lib "kernel32.dll" (ByVal hModule As Long, _
                                    
ByVal lpProcName As StringAs Long

Private Sub 
LocateSharedInfo() 'locate gSharedInfo
Dim pfnUserRegisterWowHandlers As Long: pfnUserRegisterWowHandlers = GetProcAddress(GetModuleHandle("user32.dll"), "UserRegisterWowHandlers")
Dim As Long
        For 
I = pfnUserRegisterWowHandlers To pfnUserRegisterWowHandlers + &H1000
                
If ((ReadMemoryToInt(I) = &H40C7And _
                    (ReadMemoryToInt(I + 
7) = &H40C7And _
                    (ReadMemoryToInt(I + 
7) = &H40C7And _
                    (ReadMemoryToInt(I + 
7) = &H40C7And _
                    (ReadMemoryToInt(I + 
7) = &H40C7And _
                    (ReadMemoryToInt(I + 
7) = &H40C7)) Then
                        If 
(ReadMemoryToByt(I + 7) = &HB8Then            '40c7: mov dword ptr
                                
Debug.Print "position="; Hex(I)
                                pgSharedInfo = ReadMemoryToLong(I + 
1)
                                Debug.Print "gSharedInfo="; Hex(pgSharedInfo)
                        
End If
                End If
        Next
End Sub

Private Function 
ReadMemoryToInt(ByVal dwAddress As LongAs Integer
Dim 
st As Long
Dim 
ret As Integer
Dim 
nReadBytes As Long
        
st = NtReadVirtualMemory(NtGetCurrentProcess, dwAddress, VarPtr(ret), LenB(ret), nReadBytes)
        ReadMemoryToInt = ret
End Function

Private Function 
ReadMemoryToLong(ByVal dwAddress As LongAs Long
Dim 
st As Long
Dim 
ret As Long
Dim 
nReadBytes As Long
        
st = NtReadVirtualMemory(NtGetCurrentProcess, dwAddress, VarPtr(ret), LenB(ret), nReadBytes)
        ReadMemoryToLong = ret
End Function

Private Function 
ReadMemoryToByt(ByVal dwAddress As LongAs Byte
Dim 
st As Long
Dim 
ret As Byte
Dim 
nReadBytes As Long
        
st = NtReadVirtualMemory(NtGetCurrentProcess, dwAddress, VarPtr(ret), LenB(ret), nReadBytes)
        ReadMemoryToByt = ret
End Function

Public Function 
EnumMsgHook_Init() As Boolean
        Call 
LocateSharedInfo
        EnumMsgHook_Init = (pgSharedInfo <> 
0)
End Function

Public Function 
EnumMsgHook() As MsgHookInfo()
Dim hProcess As Long: hProcess = NtGetCurrentProcess '???
Dim gSharedInfo As SHAREDINFO
Dim gHandleEntries() As HANDLEENTRY
Dim gsi As SERVERINFO
Dim retArray() As MsgHookInfo
Dim st As Long
Dim 
nReadBytes As Long
Dim 
As Long
Dim 
hHookInfo As HOOK
Dim tmpBytArray() As Byte
Dim 
w32thd As W32THREAD
        
ReDim retArray(0)
        st = NtReadVirtualMemory(hProcess, pgSharedInfo, VarPtr(gSharedInfo), LenB(gSharedInfo), nReadBytes)
        
If (Not NT_SUCCESS(st)) Then GoTo ExitFunc__
        st = NtReadVirtualMemory(hProcess, gSharedInfo.psi, VarPtr(gsi), LenB(gsi), nReadBytes)
        
If (Not NT_SUCCESS(st)) Then GoTo ExitFunc__
        
ReDim gHandleEntries(gsi.cHandleEntries - 1)
        st = NtReadVirtualMemory(hProcess, gSharedInfo.aheList, VarPtr(gHandleEntries(LBound(gHandleEntries))), _
                LenB(gHandleEntries(LBound(gHandleEntries))) * gsi.cHandleEntries, nReadBytes)
        
If (Not NT_SUCCESS(st)) Then GoTo ExitFunc__
        
For I = LBound(gHandleEntries) To UBound(gHandleEntries)
                
If (gHandleEntries(I).bType = TYPE_HOOK) Then
                        
'generally, phead is in kernel memory, so we cannot read through NtReadVirtualMemory
                        
ReDim tmpBytArray(LenB(hHookInfo) - 1)
                        
If (DumpKernelMemory(gHandleEntries(I).phead, LenB(hHookInfo), tmpBytArray)) Then
                                If 
(CopyMemory(VarPtr(hHookInfo), VarPtr(tmpBytArray(LBound(tmpBytArray))), LenB(hHookInfo))) Then
                                        With 
retArray(UBound(retArray))
                                                .hHook = hHookInfo.tshead.ThreadObjHead.headinfo.hObject
                                                .iHookType = hHookInfo.iHook
                                                .offPfn = hHookInfo.offPfn
                                                
ReDim tmpBytArray(LenB(w32thd) - 1)
                                                
If (DumpKernelMemory(hHookInfo.tshead.ThreadObjHead.pti, LenB(w32thd), tmpBytArray)) Then
                                                        If 
(CopyMemory(VarPtr(w32thd), VarPtr(tmpBytArray(LBound(tmpBytArray))), LenB(w32thd))) Then
                                                                
.pEThread = w32thd.pEThread
                                                        
End If
                                                End If
                                                
'Debug.Print String(30, "="); vbCrLf; _
                                                '            " hHook:    "; Format(Hex(.hHook), "@@@@@@@@"); vbCrLf; _
                                                '            " offPfn:   "; Format(Hex(.offPfn), "@@@@@@@@"); vbCrLf; _
                                                '            " iHook:    "; .iHookType; vbCrLf; _
                                                '            " pEThread: "; Format(Hex(.pEThread), "@@@@@@@@"); vbCrLf
                                                '======================================================================
                                        
End With
                                        ReDim Preserve 
retArray(UBound(retArray) + 1)
                                
End If
                        End If
                End If
        Next
ExitFunc__:
        
If (UBound(retArray) > 0Then ReDim Preserve retArray(UBound(retArray) - 1)
        EnumMsgHook = retArray
        
Erase retArray
        
Erase tmpBytArray
End Function

Public Function 
CopyMemory(ByVal pDst As LongByVal pSrc As LongByVal nLength As LongAs Boolean
        Dim 
st As Long
        
st = NtWriteVirtualMemory(NtGetCurrentProcess, pDst, pSrc, nLength, ByVal 0)
        CopyMemory = NT_SUCCESS(st)
End Function

Public Function 
NT_SUCCESS(ByVal Status As LongAs Boolean
        
NT_SUCCESS = (Status >= 0)
End Function