VB 枚举隐藏进程

这篇文章是我翻译了两篇VC文章结合在一起的成果~具体是翻译的文章出处我也不清楚,我也是在网络上找到的希望原作者见谅!此文章是通过获取内核数据枚举EPROCESS结构来枚举进程的.所以现在大部分隐藏进程的程序都可以有一一列出来.在有的机器上运行可能会出错.由于时间关系我只写了检查注释如果有不懂的大家请在这里留言我会一一作答.

下面是VB源码:

VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "读取内存枚举进程"
   ClientHeight    =   4080
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5775
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4080
   ScaleWidth      =   5775
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "退出(&C)"
      Height          =   345
      Left            =   4590
      TabIndex        =   2
      Top             =   3630
      Width           =   1005
   End
   Begin VB.CommandButton cmdRefresh
      Caption         =   "刷新(&R)"
      Height          =   345
      Left            =   3510
      TabIndex        =   1
      Top             =   3630
      Width           =   1005
   End
   Begin VB.ListBox lstProcesses
      Height          =   3480
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5745
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'退出程序
Private Sub cmdExit_Click()
    Unload Me
End Sub

'刷新
Private Sub cmdRefresh_Click()
    Me.lstProcesses.Clear
    PrintProcesses
End Sub

Private Sub Form_Load()
    '判断系统版本如果是2K以下的系统就报错退出
    If GetVersionName = "不支持" Then
        MsgBox "不支持此操作系统！！", vbCritical, "提示"
        Unload Me: End
    End If
    '获取Debug权限这是必须的
    EnablePrivilege
    '获取常规下的进程
    GetProcesses
    '打印进程
    PrintProcesses
End Sub

Attribute VB_Name = "modEnumProcesses"
Option Explicit
'利用PSAPI枚举进程
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
'常规模式下的进程集合
Public lngProcArr() As Long
'常规模式枚举进程
Public Function GetProcesses() As Long()
    Dim lngCbNeeded As Long
    Dim lngNumElements As Long, lngRet As Long
    ReDim lngProcArr(1024)
    lngRet = EnumProcesses(lngProcArr(0), 4 * 1024, lngCbNeeded)
    lngNumElements = lngCbNeeded / 4
    ReDim Preserve lngProcArr(lngNumElements - 1)
    GetProcesses = lngProcArr
End Function

'判断指定进程是否为隐藏进程
Public Function IsHideProcess(ByVal strProcessId As String) As Boolean
    Dim i As Integer
    For i = 0 To UBound(lngProcArr)
        If CStr(lngProcArr(i)) = CStr(Val(strProcessId)) Then
            IsHideProcess = False
            Exit Function
        End If
    Next
    IsHideProcess = True
End Function

Attribute VB_Name = "modKernel"
Option Explicit

'typedef struct _SYSTEM_MODULE
'{
'    ULONG   Reserved[2];
'    ULONG   Base;
'    ULONG   Size;
'    ULONG   Flags;
'    USHORT  Index;
'    USHORT  Unknown;
'    USHORT  LoadCount;
'    USHORT  ModuleNameOffset;
'    CHAR    ImageName[256];
'} SYSTEM_MODULE, *PSYSTEM_MODULE;

Private Type SYSTEM_MODULE
    Reserved(0 To 1) As Long
    Base As Long
    Size As Long
    Flags As Long
    Index As Integer
    Unknown As Integer
    LoadCount As Integer
    ModuleNameOffset As Integer
    ImageName(255) As Byte
End Type

'typedef struct _MEMORY_CHUNKS {
'    ULONG Address;
'    PVOID Data;
'    ULONG Length;
'}MEMORY_CHUNKS, *PMEMORY_CHUNKS;

Private Type MEMORY_CHUNKS
    Address As Long
    Data As Long
    Length As Long
End Type

