Detect if CD-ROM in drive?

[rjlohan]

I need the simplest, way of determining if a CD I have burned is in the CD-ROM drive when someone tries to run my application from their hard disk.

Spare me the 'they'll copy it anyway' stuff...

The reason I need this is because I have 165MB of audio files (.wavs - no time to create anything smaller, so spare me that lecture too... ), and I want a warning to appear when someone tries to run the program without the CD to say something like:

"CD Not in drive, do you wish to proceed with audio deactivated?"

No = Quit program.

Simple.

Cheers,
RJ

[Blinky Bill]

You can use the fso to try to connect to the C: drive and check its volume name. The fso gives an error if a cd isn't in the drive, so you can then give the message. If the cd does exist, you can check the volume name or something else if you wish and give the message that way.

Hope this helps

[rjlohan]

I'm not going to know which drive letter to check though. Could be D:, E:, F:, or anything else, I'm not sure.

[BuggyProgrammer]

well.... when they first run the program ask them for their cd-drive. or maybe enum all drives and check each one.

[rjlohan]

Thewse people are computer noobies to the max, or something...

Some of them put the mouse on the computer screen, cause they just don't know how to use PCs, so can't ask them for the CD drive.

I'd rather find something neater than checking every letter of the alphabet.

[Blinky Bill]

Do you install the program at all? Because if you do, they have to put your cd in the cd-rom right? So, use App.Path to determine the letter of the drive being used at install time, and write a text file containing that letter and read that text file every time the app starts to check for your cd.

[macai]

Put this code in a module:

Public Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength _
As Long, ByVal hwndCallback As Long) As Long
 
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Const DRIVE_CDROM = 5
 
Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
 
 
Public Sub CloseDoor(ByVal DriveLetter As String)
    Dim AliasName As String
    AliasName = "Drive" & DriveLetter
    mciSendString "Open " & DriveLetter & ": Alias " & AliasName _
    & " Type CDAudio", 0, 0, 0
    mciSendString "Set " & AliasName & " Door Closed", 0, 0, 0
End Sub
 
Public Sub OpenDoor(ByVal DriveLetter As String)
    Dim AliasName As String
    AliasName = "Drive" & DriveLetter
    mciSendString "Open " & DriveLetter & ": Alias " & AliasName _
    & " Type CDAudio", 0, 0, 0
    mciSendString "Set " & AliasName & " Door Open", 0, 0, 0
End Sub
Public Function CDLETTERS() As Variant()
 'Nucleus
 'Returns an array containing all cd rom drives Or Null of none found
 Dim tmp&, CDsCount&, ret&
 Dim tmpStr$, Drives$
 Dim CDDrives(): ReDim CDDrives(0)
 
 'init Drives To 255 spaces
 Drives = Space(255)
 'get drives, Drives var will look like
 'A:\<NULL>C:\<NULL>D:\<NULL>E:\<NULL> (note: letter of drive is every 4th char)
 'ret is the length of the String containing all the drives
 ret = GetLogicalDriveStrings(Len(Drives), Drives)
 For tmp = 1 To ret Step 4
    'extract drive from the String like "A:\"
    tmpStr = Mid(Drives, tmp, 3)
    'check If drive is a CD
    If GetDriveType(tmpStr) = DRIVE_CDROM Then
        CDsCount = CDsCount + 1
        If CDDrives(0) <> "" Then ReDim Preserve CDDrives(UBound(CDDrives) + 1)
        CDDrives(UBound(CDDrives)) = Left(tmpStr, 1)
    End If
 Next tmp
 If CDDrives(0) = "" Then
  CDLETTERS = Null
 Else
  CDLETTERS = CDDrives
 End If
End Function

The CDLETTERS function returns an array of drive letters that ARE
ALL CD ROMS! So just go through all of them!

[rjlohan]

Thanks all. I have a working solution.

Macai - your code seems a bit much. I used the API function GetDriveType to do this. I ended up just looping through the A-Z possible drive letters.

Is all the rest necessary?

[Bruce Fox]

G'Day RJ,

Just a thought; 'My Computer' can see the CDROM drive, so isn't
there some API function that can access that system info?
(instead of looping thru).



Bruce.

[rjlohan]

It probably just does the same thing as this. It's very fast really. And the GetDriveType function can return about 8 different drive 'types', so it's a pretty nifty function I guess.

It's all good though, this solution is fine.

[alex_read]

The simpler way to grab cd rom drives is to use the GetDriveType Api call, you're right on that one (bit less coding):
http://www.vbforums.com/showthread.p...&highlight=rom

[rjlohan]

That's almost exactly what I have done.

[alex_read]

Now the second part, this is the shortest way I could think of to determine if a cd is in the drive:

[size="1"]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 Sub Form_Load()
    Dim lngTotalClusters As Long
    If (GetDiskFreeSpace("D:\", ByVal 0&, ByVal 0&, ByVal 0&, _
    lngTotalClusters) = 0) Then
        MsgBox "No CD in drive"
    End If
