Detect Media Change...

[Vincent]

Hello Friends,

I need to be able to detect when the media from a drive has been either
inserted or removed. Are there any API or sample apps to show this...? I
have found none. :(
If it can support USB as well... that would be great.

Thanks for any help. :)

[Mike D Sutton]

> I need to be able to detect when the media from a drive has been either
> inserted or removed. Are there any API or sample apps to show this...? I
> have found none. :(
> If it can support USB as well... that would be great.

See if this is of any use:
http://groups.google.co.uk/group/microsoft.public.vb.general.discussion/msg/5d56b5bc0080cc0a
Hope this helps,

Mike

- Microsoft Visual Basic MVP -
E-Mail: ED...@mvps.org
WWW: Http://EDais.mvps.org/

[Vincent]

Thank you , Mike. :)

[Vincent]

Hello again, Mike.

Is there anyway to get the drive letter as well...?

Thanks again.

[Saga]

This is interesting...

Ok, so VB can catch device arrival and removal, but if I want to remove
a device from a USB port, such as one of those USB drives? Can this be
done from VB?

Some where I have some code that displays the "Safely Remove Hardware"
dialog, but is there a way to actually disconnect the device using VB
code?

Thanks
Saga

"Mike D Sutton" <EDai...@SPAMMEmvps.org> wrote in message
news:%23udE6YN...@TK2MSFTNGP10.phx.gbl...

[Mike D Sutton]

> Is there anyway to get the drive letter as well...?

Try this Window proc method instead:

'***
Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As
Long)
Private Declare Sub GetDWord Lib "MSVBVM60.dll" Alias "GetMem4" (ByRef inSrc As Any, ByRef inDst As Long)
Private Declare Sub GetWord Lib "MSVBVM60.dll" Alias "GetMem2" (ByRef inSrc As Any, ByRef inDst As Integer)

Private Type DEV_BROADCAST_HDR
dbch_size As Long
dbch_devicetype As Long
dbch_reserved As Long
End Type

Private Const DBT_DEVNODES_CHANGED As Long = &H7
Private Const DBT_DEVTYP_VOLUME As Long = &H2 ' Logical volume
Private Const DBTF_MEDIA As Long = &H1 ' Media comings and goings
Private Const DBTF_NET As Long = &H2 ' Network volume

...

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim DevBroadcastHeader As DEV_BROADCAST_HDR
Dim UnitMask As Long, Flags As Integer

If (uMsg = WM_DEVICECHANGE) Then
Select Case wParam
Case DBT_DEVICEARRIVAL, DBT_DEVICEREMOVECOMPLETE
Call RtlMoveMemory(DevBroadcastHeader, ByVal lParam, Len(DevBroadcastHeader))

If (DevBroadcastHeader.dbch_devicetype = DBT_DEVTYP_VOLUME) Then
Call GetDWord(ByVal (lParam + Len(DevBroadcastHeader)), UnitMask)
Call GetWord(ByVal (lParam + Len(DevBroadcastHeader) + 4), Flags)

Debug.Print "Drive(s): " & UnitMaskToString(UnitMask) & " " & _
IIf(wParam = DBT_DEVICEARRIVAL, "Inserted", "Ejected")
End If
Case DBT_DEVNODES_CHANGED
Debug.Print "Device added or removed"
End Select
End If

WndProc = CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam)
End Function

Private Function UnitMaskToString(ByVal inUnitMask As Long) As String
Dim LoopBits As Long

For LoopBits = 0 To 30
If (inUnitMask And (2 ^ LoopBits)) Then _
UnitMaskToString = UnitMaskToString & Chr$(Asc("A") + LoopBits)
Next LoopBits
End Function
'***

[Mike D Sutton]

> This is interesting...
>
> Ok, so VB can catch device arrival and removal, but if I want to remove
> a device from a USB port, such as one of those USB drives? Can this be
> done from VB?
>
> Some where I have some code that displays the "Safely Remove Hardware"
> dialog, but is there a way to actually disconnect the device using VB
> code?

Sure, you need to check for the DBT_DEVNODES_CHANGED flag in the wParam - See my reply to Vincent for an updated window
proc that takes this into account. Additional information is more difficult to come by with this method though, and
you'll probably have to register for device notification if you're after something specific.