'typedef 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,
'
'    //分别调用RDMSR@4和_WRMSR@12
'    SysDbgSysReadMsr = 16,
'    SysDbgSysWriteMsr = 17,
'
'    //读写总线数据
'    SysDbgSysReadBusData = 18,
'    SysDbgSysWriteBusData = 19,
'
'    SysDbgSysCheckLowMemory = 20,
'
'// 以下是NT 5.2 新增的
'
'    //分别调用_KdEnableDebugger@0和_KdDisableDebugger@0
'    SysDbgEnableDebugger = 21,
'    SysDbgDisableDebugger = 22,
'
'    //获取和设置一些调试相关的变量
'    SysDbgGetAutoEnableOnEvent = 23,
'    SysDbgSetAutoEnableOnEvent = 24,
'    SysDbgGetPitchDebugger = 25,
'    SysDbgSetDbgPrintBufferSize = 26,
'    SysDbgGetIgnoreUmExceptions = 27,
'    SysDbgSetIgnoreUmExceptions = 28
'} SYSDBG_COMMAND, *PSYSDBG_COMMAND;

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

    '//分别调用RDMSR@4和_WRMSR@12
    SysDbgSysReadMsr = 16
    SysDbgSysWriteMsr = 17

    '//读写总线数据
    SysDbgSysReadBusData = 18
    SysDbgSysWriteBusData = 19

    SysDbgSysCheckLowMemory = 20

    '// 以下是NT 5.2 新增的

    '//分别调用_KdEnableDebugger@0和_KdDisableDebugger@0
    SysDbgEnableDebugger = 21
    SysDbgDisableDebugger = 22

    '//获取和设置一些调试相关的变量
    SysDbgGetAutoEnableOnEvent = 23
    SysDbgSetAutoEnableOnEvent = 24
    SysDbgGetPitchDebugger = 25
    SysDbgSetDbgPrintBufferSize = 26
    SysDbgGetIgnoreUmExceptions = 27
    SysDbgSetIgnoreUmExceptions = 28
End Enum

'读写内核空间函数
Private Declare Function NtSystemDebugControl Lib "NTDLL.DLL" (ByVal ControlCode As SYSDBG_COMMAND, _
                                ByRef InputBuffer As Any, _
                                ByVal InputBufferLength As Long, _
                                ByRef OutputBuffer As Any, _
                                ByVal OutputBufferLength As Long, _
                                ByRef ReturnLength As Long) As Long
'枚举Kernel Module函数
Private Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" (ByVal SystemInformationClass As SYSTEM_INFORMATION_CLASS, _
                                ByVal pSystemInformation As Long, _
                                ByVal SystemInformationLength As Long, _
                                ByRef ReturnLength As Long) As Long
                               
Private Enum SYSTEM_INFORMATION_CLASS
    SystemBasicInformation
    SystemProcessorInformation             '// obsolete...delete
    SystemPerformanceInformation
    SystemTimeOfDayInformation
    SystemPathInformation
    SystemProcessInformation
    SystemCallCountInformation
    SystemDeviceInformation
    SystemProcessorPerformanceInformation
    SystemFlagsInformation
    SystemCallTimeInformation
    SystemModuleInformation
    SystemLocksInformation
    SystemStackTraceInformation
    SystemPagedPoolInformation
    SystemNonPagedPoolInformation
    SystemHandleInformation
    SystemObjectInformation
    SystemPageFileInformation
    SystemVdmInstemulInformation
    SystemVdmBopInformation
    SystemFileCacheInformation
    SystemPoolTagInformation
    SystemInterruptInformation
    SystemDpcBehaviorInformation
    SystemFullMemoryInformation
    SystemLoadGdiDriverInformation
    SystemUnloadGdiDriverInformation
    SystemTimeAdjustmentInformation
    SystemSummaryMemoryInformation
    SystemMirrorMemoryInformation
    SystemPerformanceTraceInformation
    SystemObsolete0
    SystemExceptionInformation
    SystemCrashDumpStateInformation
    SystemKernelDebuggerInformation
    SystemContextSwitchInformation
    SystemRegistryQuotaInformation
    SystemExtendServiceTableInformation
    SystemPrioritySeperation
    SystemVerifierAddDriverInformation
    SystemVerifierRemoveDriverInformation
    SystemProcessorIdleInformation
    SystemLegacyDriverInformation
    SystemCurrentTimeZoneInformation
    SystemLookasideInformation
    SystemTimeSlipNotification
    SystemSessionCreate
    SystemSessionDetach
    SystemSessionInformation
    SystemRangeStartInformation
    SystemVerifierInformation
    SystemVerifierThunkExtend
    SystemSessionProcessInformation
    SystemLoadGdiDriverInSystemSpace
    SystemNumaProcessorMap
    SystemPrefetcherInformation
    SystemExtendedProcessInformation
    SystemRecommendedSharedDataAlignment
    SystemComPlusPackage
    SystemNumaAvailableMemory
    SystemProcessorPowerInformation
    SystemEmulationBasicInformation
    SystemEmulationProcessorInformation
    SystemExtendedHandleInformation
    SystemLostDelayedWriteInformation
    SystemBigPoolInformation
    SystemSessionPoolTagInformation
    SystemSessionMappedViewInformation
    SystemHotpatchInformation
    SystemObjectSecurityMode
    SystemWatchdogTimerHandler
    SystemWatchdogTimerInformation
    SystemLogicalProcessorInformation
    SystemWow64SharedInformation
    SystemRegisterFirmwareTableInformationHandler
    SystemFirmwareTableInformation
    SystemModuleInformationEx
    SystemVerifierTriageInformation
    SystemSuperfetchInformation
    SystemMemoryListInformation
    SystemFileCacheInformationEx
    MaxSystemInfoClass  '// MaxSystemInfoClass should always be the last enum
