Option Explicit
Dim detectado As Boolean
Dim matriz_Volume(1 To 26, 1 To 3) As String
Dim matriz_ESN(1 To 26) As String
Dim numero_Volume As Long
Dim nombre_Volume As String
Private Sub cmdExtraer_Click()
If lblUnidad.Caption <> "" Then
EjectDevice (lblUnidad.Caption)
lblUnidad.Caption = ""
lblESN.Caption = ""
lblNombVol.Caption = ""
lblNumVol.Caption = ""
Else
MsgBox "No hay dispositivos USB instalados"
End If
End Sub
Private Sub cmdDetectar_Click()
Call Dame_Letra_USB
If detectado = True Then
Call Numero_de_Serie
Call Mostrar
Else
Matriz_volume_en_cero
Matriz_esn_en_cero
End If
End Sub
Public Sub Numero_de_Serie()
Dim Disco As Object
Dim cadena As String
Dim largo As Integer
Dim contador As Integer
Dim i As Integer
Dim posicion As Integer
Dim resultado As String
Dim largo_Res As Integer
Dim contador2 As Integer
Dim j As Integer
Dim posicion2 As Integer
Dim ESN As String
Dim k As Integer
k = 1
'Matriz_esn_en_cero
With GetObject("WinMgmts:")
For Each Disco In .InstancesOf("Win32_DiskDrive") ' ej 3 objetos 2 usb + ide
If Disco.InterfaceType = "USB" Then ' detecto si son usb
cadena = Disco.PNPDeviceID 'tiene embebido el ESN
largo = Len(cadena)
contador = 0
For i = largo To 1 Step -1
posicion = InStr(i, cadena, "")
contador = contador + 1
If posicion > 0 Then
resultado = Right(cadena, contador - 1)
Exit For
End If
Next
largo_Res = Len(resultado)
contador2 = 0
For j = largo_Res To 1 Step -1
posicion2 = InStr(j, resultado, "&")
contador2 = contador2 + 1
If posicion2 > 0 Then
ESN = Left(resultado, largo_Res - contador2)
matriz_ESN(k) = ESN
k = k + 1
Exit For
End If
Next
End If ' cierra el primer if el q detecta usb
Next ' cierra el for q recorre los objetos
End With
End Sub
Public Sub Dame_Letra_USB()
Dim NumDisco As Integer
Dim StrDisco As String
Dim ret As Long
Dim letra_Unidad As String
Dim bandera As Boolean
Dim i As Integer
bandera = False
i = 1
For NumDisco = 0 To 25
StrDisco = Chr(NumDisco + 65) & ":" 'convierte a char c/numero del bucle esta es la letra a verificar
If NumDisco = 0 Then
ret = GetDriveType(StrDisco)
ElseIf NumDisco > 0 And GetDriveType(StrDisco) = 2 Then ' si pasa x este if se detecto un USB
ret = 7
letra_Unidad = StrDisco
GetVolumeNumber (StrDisco)
matriz_Volume(i, 1) = letra_Unidad
matriz_Volume(i, 2) = nombre_Volume
matriz_Volume(i, 3) = Hex(numero_Volume)
i = i + 1
bandera = True
detectado = True
ElseIf NumDisco > 0 And GetDriveType(StrDisco) <> 2 Then
ret = GetDriveType(StrDisco)
End If
Next
If bandera = False Then
MsgBox "No hay dispositivos USB instalados"
detectado = False
End If
End Sub
Sub GetVolumeNumber(strDrive As String)
Dim SerialNum As Long
Dim res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
res = GetVolumeInformation(strDrive, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
nombre_Volume = Temp1
numero_Volume = SerialNum
End Sub
Public Sub Mostrar()
Dim i As Integer
For i = 1 To 26
If matriz_ESN(i) <> "" Then
If matriz_ESN(i) = "000000000000E6" Then
lst1.AddItem matriz_Volume(i, 1) & " " & matriz_ESN(i) & " " & matriz_Volume(i, 2) & " " & matriz_Volume(i, 3)
lblUnidad.Caption = matriz_Volume(i, 1)
lblESN.Caption = matriz_ESN(i)
lblNombVol.Caption = matriz_Volume(i, 2)
lblNumVol.Caption = matriz_Volume(i, 3)
fraMda.Visible = True
End If
End If
Next
End Sub
Sub Matriz_volume_en_cero()
Dim i As Integer
For i = 1 To 26
matriz_Volume(i, 1) = ""
matriz_Volume(i, 2) = ""
matriz_Volume(i, 3) = ""
Next
End Sub
Sub Matriz_esn_en_cero()
Dim i As Integer
For i = 1 To 26
matriz_ESN(i) = ""
Next
End Sub
Private Sub Form_Load()
lblUnidad.Caption = ""
lblESN.Caption = ""
lblNombVol.Caption = ""
lblNumVol.Caption = ""
End Sub
