Trucos Detectar cuál es la unidad de CD-ROM

Private Declare Function GetDriveType 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 Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6

Function StripNulls(startStrg$) As String
  Dim c%, item$
  c% = 1
  Do
     If Mid$(startStrg$, c%, 1) = Chr$(0) Then
        item$ = Mid$(startStrg$, 1, c% - 1)
        startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))
        StripNulls$ = item$
        Exit Function
     End If
     c% = c% + 1
  Loop
End Function

Private Sub Form_Load()
  Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
  Dim CDfound As Integer
  allDrives$ = Space$(64)
  r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
  allDrives$ = Left$(allDrives$, r&)
  Do
    pos% = InStr(allDrives$, Chr$(0))
    If pos% Then
       JustOneDrive$ = Left$(allDrives$, pos%)
       allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
       DriveType& = GetDriveType(JustOneDrive$)
       If DriveType& = DRIVE_CDROM Then
          CDfound% = True
          Exit Do
       End If
    End If
Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
If CDfound% Then
   label1.Caption = "El CD-ROM corresponde a la unidad: " & Ucase$(JustOneDrive$)
Else
   label1.Caption = "Su sistema no posee CD-ROM o unidad no encontrada."
End If
End Sub



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com