Option Explicit

'Function: FlashSerials
'Autor   : Sergio Desanti (Hasseds)
'Thank   : Seba , Cobein, A.Desanti
'Test    : XP (32 BIT) - W7 (32 BIT)
'Return  : Serial(ESN) de Pen-Drives conectados
'

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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 SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const WM_DEVICECHANGE As Long = 537              'Cambios en un dispositivo
Private Const DBT_DEVICEARRIVAL As Long = 32768          'Cuando se conecta uno nuevo
Private Const DBT_DEVICEREMOVECOMPLETE As Long = 32772   'Cuando se desconecta uno
Private Const DBT_DEVTYP_VOLUME As Integer = 2           'Logical volume, cualquier unidad de almacenamiento nueva.

Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByRef ClassGuid As GUID, ByVal Enumerator As Long, ByVal hwndParent As Long, ByVal flags As Long) As Long
Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long
Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, DeviceInterfaceDetailData As Any, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, DeviceInfoData As Any) As Long
Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
 
Private Type GUID
   Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(7) As Byte
End Type
 
Private Type SP_DEVICE_INTERFACE_DATA
   cbSize As Long: InterfaceClassGuid As GUID: flags As Long: Reserved As Long
End Type

Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
   cbSize As Long: strDevicePath As String * 260
End Type

Dim hHook As Long

Public Sub StartHook(hWnd As Long)
    hHook = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub StopHook(hWnd As Long)
    SetWindowLong hWnd, GWL_WNDPROC, hHook
    hHook = 0
End Sub

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(hHook, hWnd, uMsg, wParam, lParam)
    If uMsg = WM_DEVICECHANGE Then
      If wParam = DBT_DEVICEARRIVAL Then
        Form1.Cls
        Form1.Print "Conectaron", Time
        Form1.Print
        Form1.Print FlashSerials
      ElseIf wParam = DBT_DEVICEREMOVECOMPLETE Then
        Form1.Cls
        Form1.Print "Desconectaron", Time
        Form1.Print
        Form1.Print FlashSerials
      End If
    End If
End Function
 
Public Function FlashSerials() As String
 
   Dim TGUID As GUID
 
   Call IIDFromString(StrPtr("{a5dcbf10-6530-11d2-901f-00c04fb951ed}"), TGUID)
 
   Dim hDev As Long
   hDev = SetupDiGetClassDevs(TGUID, &H0, &H0, &H12)
   If hDev = -1 Then Exit Function
 
   Dim lCount       As Long
   Dim lSize        As Long
   Dim DTL          As SP_DEVICE_INTERFACE_DETAIL_DATA
   Dim DTA          As SP_DEVICE_INTERFACE_DATA
 
   DTA.cbSize = Len(DTA)
   DTL.cbSize = &H5
 
   While Not (SetupDiEnumDeviceInterfaces(hDev, &H0, TGUID, lCount, DTA) = &H0)
     Call SetupDiGetDeviceInterfaceDetail(hDev, DTA, ByVal &H0, &H0, lSize, ByVal &H0)
     Call SetupDiGetDeviceInterfaceDetail(hDev, DTA, DTL, ByVal lSize, &H0, ByVal &H0)
     If UBound(Split(DTL.strDevicePath, "#")) > 1 Then
       FlashSerials = FlashSerials & Split(UCase$(DTL.strDevicePath), "#")(2) & Chr$(&HD)
     End If
     lCount = lCount + 1
   Wend
 
   Call SetupDiDestroyDeviceInfoList(hDev)
   
   If FlashSerials = "" Then FlashSerials = "No hay conexiones"
   
End Function

Option Explicit

Private Sub Form_Load()
 AutoRedraw = True
 Print FlashSerials
 Call SetWindowPos(Form1.hWnd, &HFFFF, &H0, &H0, &H0, &H0, &H3) 'form on top
 Call StartHook(hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Call StopHook(hWnd)
End Sub

   If Not GetPixel(lDC, lParam.x, lParam.y) = &HAA431B Then
       Form1.Caption = ""
   Else
       Form1.Caption = "AA431B " & lParam.x & " " & lParam.y
       StopHook
       Exit Function 'si hace falta 
   End If