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

blackman1010 2003-03-14 12:11:03
请问怎样查看光驱所在盘符,如我的电脑为f:盘, 同学的为g:
希望能够帮我把程序写得简单点, 完整点, thanks
...全文
203 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
boywang 2003-03-14
  • 打赏
  • 举报
回复
up
northwolves 2003-03-14
  • 打赏
  • 举报
回复
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private 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
lxcc 2003-03-14
  • 打赏
  • 举报
回复
n多星星熟悉光驱!
up
nik_Amis 2003-03-14
  • 打赏
  • 举报
回复

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 Long

Const SW_SHOWNORMAL = 1





Private 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
blackman1010 2003-03-14
  • 打赏
  • 举报
回复
多谢各位,
对于野性的呼唤的答案, 提示说找不到dll入口点 getdrivetypea in kernel32
也曾经出现过找不到文件: kernel32 后来不知道怎样搞的,这个错误不存在了, 但是出现了上面那个问题
请问怎样解决?
northwolves 2003-03-14
  • 打赏
  • 举报
回复
你的系统估计有问题。
Sean918 2003-03-14
  • 打赏
  • 举报
回复
请提问前先学会搜索以前的帖子!

最近重复的帖子太多了
生活真美好 2003-03-14
  • 打赏
  • 举报
回复
api
用户 昵称 2003-03-14
  • 打赏
  • 举报
回复
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 Long

Private 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
liu584 2003-03-14
  • 打赏
  • 举报
回复
在工程中添加了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
简单吧。
nik_Amis 2003-03-14
  • 打赏
  • 举报
回复
不会吧??
你是什么操作系统???win95??
以上的程序你如果原样复制是绝对不会有问题

blackman1010 2003-03-14
  • 打赏
  • 举报
回复
都是找不到 dll 入口点 in kernel32

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