VB 驅動加載類(直接使用NtLoadDriver加載方式)

加載驅動需要有加載驅動的權限
使用前先加載“SE_LOAD_DRIVER_PRIVILEGE”權限
Option Explicit
Private Const STATUS_IMAGE_ALREADY_LOADED = 
Private Const HKEY_CLASSES_ROOT = 
Private Const HKEY_CURRENT_USER = 
Private Const HKEY_LOCAL_MACHINE = 
Private Const HKEY_USERS = 
Private Const HKEY_PERFORMANCE_DATA = 
Private Const HKEY_CURRENT_CONFIG = 
Private Const HKEY_DYN_DATA = 
Private Const REG_SZ = 1                            ' 字符串值 
Private Const REG_EXPAND_SZ = 2                     ' 可擴充字符串值 
Private Const REG_BINARY = 3                        ' 二進制值 
Private Const REG_DWORD = 4                         ' DWORD值 
Private Const REG_MULTI_SZ = 7
Private Const READ_CONTROL = 
Private Const KEY_QUERY_VALUE = 
Private Const KEY_SET_VALUE = 
Private Const KEY_CREATE_SUB_KEY = 
Private Const KEY_ENUMERATE_SUB_KEYS = 
Private Const KEY_NOTIFY = 
Private Const KEY_CREATE_LINK = 
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Private Const KEY_EXECUTE = KEY_READ
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
Private Type UNICODE_STRING
    uLength As Integer
    uMaximumLength As Integer
    pBuffer As Long
End Type
Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" (DestinationString As Any, ByVal SourceString As Long)
Private Declare Function NtLoadDriver Lib "ntdll.dll" (ByVal DriverServiceName As Long) As Long
Private Declare Function NtUnloadDriver Lib "ntdll.dll" (ByVal DriverServiceName As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, _
                                                                                    ByVal lpSubKey As String, _
                                                                                    ByVal Reserved As Long, _
                                                                                    ByVal lpClass As String, _
                                                                                    ByVal dwOptions As Long, _
                                                                                    ByVal samDesired As Long, _
                                                                                    lpSecurityAttributes As Any, _
                                                                                    phkResult As Long, _
                                                                                    lpdwDisposition As Long _
                                                                                    ) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _
                                                                                  ByVal lpValueName As String, _
                                                                                  ByVal Reserved As Long, _
                                                                                  ByVal dwType As Long, _
                                                                                  lpData As Any, _
                                                                                  ByVal cbData As Long _
                                                                                  ) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, _
                                                                            ByVal lpSubKey As String, _
                                                                            phkResult As Long _
                                                                            ) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, _
                                                                                ByVal lpSubKey As String _
                                                                                ) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'驅動控制相關 
Private Const OPEN_EXISTING As Long = 3
Private Const GENERIC_READ As Long = 
Private Const GENERIC_WRITE As Long = 
Private Const FILE_ATTRIBUTE_NORMAL = 
Private Const FILE_DEVICE_UNKNOWN As Long = 
Private Const FILE_SHARE_READ = 
Private Const FILE_SHARE_WRITE = 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32.DLL" (ByVal hObject As Long) As Long
Private Declare Function DeviceIoControl Lib "KERNEL32.DLL" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByRef lpOverlapped As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private mstrDriverName As String '驅動名稱 
Private mstrDisplayName As String
Private mhManager As Long
Private mhDriver As Long
Private mblnShare As Boolean
Public Function CHLoadDriver(ByVal lpDriverPath As String) As Boolean
    Dim lngSuccess As Long
    Dim hKey As Long
    Dim DriverPath As UNICODE_STRING
    lpDriverPath = "/??/" & lpDriverPath
    lngSuccess = RegCreateKeyEx(HKEY_LOCAL_MACHINE, _
                                "System/CurrentControlSet/Services/" & mstrDriverName, _
                                0, _
                                vbNullString, _
                                0, _
                                KEY_ALL_ACCESS, _
                                ByVal 0&, _
                                hKey, _
                                ByVal 0& _
                                )
    If lngSuccess <> 0 Then
        Exit Function
    End If
    lngSuccess = RegSetValueEx(hKey, _
                               "Type", _
                               0, _
                               REG_DWORD, _
                               1, _
                               4 _
                               )
    If lngSuccess <> 0 Then
        RegCloseKey hKey
        Exit Function
    End If
    lngSuccess = RegSetValueEx(hKey, _
                               "ErrorControl", _
                               0, _
                               REG_DWORD, _
                               1, _
                               4 _
                               )
    If lngSuccess <> 0 Then
        RegCloseKey hKey
        Exit Function
    End If
    lngSuccess = RegSetValueEx(hKey, _
                               "Start", _
                               0, _
                               REG_DWORD, _
                               3, _
                               4 _
                               )
    If lngSuccess <> 0 Then
        RegCloseKey hKey
        Exit Function
    End If
    lngSuccess = RegSetValueEx(hKey, _
                               "ImagePath", _
                               0, _
                               REG_EXPAND_SZ, _
                               ByVal lpDriverPath, _
                               lstrlen(lpDriverPath) _
                               ) 'Len(lpDriverPath) '這裏不能用len也不能用lenb不然有中文目錄時會出錯 
    If lngSuccess <> 0 Then
        RegCloseKey hKey
        Exit Function
    End If
    
    RtlInitUnicodeString DriverPath, StrPtr("/Registry/Machine/System/CurrentControlSet/Services/" & mstrDriverName)
    lngSuccess = NtLoadDriver(VarPtr(DriverPath))
    If lngSuccess = STATUS_IMAGE_ALREADY_LOADED Or lngSuccess = 0 Then
        CHLoadDriver = True
    End If
    RegCloseKey hKey
