Seykron

Option Explicit

Public Const GWL_WNDPROC = (-4)

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 Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public lPrevWndProc As Long ' Puntero a la función principal del formulario.

Function DevWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
' Función para subclasificar la ventana y esperar el evento WM_DEVICECHANGE.
'
        Dim lpDevHdr    As DEV_BROADCAST_HDR
        Dim lpDevVolume As DEV_BROADCAST_VOLUME

  If (uMsg = WM_DEVICECHANGE) Then
    
    If (wParam = DBT_DEVICEARRIVAL) Then
      '
      ' Se insertó un nuevo dispositivo USB.
      '
      
      ' Lee la estructura de la memoria.
      '
      Call CopyMemory(lpDevHdr, ByVal lParam, Len(lpDevHdr))
      
      If (lpDevHdr.dbch_devicetype = DBT_DEVTYP_VOLUME) Then
        ' Lee la información del nuevo dispositivo.
        '
        Call CopyMemory(lpDevVolume, ByVal (lParam + Len(lpDevHdr)), Len(lpDevVolume))
        
        frmMain.lblInfo = "Se encontró un nuevo volumen: " & GetDriveFromMask(lpDevVolume.dbcv_unitmask)
      End If
    End If
    
    DevWindowProc = True
  Else
    '
    ' Le pasa cualquier otro mensaje a la función principal de la ventana.
    '
    DevWindowProc = CallWindowProc(lPrevWndProc, frmMain.hWnd, uMsg, wParam, lParam)
  End If
End Function

Function GetDriveFromMask(ByVal unitmask As Long) As String
        Dim i%, iDriveType%
   
  unitmask = LoWord(unitmask)
  
  For i = 3 To 25

    If ((unitmask And (2 ^ i)) Or (Abs(unitmask) And (2 ^ i))) Then
      iDriveType = GetDriveType(Chr$(65 + i) & ":")
      If (iDriveType = 2) Then
        Exit For
      End If
    End If

  Next
  
  GetDriveFromMask = Chr$(i + 65)
End Function

Function LoWord(Dword As Long) As Integer
  If Dword And &H8000& Then
    LoWord = &H8000 Or (Dword And &H7FFF&)
  Else
    LoWord = Dword And &HFFFF&
  End If
End Function