End Enum

Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004

Private Type OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As Long
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type

Private Enum MULTIPLE_TRUSTEE_OPERATION
    NO_MULTIPLE_TRUSTEE
    TRUSTEE_IS_IMPERSONATE
End Enum

Private Enum TRUSTEE_FORM
    TRUSTEE_IS_SID
    TRUSTEE_IS_NAME
End Enum

Private Enum TRUSTEE_TYPE
    TRUSTEE_IS_UNKNOWN
    TRUSTEE_IS_USER
    TRUSTEE_IS_GROUP
End Enum

Private Enum ACCESS_MODE
    NOT_USED_ACCESS
    GRANT_ACCESS
    SET_ACCESS
    DENY_ACCESS
    REVOKE_ACCESS
    SET_AUDIT_SUCCESS
    SET_AUDIT_FAILURE
End Enum

Private Type TRUSTEE
    pMultipleTrustee            As Long
    MultipleTrusteeOperation    As MULTIPLE_TRUSTEE_OPERATION
    TrusteeForm                 As TRUSTEE_FORM
    TrusteeType                 As TRUSTEE_TYPE
    ptstrName                   As String
End Type

Private Type EXPLICIT_ACCESS
    grfAccessPermissions        As Long
    grfAccessMode               As ACCESS_MODE
    grfInheritance              As Long
    TRUSTEE                     As TRUSTEE
End Type

Private Enum SE_OBJECT_TYPE
    SE_UNKNOWN_OBJECT_TYPE = 0
    SE_FILE_OBJECT
    SE_SERVICE
    SE_PRINTER
    SE_REGISTRY_KEY
    SE_LMSHARE
    SE_KERNEL_OBJECT
    SE_WINDOW_OBJECT
    SE_DS_OBJECT
    SE_DS_OBJECT_ALL
    SE_PROVIDER_DEFINED_OBJECT
    SE_WMIGUID_OBJECT
End Enum
Private Const DACL_SECURITY_INFORMATION = &H4

Private Declare Function SetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ppsidOwner As Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any) As Long
Private Declare Function GetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ppsidOwner As Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any, ppSecurityDeor As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Any) As Long
Private Declare Function SetEntriesInAcl Lib "advapi32.dll" Alias "SetEntriesInAclA" (ByVal cCountOfExplicitEntries As Long, pListOfExplicitEntries As EXPLICIT_ACCESS, ByVal OldAcl As Long, NewAcl As Long) As Long
Private Declare Sub BuildExplicitAccessWithName Lib "advapi32.dll" Alias "BuildExplicitAccessWithNameA" (pExplicitAccess As EXPLICIT_ACCESS, ByVal pTrusteeName As String, ByVal AccessPermissions As Long, ByVal AccessMode As ACCESS_MODE, ByVal Inheritance As Long)

