Título: Serial y Unidad de Pen Drive
Publicado por: Dessa en 9 Abril 2009, 12:59 pm
No encuentro una propiedad comun entre Win32_LogicalDisk y Win32_DiskDrive para relacionar directamente la letra de un pen con su serial
Gracias y saludos
Título: Re: Serial y Unidad de Pen Drive
Publicado por: seba123neo en 10 Abril 2009, 00:00 am
Hola, yo probe con 2...uno es F y el otro H...el de unidad lo tira con order como dijiste...y el otro tambien.. :P...probe primero uno despues el otro y al reves y siempre me lo mostro igual...
saludos.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 10 Abril 2009, 00:59 am
Hola, yo probe con 2...uno es F y el otro H...el de unidad lo tira con order como dijiste...y el otro tambien.. :P...probe primero uno despues el otro y al reves y siempre me lo mostro igual...
saludos.
Sí, Seba, en algunos casos el orden de las unidades (Win32_LogicalDisk) y el orden de los seriales (Win32_DiskDrive) coinciden, yo probé en tres cpu distintas y solo en una coincidía (no llego a entender como windows maneja este tema). Por eso la pregunta sería hay alguna manera de conocer las letras de las unidades con Win32_DiskDrive ??? Gracias y saludos
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Fabricio en 13 Abril 2009, 21:28 pm
Hola a todos por lo que probe este error ocurre en algunos casos y en otros no yo probe con dos pen iguales y me doy lo s datos cambiados luego probe con otros dos pen y me dio los datos en forma correcta todo en la misma pc :huh: la verdad no entiendo que ocurre y por que algunas veces funciona y otras no
saludos :D
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 14 Abril 2009, 17:19 pm
Hola fabricio, no es un error, son dos funciones distintas que no se rigen por el mismo orden, el code wmi al que me refiero en la pregunta original es simple, pero lamentablemente no siempre retorna el serial de fábrica y las letras de sus unidades en el orden que corresponde.
Saludos
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Hasseds en 21 Abril 2009, 20:53 pm
Fabricio, te mando el code por MP.
Saludos, espero que te sirva.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Fabricio en 21 Abril 2009, 22:59 pm
Muchisimas gracias ;-) un gran saludo
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 7 Julio 2009, 21:03 pm
No encuentro una propiedad comun entre Win32_LogicalDisk y Win32_DiskDrive para relacionar directamente la letra de un pen con su serial
Retomé el tema hace unos dias y por fin pude encontrar la forma de relacionar directamente la unidad lógica de un Pendrive con con su serial (Win32_DiskDrive-PNPDeviceID), no es por intermedio de Win32_LogicalDisk sino por intermedio de Win32_LogicalDiskToPartition, esta clase me devuelve la letra Lógica (dependent) y el numero de index del disco al que corresponde (Antecedent), lo que queda es solo relacionar este numero de index con el tambien numero de index que devuelve Win32_DiskDrive (Win32_DiskDrive-index ) Y (Win32_DiskDrive-PNPDeviceID). Paso el code para el que le pueda servir Private Function UsbSerial() As String
Dim disco1 As Object: Dim Objeto1 As Object ' Detecta seriales de Pendrive, MP3, Etc Dim disco2 As Object: Dim Objeto2 As Object ' Autor = Dessa Dim sDisco As String: Dim sLetra As String ' http://foro.elhacker.net/programacion_vb-b50.0/
Set Objeto1 = GetObject("winmgmts:").ExecQuery("Select * from Win32_LogicalDiskToPartition") Set Objeto2 = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DiskDrive")
For Each disco1 In Objeto1 sLetra = Mid(disco1.dependent, InStr(1, disco1.dependent, "=") + 2, 2) sDisco = Mid(disco1.Antecedent, InStr(1, disco1.Antecedent, "#") + 1, InStrRev(disco1.Antecedent, ",") - InStr(1, disco1.Antecedent, "#")) For Each disco2 In Objeto2 If disco2.InterfaceType = "USB" Then If disco2.Index = Val(Mid(sDisco, 1, Len(sDisco) - 1)) Then UsbSerial = UsbSerial + sLetra + " " & Mid(disco2.PNPDeviceID, InStrRev(disco2.PNPDeviceID, "\") + 1, InStrRev(disco2.PNPDeviceID, "&") - InStrRev(disco2.PNPDeviceID, "\") - 1) + vbNewLine End If End If Next Next
End Function
PD: Funcinó en XP-SP3 y W7 S2
Título: Re: Serial y Unidad de Pen Drive
Publicado por: cobein en 9 Julio 2009, 03:25 am
Vuelvo a decir esto, creo que ya lo comente varias veces, WMI no es recomendable, no siempre esta disponible, lo que hace el code muy susceptible a fallos.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 9 Julio 2009, 14:58 pm
Ok, cobein, gracias por el aporte, pero cual seria la mejor solución para relacionar los seriales de los Pendrive con sos respectivas unidades ?
Por ejemplo usando APIs en XP se puede enumerar los seriales que se encuentran en HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USBSTOR y a travez del dato del valor ParentIdPrefix de cada serial se puede relacionar con la unidad de cada pendrive conectado que se encuentran en HKEY_LOCAL_MACHINE\SYSTEM\MountedDevices (en el interior del dato Binario de cada unidad montada con Pendrive se encuentra tambien el valor ParentIdPrefix de cada serial, esto permitiria relacionar directamente los seriales con sus respectivas unidades). Pero no hay una manera mas directa ???
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 12 Julio 2009, 00:40 am
Paso para el que le sirva y a modo de concepto el siguiente code para relacionar los seriales de los Pendrive con sus respectivas unidades utilizando APIs, repito que es a modo de concepto y solo para XP (En W7 es mas directo ya que el serial se encuentra en el binario de HKEY_LOCAL_MACHINE\SYSTEM\MountedDevices y no hay nesecidad de enumerar las claves de USBSTOR). PD1: Si hay una manera mejor o mas directa les agradecería si la pueden compartir. PD2: Si alguien tiene claro en que casos WMI puede estar no disponible tambien lo agradecería ya que no encuentro mucho al respecto en la web. (por lo menos en español). FORMULARIO: Option Explicit
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ '@@@ Function Datos by Dessa '@@@ '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Sub Form_DblClick(): Me.Print Datos: End Sub
Private Sub Form_Load() Me.AutoRedraw = True Me.FontBold = True Me.Print Datos End Sub
Private Function Datos() As String
Dim x As Long: Dim i As Long Dim USBSTOR As String: Dim inUSBSTOR() As String Dim Seriales As String: Dim inSeriales() As String Dim Historial As String: Dim inHistorial() As String Dim ingDrives() As String Dim Unidades As String
If CheckRegistryKey(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR") = True Then 'MsgBox EnumRegistryKeys(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR").Count '---------------------------------------------------------------------------------------- If EnumRegistryKeys(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR").Count > 0 Then For i = 1 To EnumRegistryKeys(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR").Count USBSTOR = USBSTOR + EnumRegistryKeys(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR").Item(i) + vbNewLine Next i 'MsgBox USBSTOR Else MsgBox "No hay Unidades de USB registradas" Exit Function End End If '---------------------------------------------------------------------------------------- inUSBSTOR() = Split(USBSTOR, vbNewLine) For x = 0 To UBound(inUSBSTOR) - 1 For i = 1 To EnumRegistryKeys(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR\" + inUSBSTOR(x)).Count Seriales = Seriales + inUSBSTOR(x) + "\" + EnumRegistryKeys(&H80000002, "SYSTEM\CurrentControlSet\Enum\USBSTOR\" + inUSBSTOR(x)).Item(i) + vbNewLine Next i Next x 'MsgBox Seriales '---------------------------------------------------------------------------------------- inSeriales() = Split(Seriales, vbNewLine) Dim valor As String: Dim clave As String: Dim dato As Variant For x = 0 To UBound(inSeriales) - 1 clave = "SYSTEM\CurrentControlSet\Enum\USBSTOR\" + inSeriales(x) valor = "ParentIdPrefix" dato = GetRegistryValue(&H80000002, clave, valor) Historial = Historial + inSeriales(x) + " " + dato + vbNewLine Next x 'MsgBox Historial '---------------------------------------------------------------------------------------- inHistorial() = Split(Historial, vbNewLine) ingDrives() = Split(lDrives, ":") For x = 0 To UBound(ingDrives) - 1 For i = 0 To UBound(inHistorial) - 1 If InStr(1, inHistorial(i), Parent_Id_Prefix(ingDrives(x))) > 1 Then Unidades = Mid(inHistorial(i), InStr(1, inHistorial(i), "\") + 1, Len(inHistorial(i))) Unidades = Mid(Unidades, 1, InStr(1, Unidades, "&") - 1) Datos = Datos + ingDrives(x) + ": " + Unidades + vbNewLine End If Next i Next x 'MsgBox Datos '---------------------------------------------------------------------------------------- Else MsgBox "NO EXISTE USBSTOR, NUNCA SE CONECTARON DISPOSITIVOS USB EN ESTE EQUIPO" End End If
If Datos = "" Then Datos = "NO HAY DISPOSITIVOS USB CONECTADOS"
End Function
Private Function lDrives() As String
Dim LDs As Long: Dim Cnt As Long: Dim sDrives As String
LDs = GetLogicalDrives
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
lDrives = sDrives
End Function
MODULO1 Option Explicit
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'http://binaryworld.net/Main/ApiDetail.aspx?ApiId=32141 '@@@ '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)
Public Const KEY_READ = &H20019 Public Const KEY_ALL_ACCESS = &H3F
Const REG_SZ = 1 Const REG_EXPAND_SZ = 2 Const REG_BINARY = 3 Const REG_DWORD = 4 Const REG_MULTI_SZ = 7 Const ERROR_MORE_DATA = 234
Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _ ByVal ValueName As String, Optional DefaultValue As Variant) As Variant Dim handle As Long Dim resLong As Long Dim resString As String Dim resBinary() As Byte Dim length As Long Dim retVal As Long Dim valueType As Long ' Prepare the default result GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue) ' Open the key, exit if not found. If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function End If ' prepare a 1K receiving resBinary length = 1024 ReDim resBinary(0 To length - 1) As Byte ' read the registry key retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _ length) ' if resBinary was too small, try again If retVal = ERROR_MORE_DATA Then ' enlarge the resBinary, and read the value again ReDim resBinary(0 To length - 1) As Byte retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _ length) End If ' return a value corresponding to the value type Select Case valueType Case REG_DWORD CopyMemory resLong, resBinary(0), 4 GetRegistryValue = resLong Case REG_SZ, REG_EXPAND_SZ ' copy everything but the trailing null char resString = Space$(length - 1) CopyMemory ByVal resString, resBinary(0), length - 1 GetRegistryValue = resString Case REG_BINARY ' resize the result resBinary If length <> UBound(resBinary) + 1 Then ReDim Preserve resBinary(0 To length - 1) As Byte End If GetRegistryValue = resBinary() Case REG_MULTI_SZ ' copy everything but the 2 trailing null chars resString = Space$(length - 2) CopyMemory ByVal resString, resBinary(0), length - 2 GetRegistryValue = resString Case Else RegCloseKey handle Err.Raise 1001, , "Unsupported value type" End Select ' close the registry key RegCloseKey handle End Function
Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) As Collection 'Enumerate registry keys under a given key 'Returns a collection of strings
Dim handle As Long Dim length As Long Dim index As Long Dim subkeyName As String ' initialize the result collection Set EnumRegistryKeys = New Collection ' Open the key, exit if not found If Len(KeyName) Then If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function ' in all case the subsequent functions use hKey hKey = handle End If Do ' this is the max length for a key name length = 260 subkeyName = Space$(length) ' get the N-th key, exit the loop if not found If RegEnumKey(hKey, index, subkeyName, length) Then Exit Do ' add to the result collection subkeyName = Left$(subkeyName, InStr(subkeyName, vbNullChar) - 1) EnumRegistryKeys.Add subkeyName, subkeyName ' prepare to query for next key index = index + 1 Loop ' Close the key, if it was actually opened If handle Then RegCloseKey handle End Function
Function CheckRegistryKey(ByVal hKey As Long, ByVal KeyName As String) As Boolean ' Return True if a Registry key exists Dim handle As Long ' Try to open the key If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) = 0 Then ' The key exists CheckRegistryKey = True ' Close it before exiting RegCloseKey handle End If
End Function
MODULO2 Option Explicit
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ '@@@ Function Parent_Id_Prefix by Dessa '@@@ '@@@ Function LeerIdMontaje by Daniel Aue '@@@ '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long 'Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 'Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Any) As Long
Private Const KEY_QUERY_VALUE As Long = &H1 Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8 Private Const KEY_NOTIFY As Long = &H10 Private Const SYNCHRONIZE As Long = &H100000 Private Const STANDARD_RIGHTS_READ As Long = &H20000 Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) Private Const ERROR_SUCCESS As Long = 0&
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Function Parent_Id_Prefix(ByVal sLetra As String) As String
Dim strBinario As String: Dim DatosBinario() As Byte
If LeerIdMontaje("SYSTEM\MountedDevices", "\DosDevices\" & sLetra + ":", DatosBinario) = False Then Exit Function strBinario = DatosBinario 'MsgBox DatosBinario, , "DatosBinario" If Mid(strBinario, 1, 4) <> "\??\" Then Exit Function strBinario = Replace(Mid(strBinario, 1, InStr(1, strBinario, "{") - 2), "#", "\") 'MsgBox strBinario, , "strBinario" Parent_Id_Prefix = Mid(strBinario, InStrRev(strBinario, "\") + 1, InStrRev(strBinario, "&") - 1 - InStrRev(strBinario, "\")) 'MsgBox Parent_Id_Prefix, , "Parent_Id_Prefix"
End Function
Private Function LeerIdMontaje(ByVal strPath As String, ByVal strValueName As String, btValue() As Byte) As Boolean Dim hKey As Long Dim lngDataLen As Long Dim lngResult As Long Dim regType As Long Dim btDataBuf() As Byte If RegOpenKeyEx(HKEY_LOCAL_MACHINE, strPath, 0, KEY_READ, hKey) = ERROR_SUCCESS Then If RegQueryValueEx(hKey, strValueName, 0, regType, ByVal 0&, lngDataLen) = ERROR_SUCCESS Then ReDim btDataBuf(lngDataLen - 1) As Byte If RegQueryValueEx(hKey, strValueName, 0, regType, btDataBuf(0), lngDataLen) = ERROR_SUCCESS Then btValue = btDataBuf 'MsgBox btValue, , "btValue = DatosBinario" LeerIdMontaje = True End If End If RegCloseKey hKey End If End Function
Título: Re: Serial y Unidad de Pen Drive
Publicado por: cobein en 12 Julio 2009, 05:29 am
Lo saque de un modulo que uso que tiene mas cosas asi que si no estan todas las declaraciones... creo que si pero si falta algo lo pueden agregar. '--------------------------------------------------------------------------------------- ' Module : mUSBSerial ' DateTime : 24/06/2008 07:54 ' Author : Cobein ' Mail : cobein27@hotmail.com ' WebPage : http://www.advancevb.com.ar/ ' Purpose : Read USB device srial. ' Usage : At your own risk ' Requirements: None ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. ' ' History : 24/06/2008 First Cut.................................................... '---------------------------------------------------------------------------------------
Option Explicit
Private Const INVALID_HANDLE_VALUE As Long = (-1) Private Const OPEN_EXISTING As Long = 3 Private Const GENERIC_READ As Long = &H80000000 Private Const FILE_SHARE_READ As Long = &H1 Private Const FILE_SHARE_WRITE As Long = &H2 Private Const IOCTL_STORAGE_BASE As Long = &H2D Private Const METHOD_BUFFERED As Long = 0 Private Const FILE_ANY_ACCESS As Long = 0
Private Const ERROR_NOERROR As Long = &H0 Private Const ERROR_INVALIDBUSTYPE As Long = &H2 Private Const ERROR_GENERICERROR As Long = &H4
Private Const DIGCF_PRESENT As Long = &H2 Private Const DIGCF_DEVICEINTERFACE As Long = &H10
Private Enum STORAGE_PROPERTY_ID StorageDeviceProperty = 0 StorageAdapterProperty End Enum
Private Enum STORAGE_QUERY_TYPE PropertyStandardQuery = 0 PropertyExistsQuery PropertyMaskQuery PropertyQueryMaxDefined End Enum
Public Enum STORAGE_BUS_TYPE BusTypeUnknown = 0 BusTypeScsi BusTypeAtapi BusTypeAta BusType1394 BusTypeSsa BusTypeFibre BusTypeUsb BusTypeRAID BusTypeMaxReserved = &H7F End Enum
Private Type STORAGE_PROPERTY_QUERY PropertyId As STORAGE_PROPERTY_ID QueryType As STORAGE_QUERY_TYPE AdditionalParameters(0) As Byte End Type
Private Type STORAGE_DEVICE_NUMBER dwDeviceType As Long dwDeviceNumber As Long dwPartitionNumber As Long End Type
Private Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type
Private Type STORAGE_DEVICE_DESCRIPTOR Version As Long SIZE As Long DeviceType As Byte DeviceTypeModifier As Byte RemovableMedia As Byte CommandQueueing As Byte VendorIdOffset As Long ProductIdOffset As Long ProductRevisionOffset As Long SerialNumberOffset As Long BusType As STORAGE_BUS_TYPE RawPropertiesLength As Long RawDeviceProperties(0) As Byte End Type
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type
Private Type SP_DEVICE_INTERFACE_DATA cbSize As Long InterfaceClassGuid As GUID flags As Long Reserved As Long End Type
Private Type SP_DEVINFO_DATA cbSize As Long ClassGuid As GUID DevInst As Long Reserved As Long End Type
Private Type SP_DEVICE_INTERFACE_DETAIL_DATA cbSize As Long strDevicePath As String * 260 End Type
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByVal ClassGuid As Long, ByVal Enumerator As Long, ByVal HwndParent As Long, ByVal flags As Long) As Long Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, DeviceInterfaceDetailData As Any, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, DeviceInfoData As Any) As Long Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Public Function GetUSBSerial(ByVal sDrive As String, ByRef sSerial As String) As Long Dim sDriveFormated As String Dim sData As String On Local Error GoTo GetUSBSerial_Error
If Not GetDriveBusType(sDrive) = BusTypeUsb Then GetUSBSerial = ERROR_INVALIDBUSTYPE Exit Function End If sDriveFormated = "\\.\" & Left$(sDrive, 1) & ":" sDrive = Left$(sDrive, 1) & ":" sData = GetDriveDevicePathByDeviceNumber( _ GetDeviceNumber(sDriveFormated), GetDriveType(sDrive), sDrive) sData = Split(sData, "#")(2) sSerial = Split(sData, "&")(0) GetUSBSerial = ERROR_NOERROR Exit Function GetUSBSerial_Error: GetUSBSerial = ERROR_GENERICERROR End Function
Private Function GetDriveDevicePathByDeviceNumber(ByVal lDevNumb As Long, ByVal lDriveType As Long, ByVal sDevice As String) As String Dim tGUID As GUID Dim hDevInfo As Long Dim tSP_DEVICE_INTERFACE_DATA As SP_DEVICE_INTERFACE_DATA Dim tSP_DEVICE_INTERFACE_DETAIL_DATA As SP_DEVICE_INTERFACE_DETAIL_DATA Dim tSP_DEVINFO_DATA As SP_DEVINFO_DATA With tGUID .Data2 = &HB6BF: .Data3 = &H11D0& .Data4(0) = &H94&: .Data4(1) = &HF2& .Data4(2) = &H0&: .Data4(3) = &HA0& .Data4(4) = &HC9&: .Data4(5) = &H1E& .Data4(6) = &HFB&: .Data4(7) = &H8B& Select Case lDriveType Case 2 Dim sDosDev As String * 260 Call QueryDosDevice(Left$(sDevice, 1) & ":", sDosDev, 260) If InStr(sDosDev, "\Floppy") Then .Data1 = &H53F56311 Else .Data1 = &H53F56307 End If Case 3 .Data1 = &H53F56307 Case 5 .Data1 = &H53F56308 End Select End With hDevInfo = SetupDiGetClassDevs(VarPtr(tGUID), 0, 0, _ DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE) If hDevInfo = -1 Then Exit Function
tSP_DEVICE_INTERFACE_DATA.cbSize = Len(tSP_DEVICE_INTERFACE_DATA) Dim lRet As Long Dim lIndex As Long Dim lSize As Long Dim lReturn As Long Do lRet = SetupDiEnumDeviceInterfaces(hDevInfo, _ 0, tGUID, lIndex, tSP_DEVICE_INTERFACE_DATA) If lRet = 0 Then Exit Do lSize = 0 Call SetupDiGetDeviceInterfaceDetail(hDevInfo, _ tSP_DEVICE_INTERFACE_DATA, ByVal 0&, 0, lSize, ByVal 0&) If lSize <> 0 And lSize <= 1024 Then tSP_DEVICE_INTERFACE_DETAIL_DATA.cbSize = 5 tSP_DEVINFO_DATA.cbSize = Len(tSP_DEVINFO_DATA) If SetupDiGetDeviceInterfaceDetail(hDevInfo, _ tSP_DEVICE_INTERFACE_DATA, tSP_DEVICE_INTERFACE_DETAIL_DATA, _ ByVal lSize, lReturn, tSP_DEVINFO_DATA) Then If lDevNumb = _ GetDeviceNumber(tSP_DEVICE_INTERFACE_DETAIL_DATA.strDevicePath) Then Call SetupDiDestroyDeviceInfoList(hDevInfo) GetDriveDevicePathByDeviceNumber = tSP_DEVICE_INTERFACE_DETAIL_DATA.strDevicePath Exit Function End If End If End If lIndex = lIndex + 1 Loop Call SetupDiDestroyDeviceInfoList(hDevInfo) End Function
Private Function GetDeviceNumber(ByVal sDrive As String) As Long Dim lDriveNum As Long Dim hVolume As Long Dim lRet As Long Dim tSTORAGE_DEVICE_NUMBER As STORAGE_DEVICE_NUMBER Dim lRetBytes As Long lDriveNum = -1
hVolume = CreateFile(sDrive, 0, FILE_SHARE_READ Or FILE_SHARE_WRITE, _ ByVal 0&, OPEN_EXISTING, 0, 0) If Not hVolume = INVALID_HANDLE_VALUE Then If DeviceIoControl(hVolume, &H2D1080, ByVal 0&, ByVal 0&, _ tSTORAGE_DEVICE_NUMBER, Len(tSTORAGE_DEVICE_NUMBER), _ lRetBytes, ByVal 0&) Then GetDeviceNumber = tSTORAGE_DEVICE_NUMBER.dwDeviceNumber End If Call CloseHandle(hVolume) End If End Function
Public Function GetDriveBusType(ByVal sDrive As String) As STORAGE_BUS_TYPE Dim lRet As Long Dim lDevice As Long Dim tSTORAGE_DEVICE_DESCRIPTOR As STORAGE_DEVICE_DESCRIPTOR Dim tOVERLAPPED As OVERLAPPED Dim tSTORAGE_PROPERTY_QUERY As STORAGE_PROPERTY_QUERY
sDrive = Left(sDrive, 1) & ":"
lDevice = CreateFile("\\.\" & sDrive, 0, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) If Not lDevice = INVALID_HANDLE_VALUE Then With tSTORAGE_PROPERTY_QUERY .PropertyId = StorageDeviceProperty .QueryType = PropertyStandardQuery End With Call DeviceIoControl( _ lDevice, _ IOCTL_STORAGE_QUERY_PROPERTY, _ tSTORAGE_PROPERTY_QUERY, _ LenB(tSTORAGE_PROPERTY_QUERY), _ tSTORAGE_DEVICE_DESCRIPTOR, _ LenB(tSTORAGE_DEVICE_DESCRIPTOR), _ lRet, tOVERLAPPED) GetDriveBusType = tSTORAGE_DEVICE_DESCRIPTOR.BusType Call CloseHandle(lDevice) End If End Function
Private Function IOCTL_STORAGE_QUERY_PROPERTY() As Long IOCTL_STORAGE_QUERY_PROPERTY = _ (IOCTL_STORAGE_BASE * 2 ^ 16) Or _ (FILE_ANY_ACCESS * 2 ^ 14) Or _ (&H500 * 2 ^ 2) Or _ (METHOD_BUFFERED) End Function
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 12 Julio 2009, 13:17 pm
Gacias por tu tiempo cobein, voy a probar el modulo, en cuanto a WMI no encuentro mucha informacion al respecto, en que ocasiones puede estar no disponible ?
Título: Re: Serial y Unidad de Pen Drive
Publicado por: seba123neo en 12 Julio 2009, 18:34 pm
Gacias por tu tiempo cobein, voy a probar el modulo, en cuanto a WMI no encuentro mucha informacion al respecto, en que ocasiones puede estar no disponible ?
si puede estar deshabilitado segun los permisos , si es administrador o no, sobre todo en vista...hay un codigo para saber si esta disponible. saludos.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: tobu en 12 Julio 2009, 22:55 pm
dios mio todo ésto para que reconozca la letra de unidad y del serial buffffff.pasate a net dios mio de mi alma.y no me digas que es net.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: cobein en 12 Julio 2009, 23:44 pm
Dios mio de mi alma, 300 MB de un framework para no saber como se programa ni como se saca el serial de un USB drive. Eso es a lo que yo llamo no tener idea de nada. "Usa NET que no tenes que aprender nada"
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Karcrack en 13 Julio 2009, 00:35 am
Dios mio de mi alma, 300 MB de un framework para no saber como se programa ni como se saca el serial de un USB drive. Eso es a lo que yo llamo no tener idea de nada. "Usa NET que no tenes que aprender nada"
Eso, eso .NET abajo!!!... Odio las clases... no las del instituto, sino las de .NET :laugh: (Aunque las del instituto... :-X :xD) Lo mejor es saber programar con las APIs... eso del NET es un timo... :P
Título: Re: Serial y Unidad de Pen Drive
Publicado por: BlackZeroX en 13 Julio 2009, 01:29 am
"Usa NET que no tenes que aprender nada"
Por eso NO me gusta.¡!
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Dessa en 13 Julio 2009, 03:58 am
dios mio todo ésto para que reconozca la letra de unidad y del serial buffffff.pasate a net dios mio de mi alma.y no me digas que es net.
Mejor ni opino, ya tengo dos "vacaciones del foro" este año. si puede estar deshabilitado segun los permisos , si es administrador o no, sobre todo en vista...hay un codigo para saber si esta disponible.
Gracias Seba, On Error Resume Next, luego cargar GetObject("winmgmts:") y si el error es igual a cero WMI está disponible, algo así ? S2
Título: Re: Serial y Unidad de Pen Drive
Publicado por: seba123neo en 13 Julio 2009, 04:15 am
mira este post habla justo de eso,ya sabia que estaba:
Detectar si hay WMI (VB6) (http://foro.elhacker.net/empty-t232667.0.html)
por ejemplo, la que yo hice de sacar la temperatura del disco duro con WMI, funciona bien si no tenes restricciones, pero lo he probado en otras maquinas que entras con una cuenta de usuario y no funciona el programa...
saludos.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: tobu en 14 Julio 2009, 16:56 pm
.... emmmm por cierto sigo pensando lo mismo...pásate a net hombre que facilita las cosas.en fin siempre es mi opinion así que no enfadaros.o a caso no se puedar opinion?bueno mejor no me contesten pues será una guerra textual y me ha dicho el médico que no discuta.
Título: Re: Serial y Unidad de Pen Drive
Publicado por: Karcrack en 14 Julio 2009, 18:16 pm
.... emmmm por cierto sigo pensando lo mismo...pásate a net hombre que facilita las cosas.en fin siempre es mi opinion así que no enfadaros.o a caso no se puedar opinion?bueno mejor no me contesten pues será una guerra textual y me ha dicho el médico que no discuta.
Dile a tu medico que discutir ayuda a aclarar ideas... que hay veces que estan confundidas...
Título: Re: Serial y Unidad de Pen Drive
Publicado por: seba123neo en 15 Julio 2009, 01:59 am
.... emmmm por cierto sigo pensando lo mismo...pásate a net hombre que facilita las cosas.en fin siempre es mi opinion así que no enfadaros.o a caso no se puedar opinion?bueno mejor no me contesten pues será una guerra textual y me ha dicho el médico que no discuta.
amigo tobu, ¿ podes parar de decirle a todo el mundo que use .NET ? o tambien te pasas por el foro de pascal y decis lo mismo ?, me parece que sos un troll comun de los foros.yo uso .NET todo el dia, pero no estoy por los foros diciendo tal cosa.como todo en el mundo va mejorando, los lenguajes de programacion tambien avanzan, en 100 años no creo que se tenga que declarar una api para programar...¿ pero eso quiere decir que es mejor que declararlas ?...NO. saludos.
|