Serial del disco duro o del procesador

15/08/2007 - 19:56 por Henry Sanchez | Informe spam
Hola Grupo,

Como explique antes estoy interesado en que mis macros reconozcan el equipo
en que estan corriendo,

Gracias PabloV, estoy muy interesado en que me indiques como leer el serial
del procesador, si puedes ayudarme te lo agradeceria.

En otro foro me indico Ruben como leer el serial del disco duro:

Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
ByVal lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Function DiskSerial(DrivePath As String) As String
Dim retCode As Long
Dim VolumeName As String
Dim VolumeSerialNumber As Long
Dim MaximumComponentLength As Long
Dim FileSystemFlags As Long
Dim FileSystemNameBuffer As String
Dim HiWord As Integer, LoWord As Integer

VolumeName = Space(255)
FileSystemNameBuffer = Space(255)
MaximumComponentLength = 0
FileSystemFlags = 0

retCode = GetVolumeInformation(DrivePath, VolumeName, 255,
VolumeSerialNumber, _
MaximumComponentLength, FileSystemFlags, FileSystemNameBuffer, 255)

If retCode = 0 Then
DiskSerial = "Error"
Else
HiWord = (VolumeSerialNumber And &HFFFF0000) \ &H10000
If VolumeSerialNumber And &H8000& Then
LoWord = VolumeSerialNumber Or &HFFFF0000
Else
LoWord = VolumeSerialNumber And &HFFFF&
End If
DiskSerial = Format$(Hex(HiWord), "0000") & "-" & Format$(Hex(LoWord),
"0000")
End If

End Function

llama a la function: DiskSerial("C:\")

Aunque tengo mis dudas respecto al valor que dvuelve, por que es diferente
al del codigo que manejo que obtuve con la ayuda de Hector Miguel.

Habria que determinar cual de los dos valores es el serial del disco duro y
que es lo que devuelve la otra funcion.

Yo pienso que es importante para los que creamos aplicaciones para Excel en
VBA tener una forma de proteger nuestro trabajo, asi que si alguien tiene
alguna idea o metodo que quiera compartir se le agradeceria bastante

Saludos,

Henry
 

Leer las respuestas

#1 Héctor Miguel
16/08/2007 - 05:31 | Informe spam
hola, Henry !

Como explique antes estoy interesado en que mis macros reconozcan el equipo en que estan corriendo,
Gracias PabloV, estoy muy interesado en que me indiques como leer el serial del procesador, si puedes ayudarme te lo agradeceria.
En otro foro me indico Ruben como leer el serial del disco duro: [... ... ... ]
llama a la function: DiskSerial("C:\")
Aunque tengo mis dudas respecto al valor que dvuelve, por que es diferente al del codigo que manejo...
Habria que determinar cual de los dos valores es el serial del disco duro y que es lo que devuelve la otra funcion...



[hasta donde se] usando el "PhysicalMedia" es la unica forma de obtener el ID *unico* del disco duro [no hay otra] :-((

1) el codigo nuevo que estas probando... lo consigues con las siguientes [menos extensas] lineas:
[si no recuerdo mal, es parte de la propuesta efectuada alla por julio 20 de 2005] ;)

Sub NumeroDeSerie()
' mismo numero de serie que Win32_LogicalDisk '
With CreateObject("Scripting.FileSystemObject")
MsgBox Hex(.Drives.Item("c:").SerialNumber)
End With
End Sub

2) tambien en aquella ocasion te comentaba algo +/- como lo siguiente:

"PhiysicalMedia muestra el numero con el cual el fabricante ->ha 'etiquetado'<- [fisicamente] la unidad de almacenamiento"
"[es decir... es el unico y 'verdadero' numero de serie]"
"el serial que devuelve ->cualquier otro metodo/procedimiento/llamada/API/...'<- NO es 'permanente'..."
"[es decir... cambia por cada vez que la unidad de almacenamiento 'pasa' por un proceso de 'preparacion' ->se le da formato<-]"

3) en comentarios a tu consulta previa [concretamente el punto 5] te exponia la *problematica* para identificar la unidad logica...
[asumiendo la intencion de seguir con la identificacion *unica* del fabricante del disco duro, por el "PhysicalMedia"]...

"con relacion a *identificar* el disco desde el cual se corre tu archivo/aplicacion..."
"si la intencion es continuar *leyendo* el codigo [unico e inamovible] que pone el fabricante del disco..."
"no encontre en las propiedades del objeto *physicalMedia* [primer enlace]"
"-> alguna que permita identificar [p.e.] la unidad *logica* del medio fisico [p.e. "C:\"]"

4) con respecto de cambiar a [o agregar] la identificacion del procesador del equipo donde corren tus aplicaciones...
[y solo por mencionar algunas fuentes basicas de informacion]:

a) de la pagina de Randy Birch:
Obtaining Processor Information using WMI
-> http://vbnet.mvps.org/code/wmi/win32_processor.htm

b) de las paginas de MSDN:
http://msdn2.microsoft.com/en-us/li...94373.aspx

c) un ejemplo [basado en la informacion de las paginas anteriores]:
[de todas formas, hay que *recetarse* las notas aclaratorias porque "no todo te da de todo"]

Sub Procesadores()
Dim Procesador As Object
With GetObject("WinMgmts:")
For Each Procesador In .InstancesOf("Win32_Processor")
With Procesador
MsgBox "Info del procesador:" & vbCr & _
"Fabricante:" & vbTab & .Manufacturer & vbCr & _
"Dispositivo: " & vbTab & .DeviceId & vbCr & _
" Nombre:" & vbTab & Application.Trim(.Name) & vbCr & _
"Identificador:" & vbTab & .ProcessorId & vbCr & _
" Familia:" & vbTab & .Family & vbCr & _
" ID unica:" & vbTab & .UniqueId
End With
Next
End With
End Sub

si cualquier duda... comentas ?
saludos,
hector.

__ el codigo expuesto __
Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
ByVal lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Function DiskSerial(DrivePath As String) As String
Dim retCode As Long
Dim VolumeName As String
Dim VolumeSerialNumber As Long
Dim MaximumComponentLength As Long
Dim FileSystemFlags As Long
Dim FileSystemNameBuffer As String
Dim HiWord As Integer, LoWord As Integer

VolumeName = Space(255)
FileSystemNameBuffer = Space(255)
MaximumComponentLength = 0
FileSystemFlags = 0

retCode = GetVolumeInformation(DrivePath, VolumeName, 255, VolumeSerialNumber, _
MaximumComponentLength, FileSystemFlags, FileSystemNameBuffer, 255)

If retCode = 0 Then
DiskSerial = "Error"
Else
HiWord = (VolumeSerialNumber And &HFFFF0000) \ &H10000
If VolumeSerialNumber And &H8000& Then
LoWord = VolumeSerialNumber Or &HFFFF0000
Else
LoWord = VolumeSerialNumber And &HFFFF&
End If
DiskSerial = Format$(Hex(HiWord), "0000") & "-" & Format$(Hex(LoWord), "0000")
End If

End Function

Preguntas similares