Private Declare Function NtClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                      ByRef Source As Any, _
                                      ByVal Length As Long)
                                     
Private Declare Sub RtlInitUnicodeString Lib "NTDLL.DLL" (DestinationString As UNICODE_STRING, ByVal SourceString As Long)

Private Declare Function NtOpenSection Lib "NTDLL.DLL" (SectionHandle As Long, ByVal DesiredAccess As Long, ObjectAttributes As Any) As Long
                                
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
               
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, _
                                ByVal dwDesiredAccess As Long, _
                                ByVal dwFileOffsetHigh As Long, _
                                ByVal dwFileOffsetLow As Long, _
                                ByVal dwNumberOfBytesToMap As Long) As Long
'
'typedef struct _UNICODE_STRING
'{
'    USHORT Length;
'    USHORT MaximumLength;
'    PWSTR Buffer;
'} UNICODE_STRING, *PUNICODE_STRING;
Private Type UNICODE_STRING
    uLength As Integer
    uMaximumLength As Integer
    pBuffer(3) As Byte
End Type
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const STATUS_INFO_LEN_MISMATCH = &HC0000004
Private Const STATUS_ACCESS_DENIED = &HC0000022
Private Const SECTION_MAP_WRITE = &H2
Private Const SECTION_MAP_READ = &H4
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const NO_INHERITANCE = 0
Public g_hMPM As Long
Public g_pMapPhysicalMemory As Long

'判断Nt系列函数是否调用成功
Private Function NT_SUCCESS(ByVal nStatus As Long) As Boolean
    NT_SUCCESS = (nStatus >= 0)
End Function

'获取ntoskrnl.exe的地址
Public Function GetKernelModuleBase() As Long
    Dim bytBuf() As Byte
    Dim nSize As Long, ntStatus As Long, lngModuleCount As Long
    Dim objModules() As SYSTEM_MODULE
    Dim i As Integer
    nSize = 1
    Do
        ReDim bytBuf(nSize)
        ntStatus = NtQuerySystemInformation(SystemModuleInformation, VarPtr(bytBuf(0)), nSize, 0&)
        If (Not NT_SUCCESS(ntStatus)) Then
            If (ntStatus <> STATUS_INFO_LENGTH_MISMATCH) Then
                Erase bytBuf
                Exit Function
            End If
        Else
            Exit Do
        End If
        nSize = nSize * 2
        ReDim bytBuf(nSize)
    Loop
    CopyMemory lngModuleCount, bytBuf(0), 4
    ReDim objModules(lngModuleCount - 1)
    CopyMemory objModules(0), bytBuf(4), Len(objModules(0)) * lngModuleCount
    For i = 0 To lngModuleCount - 1
        'Kernel Module路径
        Debug.Print StrConv(objModules(i).ImageName, vbUnicode)
        If InStr(LCase(StrConv(objModules(i).ImageName, vbUnicode)), "ntoskrnl.exe") Then
            'ntoskrnl.exe地址
            GetKernelModuleBase = objModules(i).Base
            Exit Function
        End If
    Next
End Function

'使物理内存可写
Private Sub SetPhyscialMemorySectionCanBeWrited(ByVal hSection As Long)
    Dim pDacl As Long
    Dim pNewDacl As Long
    Dim pSD As Long
    Dim dwRes As Long
    Dim ea As EXPLICIT_ACCESS
    '获取PhysicalMemory的DACL
    GetSecurityInfo hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, 0, 0, pDacl, 0, pSD
    '创建一个ACE，允许当前用户读写PhysicalMemory
    ea.grfAccessPermissions = SECTION_MAP_WRITE
    ea.grfAccessMode = GRANT_ACCESS
    ea.grfInheritance = NO_INHERITANCE
    ea.TRUSTEE.TrusteeForm = TRUSTEE_IS_NAME
    ea.TRUSTEE.TrusteeType = TRUSTEE_IS_USER
    ea.TRUSTEE.ptstrName = "CURRENT_USER" & vbNullChar
    '将新的ACE加入DACL
    SetEntriesInAcl 1, ea, pDacl, pNewDacl
    '更新PhysicalMemory的DACL
    SetSecurityInfo hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, 0, 0, ByVal pNewDacl, 0
                               
    LocalFree pSD
    LocalFree pNewDacl
