Páginas: [1]
|
 |
|
Autor
|
Tema: (Source) Detectar unidades extraibles USB (Leído 468 veces)
|
Kizar
Desconectado
Mensajes: 1.313
kizar_net
|
Formulario: 'Programado por Kizar Private Sub Form_Load() AllLocalDrives HookForm Me.hwnd End Sub
Private Sub Form_Unload(Cancel As Integer) UnHookForm Me.hwnd End Sub
Modulo: 'Programado por Kizar 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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetLogicalDrives Lib "kernel32" () As Long Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Type DEV_BROADCAST_HDR dbch_size As Long dbch_devicetype As Long dbch_reserved As Long End Type
Public Const GWL_WNDPROC = -4 Public Const WM_DEVICECHANGE As Long = 537 'Cambios en un dispositivo Public Const DBT_DEVICEARRIVAL As Long = 32768 'Cuando se conecta uno nuevo Public Const DBT_DEVICEREMOVECOMPLETE As Long = 32772 'Cuando se desconecta uno Public Const DBT_DEVTYP_VOLUME As Integer = 2 'Logical volume, cualquier unidad de almacenamiento nueva.
Dim PrevProc As Long Dim lArray() As String
Public Sub HookForm(hwnd As Long) PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub
Public Sub UnHookForm(hwnd As Long) SetWindowLong hwnd, GWL_WNDPROC, PrevProc End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam) If uMsg = WM_DEVICECHANGE Then If wParam = DBT_DEVICEARRIVAL Then Dim dev As DEV_BROADCAST_HDR CopyMemory dev, ByVal lParam, 12 If dev.dbch_devicetype = DBT_DEVTYP_VOLUME Then MsgBox USBConected End If ElseIf wParam = DBT_DEVICEREMOVECOMPLETE Then AllLocalDrives End If End If End Function
Public Function USBConected() As String Dim hVolume As Long, i As Integer, b As Integer, find As Boolean hVolume = GetLogicalDrives() For i = 0 To 25 If (hVolume And 2 ^ i) <> 0 Then For b = 0 To UBound(lArray) If lArray(b) = Chr(i + 65) Then find = True: Exit For Next b If find = False Then ReDim Preserve lArray(UBound(lArray) + 1) lArray(UBound(lArray)) = Chr(i + 65) USBConected = Chr(i + 65) & ":" Exit Function End If End If find = False Next i End Function
Public Sub AllLocalDrives() Dim hVolume As Long, count As Integer, i As Integer Erase lArray count = 0 hVolume = GetLogicalDrives() For i = 0 To 25 If (hVolume And 2 ^ i) <> 0 Then ReDim Preserve lArray(count) lArray(count) = Chr(i + 65) count = count + 1 End If Next i End Sub
|
|
|
|
« Última modificación: 31 Mayo 2008, 22:04 por Kizar »
|
En línea
|
|
|
|
|
seba123neo
|
muy bien,pero yo estoy borracho o ya hubo un post de esto... 
|
|
|
|
|
En línea
|
Todos somos ignorantes;lo que pasa es que no todos ignoramos las mismas cosas - Albert Einstein
|
|
|
Kizar
Desconectado
Mensajes: 1.313
kizar_net
|
Alguien lo pidio en otro post, pues ya que lo he hecho y lo e limpiado lo publico de nuevo.
|
|
|
|
|
En línea
|
|
|
|
Ar1es
Desconectado
Mensajes: 7
|
Gracias por el aporte estaba buscando esto, gracias denuevo.
|
|
|
|
|
En línea
|
|
|
|
El Riper
Desconectado
Mensajes: 57
|
se agradese el aporte... (pense lo mismo que seba123neo pero despues lei mas abajo y entendi) 
|
|
|
|
|
En línea
|
|
|
|
|
Páginas: [1]
|
|
|
|