End Sub[/size]

[alex_read]

Finally, if you needed to check that it was your CD in the drive, you'd need to use the GetVolumeLabel Api call as mentined above somehow.

[macai]

Originally posted by rjlohan
Thanks all. I have a working solution.

Macai - your code seems a bit much. I used the API function GetDriveType to do this. I ended up just looping through the A-Z possible drive letters.

Is all the rest necessary?

RJ, i just had a module with this code in it. I didn't look at the
code itself, but all i know is it works. In other words, its a module
that i copied and pasted into the post. Sorry if i wasted your time,
man.

[alex_read]

It wasn't a waste of time at all - it works! Just that he wanted a cut down version. If you know the answer & can help out on a post, then always reply

[rjlohan]

Wasn't a waste of time.

Just thought I'd suggest that your code could be simplified. Could help you too.


Alex - I used some GetVolumeInformation API or somesuch to read the CD label, in the drive which returns a DRIVE_CDROM result from GetDriveType.

Works, although I'm a bit unclear of what the parameters to that function are. Gotta love C&P.

[alex_read]

I haven't got the faintest idea what you're going on about !
What's C&P?!?!?!

Anyway, if you haven't downloaded the API Guide program (free one from www.allapi.net), grab it now it has the parameters explained as well as vb6 & vb.net sample code for most Windows API calls & it's where I start off when I write most of my samples!

[rjlohan]

Cut & Paste.


Not, don't have that one yet. Don't know why really...

[alex_read]

Sorry it took a while to post this back, but here goes! This is a list explanation of the parameters for the GetVolumeInformation API call ....

ByVal lpRootPathName As String
String for the root directory of the path or file you want to grab the information for.
In your sample, you'll want to pass in the CD-ROM drive i.e. "D:\"

ByVal lpVolumeNameBuffer As String
This is a returned value from the API call - rather than specifying/passing in a value parameter,
you pass a string variable in which'll be populated with a value when the API call runs.
Since you don't need this bit, you can pass a null string in. i.e. "vbNullString"

ByVal nVolumeNameSize As Long
This limit's the size of the above string returned. I.e. if the above string returned was "xyz " and
you put a 3 in here, the actual value returned will be the first 3 trimmed characters i.e. "xyz"

lpVolumeSerialNumber As Long
Again, this is a value which is returned from the API call & returns the volume serial number of the
drive. This one we do need, so pass in a long variable already declared in here. When the API call runs,
this will be populated & your long variable can be used afterward in say, a messagebox.

lpMaximumComponentLength As Long
Won't go into this one, only as much as to say we don't need this parameter!

Pass another blank value in for this one, like with the "vbnullstring" setting passed to a string parameter,
you pass a 0 in for a blank/default value when dealing with long parameter types. To make it run a bit
faster, enter this 0 value as "ByVal CLng(0)", specifying it as byval & converting it to a long value.

lpFileSystemFlags As Long
Again, not needed, this returns a value from the function for the flags of the file system, flags are items/notes
about the file systems such as "does it support case sensitive filenames" or "is it compressed", pass another
null value in. i.e. "Byval Clng(0)"

ByVal lpFileSystemNameBuffer As String
Returned value indicating if the volume (CD-ROM Drive) has a FAT or NTFS filesystem. Again, this we don't need,
so pass in a blank string "vbNullString"

ByVal nFileSystemNameSize As Long
Works exactly the same as the "nVolumeNameSize" parameter, so deserves the same value - "Byval Clng(0)"

[alex_read]

Api's aren't too scary once you get to know them, putting the above info into a sample, you end up with this one. Realistically, it's only 4 lines of code:

[size="1"]Private Declare Function GetVolumeInformation Lib "Kernel32" _
  Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
  ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
  lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
  ByVal nFileSystemNameSize As Long) As Long
 
Private Sub Form_Load()
    Dim lngReturnedSerialNo As Long
    GetVolumeInformation "C:\", vbNullString, ByVal CLng(0), lngReturnedSerialNo, _
    ByVal CLng(0), ByVal CLng(0), vbNullString, ByVal CLng(0)
 
    MsgBox "The serial number of the C drive is: " & Trim(lngReturnedSerialNo)
End Sub[/size]

[bumbala]

Achieving your goal with APIs is cleaner and I would suggest you do that way but if you have already included Scripting in your project or you may include it, you can try this:

    Dim fs As New FileSystemObject
    Dim d As Drive
    
    For Each d In fs.Drives
        If d.DriveType = CDRom Then
            'Check a file in the CD-ROM, to see whether it is the correct CD
            'or check its Label etc...
            If True Then
                Exit For
            End If
        End If
    Next
    Set fs = Nothing

[jian2587]

Well, if u use CD Volume to determine if its ur CD, then is it
possible that someone is trying to fool ur program by formatting
a CDROM with the Volume number of ur CD, and how he get ur
CD's volume is by DIR it.

[rjlohan]

As I said in the very first post, this isn't a security measure.

I don't care if someone wants to do that.