加载驱动 -- VB

VB编程 blackfeather

 

使用VB来加载驱动,不多解释了。用的是最简单,最原始的注册表加载的方法。

代码如下:

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

 

 

评论列表:

Lenk
power vb 果然很powser
Lenk2009/1/23 5:03:46 回复

发表评论: