By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
425,719 Members | 1,046 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

CD ROM Detection

Ali Rizwan
100+
P: 927
Hi all,
I have write this program which is used to detect CD ROM.
You just need to add a command button.

Expand|Select|Wrap|Line Numbers
  1. Option Explicit
  2.  
  3. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
  4.     (ByVal nDrive As String) As Long
  5.  
  6. Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
  7.     Alias "GetLogicalDriveStringsA" _
  8.     (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  9.  
  10. Const DRIVE_CDROM& = 5
  11.  
  12. Public Function GetDriveStrings() As String
  13.     ' Wrapper for calling the GetLogicalDriveStrings api
  14.  
  15.     Dim result As Long          ' Result of our API calls
  16.     Dim strDrives As String     ' String to pass to API call
  17.     Dim lenStrDrives As Long    ' Length of the above string
  18.  
  19.     ' Call GetLogicalDriveStrings with a buffer size of zero to
  20.     ' find out how large our stringbuffer needs to be
  21.     result = GetLogicalDriveStrings(0, strDrives)
  22.  
  23.     strDrives = String(result, 0)
  24.     lenStrDrives = result
  25.  
  26.     ' Call again with our new buffer
  27.     result = GetLogicalDriveStrings(lenStrDrives, strDrives)
  28.  
  29.     If result = 0 Then
  30.         ' There was some error calling the API
  31.         ' Pass back an empty string
  32.         ' NOTE - TODO: Implement proper error handling here
  33.         GetDriveStrings = ""
  34.     Else
  35.         GetDriveStrings = strDrives
  36.     End If
  37. End Function
  38.  
  39. Private Sub Command1_Click()
  40.     Dim strDrives As String
  41.  
  42.     ' Find out what drives we have on this machine
  43.     strDrives = GetDriveStrings()
  44.  
  45.     If strDrives = "" Then
  46.         ' No drives were found
  47.         MsgBox "No Drives were found!", vbCritical
  48.     Else
  49.         ' Walk through the string and check the type of each drive
  50.         ' displaying any cd-rom drives we find
  51.         Dim pos As Long
  52.         Dim drive As String
  53.         Dim drivetype As Long
  54.  
  55.         pos = 1
  56.  
  57.         Do While Not Mid$(strDrives, pos, 1) = Chr(0)
  58.             drive = Mid$(strDrives, pos, 3)
  59.             pos = pos + 4
  60.             drivetype = GetDriveType(drive)
  61.             If drivetype = DRIVE_CDROM Then
  62.                 MsgBox "CD-ROM found at drive " & UCase(drive)
  63.             End If
  64.         Loop
  65.     End If
  66. End Sub
Regards
>> ALI <<
Feb 25 '08 #1
Share this Article
Share on Google+