[Mike D Sutton]

> Sure, you need to check for the DBT_DEVNODES_CHANGED flag in the wParam - See my reply to Vincent for an updated
window
> proc that takes this into account. Additional information is more difficult to come by with this method though, and
> you'll probably have to register for device notification if you're after something specific.

Here's a more complete demo which includes device notification registration:

'*** Form:
Private Declare Function RegisterDeviceNotification Lib "User32.dll" Alias _
"RegisterDeviceNotificationA" (ByVal hRecipient As Long, _
ByRef NotificationFilter As Any, ByVal Flags As Long) As Long
Private Declare Function UnregisterDeviceNotification Lib "User32.dll" ( _
ByVal Handle As Long) As Long

Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type DEV_BROADCAST_DEVICEINTERFACE
dbcc_size As Long
dbcc_devicetype As Long
dbcc_reserved As Long
dbcc_classguid As Guid
dbcc_name As Long
End Type

Private hDevNotify As Long

Private Const DEVICE_NOTIFY_WINDOW_HANDLE As Long = &H0
Private Const DBT_DEVTYP_DEVICEINTERFACE As Long = &H5 ' Device interface class
Private Const DEVICE_NOTIFY_ALL_INTERFACE_CLASSES As Long = &H4

Private Sub Form_Load()
Dim NotificationFilter As DEV_BROADCAST_DEVICEINTERFACE

With NotificationFilter
.dbcc_size = Len(NotificationFilter)
.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE
End With

Call SubClass(Me.hWnd)
hDevNotify = RegisterDeviceNotification(Me.hWnd, NotificationFilter, _
DEVICE_NOTIFY_WINDOW_HANDLE Or DEVICE_NOTIFY_ALL_INTERFACE_CLASSES)
End Sub

Private Sub Form_Unload(ByRef Cancel As Integer)
Call UnregisterDeviceNotification(hDevNotify)
Call UnSubClass
End Sub
'***

