опубликован 20-12-2001 14:26 MSK            

Как определить когда появляется и изымается компакт-диск из устройства CD-ROM?
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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex 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 Const WM_DEVICECHANGE = &H219

Public glngPrevWndProc As Long

Public Function MyWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_DEVICECHANGE Then
Select Case wParam

' If device (CD-ROM) arrive...
' Событие возникает при появлении нового диска в CD-ROM'е.
Case &H8000&
Call Form1.DeviceArrival

' If CD-ROM has ejected...
' Событие возникает при изъятии диска из CD-ROM'а
Case &H8004&
Call Form1.DeviceRemoveComplete
End Select
MyWindowProc = 0
Exit Function
End If

' pass the rest messages onto VB's own Window Procedure
' остальные сообщения передаются для обработки стандартной
' процедуре окна
MyWindowProc = CallWindowProc(glngPrevWndProc, hwnd, Msg, wParam, lParam)
End Function

Использование: Создайте форму и поместите в неё следующий код:
Private Sub Form_Load()
' Перенаправление сообщений Windows от формы к собственной
' процедуре обработки сообщений Module1.MyWindowProc
glngPrevWndProc = GetWindowLong(hwnd, GWL_WNDPROC)
SetWindowLong hwnd, GWL_WNDPROC, AddressOf MyWindowProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
' Возвращение управления форме
SetWindowLong hwnd, GWL_WNDPROC, glngPrevWndProc
End Sub

Sub DeviceArrival()
' Здесь вы можете поместить код, который будет выполнятся при
' появление компакт-диска в устройстве CD-ROM
Label2.Caption = "Появилось устройство"
End Sub

Sub DeviceRemoveComplete()
' Здесь вы можете поместить код, который будет выполнятся при
' удалении компакт-диска из устройства CD-ROM
Label2.Caption = "Устройство исчезло"
End Sub