End Sub

'获取内核空间数据
Public Function GetData(ByVal lngAddr As Long) As Long
    Dim strVersion As String
    Dim objQueryBuff As MEMORY_CHUNKS
    Dim bytBuff(767) As Byte
    Dim lngReturn As Long
    Dim ntStatus As Long
    strVersion = GetVersionName
    If strVersion <> "win2k" Then
        objQueryBuff.Address = lngAddr
        objQueryBuff.Data = VarPtr(bytBuff(0))
        objQueryBuff.Length = 768
        ntStatus = NtSystemDebugControl(SysDbgCopyMemoryChunks_0, objQueryBuff, Len(objQueryBuff), ByVal 0&, 0, lngReturn)
        If NT_SUCCESS(ntStatus) Then
            CopyMemory lngReturn, bytBuff(0), 4
            GetData = lngReturn
            Exit Function
        End If
    Else
        Dim lngPhys As Long, lngTmp As Long
        lngPhys = LinearToPhys(g_pMapPhysicalMemory, lngAddr)
        'FILE_MAP_ALL_ACCESS
        lngTmp = MapViewOfFile(g_hMPM, 4, 0, lngPhys And &HFFFFF000, &H1000)
        If lngTmp = 0 Then
            GetData = 0
            Exit Function
        End If
        lngReturn = lngTmp + ((lngPhys And &HFFF) / (2 ^ 2)) * 4
        CopyMemory lngReturn, ByVal lngReturn, 4
        'ret=tmp[(phys & 0xFFF)>>2];
        GetData = lngReturn
        UnmapViewOfFile lngTmp
    End If
End Function

'获取进程PID
Public Function GetPID(ByVal lngAddr As Long) As Long
    Dim strVersion As String
    Dim objQueryBuff As MEMORY_CHUNKS
    Dim bytBuff(3) As Byte
    Dim lngReturn As Long
    Dim ntStatus As Long
    strVersion = GetVersionName
    If strVersion <> "win2k" Then
        objQueryBuff.Address = lngAddr
        objQueryBuff.Data = VarPtr(bytBuff(0))
        objQueryBuff.Length = 4
        ntStatus = NtSystemDebugControl(SysDbgCopyMemoryChunks_0, objQueryBuff, Len(objQueryBuff), ByVal 0&, 0, lngReturn)
        If NT_SUCCESS(ntStatus) Then
            CopyMemory lngReturn, bytBuff(0), 4
            GetPID = lngReturn
            Exit Function
        End If
    Else
        Dim lngPhys As Long, lngTmp As Long
        lngPhys = LinearToPhys(g_pMapPhysicalMemory, lngAddr)
        'FILE_MAP_ALL_ACCESS
        lngTmp = MapViewOfFile(g_hMPM, 4, 0, lngPhys And &HFFFFF000, &H1000)
        If lngTmp = 0 Then
            GetPID = 0
            Exit Function
        End If
        lngReturn = lngTmp + ((lngPhys And &HFFF) / (2 ^ 2)) * 4
        CopyMemory lngReturn, ByVal lngReturn, 4
        GetPID = lngReturn
        'ret=tmp[(phys & 0xFFF)>>2];
        UnmapViewOfFile lngTmp
    End If
End Function

'转换成进程名
Private Function ByteArrToString(bytBuff() As Byte) As String
    Dim i As Integer, bytOut() As Byte
    For i = 0 To UBound(bytBuff)
        If bytBuff(i) = 0 Then
            Exit For
        End If
        ReDim Preserve bytOut(0 To i)
        bytOut(i) = bytBuff(i)
    Next
    If i > 0 Then
        ByteArrToString = StrConv(bytOut, vbUnicode)
    End If
