locked
Retriving Hard Disk Serial Number Using VB 6.0

    Question

  • Is there any way to find the serial number of harddisk which is parmanent and don't get change after formatting ??

    --
    upen
    Tuesday, May 15, 2007 5:36 AM

Answers

  • Upendra Patil,

     

    Use the GetVolumeInformation API function.

     

    Code Snippet

    Private Sub Command1_Click()

        Dim root As String

        Dim volume_name As String

        Dim serial_number As Long

        Dim max_component_length As Long

        Dim file_system_flags As Long

        Dim file_system_name As String

        Dim pos As Integer

     

        root = Text1.Text

        volume_name = Space$(1024)

        file_system_name = Space$(1024)

     

        If GetVolumeInformation(root, volume_name, _

            Len(volume_name), serial_number, _

            max_component_length, file_system_flags, _

            file_system_name, Len(file_system_name)) = 0 _

        Then

            MsgBox("Error getting volume information.")

            Exit Sub

        End If

     

        pos = InStr(volume_name, Chr$(0))

        volume_name = Left$(volume_name, pos - 1)

        lblVolumeName.Caption = volume_name

     

        lblSerialNumber.Caption = Format$(serial_number)

     

        lblMaxComponentLength.Caption = _

            Format$(max_component_length)

     

        pos = InStr(file_system_name, Chr$(0))

        file_system_name = Left$(file_system_name, pos - 1)

        lblFileSystem.Caption = file_system_name

     

        lblFlags.Caption = "&&H" & Hex$(file_system_flags)

    End Sub

     

    Monday, May 21, 2007 3:51 AM
  • Hi,
     
    One of best way to configure a tool to run only on a particular machine is using the MANUFACTURER SERIAL NUMBER OF THE HARD DISK, which is unique.
     
    GetVolumeInformation will return ONLY the volume serial number, which keeps changing on format.
     
    Use the following code to retrieve Model Number, Serial Number and Firmware Revision of a hard disk.
     
    Here by I am providing the Class file code & vb file code.
     
    I am pasting the code of the class file opened by notepad here by
    ---------------------------------------------------------------
    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
      Persistable = 0  'NotPersistable
      DataBindingBehavior = 0  'vbNone
      DataSourceBehavior  = 0  'vbNone
      MTSTransactionMode  = 0  'NotAnMTSObject
    END
    Attribute VB_Name = "HDSN"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
    Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
    Option Explicit
     
    ' Antonio Giuliana, 2001-2003
     
    ' Costanti per l'individuazione della versione di OS
    Private Const VER_PLATFORM_WIN32S = 0
    Private Const VER_PLATFORM_WIN32_WINDOWS = 1
    Private Const VER_PLATFORM_WIN32_NT = 2
     
    ' Costanti per la comunicazione con il driver IDE
    Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
     
    ' Costanti per la CreateFile
    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
     
    ' Enumerazione dei comandi per la CmnGetHDData
    Private Enum HDINFO
        HD_MODEL_NUMBER
        HD_SERIAL_NUMBER
        HD_FIRMWARE_REVISION
    End Enum
     
    ' Struttura per l'individuazione della versione di OS
    Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
    End Type
     
    ' Struttura per il campo irDriveRegs della struttura SENDCMDINPARAMS
    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
     
    ' Struttura per l'I/O dei comandi al driver IDE
    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
     
    ' Struttura per il campo DStatus della struttura SENDCMDOUTPARAMS
    Private Type DRIVERSTATUS
        bDriveError As Byte
        bIDEStatus As Byte
        bReserved(1 To 2) As Byte
        dwReserved(1 To 2) As Long
    End Type
     
    ' Struttura per l'I/O dei comandi al driver IDE
    Private Type SENDCMDOUTPARAMS
        cBufferSize As Long
        DStatus As DRIVERSTATUS     ' ovvero DriverStatus
        bBuffer(1 To 512) As Byte
    End Type
     
    ' Per ottenere la versione del SO
    Private Declare Function GetVersionEx _
        Lib "kernel32" Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long
     
    ' Per ottenere un handle al device IDE
    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
     
    ' Per chiudere l'handle del device IDE
    Private Declare Function CloseHandle _
        Lib "kernel32" _
        (ByVal hObject As Long) As Long
     
    ' Per comunicare con il driver IDE
    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
       
    ' Per azzerare buffer di scambio dati
    Private Declare Sub ZeroMemory _
        Lib "kernel32" Alias "RtlZeroMemory" _
        (dest As Any, _
        ByVal numBytes As Long)
     
    ' Per copiare porzioni di memoria
    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 mvarCurrentDrive As Byte    ' Drive corrente
    Private mvarPlatform As String      ' Piattaforma usata
     
    Public Property Get Copyright() As String
       
        ' Copyright
        Copyright = "HDSN Vrs. 1.00, (C) Antonio Giuliana, 2001-2003"
       
    End Property
     
    ' Metodo GetModelNumber
    Public Function GetModelNumber() As String
       
        ' Ottiene il ModelNumber
        GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)
       
    End Function
     
    ' Metodo GetSerialNumber
    Public Function GetSerialNumber() As String
       
        ' Ottiene il SerialNumber
        GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)
       
    End Function
     
    ' Metodo GetFirmwareRevision
    Public Function GetFirmwareRevision() As String
       
        ' Ottiene la FirmwareRevision
        GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION)
       
    End Function
     
    ' Proprieta' CurrentDrive
    Public Property Let CurrentDrive(ByVal vData As Byte)
       
        ' Controllo numero di drive fisico IDE
        If vData < 0 Or vData > 3 Then
            Err.Raise 10000, , "Illegal drive number"   ' IDE drive 0..3
        End If
       
        ' Nuovo drive da considerare
        mvarCurrentDrive = vData
     
    End Property
     
    ' Proprieta' CurrentDrive
    Public Property Get CurrentDrive() As Byte
       
        ' Restituisce drive fisico corrente (IDE 0..3)
        CurrentDrive = mvarCurrentDrive
     
    End Property
     
    ' Proprieta' Platform
    Public Property Get Platform() As String
       
        ' Restituisce tipo OS
        Platform = mvarPlatform
     
    End Property
     
    Private Sub Class_Initialize()
     
        ' Individuazione del tipo di OS
        Dim OS As OSVERSIONINFO
           
        OS.dwOSVersionInfoSize = Len(OS)
        Call GetVersionEx(OS)
        mvarPlatform = "Unk"
        Select Case OS.dwPlatformId
            Case Is = VER_PLATFORM_WIN32S
                mvarPlatform = "32S"                ' Win32S
            Case Is = VER_PLATFORM_WIN32_WINDOWS
                If OS.dwMinorVersion = 0 Then
                    mvarPlatform = "W95"            ' Win 95
                Else
                    mvarPlatform = "W98"            ' Win 98
                End If
            Case Is = VER_PLATFORM_WIN32_NT
                mvarPlatform = "WNT"                ' Win NT/2000
        End Select
     
    End Sub
     
    Private Function CmnGetHDData(hdi As HDINFO) As String
     
        ' Rilevazione proprieta' IDE
       
        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             ' Selezione tipo caratteristica richiesta
            Case HD_MODEL_NUMBER
                hddfr = 55          ' Posizione nel buffer del ModelNumber
                hddln = 40          ' Lunghezza nel buffer del ModelNumber
            Case HD_SERIAL_NUMBER
                hddfr = 21          ' Posizione nel buffer del SerialNumber
                hddln = 20          ' Lunghezza nel buffer del SerialNumber
            Case HD_FIRMWARE_REVISION
                hddfr = 47          ' Posizione nel buffer del FirmwareRevision
                hddln = 8           ' Lunghezza nel buffer del FirmwareRevision
            Case Else
                Err.Raise 10001, "Illegal HD Data type" ' Altre informazioni non disponibili
     
    (Evoluzione futura)
        End Select
       
        Select Case mvarPlatform
            Case "WNT"
                ' Per Win NT/2000 apertura handle al drive fisico
                hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _
                    GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _
                    0, OPEN_EXISTING, 0, 0)
            Case "W95", "W98"
                ' Per Win 9X apertura handle al driver SMART
                ' (in \WINDOWS\SYSTEM da spostare in \WINDOWS\SYSTEM\IOSUBSYS)
                ' che comunica con il driver IDE
                hdh = CreateFile("\\.\Smartvsd", _
                    0, 0, 0, CREATE_NEW, 0, 0)
            Case Else
                ' Piattaforma non supportata (Win32S)
                Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)"    ' Altre piattaforme
     
    non gestite
        End Select
        ' Controllo validità handle
        If hdh = 0 Then
            Err.Raise 10003, , "Error on CreateFile"
        End If
       
        ' Azzeramento strutture per l'I/O da driver
        ZeroMemory bin, Len(bin)
        ZeroMemory bout, Len(bout)
       
        ' Preparazione parametri struttura di richiesta al driver
        With bin
            .bDriveNumber = mvarCurrentDrive
            .cBufferSize = 512
            With .irDriveRegs
                If (mvarCurrentDrive And 1) Then
                    .bDriveHeadReg = &HB0
                Else
                    .bDriveHeadReg = &HA0
                End If
                .bCommandReg = &HEC
                .bSectorCountReg = 1
                .bSectorNumberReg = 1
            End With
        End With
       
        ' Richiesta al driver
        DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _
                        bin, Len(bin), bout, Len(bout), br, 0
       
        ' Formazione stringa di risposta
        ' da buffer di uscita
        ' L'ordine dei byte e' invertito
        s = ""
        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
       
        ' Chiusura handle
        CloseHandle hdh
     
        ' Restituzione informazione richiesta
        CmnGetHDData = Trim(s)
       
    End Function
     
    --------------------------------------------------------------------------
     
    In the form, place a combobox with values 0,1,2,3 represents Primary Master, Primary Slave,
     
    Secondary Master & Secondary Slave HDDs.
     
    Code is
     
    Dim h As HDSN
     
    Private Sub cmdGo_Click()
     
        Dim hT As Long
        Dim uW() As Byte
        Dim dW() As Byte
        Dim pW() As Byte
       
        Set h = New HDSN
       
        With h
            .CurrentDrive = Val(cbDrive.Text)
           
            lstInfo.Clear
            lstInfo.AddItem "Current drive: " & .CurrentDrive
            lstInfo.AddItem ""
            lstInfo.AddItem "Model number: " & .GetModelNumber
            lstInfo.AddItem "Serial number: " & .GetSerialNumber
            lstInfo.AddItem "Firmware Revision: " & .GetFirmwareRevision
            lstInfo.AddItem ""
            lstInfo.AddItem "Copyright: " & .Copyright
        End With
       
        Set h = Nothing
       
    End Sub
     
    Private Sub Form_Load()
        cbDrive.ListIndex = 0
    End Sub
     
    --------------------------------------------------------------------
    Hope this will help you...
    Thanks
    Wednesday, December 12, 2007 8:30 AM

