 Autor
|
Tema: Detectar USB, Pendrives (Leído 10,478 veces)
|
SKL (orignal)
 Desconectado
Mensajes: 259
UpLoadSourceCode
|
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
|
|
|
|
|
En línea
|
|
|
|
|
|
Kizar
Desconectado
Mensajes: 1.325
kizar_net
|
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: Private Sub Form_Load()
HookForm Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHookForm Me.hwnd
End Sub
Modulo (bas): 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
|
|
|
|
|
En línea
|
|
|
|
|
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
|
|
|
|
|
En línea
|
|
|
|
abel_c_b
Desconectado
Mensajes: 91
|
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, 
|
|
|
|
|
En línea
|
|
|
|
SKL (orignal)
Desconectado
Mensajes: 259
UpLoadSourceCode
|
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.
|
|
|
|
|
En línea
|
|
|
|
Kizar
Desconectado
Mensajes: 1.325
kizar_net
|
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.
|
|
|
|
|
En línea
|
|
|
|
|
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.
|
|
|
|
|
En línea
|
|
|
|
Kizar
Desconectado
Mensajes: 1.325
kizar_net
|
Lo de detectarlos por el tipo de Bus te lo dejo a ti que yo no tengo mucho tiempo hoy. Formulario: Private Sub Form_Load()
LocalDrives
HookForm Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHookForm Me.hwnd
End Sub
Modulo: 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 |
|
|
|
|
En línea
|
|
|
|
Molasar
Desconectado
Mensajes: 29
|
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.
|
|
|
|
|
En línea
|
|
|
|
|
| Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Reparar los pendrives de 128gb truchos
« 1 2 »
Hardware
|
TDKMAS
|
12
|
16,866
|
10 Febrero 2011, 00:58 am
por Aprendiz-Oscuro
|
|
|
|
Ejército de EE.UU. responde a Wikileaks: ¡no más pendrives!
Noticias
|
Novlucker
|
2
|
1,959
|
13 Diciembre 2010, 13:51 pm
por -- KiLiaN --
|
|
|
cambiar flash ics de pendrives
Electrónica
|
z_ane_666
|
0
|
3,517
|
4 Febrero 2011, 03:42 am
por z_ane_666
|
|
|
No me lee mis pendrives :S
« 1 2 3 4 »
Windows
|
$Edu$
|
34
|
20,440
|
12 Septiembre 2011, 06:42 am
por Randomize
|
|
|
|
Pendrives bloqueados en XP?
« 1 2 »
Windows
|
Legion_R1ver
|
11
|
8,435
|
5 Julio 2012, 14:49 pm
por dato000
|
 |
