VB 卸載USB設備/解鎖文件

這次索性貼完整源碼,希望能對大家有所幫助.

frmMain.frm

VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Usb卸載程序"
   ClientHeight    =   2445
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4425
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2445
   ScaleWidth      =   4425
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdAbout
      Caption         =   "關於(&A)"
      Height          =   375
      Left            =   1050
      TabIndex        =   4
      Top             =   1590
      Width           =   1005
   End
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "退出(&C)"
      Height          =   375
      Left            =   3150
      TabIndex        =   3
      Top             =   1590
      Width           =   1005
   End
   Begin VB.CommandButton cmdUnLoad
      Caption         =   "卸載(&U)"
      Default         =   -1  'True
      Height          =   375
      Left            =   2100
      TabIndex        =   2
      Top             =   1590
      Width           =   1005
   End
   Begin VB.TextBox txtUsbDrive
      Height          =   285
      Left            =   1530
      TabIndex        =   0
      Top             =   750
      Width           =   2625
   End
   Begin VB.Label lblMsg
      AutoSize        =   -1  'True
      Caption         =   "輸入USB盤符:"
      Height          =   180
      Left            =   240
      TabIndex        =   1
      Top             =   810
      Width           =   1080
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdAbout_Click()
    Shell "explorer /s , http://blog.csdn.net/chenhui530/"
    MsgBox "歡迎大家使用我編寫的卸載USB程序,如果您在使用中發現有什麼BUG或者是好的建" & vbNewLine & "議可以到我的博客上留言反映情況。地址是: http://blog.csdn.net/chenhui530/", vbInformation, "關於"
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdUnLoad_Click()
    Dim lngLenPath As Long, blnIsUsb As Boolean, strPath As String
    lngLenPath = Len(txtUsbDrive.Text)
    If lngLenPath <= 3 And Dir(txtUsbDrive.Text, 1 Or 2 Or 4 Or vbDirectory) <> "" Then
        If lngLenPath = 2 Then
            If GetDriveBusType(txtUsbDrive.Text) <> "Usb" Then
                MsgBox "只能解鎖USB設備分區!!", vbCritical, "錯誤"
                txtUsbDrive.SetFocus
                Exit Sub
            End If
            strPath = txtUsbDrive.Text & "/"
        ElseIf lngLenPath = 1 Then
            If GetDriveBusType(txtUsbDrive.Text & ":") <> "Usb" Then
                MsgBox "只能解鎖USB設備分區!!", vbCritical, "錯誤"
                txtUsbDrive.SetFocus
                Exit Sub
            End If
            strPath = txtUsbDrive.Text & ":/"
        Else
            If GetDriveBusType(Left(txtUsbDrive.Text, 2)) <> "Usb" Then
                MsgBox "只能解鎖USB設備分區!!", vbCritical, "錯誤"
                txtUsbDrive.SetFocus
                Exit Sub
            End If
            strPath = txtUsbDrive.Text
        End If
        blnIsUsb = True
    Else
        MsgBox "您輸入的USB盤符不要求!!", vbCritical, "錯誤"
        txtUsbDrive.SetFocus
        Exit Sub
    End If
    Me.cmdUnLoad.Enabled = False
    Me.cmdExit.Enabled = False
    '這裏只檢測本進程因爲在獲取驅動器類型的時候會打開一個句柄但是WINDOWS沒有自己關閉所以用這個來
    '解除鎖定,當然你也可以使用CloseLoackFiles函數來檢測所有進程
    If CloseLockFileHandle(Left(strPath, 2), GetCurrentProcessId) Then
        If blnIsUsb Then
            If RemoveUsbDrive("//./" & Left(strPath, 2), True) Then
                MsgBox "卸載UBS設備成功!!", , "提示"
            Else
                MsgBox "但卸載UBS設備失敗!!", vbCritical, "提示"
            End If
        End If
    Else
        MsgBox "發現有鎖定文件還沒解鎖!!", vbCritical, "提示"
    End If
    Me.cmdUnLoad.Enabled = True
    Me.cmdExit.Enabled = True
End Sub

modGetDriveType.bas

Attribute VB_Name = "modGetDriveType"
Option Explicit
'****************************************************************************************************************
'此模塊來自於網絡
'****************************************************************************************************************
'判斷驅動器的類型

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Const DRIVE_UNKNOWN = 0        '驅動器類型無法確定
Private Const DRIVE_NO_ROOT_DIR = 1    '驅動器根目錄不存在
Private Const DRIVE_REMOVABLE = 2      '軟盤驅動器或可移動盤
Private Const DRIVE_FIXED = 3          '硬盤驅動器
Private Const DRIVE_REMOTE = 4         'Network 驅動器
Private Const DRIVE_CDROM = 5          '光盤驅動器
Private Const DRIVE_RAMDISK = 6        'RAM 存儲器

'****************************************************************************************************************

' CreateFile獲取設備句柄

'參數
'lpFileName                       文件名
'dwDesiredAccess                  訪問方式
'dwShareMode                      共享方式
'ATTRIBUTES lpSecurityAttributes  安全描述符指針
'dwCreationDisposition            創建方式
'dwFlagsAndAttributes             文件屬性及標誌
' hTemplateFile                   模板文件的句柄

'CreateFile這個函數用處很多,這裏我們用它「打開」設備驅動程序,得到設備的句柄。
'操作完成後用CloseHandle關閉設備句柄。
'與普通文件名有所不同,設備驅動的「文件名」形式固定爲「//./DeviceName」(注意在C程序中該字符串寫法爲「////.//DeviceName」)
'DeviceName必須與設備驅動程序內規定的設備名稱一致。
'一般地,調用CreateFile獲得設備句柄時,訪問方式參數設置爲0或GENERIC_READ|GENERIC_WRITE
'共享方式參數設置爲FILE_SHARE_READ|FILE_SHARE_WRITE,創建方式參數設置爲OPEN_EXISTING,其它參數設置爲0或NULL。

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" (ByVal hObject As Long) As Long

Private Const GENERIC_READ = &H80000000   '允許對設備進行讀訪問
Private Const FILE_SHARE_READ = &H1       '允許讀取共享
Private Const OPEN_EXISTING = 3           '文件必須已經存在。由設備提出要求
Private Const FILE_SHARE_WRITE = &H2      '允許對文件進行共享訪問

'****************************************************************************************************************

'DeviceIoControl說明

'用途              實現對設備的訪問—獲取信息,發送命令,交換數據等。

'參數
'hDevice           設備句柄
'dwIoControlCode   控制碼
'lpInBuffer        輸入數據緩衝區指針
'nInBufferSize     輸入數據緩衝區長度
'lpOutBuffer       輸出數據緩衝區指針
'nOutBufferSize    輸出數據緩衝區長度
'lpBytesReturned   輸出數據實際長度單元長度
'lpOverlapped      重疊操作結構指針
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long

