Título: ESN Pendrive
Publicado por: Fabricio en 11 Marzo 2009, 17:07 pm
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
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 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 !!!
Título: Re: Help!!!
Publicado por: Fabricio en 11 Marzo 2009, 18:10 pm
LEER ESTE GRACIAS este esta un poco mas prolijo en el formulario 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 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
Título: Re: Help!!!
Publicado por: Karcrack en 11 Marzo 2009, 19:33 pm
Antes que nada, para vaciar un Array no necesitas recorrer todos sus valores, simplemente con: 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: 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 ;)
Título: Re: Help!!!
Publicado por: Fabricio en 23 Marzo 2009, 21:35 pm
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
Título: Re: Help!!!
Publicado por: Dessa en 24 Marzo 2009, 03:18 am
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
Título: esn
Publicado por: Fabricio en 26 Marzo 2009, 13:18 pm
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
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
|