unidad de cd

18/01/2005 - 18:33 por gemma | Informe spam
Que tal, espero me puedan ayudar:

Necesito detectar la unidad de CD-Room, por lo regular se
encuentra en D:, pero tengo equipos en los que cambia la
letra, como puedo hacer para detectar en que letra esta
dicha unidad?

Gracias Anticipadas
 

Leer las respuestas

#1 KL
18/01/2005 - 19:45 | Informe spam
Gemma,

Creo q habra q recurrir al codigo VBA y especificamente a las llamadas API
de Windows. Abajo te pongo un codigo basado en las funciones creadas por
John Walkenbach. Tienes q ir al Editor VBA, crear un nuevo modulo, pegar el
codigo ahi y lanzar el macro BuscarCDRom.

Saludos,
KL

'-Inicio Codigo
Option Explicit

' 32-bit API declarations

Private Declare Function GetDriveType32 Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function GetDiskFreeSpace Lib "kernel32" _
Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) _
As Long

Private Function DriveType(DriveLetter As String) As String
Dim DLetter
Dim DriveCode
' Returns a string that describes the drive type

DLetter = Left(DriveLetter, 1) & ":"
DriveCode = GetDriveType32(DLetter)

Select Case DriveCode
Case 1: DriveType = "Local"
Case 2: DriveType = "Removable"
Case 3: DriveType = "Fixed"
Case 4: DriveType = "Remote"
Case 5: DriveType = "CD-ROM"
Case 6: DriveType = "RAM Disk"
Case Else: DriveType = "Unknown Drive Type"
End Select
End Function

Private Function NumberofDrives() As Integer
' Returns the number of drives

Dim Buffer As String * 255
Dim BuffLen As Long
Dim DriveCount As Integer
Dim i

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)
DriveCount = 0
' Search for a null -- which separates the drives
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) = 0 Then _
DriveCount = DriveCount + 1
Next i
NumberofDrives = DriveCount
End Function

Private Function DriveName(index As Integer) As String
' Returns the drive letter using an index
' Returns an empty string if index > number of drives

Dim Buffer As String * 255
Dim BuffLen As Long
Dim TheDrive As String
Dim DriveCount As Integer
Dim i

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)

' Search thru the string of drive names
TheDrive = ""
DriveCount = 0
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) <> 0 Then _
TheDrive = TheDrive & Mid(Buffer, i, 1)
If Asc(Mid(Buffer, i, 1)) = 0 Then 'null separates drives
DriveCount = DriveCount + 1
If DriveCount = index Then
DriveName = UCase(Left(TheDrive, 1))
Exit Function
End If
TheDrive = ""
End If
Next i
End Function

Sub BuscarCDRom()
Dim i As Integer
Dim DLetter As String
Dim NumDrives As Integer
Dim contador As Integer

NumDrives = NumberofDrives()

For i = 1 To NumDrives
DLetter = DriveName(i)
If DriveType(DLetter) = "CD-ROM" Then
MsgBox DLetter & ":\ es un CD-ROM"
contador = contador + 1
End If
Next i
MsgBox "Se han encontrado " & contador & " CD-ROM(s)"
End Sub
'-Fin Codigo


"gemma" wrote in message
news:150101c4fd83$c481f1d0$
Que tal, espero me puedan ayudar:

Necesito detectar la unidad de CD-Room, por lo regular se
encuentra en D:, pero tengo equipos en los que cambia la
letra, como puedo hacer para detectar en que letra esta
dicha unidad?

Gracias Anticipadas

Preguntas similares