如何检测U盘并定时提醒备份？

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '系統預設值
   Begin VB.Timer Timer1
      Left            =   3840
      Top             =   240
   End
   Begin Command2
      Caption         =   "Command2"
      Height          =   495
      Left            =   2160
      TabIndex        =   1
      Top             =   240
      Width           =   1335
   End
   Begin Command1
      Caption         =   "Command1"
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'用VB實現卸載U盤
'一般在拔U盤之前，都要先「安全刪除硬件」的,用VB能實現這個功能嗎？
'解答之一:

'Shell "RUNDLL32.EXE shell32.dll,Control_RunDLL hotplug.dll"

'這句代碼可以彈出安全刪除硬件的窗口,可是我想要的不是這樣的效果，我需要直接把U盤安全刪除掉，不用彈出窗口。也就是自動安全刪除U盤。這樣有辦法嗎？


'解答2:
'代碼開始:

Option Explicit

'QQ:121877114     丹心軟件設計
'E-MAIL:CNSTARWORK@
'2007.6.1

Dim boTimeOut As Boolean

Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_REMOVABLE As Long = 2
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_DEVICE_FILE_SYSTEM As Long = 9
Private Const FILE_DEVICE_MASS_STORAGE As Long = &H2D&
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_ANY_ACCESS As Long = 0
Private Const FILE_READ_ACCESS As Long = 1
Private Const LOCK_VOLUME As Long = 6
Private Const DISMOUNT_VOLUME As Long = 8
Private Const EJECT_MEDIA As Long = &H202
Private Const MEDIA_REMOVAL As Long = &H201
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const LOCK_TIMEOUT As Long = 1000
Private Const LOCK_RETRIES As Long = 20

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByRef 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 Long) As Long
               
Private Function CTL_CODE(lngDevFileSys As Long, lngFunction As Long, lngMethod As Long, lngAccess As Long) As Long

    CTL_CODE = (lngDevFileSys * (2 ^ 16)) Or (lngAccess * (2 ^ 14)) Or (lngFunction * (2 ^ 2)) Or lngMethod
   
End Function

Private Function OpenVolume(strLetter As String, lngVolHandle As Long) As Boolean
Dim lngDriveType As Long
Dim lngAccessFlags As Long
Dim strVolume As String

    lngDriveType = GetDriveType(strLetter)
   
    Select Case lngDriveType
        Case DRIVE_REMOVABLE
            lngAccessFlags = GENERIC_READ Or GENERIC_WRITE
        Case DRIVE_CDROM
            lngAccessFlags = GENERIC_READ
        Case Else
            OpenVolume = False
            Exit Function
    End Select
   
    strVolume = "\\.\" & strLetter
    lngVolHandle = CreateFile(strVolume, lngAccessFlags, 0, ByVal CLng(0), OPEN_EXISTING, ByVal CLng(0), ByVal CLng(0))
   
    If lngVolHandle = INVALID_HANDLE_VALUE Then
        OpenVolume = False
        Exit Function
    End If
   
    OpenVolume = True
   
End Function

Private Function CloseVolume(lngVolHandle As Long) As Boolean
Dim lngReturn As Long

    lngReturn = CloseHandle(lngVolHandle)
    If lngReturn = 0 Then
        CloseVolume = False
    Else
        CloseVolume = True
    End If

End Function

Private Function LockVolume(ByRef lngVolHandle As Long) As Boolean
Dim lngBytesReturned As Long
Dim intCount As Integer
Dim intI As Integer
Dim boLocked As Boolean
Dim lngFunction As Long

    lngFunction = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, LOCK_VOLUME, METHOD_BUFFERED, FILE_ANY_ACCESS)
    intCount = LOCK_TIMEOUT / LOCK_RETRIES
    boLocked = False
   
    For intI = 0 To LOCK_RETRIES
   
        boTimeOut = False
        Timer1.Interval = intCount
        Timer1.Enabled = True
        
        Do Until boTimeOut = True Or boLocked = True
            boLocked = DeviceIoControl(lngVolHandle, ByVal lngFunction, CLng(0), 0, CLng(0), 0, lngBytesReturned, ByVal CLng(0))
            DoEvents
        Loop
        
        If boLocked = True Then
            LockVolume = True
            Timer1.Enabled = False
            Exit Function
        End If
        
    Next intI
   
    LockVolume = False

