Detectar Unidades USB (Pendrive) (SRC)

[Hasseds]

Hay varios codes que hacen lo mismo, pero todos los que encontré usan Hook (me resisto a usarlos)
Solo un Timer1 en el Form

NOTA 1: en el momento que el If del timer1 devuelve el string con la letra de la unidad  detectada ya se puede "operar"

NOTA 2: este code no incluye a los disquetes, ya que el for de la Function UnidadesUSB empiza desde 2 hasta 25 (cero y uno corresponden tambien a unidades extribles pero el sistema los reserva para las disqueteras)

Código [Seleccionar] Expandir


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Option Explicit ' Hassed (http://foro.elhacker.net/programacion_vb-b50.0/)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim ControlUnidadesUSB1 As String: Dim ControlUnidadesUSB2 As String

Private Sub Form_Load()
 Timer1.Interval = 50: Me.AutoRedraw = True: Me.FontBold = True
End Sub

Private Function UnidadesUSB() As String
 Dim DiscosLogicos As Long: DiscosLogicos = GetLogicalDrives: Dim i As Long
 For i = 2 To 25
   If (DiscosLogicos And 2 ^ i) <> 0 Then
     If GetDriveType(Chr$(65 + i) + ":") = 2 Then
       UnidadesUSB = UnidadesUSB + Chr$(65 + i)
     End If
   End If
 Next i
End Function

Private Sub Timer1_Timer()
 ControlUnidadesUSB1 = UnidadesUSB
 If ControlUnidadesUSB1 <> ControlUnidadesUSB2 Then
   If Len(ControlUnidadesUSB1) > Len(ControlUnidadesUSB2) Then
     Dim i As Integer
     For i = 1 To Len(ControlUnidadesUSB1)
       If InStr(ControlUnidadesUSB2, Mid(ControlUnidadesUSB1, i, 1)) = 0 Then Me.Print Mid(ControlUnidadesUSB1, i, 1) + vbTab & Time
     Next i
   End If
   ControlUnidadesUSB2 = UnidadesUSB
 End If
End Sub




NOTA 3: el mismo code pero un poco mas completo

Código [Seleccionar] Expandir


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Option Explicit ' Hassed (http://foro.elhacker.net/programacion_vb-b50.0/)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim ControlUnidadesUSB1 As String: Dim ControlUnidadesUSB2 As String

Private Sub Form_Load()
 If App.PrevInstance = True Then End
 ControlUnidadesUSB2 = "$"
 Me.AutoRedraw = True
 Me.FontBold = True
 Timer1.Interval = 50
End Sub
Private Function UnidadesUSB() As String
 Dim LDs As Long:  LDs = GetLogicalDrives
 Dim Cnt As Long: Dim sDrives As String
 For Cnt = 2 To 25
   If (LDs And 2 ^ Cnt) <> 0 Then
     If GetDriveType(Chr$(65 + Cnt) + ":") = 2 Then
       sDrives = sDrives + Chr$(65 + Cnt)
     End If
   End If
 Next Cnt
 UnidadesUSB = Replace(Replace(sDrives, " ", ""), ":", "")
End Function

Private Sub Timer1_Timer()
 If UnidadesUSB <> "" Then Me.Caption = "Unidades USB: " + UnidadesUSB
 If UnidadesUSB = "" Then Me.Caption = "No hay Unidades USB conectadas"
 ControlUnidadesUSB1 = UnidadesUSB
 If ControlUnidadesUSB1 <> ControlUnidadesUSB2 Then
     Dim i As Integer
     If Len(ControlUnidadesUSB1) > 0 Then
         If Len(ControlUnidadesUSB1) > Len(ControlUnidadesUSB2) Then
             For i = 1 To Len(ControlUnidadesUSB1)
                 If InStr(ControlUnidadesUSB2, Mid(ControlUnidadesUSB1, i, 1)) = 0 Then Me.Print "conexión" + vbTab + Mid(ControlUnidadesUSB1, i, 1) + vbTab & Time
             Next i
             ControlUnidadesUSB2 = UnidadesUSB
         Else
             If ControlUnidadesUSB2 = "$" Then
                 Me.Print "conexión" + vbTab + UnidadesUSB + vbTab & Time
                 ControlUnidadesUSB2 = UnidadesUSB
             Else
                 For i = 1 To Len(ControlUnidadesUSB2)
                     If InStr(ControlUnidadesUSB1, Mid(ControlUnidadesUSB2, i, 1)) = 0 Then Me.Print "EXPULCIÓN" + vbTab + Mid(ControlUnidadesUSB2, i, 1) + vbTab & Time
                 Next i
                 ControlUnidadesUSB2 = UnidadesUSB
             End If
         End If
     Else
         If Len(ControlUnidadesUSB1) < Len(ControlUnidadesUSB2) And ControlUnidadesUSB2 <> "$" Then
             Me.Print "EXPULCIÓN" + vbTab + ControlUnidadesUSB2 + vbTab & Time
             ControlUnidadesUSB2 = "$"
         Else
             Me.Print "SIN  DATOS" + vbTab + "···" + vbTab & Time
             ControlUnidadesUSB2 = UnidadesUSB
         End If
     End If
 End If
End Sub




NOTA 4: Saludos

[Angeldj27]

Bueno pero se supone que kieres ahorrar recursos y en eso los Hook hacen un buen trabajo.

Saludos

[Hasseds]

Hay varios codes que hacen lo mismo, pero todos los que encontré usan Hook (me resisto a usarlos)

Bueno pero se supone que kieres ahorrar recursos y en eso los Hook hacen un buen trabajo.

Saludos

Tal vez me expresé mal Angeldj27, me resisto a meter un  Hook para algo tan simple como obtener un string con la letra de una unidad.

Saludos

[XcryptOR]

ademas de minimizar consumo de recursos, es la mejor forma de hacerlo, el sistema windows es un sistema basado en mensajes y un timer la verdad si no lo manejas adecuadamente se como al procesador

[Hasseds]

ademas de minimizar consumo de recursos, es la mejor forma de hacerlo, el sistema windows es un sistema basado en mensajes y un timer la verdad si no lo manejas adecuadamente se como al procesador

No en este caso, XcryptOR , el código del Timer solo se ejecuta cuando se conecta un pen y el consumo del cpu está clavado en cero, chequealo  comparando la dos maneras.

Saludos.