是弹出还是探测出? 弹出:mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& 探测出,用DIR函数,或者DriveListBox控件,或者FSO,API都可以,方法很多.
打开/关闭光驱门 声明 Private Declare Function mciSendString Lib "winmm.dll" Alias " mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 代码 Sub OpenCDDoor() mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& End Sub Sub CloseCDDoor() mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0& End Sub 给你段检测磁盘类型的代码 Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Sub Command1_Click() Dim StrDrive As String '盘符串(A:\ C:\ D:\...) Dim DriveID As String '盘符(如:A:\) StrDrive = String(100, Chr$(0)) '初始化盘符串 Call GetLogicalDriveStrings(100, StrDrive) '返回盘符串 Dim i As Integer '返回光盘盘符到数组 For i = 1 To 100 Step 4 '注意这里是4 DriveID = Mid(StrDrive, i, 3) '枚举盘符 If DriveID = Chr$(0) & Chr(0) & Chr(0) Then Exit For '没有盘符,即时退出循环 'Debug.Print DriveID 'Debug.Print GetDriveType(DriveID) If GetDriveType(DriveID) = 2 Then List1.AddItem DriveID & " 软盘" End If If GetDriveType(DriveID) = 3 Then List1.AddItem DriveID & " 硬盘" End If If GetDriveType(DriveID) = 5 Then List1.AddItem DriveID & " 光驱" End If Next iEnd Sub another code 你可以使用下面这个函数: Public Function IsEmptyCDROM(sDrive As String) Dim s
On Error GoTo ErrHandle s = Dir(sDrive + ":\*.*") IsEmptyCDROM = False Exit Function ErrHandle: IsEmptyCDROM = True End Function 如果你的光驱是E盘,调用IsEmptyCDROM("e"),如果返回值为False表示有光盘,返回True表示没有光盘。
弹出:mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0&
探测出,用DIR函数,或者DriveListBox控件,或者FSO,API都可以,方法很多.
Private Declare Function mciSendString Lib "winmm.dll" Alias "
mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString
As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As
Long
代码
Sub OpenCDDoor()
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0&
End Sub Sub CloseCDDoor()
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0&
End Sub 给你段检测磁盘类型的代码
Option Explicit
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Sub Command1_Click()
Dim StrDrive As String '盘符串(A:\ C:\ D:\...)
Dim DriveID As String '盘符(如:A:\)
StrDrive = String(100, Chr$(0)) '初始化盘符串
Call GetLogicalDriveStrings(100, StrDrive) '返回盘符串
Dim i As Integer
'返回光盘盘符到数组
For i = 1 To 100 Step 4 '注意这里是4
DriveID = Mid(StrDrive, i, 3) '枚举盘符
If DriveID = Chr$(0) & Chr(0) & Chr(0) Then Exit For '没有盘符,即时退出循环
'Debug.Print DriveID
'Debug.Print GetDriveType(DriveID)
If GetDriveType(DriveID) = 2 Then
List1.AddItem DriveID & " 软盘"
End If
If GetDriveType(DriveID) = 3 Then
List1.AddItem DriveID & " 硬盘"
End If
If GetDriveType(DriveID) = 5 Then
List1.AddItem DriveID & " 光驱"
End If
Next iEnd Sub
another code
你可以使用下面这个函数:
Public Function IsEmptyCDROM(sDrive As String)
Dim s
On Error GoTo ErrHandle
s = Dir(sDrive + ":\*.*")
IsEmptyCDROM = False
Exit Function
ErrHandle:
IsEmptyCDROM = True
End Function
如果你的光驱是E盘,调用IsEmptyCDROM("e"),如果返回值为False表示有光盘,返回True表示没有光盘。