End Function

'获取进程名
Public Function GetProcessName(ByVal lngAddr As Long) As String
    Dim strVersion As String
    Dim objQueryBuff As MEMORY_CHUNKS
    Dim bytBuff(15) As Byte
    Dim lngReturn As Long
    Dim ntStatus As Long
    Dim strOut As String
    strVersion = GetVersionName
    If strVersion <> "win2k" Then
        objQueryBuff.Address = lngAddr
        objQueryBuff.Data = VarPtr(bytBuff(0))
        objQueryBuff.Length = 16
        ntStatus = NtSystemDebugControl(SysDbgCopyMemoryChunks_0, objQueryBuff, Len(objQueryBuff), ByVal 0&, 0, lngReturn)
        If NT_SUCCESS(ntStatus) Then
'            CopyMemory bytBuff(0), bytBuff(0), 16
            strOut = ByteArrToString(bytBuff)
            GetProcessName = strOut
            Exit Function
        End If
    Else
        Dim lngPhys As Long, lngTmp As Long
        lngPhys = LinearToPhys(g_pMapPhysicalMemory, lngAddr)
        'FILE_MAP_ALL_ACCESS
        lngTmp = MapViewOfFile(g_hMPM, 4, 0, lngPhys And &HFFFFF000, &H1000)
        If lngTmp = 0 Then
            GetProcessName = ""
            Exit Function
        End If
        lngReturn = lngTmp + ((lngPhys And &HFFF) / (2 ^ 2)) * 4
        CopyMemory bytBuff(0), ByVal lngReturn, 16
        strOut = ByteArrToString(bytBuff) 'StrConv(bytBuff(0), vbUnicode)
        GetProcessName = strOut
        'ret=tmp[(phys & 0xFFF)>>2];
        UnmapViewOfFile lngTmp
    End If
End Function

Private Function ByteArrToLong(bytBuff() As Byte) As Double
    Dim i As Integer
    For i = 0 To 3
        ByteArrToLong = ByteArrToLong + bytBuff(i) * (&H100 ^ i)
    Next i
End Function

'将物理内存影射到进程空间
Private Function LinearToPhys(lngBaseAddress As Long, lngAddr As Long) As Long
    Dim VAddr As Long, PGDE As Long, PTE As Long, PAddr As Long
    Dim lTemp As Long, bytBuff(3) As Byte
    VAddr = lngAddr
    CopyMemory bytBuff(0), VAddr, 4
    lTemp = Fix(ByteArrToLong(bytBuff) / (2 ^ 22))
    PGDE = lngBaseAddress + lTemp * 4
    CopyMemory PGDE, ByVal PGDE, 4
    If (PGDE And 1) <> 0 Then
        lTemp = PGDE And &H80
        If lTemp <> 0 Then
            PAddr = (PGDE And &HFFC00000) + (VAddr And &H3FFFFF)
        Else
            PGDE = MapViewOfFile(g_hMPM, 4, 0, PGDE And &HFFFFF000, &H1000)
            lTemp = (VAddr And &H3FF000) / (2 ^ 12)
            PTE = PGDE + lTemp * 4
            CopyMemory PTE, ByVal PTE, 4
            If (PTE And 1) <> 0 Then
                PAddr = (PTE And &HFFFFF000) + (VAddr And &HFFF)
                UnmapViewOfFile PGDE
            End If
        End If
    End If
    LinearToPhys = PAddr
End Function

