IF(A73X) {TRUE;}

ເປັນໂປຣແກຣມ ກວດຈັບ ຫາ ຊ່ອງ USB ເມື່ອ ເຮົາສຽບ USB ເຂົ້າໃສ່ຄອມ
Image does not exist: https://www.planet-source-code.com/Upload_PSC/ScreenShots/PIC200721912582850.GIF
ມີໂຄ້ດ ດັ່ງນີ້:
ສຳລັບໄຟລໂມດູນ
Module1.bas ແມ່ນປະກາດ API Function ໄວ້

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

ສຳລັບ Form1.frm ມີ ໂຄ້ດໃນຟອມ :

Option Explicit
Dim s As String
Dim r As String
Dim i As Integer
Private Sub Form_Load()
    GetUSB List1
End Sub
'USB .........
'Tip device  : 2        'Logical volume (disk drive).
'ID          : 16       'Logical unit mask identifying one or more logical units.Each bit in the mask corresponds to one logical drive
'Disc        : E
'Nume Device :
'Data device : 0
Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
    s = ""
    r = ""
    s = s & "USB ........." & vbCrLf
    s = s & "Tip device  : " & DeviceType & vbCrLf
    s = s & "ID          : " & DeviceID & vbCrLf
    s = s & "Disc        : " & GetDrive(DeviceType, DeviceID) & vbCrLf
    s = s & "Nume device : " & DeviceName & vbCrLf
    s = s & "Data device : " & DeviceData & vbCrLf
    Text1.Text = s
    Text2.Text = r
    GetUSB List2
End Sub
Private Function GetUSB(list As ListBox) As String
Dim nDrive, cDrive, DriveType As String
    list.Clear
    For i = 65 To 90
        nDrive = Chr(i) & ":"
        cDrive = GetDriveType(nDrive)
        Select Case cDrive
            Case 2
                If nDrive = "A:" Then
                    DriveType = "- Floppy disc"
                Else
                    DriveType = "- Periferic USB"
                End If
            Case 3
                DriveType = "- Hard Disc"
            Case 4
                DriveType = "- Disc Retea"
            Case 5
                DriveType = "- CD/DVD"
            Case Else
                DriveType = "- Neidentificat"
        End Select
        If cDrive <> 1 Then
            list.AddItem nDrive & vbTab & vbTab & DriveType
        End If
    Next i
End Function
Private Function GetDrive(devType As Long, devID As Long) As String
   Select Case devType
   Case 0 To 1
      GetDrive = devID
      Exit Function
   Case 3 To 4
      GetDrive = devID
      Exit Function
   Case 2
      Dim drives(25)
      Dim dvNum As Long
      Dim i As Integer
      dvNum = 1
      drives(0) = 1
      For i = 1 To 25
         dvNum = dvNum * 2
         drives(i) = dvNum
      Next i
      For i = 0 To 25
         If drives(i) = devID Then
            GetDrive = Chr(i + 65)
            r = r & devType & " - " & devID & vbCrLf
            Exit Function
         End If
      Next i
   Case Else
      r = r & devType & " - " & devID & vbCrLf
   End Select
   
 End Function
Private Sub SysInfo1_DeviceRemoveComplete(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
    Text1.Text = "Device-ul a fost scos"
    GetUSB List2
End Sub