End Function

Private Function DismountVolume(lngVolHandle As Long) As Boolean
Dim lngBytesReturned As Long
Dim lngFunction As Long

    lngFunction = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, DISMOUNT_VOLUME, METHOD_BUFFERED, FILE_ANY_ACCESS)
    DismountVolume = DeviceIoControl(lngVolHandle, ByVal lngFunction, 0, 0, 0, 0, lngBytesReturned, ByVal 0)
   
End Function

Private Function PreventRemovalofVolume(lngVolHandle As Long) As Boolean
Dim boPreventRemoval As Boolean
Dim lngBytesReturned As Long
Dim lngFunction As Long

    boPreventRemoval = False
    lngFunction = CTL_CODE(FILE_DEVICE_MASS_STORAGE, MEDIA_REMOVAL, METHOD_BUFFERED, FILE_READ_ACCESS)
    PreventRemovalofVolume = DeviceIoControl(lngVolHandle, ByVal lngFunction, boPreventRemoval, Len(boPreventRemoval), 0, 0, lngBytesReturned, ByVal 0)

End Function

Private Function AutoEjectVolume(lngVolHandle As Long) As Boolean
Dim lngFunction As Long
Dim lngBytesReturned As Long

    lngFunction = CTL_CODE(FILE_DEVICE_MASS_STORAGE, EJECT_MEDIA, METHOD_BUFFERED, FILE_READ_ACCESS)
    AutoEjectVolume = DeviceIoControl(lngVolHandle, ByVal lngFunction, 0, 0, 0, 0, lngBytesReturned, ByVal 0)

End Function

Private Sub Eject(strVol As String)
Dim lngVolHand As Long
Dim boResult As Boolean
Dim boSafe As Boolean

    strVol = strVol & ":"
    '
    ' Open and get a Handle for the Volume
    '
    boResult = OpenVolume(strVol, lngVolHand)
    If boResult = False Then
        MsgBox "Error Opening Volume " & Err.LastDllError
        Exit Sub
    End If
    '
    ' Lock the Volume
    '
    boResult = LockVolume(lngVolHand)
    If boResult = False Then
        MsgBox "Error Dismounting Volume " & Err.LastDllError
        CloseVolume (lngVolHand)
        Exit Sub
    End If
    '
    'Dismount the Volume
    '
    boResult = DismountVolume(lngVolHand)
    If boResult = False Then
        MsgBox "Error Dismounting Volume " & Err.LastDllError
        CloseVolume (lngVolHand)
        Exit Sub
    End If
    '
    ' Set to allow the Volume to be Removed
    '
    boResult = PreventRemovalofVolume(lngVolHand)
    If boResult = False Then
        MsgBox "Error Allowing Removal of Volume " & Err.LastDllError
        CloseVolume (lngVolHand)
        Exit Sub
    End If
    boSafe = True
    '
    ' Eject the Volume
    '
    boResult = AutoEjectVolume(lngVolHand)
    If boSafe = True Then
        MsgBox "Media may be Safely Removed from Drive " & UCase(strVol)
    End If
    '
    ' Close the Handle
    '
    boResult = CloseVolume(lngVolHand)
    If boResult = False Then
        MsgBox "Error Closing Volume " & Err.LastDllError
        Exit Sub
    End If
   
    Unload Me
   
End Sub

Private Sub Command1_Click()
    Eject "k"
End Sub

Private Sub Timer1_Timer()
    boTimeOut = True
End Sub
   
'代碼結束
'上述代碼實現了以上功能,如果U盤不是K呢？
'加點下面的代碼:
Private Function USBDISKINDEX() As String '找到U盤
Dim i As Long

    For i = Asc("C") To Asc("Z")
        If GetDriveType(Chr(i) + ":") = 2 Then
            USBDISKINDEX = Chr(i)
        End If
    Next i
   
End Function

Private Sub Command2_Click()
    Eject USBDISKINDEX '刪除U盤
End Sub