'获取/Device/PhysicalMemory的可读写句柄
Public Function OpenPhysicalMemory() As Long
    Dim ntStatus As Long
    Dim objPhysmemString As UNICODE_STRING
    Dim objAttributes As OBJECT_ATTRIBUTES
    Dim strVersion As String
    strVersion = GetVersionName
    RtlInitUnicodeString objPhysmemString, StrPtr("/Device/PhysicalMemory")
    objAttributes.Length = Len(objAttributes)
    objAttributes.RootDirectory = 0
    objAttributes.ObjectName = VarPtr(objPhysmemString)
    objAttributes.Attributes = 0
    objAttributes.SecurityDescriptor = 0
    objAttributes.SecurityQualityOfService = 0
    '以可读写Section权限打开PhysicalMemory
    ntStatus = NtOpenSection(g_hMPM, SECTION_MAP_READ Or SECTION_MAP_WRITE, objAttributes)
    '错误，但非权限不足，打开失败
    If ntStatus = STATUS_ACCESS_DENIED Then
        '以可读写ACL权限打开PhysicalMemory
        ntStatus = NtOpenSection(g_hMPM, READ_CONTROL Or WRITE_DAC, objAttributes)
        '使物理内存可写
        SetPhyscialMemorySectionCanBeWrited g_hMPM
        CloseHandle g_hMPM
        '再次以可读写权限打开PhysicalMemory
        ntStatus = NtOpenSection(g_hMPM, SECTION_MAP_READ Or SECTION_MAP_WRITE, objAttributes)
    End If
   
    If Not NT_SUCCESS(ntStatus) Then
        OpenPhysicalMemory = 0
        Exit Function
    End If
    g_pMapPhysicalMemory = MapViewOfFile(g_hMPM, 4, 0, &H30000, &H1000)
    If g_pMapPhysicalMemory <> 0 Then OpenPhysicalMemory = g_hMPM
End Function

Public Sub PrintProcesses()
    Dim lngKernel As Long, pKernel As Long, lngStartProcAddr As Long, lngBaseAddr As Long
    Dim objAddr As Long, strProcessName As String, strEAddr As String, strProcessId As String
    Dim objEndAddr As Long, lngPID As Long, lngName As Long, lngAName As Long, lngTmp As Long
    Dim strVersion As String, lngSName As Long, lngAList As Long, lngSList As Long
    '在用户态加载一份ntoskrnl.exe
    lngKernel = LoadLibrary("ntoskrnl.exe")
    '获取System进程内核例程/变量在用户态的相对位置
    lngStartProcAddr = GetProcAddress(lngKernel, "PsInitialSystemProcess")
    '获取系统核心模块ntoskrnl.exe的基址
    lngBaseAddr = GetKernelModuleBase()
    'System进程内核例程/变量的实际地址
    lngStartProcAddr = lngStartProcAddr + lngBaseAddr - lngKernel
   
