Option Explicit
Private Declare Function AdjustTokenPrivileges _
Lib "advapi32.dll" (ByVal TokenHandle As Long, _
ByVal DisableAllPriv As Long, _
ByRef NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
ByRef PreviousState As TOKEN_PRIVILEGES, _
ByRef pReturnLength As Long) As Long
Private Declare Function
GetCurrentProcess _
Lib "kernel32" () As Long
Private Declare Function
GetVersionEx _
Lib "kernel32" _
Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function
LookupPrivilegeValue _
Lib "advapi32.dll" _
Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, _
ByVal lpName As String, _
lpLuid
As LUID) As Long
Private Declare Function
NtSystemDebugControl _
Lib "NTDLL.DLL" (ByVal scCommand As SYSDBG_COMMAND, _
ByVal pInputBuffer As Long, _
ByVal InputBufferLength As Long, _
ByVal pOutputBuffer As Long, _
ByVal OutputBufferLength As Long, _
ByRef pReturnLength As Long) As Long
Private Declare Function
OpenProcessToken _
Lib "advapi32.dll" (ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle
As Long) As Long
'=========Checking OS staff=============
Private Type OSVERSIONINFO
dwOSVersionInfoSize
As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type MEMORY_CHUNKS
Address
As Long
pData As Long
Length As Long
End
Type
Private Type LUID
UsedPart
As Long
IgnoredForNowHigh32BitPart As Long
End
Type '
Private Type TOKEN_PRIVILEGES
PrivilegeCount
As Long
TheLuid As LUID
Attributes
As Long
End
Type
Private Enum SYSDBG_COMMAND
'//以下5个在Windows NT各个版本上都有
SysDbgGetTraceInformation = 1
SysDbgSetInternalBreakpoint = 2
SysDbgSetSpecialCall = 3
SysDbgClearSpecialCalls = 4
SysDbgQuerySpecialCalls = 5
'// 以下是NT 5.1 新增的
SysDbgDbgBreakPointWithStatus = 6
'//获取KdVersionBlock
SysDbgSysGetVersion = 7
'//从内核空间拷贝到用户空间或者从用户空间拷贝到用户空间
'//但是不能从用户空间拷贝到内核空间
SysDbgCopyMemoryChunks_0 = 8

'//SysDbgReadVirtualMemory = 8
'//从用户空间拷贝到内核空间或者从用户空间拷贝到用户空间
'//但是不能从内核空间拷贝到用户空间
SysDbgCopyMemoryChunks_1 = 9
'//SysDbgWriteVirtualMemory = 9
'//从物理地址拷贝到用户空间 不能写到内核空间
SysDbgCopyMemoryChunks_2 = 10
'//SysDbgReadVirtualMemory = 10
'//从用户空间拷贝到物理地址 不能读取内核空间
SysDbgCopyMemoryChunks_3 = 11
'//SysDbgWriteVirtualMemory = 11
'//读写处理器相关控制块
SysDbgSysReadControlSpace = 12
SysDbgSysWriteControlSpace = 13
'//读写端口
SysDbgSysReadIoSpace = 14
SysDbgSysWriteIoSpace = 15
'//分别调用_WRMSR@12
SysDbgSysReadMsr = 16
SysDbgSysWriteMsr = 17
'//读写总线数据
SysDbgSysReadBusData = 18
SysDbgSysWriteBusData = 19
SysDbgSysCheckLowMemory = 20
'// 以下是NT 5.2 新增的
'//分别调用_KdDisableDebugger@0
SysDbgEnableDebugger = 21
SysDbgDisableDebugger = 22
'//获取和设置一些调试相关的变量
SysDbgGetAutoEnableOnEvent = 23
SysDbgSetAutoEnableOnEvent = 24
SysDbgGetPitchDebugger = 25
SysDbgSetDbgPrintBufferSize = 26
SysDbgGetIgnoreUmExceptions = 27
SysDbgSetIgnoreUmExceptions = 28
End Enum
Private Const
SE_DEBUG As String = "SeDebugPrivilege"
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const TOKEN_QUERY As Long = &H8
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Dim VerInfo As OSVERSIONINFO
Public Function GetData(ByVal addr As Long) As Long
Dim
mc As MEMORY_CHUNKS
Dim retv&, retl&
With mc
.Address = addr
.Length = Len(addr)
.pData = VarPtr(retv)
End With
Dim
st As Long
st = NtSystemDebugControl(SysDbgCopyMemoryChunks_0, VarPtr(mc), Len(mc), 0&, 0&, VarPtr(retl))
GetData = retv
If (Not NT_SUCCESS(st)) Then GetData = 0
End Function
Public Function
InitMemoryControl() As Boolean
InitMemoryControl = True
InitMemoryControl = InitMemoryControl And IsSupportedOS
InitMemoryControl = InitMemoryControl
And EnablePrivilege(SE_DEBUG)
End Function
Public Function
IsSupportedOS() As Boolean
On Error GoTo
IsSupportedOS_Err_Hdl
IsSupportedOS =
False
VerInfo.dwOSVersionInfoSize = Len(VerInfo)
If (GetVersionEx(VerInfo)) <> 0 Then
If
VerInfo.dwPlatformId = 2 Then
If
VerInfo.dwMajorVersion = 5 Then
If
(VerInfo.dwMinorVersion > 0) Then
IsSupportedOS = True
End If
End If
End If
End If
IsSupportedOS_Err_Hdl:
End Function
Public Function
SetData(ByVal addr As Long, _
ByVal data As Long) As Boolean
Dim
mc As MEMORY_CHUNKS
Dim retv&, retl&
With mc
.Address = addr
.Length = Len(addr)
.pData = VarPtr(data)
color="#0000FF">End With
Dim st As Long
st = NtSystemDebugControl(SysDbgCopyMemoryChunks_1, VarPtr(mc), Len(mc), 0&, 0&, VarPtr(retl))
SetData = NT_SUCCESS(st)
End Function
Private Function
EnablePrivilege(ByVal seName As String) As Boolean
On Error Resume Next
Dim
p_lngRtn As Long
Dim
p_lngToken As Long
Dim
p_lngBufferLen As Long
Dim
p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES
Or _
TOKEN_QUERY, p_lngToken)
If p_lngRtn = 0 Then
EnablePrivilege = False
Exit Function
End If
If
Err.LastDllError <> 0 Then
EnablePrivilege = False
Exit Function
End If
p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)
If p_lngRtn = 0 Then
EnablePrivilege = False
Exit Function
End If
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.TheLuid = p_typLUID
EnablePrivilege = (AdjustTokenPrivileges(p_lngToken,
False, p_typTokenPriv, Len( _
p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <>
0)
End Function
Private Function
NT_SUCCESS(ByVal nsStatus As Long) As Boolean
NT_SUCCESS = (nsStatus >= 0)
End Function


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!