我的电脑有两个光驱，如何用VB6写一个小工具，弹出或关闭指定的光驱？
我的电脑有两个光驱，如何用VB6写一个小工具，弹出或关闭指定的光驱？
我在网上找到的都是打开默认的光驱，如何打开指定的一个呢？
用下面这个不成功，不知道为什么？
Dim mssg As String * 255
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrRetumString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Sub Timer1_Timer()
On Error Resume Next
Dim fso, d, pos1 As Integer, drv As String
Dim Flag As Boolean
For i = 1 To Drive1.ListCount - 1
pos1 = InStr(Drive1.List(i), ":")
drv = Left(Drive1.List(i), pos1)
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(drv)
Flag = Fun_FloppyDrive(drv) '判断是否空盘
If d.DriveType = 4 And Flag Then '判断如果是光驱并有光盘在读
If pwd <> "12345678" Then '判断是否合法
i = mciSendString("stop cd", 0&, 0, 0) '清除原先的光驱记录
i = mciSendString("close cd", 0&, 0, 0) '清除原先的光驱记录
i = mciSendString("open " & drv & " type cdaudio alias cd wait shareable", 0&, 0, 0)
i = mciSendString("set cd door open wait", mssg, 255, 0)
MsgBox "非法使用光驱", 64, "警告"
End If
End If
Next
End Sub
Private Function Fun_FloppyDrive(sDrive As String) As Boolean
On Error GoTo err
If Dir(sDrive) <> "" Or Dir(sDrive) = "" Then
Fun_FloppyDrive = True
Exit Function
End If
err:
Fun_FloppyDrive = False
End Function
[解决办法]
类模块CDClass
'类模块CDClassOption ExplicitPrivate Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As LongPrivate Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Const DRIVE_CDROM = 5Private Const DRIVE_FIXED = 3Private Const DRIVE_RAMDISK = 6Private Const DRIVE_REMOTE = 4Private Const DRIVE_REMOVABLE = 2Private Const INVALID_HANDLE_VALUE = -1Private Const OPEN_EXISTING = 3Private Const FILE_FLAG_DELETE_ON_CLOSE = 67108864Private Const GENERIC_READ = &H80000000Private Const GENERIC_WRITE = &H40000000Dim MyDrive(23) As String, MyCD_ROM(23) As StringDim i As Long, j As Long, information As Long'寻找光驱CD的函数Public Function SeekCD(FindCD As String) As Boolean '返回参数FindCD为找到的所有光盘驱动器字母之和 On Error Resume Next For i = 0 To 22 MyDrive(i) = Chr(i + 100) & ":": MyCD_ROM(i) = "" Next i j = 0 For i = 0 To 22 information = GetDriveType(MyDrive(i)) If information = DRIVE_CDROM Then SeekCD = True MyCD_ROM(j) = MyDrive(i) FindCD = FindCD & "[" & MyCD_ROM(j) & "]" j = j + 1 '光驱个数累计 End If Next i End Function'控制光驱门的函数Public Function CDRomControl(ByVal DriveLetter As String, ByVal Mode As Long) As Boolean 'DriveLetter为光驱所在盘符， 'Mode为标准的IO控制代码 Dim hDrive As Long, DummyReturnedBytes As Long Dim DriveLetterAndColon As String CDRomControl = False If Len(DriveLetter) Then DriveLetterAndColon = UCase(Left$(DriveLetter & ":", 2)) hDrive = CreateFile("\\.\" & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0) If hDrive <> INVALID_HANDLE_VALUE Then CDRomControl = True Call DeviceIoControl(hDrive, Mode, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0) Call CloseHandle(hDrive) End If End IfEnd Function