Autor Tema: Obtener el numero original del DISCO DURO  (Leído 1340 veces)

0 Usuarios y 1 Visitante están viendo este tema.

k_arlytos

  • Megabyte
  • ***
  • Mensajes: 210
  • Reputación: +2/-4
    • Ver Perfil
Obtener el numero original del DISCO DURO
« en: Agosto 20, 2016, 01:30:44 am »
Buenas tardes quisiera saber que funcion me retorna el numero original que no se pueda clonar del disco duro
para de esta forma crear un demo de una aplicacion

Muchas Gracias
« última modificación: Agosto 20, 2016, 04:06:53 pm por k_arlytos »
"Comentar el código es como limpiar el cuarto de baño; nadie quiere hacerlo, pero el resultado es siempre una experiencia más agradable para uno mismo y sus invitados"

Albertomi

  • Gigabyte
  • ****
  • Mensajes: 281
  • Reputación: +153/-0
    • Ver Perfil
Re:Obtener el numero original del DISCO DURO
« Respuesta #1 en: Agosto 20, 2016, 11:00:09 pm »
Estimado k_arlytos, espero que esté código se ajuste a lo que necesitas y que te sea de utilidad

Estés es el código de la clase

Código: (VB) [Seleccionar]
Option Explicit

Private Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1

Private Enum HDINFO
  HD_MODEL_NUMBER
  HD_SERIAL_NUMBER
  HD_FIRMWARE_REVISION
End Enum

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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetLastError Lib "kernel32" () As Long

Private m_bytCurrentDrive As Byte
Private m_strPlatform As String


Public Property Let CurrentDrive(ByVal vData As Byte)
  If vData < 0 Or vData > 3 Then
    Err.Raise 10000, , "Illegal drive number"
  End If
 
  m_bytCurrentDrive = vData
End Property

Public Property Get CurrentDrive() As Byte
  CurrentDrive = m_bytCurrentDrive
End Property

Public Function GetModelNumber() As String
  GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)
End Function

Public Function GetSerialNumber() As String
  GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)
End Function

Public Function GetFirmwareRevision() As String
  GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION)
End Function

Public Property Get Platform() As String
  Platform = m_strPlatform
End Property

Private Sub Class_Initialize()
  Dim OS As OSVERSIONINFO
     
  OS.dwOSVersionInfoSize = Len(OS)
  Call GetVersionEx(OS)
 
  m_strPlatform = "Unk"
  Select Case OS.dwPlatformId
    Case Is = VER_PLATFORM_WIN32S
      m_strPlatform = "32S"
    Case Is = VER_PLATFORM_WIN32_WINDOWS
      If OS.dwMinorVersion = 0 Then
        m_strPlatform = "W95"
      Else
         m_strPlatform = "W98"
      End If
    Case Is = VER_PLATFORM_WIN32_NT
      m_strPlatform = "WNT"
  End Select
End Sub

Private Function CmnGetHDData(hdi As HDINFO) As String
  Dim bin As SENDCMDINPARAMS
  Dim bout As SENDCMDOUTPARAMS
  Dim hdh As Long
  Dim br As Long
  Dim ix As Long
  Dim hddfr As Long
  Dim hddln As Long
  Dim s As String
 
  Select Case hdi
    Case HD_MODEL_NUMBER
      hddfr = 55
      hddln = 40
    Case HD_SERIAL_NUMBER
      hddfr = 21
      hddln = 20
    Case HD_FIRMWARE_REVISION
      hddfr = 47
      hddln = 8
    Case Else
      Err.Raise 10001, "Illegal HD Data type"
  End Select
 
  Select Case m_strPlatform
    Case "WNT"
      hdh = CreateFile("\\.\PhysicalDrive" & m_bytCurrentDrive, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
    Case "W95", "W98"
      hdh = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
    Case Else
      Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)"
  End Select
 
  If hdh = 0 Then
    Err.Raise 10003, , "Error on CreateFile"
  End If
 
  ZeroMemory bin, Len(bin)
  ZeroMemory bout, Len(bout)
 
  With bin
    .bDriveNumber = m_bytCurrentDrive
    .cBufferSize = 512
   
    With .irDriveRegs
      If (m_bytCurrentDrive And 1) Then
        .bDriveHeadReg = &HB0
      Else
        .bDriveHeadReg = &HA0
      End If
     
      .bCommandReg = &HEC
      .bSectorCountReg = 1
      .bSectorNumberReg = 1
    End With
  End With
 
  DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, bin, Len(bin), bout, Len(bout), br, 0
 
  s = vbNullString
  For ix = hddfr To hddfr + hddln - 1 Step 2
    If bout.bBuffer(ix + 1) = 0 Then Exit For
    s = s & Chr(bout.bBuffer(ix + 1))
    If bout.bBuffer(ix) = 0 Then Exit For
    s = s & Chr(bout.bBuffer(ix))
  Next ix
 
  CloseHandle hdh
 
  CmnGetHDData = Trim(s)
End Function



Esta es una forma de invocarlo por ejemplo desde un formulario

Código: (VB) [Seleccionar]
Private Sub Command1_Click()
  Dim strData As String
  Dim objHD As clsHardDisk
 
  strData = vbNullString
 
  Set objHD = New clsHardDisk
  With objHD
    .CurrentDrive = 0
    strData = strData & "Model number: " & .GetModelNumber() & vbCrLf
    strData = strData & "Serial number: " & .GetSerialNumber() & vbCrLf
    strData = strData & "Firmware Revision: " & .GetFirmwareRevision() & vbCrLf
  End With
  Set objHD = Nothing
 
  MsgBox strData 
End Sub


Saludos, desde algún lugar de Lima-Perú
« última modificación: Agosto 20, 2016, 11:05:52 pm por Albertomi »
Saludos, desde algún lugar de Lima-Perú

PatriciaBB

  • Kilobyte
  • **
  • Mensajes: 51
  • Reputación: +5/-0
    • Ver Perfil
Re:Obtener el numero original del DISCO DURO
« Respuesta #2 en: Agosto 20, 2016, 11:15:51 pm »
Yo he utilizado el código de esta página

http://vbnet.mvps.org/index.html?code/disk/smartide.htm

;)

Albertomi

  • Gigabyte
  • ****
  • Mensajes: 281
  • Reputación: +153/-0
    • Ver Perfil
Re:Obtener el numero original del DISCO DURO
« Respuesta #3 en: Agosto 21, 2016, 12:15:17 am »

Estimado k_arlytos, este es un tema que lo consultó lucius en Junio del 2010


Te copio el link por si te intersa revisarlo
  http://leandroascierto.com/foro/index.php?topic=356.0




Saludos, desde algún lugar de Lima-Perú
Saludos, desde algún lugar de Lima-Perú