ESN Pendrive

[Fabricio]

el frm tiene un listbox y dos botones detectar y extraer
el problema surge cuando inserto dos pendrives en ocasiones no muestra los datos en forma correcta o sea el ESN no coincide con la letra y el volumen
codigo del frm

NO LEAN ESTE CODGIGO LEAN EL SEGUNDO

Código [Seleccionar] Expandir



Option Explicit

Dim matriz_Volume(1 To 26, 1 To 26) As String
Dim matriz_ESN(1 To 26) As String


Private Sub cmdExtraer_Click()

If lst1.ListIndex > -1 Then

    EjectDevice (lst1.List(lst1.ListIndex))
    lst1.RemoveItem (lst1.ListIndex)
    lst1.Refresh
Else
    MsgBox "No hay dispositivos USB instalados"
End If


End Sub

Private Sub cmdDetectar_Click()

Call Dame_Unidad_USB
Call Numero_de_Serie
Call Mostrar

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
With GetObject("WinMgmts:")

    For Each Disco In .InstancesOf("Win32_DiskDrive") ' 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)     'resultado2 = Left(resultado, largo_Res - contador2)
                    matriz_ESN(k) = ESN
                    k = k + 1
                    'lst1.AddItem ESN
                    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_Unidad_USB()

    Dim NumDisco As Integer
    Dim StrDisco As String
    Dim ret As Long
    Dim letra_Unidad As String
    Dim numero_Volume As Long
    Dim bandera As Boolean
    'Dim matriz_Volume(0 To 25, 0 To 25) As String
    Dim i As Integer
   
       
    lst1.Clear
   
    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
            numero_Volume = GetVolumeNumber(StrDisco)    'obtengo el numero de volumen         'lESNUnidad = GetVolumeNumber(StrDisco)
            matriz_Volume(i, 1) = letra_Unidad
            matriz_Volume(i, 2) = Hex(numero_Volume)
            i = i + 1
            'MsgBox matriz_Volume(1, 1) & matriz_Volume(1, 2)
            'lst1.AddItem matriz_Volume(i, 1) & matriz_Volume(i, 2) & matriz_Volume(i, 3)
            'lst1.AddItem letra_Unidad & " " & Hex(numero_Volume)
           
            bandera = 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"
    End If


End Sub

Public Sub Mostrar()
Dim i As Integer
For i = 1 To 26
    lst1.AddItem matriz_Volume(i, 1) & " " & matriz_ESN(i) & " " & matriz_Volume(i, 2)
Next
End Sub


Function GetVolumeNumber(strDrive As String) As Long ' obtengo el numero de volumen de la letra q le paso

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))
GetVolumeNumber = SerialNum


End Function



codigo del modulo

Código [Seleccionar] Expandir


Option Explicit

Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
"GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal _
lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize 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




EDIT:poner titulos descriptivos a los post !!!

[Fabricio]

LEER ESTE GRACIAS

este esta un poco mas prolijo

en el formulario

Código [Seleccionar] Expandir


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
        lst1.AddItem matriz_Volume(i, 1) & " " & matriz_ESN(i) & " " & matriz_Volume(i, 3)
    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




en el modulo

Código [Seleccionar] Expandir


Option Explicit

Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
"GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal _
lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize 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





[Karcrack]

Antes que nada, para vaciar un Array no necesitas recorrer todos sus valores, simplemente con:

Código (vb) [Seleccionar] Expandir

Redim matriz(0)
sobra...

Y bueno, la verdad es que te recomiendo trabajar envez de con matrices de 2 dimensiones trabajar con una matriz de un Type... me explico:

Código (vb) [Seleccionar] Expandir

Private Type t_USB
    Letra_Unidad    As String
    Nombre_Volume   As String
    numero_Volume   As String
End Type

Dim Matriz_USB()    As t_USB

De todas formas no acabo de entender donde esta el problema.... que es lo que pasa? que si hay mas de dos USB no los reconoce?

Saludos

[Fabricio]

Hola a todos tengo un problema  el problema es el siguiente tengo que obtener el ESN (numero de serie electronico dado por el fabricante) de todos los  pen drive conectados el codigo que deje funciona solo si se conecta un solo pen.... si se conectan dos te da los datos cambiados(o sea la letra del pen 1 no corresponde con su esn sino con el esn del otro pen) ej F: esn 23
                             G: esn 65
pero el 23 es el esn de G y el 65 el de F

me podes ayudar ya que no se como corregir este error
o sabes de otra forma de obtener estos datos

[Dessa]

Hola Fabricio, para mí tenes que vaciar las dos matrices  (Matriz_Volume y matriz_ESN) antes de cmdDetectar_Click(), de esta manera "refrescas" y volves a detectar todos los cambios desde cero.

PD: A mí me funciona bien de esta manera, (hasta puse el code del button cmdDetectar en un timer para que se actualize automaticamente).

Saludos

[Fabricio]

Hola "Dessa" por lo que me decis me parece que el problema esta en mi PC vos probaste anotar los datos de cada pen por separado y luego poner los dos a la ves y correr el programa???????
Depure el codigo paso a paso y en la rutina obtener ESN mi pc el primer pen que detecta en

Código [Seleccionar] Expandir



With GetObject("WinMgmts:")
        For Each Disco In .InstancesOf("Win32_DiskDrive")

es el pen al que windows le asigna la letra G (en tu pc puede ser otra obvio)
mientras mi pc detecte primero este pen el codigo nunca va a funcionar por que la primer letra que se genera y se guarda en la matriz es la F (esta letra es la que se le asigna al otro pen)
tambien te cuento que lo probe en otra pc y el resultado fue el mismo
espero aber sido claro
un gran saludo