VB如何遍历驱动程序？ - 编程论坛

#2

约定的童话2022-03-19 08:00

https://blog.
参考下

#3

yuma2022-03-19 18:53

回复 2楼约定的童话

遍历驱动程序，不是遍历驱动器。

#4

apull2022-03-19 20:53

祝你好运

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

#5

yuma2022-03-20 18:30

参考链接没有营养，用Win32_SystemDriver是可以的。

#6

yuma2022-03-21 19:14

程序代码：

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编辑过]

#7

时光流逝2022-05-14 21:31

如果你不嫌麻烦,也可以这样:

程序代码：

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

#8

yuma2022-05-15 08:45

你这代码修改一下还好能运行，只是获取的驱动名称是驱动的文件名，不如我上面WIN32类获取的简洁。其它没有问题。

#9

时光流逝2022-05-15 14:58

但是可以获取驱动基址

#10

独木星空2022-05-15 21:30

都是高手，学习了。