Code:
Public Sub GetSSDT(ByVal lst As ListView)
On Error Resume Next
Dim i As Long, j As Long, Length As Long, Buff() As Byte, pKernelName As Long, hKernel As Long
Dim dwKSDT As Long, pService As Long, DosHeader As IMAGE_DOS_HEADER, NtHeader As IMAGE_NT_HEADER
dwServices = 0
ZwQuerySystemInformation SystemModuleInformation, 0, 0, VarPtr(Length)
ReDim Buff(Length - 1)
ZwQuerySystemInformation SystemModuleInformation, VarPtr(Buff(0)), Length, 0
With ModuleInformationFromPtr(VarPtr(Buff(4)))
dwKernelBase = .Base
pKernelName = VarPtr(.ImageName(0)) + .ModuleNameOffset
End With
hKernel = LoadLibraryEx(pKernelName, 0, DONT_RESOLVE_DLL_REFERENCES)
dwKSDT = GetProcAddress(hKernel, "KeServiceDescriptorTable")
Assert dwKSDT <> 0
dwKSDT = dwKSDT - hKernel
dwKiServiceTable = FindKiServiceTable(hKernel, dwKSDT)
Assert dwKiServiceTable <> 0
CopyMemory VarPtr(DosHeader), hKernel, 64
With DosHeader
Assert .e_magic = &H5A4D
CopyMemory VarPtr(NtHeader), hKernel + .e_lfanew, 168
End With
With NtHeader
Assert .Signature = &H4550
Assert .Magic = &H10B
End With
pService = hKernel + dwKiServiceTable
Do While DwordFromPtr(pService) - NtHeader.ImageBase < NtHeader.SizeOfImage
Address1(dwServices) = DwordFromPtr(pService) - NtHeader.ImageBase + dwKernelBase
pService = pService + 4
dwServices = dwServices + 1
Loop
FreeLibrary hKernel
Dim QueryBuff As MEMORY_CHUNKS, ReturnLength As Long
With QueryBuff
.Address = dwKernelBase + dwKiServiceTable
.pData = VarPtr(Address2(0))
.Length = dwServices * 4
End With
ZwSystemDebugControl SysDbgReadVirtualMemory, VarPtr(QueryBuff), 12, 0, 0, VarPtr(ReturnLength)
Length = DwordFromPtr(VarPtr(Buff(0)))
For i = 0 To Length - 1
With ModuleInformationFromPtr(VarPtr(Buff(i * 284 + 4)))
For j = 0 To dwServices - 1
If Address2(j) >= .Base And Address2(j) < .Base + .Size Then
ModuleName(j) = StringFromPtr(VarPtr(.ImageName(0)))
End If
Next
End With
Next
Dim c As OLE_COLOR
With lst.ListItems
.Clear
For i = 0 To dwServices - 1
'RecoverSSDT i - 1
If Address1(i) = Address2(i) Then
c = vbBlack
Else
c = vbRed
End If
With .Add(, , "0x" & AddZero(Hex(i), 4))
.ForeColor = c
With .ListSubItems
.Add(, , FuncName(i)).ForeColor = c
.Add(, , "0x" & AddZero(Hex(Address1(i)), 8)).ForeColor = c
.Add(, , "0x" & AddZero(Hex(Address2(i)), 8)).ForeColor = c
.Add(, , ModuleName(i)).ForeColor = c
End With
End With
Next
WriteSSDT
End With
End Sub
Someone can help read the address hooks in Win 7 32b