首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

小弟我的电脑有两个光驱,怎么用VB6写一个小工具,弹出或关闭指定的光驱

2012-01-15 
我的电脑有两个光驱,如何用VB6写一个小工具,弹出或关闭指定的光驱?我的电脑有两个光驱,如何用VB6写一个小

我的电脑有两个光驱,如何用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

VB code
'类模块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 

热点排行