Detekce CD-ROM

Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6

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
* ka₧dß deklarace musφ b²t na samostatnΘ °ßdce

Zalo₧te novou proceduru DetectCDROM:

Public Sub DetectCDROM

   Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
   Dim CDfound As Integer

   'Definice mφsta v prom∞nnΘ
   allDrives$ = Space$(64)

   'Zφskßnφ jmen vÜech disk∙
   r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)

   'o°φznutφ koncov²ch chr$(0). AllDrives$
   'nynφ bude obsahovat pouze jmΘna disk∙.
   allDrives$ = Left$(allDrives$, r&)

   'cyklus
   Do
      'Nalezenφ prvnφho odd∞lovaΦe chr$(0)
      pos% = InStr(allDrives$, Chr$(0))
      'pokud nalezeno ....
      If pos% Then
            'zjiÜt∞nφ disku k chr$(0)
           JustOneDrive$ = Left$(allDrives$, pos%)
           'a odstran∞nφ z °et∞zce allDrives$, aby se netestoval znovu
           allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
          's vybran²m diskem zavolat API pro zjiÜt∞nφ tipu disku 
          DriveType& = GetDriveType(JustOneDrive$)
          'Je-li to CD ROM
           If DriveType& = DRIVE_CDROM Then
               CDfound% = True
               Exit Do
           End If
      End If
   Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM

   If CDfound% Then
        MsgBox "CD-ROM - disk " & UCase$(JustOneDrive$)
   Else
        MsgBox "Tento poΦφtaΦ nemß CD_ROM."
   End If

End Sub

Zp∞t