Question

我正在尝试制作一个屏幕锁定软件，只有在插入正确的闪存驱动器时才能解锁，并在拔下电源插头时锁定。所以我搜索并找到了一些检测闪存驱动器的代码。当只有一个闪存驱动器但是如果有多个闪存驱动器并且我没有通过时拔掉一个闪存驱动器时，它可以正常工作，我的软件仍然会锁定屏幕。任何人都可以帮忙吗？

这是我的代码

Imports System.Runtime.InteropServices
Imports System.IO

Public Class Form1

Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
    e.Cancel = True
End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
    Me.WindowState = FormWindowState.Maximized
    Me.TopMost = True
End Sub


Private Const WM_DEVICECHANGE As Integer = &H219
Private Const DBT_DEVICEARRIVAL As Integer = &H8000
Private Const DBT_DEVTYP_VOLUME As Integer = &H2
Private Const DBT_DEVICEREMOVECOMPLETE As Integer = &H8004


Public Structure DEV_BROADCAST_HDR
    Public dbch_size As Int32
    Public dbch_devicetype As Int32
    Public dbch_reserved As Int32
End Structure

Private Structure DEV_BROADCAST_VOLUME
    Public dbcv_size As Int32
    Public dbcv_devicetype As Int32
    Public dbcv_reserved As Int32
    Public dbcv_unitmask As Int32
    Public dbcv_flags As Int16
End Structure

Private Function GetDriveLetterFromMask(ByRef Unit As Int32) As Char
    For i As Integer = 0 To 25
        If Unit = (2 ^ i) Then
            Return Chr(Asc("A") + i)
        End If
    Next
End Function


Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

    If m.Msg = WM_DEVICECHANGE Then
        If m.WParam.ToInt32 = DBT_DEVICEARRIVAL Then
            If CInt(m.WParam) = DBT_DEVICEARRIVAL Then
                Dim DeviceInfo As DEV_BROADCAST_HDR
                DeviceInfo = DirectCast(Marshal.PtrToStructure(m.LParam, GetType(DEV_BROADCAST_HDR)), DEV_BROADCAST_HDR)
                If DeviceInfo.dbch_devicetype = DBT_DEVTYP_VOLUME Then
                    Dim Volume As DEV_BROADCAST_VOLUME
                    Volume = DirectCast(Marshal.PtrToStructure(m.LParam, GetType(DEV_BROADCAST_VOLUME)), DEV_BROADCAST_VOLUME)
                    Dim DriveLetter As String = (GetDriveLetterFromMask(Volume.dbcv_unitmask) & ":\")
                    If IO.File.Exists(IO.Path.Combine(DriveLetter, "password.info")) Then


                        Dim fso As Scripting.FileSystemObject
                        Dim oDrive As Scripting.Drive

                        fso = CreateObject("Scripting.FileSystemObject")

                        oDrive = fso.GetDrive(DriveLetter)


                        Dim passline As String() = File.ReadAllLines(DriveLetter & "password.info")

                        If passline(3) = "1120" & oDrive.SerialNumber Then
                            MessageBox.Show("Welcome!")
                            Me.TopMost = False
                            Me.WindowState = FormWindowState.Minimized

                        Else
                            MsgBox("This is not your password.")
                        End If

                    Else

                        MessageBox.Show("Password couldn't be found!")
                    End If
                End If
            End If
        End If
        If m.WParam.ToInt32 = DBT_DEVICEREMOVECOMPLETE Then

            Me.WindowState = FormWindowState.Maximized
            Me.TopMost = True
            MsgBox("Device is removed!")


        End If
    Else

    End If


    MyBase.WndProc(m)
End Sub

End Class

Answer 1

由于您在移除驱动器时无法获取设备ID，因此无法确定哪个设备已被删除，您所知道的是已删除了某些设备。

此时您确实需要扫描并查看预期的驱动器是否仍然连接。

当检测到正确的USB驱动器时，您需要将其保存在类中，然后检查驱动器被移除后它仍然存在。

像

这样的东西

    Dim Key_Is_Gone = True
    For Each drv As DriveInfo In My.Computer.FileSystem.Drives
        If drv.Name = DriveLetter Then
            Key_Is_Gone = False
            Exit For 
        End If
    Next

    If Key_Is_Gone Then
         'Do what you have to do
    End If

虽然如果驱动器号确实存在，您可能需要检查驱动器的其他一些属性以验证它是否真的是同一个键。否则，一些明亮的火花可能会重新分配你的驱动器号。

也许

drv.RootDirectory.CreationTime

在检测到Key时读取并存储它，并使用该存储值进行测试。

    Dim Key_Is_Gone = True
    For Each drv As DriveInfo In My.Computer.FileSystem.Drives
        If drv.Name = DriveLetter andalso drv.RootDirectory.CreationTime = DetectedKeyDate Then
            Key_Is_Gone = False
            Exit For 
        End If
    Next

    If Key_Is_Gone Then
         'Do what you have to do
    End If

另外：不要使用FSO，使用原生VB.NET

My.Computer.FileSystem

而不是

对象。

Answer 2

如果它是唯一的可移动设备，则可以获取设备类型，然后随便做什么

Dim folder = New FolderBrowserDialog()
Dim drives = System.IO.DriveInfo.GetDrives()
Dim usbDrive = drives.FirstOrDefault(Function(m) m.DriveType = System.IO.DriveType.Removable)

For i As Integer = 0 To drives.Count - 1

    If drives(i).DriveType = System.IO.DriveType.Removable Then
       'Codes will not run if there were no removable device
       folder.SelectedPath = usbDrive.RootDirectory.FullName
       MessageBox.Show(folder.SelectedPath)
    End If

Next i

代码使用Visual Basic语言

如何在Vb.net上检测第一个插入usb闪存

2 个答案: