CD drive notification

Is it possible to intercept a windows message when the drive door closes or
somthing like that, i don't want to have to use a timer to check all the
time?
Thanks

Hi Lee,

The code below detects when the CD was inserted or removed by trapping the
WM_DEVICECHANGE. wParam parameter of the message contains the value of the
specific device change event and the lParam contains pointer to the address of
a structure that contains event-specific data. Its meaning depends on the given
event.
Also it checks if the CD insereted is different from the previous by a call to
GetVolumeInformation().

When the CDROM door is opened wParam = DBT_DEVICEREMOVECOMPLETE, when it is
closed wParam = DBT_DEVICEARRIVAL.

So, you need to subclass your form and trap the WM_DEVICECHANGE message and
then check the value of the wParam parameter.

Here is some code that will let you know when the CD was removed, inserted or
changed:

(NOTE: This code requires VB5 or later)

1. Open a new project and add Module1.bas to it.
2. Place 4 Label controls on Form1 (Label1, Label2, Label3 and Label4)
3. Copy the following code to Form1:

'''''''''''''''''''''''''''''''''''''''Form Module Code''''''''''''''''''''

Private Sub Form_Load()

With Label1
'Set Label1 size and position
.Height = 372
.Width = 2532
.Left = (Me.ScaleWidth - .Width) \ 2
.Top = 120
'Set Label properties
With .Font
.Size = 12
.Bold = True
End With
End With

With Label2
'Set Label2 size and position
.Height = 200
.Width = 2532
.Left = Label1.Left
.Top = Label1.Top + 1.1 * Label1.Height
End With
With Label3
'Set Label3 size and position
.Height = 200
.Width = 2532
.Left = Label1.Left
.Top = Label2.Top + 1.1 * Label2.Height
End With
With Label4
'Set Label3 size and position
.Height = 200
.Width = 2532
.Left = Label1.Left
.Top = Label3.Top + 1.1 * Label3.Height
End With

'Subclass the window
g_lOldProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WndProc)

'Find the CD drive
g_sCDdrive = FindCDROMdrive

'Get current CD info
VolumeInfo g_sCDdrive
End Sub

Private Sub Form_Unload(Cancel As Integer)
'UnSubclass the form
SetWindowLong Me.hWnd, GWL_WNDPROC, g_lOldProc
End Sub

'''''''''''''''''''''''''End Form Module Code''''''''''''''''''''''''''''

4. Copy the following code to the .Bas Module1:

''''''''''''''''''''BAS Module Code'''''''''''''''''''''''''''''''

Public Const WM_DEVICECHANGE = &H219
Public Const DBT_DEVICEARRIVAL = &H8000&
Public Const DBT_DEVICEREMOVECOMPLETE = &H8004&

Public 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

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

Public Const DRIVE_UNKNOWN = 0 'The drive type cannot be determined.
Public Const DRIVE_NO_ROOT_DIR = 1 'The root directory does not exist.
Public Const DRIVE_REMOVABLE = 2 'The disk can be removed from the
drive.
Public Const DRIVE_FIXED = 3 'The disk cannot be removed from the
drive.
Public Const DRIVE_REMOTE = 4 'The drive is a remote (network) drive.

Public Const DRIVE_CDROM = 5 'The drive is a CD-ROM drive.
Public Const DRIVE_RAMDISK = 6 'The drive is a RAM disk.

Public Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)

Public g_lOldProc As Long

Public g_sOldCDVolume As String
Public g_lOldCDSerialNum As Long
Public g_sCDdrive As String

Public Function FindCDROMdrive() As String
'Finds the letter of the First CDROM drive.
'Note: this functions stops searching when
'the first CDROM drive is found. There could be
'more. And the User could have inserted the CD
'in another CDROM drive. So, you could improve the
'function so that it returns all the CDROM drives
'(in an array maybe).

Dim nI As Integer

For nI = Asc("c") To Asc("z")
If GetDriveType(Chr$(nI) & ":") = DRIVE_CDROM Then
FindCDROMdrive = Chr$(nI) & ":"
Exit For
End If
Next nI
End Function
Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As
Long, ByVal lp As Long) As Long
If Msg = WM_DEVICECHANGE Then
With Form1
Select Case wp
Case DBT_DEVICEARRIVAL
.Label1.ForeColor = RGB(0, 100, 200)
.Label1.Caption = "CDROM door closed"

'Get CD info
VolumeInfo g_sCDdrive
Case DBT_DEVICEREMOVECOMPLETE
.Label1.ForeColor = RGB(200, 0, 0)
.Label1.Caption = "CDROM door opened"
.Label2.Caption = ""
.Label3.Caption = ""
.Label4.Caption = ""
End Select
End With
End If

WndProc = CallWindowProc(g_lOldProc, hWnd, Msg, wp, lp)
End Function
Public Sub VolumeInfo(sDisk As String)
Dim lRetVal As Long
Dim sVolumeName As String
Dim lSerialNumber As Long
Dim lMaxNameLength As Long
Dim lFileSystemFlags As Long
Dim sFileSystemName As String
Dim nPos As Integer
Dim nTemp As Integer

'Allocate memory
sVolumeName = String$(256, Chr$(0))
sFileSystemName = String$(256, Chr$(0))

'Check for network drive name
nPos = InStr(1, sDisk, "[")
If nPos > 0 Then
'nTemp = InStr(nPos + 1, sDisk, "]")
' sDisk = Mid$(sDisk, nPos + 1, nTemp - nPos - 1)
sDisk = Left$(sDisk, 2)
End If

If Right$(sDisk, 1) <> "\" Then
sDisk = sDisk & "\"
End If

'Call the API
lRetVal = GetVolumeInformation(sDisk, sVolumeName, Len(sVolumeName) - 1, _
lSerialNumber, lMaxNameLength, lFileSystemFlags, sFileSystemName, _

Len(sFileSystemName) - 1)

With Form1
If lRetVal <> 0 Then
nPos = InStr(1, sVolumeName, Chr$(0))

If nPos > 0 Then
.Label2.Caption = "Volume: " & Left$(sVolumeName, nPos - 1)
Else
'Some error occurred

End If

.Label3.Caption = "SN: " & "&H" & Hex$(lSerialNumber)

If g_sOldCDVolume <> sVolumeName Or g_lOldCDSerialNum <>
lSerialNumber Then
'Show CD status
.Label4.ForeColor = vbRed
.Label4.Caption = "CD changed"

'Update CD info variables
g_sOldCDVolume = sVolumeName
g_lOldCDSerialNum = lSerialNumber
Else
.Label4.ForeColor = vbBlue
.Label4.Caption = "CD not changed"
End If

Else
'Could not get CD info
'Most likely because there
'is no CD in.
.Label2.Caption = ""
.Label3.Caption = ""
.Label4.Caption = "No Disk in CDROM"
End If
End With
End Sub

''''''''''''''''''''''''''End BAS Module Code''''''''''''''''''''''''''''''''''

5. Run the project and play with the CDROM by removing and inserting a CD. Note
that the code will watch the first CDROM on your drive, in case you have more
than one.
NOTE that there is some delay before the WM_DEVICECHANGE message is broadcast.
Also, the message is sent only if a device change has occurred: e.g. if there
was no CD in the CDROM drive when you opened the door, no message is sent.

Regards,
Stoil