Recuperar el serial del disco duro con vb6.0

[lucius]

Como averiguo el numero de serie del disco duro mas no de la particion, es posible?

[czar9]

checa este link
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/

[lucius]

voy a revisarlos,saludos

[Dessa]

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

[coco]

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.

Código: (vb) [Seleccionar]

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

[lucius]

gracias voy a revisar los ejemplo y les cuento, saludos

[lucius]

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

[coco]

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

[Dessa]

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:

Código: [Seleccionar]



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




[YAcosta]

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.

[Dessa]

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.

[YAcosta]

Excelente respuesta Dessa.
Punto para ti

[Dessa]

Gracias YvanB, pero recuerda que es un code limitado (Windows NT + Administrador)

Saludos

[lucius]

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

[Bazooka]

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.

Código: (vb) [Seleccionar]

'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