Private Type SECURITY_ATTRIBUTES
    nLength As Long                    '結構體的大小
    lpSecurityDescriptor As Long       '安全描述符(一個C-Style的字符串)。
    bInheritHandle As Long             '所創建出來的東西是可以被其他的子進程使用的
End Type

'查詢存儲設備還是適配器屬性
Private Enum STORAGE_PROPERTY_ID
    StorageDeviceProperty = 0          '查詢設備屬性
    StorageAdapterProperty             '查詢適配器屬性
End Enum

'查詢存儲設備屬性的類型
Private Enum STORAGE_QUERY_TYPE
    PropertyStandardQuery = 0          '讀取描述
    PropertyExistsQuery                '測試是否支持
    PropertyMaskQuery                  '讀取指定的描述
    PropertyQueryMaxDefined            '驗證數據
End Enum

'查詢屬性輸入的數據結構
Private Type STORAGE_PROPERTY_QUERY
    PropertyId As STORAGE_PROPERTY_ID  '設備/適配器
    QueryType As STORAGE_QUERY_TYPE    '查詢類型
    AdditionalParameters(0) As Byte    '額外的數據(僅定義了象徵性的1個字節)
End Type

Private Type OVERLAPPED
    Internal As Long                  '保留給操作系統使用。用於保存系統狀態,當GetOverLappedRseult的返回值中沒有設置ERROR_IO_PENDING時,本域爲有效。
    InternalHigh As Long              '成員保留給操作系統使用。用於保存異步傳輸數據的長度。當GetOverLappedRseult返回TRUE時,本域爲有效。
    offset As Long                    '指定開始進行異步傳輸的文件的一個位置。該位置是距離文件開頭處的偏移值。在調用ReadFile或WriteFile之前,必須設置此分量。
    OffsetHigh As Long                '指定開始異步傳輸處的字節偏移的高位字部分。
    hEvent As Long                    '指向一個事件的句柄,當傳輸完後將其設置爲信號狀態。
End Type

'存儲設備的總線類型
Private Enum STORAGE_BUS_TYPE
    BusTypeUnknown = 0
    BusTypeScsi
    BusTypeAtapi
    BusTypeAta
    BusType1394
    BusTypeSsa
    BusTypeFibre
    BusTypeUsb
    BusTypeRAID
    BusTypeMaxReserved = &H7F
End Enum

'查詢屬性輸出的數據結構
Private Type STORAGE_DEVICE_DESCRIPTOR
    Version As Long                 '版本
    Size As Long                    '結構大小
    DeviceType As Byte              '設備類型
    DeviceTypeModifier As Byte      'SCSI-2額外的設備類型
    RemovableMedia As Byte          '是否可移動
    CommandQueueing As Byte         '是否支持命令隊列
    VendorIdOffset As Long          '廠家設定值的偏移
    ProductIdOffset As Long         '產品ID的偏移
    ProductRevisionOffset As Long   '產品版本的偏移
    SerialNumberOffset As Long      '序列號的偏移
    BusType As STORAGE_BUS_TYPE     '總線類型
    RawPropertiesLength As Long     '額外的屬性數據長度
    RawDeviceProperties(0) As Byte  '額外的屬性數據(僅定義了象徵性的1個字節)
End Type

'計算控制碼   IOCTL_STORAGE_QUERY_PROPERTY
Private Const IOCTL_STORAGE_BASE As Long = &H2D
Private Const METHOD_BUFFERED = 0
Private Const FILE_ANY_ACCESS = 0

'獲取磁盤屬性
Private Function GetDisksProperty(ByVal hDevice As Long, utDevDesc As STORAGE_DEVICE_DESCRIPTOR) As Boolean
    Dim ut As OVERLAPPED
    Dim utQuery As STORAGE_PROPERTY_QUERY
    Dim lOutBytes As Long
    With utQuery
        .PropertyId = StorageDeviceProperty
        .QueryType = PropertyStandardQuery
    End With
    GetDisksProperty = DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, utQuery, LenB(utQuery), utDevDesc, LenB(utDevDesc), lOutBytes, ut)
End Function

Private Function CTL_CODE(ByVal lDeviceType As Long, ByVal lFunction As Long, ByVal lMethod As Long, ByVal lAccess As Long) As Long
    CTL_CODE = (lDeviceType * 2 ^ 16&) Or (lAccess * 2 ^ 14&) Or (lFunction * 2 ^ 2) Or (lMethod)
End Function

'獲取設備屬性信息,希望得到系統中所安裝的各種固定的和可移動的硬盤、優盤和CD/DVD-ROM/R/W的接口類型、序列號、產品ID等信息。
Private Function IOCTL_STORAGE_QUERY_PROPERTY() As Long
    IOCTL_STORAGE_QUERY_PROPERTY = CTL_CODE(IOCTL_STORAGE_BASE, &H500, METHOD_BUFFERED, FILE_ANY_ACCESS)
End Function