End Function
Public Function CHUnLoadDriver() As Boolean
    Dim hKey As Long
    Dim lngSuccess As Long
    Dim DriverPath As UNICODE_STRING
    RtlInitUnicodeString DriverPath, StrPtr("/Registry/Machine/System/CurrentControlSet/Services/" & mstrDriverName)
    lngSuccess = NtUnloadDriver(VarPtr(DriverPath))
'    lngSuccess = RegOpenKey(HKEY_LOCAL_MACHINE, _ 
'                          "System/CurrentControlSet/Services/" & mstrDriverName, _ 
'                          hKey _ 
'                          ) 
'    If lngSuccess <> 0 Then 
'        Exit Function 
'    End If 
'    lngSuccess = RegDeleteKey(hKey, "Enum") 
'    RegCloseKey hKey 
'    lngSuccess = RegOpenKey(HKEY_LOCAL_MACHINE, _ 
'                          "System/CurrentControlSet/Services", _ 
'                          hKey _ 
'                          ) 
'    If lngSuccess <> 0 Then 
'        Exit Function 
'    End If 
'    lngSuccess = RegDeleteKey(hKey, mstrDriverName) 
    lngSuccess = RegDeleteKey(HKEY_LOCAL_MACHINE, "System/CurrentControlSet/Services/" & mstrDriverName & "/Enum")
    If lngSuccess <> 0 Then
        Exit Function
    End If
    lngSuccess = RegDeleteKey(HKEY_LOCAL_MACHINE, "System/CurrentControlSet/Services/" & mstrDriverName)
    CHUnLoadDriver = lngSuccess = 0
End Function
Public Function CHDeviceIoControl(ByVal dwIoControlCode As Long, ByVal lpInBuffer As Long, ByVal nInBufferSize As Long, ByVal lpOutBuffer As Long, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long) As Boolean
    CHDeviceIoControl = DeviceIoControl(mhDriver, dwIoControlCode, lpInBuffer, nInBufferSize, lpOutBuffer, nOutBufferSize, lpBytesReturned, ByVal 0&)
End Function
Public Property Get DriverHandle() As Long
    Dim dwShareAccess As Long
    If mhDriver = 0 Then
        If mblnShare Then
            dwShareAccess = FILE_SHARE_READ Or FILE_SHARE_WRITE
        End If
        mhDriver = CreateFile("//./" & mstrDriverName, GENERIC_READ Or GENERIC_WRITE, dwShareAccess, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    End If
    DriverHandle = mhDriver
End Property
'Private Property Let DriverName(ByVal New_Value As Long) 
'    mhDriver = New_Value 
'End Property 
Public Property Get ShareControl() As Boolean
    ShareControl = mblnShare
End Property
Public Property Let ShareControl(ByVal New_Value As Boolean)
    mblnShare = New_Value
End Property
Public Property Get DriverName() As String
    DriverName = mstrDriverName
End Property
Public Property Let DriverName(ByVal New_Value As String)
    mstrDriverName = New_Value
End Property
Public Property Get DisplayName() As String
    DriverName = mstrDisplayName
End Property
Public Property Let DisplayName(ByVal New_Value As String)
    mstrDisplayName = New_Value
End Property
Private Sub Class_Initialize()
    mblnShare = True
End Sub
Private Sub Class_Terminate()
    CloseHandle mhDriver
End Sub
VB 驅動加載類(直接使用NtLoadDriver加載方式)

如何使用 JS 判斷用戶是否處於活躍狀態

通過HPA+CronHPA組合應對業務複雜彈性伸縮場景

VB 卸載USB設備/解鎖文件

[大膽構想]在內存中感染

[開源討論]兄弟們你們願意把你們的源碼開源嗎?

獲取進程命令行之四

閉關練功中

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結
