Detectar USB, Pendrives

[SKL (orignal)]

ahhh re bien che, en mi pagina no se descarga??? y lo ponen en megaupload que tenes que hacer un SISTEMA OPERATIVO para poder bajar esas cosas!!!!!

dios mioooooooo, fijate que anda bien y sino anda a OTROS CODIGOS que esta mas atras repetido, fijate qeu tiene mas de 1 descarga, solo a vos te tira error, proba en distintos Browsers


sl2

Eso es verdad  .
Es tu pagina? no lo sabia por cierto muy buena .

sisis es mi web, y por lo que veo funciona bien, solo a el no le funciona :S

[Kizar]

Esta interesante el code, pero yo le he mejorado considerablemente
http://msdn.microsoft.com/en-us/library/aa363480.aspx

[Kizar]

Lo acabo de hacer por aburrimiento, a partir de aquí es fácil hacer un pequeño virus...
Cuando se conecta un dispositivo se llama a la función USBConected y esta te devuelve la letra de el ultimo pendrive conectado.

Formulario:

Código [Seleccionar] Expandir


Private Sub Form_Load()
    HookForm Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookForm Me.hwnd
End Sub


Modulo (bas):

Código [Seleccionar] Expandir


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

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 DRIVE_REMOVABLE As Integer = 2
Dim PrevProc As Long

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 And wParam = DBT_DEVICEARRIVAL Then
        MsgBox USBConected
    End If
End Function

Public Function USBConected() As String
    Dim hVolume As Long, i As Integer
    hVolume = GetLogicalDrives()
    For i = 0 To 25
        If (hVolume And 2 ^ i) <> 0 And GetDriveType(Chr(i + 65) & ":") = DRIVE_REMOVABLE Then
            USBConected = Chr(i + 65) & ":"
        End If
    Next
End Function


[cobein]

Algunas cosas con respecto a este code.

Primero la manera correcta de hacerlo seria copiar la estructura que pasa lParam para ver que tipo de dispositivo es etc.

Segundo, este code se dispara de manera herrada por ejemplo al montar un volumen.

La funcion de "escaneo" de drives tendria que iniciarce y luego al reescanear hacer una comparacion, de la manera en que esta hecho ahora simplemente va a reportar la primer unidad que sea removible (DRIVE_REMOVABLE).

Y por ultimo, esa funcion no es correcta puesto que hay memorias y/o discos que no son reconocidos como DRIVE_REMOVABLE, para identificarlos tendrias que ver que el tipo de bus sea BusTypeUsb

[abel_c_b]

sisis es mi web, y por lo que veo funciona bien, solo a el no le funciona :S
[/quote]


No funciona, no se que sucede pero no funciona, deberian revisar que pasa con IE6 ya que creo que ese el problema, 

[SKL (orignal)]

osea... el problema es IE6, cosa que muy pocos lo usan, la mayoria usa FIREFOX o IE7... hay que actualizarse.. debes en cuando

y si, el code esta armado asi nomas, pero tiene todo lo que necesita para detectar un pen.

[Kizar]

Primero la manera correcta de hacerlo seria copiar la estructura que pasa lParam para ver que tipo de dispositivo es etc.

Si, eso seria lo correcto, esta tarde si tengo tiempo lo cambio.

Segundo, este code se dispara de manera herrada por ejemplo al montar un volumen.

Si cambio lo anterior esto no pasa.

La funcion de "escaneo" de drives tendria que iniciarce y luego al reescanear hacer una comparacion, de la manera en que esta hecho ahora simplemente va a reportar la primer unidad que sea removible (DRIVE_REMOVABLE).

Tal y como esta ahora te muestra el ultimo pendrive conectado. Windows asigna letras en orden alfabetico a los nuevos dispositivos, pro lo tanto si encuentro dos pendrives uno llamado H: y otro I:
USBConected valdrá primero H:
Después USBConected valdra I:
Y después saldrá del for y devolverá el valor I:
Esto seria lo normal que ocurriese, ya se que puede que desconectes primero el H: y  a la proxima vez el proximo dispositivo sea H: pero esto pasa pocas veces...Se puede solucionar con una pequeña matriz pero así queda mas elegante xD

Y por ultimo, esa funcion no es correcta puesto que hay memorias y/o discos que no son reconocidos como DRIVE_REMOVABLE, para identificarlos tendrias que ver que el tipo de bus sea BusTypeUsb

A mi nunca me paso eso, siempre con DRIVE_REMOVABLE me ha devuelto bien las unidades Flash.

[cobein]

@Kizar

Una sola cosita, lo demas esta claro, el tema de DRIVE_REMOVABLE, hay unidades Flash, jump, pen o como le quieras llamar que son reconocidas como DRIVE_FIXED, lo digo por experiencia propia, no es nada que se me ocurrio a mi. Ademas de eso tenes los HDD portatiles son del tipo DRIVE_FIXED y que soportan un autorun.inf lo digo por el tema de la infeccion que comentaste.

Si podes modificar el code y compartirlo sera interesante, no hay ninguno "bien" hecho por ahi.

[Kizar]

Lo de detectarlos por el tipo de Bus te lo dejo a ti que yo no tengo mucho tiempo hoy.

Formulario:

Código [Seleccionar] Expandir


Private Sub Form_Load()
    LocalDrives
    HookForm Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookForm Me.hwnd
End Sub


Modulo:

Código [Seleccionar] Expandir

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
                'Mostramos la letra de la ultima unidad de almacenamiento conectada
                MsgBox USBConected
            End If
        ElseIf wParam = DBT_DEVICEREMOVECOMPLETE Then
            'Si se desconecta alguno volvemos ha hacer toda la lista.
            LocalDrives
        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 LocalDrives()
    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

[Molasar]

Gracias Kizar, fuciona muy bien.

En cuanto a la observación de Cobein de detectar el tipo de bus, tiene razón, ya que así como está, "salta" igual al "crear" una unidad con SUBST o al montar una unidad con Truecrypt.