Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: lucius en Junio 10, 2010, 12:03:10 am
-
Como averiguo el numero de serie del disco duro mas no de la particion, es posible?
-
checa este link
http://vbnet.mvps.org/index.html?code/disk/smartide.htm (http://vbnet.mvps.org/index.html?code/disk/smartide.htm)
y tambien este
http://social.msdn.microsoft.com/forums/en-US/vbpowerpacks/thread/0e9a097d-c22c-4b70-ad50-106d680fa5b3/ (http://social.msdn.microsoft.com/forums/en-US/vbpowerpacks/thread/0e9a097d-c22c-4b70-ad50-106d680fa5b3/)
-
voy a revisarlos,saludos
-
Hola, solo una acotacion, el code de los dos links requieren ser administrador del sistema y creo que el segundo link en particular tiene un error en el retorno de createfile (Igual a cero) (Por favor corríjanme si estoy equivocado)
Saludos
-
Como averiguo el numero de serie del disco duro mas no de la particion, es posible?
aca te dejo 3 funciones para obtener el serial del disco, todas funcionan perfecto, excepto la de WMI con windows 9x.
Private Declare Function GetVolumeInformationW Lib "kernel32" (ByVal lpRootPathName As Long, ByVal lpVolumeNameBuffer As Long, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As Long, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetVolumeInformationA Lib "kernel32" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Function GetIDA(ByVal strName As String) As Long
Call GetVolumeInformationA(strName, vbNullString, 0, GetIDA, 0, 0, vbNullString, 0)
End Function
Private Function GetIDW(ByVal strName As String) As Long
Call GetVolumeInformationW(StrPtr(strName), 0&, 0&, GetIDW, 0&, 0&, 0&, 0&)
End Function
Private Function GetIDWMI(ByVal strName As String) As Long
Dim objRoot As Object
Dim objEnum As Object
Dim objChild As Object
Set objRoot = GetObject("winmgmts:root\cimv2")
Set objEnum = objRoot.execQuery("select VolumeSerialNumber from win32_logicaldisk where DeviceID =""" & Left$(strName, 1) & ":""")
For Each objChild In objEnum
GetIDWMI = CLng("&H" & objChild.VolumeSerialNumber)
Set objChild = Nothing
Set objEnum = Nothing
Set objRoot = Nothing
Exit For
Next
End Function
llama a todas pasando solo la letra del disco y dos puntos, ejemplo C:, D:, F:, etc
con eso obtenes lo de las particiones, pero podes usar WMI con el siguiente: Win32_DiskDrive y buscar con Where Name= "\\.PHYSICALDRIVEX" y obtener la data, en especial .SerialNumber.
saludos
-
gracias voy a revisar los ejemplo y les cuento, saludos
-
Solo funciona bien GetIDWMI me devuelve el numero de "C:" y "D:" las otras dos solo devuelven el numero de "D:" y "C:" sale 0
-
Solo funciona bien GetIDWMI me devuelve el numero de "C:" y "D:" las otras dos solo devuelven el numero de "D:" y "C:" sale 0
me debo haber confundido yo!!.. a las 3 les pasas C:\ por ejemplo.. el DMI te debe andar porque tiene un Left(strPath, 1) & ":" entonces no falla nunca... proba con C:\... pero creo que eso no era lo que precisabas..
saludos
-
Como averiguo el numero de serie del disco duro mas no de la particion, es posible?
Hola coco y lucius, creo que el serial Verdadero del disco rígido (el ue figura en la etiqueta exterior del mismo y no cambia al formatear una o todas sus unidades lógicas ) no es devuelto por GetVolumeInformation.(Por lo menos yo nunca pude obtenerlo de esa manera)
Yo uso el siguiente code, por lo menos a mí me dió buen resultado:
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function: SerialHD
' Autor: Dessa
' Creditos: es una adaptacion a mis nesecidades de una clase de Antonio Giuliana
' Requisitos : Windows NT + Administrador
' Rertorno: retorna el serial verdadero de Discos IDE o S-ATA conectados
' Serial verdadero: Es el que figura en la etiqueta del Disco y no cambia al formatear
' Fecha : Febrero 2010
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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, ByVal lpOverlapped As Long) As Long
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function IsNTAdmin Lib "advpack.dll" (ByVal dwReserved As Long, ByRef lpdwReserved As Long) As Long
Private Type OSVERSIONINFO: dwOSVersionInfoSize As Long: dwMajorVersion As Long: dwMinorVersion As Long: dwBuildNumber As Long: dwPlatformId As Long: szCSDVersion As String * 128: End Type
Private Type IDEREGS: bFeaturesReg As Byte: bSectorCountReg As Byte: bSectorNumberReg As Byte: bCylLowReg As Byte: bCylHighReg As Byte: bDriveHeadReg As Byte: bCommandReg As Byte: bReserved As Byte: End Type
Private Type SENDCMDINPARAMS: cBufferSize As Long: irDriveRegs As IDEREGS: bDriveNumber As Byte: bReserved(1 To 3) As Byte: dwReserved(1 To 4) As Long: End Type
Private Type DRIVERSTATUS: bDriveError As Byte: bIDEStatus As Byte: bReserved(1 To 2) As Byte: dwReserved(1 To 2) As Long: End Type
Private Type SENDCMDOUTPARAMS: cBufferSize As Long: DStatus As DRIVERSTATUS: bBuffer(1 To 512) As Byte: End Type
Private Sub Form_DblClick()
Me.Print SerialHD
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Me.Print SerialHD
End Sub
Public Function SerialHD() As String
Dim OS As OSVERSIONINFO: OS.dwOSVersionInfoSize = Len(OS): Call GetVersionEx(OS)
If OS.dwPlatformId <> 2 Then 'VER_PLATFORM_WIN32_NT = 2
SerialHD = "Sistema Operativo No válido"
Exit Function
End If
If Not CBool(IsNTAdmin(0, 0)) Then
SerialHD = "Se requiere Administrador"
Exit Function
End If
Dim bin As SENDCMDINPARAMS: Dim bout As SENDCMDOUTPARAMS
Dim x As Long: Dim br As Long: Dim hddfr As Long: Dim hddln As Long
Dim nDisco As Byte: Dim hdh As Long: Dim s As String
For nDisco = 0 To 20 ' los ciclos del For serán solo la cantidad de "PhysicalDrive" conectados
hdh = CreateFile("\\.\PhysicalDrive" & nDisco, &H1 + &H2, 0, 0, 3, 0, 0)
If hdh = -1 Then
If nDisco = 0 Then
SerialHD = " IDE " & nDisco & " = " & "Error en CreateFile" & vbNewLine
Else
SerialHD = SerialHD & " IDE " & nDisco & " = " & "Error en CreateFile" & vbNewLine
End If
Else
hddfr = 21 ' Posicion en el buffer del SerialNumber
hddln = 20 ' Tamaño resrvado en el buffer para el SerialNumber
Call ZeroMemory(bin, Len(bin))
Call ZeroMemory(bout, Len(bout))
With bin
.bDriveNumber = nDisco
.cBufferSize = 512
With .irDriveRegs
If (nDisco And 1) Then
.bDriveHeadReg = &HB0
Else
.bDriveHeadReg = &HA0
End If
.bCommandReg = &HEC
.bSectorCountReg = 1
.bSectorNumberReg = 1
End With
End With
'DFP_RECEIVE_DRIVE_DATA = &H7C088
Call DeviceIoControl(hdh, &H7C088, bin, Len(bin), bout, Len(bout), br, 0)
s = ""
For x = hddfr To hddfr + hddln - 1 Step 2
If bout.bBuffer(x + 1) = 0 Then Exit For
s = s & Chr(bout.bBuffer(x + 1))
If bout.bBuffer(x) = 0 Then Exit For
s = s & Chr(bout.bBuffer(x))
Next x
Call CloseHandle(hdh)
If Trim(s) = "" Then Exit For
SerialHD = SerialHD & " IDE " & nDisco & " = " & Trim(s) & vbNewLine
'SerialHD = SerialHD & Trim(s) & vbNewLine
End If
Next nDisco
End Function
-
Buen aporte Dessa. Una pregunta del tipo mas bien generico. El codigo de un Disco duro al que te refieres es unico con respecto a los demas discos duros del mundo? o en todo caso usando el Ghost para clonar el disco duro lograremos clonar tambien el codigo o numero de disco duro?
Seria bueno saber esto para usarlo en licencias.
-
Hola YvanB , el serial es unico e irrepetible, si por ejemplo el serial del disco de tu cliente es WD-WCAMD9323451 y agregas en el load :
If SerialHD <> "WD-WCAMD9323451" Then
MsgBox "No está autorizado a usar mi Sofware"
Unload Me
End If
El disco o la partición del disco mejor dicho se pueden clonar y volver a usar como backup del mismo disco, pero si copian esa imagen (Ghost, DriveImage, R-Driveimage, etc , etc )en otro disco rigido el sistema operativo tal vez corra pero tu aplicación no.
-
Excelente respuesta Dessa.
Punto para ti
-
Gracias YvanB, pero recuerda que es un code limitado (Windows NT + Administrador)
Saludos
-
Gracias por las respuestas ya quedo claro que una cosa el serial de disco y otro el serial de la unidad.
Tengo una ultima consulta hablando del serial de la UNIDAD siempre va a devolver numeros o puede que tambien devuelva numero y letras.
saludos
-
Gracias por las respuestas ya quedo claro que una cosa el serial de disco y otro el serial de la unidad.
Tengo una ultima consulta hablando del serial de la UNIDAD siempre va a devolver numeros o puede que tambien devuelva numero y letras.
saludos
Hola! yo utilizo el MAC del pc para generar el Serial y me a dado buen resultado hasta ahora antes utilizaba el GetDiskSerial.dll pero esta gente nunca me dio soporte luego que lo compre y tuve algunos problemas con los nuevos SO como Vista y Win7 ahi va el codigo por si a alguno le sirve.
'FUNCION QUE OBTIENE LA mac de la pc
Public Function leerIDcomputadora() As String
Dim colNetAdapters, objWMIService As Object
Dim strComputer As String
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colNetAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each objitem In colNetAdapters
leerIDcomputadora = objitem.MACAddress
Next
End Function
Private Sub Command1_Click()
MsgBox "El MAC de esta Pc es " & leerIDcomputadora
End Sub
-
recuerda que es un code limitado (Windows NT + Administrador)
A que se refiere este parrafo exactamente?, por que he probado el codigo y funciono en windows xp sp2 podrian especificar.
Otra consulta, saben si este codigo corre en windows vista y 7, alguien del foro puede probarlo.
saludos
-
Uhm yo lo probe en win 7, y no me devuelve nada.
Salu2.
-
Hola,
Yo tengo una DLL que adquirí y la comparto con el que me la solicite por correo y la misma funciona correctamente en WIN 7. Se trata de GetDiskSerial.
Saludos