[此贴子已经被作者于2022-3-20 23:07编辑过]

程序代码：

Private Sub Form_Load()
Const wbemFlagReturnImmediately = &H10
Const wbemFlagForwardOnly = &H20
strComputer = "."
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_SystemDriver", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
'Debug.Print objItem.DisplayName  '驱动名称
Debug.Print objItem.PathName  '驱动路径
Next
End Sub

[此贴子已经被作者于2022-5-15 08:42编辑过]

程序代码：

Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByVal Address As Long, ByVal dwSize As Long, ByVal AllocationType As Long, ByVal Protect As Long) As Long
'Public Declare Function ZwUnloadDriver Lib "ntdll.dll" (DriverServiceName As UNICODE_STRING) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal pDst As Long, _
    ByVal pSrc As Long, _
    ByVal ByteLen As Long)
Private Declare Function NtQuerySystemInformation Lib "ntdll.dll" ( _
    ByVal SystemInformationClass As Long, _
    ByVal pSystemInformation As Long, _
    ByVal SystemInformationLength As Long, _
    ByRef ReturnLength As Long) As Long    
Private Type SYSTEM_MODULE_INFORMATION_ENTRY
    dwReserved(1) As Long
    dwBase As Long
    dwSize As Long
    dwFlags As Long
    Index As Integer
    Unknown As Integer
    LoadCount As Integer
    ModuleNameOffset As Integer
    ImageName As String * 256
End Type
Private Type SYSTEM_MODULE_INFORMATION
    Count As Long
    ModuleInformation As SYSTEM_MODULE_INFORMATION_ENTRY
End Type    
Private Const SystemModuleInformation = 11
Private Const PAGE_READWRITE = &H4
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Public Sub GetKernelModuleList(lvwKernelModule As ListView)
    Dim ret As Long
    Dim Buffer As Long
    Dim ModulesInfo As SYSTEM_MODULE_INFORMATION
    Dim I As Long
    Dim n As Integer: n = 1
    
    NtQuerySystemInformation SystemModuleInformation, 0, 0, ret
    Buffer = VirtualAlloc(0, ret * 2, MEM_COMMIT, PAGE_READWRITE)
    NtQuerySystemInformation SystemModuleInformation, Buffer, ret * 2, ret
    CopyMemory ByVal VarPtr(ModulesInfo), ByVal Buffer, LenB(ModulesInfo)
    I = ModulesInfo.Count
    While (I > 1)
        I = I - 1
        Buffer = Buffer + 71 * 4
        CopyMemory ByVal VarPtr(ModulesInfo), ByVal Buffer, LenB(ModulesInfo)
        lvwKernelModule.ListItems.Add , , n'驱动索引
        'MyMsgBox InStrRev(GetCorrectPath(StrConv(ModulesInfo.ModuleInformation.ImageName, vbUnicode)), "\")
        'MyMsgBox Len(GetCorrectPath(StrConv(ModulesInfo.ModuleInformation.ImageName, vbUnicode)))
        lvwKernelModule.ListItems(n).SubItems(1) = Right(GetCorrectPath(StrConv(ModulesInfo.ModuleInformation.ImageName, vbUnicode)), Len(GetCorrectPath(StrConv(ModulesInfo.ModuleInformation.ImageName, vbUnicode))) - InStrRev(GetCorrectPath(StrConv(ModulesInfo.ModuleInformation.ImageName, vbUnicode)), "\")) '驱动名称
        lvwKernelModule.ListItems(n).SubItems(2) = "0x" & Hex(ModulesInfo.ModuleInformation.dwBase) '驱动基址
        lvwKernelModule.ListItems(n).SubItems(3) = "0x" & Hex(ModulesInfo.ModuleInformation.dwSize) '驱动偏移
        lvwKernelModule.ListItems(n).SubItems(4) = ModulesInfo.ModuleInformation.LoadCount '驱动加载次数
        lvwKernelModule.ListItems(n).SubItems(5) = ModulesInfo.ModuleInformation.dwFlags '驱动标志
        lvwKernelModule.ListItems(n).SubItems(6) = GetCorrectPath(StrConv(ModulesInfo.ModuleInformation.ImageName, vbUnicode)) '驱动路径
        DoEvents
        n = n + 1
    Wend
    Exit Sub
End Sub

Private Function GetCorrectPath(lpPath As String) As String    
    Dim CorrectPath As String    
    CorrectPath = lpPath    
    If InStr(lpPath, "\??\") = 1 Then CorrectPath = Right(lpPath, Len(lpPath) - 4)    
    If InStr(lpPath, "\??\") = 3 Then CorrectPath = Replace(CorrectPath, "\??\", "")    
    CorrectPath = Replace(CorrectPath, "\SystemRoot\", "C:\")    
    If InStr(CorrectPath, "C:") <> 1 Then        
        GetCorrectPath = Left("C:" & CorrectPath, InStr("C:" & CorrectPath, ".") + 3)        
    Else        
        GetCorrectPath = Left(CorrectPath, InStr(CorrectPath, ".") + 3)        
    End If    
    If LCase(Left(GetCorrectPath, 11)) = "c:\system32" Then GetCorrectPath = "c:\windows\system32" & Right(GetCorrectPath, Len(GetCorrectPath) - 11)    
    GetCorrectPath = UCase(Left(GetCorrectPath, 1)) & Right(GetCorrectPath, Len(GetCorrectPath) - 1)
End Function