Driver - Verifica i CD nel computer

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


Function FreeDrive() As String
Dim DriveNum As String 'Questa variabile, verra' utilizzata nel ciclo per la scansione delle lettere
Dim DriveType As Long 'Per ottenere il tipo di drive
DriveNum = 64 'Il ciclo inizia da 65 che corrispondera alla lettera A (Chr$(65))

Do
DriveNum = DriveNum + 1 ' parte dal drive zero.

DriveType = GetDriveType(Chr$(DriveNum) & ":\")
' se si e' superato C: ed il tipo di drive e' indeterrminato, esce dal loop

Select Case DriveType
Case Is = 1
TipoDrive = "Drive Inesistente"
Case Is = 2
TipoDrive = "Floppy drive"
Case Is = 3
TipoDrive = "Hard drive"
Case Is = 4
TipoDrive = "Drive di rete "
Case Is = 5
TipoDrive = "CD-ROM drive "
Case Is = 6
TipoDrive = "disco RAM"
End Select

List1.AddItem (Chr$(DriveNum) & ":\ " & TipoDrive)
If DriveType = 1 And DriveNum > 67 Then Exit Do
If DriveType = 5 Then
If (PresenzaCD(Chr$(DriveNum))) = True Then
MsgBox ("Nel Drive " & Chr$(DriveNum) & " c'e' un CD-ROM")
Label1.Caption = "Nel Drive " & Chr$(DriveNum) & " c'e' un CD-ROM"
Else
MsgBox ("Nel Drive " & Chr$(DriveNum) & " non c'e' un CD-ROM")

Label1.Caption = "Nel Drive " & Chr$(DriveNum) & " non c'e' alcun CD-ROM"
End If
End If
Loop
End Function

Function PresenzaCD(Drive As String) As Boolean

On Error GoTo ERRORE
PresenzaCD = True
Open Drive + ":\testcd" For Output As #1
Close #1
Exit Function
ERRORE:
'Il codice di errore per l'assenza del CD e' (71)

If Err.Number = 71 Then PresenzaCD = False

End Function
Private Sub Command1_Click()
FreeDrive
End Sub