'獲取驅動器總線類型
Public Function GetDriveBusType(ByVal strDriveLetter As String) As String
    Dim hDevice As Long
    Dim utDevDesc As STORAGE_DEVICE_DESCRIPTOR
    hDevice = CreateFile("//./" & strDriveLetter, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hDevice <> -1 Then
        utDevDesc.Size = LenB(utDevDesc)
        Call GetDisksProperty(hDevice, utDevDesc)
        Select Case utDevDesc.BusType
            Case BusType1394
                GetDriveBusType = "1394"
            Case BusTypeAta
                GetDriveBusType = "Ata"
            Case BusTypeAtapi
                GetDriveBusType = "Atapi"
            Case BusTypeFibre
                GetDriveBusType = "Fibre"
            Case BusTypeRAID
                GetDriveBusType = "RAID"
            Case BusTypeScsi
                GetDriveBusType = "Scsi"
            Case BusTypeSsa
                GetDriveBusType = "Ssa"
            Case BusTypeUsb
                GetDriveBusType = "Usb"
            Case BusTypeUnknown
                GetDriveBusType = "未知"
            Case Else
        End Select
        Call CloseHandle(hDevice)
    End If
End Function

modLockFileInfo.bas

Attribute VB_Name = "modLockFileInfo"
Option Explicit

Private Declare Function NtQueryInformationProcess Lib "NTDLL.DLL" (ByVal ProcessHandle As Long, _
                                ByVal ProcessInformationClass As PROCESSINFOCLASS, _
                                ByVal ProcessInformation As Long, _
                                ByVal ProcessInformationLength As Long, _
                                ByRef ReturnLength As Long) As Long

Private Enum PROCESSINFOCLASS
    ProcessBasicInformation = 0
    ProcessQuotaLimits
    ProcessIoCounters
    ProcessVmCounters
    ProcessTimes
    ProcessBasePriority
    ProcessRaisePriority
    ProcessDebugPort
    ProcessExceptionPort
    ProcessAccessToken
    ProcessLdtInformation
    ProcessLdtSize
    ProcessDefaultHardErrorMode
    ProcessIoPortHandlers
    ProcessPooledUsageAndLimits
    ProcessWorkingSetWatch
    ProcessUserModeIOPL
    ProcessEnableAlignmentFaultFixup
    ProcessPriorityClass
    ProcessWx86Information
    ProcessHandleCount
    ProcessAffinityMask
    ProcessPriorityBoost
    ProcessDeviceMap
    ProcessSessionInformation
    ProcessForegroundInformation
    ProcessWow64Information
    ProcessImageFileName
    ProcessLUIDDeviceMapsEnabled
    ProcessBreakOnTermination
    ProcessDebugObjectHandle
    ProcessDebugFlags
    ProcessHandleTracing
    ProcessIoPriority
    ProcessExecuteFlags
    ProcessResourceManagement
    ProcessCookie
    ProcessImageInformation
    MaxProcessInfoClass
End Enum

Private Type PROCESS_BASIC_INFORMATION
    ExitStatus As Long 'NTSTATUS
    PebBaseAddress As Long 'PPEB
    AffinityMask As Long 'ULONG_PTR
    BasePriority As Long 'KPRIORITY
    UniqueProcessId As Long 'ULONG_PTR
    InheritedFromUniqueProcessId As Long 'ULONG_PTR
End Type

Private Type FILE_NAME_INFORMATION
     FileNameLength As Long
     FileName(3) As Byte
End Type

Private Type NM_INFO
    Info As FILE_NAME_INFORMATION
    strName(259) As Byte
End Type

Private Enum FileInformationClass
    FileDirectoryInformation = 1
    FileFullDirectoryInformation = 2
    FileBothDirectoryInformation = 3
    FileBasicInformation = 4
    FileStandardInformation = 5
    FileInternalInformation = 6
    FileEaInformation = 7
    FileAccessInformation = 8
    FileNameInformation = 9
    FileRenameInformation = 10
    FileLinkInformation = 11
    FileNamesInformation = 12
    FileDispositionInformation = 13
    FilePositionInformation = 14
    FileFullEaInformation = 15
    FileModeInformation = 16
    FileAlignmentInformation = 17
    FileAllInformation = 18
    FileAllocationInformation = 19
    FileEndOfFileInformation = 20
    FileAlternateNameInformation = 21
    FileStreamInformation = 22
    FilePipeInformation = 23
    FilePipeLocalInformation = 24
    FilePipeRemoteInformation = 25
    FileMailslotQueryInformation = 26
    FileMailslotSetInformation = 27
    FileCompressionInformation = 28
    FileObjectIdInformation = 29
    FileCompletionInformation = 30
    FileMoveClusterInformation = 31
    FileQuotaInformation = 32
    FileReparsePointInformation = 33
    FileNetworkOpenInformation = 34
    FileAttributeTagInformation = 35
    FileTrackingInformation = 36
    FileMaximumInformation
End Enum

Private Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" (ByVal SystemInformationClass As SYSTEM_INFORMATION_CLASS, _
                                ByVal pSystemInformation As Long, _
                                ByVal SystemInformationLength As Long, _
                                ByRef ReturnLength As Long) As Long
                               

Private Enum SYSTEM_INFORMATION_CLASS
    SystemBasicInformation
    SystemProcessorInformation             '// obsolete...delete
    SystemPerformanceInformation
    SystemTimeOfDayInformation
    SystemPathInformation
    SystemProcessInformation
    SystemCallCountInformation
    SystemDeviceInformation
    SystemProcessorPerformanceInformation
    SystemFlagsInformation
    SystemCallTimeInformation
    SystemModuleInformation
    SystemLocksInformation
    SystemStackTraceInformation
    SystemPagedPoolInformation
    SystemNonPagedPoolInformation
    SystemHandleInformation
    SystemObjectInformation
    SystemPageFileInformation
    SystemVdmInstemulInformation
    SystemVdmBopInformation
    SystemFileCacheInformation
    SystemPoolTagInformation
    SystemInterruptInformation
    SystemDpcBehaviorInformation
    SystemFullMemoryInformation
    SystemLoadGdiDriverInformation
    SystemUnloadGdiDriverInformation
    SystemTimeAdjustmentInformation
    SystemSummaryMemoryInformation
    SystemMirrorMemoryInformation
    SystemPerformanceTraceInformation
    SystemObsolete0
    SystemExceptionInformation
    SystemCrashDumpStateInformation
    SystemKernelDebuggerInformation
    SystemContextSwitchInformation
    SystemRegistryQuotaInformation
    SystemExtendServiceTableInformation
    SystemPrioritySeperation
    SystemVerifierAddDriverInformation
    SystemVerifierRemoveDriverInformation
    SystemProcessorIdleInformation
    SystemLegacyDriverInformation
    SystemCurrentTimeZoneInformation
    SystemLookasideInformation
    SystemTimeSlipNotification
    SystemSessionCreate
    SystemSessionDetach
    SystemSessionInformation
    SystemRangeStartInformation
    SystemVerifierInformation
    SystemVerifierThunkExtend
    SystemSessionProcessInformation
    SystemLoadGdiDriverInSystemSpace
    SystemNumaProcessorMap
    SystemPrefetcherInformation
    SystemExtendedProcessInformation
    SystemRecommendedSharedDataAlignment
    SystemComPlusPackage
    SystemNumaAvailableMemory
    SystemProcessorPowerInformation
    SystemEmulationBasicInformation
    SystemEmulationProcessorInformation
    SystemExtendedHandleInformation
    SystemLostDelayedWriteInformation
    SystemBigPoolInformation
    SystemSessionPoolTagInformation
    SystemSessionMappedViewInformation
    SystemHotpatchInformation
    SystemObjectSecurityMode
    SystemWatchdogTimerHandler
    SystemWatchdogTimerInformation
    SystemLogicalProcessorInformation
    SystemWow64SharedInformation
    SystemRegisterFirmwareTableInformationHandler
    SystemFirmwareTableInformation
    SystemModuleInformationEx
    SystemVerifierTriageInformation
    SystemSuperfetchInformation
    SystemMemoryListInformation
    SystemFileCacheInformationEx
    MaxSystemInfoClass  '// MaxSystemInfoClass should always be the last enum
End Enum

Private Type SYSTEM_HANDLE
    UniqueProcessId As Integer
    CreatorBackTraceIndex As Integer
    ObjectTypeIndex As Byte
    HandleAttributes As Byte
    HandleValue As Integer
    pObject As Long
    GrantedAccess As Long
End Type

Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004