'*** Module:
Private Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "User32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _

ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function StringFromGUID2 Lib "OLE32.dll" ( _
ByRef rGUID As Any, ByVal lpSz As String, ByVal cchMax As Long) As Long
Private Declare Function lstrcpyA Lib "Kernel32.dll" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32.dll" (ByVal lpString As Long) As Long
Private Declare Function GetDriveType Lib "Kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" ( _

ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub GetDWord Lib "MSVBVM60.dll" Alias "GetMem4" (ByRef inSrc As Any, ByRef inDst As Long)
Private Declare Sub GetWord Lib "MSVBVM60.dll" Alias "GetMem2" (ByRef inSrc As Any, ByRef inDst As Integer)

Private Type DEV_BROADCAST_HDR
dbch_size As Long
dbch_devicetype As Long
dbch_reserved As Long
End Type

Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Dim OldProc As Long
Dim WndHnd As Long

Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_DEVICECHANGE As Long = &H219

Private Const DBT_DEVNODES_CHANGED As Long = &H7

Private Const DBT_DEVICEARRIVAL As Long = &H8000&
Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&

Private Const DBT_DEVTYP_VOLUME As Long = &H2 ' Logical volume

Private Const DBT_DEVTYP_DEVICEINTERFACE As Long = &H5 ' Device interface class

Private Const DBTF_MEDIA As Long = &H1 ' Media comings and goings
Private Const DBTF_NET As Long = &H2 ' Network volume

Private Const DRIVE_NO_ROOT_DIR As Long = 1
Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK As Long = 6

Public Sub SubClass(ByVal inWnd As Long)
If (WndHnd) Then Call UnSubClass

OldProc = SetWindowLong(inWnd, GWL_WNDPROC, AddressOf WndProc)
WndHnd = inWnd
End Sub

Public Sub UnSubClass()
If (WndHnd = 0) Then Exit Sub
Call SetWindowLong(WndHnd, GWL_WNDPROC, OldProc)

WndHnd = 0
OldProc = 0
End Sub

Private Function WndProc(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim DevBroadcastHeader As DEV_BROADCAST_HDR
Dim UnitMask As Long, Flags As Integer

Dim DeviceGUID As Guid
Dim DeviceNamePtr As Long
Dim DriveLetters As String
Dim LoopDrives As Long

If (uMsg = WM_DEVICECHANGE) Then
Select Case wParam
Case DBT_DEVICEARRIVAL, DBT_DEVICEREMOVECOMPLETE

If (lParam) Then ' Read generic DEV_BROADCAST_HDR structure

Call RtlMoveMemory(DevBroadcastHeader, ByVal lParam, Len(DevBroadcastHeader))

If (DevBroadcastHeader.dbch_devicetype = DBT_DEVTYP_VOLUME) Then

' Read end of DEV_BROADCAST_VOLUME structure

Call GetDWord(ByVal (lParam + Len(DevBroadcastHeader)), UnitMask)
Call GetWord(ByVal (lParam + Len(DevBroadcastHeader) + 4), Flags)

DriveLetters = UnitMaskToString(UnitMask)

For LoopDrives = 1 To Len(DriveLetters) ' Print a message for each drive
Debug.Print "Drive " & Mid$(DriveLetters, LoopDrives, 1) & " " & _
IIf(wParam = DBT_DEVICEARRIVAL, "Inserted", "Ejected") & " (" & _
DriveTypeToString(GetDriveType(Mid$(DriveLetters, LoopDrives, 1) & ":\")) & ")"
Next LoopDrives
ElseIf (DevBroadcastHeader.dbch_devicetype = DBT_DEVTYP_DEVICEINTERFACE) Then
' Read end of DEV_BROADCAST_DEVICEINTERFACE structure
Call RtlMoveMemory(DeviceGUID, ByVal (lParam + Len(DevBroadcastHeader)), Len(DeviceGUID))
Call GetDWord(ByVal (lParam + Len(DevBroadcastHeader) + Len(DeviceGUID)), DeviceNamePtr)
Debug.Print "Device GUID: " & GUIDToString(DeviceGUID) & _
", name: """ & CopyStringA(DeviceNamePtr) & """"
End If

End If
Case DBT_DEVNODES_CHANGED
Debug.Print "Device added or removed"
End Select
End If

WndProc = CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam)
End Function

Private Function UnitMaskToString(ByVal inUnitMask As Long) As String
Dim LoopBits As Long

For LoopBits = 0 To 30
If (inUnitMask And (2 ^ LoopBits)) Then _
UnitMaskToString = UnitMaskToString & Chr$(Asc("A") + LoopBits)
Next LoopBits
End Function

Private Function GUIDToString(ByRef inGUID As Guid) As String
Dim RetBuf As String, GUILen As Long

Const BufLen As Long = 80

RetBuf = Space$(BufLen)
GUILen = StringFromGUID2(inGUID, RetBuf, BufLen)

If (GUILen) Then GUIDToString = StrConv(Left$(RetBuf, (GUILen - 1) * 2), vbFromUnicode)
End Function

Public Function CopyStringA(ByVal inPtr As Long) As String
Dim BufLen As Long

BufLen = lstrlenA(inPtr)

If (BufLen > 0) Then
CopyStringA = Space$(BufLen)
Call lstrcpyA(CopyStringA, inPtr)
End If
End Function

Private Function DriveTypeToString(ByVal inDriveType As Long) As String
Select Case inDriveType
Case DRIVE_NO_ROOT_DIR: DriveTypeToString = "No root directory" '??
Case DRIVE_REMOVABLE: DriveTypeToString = "Removable"
Case DRIVE_FIXED: DriveTypeToString = "Fixed"
Case DRIVE_REMOTE: DriveTypeToString = "Remote"
Case DRIVE_CDROM: DriveTypeToString = "CD-ROM"
Case DRIVE_RAMDISK: DriveTypeToString = "RAM disk"
Case Else: DriveTypeToString = "[ Unknown ]"
End Select
End Function
'***

AFAIK the notification for all devices will only work properly under WinXP, on older OS' you'll just get a
DBT_DEVNODES_CHANGED message (you will get a separate notification tell you the drive letter if it appears to the system
as a drive though.) If you're after a specific device then you can request notification for that specific device using
RegisterDeviceNotification().