Detectar Unidades USB (Pendrive) (SRC)

Iniciado por Hasseds, 20 Abril 2009, 23:11 PM

0 Miembros y 1 Visitante están viendo este tema.

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)


'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




'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

Sergio Desanti

Angeldj27

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

Saludos


"Que vamos a hacer Mañana?..... Lo mismo que hacemos todos los dias Pinky tratar de Conquistar el Mundoooo!!!!!

Hasseds

#2
Cita de: Hassed  link=topic=252527.msg1220588#msg1220588 date=1240261909
Hay varios codes que hacen lo mismo, pero todos los que encontré usan Hook (me resisto a usarlos)

Cita de: Angeldj27 en 20 Abril 2009, 23:59 PM
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


Sergio Desanti

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

#4
Cita de: XcryptOR en 21 Abril 2009, 19:52 PM
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.
Sergio Desanti