请问怎样查看光驱所在盘符，如我的电脑为f:盘， 同学的为g:

Question

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Sub Command1_Click()
Dim msg As String, I As Long
msg = ""
For I = 0 To 25
temp = Chr(65 + I) & ":\"
If GetDriveType(temp) = 5 Then msg = msg & vbCrLf & temp
Next
MsgBox msg, 64, "CDROM"
End Sub

Answer 1

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 Form_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
      If GetDriveType(DriveID) = 5 Then Call ShellPro(DriveID)
      '如果枚举到的盘是CD-ROM,转到 ShellPro 子程序
    Next i
End Sub'子程序:::::打开文件
Sub ShellPro(DrivePro As String) On Error GoTo Err_File:
    If Not IsEmptyCDROM(DrivePro) Then
        Shell (DrivePro & "Hello.exe")   '打开文件路径
        Unload Me
        End  '并结束本程序
    Else
        Debug.Print "cdrom empty"
    End If
Err_File:
   If Err.Description = "错语的文件名或号码" Then Exit Sub
End Sub    Function IsEmptyCDROM(sDrive As String)
     Dim s
     
     On Error GoTo ErrHandle
     s = Dir(sDrive + "*.*")
     IsEmptyCDROM = False
     Exit Function
ErrHandle:
     IsEmptyCDROM = True
    End Function

Answer 2

多谢各位,
对于野性的呼唤的答案, 提示说找不到dll入口点 getdrivetypea  in  kernel32
也曾经出现过找不到文件: kernel32 后来不知道怎样搞的,这个错误不存在了, 但是出现了上面那个问题
请问怎样解决?

Answer 3

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongConst SW_SHOWNORMAL = 1Private Function IsCDRom(ByVal sDriver As String) As Boolean
    Select Case GetDriveType(sDriver)
        Case 2: IsCDRom = False ' "Removable"
        Case 3: IsCDRom = False '  "Drive Fixed"
        Case Is = 4: IsCDRom = False '  "Remote"
        Case Is = 5: IsCDRom = True '  "Cd-Rom"
        Case Is = 6: IsCDRom = False '  "Ram disk"
        Case Else: IsCDRom = False '  "Unrecognized"
    End Select
End Function
Private Function GetCDRom() As String
    Dim LDs As Long, Cnt As Long, sDriver As String
    LDs = GetLogicalDrives
    For Cnt = 0 To 25
        If (LDs And 2 ^ Cnt) <> 0 Then
            sDriver = Chr$(65 + Cnt) & ":\"
            If IsCDRom(sDriver) Then
                Run sDriver
            End If
        End If
    Next Cnt
End Function

Answer 4

都是找不到 dll 入口点    in kernel32

Answer 5

不会吧？？
你是什么操作系统？？？win95??
以上的程序你如果原样复制是绝对不会有问题

Answer 6

在工程中添加了Scripting.FileSystemObject后就可以用下面的代码了:
Set FSO = CreateObject("Scripting.FileSystemObject")
        Set dr = FSO.Drives
        For Each d In dr
            if d.drivetype=4 then
               print d.driveletter  & ":" & "是光驱。"
            end if 
        Next d
简单吧。