Autor
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:
'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
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:
'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 "CONECCIÓN" + vbTab + Mid(ControlUnidadesUSB1, i, 1) + vbTab & Time
Next i
ControlUnidadesUSB2 = UnidadesUSB
Else
If ControlUnidadesUSB2 = "$" Then
Me.Print "CONECCIÓ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
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 "CONECCIÓN" + vbTab + Mid(ControlUnidadesUSB1, i, 1) + vbTab & Time
Next i
ControlUnidadesUSB2 = UnidadesUSB
Else
If ControlUnidadesUSB2 = "$" Then
Me.Print "CONECCIÓ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
En línea