Private Enum SYSTEM_HANDLE_TYPE
    OB_TYPE_UNKNOWN = 0
    OB_TYPE_TYPE = 1
    OB_TYPE_DIRECTORY
    OB_TYPE_SYMBOLIC_LINK
    OB_TYPE_TOKEN
    OB_TYPE_PROCESS
    OB_TYPE_THREAD
    OB_TYPE_UNKNOWN_7
    OB_TYPE_EVENT
    OB_TYPE_EVENT_PAIR
    OB_TYPE_MUTANT
    OB_TYPE_UNKNOWN_11
    OB_TYPE_SEMAPHORE
    OB_TYPE_TIMER
    OB_TYPE_PROFILE
    OB_TYPE_WINDOW_STATION
    OB_TYPE_DESKTOP
    OB_TYPE_SECTION
    OB_TYPE_KEY
    OB_TYPE_PORT
    OB_TYPE_WAITABLE_PORT
    OB_TYPE_UNKNOWN_21
    OB_TYPE_UNKNOWN_22
    OB_TYPE_UNKNOWN_23
    OB_TYPE_UNKNOWN_24
    OB_TYPE_IO_COMPLETION
    OB_TYPE_FILE
End Enum

'typedef struct _SYSTEM_HANDLE_INFORMATION
'{
 '   ULONG           uCount;
 '   SYSTEM_HANDLE   aSH[];
'} SYSTEM_HANDLE_INFORMATION, *PSYSTEM_HANDLE_INFORMATION;

Private Type SYSTEM_HANDLE_INFORMATION
    uCount As Long
    aSH() As SYSTEM_HANDLE
End Type

Private Declare Function NtDuplicateObject Lib "NTDLL.DLL" (ByVal SourceProcessHandle As Long, _
                                ByVal SourceHandle As Long, _
                                ByVal TargetProcessHandle As Long, _
                                ByRef TargetHandle As Long, _
                                ByVal DesiredAccess As Long, _
                                ByVal HandleAttributes As Long, _
                                ByVal Options As Long) As Long

Private Const DUPLICATE_CLOSE_SOURCE = &H1

Private Const DUPLICATE_SAME_ACCESS = &H2

Private Const DUPLICATE_SAME_ATTRIBUTES = &H4

Private Declare Function NtOpenProcess Lib "NTDLL.DLL" (ByRef ProcessHandle As Long, _
                                ByVal AccessMask As Long, _
                                ByRef ObjectAttributes As OBJECT_ATTRIBUTES, _
                                ByRef ClientID As CLIENT_ID) As Long

Private Type OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As Long
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type

Private Type CLIENT_ID
    UniqueProcess As Long
    UniqueThread  As Long
End Type

Private Type IO_STATUS_BLOCK
    Status As Long
    uInformation As Long
End Type

Private Const PROCESS_CREATE_THREAD = &H2

Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_VM_OPERATION = &H8

Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)

Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000

Private Const SYNCHRONIZE As Long = &H100000

Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Private Const PROCESS_DUP_HANDLE As Long = (&H40)

Private Declare Function NtClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                      ByRef Source As Any, _
                                      ByVal Length As Long)
                                     
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

'typedef struct _OBJECT_NAME_INFORMATION
'{
'    UNICODE_STRING  Name;
'} OBJECT_NAME_INFORMATION, *POBJECT_NAME_INFORMATION;
'typedef enum _OBJECT_INFORMATION_CLASS
'{
'    ObjectBasicInformation,             // 0    Y       N
'    ObjectNameInformation,              // 1    Y       N
'    ObjectTypeInformation,              // 2    Y       N
'    ObjectAllTypesInformation,          // 3    Y       N
'    ObjectHandleInformation             // 4    Y       Y
'} OBJECT_INFORMATION_CLASS;
Private Enum OBJECT_INFORMATION_CLASS
    ObjectBasicInformation = 0
    ObjectNameInformation
    ObjectTypeInformation
    ObjectAllTypesInformation
    ObjectHandleInformation
End Enum
'
'typedef struct _UNICODE_STRING
'{
'    USHORT Length;
'    USHORT MaximumLength;
'    PWSTR Buffer;
'} UNICODE_STRING, *PUNICODE_STRING;
Private Type UNICODE_STRING
    uLength As Integer
    uMaximumLength As Integer
    pBuffer(3) As Byte
End Type

Private Type OBJECT_NAME_INFORMATION
    pName As UNICODE_STRING