'    strEAddr = "0x" & Hex(lngStartProcAddr)
    '释放ntoskrnl.exe
    FreeLibrary lngKernel
    '获取系统版本
    strVersion = GetVersionName
    If strVersion = "win2k" Then
        lngPID = 156
        lngName = &H1FC
        lngSName = 264
        lngAName = 348
        lngSList = 244
        lngAList = 160
        '打开物理内存如果失败就退出程序
        If OpenPhysicalMemory = 0 Then
            End
        End If
    ElseIf strVersion = "winxp" Then
        lngPID = 132
        lngName = &H174
        lngSName = 192
        lngAName = 236
        lngSList = 180
        lngAList = 136
    Else
        lngPID = 132
        lngName = &H154
        lngSName = 160
        lngAName = 204
        lngSList = 180
        lngAList = 136
    End If
    '从内核空间获取System进程的EPROCESS结构
    objAddr = GetData(lngStartProcAddr)
    '获取System进程的EPROCESS地址
    strEAddr = "0x" & Hex(objAddr)
    'strProcessId = Format(CStr(GetPID(objAddr + 132)), "0000")
    '获取System进程的PID
    strProcessId = Format(CStr(GetPID(objAddr + lngPID)), "0000")
    'strProcessName = GetProcessName(objAddr + &H174)
    '获取System进程的名
    strProcessName = GetProcessName(objAddr + lngName)
    lngTmp = (objAddr + lngName) - (objAddr + lngPID) '进程名和进程ID之间的差值方便后面遍历
    '打印进程信息
    frmMain.lstProcesses.AddItem "PID: " & strProcessId & "   EPROCESS: " & strEAddr & "   ImageName: " & strProcessName
    'objAddr = GetData(objAddr + 136)
    '从内核空间获取SMSS.EXE进程的EPROCESS结构
    objAddr = GetData(objAddr + lngAList)
    'strEAddr = "0x" & Hex(objAddr - 136)
    '获取SMSS.EXE进程的EPROCESS地址
    strEAddr = "0x" & Hex(objAddr - lngAList)
    'strProcessId = Format(CStr(GetPID(objAddr - 4)), "0000")
    '获取SMSS.EXE进程的PID
    strProcessId = Format(CStr(GetPID(objAddr - lngAList + lngPID)), "0000")
    'strProcessName = GetProcessName(objAddr + 236)
    '获取SMSS.EXE进程的名
    strProcessName = GetProcessName(objAddr + lngName - lngAList)
    '打印进程信息
    frmMain.lstProcesses.AddItem "PID: " & strProcessId & "   EPROCESS: " & strEAddr & "   ImageName: " & strProcessName
    '获取第一个遍历EPROCESS结构
    objAddr = GetData(objAddr)
    'objAddr = objAddr - 136 + 180
    objAddr = objAddr - lngAList + lngSList
    objEndAddr = objAddr
    '遍历ActiveProcessLinks
    Do
        If objAddr > &HFFFF0000 Then
            Exit Do
        End If
        'strEAddr = "0x" & Hex(objAddr - 180)
        '获取XXX进程的EPROCESS地址
        strEAddr = "0x" & Hex(objAddr - lngSList)
        'strProcessId = Format(CStr(GetPID(objAddr + 192 - 240)), "0000")
         '获取XXX进程的PID
        strProcessId = Format(CStr(GetPID(objAddr + lngSName - lngTmp)), "0000")
        If strProcessId = "0000" Then Exit Do
        'strProcessName = GetProcessName(objAddr + 192)
        '获取XXX进程的名
        strProcessName = GetProcessName(objAddr + lngSName)
        '检测是否为隐藏进程
        If IsHideProcess(strProcessId) And Val(strProcessId) > 4 Then
            frmMain.lstProcesses.AddItem "隐藏PID: " & strProcessId & "   EPROCESS: " & strEAddr & "   ImageName: " & strProcessName
        Else
            If Val(strProcessId) > 4 Then
                frmMain.lstProcesses.AddItem "PID: " & strProcessId & "   EPROCESS: " & strEAddr & "   ImageName: " & strProcessName
            End If
        End If
        objAddr = GetData(objAddr)
    Loop While objAddr <> 0 And objEndAddr <> objAddr
    frmMain.Caption = "读取内存枚举进程" & " (进程总数：" & frmMain.lstProcesses.ListCount & "+1" & ")"
End Sub

Attribute VB_Name = "modPrivilege"
Option Explicit

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ALL_ACCESS = 983551
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const SE_DEBUG_NAME = "SeDebugPrivilege"

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!
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 GetCurrentProcess Lib "kernel32" () As Long '获取当前进程句柄

'获取Debug权限
Public Function EnablePrivilege() As Boolean
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
    Dim lp As Long
    hdlProcessHandle = GetCurrentProcess()
    lp = OpenProcessToken(hdlProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hdlTokenHandle)
    lp = LookupPrivilegeValue(vbNullString, "SeDebugPrivilege", tmpLuid)
    tkp.PrivilegeCount = 1
    tkp.Privileges(0).pLuid = tmpLuid
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    EnablePrivilege = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
End Function

Attribute VB_Name = "modPublic"
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Function GetVersionName() As String '获取操作系统名称
    Dim objOSInfo As OSVERSIONINFO
    Dim ret As Long
    objOSInfo.dwOSVersionInfoSize = Len(objOSInfo)
    '获得系统的版本号
    Call GetVersionEx(objOSInfo)
    Select Case objOSInfo.dwBuildNumber
        Case 2195
            GetVersionName = "win2k"
        Case 2600
            GetVersionName = "winxp"
        Case 3790
            GetVersionName = "win2k3"
        Case Else
            GetVersionName = "不支持"
    End Select
End Function