|
不知为何,这份代码有个很奇怪的BUG,就是不能加载路径太长的驱动,比如桌面上的驱动。。。(梧桐牛说可能是MAX_PATH的问题)
首先创建cls_Driver的类文件,代码如下:
- Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Integer) As IntPtr
- Private Declare Function OpenService Lib "advapi32.dll" Alias "OpenServiceA" (ByVal hSCManager As IntPtr, ByVal lpServiceName As String, ByVal dwDesiredAccess As Integer) As IntPtr
- Private Declare Function StartService Lib "advapi32.dll" Alias "StartServiceA" (ByVal hService As IntPtr, ByVal dwNumServiceArgs As Integer, ByVal lpServiceArgVectors As IntPtr) As Integer
- Private Declare Function CreateService Lib "advapi32.dll" Alias "CreateServiceA" (ByVal hSCManager As IntPtr, ByVal lpServiceName As String, ByVal lpDisplayName As String, ByVal dwDesiredAccess As Integer, ByVal dwServiceType As Integer, ByVal dwStartType As Integer, ByVal dwErrorControl As Integer, ByVal lpBinaryPathName As String, ByVal lpLoadOrderGroup As UIntPtr, ByVal lpdwTagId As Integer, ByVal lpDependencies As UIntPtr, ByVal lp As UIntPtr, ByVal lpPassword As UIntPtr) As IntPtr
- Private Declare Function ControlService Lib "advapi32.dll" (ByVal hService As IntPtr, ByVal dwControl As Integer, ByRef lpServiceStatus As SERVICE_STATUS) As Integer
- Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As IntPtr, ByVal dwIoControlCode As Integer, ByVal lpInBuffer As UIntPtr, ByVal nInBufferSize As UInteger, ByVal lpOutBuffer As UIntPtr, ByVal nOutBufferSize As UInteger, ByVal lpBytesReturned As UIntPtr, ByRef lpOverlapped As OVERLAPPED) As Integer
- Private Declare Function DeleteService Lib "advapi32.dll" (ByVal hService As IntPtr) As Integer
- Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject As IntPtr) As Integer
- Private Declare Function QueryServiceStatus Lib "advapi32.dll" (ByVal hService As IntPtr, ByRef lpServiceStatus As SERVICE_STATUS) As Integer
- Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer, ByVal lpSecurityAttributes As UIntPtr, ByVal dwCreationDisposition As Integer, ByVal dwFlagsAndAttributes As Integer, ByVal hTemplateFile As IntPtr) As IntPtr
- Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As IntPtr) As Integer
- Private Declare Function GetLastError Lib "kernel32.dll" () As Integer
- Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As UInteger)
- Private Const SC_MANAGER_CONNECT = &H1
- Private Const SC_MANAGER_CREATE_SERVICE = &H2
- Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
- Private Const SC_MANAGER_LOCK = &H8
- Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10
- Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20
- Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
- Private Const SC_MANAGER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SC_MANAGER_CONNECT Or SC_MANAGER_CREATE_SERVICE Or SC_MANAGER_ENUMERATE_SERVICE Or SC_MANAGER_LOCK Or SC_MANAGER_QUERY_LOCK_STATUS Or SC_MANAGER_MODIFY_BOOT_CONFIG)
- Private Const SERVICE_QUERY_CONFIG = &H1
- Private Const SERVICE_CHANGE_CONFIG = &H2
- Private Const SERVICE_QUERY_STATUS = &H4
- Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8
- Private Const SERVICE_START = &H10
- Private Const SERVICE_STOP = &H20
- Private Const SERVICE_PAUSE_CONTINUE = &H40
- Private Const SERVICE_INTERROGATE = &H80
- Private Const SERVICE_USER_DEFINED_CONTROL = &H100
- Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SERVICE_QUERY_CONFIG Or SERVICE_CHANGE_CONFIG Or SERVICE_QUERY_STATUS Or SERVICE_ENUMERATE_DEPENDENTS Or SERVICE_START Or SERVICE_STOP Or SERVICE_PAUSE_CONTINUE Or SERVICE_INTERROGATE Or SERVICE_USER_DEFINED_CONTROL)
- Private Const SERVICE_KERNEL_DRIVER As Integer = &H1
- Private Const SERVICE_DEMAND_START As Integer = &H3
- Private Const SERVICE_ERROR_NORMAL As Integer = &H1
- Private Const SERVICE_CONTROL_STOP = &H1
- Private Structure SERVICE_STATUS
- Dim dwServiceType As Integer
- Dim dwCurrentState As Integer
- Dim dwControlsAccepted As Integer
- Dim dwWin32ExitCode As Integer
- Dim dwServiceSpecificExitCode As Integer
- Dim dwCheckPoint As Integer
- Dim dwWaitHint As Integer
- End Structure
- Private Const SERVICE_START_PENDING As Integer = &H2
- Private Const SERVICE_RUNNING As Integer = &H4
- Private Const SERVICE_RUNS_IN_SYSTEM_PROCESS As Integer = &H1
- Private Const SERVICE_STOP_PENDING As Integer = &H3
- Private Const SERVICE_STOPPED As Integer = &H1
- Private Const GENERIC_READ As Integer = &H80000000
- Private Const GENERIC_WRITE As Integer = &H40000000
- Private Const OPEN_EXISTING As Integer = 3
- Private Const FILE_ATTRIBUTE_NORMAL As Integer = &H80
- Private Const FILE_FLAG_OVERLAPPED As Integer = &H40000000
- Private Const FILE_FLAG_DELETE_ON_CLOSE As Integer = &H4000000
- Private Const FILE_SHARE_READ As Integer = &H1
- Private Const FILE_SHARE_WRITE As Integer = &H2
- Private Structure OVERLAPPED
- Dim InternalLow As UIntPtr
- Dim InternalHigh As UIntPtr
- Dim Pointer As ULong
- Dim hEvent As IntPtr
- End Structure
- Private Const INVALID_HANDLE_VALUE As Long = (-1)
- Private Const FILE_DEVICE_UNKNOWN As Integer = &H22
- Private Const METHOD_BUFFERED As Integer = 0
- Private Const FILE_ANY_ACCESS As Integer = 0
- Private Const ERROR_SERVICE_EXISTS As Integer = 1073&
- Private Const ERROR_IO_PENDING As Integer = 997
- Private Const ERROR_SERVICE_MARKED_FOR_DELETE As Integer = 1072&
- Public szDrvSvcName As String
- Public szDrvDisplayName As String
- Public szDrvFilePath As String
- Public szDrvLinkName As String 'e.g. "\\.\TestDrv"
- Dim hSvcHandle As IntPtr
- Dim scHandle As IntPtr
- Dim hDrvHandle As IntPtr
- Public Function InstDrv() As Boolean
- Static nTry As Integer
- scHandle = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ALL_ACCESS)
- If (Not CBool(scHandle)) Then
- DelDrv()
- Return False
- Exit Function
- End If
- hSvcHandle = CreateService(scHandle, szDrvSvcName, szDrvDisplayName, SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, szDrvFilePath, 0, 0, 0, 0, 0)
- If (Not CBool(hSvcHandle)) Then
- 'If ((GetLastError = ERROR_SERVICE_EXISTS) Or (GetLastError = ERROR_SERVICE_MARKED_FOR_DELETE)) Then
- If (nTry > 5) Then InstDrv = False : nTry = 0 : Exit Function
- hSvcHandle = OpenService(scHandle, szDrvSvcName, SERVICE_ALL_ACCESS)
- DelDrv()
- nTry = nTry + 1
- InstDrv()
- 'Else
- 'DelDrv
- 'Exit Function
- 'End If
- End If
- InstDrv = True
- End Function
- Public Function StartDrv() As Boolean
- Dim ret&
- Dim ss As SERVICE_STATUS
- Call QueryServiceStatus(hSvcHandle, ss)
- 'If (ss.dwCurrentState = SERVICE_RUNS_IN_SYSTEM_PROCESS) Then StartDrv = True: Exit Function
- ret = StartService(hSvcHandle, 0, 0)
- If (CBool(ret)) Then
- Dim nTry As Long : nTry = 0
- Call QueryServiceStatus(hSvcHandle, ss)
- While ((ss.dwCurrentState = SERVICE_START_PENDING) And (nTry < 80))
- Sleep(50)
- nTry = nTry + 1
- Call QueryServiceStatus(hSvcHandle, ss)
- End While
- End If
- StartDrv = CBool(ret)
- End Function
- Public Function OpenDrv() As Boolean
- Dim MyFile As String
- If (hDrvHandle <> INVALID_HANDLE_VALUE) Then OpenDrv = True : Exit Function
- MyFile = szDrvLinkName
- If Left(szDrvLinkName, Len("\\.")) <> "\\." Then
- MyFile = "\\." & szDrvLinkName
- End If
- hDrvHandle = CreateFile(MyFile, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
- OpenDrv = (hDrvHandle <> INVALID_HANDLE_VALUE)
- End Function
- Public Function IoControl(ByVal dwIoControlCode As Integer, ByVal lpInBuffer As UIntPtr, ByVal nInBufferSize As UInteger, ByVal lpOutBuffer As UIntPtr, ByVal nOutBufferSize As UInteger, Optional ByRef lpBytesReturned As ULong = 0) As Integer
- Dim lDrvRetSize As Long
- Dim pOver As OVERLAPPED
- IoControl = DeviceIoControl(hDrvHandle, dwIoControlCode, lpInBuffer, nInBufferSize, lpOutBuffer, nOutBufferSize, lDrvRetSize, pOver)
- lpBytesReturned = lDrvRetSize
- End Function
- Public Function StopDrv() As Boolean
- Dim ss As SERVICE_STATUS
- StopDrv = CBool(ControlService(hSvcHandle, SERVICE_CONTROL_STOP, ss))
- Dim nTry As Long : nTry = 0
- Call QueryServiceStatus(hSvcHandle, ss)
- While ((ss.dwCurrentState = SERVICE_STOP_PENDING) And (nTry < 80))
- Sleep(50)
- nTry = nTry + 1
- Call QueryServiceStatus(hSvcHandle, ss)
- End While
- End Function
- Public Function DelDrv() As Boolean
- Call CloseHandle(hDrvHandle)
- Call StopDrv()
- Call DeleteService(hSvcHandle)
- Call CloseServiceHandle(hSvcHandle)
- Call CloseServiceHandle(scHandle)
- hSvcHandle = 0
- scHandle = 0
- DelDrv = True
- End Function
- '构造函数
- Sub New(ByVal FilePath As String, ByVal DisplayName As String, ByVal LinkName As String, ByVal ServiceName As String)
- hSvcHandle = 0
- scHandle = 0
- hDrvHandle = INVALID_HANDLE_VALUE
- szDrvDisplayName = DisplayName
- szDrvFilePath = FilePath
- szDrvLinkName = LinkName
- szDrvSvcName = ServiceName
- End Sub
- Sub Terminate()
- DelDrv()
- End Sub
- Public Function CTL_CODE(ByVal lngDevFileSys As Integer, ByVal lngFunction As Integer, ByVal lngMethod As Integer, ByVal lngAccess As Integer) As Integer
- CTL_CODE = CInt((lngDevFileSys * (2 ^ 16))) Or CInt((lngAccess * (2 ^ 14))) Or CInt((lngFunction * (2 ^ 2))) Or lngMethod
- End Function
- Public Function CTL_CODE_GEN(ByVal lngFunction As Long) As Integer
- CTL_CODE_GEN = CInt((FILE_DEVICE_UNKNOWN * (2 ^ 16))) Or CInt((FILE_ANY_ACCESS * (2 ^ 14))) Or CInt((lngFunction * (2 ^ 2))) Or METHOD_BUFFERED
- End Function
复制代码
定义一个新驱动:
- Dim a As New cls_Driver(文件名,显示名,链接名,服务名)
复制代码
加载驱动:
- With a
- .InstDrv()
- .StartDrv()
- If .OpenDrv = False Then MsgBox("Failed to load driver!", vbExclamation, "Error") : End
- End With
复制代码
卸载驱动:
- With DrvCtrl
- .StopDrv()
- .DelDrv()
- End With
复制代码 |
|