End Type
Private Const STATUS_INFO_LEN_MISMATCH = &HC0000004
Private Const HEAP_ZERO_MEMORY = &H8
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Function HeapReAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any, ByVal dwBytes As Long) As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
'Private Declare Function NtQueryObject Lib "NTDLL.DLL" (ByVal ObjectHandle As Long, _
'                                                        ByVal ObjectInformationClass As OBJECT_INFORMATION_CLASS, _
'                                                        ObjectInformation As Any, ByVal ObjectInformationLength As Long, _
'                                                        ReturnLength As Long) As Long
Private Declare Function NtQueryObject Lib "NTDLL.DLL" (ByVal ObjectHandle As Long, _
                                                        ByVal ObjectInformationClass As OBJECT_INFORMATION_CLASS, _
                                                        ByVal ObjectInformation As Long, ByVal ObjectInformationLength As Long, _
                                                        ReturnLength As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function GetFileType Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Private Function NT_SUCCESS(ByVal nStatus As Long) As Boolean
    NT_SUCCESS = (nStatus >= 0)
End Function

Public Function GetFileFullPath(ByVal hFile As Long) As String
    Dim hHeap As Long, dwSize As Long, objName As UNICODE_STRING, pName As Long
    Dim ntStatus As Long, i As Long, lngNameSize As Long, strDrives As String, strArray() As String
    Dim dwDriversSize As Long, strDrive As String, strTmp As String, strTemp As String
    On Error GoTo ErrHandle
    hHeap = GetProcessHeap
    pName = HeapAlloc(hHeap, HEAP_ZERO_MEMORY, &H1000)
    ntStatus = NtQueryObject(hFile, ObjectNameInformation, pName, &H1000, dwSize)
    If (NT_SUCCESS(ntStatus)) Then
        i = 1
        Do While (ntStatus = STATUS_INFO_LEN_MISMATCH)
            pName = HeapReAlloc(hHeap, HEAP_ZERO_MEMORY, pName, &H1000 * i)
            ntStatus = NtQueryObject(hFile, ObjectNameInformation, pName, &H1000, ByVal 0)
            i = i + 1
        Loop
    End If
    HeapFree hHeap, 0, pName
    strTemp = String(512, Chr(0))
    lstrcpyW strTemp, pName + Len(objName)
    strTemp = StrConv(strTemp, vbFromUnicode)
    strTemp = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
    strDrives = String(512, Chr(9))
    dwDriversSize = GetLogicalDriveStrings(512, strDrives)
    If dwDriversSize Then
        strArray = Split(strDrives, Chr(0))
        For i = 0 To UBound(strArray)
            If strArray(i) <> "" Then
                strDrive = Left(strArray(i), 2)
                strTmp = String(260, Chr(0))
                Call QueryDosDevice(strDrive, strTmp, 256)
                strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
                If InStr(LCase(strTemp), LCase(strTmp)) = 1 Then
                    GetFileFullPath = strDrive & Mid(strTemp, Len(strTmp) + 1, Len(strTemp) - Len(strTmp))
                    Exit Function
                End If
            End If
        Next
    End If
ErrHandle:
End Function

Public Function CloseLockFileHandle(ByVal strFileName As String, ByVal dwProcessId As Long) As Boolean
    Dim ntStatus As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim lngHandles As Long
    Dim i As Long
    Dim objInfo As SYSTEM_HANDLE_INFORMATION, lngType As Long
    Dim hProcess As Long, hProcessToDup As Long, hFileHandle As Long
    Dim hFile As Long
    'Dim objIo As IO_STATUS_BLOCK, objFn As FILE_NAME_INFORMATION, objN As NM_INFO
    Dim bytBytes() As Byte, strSubPath As String, strTmp As String
    Dim blnIsOk As Boolean
    strSubPath = Mid(strFileName, 3, Len(strFileName) - 2)
    hFile = CreateFile("NUL", &H80000000, 0, ByVal 0&, 3, 0, 0)
    If hFile = -1 Then
        CloseLockFileHandle = False
        Exit Function
    End If
    objOa.Length = Len(objOa)
    objCid.UniqueProcess = dwProcessId
    ntStatus = 0
    Dim bytBuf() As Byte
    Dim nSize As Long
    nSize = 1
    Do
        ReDim bytBuf(nSize)
        ntStatus = NtQuerySystemInformation(SystemHandleInformation, VarPtr(bytBuf(0)), nSize, 0&)
        If (Not NT_SUCCESS(ntStatus)) Then
            If (ntStatus <> STATUS_INFO_LENGTH_MISMATCH) Then
                Erase bytBuf
                Exit Function
            End If
        Else
            Exit Do
        End If
        nSize = nSize * 2
        ReDim bytBuf(nSize)
    Loop
    lngHandles = 0
    CopyMemory objInfo.uCount, bytBuf(0), 4
    lngHandles = objInfo.uCount
    ReDim objInfo.aSH(lngHandles - 1)
    Call CopyMemory(objInfo.aSH(0), bytBuf(4), Len(objInfo.aSH(0)) * lngHandles)
    For i = 0 To lngHandles - 1
        If objInfo.aSH(i).HandleValue = hFile And objInfo.aSH(i).UniqueProcessId = GetCurrentProcessId Then
            lngType = objInfo.aSH(i).ObjectTypeIndex
            Exit For
        End If
    Next
    NtClose hFile
    blnIsOk = True
    For i = 0 To lngHandles - 1
        If objInfo.aSH(i).ObjectTypeIndex = lngType And objInfo.aSH(i).UniqueProcessId = dwProcessId Then
            ntStatus = NtOpenProcess(hProcessToDup, PROCESS_DUP_HANDLE, objOa, objCid)
            If hProcessToDup <> 0 Then
                ntStatus = NtDuplicateObject(hProcessToDup, objInfo.aSH(i).HandleValue, GetCurrentProcess, hFileHandle, 0, 0, DUPLICATE_SAME_ATTRIBUTES)
                If (NT_SUCCESS(ntStatus)) Then
                    '這裏如果直接調用NtQueryObject可能會掛起解決方法是用線程去處理當線程處理時間超過一定時間就把它幹掉
                    '由於VB對多線程支持很差,其實應該說是對CreateThread支持很差,什麼原因不要問我,相信網上也寫有不少
                    '文件是關於它的,這裏我選擇了另一個函數也可以建立線程但是它是建立遠程線程的,不過它卻很穩定正好解決了
                    '我們這裏的問題它就是CreateRemoteThread,^_^還記得我說過它很強大吧~~哈哈。
                    ntStatus = MyGetFileType(hFileHandle)
                    If ntStatus Then
                        strTmp = GetFileFullPath(hFileHandle)
                    End If
                    NtClose hFileHandle
                    If InStr(LCase(strTmp), LCase(strFileName)) Then
                        If Not CloseRemoteHandle(dwProcessId, objInfo.aSH(i).HandleValue, strFileName) Then
                            blnIsOk = False
                        End If
                    End If
                End If
            End If
        End If
    Next
    CloseLockFileHandle = blnIsOk
End Function

'檢測所有進程
Public Function CloseLoackFiles(ByVal strFileName As String) As Boolean
    Dim ntStatus As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim lngHandles As Long
    Dim i As Long
    Dim objInfo As SYSTEM_HANDLE_INFORMATION, lngType As Long
    Dim hProcess As Long, hProcessToDup As Long, hFileHandle As Long
    Dim hFile As Long, blnIsOk As Boolean, strProcessName As String
    'Dim objIo As IO_STATUS_BLOCK, objFn As FILE_NAME_INFORMATION, objN As NM_INFO
    Dim bytBytes() As Byte, strSubPath As String, strTmp As String
    strSubPath = Mid(strFileName, 3, Len(strFileName) - 2)
    hFile = CreateFile("NUL", &H80000000, 0, ByVal 0&, 3, 0, 0)
    If hFile = -1 Then
        CloseLoackFiles = False
        Exit Function
    End If
    objOa.Length = Len(objOa)
    ntStatus = 0
    Dim bytBuf() As Byte
    Dim nSize As Long
    nSize = 1
    Do
        ReDim bytBuf(nSize)
        ntStatus = NtQuerySystemInformation(SystemHandleInformation, VarPtr(bytBuf(0)), nSize, 0&)
        If (Not NT_SUCCESS(ntStatus)) Then
            If (ntStatus <> STATUS_INFO_LENGTH_MISMATCH) Then
                Erase bytBuf
                Exit Function
            End If
        Else
            Exit Do
        End If
        nSize = nSize * 2
        ReDim bytBuf(nSize)
    Loop
    lngHandles = 0
    CopyMemory objInfo.uCount, bytBuf(0), 4
    lngHandles = objInfo.uCount
    ReDim objInfo.aSH(lngHandles - 1)
    Call CopyMemory(objInfo.aSH(0), bytBuf(4), Len(objInfo.aSH(0)) * lngHandles)
    For i = 0 To lngHandles - 1
        If objInfo.aSH(i).HandleValue = hFile And objInfo.aSH(i).UniqueProcessId = GetCurrentProcessId Then
            lngType = objInfo.aSH(i).ObjectTypeIndex
            Exit For
        End If
    Next
    NtClose hFile
    blnIsOk = True
    For i = 0 To lngHandles - 1
        If objInfo.aSH(i).ObjectTypeIndex = lngType Then
            objCid.UniqueProcess = objInfo.aSH(i).UniqueProcessId
            ntStatus = NtOpenProcess(hProcessToDup, PROCESS_DUP_HANDLE, objOa, objCid)
            If hProcessToDup <> 0 Then
                ntStatus = NtDuplicateObject(hProcessToDup, objInfo.aSH(i).HandleValue, GetCurrentProcess, hFileHandle, 0, 0, DUPLICATE_SAME_ATTRIBUTES)
                If (NT_SUCCESS(ntStatus)) Then
                    '這裏如果直接調用NtQueryObject可能會掛起解決方法是用線程去處理當線程處理時間超過一定時間就把它幹掉
                    '由於VB對多線程支持很差,其實應該說是對CreateThread支持很差,什麼原因不要問我,相信網上也寫有不少
                    '文件是關於它的,這裏我選擇了另一個函數也可以建立線程但是它是建立遠程線程的,不過它卻很穩定正好解決了
                    '我們這裏的問題它就是CreateRemoteThread,^_^還記得我說過它很強大吧~~哈哈。
                    ntStatus = MyGetFileType(hFileHandle)
                    If ntStatus Then
                        strTmp = GetFileFullPath(hFileHandle)
                    Else
                        strTmp = ""
                    End If
                    NtClose hFileHandle
                    If InStr(LCase(strTmp), LCase(strFileName)) Then
                        If Not CloseRemoteHandle(objInfo.aSH(i).UniqueProcessId, objInfo.aSH(i).HandleValue, strTmp) Then
                            blnIsOk = False
                        End If
                    End If
                End If
            End If
        End If
    Next
    CloseLoackFiles = blnIsOk
End Function

Private Function GetProcessCommandLine(ByVal dwProcessId As Long) As String
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim ntStatus As Long, hKernel As Long, strName As String
    Dim hProcess As Long, dwAddr As Long, dwRead As Long
    objOa.Length = Len(objOa)
    objCid.UniqueProcess = dwProcessId
    ntStatus = NtOpenProcess(hProcess, &H10, objOa, objCid)
    If hProcess = 0 Then
        GetProcessCommandLine = ""
        Exit Function
    End If
    hKernel = GetModuleHandle("kernel32")
    dwAddr = GetProcAddress(hKernel, "GetCommandLineA")
    CopyMemory dwAddr, ByVal dwAddr + 1, 4
    If ReadProcessMemory(hProcess, ByVal dwAddr, dwAddr, 4, dwRead) Then
        strName = String(260, Chr(0))
        If ReadProcessMemory(hProcess, ByVal dwAddr, ByVal strName, 260, dwRead) Then
            strName = Left(strName, InStr(strName, Chr(0)) - 1)
            NtClose hProcess
            GetProcessCommandLine = strName
            Exit Function
        End If
    End If
    NtClose hProcess
End Function

'解鎖指定進程的鎖定文件
Public Function CloseRemoteHandle(ByVal dwProcessId, ByVal hHandle As Long, Optional ByVal strLockFile As String = "") As Boolean
    Dim hMyProcess  As Long, hRemProcess As Long, blnResult As Long, hMyHandle As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim ntStatus As Long, strProcessName As String, hProcess As Long, strMsg As String
    objCid.UniqueProcess = dwProcessId
    objOa.Length = Len(objOa)
    hMyProcess = GetCurrentProcess()
    ntStatus = NtOpenProcess(hRemProcess, PROCESS_DUP_HANDLE, objOa, objCid)
    If hRemProcess Then
        ntStatus = NtDuplicateObject(hRemProcess, hHandle, GetCurrentProcess, hMyHandle, 0, 0, DUPLICATE_CLOSE_SOURCE Or DUPLICATE_SAME_ACCESS)
        If (NT_SUCCESS(ntStatus)) Then
        'If DuplicateHandle(hRemProcess, hMyProcess, hHandle, hMyHandle, 0, 0, DUPLICATE_CLOSE_SOURCE Or DUPLICATE_SAME_ACCESS) Then
            blnResult = NtClose(hMyHandle)
            If blnResult >= 0 Then
                strProcessName = GetProcessCommandLine(dwProcessId)
                'If InStr(LCase(strProcessName), LCase(strLockFile)) Then
                If InStr(LCase(strProcessName), "explorer.exe") = 0 And dwProcessId <> GetCurrentProcessId Then
                    objCid.UniqueProcess = dwProcessId
                    ntStatus = NtOpenProcess(hProcess, 1, objOa, objCid)
                    If hProcess <> 0 Then TerminateProcess hProcess, 0
                End If
            End If
        End If
        Call NtClose(hRemProcess)
    End If
    CloseRemoteHandle = blnResult >= 0
End Function


'解鎖指定進程的鎖定文件
Public Function CloseRemoteHandleEx(ByVal dwProcessId, ByVal hHandle As Long, Optional ByVal strLockFile As String = "") As Boolean
    Dim hRemProcess As Long, hThread As Long, lngResult As Long, pfnThreadRtn As Long, hKernel As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES, strMsg As String
    Dim ntStatus As Long, strProcessName As String, hProcess As Long
    objCid.UniqueProcess = dwProcessId
    objOa.Length = Len(objOa)
    ntStatus = NtOpenProcess(hRemProcess, PROCESS_QUERY_INFORMATION Or PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, objOa, objCid)
'    hMyProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, dwProcessId)
    If hRemProcess = 0 Then
        CloseRemoteHandleEx = False
        Exit Function
    End If
    hKernel = GetModuleHandle("kernel32")
    If hKernel = 0 Then
        CloseRemoteHandleEx = False
        Exit Function
    End If
    pfnThreadRtn = GetProcAddress(hKernel, "CloseHandle")
    If pfnThreadRtn = 0 Then
        FreeLibrary hKernel
        CloseRemoteHandleEx = False
        Exit Function
    End If
    hThread = CreateRemoteThread(hRemProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal hHandle, 0, 0&)
    If hThread = 0 Then
        FreeLibrary hKernel
        CloseRemoteHandleEx = False
        Exit Function
    End If
    GetExitCodeThread hThread, lngResult
    CloseRemoteHandleEx = CBool(lngResult)
    strProcessName = GetProcessCommandLine(dwProcessId)
    If InStr(strProcessName, strLockFile) Then
        objCid.UniqueProcess = dwProcessId
        ntStatus = NtOpenProcess(hProcess, 1, objOa, objCid)
        If hProcess <> 0 Then TerminateProcess hProcess, 0
    End If
    NtClose hThread
    NtClose hRemProcess
    FreeLibrary hKernel
End Function

Private Function MyGetFileType(ByVal hFile As Long) As Long
    Dim hRemProcess As Long, hThread As Long, lngResult As Long, pfnThreadRtn As Long, hKernel As Long
    Dim dwEax As Long, dwTimeOut As Long
    hRemProcess = GetCurrentProcess
    hKernel = GetModuleHandle("kernel32")
    If hKernel = 0 Then
        MyGetFileType = 0
        Exit Function
    End If
    pfnThreadRtn = GetProcAddress(hKernel, "GetFileType")
    If pfnThreadRtn = 0 Then
        FreeLibrary hKernel
        MyGetFileType = 0
        Exit Function
    End If
    hThread = CreateRemoteThread(hRemProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal hFile, 0, ByVal 0&)
    dwEax = WaitForSingleObject(hThread, 100)
    If dwEax = &H102 Then
        Call GetExitCodeThread(hThread, dwTimeOut)
        Call TerminateThread(hThread, dwTimeOut)
        NtClose hThread
        MyGetFileType = 0
        Exit Function
    End If
    If hThread = 0 Then
        FreeLibrary hKernel
        MyGetFileType = False
        Exit Function
    End If
    GetExitCodeThread hThread, lngResult
    MyGetFileType = lngResult
    NtClose hThread
    NtClose hRemProcess
    FreeLibrary hKernel
End Function

modRemoveUsbDrive.bas

Attribute VB_Name = "modRemoveUsbDrive"
Option Explicit
'****************************************************************************************************************
'此模塊是通過轉換C++代碼而來
'****************************************************************************************************************
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

'typedef struct _SP_DEVICE_INTERFACE_DETAIL_DATA_A {
'    DWORD  cbSize;
'    CHAR   DevicePath[ANYSIZE_ARRAY];
'} SP_DEVICE_INTERFACE_DETAIL_DATA_A, *PSP_DEVICE_INTERFACE_DETAIL_DATA_A;
Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
    cbSize As Long
    strDevicePath As String * 260
End Type

Private Type SP_DEVICE_INTERFACE_DATA
    cbSize As Long 'taille de la structure en octets
    InterfaceClassGuid As GUID 'GUID de la classe d'interface
    flags As Long 'options
    Reserved As Long 'réservé
End Type

Private Type SP_DEVINFO_DATA
    cbSize As Long 'taille de la structure en octets
    ClassGuid As GUID 'GUID de la classe d'installation
    DevInst As Long 'handle utilisable par certaine fonction CM_xxx
    Reserved As Long 'réservé
End Type
'
'typedef struct _STORAGE_DEVICE_NUMBER {
'    //
'    // The FILE_DEVICE_XXX type for this device.
'    //
'    DEVICE_TYPE DeviceType;
'    //
'    // The number of this device
'    //
'    DWORD       DeviceNumber;
'    //
'    // If the device is partitionable, the partition number of the device.
'    // Otherwise -1
'    //
'    DWORD       PartitionNumber;
'} STORAGE_DEVICE_NUMBER, *PSTORAGE_DEVICE_NUMBER;
Private Type STORAGE_DEVICE_NUMBER
    dwDeviceType As Long
    dwDeviceNumber As Long
    dwPartitionNumber As Long
End Type

'typedef enum    _PNP_VETO_TYPE {
'    PNP_VetoTypeUnknown,            // Name is unspecified
'    PNP_VetoLegacyDevice,           // Name is an Instance Path
'    PNP_VetoPendingClose,           // Name is an Instance Path
'    PNP_VetoWindowsApp,             // Name is a Module
'    PNP_VetoWindowsService,         // Name is a Service
'    PNP_VetoOutstandingOpen,        // Name is an Instance Path
'    PNP_VetoDevice,                 // Name is an Instance Path
'    PNP_VetoDriver,                 // Name is a Driver Service Name
'    PNP_VetoIllegalDeviceRequest,   // Name is an Instance Path
'    PNP_VetoInsufficientPower,      // Name is unspecified
'    PNP_VetoNonDisableable,         // Name is an Instance Path
'    PNP_VetoLegacyDriver,           // Name is a Service
'    PNP_VetoInsufficientRights      // Name is unspecified
'}   PNP_VETO_TYPE, *PPNP_VETO_TYPE;

Private Enum PNP_VETO_TYPE
    PNP_VetoTypeUnknown
    PNP_VetoLegacyDevice
    PNP_VetoPendingClose
    PNP_VetoWindowsApp
    PNP_VetoWindowsService
    PNP_VetoOutstandingOpen
    PNP_VetoDevice
    PNP_VetoDriver
    PNP_VetoIllegalDeviceRequest
    PNP_VetoInsufficientPower
    PNP_VetoNonDisableable
    PNP_VetoLegacyDriver
    PNP_VetoInsufficientRights
End Enum
'Private Const DIGCF_DEFAULT = &H1                        ' only valid with DIGCF_DEVICEINTERFACE
Private Const DIGCF_PRESENT = &H2
'Private Const DIGCF_ALLCLASSES = &H4
'Private Const DIGCF_PROFILE = &H8
Private Const DIGCF_DEVICEINTERFACE = &H10
Private Const GENERIC_READ = &H80000000   '允許對設備進行讀訪問
Private Const FILE_SHARE_READ = &H1       '允許讀取共享
Private Const OPEN_EXISTING = 3           '文件必須已經存在。由設備提出要求
Private Const FILE_SHARE_WRITE = &H2      '允許對文件進行共享訪問
Private Const IOCTL_STORAGE_BASE As Long = &H2D
Private Const METHOD_BUFFERED = 0
Private Const FILE_ANY_ACCESS = 0

Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByVal ClassGuid As Long, ByVal Enumerator As Long, ByVal HwndParent As Long, ByVal flags As Long) As Long
Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long
Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, DeviceInterfaceDetailData As Any, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, DeviceInfoData As Any) As Long
Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
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 CM_Get_Parent Lib "cfgmgr32.dll" (pdwDevInst As Long, ByVal dwDevInst As Long, ByVal ulFlags As Long) As Long
Private Declare Function CM_Request_Device_EjectW Lib "setupapi.dll" (ByVal dwDevInst As Long, ByVal pVetoType As Long, ByVal pszVetoName As String, ByVal ulNameLength As Long, ByVal ulFlags As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Function CTL_CODE(ByVal lDeviceType As Long, ByVal lFunction As Long, ByVal lMethod As Long, ByVal lAccess As Long) As Long
    CTL_CODE = (lDeviceType * 2 ^ 16&) Or (lAccess * 2 ^ 14&) Or (lFunction * 2 ^ 2) Or (lMethod)
End Function

'獲取設備屬性信息,希望得到系統中所安裝的各種固定的和可移動的硬盤、優盤和CD/DVD-ROM/R/W的接口類型、序列號、產品ID等信息。
Private Function IOCTL_STORAGE_GET_DEVICE_NUMBER() As Long '2953344
    IOCTL_STORAGE_GET_DEVICE_NUMBER = CTL_CODE(IOCTL_STORAGE_BASE, &H420, METHOD_BUFFERED, FILE_ANY_ACCESS)
End Function

Private Function GetDrivesDevInstByDeviceNumber(ByVal lngDeviceNumber As Long, ByVal uDriveType As Long, ByVal szDosDeviceName As String) As Long
    Dim objGuid As GUID, hDevInfo As Long, dwIndex As Long, lngRes As Long, dwSize As Long
    Dim objSpdid As SP_DEVICE_INTERFACE_DATA, objSpdd As SP_DEVINFO_DATA, objPspdidd As SP_DEVICE_INTERFACE_DETAIL_DATA
    Dim hDrive As Long, objSdn As STORAGE_DEVICE_NUMBER, dwBytesReturned As Long
    Dim dwReturn As Long
    '處理GUID
    With objGuid
        .Data2 = &HB6BF
        .Data3 = &H11D0&
        .Data4(0) = &H94&
        .Data4(1) = &HF2&
        .Data4(2) = &H0&
        .Data4(3) = &HA0&
        .Data4(4) = &HC9&
        .Data4(5) = &H1E&
        .Data4(6) = &HFB&
        .Data4(7) = &H8B&
        Select Case uDriveType
            Case 2
                If InStr(szDosDeviceName, "/Floppy") Then
                    .Data1 = &H53F56311
                Else
                    .Data1 = &H53F56307
                End If
            Case 3
                .Data1 = &H53F56307
            Case 5
                .Data1 = &H53F56308
        End Select
    End With
    'Get device interface info set handle for all devices attached to system
    hDevInfo = SetupDiGetClassDevs(VarPtr(objGuid), 0, 0, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)
    If hDevInfo = -1 Then
        GetDrivesDevInstByDeviceNumber = 0
        Exit Function
    End If
    objSpdid.cbSize = Len(objSpdid)
    Do While 1
        lngRes = SetupDiEnumDeviceInterfaces(hDevInfo, 0, objGuid, dwIndex, objSpdid)
        If lngRes = 0 Then Exit Do
        dwSize = 0
        Call SetupDiGetDeviceInterfaceDetail(hDevInfo, objSpdid, ByVal 0&, 0, dwSize, ByVal 0&)
        If dwSize <> 0 And dwSize <= 1024 Then
            objPspdidd.cbSize = 5 'Len(objPspdidd) '這裏十分注意這裏必須是5不能用'Len(objPspdidd)
            objSpdd.cbSize = Len(objSpdd)
            lngRes = SetupDiGetDeviceInterfaceDetail(hDevInfo, objSpdid, objPspdidd, ByVal dwSize, dwReturn, objSpdd)
            If lngRes > 0 Then
                '打開設備
                hDrive = CreateFile(objPspdidd.strDevicePath, 0, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
                If hDrive <> -1 Then
                    '獲取設備號
                    lngRes = DeviceIoControl(hDrive, IOCTL_STORAGE_GET_DEVICE_NUMBER, ByVal 0&, 0, objSdn, Len(objSdn), dwBytesReturned, ByVal 0&)
                    If lngRes Then
                        'match the given device number with the one of the current device
                        If lngDeviceNumber = objSdn.dwDeviceNumber Then
                            Call CloseHandle(hDrive)
                            SetupDiDestroyDeviceInfoList hDevInfo
                            GetDrivesDevInstByDeviceNumber = objSpdd.DevInst
                            Exit Function
                        End If
                    End If
                    Call CloseHandle(hDrive)
                End If
            End If
        End If
        dwIndex = dwIndex + 1
    Loop
    Call SetupDiDestroyDeviceInfoList(hDevInfo)
End Function

'************************************************************************************************
'參數爲szDosDeviceName爲USB的路徑格式爲"//./" & drive & ":"形式,blnIsShowNote參數是是否顯示
'消息窗體的着用,這裏需要注意的是在9X下只能把blnIsShowNote參數設置爲FALSE
'************************************************************************************************
Public Function RemoveUsbDrive(ByVal szDosDeviceName As String, ByVal blnIsShowNote As Boolean) As Boolean
    Dim strDrive As String, dwDeviceNumber As Long, hVolume As Long, objSdn As STORAGE_DEVICE_NUMBER, dwBytesReturned As Long
    Dim lngRes As Long, uDriveType As Long, strDosDriveName As String, hDevInst As Long, uType As PNP_VETO_TYPE
    Dim strVetoName As String, blnSuccess As Boolean, dwDevInstParent As Long, i As Integer, pVetoType As Long
    '獲取USB所在盤符
    strDrive = Right(szDosDeviceName, 2)
    dwDeviceNumber = -1
    '打開設備
    hVolume = CreateFile(szDosDeviceName, 0, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hVolume = -1 Then
        RemoveUsbDrive = False
        Exit Function
    End If
    '獲取設備號
    lngRes = DeviceIoControl(hVolume, IOCTL_STORAGE_GET_DEVICE_NUMBER, ByVal 0&, 0, objSdn, Len(objSdn), dwBytesReturned, ByVal 0&)
    If lngRes Then
        dwDeviceNumber = objSdn.dwDeviceNumber
    End If
    '關閉設備
    Call CloseHandle(hVolume)
    If dwDeviceNumber = -1 Then
        RemoveUsbDrive = False
        Exit Function
    End If
    '獲取驅動器類型
    uDriveType = GetDriveType(strDrive)
    strDosDriveName = String(280, Chr(0))
    'get the dos device name (like /device/floppy0) to decide if it's a floppy or not - who knows a better way?
    lngRes = QueryDosDevice(strDrive, strDosDriveName, 280)
    strDosDriveName = Left(strDosDriveName, InStr(strDosDriveName, Chr(0)) - 1)
    If lngRes = 0 Then
        RemoveUsbDrive = False
        Exit Function
    End If
    'get the device instance handle of the storage volume by means of a SetupDi enum and matching the device number
    hDevInst = GetDrivesDevInstByDeviceNumber(dwDeviceNumber, uDriveType, strDosDriveName)
    If hDevInst = 0 Then
        RemoveUsbDrive = False
        Exit Function
    End If
    strVetoName = String(260, Chr(0))
    'get drives's parent, e.g. the USB bridge, the SATA port, an IDE channel with two drives!
    lngRes = CM_Get_Parent(dwDevInstParent, hDevInst, 0)
    For i = 0 To 3
        '卸載UB設備
        If blnIsShowNote Then
            lngRes = CM_Request_Device_EjectW(dwDevInstParent, ByVal VarPtr(pVetoType), vbNullString, 0, 0)
        Else
            lngRes = CM_Request_Device_EjectW(dwDevInstParent, uType, strVetoName, 260, 0)
        End If
        If lngRes = 0 And uType = PNP_VetoTypeUnknown Then
            blnSuccess = True
            Exit For
        End If
        Sleep 300
    Next
    RemoveUsbDrive = blnSuccess
End Function

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章