All replies

  • Upendra Patil,

     

    Use the GetVolumeInformation API function.

     

    Code Snippet

    Private Sub Command1_Click()

        Dim root As String

        Dim volume_name As String

        Dim serial_number As Long

        Dim max_component_length As Long

        Dim file_system_flags As Long

        Dim file_system_name As String

        Dim pos As Integer

     

        root = Text1.Text

        volume_name = Space$(1024)

        file_system_name = Space$(1024)

     

        If GetVolumeInformation(root, volume_name, _

            Len(volume_name), serial_number, _

            max_component_length, file_system_flags, _

            file_system_name, Len(file_system_name)) = 0 _

        Then

            MsgBox("Error getting volume information.")

            Exit Sub

        End If

     

        pos = InStr(volume_name, Chr$(0))

        volume_name = Left$(volume_name, pos - 1)

        lblVolumeName.Caption = volume_name

     

        lblSerialNumber.Caption = Format$(serial_number)

     

        lblMaxComponentLength.Caption = _

            Format$(max_component_length)

     

        pos = InStr(file_system_name, Chr$(0))

        file_system_name = Left$(file_system_name, pos - 1)

        lblFileSystem.Caption = file_system_name

     

        lblFlags.Caption = "&&H" & Hex$(file_system_flags)

    End Sub

     

    Monday, May 21, 2007 3:51 AM
  • Hi Bruno,

     

    I am also interested in this topic. I also want to know how to retrieve using VB-6 the IDE header (hardware header of the HDD added by the manufacturer which includes serial number, model number, etc.) and the MAC address of the LAN adapter. Please help.

     

    Mr patil had asked about the manufacturer's serial number of the HDD. Your code is not the solution because it retrieves only the volume serial number inserted in the boot record by the Format command. Please review Mr patil's query and suggest the correct code.

    Wednesday, November 21, 2007 6:30 PM
  • Hi,
     
    One of best way to configure a tool to run only on a particular machine is using the MANUFACTURER SERIAL NUMBER OF THE HARD DISK, which is unique.
     
    GetVolumeInformation will return ONLY the volume serial number, which keeps changing on format.
     
    Use the following code to retrieve Model Number, Serial Number and Firmware Revision of a hard disk.
     
    Here by I am providing the Class file code & vb file code.
     
    I am pasting the code of the class file opened by notepad here by
    ---------------------------------------------------------------
    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
      Persistable = 0  'NotPersistable
      DataBindingBehavior = 0  'vbNone
      DataSourceBehavior  = 0  'vbNone
      MTSTransactionMode  = 0  'NotAnMTSObject
    END
    Attribute VB_Name = "HDSN"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
    Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
    Option Explicit
     
    ' Antonio Giuliana, 2001-2003
     
    ' Costanti per l'individuazione della versione di OS
    Private Const VER_PLATFORM_WIN32S = 0
    Private Const VER_PLATFORM_WIN32_WINDOWS = 1
    Private Const VER_PLATFORM_WIN32_NT = 2
     
    ' Costanti per la comunicazione con il driver IDE
    Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
     
    ' Costanti per la CreateFile
    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
     
    ' Enumerazione dei comandi per la CmnGetHDData
    Private Enum HDINFO
        HD_MODEL_NUMBER
        HD_SERIAL_NUMBER
        HD_FIRMWARE_REVISION
    End Enum
     
    ' Struttura per l'individuazione della versione di OS
    Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
    End Type
     
    ' Struttura per il campo irDriveRegs della struttura SENDCMDINPARAMS
    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
     
    ' Struttura per l'I/O dei comandi al driver IDE
    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
     
    ' Struttura per il campo DStatus della struttura SENDCMDOUTPARAMS
    Private Type DRIVERSTATUS
        bDriveError As Byte
        bIDEStatus As Byte
        bReserved(1 To 2) As Byte
        dwReserved(1 To 2) As Long
    End Type
     
    ' Struttura per l'I/O dei comandi al driver IDE
    Private Type SENDCMDOUTPARAMS
        cBufferSize As Long
        DStatus As DRIVERSTATUS     ' ovvero DriverStatus
        bBuffer(1 To 512) As Byte
    End Type
     
    ' Per ottenere la versione del SO
    Private Declare Function GetVersionEx _
        Lib "kernel32" Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long
     
    ' Per ottenere un handle al device IDE
    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
     
    ' Per chiudere l'handle del device IDE
    Private Declare Function CloseHandle _
        Lib "kernel32" _
        (ByVal hObject As Long) As Long
     
    ' Per comunicare con il driver IDE
    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
       
    ' Per azzerare buffer di scambio dati
    Private Declare Sub ZeroMemory _
        Lib "kernel32" Alias "RtlZeroMemory" _
        (dest As Any, _
        ByVal numBytes As Long)
     
    ' Per copiare porzioni di memoria
    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 mvarCurrentDrive As Byte    ' Drive corrente
    Private mvarPlatform As String      ' Piattaforma usata
     
    Public Property Get Copyright() As String
       
        ' Copyright
        Copyright = "HDSN Vrs. 1.00, (C) Antonio Giuliana, 2001-2003"
       
    End Property
     
    ' Metodo GetModelNumber
    Public Function GetModelNumber() As String
       
        ' Ottiene il ModelNumber
        GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)
       
    End Function
     
    ' Metodo GetSerialNumber
    Public Function GetSerialNumber() As String
       
        ' Ottiene il SerialNumber
        GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)
       
    End Function
     
    ' Metodo GetFirmwareRevision
    Public Function GetFirmwareRevision() As String
       
        ' Ottiene la FirmwareRevision
        GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION)
       
    End Function
     
    ' Proprieta' CurrentDrive
    Public Property Let CurrentDrive(ByVal vData As Byte)
       
        ' Controllo numero di drive fisico IDE
        If vData < 0 Or vData > 3 Then
            Err.Raise 10000, , "Illegal drive number"   ' IDE drive 0..3
        End If
       
        ' Nuovo drive da considerare
        mvarCurrentDrive = vData
     
    End Property
     
    ' Proprieta' CurrentDrive
    Public Property Get CurrentDrive() As Byte
       
        ' Restituisce drive fisico corrente (IDE 0..3)
        CurrentDrive = mvarCurrentDrive
     
    End Property
     
    ' Proprieta' Platform
    Public Property Get Platform() As String
       
        ' Restituisce tipo OS
        Platform = mvarPlatform
     
    End Property
     
    Private Sub Class_Initialize()
     
        ' Individuazione del tipo di OS
        Dim OS As OSVERSIONINFO
           
        OS.dwOSVersionInfoSize = Len(OS)
        Call GetVersionEx(OS)
        mvarPlatform = "Unk"
        Select Case OS.dwPlatformId
            Case Is = VER_PLATFORM_WIN32S
                mvarPlatform = "32S"                ' Win32S
            Case Is = VER_PLATFORM_WIN32_WINDOWS
                If OS.dwMinorVersion = 0 Then
                    mvarPlatform = "W95"            ' Win 95
                Else
                    mvarPlatform = "W98"            ' Win 98
                End If
            Case Is = VER_PLATFORM_WIN32_NT
                mvarPlatform = "WNT"                ' Win NT/2000
        End Select
     
    End Sub
     
    Private Function CmnGetHDData(hdi As HDINFO) As String
     
        ' Rilevazione proprieta' IDE
       
        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             ' Selezione tipo caratteristica richiesta
            Case HD_MODEL_NUMBER
                hddfr = 55          ' Posizione nel buffer del ModelNumber
                hddln = 40          ' Lunghezza nel buffer del ModelNumber
            Case HD_SERIAL_NUMBER
                hddfr = 21          ' Posizione nel buffer del SerialNumber
                hddln = 20          ' Lunghezza nel buffer del SerialNumber
            Case HD_FIRMWARE_REVISION
                hddfr = 47          ' Posizione nel buffer del FirmwareRevision
                hddln = 8           ' Lunghezza nel buffer del FirmwareRevision
            Case Else
                Err.Raise 10001, "Illegal HD Data type" ' Altre informazioni non disponibili
     
    (Evoluzione futura)
        End Select
       
        Select Case mvarPlatform
            Case "WNT"
                ' Per Win NT/2000 apertura handle al drive fisico
                hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _
                    GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _
                    0, OPEN_EXISTING, 0, 0)
            Case "W95", "W98"
                ' Per Win 9X apertura handle al driver SMART
                ' (in \WINDOWS\SYSTEM da spostare in \WINDOWS\SYSTEM\IOSUBSYS)
                ' che comunica con il driver IDE
                hdh = CreateFile("\\.\Smartvsd", _
                    0, 0, 0, CREATE_NEW, 0, 0)
            Case Else
                ' Piattaforma non supportata (Win32S)
                Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)"    ' Altre piattaforme
     
    non gestite
        End Select
        ' Controllo validità handle
        If hdh = 0 Then
            Err.Raise 10003, , "Error on CreateFile"
        End If
       
        ' Azzeramento strutture per l'I/O da driver
        ZeroMemory bin, Len(bin)
        ZeroMemory bout, Len(bout)
       
        ' Preparazione parametri struttura di richiesta al driver
        With bin
            .bDriveNumber = mvarCurrentDrive
            .cBufferSize = 512
            With .irDriveRegs
                If (mvarCurrentDrive And 1) Then
                    .bDriveHeadReg = &HB0
                Else
                    .bDriveHeadReg = &HA0
                End If
                .bCommandReg = &HEC
                .bSectorCountReg = 1
                .bSectorNumberReg = 1
            End With
        End With
       
        ' Richiesta al driver
        DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _
                        bin, Len(bin), bout, Len(bout), br, 0
       
        ' Formazione stringa di risposta
        ' da buffer di uscita
        ' L'ordine dei byte e' invertito
        s = ""
        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
       
        ' Chiusura handle
        CloseHandle hdh
     
        ' Restituzione informazione richiesta
        CmnGetHDData = Trim(s)
       
    End Function
     
    --------------------------------------------------------------------------
     
    In the form, place a combobox with values 0,1,2,3 represents Primary Master, Primary Slave,
     
    Secondary Master & Secondary Slave HDDs.
     
    Code is
     
    Dim h As HDSN
     
    Private Sub cmdGo_Click()
     
        Dim hT As Long
        Dim uW() As Byte
        Dim dW() As Byte
        Dim pW() As Byte
       
        Set h = New HDSN
       
        With h
            .CurrentDrive = Val(cbDrive.Text)
           
            lstInfo.Clear
            lstInfo.AddItem "Current drive: " & .CurrentDrive
            lstInfo.AddItem ""
            lstInfo.AddItem "Model number: " & .GetModelNumber
            lstInfo.AddItem "Serial number: " & .GetSerialNumber
            lstInfo.AddItem "Firmware Revision: " & .GetFirmwareRevision
            lstInfo.AddItem ""
            lstInfo.AddItem "Copyright: " & .Copyright
        End With
       
        Set h = Nothing
       
    End Sub
     
    Private Sub Form_Load()
        cbDrive.ListIndex = 0
    End Sub
     
    --------------------------------------------------------------------
    Hope this will help you...
    Thanks
    Wednesday, December 12, 2007 8:30 AM
  •  

    Rajkumar,

     

    Thanks for the code that you provided. Does this code reliably works on Vista?

     

    Thanks,

    Oren

     

    Saturday, February 02, 2008 5:22 AM
  •  

    Hi Tirosh,

     

    I am not sure whether this code will work on Vista. If you have any, plz share.

     

    Thanks

    Raj

    Wednesday, February 06, 2008 2:58 PM
  • An ActiveX COM DLL to retrieve hard drive serial number : http://www.diskserialnumber.com

    Monday, February 25, 2008 9:49 PM
  • Hi Guys,

     

    This code is great, even on Vista, after playing around a bit.

     

    The quick answer: either right-click the program and choose to run it as administrator, or try within softwaer to obtain administrative permissions.  Otherwise, it won't work on vista.

     

      I played around for a while with this on a Windows Vista Business Edition machine.  It seemed to be the best way out of any code I found to get a hard drive serial number with any other operating system, but Vista just wasn't working.  After dissecting it a little bit, I looked into the CreateFile function that is used to get a handle of the hard drive.  See this page for more information: http://msdn2.microsoft.com/en-us/library/aa363858(VS.85).aspx.  there is a statement on this page that says, "The caller must have administrative privileges."  So I tried right-clicking my app, and this time it got what I needed!  Now I'll just need to research a way through the User Account Control permissions for Vista.

    Saturday, March 08, 2008 2:37 AM
  • Please take a look at DiskId32 at  http://www.winsim.com/diskid32/diskid32.html .
    The source code is there also for retrieving the hard drive serial number
    under Windows (2K, XP or Vista).

    Lynn



    Wednesday, June 18, 2008 3:50 PM
  • Could you please convert the code to VB.NET? This is very cool, since there was a VC++ code just like this and it was MESSY! I'm a VB6 veteran but don't have the time to try to convert this into VB.NET.
    It will be very cool if you can convert this code to .NET.
    Saturday, November 08, 2008 2:48 PM
  • Is there any way to find the serial number of harddisk which is parmanent and don't get change after formatting ??

    --
    upen

    i do not understand with you; text1.text ?
    Tuesday, April 27, 2010 3:07 AM
  • Hello

    I put this code in a module but it just turns to red text...

    [code]

    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
      Persistable = 0  'NotPersistable
      DataBindingBehavior = 0  'vbNone
      DataSourceBehavior  = 0  'vbNone
      MTSTransactionMode  = 0  'NotAnMTSObject
    END
    Attribute VB_Name = "HDSN"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
    Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
    Option Explicit

    [/code]

    is there a difference of putting it in a module vs a class module?

    Friday, August 13, 2010 1:22 PM
  • Mr. Raj, This requires Admin Previlleges and will not work in user login mode.  I have workd more professionally than this such as;

    We assume that u have compiled and registered and added HDSNLab.dll to the project by using the refrences dialog box. 

    Private Sub Form_Load()

    Set h = New HDSNLib.HDSN
    With h
        Dim hdSno As String
        hdSno = .GetSerialNumber
        hdSno = Trim(hdSno)
        Dim myHddSno1, myHddSno2, myHddSno3, myHddSno4, myHddSno5, myHddSno6, _
        myHddSno7, myHddSno8, myHddSno9, myHddSno10, myHddSno11, myHddSno12 As String
        myHddSno1 = "WD-WCAP9C544909" 'Arish
        myHddSno2 = "5QZ1QT9S" 'Mujahid
        myHddSno3 = "3EXM03KZ" 'Ashfaq
        myHddSno4 = "5LA1RJ01" 'FGS
        myHddSno5 = "5JVVYQ0S" 'PMS (Mehro Nissa)
        myHddSno6 = "WD-WMA6R4227612" 'RMS (Imran)
        myHddSno7 = "WD-WMAM9JH13438" 'Q.C
        myHddSno8 = "5MA122NT" 'Yasir
        myHddSno9 = "902LC292T" 'Mine
        myHddSno10 = "5LALP54P" 'Miss Mehak
        myHddSno11 = "6FB0A1M1" 'Miss Nadia
        myHddSno12 = "K64LT8B2E3HH" 'Fahad Laptop
        If Trim(hdSno) = myHddSno1 Or Trim(hdSno) = myHddSno2 Or Trim(hdSno) = myHddSno3 Or Trim(hdSno) = myHddSno4 Or _
            Trim(hdSno) = myHddSno5 Or Trim(hdSno) = myHddSno6 Or Trim(hdSno) = myHddSno7 Or _
            Trim(hdSno) = myHddSno8 Or Trim(hdSno) = myHddSno9 Or Trim(hdSno) = myHddSno10 Or _
            Trim(hdSno) = myHddSno11 Or Trim(hdSno) = myHddSno12 Then
            Call MC.OpenCn("Provider=msdasql;dsn=Financial & Management System")
            StatusBar1.Panels(1) = "Welcome " & MC.curUserName
            StatusBar1.Font.Bold = True
        Else
            MsgBox "Application is not registered on this machine" & vbCrLf & _
                "To get registered, please call Mr. Afridi as '+92-3339176357'", vbInformation, "Registration Requires"
            End
        End If
    End With
    Set h = Nothing

    End Sub

    But remember Raj, we are still fighting how to develope a source code that will retrieve hdd firmware number in user loging mode not with admin previlleges. Believe it i rewarded the user to that folder with full control to use this assembly/dll but still failed to retrieve hdd firmware number. Becasue we don't let the user to login as Admin or with Admin previlleges and if we don't, then u cannot execute this code on the client machine/user machine. Mean WMI (Windows Management Instrumentation) calling Requires totally Admin previlleges which leads to a dark side implementation. If you do so, then you are compelled to let him or her login as admin!!!!!!!!!!

    But we are looking forward and hope to find quick response

    Mr. Afridi (MCP.net, MCAD.net, MCSD.net, MCPD.net)

    Tuesday, January 11, 2011 5:19 PM
  • Its csharp but vb.net is also maching and very few diffrences are there:

    using System;
    using System.Collections;
    using System.Management;

    namespace mHddSerial
    {
     class HardDrive
     {
      private string model = null;
      private string type = null;
      private string serialNo = null;

      public string Model
      {
       get {return model;}
       set {model = value;}
      }

      public string Type
      {
       get {return type;}
       set {type = value;}
      }

      public string SerialNo
      {
       get {return serialNo;}
       set {serialNo = value;}
      }
     }

     class TestProgram
     {
      /// <summary>
      /// The main entry point for the application.
      /// </summary>
      [STAThread]
      static void Main(string[] args)
      {
       ArrayList hdCollection = new ArrayList();

                ManagementObjectSearcher searcher = new
                    ManagementObjectSearcher("SELECT * FROM Win32_PhysicalMedia");
                string hD_SerialNo = null;
                foreach (ManagementObject wmi_HD in searcher.Get())
                {
                    // get the hard drive from collection
                    // using index
                    //HardDrive hd = (HardDrive)hdCollection[i];
                    HardDrive hd = new HardDrive();
                    // get the hardware serial no.
                    if (wmi_HD["SerialNumber"] == null)
                        //hd.SerialNo = "None";
                        hd.SerialNo = hD_SerialNo.ToString() ;
                    else
                        hd.SerialNo = wmi_HD["SerialNumber"].ToString();
                    hD_SerialNo = hd.SerialNo.ToString() ;
                    Console.WriteLine(hd.SerialNo);

                }           

       // Display available hard drives
               Console.WriteLine();
       // Pause application
       Console.WriteLine("Press [Enter] to exit...");
       Console.ReadLine();
      }
     }
    }

    Tuesday, January 11, 2011 5:31 PM
  • Where i put this part of the code? reply pls..

     

    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
      Persistable = 0  'NotPersistable
      DataBindingBehavior = 0  'vbNone
      DataSourceBehavior  = 0  'vbNone
      MTSTransactionMode  = 0  'NotAnMTSObject
    END
    Attribute VB_Name = "HDSN"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
    Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

    Thursday, February 10, 2011 12:49 AM
  • where i put this part of the code?

    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
      Persistable = 0  'NotPersistable
      DataBindingBehavior = 0  'vbNone
      DataSourceBehavior  = 0  'vbNone
      MTSTransactionMode  = 0  'NotAnMTSObject
    END
    Attribute VB_Name = "HDSN"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
    Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

    Thursday, February 10, 2011 12:51 AM
  • This works only for Volume Serial Number not for Serial Number manufacturer
    Sunday, February 20, 2011 8:49 PM
  • This works fine for IDE Drives, what about USB Drives?
    Sunday, February 20, 2011 8:50 PM
  • There are 2 samples. Very easy!

     

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set DC = fso.Drives
    s = ""
    For Each OBJDR In DC
      If OBJDR.DriveType = 2 Then
       If OBJDR.DriveLetter = "C" Then
        SR = OBJDR.serialnumber
        SRNom = Hex(SR)
       End If
      End If
    Next

    ===========

    Dim fso, objDrive, s
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objDrive = fso.GetDrive("C:")
    s = "SN: " & objDrive.SerialNumber
    MsgBox s

    ==================

    Saturday, April 23, 2011 8:14 AM
  • There are 2 samples. Very easy!

     

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set DC = fso.Drives
    s = ""
    For Each OBJDR In DC
      If OBJDR.DriveType = 2 Then
       If OBJDR.DriveLetter = "C" Then
        SR = OBJDR.serialnumber
        SRNom = Hex(SR)
       End If
      End If
    Next

    ===========

    Dim fso, objDrive, s
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objDrive = fso.GetDrive("C:")
    s = "SN: " & objDrive.SerialNumber
    MsgBox s

    ==================

    s = "SN: " & Hex(objDrive.SerialNumber)


    Thursday, May 26, 2011 8:46 AM
  • 'PLEASE SEE ALL COMMENTS HERE, THERE ARE TWO MODULES PASTED HERE AND CODE FOR YOUR 'FORM FOR CALLING THESE FUNCTIONS

     

     

    Make a first module as"mSMARTDef" and past this code in it

    Public Const MAX_IDE_DRIVES = 4         ' // Max number of drives assuming primary/secondary, master/slave topology
    Public Const READ_ATTRIBUTE_BUFFER_SIZE = 512
    Public Const IDENTIFY_BUFFER_SIZE = 512
    Public Const READ_THRESHOLD_BUFFER_SIZE = 512
    Public Const OUTPUT_DATA_SIZE = IDENTIFY_BUFFER_SIZE + 16

    'IOCTL commands
    Public Const DFP_GET_VERSION = &H74080
    Public Const DFP_SEND_DRIVE_COMMAND = &H7C084
    Public Const DFP_RECEIVE_DRIVE_DATA = &H7C088

    '---------------------------------------------------------------------
    ' GETVERSIONOUTPARAMS contains the data returned from the
    ' Get Driver Version function.
    '---------------------------------------------------------------------
    Public Type GETVERSIONOUTPARAMS
           bVersion       As Byte ' Binary driver version.
           bRevision      As Byte ' Binary driver revision.
           bReserved      As Byte ' Not used.
           bIDEDeviceMap  As Byte ' Bit map of IDE devices.
           fCapabilities  As Long ' Bit mask of driver capabilities.
           dwReserved(3)  As Long ' For future use.
    End Type

    'Bits returned in the fCapabilities member of GETVERSIONOUTPARAMS
    Public Const CAP_IDE_ID_FUNCTION = 1             ' ATA ID command supported
    Public Const CAP_IDE_ATAPI_ID = 2                ' ATAPI ID command supported
    Public Const CAP_IDE_EXECUTE_SMART_FUNCTION = 4  ' SMART commannds supported

    '---------------------------------------------------------------------
    ' IDE registers
    '---------------------------------------------------------------------
    Public Type IDEREGS
       bFeaturesReg     As Byte ' // Used for specifying SMART "commands".
       bSectorCountReg  As Byte ' // IDE sector count register
       bSectorNumberReg As Byte ' // IDE sector number register
       bCylLowReg       As Byte ' // IDE low order cylinder value
       bCylHighReg      As Byte ' // IDE high order cylinder value
       bDriveHeadReg    As Byte ' // IDE drive/head register
       bCommandReg      As Byte ' // Actual IDE command.
       bReserved        As Byte ' // reserved for future use.  Must be zero.
    End Type

    '---------------------------------------------------------------------
    ' SENDCMDINPARAMS contains the input parameters for the
    ' Send Command to Drive function.
    '---------------------------------------------------------------------
    Public Type SENDCMDINPARAMS
       cBufferSize     As Long     ' Buffer size in bytes
       irDriveRegs     As IDEREGS  ' Structure with drive register values.
       bDriveNumber    As Byte     ' Physical drive number to send command to (0,1,2,3).
       bReserved(2)    As Byte     ' Bytes reserved
       dwReserved(3)   As Long     ' DWORDS reserved
       bBuffer()      As Byte      ' Input buffer.
    End Type

    ' Valid values for the bCommandReg member of IDEREGS.
    Public Const IDE_ATAPI_ID = &HA1               ' Returns ID sector for ATAPI.
    Public Const IDE_ID_FUNCTION = &HEC            ' Returns ID sector for ATA.
    Public Const IDE_EXECUTE_SMART_FUNCTION = &HB0 ' Performs SMART cmd.
                                                   ' Requires valid bFeaturesReg,
                                                   ' bCylLowReg, and bCylHighReg

    ' Cylinder register values required when issuing SMART command
    Public Const SMART_CYL_LOW = &H4F
    Public Const SMART_CYL_HI = &HC2

    '---------------------------------------------------------------------
    ' Status returned from driver
    '---------------------------------------------------------------------
    Public Type DRIVERSTATUS
       bDriverError  As Byte          ' Error code from driver, or 0 if no error.
       bIDEStatus    As Byte          ' Contents of IDE Error register.
                                      ' Only valid when bDriverError is SMART_IDE_ERROR.
       bReserved(1)  As Byte
       dwReserved(1) As Long
     End Type

    ' bDriverError values
    Public Enum DRIVER_ERRORS
           SMART_NO_ERROR = 0         ' No error
           SMART_IDE_ERROR = 1        ' Error from IDE controller
           SMART_INVALID_FLAG = 2     ' Invalid command flag
           SMART_INVALID_COMMAND = 3  ' Invalid command byte
           SMART_INVALID_BUFFER = 4   ' Bad buffer (null, invalid addr..)
           SMART_INVALID_DRIVE = 5    ' Drive number not valid
           SMART_INVALID_IOCTL = 6    ' Invalid IOCTL
           SMART_ERROR_NO_MEM = 7     ' Could not lock user's buffer
           SMART_INVALID_REGISTER = 8 ' Some IDE Register not valid
           SMART_NOT_SUPPORTED = 9    ' Invalid cmd flag set
           SMART_NO_IDE_DEVICE = 10   ' Cmd issued to device not present
                                      ' although drive number is valid
           ' 11-255 reserved
    End Enum
    '---------------------------------------------------------------------
    ' The following struct defines the interesting part of the IDENTIFY
    ' buffer:
    '---------------------------------------------------------------------
    Public Type IDSECTOR
       wGenConfig                 As Integer
       wNumCyls                   As Integer
       wReserved                  As Integer
       wNumHeads                  As Integer
       wBytesPerTrack             As Integer
       wBytesPerSector            As Integer
       wSectorsPerTrack           As Integer
       wVendorUnique(2)           As Integer
       sSerialNumber(19)          As Byte
       wBufferType                As Integer
       wBufferSize                As Integer
       wECCSize                   As Integer
       sFirmwareRev(7)            As Byte
       sModelNumber(39)           As Byte
       wMoreVendorUnique          As Integer
       wDoubleWordIO              As Integer
       wCapabilities              As Integer
       wReserved1                 As Integer
       wPIOTiming                 As Integer
       wDMATiming                 As Integer
       wBS                        As Integer
       wNumCurrentCyls            As Integer
       wNumCurrentHeads           As Integer
       wNumCurrentSectorsPerTrack As Integer
       ulCurrentSectorCapacity    As Long
       wMultSectorStuff           As Integer
       ulTotalAddressableSectors  As Long
       wSingleWordDMA             As Integer
       wMultiWordDMA              As Integer
       bReserved(127)             As Byte
    End Type

    '---------------------------------------------------------------------
    ' Structure returned by SMART IOCTL for several commands
    '---------------------------------------------------------------------
    Public Type SENDCMDOUTPARAMS
      cBufferSize   As Long         ' Size of bBuffer in bytes (IDENTIFY_BUFFER_SIZE in our case)
      DRIVERSTATUS  As DRIVERSTATUS ' Driver status structure.
      bBuffer()    As Byte          ' Buffer of arbitrary length in which to store the data read from the drive.
    End Type

    '---------------------------------------------------------------------
    ' Feature register defines for SMART "sub commands"
    '---------------------------------------------------------------------

    Public Const SMART_READ_ATTRIBUTE_VALUES = &HD0
    Public Const SMART_READ_ATTRIBUTE_THRESHOLDS = &HD1
    Public Const SMART_ENABLE_DISABLE_ATTRIBUTE_AUTOSAVE = &HD2
    Public Const SMART_SAVE_ATTRIBUTE_VALUES = &HD3
    Public Const SMART_EXECUTE_OFFLINE_IMMEDIATE = &HD4
    ' Vendor specific commands:
    Public Const SMART_ENABLE_SMART_OPERATIONS = &HD8
    Public Const SMART_DISABLE_SMART_OPERATIONS = &HD9
    Public Const SMART_RETURN_SMART_STATUS = &HDA

    '---------------------------------------------------------------------
    ' The following structure defines the structure of a Drive Attribute
    '---------------------------------------------------------------------

    Public Const NUM_ATTRIBUTE_STRUCTS = 30

    Public Type DRIVEATTRIBUTE
           bAttrID As Byte         ' Identifies which attribute
           wStatusFlags As Integer 'Integer ' see bit definitions below
           bAttrValue As Byte      ' Current normalized value
           bWorstValue As Byte     ' How bad has it ever been?
           bRawValue(5) As Byte    ' Un-normalized value
           bReserved As Byte       ' ...
    End Type
    '---------------------------------------------------------------------
    ' Status Flags Values
    '---------------------------------------------------------------------
    Public Enum STATUS_FLAGS
           PRE_FAILURE_WARRANTY = &H1
           ON_LINE_COLLECTION = &H2
           PERFORMANCE_ATTRIBUTE = &H4
           ERROR_RATE_ATTRIBUTE = &H8
           EVENT_COUNT_ATTRIBUTE = &H10
           SELF_PRESERVING_ATTRIBUTE = &H20
    End Enum

    '---------------------------------------------------------------------
    ' The following structure defines the structure of a Warranty Threshold
    ' Obsoleted in ATA4!
    '---------------------------------------------------------------------

    Public Type ATTRTHRESHOLD
           bAttrID As Byte            ' Identifies which attribute
           bWarrantyThreshold As Byte ' Triggering value
           bReserved(9) As Byte       ' ...
    End Type

    '---------------------------------------------------------------------
    ' Valid Attribute IDs
    '---------------------------------------------------------------------
    Public Enum ATTRIBUTE_ID
           ATTR_INVALID = 0
           ATTR_READ_ERROR_RATE = 1
           ATTR_THROUGHPUT_PERF = 2
           ATTR_SPIN_UP_TIME = 3
           ATTR_START_STOP_COUNT = 4
           ATTR_REALLOC_SECTOR_COUNT = 5
           ATTR_READ_CHANNEL_MARGIN = 6
           ATTR_SEEK_ERROR_RATE = 7
           ATTR_SEEK_TIME_PERF = 8
           ATTR_POWER_ON_HRS_COUNT = 9
           ATTR_SPIN_RETRY_COUNT = 10
           ATTR_CALIBRATION_RETRY_COUNT = 11
           ATTR_POWER_CYCLE_COUNT = 12
           ATTR_SOFT_READ_ERROR_RATE = 13
           ATTR_G_SENSE_ERROR_RATE = 191
           ATTR_POWER_OFF_RETRACT_CYCLE = 192
           ATTR_LOAD_UNLOAD_CYCLE_COUNT = 193
           ATTR_TEMPERATURE = 194
           ATTR_REALLOCATION_EVENTS_COUNT = 196
           ATTR_CURRENT_PENDING_SECTOR_COUNT = 197
           ATTR_UNCORRECTABLE_SECTOR_COUNT = 198
           ATTR_ULTRADMA_CRC_ERROR_RATE = 199
           ATTR_WRITE_ERROR_RATE = 200
           ATTR_DISK_SHIFT = 220
           ATTR_G_SENSE_ERROR_RATEII = 221
           ATTR_LOADED_HOURS = 222
           ATTR_LOAD_UNLOAD_RETRY_COUNT = 223
           ATTR_LOAD_FRICTION = 224
           ATTR_LOAD_UNLOAD_CYCLE_COUNTII = 225
           ATTR_LOAD_IN_TIME = 226
           ATTR_TORQUE_AMPLIFICATION_COUNT = 227
           ATTR_POWER_OFF_RETRACT_COUNT = 228
           ATTR_GMR_HEAD_AMPLITUDE = 230
           ATTR_TEMPERATUREII = 231
           ATTR_READ_ERROR_RETRY_RATE = 250
    End Enum

    '============================================================

     

     

    Make a second module as "mSMARTCall" and past a code in it

    Option Explicit

    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 Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long

    Private Type ATTR_DATA
        AttrID As Byte
        AttrName As String
        AttrValue As Byte
        ThresholdValue As Byte
        WorstValue As Byte
        StatusFlags As STATUS_FLAGS
    End Type

    Public Type DRIVE_INFO
        bDriveType As Byte
        SerialNumber As String
        Model As String
        FirmWare As String
        Cilinders As Long
        Heads As Long
        SecPerTrack As Long
        BytesPerSector As Long
        BytesperTrack As Long
        NumAttributes As Byte
        Attributes() As ATTR_DATA
    End Type

    Public Enum IDE_DRIVE_NUMBER
        PRIMARY_MASTER
        PRIMARY_SLAVE
        SECONDARY_MASTER
        SECONDARY_SLAVE
    End Enum

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

    Private Const GENERIC_READ = &H80000000
    Private Const GENERIC_WRITE = &H40000000

    Private Const FILE_SHARE_READ = &H1
    Private Const FILE_SHARE_WRITE = &H2
    Private Const OPEN_EXISTING = 3
    Private Const FILE_ATTRIBUTE_SYSTEM = &H4
    Private Const CREATE_NEW = 1

    Private Const INVALID_HANDLE_VALUE = -1
    Dim di As DRIVE_INFO
    Dim colAttrNames As Collection
    '***************************************************************************
    ' Open SMART to allow DeviceIoControl communications. Return SMART handle
    '***************************************************************************
    Private Function OpenSmart(drv_num As IDE_DRIVE_NUMBER) As Long
       If IsWindowsNT Then
          OpenSmart = CreateFile("\\.\PhysicalDrive" & CStr(drv_num), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
       Else
          OpenSmart = CreateFile("\\.\SMARTVSD", 0, 0, ByVal 0&, CREATE_NEW, 0, 0)
       End If
    End Function

    '****************************************************************************
    ' CheckSMARTEnable - Check if SMART enable
    ' FUNCTION: Send a SMART_ENABLE_SMART_OPERATIONS command to the drive
    ' bDriveNum = 0-3
    '***************************************************************************}
    Private Function CheckSMARTEnable(ByVal hDrive As Long, DriveNum As IDE_DRIVE_NUMBER) As Boolean
       'Set up data structures for Enable SMART Command.
       Dim SCIP As SENDCMDINPARAMS
       Dim SCOP As SENDCMDOUTPARAMS
       Dim lpcbBytesReturned As Long
       With SCIP
           .cBufferSize = 0
           With .irDriveRegs
                .bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
                .bSectorCountReg = 1
                .bSectorNumberReg = 1
                .bCylLowReg = SMART_CYL_LOW
                .bCylHighReg = SMART_CYL_HI
       'Compute the drive number.
                .bDriveHeadReg = &HA0 ' Or (DriveNum And 1) * 16
                .bCommandReg = IDE_EXECUTE_SMART_FUNCTION
            End With
            .bDriveNumber = DriveNum
       End With
       CheckSMARTEnable = DeviceIoControl(hDrive, DFP_SEND_DRIVE_COMMAND, SCIP, Len(SCIP) - 4, SCOP, Len(SCOP) - 4, lpcbBytesReturned, ByVal 0&)
    End Function

    '****************************************************************************
    ' DoIdentify
    ' Function: Send an IDENTIFY command to the drive
    ' DriveNum = 0-3
    ' IDCmd = IDE_ID_FUNCTION or IDE_ATAPI_ID
    '*****************************************************************************

    Private Function IdentifyDrive(ByVal hDrive As Long, ByVal IDCmd As Byte, ByVal DriveNum As IDE_DRIVE_NUMBER) As Boolean
        Dim SCIP As SENDCMDINPARAMS
        Dim IDSEC As IDSECTOR
        Dim bArrOut(OUTPUT_DATA_SIZE - 1) As Byte
        Dim sMsg As String
        Dim lpcbBytesReturned As Long
        Dim barrfound(100) As Long
        Dim i As Long
        Dim lng As Long
    '   Set up data structures for IDENTIFY command.
        With SCIP
            .cBufferSize = IDENTIFY_BUFFER_SIZE
            .bDriveNumber = CByte(DriveNum)
            With .irDriveRegs
                 .bFeaturesReg = 0
                 .bSectorCountReg = 1
                 .bSectorNumberReg = 1
                 .bCylLowReg = 0
                 .bCylHighReg = 0
    ' Compute the drive number.
                 .bDriveHeadReg = &HA0
                 If Not IsWindowsNT Then .bDriveHeadReg = .bDriveHeadReg Or (DriveNum And 1) * 16
    ' The command can either be IDE identify or ATAPI identify.
                 .bCommandReg = CByte(IDCmd)
            End With
        End With
        If DeviceIoControl(hDrive, DFP_RECEIVE_DRIVE_DATA, SCIP, Len(SCIP) - 4, bArrOut(0), OUTPUT_DATA_SIZE, lpcbBytesReturned, ByVal 0&) Then
           IdentifyDrive = True
           CopyMemory IDSEC, bArrOut(16), Len(IDSEC)
           di.Model = SwapStringBytes(StrConv(IDSEC.sModelNumber, vbUnicode))
           di.FirmWare = SwapStringBytes(StrConv(IDSEC.sFirmwareRev, vbUnicode))
           di.SerialNumber = SwapStringBytes(StrConv(IDSEC.sSerialNumber, vbUnicode))
           di.Cilinders = IDSEC.wNumCyls
           di.Heads = IDSEC.wNumHeads
           di.SecPerTrack = IDSEC.wSectorsPerTrack
        End If
    End Function

    '****************************************************************************
    ' ReadAttributesCmd
    ' FUNCTION: Send a SMART_READ_ATTRIBUTE_VALUES command to the drive
    ' bDriveNum = 0-3
    '***************************************************************************}
    Private Function ReadAttributesCmd(ByVal hDrive As Long, DriveNum As IDE_DRIVE_NUMBER) As Boolean
       Dim cbBytesReturned As Long
       Dim SCIP As SENDCMDINPARAMS
       Dim drv_attr As DRIVEATTRIBUTE
       Dim bArrOut(OUTPUT_DATA_SIZE - 1) As Byte
       Dim sMsg As String
       Dim i As Long
       With SCIP
     ' Set up data structures for Read Attributes SMART Command.
           .cBufferSize = READ_ATTRIBUTE_BUFFER_SIZE
           .bDriveNumber = DriveNum
           With .irDriveRegs
                .bFeaturesReg = SMART_READ_ATTRIBUTE_VALUES
                .bSectorCountReg = 1
                .bSectorNumberReg = 1
                .bCylLowReg = SMART_CYL_LOW
                .bCylHighReg = SMART_CYL_HI
    '  Compute the drive number.
                .bDriveHeadReg = &HA0
                If Not IsWindowsNT Then .bDriveHeadReg = .bDriveHeadReg Or (DriveNum And 1) * 16
                .bCommandReg = IDE_EXECUTE_SMART_FUNCTION
           End With
      End With
      ReadAttributesCmd = DeviceIoControl(hDrive, DFP_RECEIVE_DRIVE_DATA, SCIP, Len(SCIP) - 4, bArrOut(0), OUTPUT_DATA_SIZE, cbBytesReturned, ByVal 0&)
      On Error Resume Next
      For i = 0 To NUM_ATTRIBUTE_STRUCTS - 1
          If bArrOut(18 + i * 12) > 0 Then
             di.Attributes(di.NumAttributes).AttrID = bArrOut(18 + i * 12)
             di.Attributes(di.NumAttributes).AttrName = "Unknown value (" & bArrOut(18 + i * 12) & ")"
             di.Attributes(di.NumAttributes).AttrName = colAttrNames(CStr(bArrOut(18 + i * 12)))
             di.NumAttributes = di.NumAttributes + 1
             ReDim Preserve di.Attributes(di.NumAttributes)
             CopyMemory di.Attributes(di.NumAttributes).StatusFlags, bArrOut(19 + i * 12), 2
             di.Attributes(di.NumAttributes).AttrValue = bArrOut(21 + i * 12)
             di.Attributes(di.NumAttributes).WorstValue = bArrOut(22 + i * 12)
          End If
      Next i
    End Function

    Private Function ReadThresholdsCmd(ByVal hDrive As Long, DriveNum As IDE_DRIVE_NUMBER) As Boolean
       Dim cbBytesReturned As Long
       Dim SCIP As SENDCMDINPARAMS
       Dim IDSEC As IDSECTOR
       Dim bArrOut(OUTPUT_DATA_SIZE - 1) As Byte
       Dim sMsg As String
       Dim thr_attr As ATTRTHRESHOLD
       Dim i As Long, J As Long
       With SCIP
     ' Set up data structures for Read Attributes SMART Command.
           .cBufferSize = READ_THRESHOLD_BUFFER_SIZE
           .bDriveNumber = DriveNum
           With .irDriveRegs
                .bFeaturesReg = SMART_READ_ATTRIBUTE_THRESHOLDS
                .bSectorCountReg = 1
                .bSectorNumberReg = 1
                .bCylLowReg = SMART_CYL_LOW
                .bCylHighReg = SMART_CYL_HI
    '  Compute the drive number.
                .bDriveHeadReg = &HA0
                If Not IsWindowsNT Then .bDriveHeadReg = .bDriveHeadReg Or (DriveNum And 1) * 16
                .bCommandReg = IDE_EXECUTE_SMART_FUNCTION
           End With
      End With
      ReadThresholdsCmd = DeviceIoControl(hDrive, DFP_RECEIVE_DRIVE_DATA, SCIP, Len(SCIP) - 4, bArrOut(0), OUTPUT_DATA_SIZE, cbBytesReturned, ByVal 0&)
      For i = 0 To NUM_ATTRIBUTE_STRUCTS - 1
          CopyMemory thr_attr, bArrOut(18 + i * Len(thr_attr)), Len(thr_attr)
          If thr_attr.bAttrID > 0 Then
             For J = 0 To UBound(di.Attributes)
                 If thr_attr.bAttrID = di.Attributes(J).AttrID Then
                    di.Attributes(J).ThresholdValue = thr_attr.bWarrantyThreshold
                    Exit For
                 End If
             Next J
          End If
      Next i
    End Function

    Private Function GetSmartVersion(ByVal hDrive As Long, VersionParams As GETVERSIONOUTPARAMS) As Boolean
       Dim cbBytesReturned As Long
       GetSmartVersion = DeviceIoControl(hDrive, DFP_GET_VERSION, ByVal 0&, 0, VersionParams, Len(VersionParams), cbBytesReturned, ByVal 0&)
    End Function

    Public Function GetDriveInfo(DriveNum As IDE_DRIVE_NUMBER) As DRIVE_INFO
        Dim hDrive As Long
        Dim VerParam As GETVERSIONOUTPARAMS
        Dim cb As Long
        di.bDriveType = 0
        di.NumAttributes = 0
        ReDim di.Attributes(0)
        hDrive = OpenSmart(DriveNum)
        If hDrive = INVALID_HANDLE_VALUE Then Exit Function
        If Not GetSmartVersion(hDrive, VerParam) Then Exit Function
        'for Others Computer Now salman also
        If Not IsBitSet(VerParam.bIDEDeviceMap, DriveNum) Then Exit Function
        'For Zeshan Office Computer
    '    If IsBitSet(VerParam.bIDEDeviceMap, DriveNum) Then Exit Function
        di.bDriveType = 1 + Abs(IsBitSet(VerParam.bIDEDeviceMap, DriveNum + 4))
        If Not CheckSMARTEnable(hDrive, DriveNum) Then Exit Function
        FillAttrNameCollection
        Call IdentifyDrive(hDrive, IDE_ID_FUNCTION, DriveNum)
        Call ReadAttributesCmd(hDrive, DriveNum)
        Call ReadThresholdsCmd(hDrive, DriveNum)
        GetDriveInfo = di
        CloseHandle hDrive
        Set colAttrNames = Nothing
    End Function

    Private Function IsWindowsNT() As Boolean
       Dim verinfo As OSVERSIONINFO
       verinfo.dwOSVersionInfoSize = Len(verinfo)
       If (GetVersionEx(verinfo)) = 0 Then Exit Function
       If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
    End Function

    Private Function IsBitSet(iBitString As Byte, ByVal lBitNo As Integer) As Boolean
        If lBitNo = 7 Then
            IsBitSet = iBitString < 0
        Else
            IsBitSet = iBitString And (2 ^ lBitNo)
        End If
    End Function

    Private Function SwapStringBytes(ByVal sIn As String) As String
       Dim sTemp As String
       Dim i As Integer
       sTemp = Space(Len(sIn))
       For i = 1 To Len(sIn) - 1 Step 2
           Mid(sTemp, i, 1) = Mid(sIn, i + 1, 1)
           Mid(sTemp, i + 1, 1) = Mid(sIn, i, 1)
       Next i
       SwapStringBytes = sTemp
    End Function

    Public Sub FillAttrNameCollection()
       Set colAttrNames = New Collection
       With colAttrNames
           .Add "ATTR_INVALID", "0"
           .Add "READ_ERROR_RATE", "1"
           .Add "THROUGHPUT_PERF", "2"
           .Add "SPIN_UP_TIME", "3"
           .Add "START_STOP_COUNT", "4"
           .Add "REALLOC_SECTOR_COUNT", "5"
           .Add "READ_CHANNEL_MARGIN", "6"
           .Add "SEEK_ERROR_RATE", "7"
           .Add "SEEK_TIME_PERF", "8"
           .Add "POWER_ON_HRS_COUNT", "9"
           .Add "SPIN_RETRY_COUNT", "10"
           .Add "CALIBRATION_RETRY_COUNT", "11"
           .Add "POWER_CYCLE_COUNT", "12"
           .Add "SOFT_READ_ERROR_RATE", "13"
           .Add "G_SENSE_ERROR_RATE", "191"
           .Add "POWER_OFF_RETRACT_CYCLE", "192"
           .Add "LOAD_UNLOAD_CYCLE_COUNT", "193"
           .Add "TEMPERATURE", "194"
           .Add "REALLOCATION_EVENTS_COUNT", "196"
           .Add "CURRENT_PENDING_SECTOR_COUNT", "197"
           .Add "UNCORRECTABLE_SECTOR_COUNT", "198"
           .Add "ULTRADMA_CRC_ERROR_RATE", "199"
           .Add "WRITE_ERROR_RATE", "200"
           .Add "DISK_SHIFT", "220"
           .Add "G_SENSE_ERROR_RATEII", "221"
           .Add "LOADED_HOURS", "222"
           .Add "LOAD_UNLOAD_RETRY_COUNT", "223"
           .Add "LOAD_FRICTION", "224"
           .Add "LOAD_UNLOAD_CYCLE_COUNTII", "225"
           .Add "LOAD_IN_TIME", "226"
           .Add "TORQUE_AMPLIFICATION_COUNT", "227"
           .Add "POWER_OFF_RETRACT_COUNT", "228"
           .Add "GMR_HEAD_AMPLITUDE", "230"
           .Add "TEMPERATUREII", "231"
           .Add "READ_ERROR_RETRY_RATE", "250"
       End With
    End Sub

     

    '==============================================================

    '   NOW HOW TO CALL THEM

    '===============================================================

    declare following variable on form as below

    Public ActualModel As String
    Public ActualFirm As String
    Public ActualSerial As String

    'make a function in your form as below

    Public Sub CheckHDDSerial()

       Dim drv_info As DRIVE_INFO
       drv_info = GetDriveInfo(0)
       With drv_info
           If .bDriveType = 1 Then
              ActualModel = Trim(.Model)
              ActualFirm = Trim(.FirmWare)
    '          ActualSerial = Mid(.SerialNumber, 1, (Len(.SerialNumber) - 6))
              ActualSerial = Trim(.SerialNumber)
          End If
       End With
        Debug.Print ActualModel
        Debug.Print ActualFirm
        Debug.Print ActualSerial
    End Sub

    'And call this function on Form Load event as

     Call CheckHDDSerial

    'and check it either values matches or not as below 

     If Not (ActualSerial = "MRL242L2GUNDJB" And ActualFirm = "MG2OA56A" And ActualModel = "HTS548040M9AT00") Then
            MsgBox "UnLicensed Copy of this Software ... Please Contact Faisal Saleem : (0321-4370010)", vbCritical, "APPLICATION TITLE : COMPANY NAME © : " & ActualSerial & " " & ActualFirm & " " & ActualModel
            End
        End If

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    '---------------------------------------------------

    '***********************************************

    '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

    'BEST OF LUCK & ENJOY THIS CODE

     

     

     

     

    '

    • Proposed as answer by Faisal Sagar Saturday, July 09, 2011 1:55 PM
    • Unproposed as answer by Faisal Sagar Saturday, July 09, 2011 1:56 PM
    Saturday, July 09, 2011 1:52 PM
  • Dear Mr. Faisal

    This code needs Admin privilege, is there any way to run this code using limited user??

     

    BR,

    Sunday, September 04, 2011 10:16 AM
  • hi faisal this code works good in some system like branded pc's but atapi type of hdd give error msg not register copy even add correct serial model and firm any suggestion?
    Thursday, December 22, 2011 8:55 AM
  • This ActiveX control can retrive it easyly, Get hard disk serial number
    Thursday, May 10, 2012 7:28 AM